Console Tools für FreeBasic und PB CC

[Peter Weis]

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!

 

[Peter Weis]

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!!!

Code: [Select]

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

[Peter Weis]

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

Code: [Select]

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

[Peter Weis]

Hi habe die Funktion umgeschrieben,
so das sie auch mit freebasic 1.00 läuft

Code: [Select]

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

[Peter Weis]

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.

Code: [Select]


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!

Code: [Select]

movzx  bx, Byte ptr [radix]
 


Grüße Peter
 

[Peter Weis]

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

Code: [Select]

movzx  ax, Byte Ptr [esi+tcols]
mov [wcols], ax
Add   ax, [col]
dec   ax
cmp   ax, [MAXCOL]
ja @@errproc_movepos


[Peter Weis]

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!

[Peter Weis]

na ja hab wieder zwei Fehler beseitigt

in diakey dieses mal, na ja ist aber immer noch nicht Fehlerlos!!!!

Code: [Select]

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