| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
Issue with MalwareBytes A...
Forum: This and that - friendly chat
Last Post: Kurt Kuzba
29.11.2025, 13:19
» Replies: 1
» Views: 121
|
Posts here
Forum: Suggestions and discussion about PUMP
Last Post: Stanley Durham
26.11.2025, 22:37
» Replies: 2
» Views: 229
|
Arduino users news
Forum: This and that - friendly chat
Last Post: Pierre Bellisle
31.10.2025, 21:18
» Replies: 9
» Views: 1,190
|
How to run PB progs in Li...
Forum: PowerBASIC for Windows
Last Post: Gerald Sutherland
30.10.2025, 20:18
» Replies: 12
» Views: 1,691
|
Pac-Man maze
Forum: Programming
Last Post: Jules Marchildon
30.10.2025, 16:03
» Replies: 12
» Views: 3,143
|
Having problems with pbus...
Forum: This and that - friendly chat
Last Post: Kurt Kuzba
26.10.2025, 12:17
» Replies: 3
» Views: 738
|
Very Simple Round Gauge 0...
Forum: Source Code Library
Last Post: Jules Marchildon
18.10.2025, 01:17
» Replies: 6
» Views: 1,332
|
The Future
Forum: Suggestions and discussion about PUMP
Last Post: Dale Yarker
12.10.2025, 06:34
» Replies: 84
» Views: 18,158
|
READ$/Data Slow
Forum: PowerBASIC for Windows
Last Post: Brent F Boshart
11.10.2025, 20:13
» Replies: 4
» Views: 683
|
7zip alternatives ?
Forum: This and that - friendly chat
Last Post: Eric Pearson
08.10.2025, 15:07
» Replies: 4
» Views: 718
|
|
|
| Detect WINE emulator |
|
Posted by: Anne Wilson - 29.01.2025, 18:05 - Forum: Source Code Library
- No Replies
|
 |
