Oxygen Basic
Programming => Problems & Solutions => Topic started by: Brian Alvarez on August 02, 2019, 02:01:48 PM
-
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?
-
Hi Brian,
There is a 64bit version of FindEd including the source code in inc\OXSC. It uses inc\SearchUtil.inc which uses FindFirstFile and FindNextFile. It is a bit excessive in using sys integers where 32bit ints would do, so I'll check that it continues working with ints, except for handle h.
BTW: This is my most useful tool for maintaining o2 and other large projects.
function dirpath(string d) as string
====================================
sys a,b,i,e=len d
do
i++
if i>e then exit do
a=asc d,i
if a=47 or a=92 then b=i
end do
if b then return left d,b
end function
function GetFilteredFileList(string filter) as string
=====================================================
WIN32_FIND_DATA f
sys h
int a,e,i
zstring dirname[256]
string dr=dirpath filter
string fbuf=nuls 0x8000
int fbe,le,ld
ld=len dr
'
'GetCurrentDirectory 256, @dirname
'pr="Directory Name: " dirname cr "Filter: " filter cr cr
'
h=FindFirstFile filter, @f
'
if h then
do
a=0
if not wordlist then
a=1
else
if f.cfilename then
a=SearchFile dr+f.cFileName
end if
end if
'
if a then
i++
le=ld+len(f.cFileName)+2
if fbe+le>len fbuf then fbuf+=nuls 0x8000
mid fbuf,fbe+1,dr+f.cFileName+cr
fbe+=le
'function+=dr f.cFileName cr
end if
e=FindNextFile h, @f
if e=0 then
e=GetLastError 'should be 18 when no more files
'print e
exit do
end if
end do
FindClose h
end if
return left fbuf,fbe
end function
-
Thanks Charles, im going to take a look.
-
Charles, my code works fine in 64bit mode... it seems like my headers are fine,
except that Oxygen does not like this:
if (f.cFileName <> ".") and (f.cFileName <> "..") then
exit do
end if
Im doing this to avoid giving those strings as results, but Oxygen does not
like the statement. There are no null addresses, and the strings in are
apparently fine. if i remove that line, it works, but includes "." in the results.
I think <> is not working fine with CHAR strings in a UDT. The following code
fixed everything, but i would appreciate if you could confirm this is safe:
if (ltrim(f.cFileName) <> ".") and (ltrim(f.cFileName) <> "..") then
exit do
end if
I would also appreciate if you could take a look at why comparing CHAR string
crashes the executable... when you have some spare time.
-
Hi Brian,
I'll fix the problem in RTL64, and include support for unicode wchar string comparisons.
But the best solution, saving a page-full of assembler is:
byte b at @f.cFileName
if b=46 then
'if (f.cFileName <> ".") and (f.cFileName <> "..") then
exit do
end if
-
I tried that but i thought... what about genuine files that start with a period?
I dont know who whould name a file like that.. but since the OS allows it...
-
I've never seen it on Windows either.
The only instance I know of is .htaccess:
http://www.htaccess-guide.com/
The dot test, used in my software is confined to directories rather than filenames.
-
Exactly. I also generate CGI scripts with Oxygen... and that .htaccess file is the only instance
of a "normal" file i recall ever seing that starts with a period.