Hi mal was anderes zwischendurch!!! ;)
Die Tools sind fast ausnahmslos mit dem Inline Assembler von FreeBASIC geschrieben
wollte eigentlich das man sie von FreeBASIC und PowerBasic aus nutzen kann einige Funktionen laufen auch unter PowerBASIC aber nicht alle da PowerBASIC für Strings BSTR her nimmt, und FreeBASIC FSTR.
Da sich der Compiler von FreeBASIC geändert hat haben sich ein paar kleine Fehler eingeschlichen :(
Die Tools kann man auch als in eine DLL packen!
Ich stelle hier die Version vom 05.12.14 zur freier Verfügung, diese läuft mit FREE Basic 1.00 nicht nur mit Version 0.22!
Hallo hab mal geschaut die Funktion _MINSTAT hat bei der aktuellen Version 1.00 von Freebasic einen Fehler! :'(
werde morgen mal schauen was da nicht geht!!! gehe mit IDAG daran weil Freebasic keinen guten Debugger hat!!!
Function _MINSTAT Alias "_MINSTAT" (ByVal v As Short) As Short Export
Dim larg As Short
Asm
mov word Ptr [word_10C69], 0
mov word Ptr [word_10C84], 0 ' MSELECT
Call sub_11C32
Or ax,ax
jz short loc_112E1
Call MOUSEOFF
mov ax, &HFFFF
jmp Short loc_11330
loc_112E1:
mov word Ptr [word_10C69], &HFFFF
cmp Byte Ptr [byte_10C68], 0 ' Mouse ja
jz short loc_11330
Call mouseon
movzx ebx, word Ptr [word_10C65] ' MRITEMS
movzx eax, word Ptr [v]
Or ax, ax
jnz Short loc_11312
mov eax, ebx
jmp Short loc_11319
loc_11312:
cmp ax, &HFFFF
jnz Short loc_11319
mov eax, ebx
loc_11319:
Sub ebx, eax
inc ebx
push eax
push ebx
Call CHECKDEFINES
mov [larg], ax
Or ax, ax
je loc_11330
Call MOUSEOFF
mov ax, &HFFFF
mov [larg], ax
loc_11330:
push eax
mov ax, [word_10C84]
mov [MSELECT], AX
mov ax, [word_10C6B]
mov [MPRESSED], ax
pop eax
mov [larg], ax
Call savelastevents
End Asm
Function = larg
End Function
denke das der Murks bei loc_112E1:gemacht wird
Grüße Peter
bin dem Fehler ganz nahe!
der Fehler bei freebasic 1.00 wird bei in Sinulate ausgelöst beim Aufruf von WriteConsoleInput
Jedes Button hat einen Tastaturcode der hier simuliert wird und neu geschrieben wird damit die Maus Funktion aufgeführt werden kann!
ihr hörst von mir
Sub simulate naked () Export
'Dim InputRecords (1 to 100) As INPUT_RECORD
Dim simulateptr As UByte Ptr
Dim simulatelen As UInteger
Asm
push eax
push ecx
push esi
push edi
cmp esi, 0
je simulateerr
mov [simulateptr], esi
mov [simulatelen], ecx
End Asm
Dim hin As handle = GetStdHandle(STD_INPUT_HANDLE)
Dim i As UInteger = 1
Dim n As UInteger = 1
Dim lvar As Short
Dim InputRecords (1 to simulatelen * 2) As INPUT_RECORD
While i <= simulatelen
i+=1
InputRecords(n).EventType = KEY_EVENT
InputRecords(n).Event.keyEvent.bKeyDown = 1
InputRecords(n).Event.keyEvent.wRepeatCount = 1
InputRecords(n).Event.keyEvent.wVirtualScanCode = simulateptr[1] And &HFF
lvar = simulateptr[0] And &HFF
InputRecords(n).Event.keyEvent.dwControlKeyState = 0
inputRecords(n).Event.KeyEvent.uChar.AsciiChar = simulateptr[0] And &HFF
n+=1
InputRecords(n) = InputRecords(n - 1)
InputRecords(n).Event.keyEvent.bKeyDown = 0
simulateptr+=2
Wend
WriteConsoleInput hin, ByVal VarPtr(InputRecords(1)), n, ByVal VarPtr(n)
'mov ax, cs:word_10342
'mov es, ax
'assume es:nothing
'mov edi, &H1E
'mov es:1Ah, di
'cmp ecx, &H0F
'jbe short loc_1045A
'mov ecx, &H0F
'loc_1045A:
'cld
'rep movsw
'mov es:1Ch, di
Asm
simulateerr:
pop edi
pop esi
pop ecx
pop eax
ret
End Asm
End Sub
Hi habe die Funktion umgeschrieben,
so das sie auch mit freebasic 1.00 läuft
Sub simulate() Export
Dim simulateptr As UByte Ptr
Dim simulatelen As UInteger
Asm
mov [simulateptr], esi
mov [simulatelen], ecx
End Asm
If simulateptr Then
Dim hin As handle = GetStdHandle(STD_INPUT_HANDLE)
Dim i As UInteger = 1
Dim n As DWORD = 1
Dim lvar As Short
Dim InputRecords (1 to simulatelen * 2) As INPUT_RECORD
While i <= simulatelen
i+=1
InputRecords(n).EventType = KEY_EVENT
InputRecords(n).Event.keyEvent.bKeyDown = 1
InputRecords(n).Event.keyEvent.wRepeatCount = 1
InputRecords(n).Event.keyEvent.wVirtualScanCode = simulateptr[1] And &HFF
lvar = simulateptr[0] And &HFF
InputRecords(n).Event.keyEvent.dwControlKeyState = 0
inputRecords(n).Event.KeyEvent.uChar.AsciiChar = simulateptr[0] And &HFF
n+=1
InputRecords(n) = InputRecords(n - 1)
InputRecords(n).Event.keyEvent.bKeyDown = 0
simulateptr+=2
Wend
WriteConsoleInput hin, ByVal VarPtr(InputRecords(1)), n, ByVal VarPtr(n)
End If
End Sub
werde sie aber noch mal umschreiben entweder werde ich die Variable (InputRecordsauf den localen Stack legen oder werde Pointer und länge auf Stack legen
Grüße Peter
Hi habe wieder mal eine kleine Anpassung vorgenommen, so das die Funktion _ulng2str wieder richtig mit FreeBASIC 1.0 funktioniert.
Die Übergabe von 8 Bit Byte Parametern über den Stack erfolgt über 32 Bit bei jeder Programmiersprache und ist Systemabhängig" Dos 16 Bits Windows 32 Bits oder auch 64 Bits bei 64 Bit Betriebssystem". Ältere Versionen von FreeBASIC löschten die höherwertigen 8Bits von 16 bzw. 32 beim Aufruf automatisch. Das ist bei FreeBasic 1.0 nicht mehr der Fall. Es wird einfach der Wert der Speicherstelle übergeben!!!
Die Funktion benötigt die Funktion __long2asc diese Funktion die dann den Parameter Radix falsch interpretiert.
Sub __long2asc(ByVal value As dword, ByVal c As byte Ptr, ByVal radix As UByte, _
ByVal signed As UByte, ByVal addchar As ubyte, ByVal Xbit As Short)
Dim lvar As Short
Dim lstr(34) As Byte
Asm
mov edi, [c]
mov bx, [radix] ' hier ist dann der Fehler
cmp bl, 36
ja endproc
Habe den Fehler durch ersetzen der Zeile beseitigt. Jetzt wird das höherwertige Byte gelöscht duch!
movzx bx, Byte ptr [radix]
Grüße Peter
Hi :) habe wieder mal eine kleine Anpassung gemacht, und habe die Funktion _CMOVEWINDOWPOS an neuere Windows Versionen angepasst. Die Funktion arbeitete nur mit 120 Spalten sauber neuere Versionen von Windows haben aber 240 Spalten
movzx ax, Byte Ptr [esi+tcols]
mov [wcols], ax
Add ax, [col]
dec ax
cmp ax, [MAXCOL]
ja @@errproc_movepos
Hallo arbeite mal wieder an einer neuen Version. Da ich festgestellt habe das mit neuen Bildschirmen die Byte Struktur nicht mehr reicht habe ich es auf word geändert. sind aber noch viele Fehler drin es ist noch nicht stabil so wie die alte Version. Wer testen mag kann testen. Gebt mir bescheid wen ihr Fehler findet!
na ja hab wieder zwei Fehler beseitigt
in diakey dieses mal, na ja ist aber immer noch nicht Fehlerlos!!!!
Sub diakey naked Alias "Diakey"() Export
Asm
Xor ax, ax
cmp word Ptr [diawinopen], 0
jz short loc_11146
push offset [diacol]
push offset [diarow]
Call CMOVEWINDOW
loc_11146:
Or eax, eax
jz Short loc_1116E
mov edx, eax
Shr edx, 16
push edx 'push [testvar]
push eax '[testvar+2]
Call _selreloc
mov ax,[diarow]
mov ebx, [diarowref]
mov [ebx], ax
mov ax, [diacol]
mov ebx, [diacolref]
mov [ebx], ax
mov ax, -1
jmp short locret_11183
loc_1116E:
Call _lastkeyx
cmp ax, _ESC
jnz short loc_1117E
mov ax,-1
jmp Short locret_11183
loc_1117E:
Call _selkey
locret_11183:
ret
End Asm
End Sub