This program will detect if it is being run in a WINE emulator.
Note that hackers will place your programs to run in WINE so that they can
pirate or hack your programs.
This is to detect whether the user is using a WINE emulator and to do the
necessary counter action.
Please let me know if you encounter issue with this program.
Code: ' Detect Wine.bas
#COMPILE EXE
#DIM ALL
#INCLUDE "Win32Api.inc"
' Constants for registry access
%KEY_QUERY_VALUE = &H0001
%KEY_WOW64_64KEY = &H0100
'===================
FUNCTION PBMAIN() AS LONG
IF IsRunningInWine() THEN
? "Running in Wine."
ELSE
? "Not running in Wine."
END IF
END FUNCTION
'=========================
FUNCTION IsRunningInWine() AS LONG
' Check for Wine-specific environment variables
LOCAL szBuffer AS ASCIIZ * 256
LOCAL lResult AS LONG
' Check for the "WINEDLLPATH" environment variable
lResult = GetEnvironmentVariable( stWineP, szBuffer, SIZEOF(szBuffer))
IF lResult > 0 THEN
' Wine environment variable found
FUNCTION = 1
EXIT FUNCTION
END IF
' Check for the "WINE" environment variable
lResult = GetEnvironmentVariable(stWine, szBuffer, SIZEOF(szBuffer))
IF lResult > 0 THEN
' Wine environment variable found
FUNCTION = 1
EXIT FUNCTION
END IF
' Check for Wine-specific registry keys
LOCAL hwnKey AS LONG
LOCAL dwType AS LONG
LOCAL dwSize AS LONG
' Check for Wine version in the registry
' Software\Wine
lResult = RegOpenKeyEx(%HKEY_LOCAL_MACHINE, swWine , _
0, %KEY_QUERY_VALUE OR %KEY_WOW64_64KEY, hwnKey)
IF lResult = 0 THEN
' Wine registry key found
FUNCTION = 1
RegCloseKey(hwnKey)
EXIT FUNCTION
END IF
' Check for Wine-specific files
' C:\windows\system32\winecfg.exe
IF GetFileAttributes(stWcfg) <> %INVALID_FILE_ATTRIBUTES THEN
' Wine-specific file found
FUNCTION = 1
EXIT FUNCTION
END IF
' If none of the above checks pass, assume not running in Wine
FUNCTION = 0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' WINEDLLPATH
FUNCTION stWineP() AS STRING
#REGISTER NONE
LOCAL pstr AS DWORD
LOCAL a$
a$ = NUL$(11)
pstr = STRPTR(a$)
! mov esi, pstr
! mov BYTE PTR [esi+6], 76
! mov BYTE PTR [esi+2], 78
! mov BYTE PTR [esi+0], 87
! mov BYTE PTR [esi+4], 68
! mov BYTE PTR [esi+3], 69
! mov BYTE PTR [esi+5], 76
! mov BYTE PTR [esi+10], 72
! mov BYTE PTR [esi+7], 80
! mov BYTE PTR [esi+1], 73
! mov BYTE PTR [esi+8], 65
! mov BYTE PTR [esi+9], 84
FUNCTION = a$
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' WINE
FUNCTION stWine() AS STRING
#REGISTER NONE
LOCAL pstr AS DWORD
LOCAL a$
a$ = NUL$(4)
pstr = STRPTR(a$)
! mov esi, pstr
! mov BYTE PTR [esi+1], 73
! mov BYTE PTR [esi+3], 69
! mov BYTE PTR [esi+2], 78
! mov BYTE PTR [esi+0], 87
FUNCTION = a$
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Software\Wine
FUNCTION swWine() AS STRING
#REGISTER NONE
LOCAL pstr AS DWORD
LOCAL a$
a$ = NUL$(13)
pstr = STRPTR(a$)
! mov esi, pstr
! mov BYTE PTR [esi+7], 101
! mov BYTE PTR [esi+9], 87
! mov BYTE PTR [esi+0], 83
! mov BYTE PTR [esi+6], 114
! mov BYTE PTR [esi+3], 116
! mov BYTE PTR [esi+4], 119
! mov BYTE PTR [esi+1], 111
! mov BYTE PTR [esi+10], 105
! mov BYTE PTR [esi+2], 102
! mov BYTE PTR [esi+11], 110
! mov BYTE PTR [esi+12], 101
! mov BYTE PTR [esi+5], 97
! mov BYTE PTR [esi+8], 92
FUNCTION = a$
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' C:\windows\system32\winecfg.exe
FUNCTION stWcfg() AS STRING
#REGISTER NONE
LOCAL pstr AS DWORD
LOCAL a$
a$ = NUL$(31)
pstr = STRPTR(a$)
! mov esi, pstr
! mov BYTE PTR [esi+24], 99
! mov BYTE PTR [esi+25], 102
! mov BYTE PTR [esi+17], 51
! mov BYTE PTR [esi+22], 110
! mov BYTE PTR [esi+14], 116
! mov BYTE PTR [esi+15], 101
! mov BYTE PTR [esi+27], 46
! mov BYTE PTR [esi+9], 115
! mov BYTE PTR [esi+12], 121
! mov BYTE PTR [esi+7], 111
! mov BYTE PTR [esi+2], 92
! mov BYTE PTR [esi+23], 101
! mov BYTE PTR [esi+29], 120
! mov BYTE PTR [esi+26], 103
! mov BYTE PTR [esi+28], 101
! mov BYTE PTR [esi+8], 119
! mov BYTE PTR [esi+18], 50
! mov BYTE PTR [esi+30], 101
! mov BYTE PTR [esi+4], 105
! mov BYTE PTR [esi+19], 92
! mov BYTE PTR [esi+6], 100
! mov BYTE PTR [esi+11], 115
! mov BYTE PTR [esi+0], 67
! mov BYTE PTR [esi+1], 58
! mov BYTE PTR [esi+5], 110
! mov BYTE PTR [esi+3], 119
! mov BYTE PTR [esi+10], 92
! mov BYTE PTR [esi+20], 119
! mov BYTE PTR [esi+21], 105
! mov BYTE PTR [esi+16], 109
! mov BYTE PTR [esi+13], 115
FUNCTION = a$
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
|
|
|
| Detect the Virtual Box Virtual Machine |
|
Posted by: Anne Wilson - 29.01.2025, 17:34 - Forum: Source Code Library
- No Replies
|
|
This program will detect if it is being run in a Virtual Box Virtual Machine VM.
Note that hackers will place your programs to run in a VM so that they can
pirate or hack your programs.
This is to detect whether the user is using a Virtual Box VM and to do the
necessary counter action.
Please let me know if you encounter issue with this program.
Code: ' Detect VirtualBox2.bas
' The program checks the SystemProductName value in the
' HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\BIOS registry key.
' If the value contains the string "VIRTUALBOX", it
' assumes the program is running inside a VirtualBox virtual machine.
' This method relies on the registry value, which can be modified
' by advanced hackers or customized VirtualBox installations.
' Additional checks :
' Detect VirtualBox with additional checks such as
' VirtualBox Guest Additions:
' The program checks for the presence of the
' C:\Program Files\Oracle\VirtualBox Guest Additions directory.
' If this directory exists, it is a strong indicator that
' VirtualBox Guest Additions are installed.
' VirtualBox Graphics Adapter:
' The program checks the registry for the DriverDesc value under the
' SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0000 key.
' If the value contains "VirtualBox", it indicates the presence of the
' VirtualBox Graphics Adapter.
' VirtualBox Shared Folders Service:
' The program checks for the VBoxSF service in the registry under
' SYSTEM\CurrentControlSet\Services\VBoxSF. If this key exists, it
' indicates that the VirtualBox Shared Folders service is installed.
' Some checks may require administrative privileges to access
' certain registry keys or files.
' VirtualBox environments can be customized by hackers, so these checks
' may not work in all cases.
#COMPILE EXE
#DIM ALL
#INCLUDE "Win32Api.inc"
' Constants for registry access
%KEY_QUERY_VALUE = &H0001
%KEY_WOW64_64KEY = &H0100
'=========================
FUNCTION PBMAIN() AS LONG
IF IsVirtualBox() THEN
? "Running inside VirtualBox."
ELSE
? "Not running inside VirtualBox."
END IF
END FUNCTION
'===================================
FUNCTION IsVirtualBox() AS LONG
' Check for VirtualBox specific hardware
LOCAL hvbKey AS LONG
LOCAL lResult AS LONG
LOCAL dwType AS LONG
LOCAL dwSize AS LONG
LOCAL szBuffer AS ASCIIZ * 256
LOCAL tmpVBfind AS LONG
' Indicator to signify that Virtual Box is found
tmpVBfind = 0
' Check for VirtualBox in the registry for "HARDWARE\DESCRIPTION\System\BIOS" key
lResult = RegOpenKeyEx(%HKEY_LOCAL_MACHINE, HwBios , _
0, %KEY_QUERY_VALUE OR %KEY_WOW64_64KEY, hvbKey)
IF lResult = 0 THEN
dwSize = SIZEOF(szBuffer)
' search for "SystemProductName" in the registry key
lResult = RegQueryValueEx(hvbKey, StSysPNam , 0 , _
dwType, BYVAL VARPTR(szBuffer), dwSize)
IF lResult = 0 THEN
' checks for presence of "VIRTUALBOX"
IF INSTR(UCASE$(szBuffer), StVbox ) > 0 THEN
' Running inside VirtualBox
tmpVBfind = 1
END IF
END IF
RegCloseKey(hvbKey)
END IF
IF tmpVBfind > 0 THEN
' inside Virtual Box, we exit
FUNCTION = 1
EXIT FUNCTION
END IF
' Check for VirtualBox Guest Additions folder
' C:\Program Files\Oracle\VirtualBox Guest Additions
IF GetFileAttributes(StGuestAdd) <> _
%INVALID_FILE_ATTRIBUTES THEN
' VirtualBox Guest Additions folder found
tmpVBfind = 2
END IF
IF tmpVBfind > 0 THEN
' inside Virtual Box, we exit
FUNCTION = 1
EXIT FUNCTION
END IF
' Check for VirtualBox Graphics Adapter in the registry
' SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0000
lResult = RegOpenKeyEx(%HKEY_LOCAL_MACHINE, _
VboxReg , 0, %KEY_QUERY_VALUE OR %KEY_WOW64_64KEY, hvbKey)
IF lResult = 0 THEN
dwSize = SIZEOF(szBuffer)
' DriverDesc
lResult = RegQueryValueEx(hvbKey, DrvDesc , 0, _
dwType, BYVAL VARPTR(szBuffer), dwSize)
IF lResult = 0 THEN
' checks for presence of "VIRTUALBOX"
IF INSTR(UCASE$(szBuffer), StVbox ) > 0 THEN
' VirtualBox Graphics Adapter found
tmpVBfind = 3
END IF
END IF
RegCloseKey(hvbKey)
END IF
IF tmpVBfind > 0 THEN
' inside Virtual Box, we exit
FUNCTION = 1
EXIT FUNCTION
END IF
' Check for VirtualBox Shared Folders service
' SYSTEM\CurrentControlSet\Services\VBoxSF
lResult = RegOpenKeyEx(%HKEY_LOCAL_MACHINE, VBoxSF ,_
0, %KEY_QUERY_VALUE OR %KEY_WOW64_64KEY, hvbKey)
IF lResult = 0 THEN
' VirtualBox Shared Folders service found
tmpVBfind = 4
RegCloseKey(hvbKey)
END IF
IF tmpVBfind > 0 THEN
'inside Virtual Box, we exit
FUNCTION = 1
EXIT FUNCTION
END IF
' Not running inside VirtualBox
FUNCTION = 0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SYSTEM\CurrentControlSet\Services\VBoxSF
FUNCTION VBoxSF() AS STRING
' Text is 40 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(40)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 40
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 40
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 79,184,216,160,164,135,207,62,1,240,202,123,92,83,181,95
! db 45,190,211,214,162,219,235,86,157,31,187,119,158,43,215,78
! db 122,59,140,231,178,30,78,170,0
#ALIGN 4
paddlabel:
! db 28,225,139,244,225,202,147,125,116,130,184,30,50,39,246,48
! db 67,202,161,185,206,136,142,34,193,76,222,5,232,66,180,43
! db 9,103,218,165,221,102,29,236,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' DriverDesc
FUNCTION DrvDesc() AS STRING
' Text is 10 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(10)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 10
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 10
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 95,19,30,205,113,174,192,70,177,188,0
#ALIGN 4
paddlabel:
! db 27,97,119,187,20,220,132,35,194,223,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0000
FUNCTION VboxReg() AS STRING
' Text is 82 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(82)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 82
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 82
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 249,4,13,80,88,97,132,5,24,111,213,141,243,173,242,206
! db 189,198,195,6,254,205,26,36,221,142,19,135,64,61,151,78
! db 153,171,45,85,38,106,176,110,168,138,35,114,191,211,155,93
! db 173,26,92,124,246,134,68,157,34,41,54,12,4,160,71,157
! db 217,220,127,46,171,7,143,39,93,53,250,48,59,101,31,82
! db 71,223,0
#ALIGN 4
paddlabel:
! db 170,93,94,4,29,44,216,70,109,29,167,232,157,217,177,161
! db 211,178,177,105,146,158,127,80,129,205,124,233,52,79,248,34
! db 197,232,65,52,85,25,236,21,156,206,16,68,250,234,173,101
! db 128,95,111,78,195,171,117,172,97,108,27,78,66,227,118,176
! db 233,228,79,30,153,69,202,22,109,6,203,8,70,57,47,98
! db 119,239,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' C:\Program Files\Oracle\VirtualBox Guest Additions
FUNCTION StGuestAdd() AS STRING
' Text is 50 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(50)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 50
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 50
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 7,220,75,224,3,68,53,168,252,239,117,24,148,135,223,200
! db 247,24,180,35,112,47,153,150,228,9,220,195,146,241,190,213
! db 5,52,58,119,39,226,64,247,210,250,250,22,125,81,204,206
! db 154,127,0
#ALIGN 4
paddlabel:
! db 68,230,23,176,113,43,82,218,157,130,85,94,253,235,186,187
! db 171,87,198,66,19,67,252,202,178,96,174,183,231,144,210,151
! db 106,76,26,48,82,135,51,131,242,187,158,114,20,37,165,161
! db 244,12,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' HARDWARE\DESCRIPTION\System\BIOS
FUNCTION HwBios() AS STRING
' Text is 32 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(32)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 32
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 32
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 6,160,141,231,80,254,21,81,26,141,42,230,212,123,191,161
! db 135,127,23,20,125,4,86,219,249,27,41,173,135,79,226,31,0
#ALIGN 4
paddlabel:
! db 78,225,223,163,7,191,71,20,70,201,111,181,151,41,246,241
! db 211,54,88,90,33,87,47,168,141,126,68,241,197,6,173,76,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SystemProductName
FUNCTION StSysPNam() AS STRING
' Text is 17 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(17)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 17
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 17
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 13,86,169,118,27,35,11,70,75,176,244,132,4,124,41,63
! db 53,0
#ALIGN 4
paddlabel:
! db 94,47,218,2,126,78,91,52,36,212,129,231,112,50,72,82
! db 80,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' VIRTUALBOX
FUNCTION StVbox() AS STRING
' Text is 10 bytes excluding the terminating zero
#REGISTER NONE
LOCAL src AS DWORD
LOCAL dst AS DWORD
LOCAL outpt$
src = CODEPTR(datalabel)
outpt$ = NUL$(10)
dst = STRPTR(outpt$)
' -------------------
' copy data to string
' -------------------
! mov esi, src
! mov edi, dst
! mov ecx, 10
! rep movsb
src = CODEPTR(paddlabel)
' -----------------------------
' xor string data to unique pad
' -----------------------------
! mov esi, dst
! mov ebx, 10
! mov edi, src
! add esi, ebx
! add edi, ebx
! neg ebx
lbl0:
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jz lbl1
! movzx eax, BYTE PTR [edi+ebx]
! xor [esi+ebx], al
! add ebx, 1
! jnz lbl0
lbl1:
FUNCTION = outpt$
EXIT FUNCTION
#ALIGN 4
datalabel:
! db 44,250,255,129,228,77,15,253,221,22,0
#ALIGN 4
paddlabel:
! db 122,179,173,213,177,12,67,191,146,78,0
END FUNCTION
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
|
|
|
|
PBDOS -- Where The Love Affair Began |
|
Posted by: Frank Ferrell - 29.01.2025, 11:39 - Forum: PowerBASIC for DOS
- Replies (9)
|
|
Greetings ....
The love affair with PowerBASIC began for me in the early 1990s, when I received my first PBDOS compiler program disk and manual (Version 2.1). It wasn't long before I moved up the cyber-ladder to Versions 3.0, 3.2 and finally the wonderful PBDOS 3-point-5.
I'm sure that many will agree that PBDOS and its IDE was a welcome change from Microsoft's QBasic/Quickbasic. The QB's were mmmmm, OK, but had several limitations, and at times produced a lot of frustrations.
With PBDOS in general, and V35 in particular, it was wonderful writing programs, aided by several statements and functions not found in the QB's.
If I could pick some statements/functions to add to PBDOS, which would later appear in the Console Compiler series, then these -- BUILD$, CHOOSE/CHOOSE$, WAITKEY$ and XPRINT -- would be at the top of the wish list.
So, that's my story. albeit a brief one. What's yours?
Thanx-A-Lotte, Frank.
|
|
|
|
| Mapped Drives and Run As Administrator issue |
|
Posted by: Stuart McLachlan - 29.01.2025, 02:45 - Forum: Programming
- Replies (2)
|
 |
