This is not a bug or a bug report, instead i think i am making a mistake in my declarations, but
i dont see where. I Implemented DIR and it works flawless for 32bit mode, but chashes on the first call
to findfirstfile when compiled in 64 bit mode.
'Generated with PluriBASIC 6.0.237326.0
$ filename "C:\Users\Diamante\Documents\PluriBASIC\projects\drmario\DIR_TEST.exe"
uses rtl32
%NoConsole
uses console
DIM STRING ¤SYSTEM_UDT_OFFSETS(0)
STRING ¤TMPS = "" ' a temporary string.
DECLARE FUNCTION ¤GetLastError Lib "Kernel32.dll" Alias "GetLastError" () AS LONG
DECLARE FUNCTION ¤GetAsyncKeyState Lib "User32.dll" Alias "GetAsyncKeyState" (ByVal vKey AS LONG) AS short
DECLARE SUB ¤Sleep lib "Kernel32.dll" alias "Sleep" (dword mSec)
function ¤INI_QUAD(dword v1, v2) as quad
quad v = 0
copy(@v+0, @v2, 4)
copy(@v+4, @v1, 4)
return v
end function
DECLARE FUNCTION ¤OpenProcess Lib "KERNEL32.DLL" Alias "OpenProcess" (ByVal dwDesiredAccess AS DWORD, ByVal bInheritHandle AS LONG, ByVal dwProcessId AS SYS) AS SYS
DECLARE FUNCTION ¤TerminateProcess Lib "KERNEL32.DLL" Alias "TerminateProcess" ( ByVal hProcess AS SYS, ByVal uExitCode AS DWORD) AS LONG
DECLARE FUNCTION ¤CloseHandle Lib "KERNEL32.DLL" Alias "CloseHandle" (ByVal hObject AS SYS) AS LONG
DECLARE FUNCTION ¤GetCurrentProcessId Lib "KERNEL32.DLL" Alias "GetCurrentProcessId" () AS SYS
MACRO ¤SET_ERR(n)
Err.err = n
Err.erl = Err.erp
END MACRO
MACRO ¤ONERR(l, e)
Err.err = e
IF (Err.err>0) THEN
Err.ers = Err.erp
Err.erl = l
IF Err.Oe1 THEN
JMP Err.Oe1
ELSEIF Err.Oe2 THEN
CALL Err.Oe2
END IF
else
Err.ers = ""
Err.erl = 0
END IF
END MACRO
MACRO ERRCLEAR
Err.err = 0
Err.erl = 0
Err.ers = ""
END MACRO
CLASS ¤SYSERR
public sys Oe1 = 0
public sys Oe2 = 0
public int err = 0
public int erl = 0
public string erp = ""
public string ers = ""
END CLASS
DECLARE FUNCTION ¤WriteConsole LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS SYS, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS dword, lpNumberOfBytesWritten AS dword, lpReserved AS long) AS LONG
DECLARE FUNCTION ¤AllocConsole LIB "KERNEL32.DLL" ALIAS "AllocConsole" () AS LONG
DECLARE FUNCTION ¤FlushFileBuffers LIB "KERNEL32.DLL" ALIAS "FlushFileBuffers" (BYVAL hFile AS SYS) AS LONG
DECLARE FUNCTION ¤GetStdHandle LIB "KERNEL32.DLL" Alias "GetStdHandle" (ByVal nStdHandle AS DWORD) AS SYS
declare function ¤FindFirstFile alias "FindFirstFileA" lib "kernel32.dll" '(lpFileName AS ASCIIZ, BYVAL lpFindFileData AS SYS) AS SYS
declare function ¤FindNextFile alias "FindNextFileA" lib "kernel32.dll" '(BYVAL hFindFile AS SYS, BYVAL lpFindFileData AS SYS) AS SYS
declare function ¤FindClose alias "FindClose" lib "kernel32.dll" '(BYVAL hFindFile AS SYS) AS SYS
declare function ¤DisableRdr alias "Wow64DisableWow64FsRedirection" lib "kernel32.dll" '(BYVAL hFindFile AS SYS) AS SYS
' STARTS PLURIBASIC_PREPARE.BIN
' This code is executed before anything else, if you want to do something after defining other things, see PLURIBASIC_INIT
int ¤i = 0
' STARTS SYSTEM_OPERATORS.BIN
FUNCTION ¤BytOvf(byte b) AS byte
return b
END FUNCTION
FUNCTION ¤NOT(byval quad v1) AS QUAD
dword w1
dword w2
quad r
copy @w1, @v1, 4
copy @w2, @v1+4, 4
w1 = not(w1)
w2 = not(w2)
copy @r, @w1, 4
copy @r+4, @w2, 4
return r
END FUNCTION
FUNCTION ¤AND(byval quad v1, v2) as quad
dword w1
dword w2
quad r
copy @w1, @v1, 4
copy @w2, @v2, 4
w1 = (w1 and w2)
copy @r, @w1, 4
copy @w1, @v1+4, 4
copy @w2, @v2+4, 4
w1 = (w1 and w2)
copy @r+4, @w1, 4
return r
end function
FUNCTION ¤OR(byval int v1, v2) as int
return v1 or v2
end function
'FUNCTION ¤OR(byval quad v1, v2) as quad
' dword w1
' dword w2
' quad r
' copy @w1, @v1, 4
' copy @w2, @v2, 4
' w1 = (w1 or w2)
' copy @r, @w1, 4
' copy @w1, @v1+4, 4
' copy @w2, @v2+4, 4
' w1 = (w1 or w2)
' copy @r+4, @w1, 4
' return r
'end function
FUNCTION ¤IMP(byval quad v1, v2) as quad
if v1 then return -1
if v2 then return -1
end function
FUNCTION ¤EQV(byval quad v1, v2) as quad
if v1=0 then return 0
if v2=0 then return 0
return -1
end function
FUNCTION ¤MOD(quad v1, v2) as quad
return MOD(v1, v2)
end function
' END OF SYSTEM_OPERATORS.BIN
' CONTINUES (17) PLURIBASIC_PREPARE.BIN
#DEF HANDLE SYS
TYPE ¤SYSNMHDR
hwndFrom AS SYS
idFrom AS SYS
Code AS DWORD
END TYPE
class ¤SYSF
FUNCTION CONSTRUCTOR()
END FUNCTION
END CLASS
new ¤SYSF EXE()
def true -1
' END OF PLURIBASIC_PREPARE.BIN
' STARTS STR$.BIN
'int dp ' DECIMAL PLACES
'int trz ' STRIP TRAILING ZEROS
'int sn ' SCIENTIFIC NOTATION BY DEFAULT
'int sdp ' INHIBIT ZERO BEFORE DECIMAL POINT
'int sns ' LEADING SPACE FOR NON NEGATIVE NUMBERS
'int lps ' LEAD PADDING SPACES
'numberformat(8,0,0,0,1,0) 'default settings
'numberformat 'return to default
MACRO ¤STRCODE(dc)
numberformat(dc,1,0,1,0,0)
string ss = str(v)
numberformat
if v < 0 then
return ltrim(ss)
else
return " " + ltrim(ss)
end if
END MACRO
FUNCTION ¤STR(double v, byref long d) as string
long d2 = 6
if @d then d2 = d
¤STRCODE(d2)
END FUNCTION
FUNCTION ¤STR(single v, byref long d) as string
long d2 = 6
if @d then d2 = d
¤STRCODE(d2)
END FUNCTION
FUNCTION ¤STR(quad v, byref long d) as string
¤STRCODE(0)
END FUNCTION
FUNCTION ¤STR(quad v) as string
long d = 0
¤STRCODE(0)
END FUNCTION
' END OF STR$.BIN
' STARTS PRINTR.BIN
SUB ¤INITCONSOLE()
STATIC Allc AS LONG
IF Allc=0 THEN
¤AllocConsole()
Allc = 1
END IF
END SUB
MACRO ¤STDOUT()
INT lWritten = 0
SYS hFile = 0
INT Btc = 0
' Capturing in IDE, do not show.
if cr=1 then s += chr(13, 10)
if cr=2 then s += "</br>"
¤Sleep(0)
hFile = ¤GetStdHandle(-11)
FOR Btc = 1 TO 50
IF ((Btc*32000)-31999) > len(s) THEN EXIT FOR
TTsnd = MID(s, ((Btc*32000)-31999), 32000)
¤WriteConsole(hFile, ByVal StrPtr(TTsnd), byval Len(TTsnd), lWritten, ByVal 0)
NEXT Btc
'¤FlushFileBuffers(hFile)
END MACRO
SUB ¤PRINTASZ(ASCIIZ c[0], byval int cr)
STRING TTsnd = ""
string s = c
¤STDOUT()
END SUB
SUB ¤PRINTSTR(STRING c, byval int cr)
STRING TTsnd = ""
STRING s = c
¤STDOUT()
END SUB
SUB ¤PRINTJSN(STRING c, byval int cr)
STRING TTsnd = ""
STRING s = c
¤STDOUT()
END SUB
SUB ¤PRINTSTZ(ZSTRING c[0], byval int cr)
STRING TTsnd = ""
STRING s = c
¤STDOUT()
END SUB
SUB ¤PRINTWST(WSTRING c, byval int cr)
STRING TTsnd = ""
STRING s = c
¤STDOUT()
END SUB
SUB ¤PRINTWSZ(WZSTRING c[0], byval int cr)
WSTRING TTsnd = ""
WSTRING s = c
¤STDOUT()
END SUB
' END OF PRINTR.BIN
' STARTS PLURIBASIC_INIT.BIN
' This code is executed before anything else, if you want to do something before nything else, see PLURIBASIC_PREPARE
' END OF PLURIBASIC_INIT.BIN
' STARTS DIR$.BIN
type ¤FILETIME
DWORD dwLowDateTime
DWORD dwHighDateTime
end type
type ¤WIN32_FIND_DATA
DWORD dwFileAttributes
¤FILETIME ftCreationTime
¤FILETIME ftLastAccessTime
¤FILETIME ftLastWriteTime
DWORD nFileSizeHigh
DWORD nFileSizeLow
DWORD dwReserved0
DWORD dwReserved1
CHAR cFileName[MAX_PATH]
CHAR cAlternateFileName[14]
CHAR Buffer[512]
end type
' Returns the first file that matches the specs.
FUNCTION ¤DIR(string specs, int o, flg, r) AS STRING
static string pspec
static int flags
static sys hSearch
static int nomatch
static int oy
int nErr = 0
int i = 0
¤WIN32_FIND_DATA f
if o=2 then ' find next file
if hSearch then
if nomatch then
return ""
end if
o = oy
if ¤FindNextFile(hSearch, @f) then
goto .¤ContinueSearch
else
nomatch = 1
end if
end if
else ' find first file.
pspec = specs
flags = flg
oy = o
nomatch = 0
if hSearch then
¤FindClose(hSearch)
end if
¤DisablerDR(BYVAL 0)
hSearch = ¤FindFirstFile(specs, BYVAL @f)
if hSearch then
do
if (f.cFileName <> ".") and (f.cFileName <> "..") then
exit do
end if
if ¤FindNextFile(hSearch, @f) = 0 then
nomatch = 2
return ""
end if
loop
..¤ContinueSearch
do
if o then ' do we force matching flags?
i = 1
do
if ((flags and i) = i) then ' do we force this style?
if ((f.dwFileAttributes and i) <> i) then
goto .¤NoMatchContinueSearch
end if
else
if ((f.dwFileAttributes and i) = i) then
goto .¤NoMatchContinueSearch
end if
end if
i *= 2
if i > 32 then
exit do
end if
loop
else
if flags then
i = 1
do
if ((flags and i) = i) then ' do we need this style?
if ((f.dwFileAttributes and i) <> i) then ' do the file have it?
goto .¤NoMatchContinueSearch
end if
end if
i *= 2
if i > 32 then
exit do
end if
loop
end if
end if
return ltrim(rtrim(f.cFileName))
..¤NoMatchContinueSearch
if ¤FindNextFile(hSearch, @f) = 0 then
nomatch = 3
exit do
end if
loop
end if
end if
return ""
END FUNCTION
' Returns the next matching file.
FUNCTION ¤DIR(int specs, f, g) AS STRING
return ¤DIR("", 2, 0, 0)
END FUNCTION
' Returns the first matching file (with flags)
FUNCTION ¤DIR(string specs, int f, g) AS STRING
if specs <> "" then
return ¤DIR(specs, 0, 0, 0)
end if
END FUNCTION
' END OF DIR$.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
DECLARE FUNCTION PBMAIN() AS INT
' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION PBMAIN() AS INT
INT ¤RETVAL = 0
¤SYSERR Err
¤PRINTSTR("C " + ¤DIR("*", byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
¤PRINTSTR("D " + ¤DIR(0, byval 0, byval 0), 1)
RETURN ¤RETVAL
END FUNCTION
PBMAIN() ' invoke entry point
Is there a working example that compiles runs fine in 64 bit mode that uses these functions?