Just ran into a little oops.
Writing a small backup utility to copy files from a mapped drive to a USB Thumb Drive.
I initially couldn't work out why it was silently failing with "Compile and Execute"
I tried running the executable from Windows Explorer and it worked.
Then it dawned on me  :
I have PBEdit and PBWin set to "run as Administrator' to avoid the known issues with occasional slow compilation and/or compiler fails.
"Administrator " didn't have the drive mapping.
My solution:
Code: dwDrives = GetLogicalDrives
IF BIT(dwDrives,25) = 0 THEN ' Drive Z not available
? "Cannot access source drive Z:\." & $LF & $LF & "You must run this application as a user with drive Z:\ mapped!" & $LF & $LF & _
"Note that the backup will fail if you run ""as administrator"" rather than as a normal user who has Z:\ mapped",%MB_ICONERROR,"Backup To USB Failed"
EXIT FUNCTION
END IF
|
|
|
|
| Calling opcode string discussion |
|
Posted by: Pierre Bellisle - 27.01.2025, 20:18 - Forum: Programming
- Replies (25)
|
 |
Calling opcode string discussion was started at https://forum.powerbasic.com/forum/user-...discussion
It is an answer To Anne on how to get and embed a function in a string and call it via "call dword"
This one show particularly how to find the end of the function code by inserting data near the end.
Code: 'follow up of https://forum.powerbasic.com/forum/user-to-user-discussions/programming/838669-calling-opcode-string-discussion
#compile exe '#Win 10.04 (D:\Dev\Pow\Bas\Jose Roca\Forum\Jose\Windows API Headers\3.1.07\uz)#
#dim all
'#register none
'%Unicode = 1
#include "Win32Api.inc"
#RESOURCE MANIFEST, 1, "XPTheme.xml"
global hDlg as dword
$AppName = "call dword"
%Static01 = 101
%Button01 = 201
declare function myfunction(byval var1 as long ,byval var2 as long) as long 'for call dword to use
'_____________________________________________________________________________
function HexView$(sString as string) as string 'HexString
local pByte as byte pointer
local sBuffer as string
local sChar16 as string
local Looper as long
pByte = strptr(sString)
do
if (Looper and 15) = 00 then 'Like MOD 16
sBuffer = sBuffer & hex$(Looper, 4) & ": " 'Line number:
elseif (Looper and 07) = 00 then 'Like MOD 8
sBuffer = sBuffer & "- " 'Middle dash
end if
if Looper < len(sString) then 'Add data
sBuffer = sBuffer & hex$(@pByte[Looper], 2) & $spc
else
#if %def(%pb_win32) 'A to F have bigger width
sBuffer = sBuffer & " " 'Windows: No more data, fill with five spaces
#else 'Use STDOUT in console
sBuffer = sBuffer & " " 'Console: No more data, fill with three spaces
#endif
end if
if (Looper and 15) = 15 then 'End of 16 bytes line
sChar16 = mid$(sString, Looper -14, 16) 'Next line replace non visible characters with dot
replace any chr$(0,1,7,9,10,13,27 to 31,127,129,140,141,143,144,152,157) with "..................." in sChar16
sBuffer = sBuffer & "; " & sChar16 & $crlf 'Add ascii string and CRLF
if Looper >= len(sString) - 1 then exit do 'Job done
end if
incr Looper
loop
function = "Binary data lenght is" & str$(len(sString)) & " bytes." & $crlf & sBuffer
end function
'____________________________________________________________________________
function Add2Numbers(byval var1 as long ,byval var2 as long) as long
function = var1 + var2
'function = var2
exit function
!DB &h12, &h34, &h56, &h78, &h9A, &hBC, &hDE, &hF0
end function
'_____________________________________________________________________________
callback function DlgProc
local sAsm as string
local sTerminator as string
local pcode as dword
local pString as dword
local RetVal as long
local byteVal as byte
select case cbmsg
case %wm_command
select case cbctl
case %Button01
if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
'call original function
sTerminator = chr$(&h12, &h34, &h56, &h78, &h9A, &hBC, &hDE, &hF0)
pcode = codeptr(Add2Numbers)
RetVal = 0
call dword pcode using myfunction(2, 2) to RetVal
MessageBox(hDlg, "CALL DWORD pcode result =" & str$(RetVal), $AppName, 266240)
'-----------------------------------------------------------------------------
'call a copy of original function using myfunction()
sAsm = ""
do
sAsm &= peek$(pcode, 1) 'build sAsm byte by byte to be sure to not access out of bound memory
incr pcode
if instr(sAsm, sTerminator) then
sAsm &= peek$(pcode, 16) 'get the end of function
exit do
end if
loop
RetVal = 0
pString = strptr(sAsm)
call dword pString using myfunction(2, 3) to RetVal
MessageBox(hDlg, "CALL DWORD pString result =" & str$(RetVal), $AppName, 266240)
'-------------------------------------------------------------------------------------------------
'call a copy of original function without using myfunction()
pString = strptr(sAsm)
! push 4
! push 2
call dword pString 'Or you may use !call pcode
! mov RetVal, eax
MessageBox(hDlg, "CALL DWORD ASM result =" & str$(RetVal), $AppName, 266240)
'-------------------------------------------------------------------------------------------------
'show the copy and original function code side to side
MessageBox(hDlg, "pcode:" & $crlf & HexView$(peek$(codeptr(Add2Numbers), len(sAsm))) & $crlf & $crlf & $crlf & _
"pString:" & $crlf & HexView$(peek$(codeptr(Add2Numbers), len(sAsm))), $AppName, 266240)
end if
end select
end select
end function
'_____________________________________________________________________________
function pbmain()
dialog font "Segoe UI", 9
dialog new %hwnd_desktop, $AppName, , , 150, 50, _
%ws_caption or %ws_minimizebox or %ws_maximizebox or %ws_sizebox or %ws_sysmenu, %ws_ex_left to hDlg
control add label, hDlg, %Static01, "codeptr() and strptr() test", 5, 10, 140, 11, %ss_center
control add button, hDlg, %Button01, "test codeptr() and strptr()", 15, 25, 120, 15
dialog show modal hDlg call DlgProc
end function
'_____________________________________________________________________________
'
|
|
|
|
| RUST (from PB Third Party-PluriBASIC) |
|
Posted by: Dale Yarker - 26.10.2024, 14:45 - Forum: This and that - friendly chat
- Replies (1)
|
 |
Downloaded/installed Rust. The example code shows curly brace and semicolon fetish I've avoided till now (C was saving RAM when 65K was a lot!).
Downloading Visual Studio (mandatory to have) took a long time. It is 1.42G!
The Rust doc said nothing about what to use to create/edit a source file. Finally just used PBCC Edit. I had to use File Explorer to delete the .bas it kept adding to the name. An appropriate editor is a problem for another day.
Rust uses UTC-8 so internationalization will be easier than current BASICs that are far behind PB (PB has WSTRING, others are ANSI).
Command Prompt for compiling is another thing to improve. I did have success with "Hello world".
Rust has a forum called Community. I think I'll discuss experiences with Rust, rather the PB.
Cheers,
|
|
|
|
|
