Last active
March 21, 2024 17:43
-
-
Save CarlTBarnes/e5d553a8ffe4287b0e19deac9c432202 to your computer and use it in GitHub Desktop.
REMOVE() in RTL has bugs and is very slow using ShFileOperation(). My replacement uses API DeleteFile() and sets Clarion ErrorCode() so can replace REMOVE().
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
!There are a few Remove() things here, what you want is FileApiRemove FUNCTION(STRING Fn2Delete),LONG,PROC | |
! | |
!In C8 Clarion REMOVE() was enhanced a second parameter with flags to allow wildcards, recursion, etc | |
!It was changed from calling API DeleteFile() to use the much more complicated ShFileOperation() | |
!This makes it much slower and more bug prone | |
! | |
!My replacement FileApiRemove() uses API DeleteFile() then sets the Claion Error so it can replace | |
!an existing REMOVE() in Clarion code. If you are using Remove(FILE) you'll need REMOVE(Name(File)) | |
!or you can create a FileApi2Remove(FILE FileRef) that calls FileApiRemove(FileRef{PROP:Name}) or NAME() | |
!I named it "FileApiRemove(" so if you are searching "REMOVE(" you'll file it, versus RemoveUsingAPI() would not. | |
! | |
!One Other PITA with REMOVE() is if its a TPS file the Driver will open the file and read the header in case its a super file. | |
!Often if you are changing the file, e.g. to add an OWNER password, you can get an error when Remove(Name(TpsFile)) will work. | |
!-------------------------------------------------------------- | |
PROGRAM | |
INCLUDE 'TplEqu.CLW' | |
INCLUDE 'KeyCodes.CLW' | |
MAP | |
TestWindow PROCEDURE() | |
FileApiRemove FUNCTION(STRING Fn2Delete),LONG,PROC !API Replacement 0=OK else GetLastError(). Can ignore sets RTL ErrorCode() | |
SafeRemove FUNCTION(STRING Fn2Delete) !Uses DOS File with RTL REMOVE() | |
TestRemoveFileAPI FUNCTION(STRING Fn2Delete) | |
RemoveFileQueue FUNCTION(FILE:Queue FlzQ, STRING _FilePath),LONG,PROC !Returns files left | |
MODULE('ClaApi') | |
!These Error functions have been in the RTL forever and appear in LibSrc but are not documented | |
SetError(LONG ErrNumberToSet),NAME('Cla$SetError'),DLL(DLL_Mode) | |
ClearError(),NAME('Cla$ClearError'),DLL(DLL_Mode) | |
MkDir(*cstring),short,raw,proc,name('_mkdir'),DLL(DLL_Mode) !just used in this test | |
end | |
module('api') | |
DeleteFile(*CSTRING lpFileName),PASCAL,DLL(1),RAW,BOOL,PROC,name('DeleteFileA') | |
OutputDebugString(*CSTRING cMsg),PASCAL,DLL(1),RAW,NAME('OutputDebugStringA') | |
DebugBreak(),PASCAL,DLL(1) !If running under Debug forces the debugger to popup | |
GetLastError(),LONG,PASCAL,DLL(1) | |
Sleep(LONG),PASCAL,DLL(1) | |
end | |
end | |
code | |
TestWindow() | |
return | |
!=============================================================================== | |
TestWindow PROCEDURE() | |
TestFolderBS CSTRING('.\TestDelPath\') | |
DelDolQ QUEUE(FILE:Queue),PRE(DelDoDelDolQlQ) | |
END | |
Window WINDOW('Delete File API'),AT(,,566,276),CENTER,GRAY,SYSTEM,FONT('Segoe UI',9),RESIZE | |
STRING('Buttons test FileApiRemove()'),AT(11,23) | |
BUTTON('Remove IdoNOTexist.$$$'),AT(11,37),USE(?DeleteNEfile) | |
BUTTON('Remove badpath\na.$$$'),AT(11,52),USE(?DeletebadPathfile) | |
BUTTON('Remove m:\badpath\na.$$$'),AT(11,67),USE(?DeleteMdrvBadPathfile) | |
BUTTON('Remove TestReadOnly.$$$'),AT(11,82),USE(?DeleteReadOnly) | |
BUTTON('Test SafeRemove()'),AT(11,109),USE(?SafeRemoveTEstBtn) | |
STRING('Path:'),AT(7,6),USE(?STRINGpath) | |
LIST,AT(157,23),FULL,USE(?ListFiles),VSCROLL,TIP('Click heads to sort, right click to reverse'), | | |
FROM(DelDolQ),FORMAT('100L(1)|M~Name~@s255@52L(1)|M~Short Name~@s13@40R(1)|M~Date~C(' & | | |
'0)@d1@40R(1)|M~Time~C(0)@T4@56R(1)|M~Size~C(0)@n13@16L(1)|M~Attr~@n3@'), | | |
ALRT(MouseLeft), ALRT(MouseRight) | |
BUTTON('Load Random'),AT(207,4),USE(?FQloadRandomBtn),TIP('Create 50 Temp files with PUTINI ' & | | |
'named TD####.$$$ in .\TestDelPath\') | |
BUTTON('Delete Q'),AT(275,4),USE(?FQDeleteBtn),TIP('Delete Temp files in LIST below using Re' & | | |
'moveFileQueue()') | |
END | |
code | |
MkDir(TestFolderBS) | |
open(window) | |
?STRINGpath{PROP:Text}=longpath() | |
accept | |
case event() | |
end | |
case accepted() | |
OF ?DeleteNEfile ; TestRemoveFileAPI('IdoNotExist.$$$') | |
OF ?DeletebadPathfile ; TestRemoveFileAPI('badpath\na.$$$') | |
OF ?DeleteMdrvBadPathfile ; TestRemoveFileAPI('m:\badpath\na.$$$') | |
OF ?DeleteReadOnly ; IF ~EXISTS('TestReadOnly.$$$') THEN Message('You must create a file and make Read Only file named: TestReadOnly.$$$','Action'). | |
TestRemoveFileAPI('TestReadOnly.$$$') | |
OF ?SafeRemoveTEstBtn ; DO SafeRemoveTEstRtn | |
OF ?FQloadRandomBtn ; DO FQloadRandomRtn | |
OF ?FQDeleteBtn ; DO FQDeleteRtn | |
end | |
end | |
close(window) | |
SafeRemoveTEstRtn ROUTINE | |
DATA | |
DelFN STRING('.\SafeTest.INI') | |
cFold CSTRING(260) | |
cFold2 CSTRING(260) | |
WhatTest PSTRING(256) | |
CODE | |
PUTINI('xxx','yyy','1',DelFN) | |
e1#=EXISTS(DelFN) | |
SafeRemove(DelFN) | |
e2#=EXISTS(DelFN) | |
Message('SafeRemove(Safetest.INI) ' & choose(e1#=1 and e2#=0,' WORKED! ', 'Unexpected Exists Before=' & E1# & 'After=' & E2#) ) | |
!Wildcard test | |
PUTINI('xxx','yyy','1','.\SafeTest1.INI') | |
PUTINI('xxx','yyy','1','.\SafeTest2.INI') | |
PUTINI('xxx','yyy','1','.\SafeTest3.INI') | |
Message('Testing Wildcards SafeRemove(SafeTest*.INI)',LONGPATH()) | |
SafeRemove('SafeTest*.INI') | |
IF EXISTS('SafeTest1.INI') AND EXISTS('SafeTest2.INI') THEN | |
SafeRemove('SafeTest1.INI') ; SafeRemove('SafeTest2.INI') | |
ELSE | |
Message('PROBLEM! Wildcards worked SafeRemove(SafeTest*.INI)') | |
END | |
!Wildcard in folder test | |
cFold ='SafeWildTest' & clock() | |
MkDir(cFold) ; e1#=EXISTS(cFold) ; IF ~e1# THEN STOP('Failed MkDir ' & CFold) . | |
PUTINI('xxx','yyy',CLOCK(),cFold & '\SafeFldTest1.INI') | |
PUTINI('xxx','yyy',CLOCK(),cFold & '\SafeFldTest2.INI') | |
Message('Read to test SafeRemove(' & cFold & '\SafeFldTest*.INI' ) | |
SafeRemove(cFold & '\SafeFldTest*.INI') | |
Message('Are files gone? SafeRemove(' & cFold & '\SafeFldTest*.INI' ) | |
!Folder tests | |
cFold ='SafeRmvTest' & day(today())&clock() | |
MkDir(cFold) | |
e1#=EXISTS(cFold) ; IF ~e1# THEN STOP('Failed MkDir ' & CFold) . | |
CASE Message('Test What','SafeRemove(Folder) Test',,'HALT()|Empty|Has Files|Sub-Folders') -1 | |
OF 0 ; HALT() | |
OF 1 | |
WhatTest='Empty folder Remove' | |
OF 2 | |
WhatTest='Folder with INI File' | |
PUTINI('xx',TODAY(),Clock(), '.\' & cFold & '\TestRemoveFolder.ini') | |
Message('Ready to test SafeRemove(Folder) folder has 1 INI file)||' & cFold , LongPath() ) | |
OF 3 | |
WhatTest='Folder with SubFolder' | |
cFold2 = CFold & '\SubFolder' & random(100,999) | |
MkDir(cFold2) | |
IF ~EXISTS(cFold2) THEN STOP('Failed MkDir ' & CFold2) . | |
Message('Ready to test SafeRemove(Folder)| ' & cFold&'||Sub ' & CFold2 , LongPath() ) | |
END | |
SafeRemove(cFold) | |
e2#=EXISTS(cFold) | |
Message('SafeRemove(SafeRmvFolderTest)|Test=' & WhatTest &'||'& | | |
choose(e1#=1 and e2#=1,' Worked, folder exists '& cFold,'') & | | |
choose(e1#=1 and e2#=0,' FAILED, Got Removed! ', '') & | | |
choose(e1#=0 ,' Failed to MkDir(' & cFold ,'') & | | |
'', longpath()) | |
EXIT | |
FQloadRandomRtn ROUTINE | |
!FYI TestFolderBS = '.\TestDelPath\' | |
loop 50 TIMES | |
putini(today(),clock(),1,TestFolderBS & 'td' & random(1,1000000) & '.$$$') | |
end | |
FREE(DelDolQ) | |
DIRECTORY(DelDolQ,TestFolderBS & 'TD*.$$$',ff_:NORMAL) | |
DISPLAY | |
EXIT | |
!------------------ | |
FQDeleteRtn ROUTINE | |
RemoveFileQueue(DelDolQ,TestFolderBS) | |
!=============================================== | |
TestRemoveFileAPI FUNCTION(STRING Fn2Delete) | |
CODE | |
message('Test FileApiRemove()||File: ' & Fn2Delete & | | |
'||FileApiRemove() Return=' & FileApiRemove(Fn2Delete) & | | |
'||Clarion ErrorCode()=' & ErrorCode() & | | |
'|Clarion Error()='& Error(),'TestRemoveFileAPI()',ICON:Asterisk ) | |
return | |
!=================================================================================================== | |
RemoveFileQueue FUNCTION(FILE:Queue FlzQ, STRING _FilePath)!,LONG,PROC !Returns files left | |
pFilePathBS PSTRING(255),AUTO | |
LnFP LONG,AUTO | |
Ndx LONG,AUTO | |
Ret SHORT | |
KillTry SHORT !#cc-283# delete timing issues | |
LastTry EQUATE(4) !#cc-283# | |
CODE | |
LnFP=LEN(CLIP(_FilePath)) | |
IF ~LnFP THEN | |
pFilePathBS='.\' | |
ELSE | |
pFilePathBS=_FilePath[1 : LnFP] & choose(_FilePath[LnFP]='\','','\') !add ending "\" if needed | |
END | |
!message(_FilePath &'|' & pFilePathBS ) | |
LOOP KillTry = 1 TO LastTry !#cc-283# try 5 tiems to delete all the files | |
LOOP Ndx = RECORDS(FlzQ) TO 1 BY -1 !#cc-283# go backwards to allow delete(q) 1 TO RECORDS(FlzQ) | |
GET(FlzQ,Ndx) | |
EXECUTE Killtry % 2 + 1 !Alternate API Remove and Clarion Remov | |
Remove(pFilePathBS & FlzQ:Name ) !KillTry 2 4 so % 2 + 1 = 1 | |
FileApiRemove(pFilePathBS & FlzQ:Name ) !KillTry 1 3 so % 2 + 1 = 2 | |
END | |
CASE ERRORCODE() | |
OF 0 OROF 2 OROF 3 !No error, no file, no path, that's fine | |
DELETE(FlzQ) !#cc-283# delete from queue if worked so I know I'm ok | |
ELSE | |
!I failed | |
END !Case Error | |
END !Loop Ndx Q | |
IF ~RECORDS(FlzQ) THEN BREAK. | |
SLEEP(100) | |
GET(FlzQ,1) | |
IF EXISTS(pFilePathBS & FlzQ:Name ) THEN !on one system doing an Exists() helped | |
END | |
END ! LOOP KillTry = 1 TO LastTry !#cc-283# no need for 5 tries if Q is empty | |
RETURN RECORDS(FlzQ) | |
!=================================================================================================== | |
! Another idea use the DOS driver to Remove(). I would not do this. | |
!=================================================================================================== | |
SafeRemove FUNCTION (STRING Fn2Delete) | |
File2Rmv FILE,DRIVER('DOS') !Any Driver works | |
RECORD ; END | |
END | |
CODE | |
!Warning: Removes Empty Folders, but not filled (for me) | |
File2Rmv{PROP:Name}=Fn2Delete | |
REMOVE(File2Rmv) | |
RETURN | |
!=================================================================================================== | |
! FileApiRemove() replacement for Clarion REMOVE() in that it sets the ErrorCode() and Error(). | |
! This also returns the API GetLastError() or Zero for Success | |
!=================================================================================================== | |
FileApiRemove FUNCTION (STRING Fn2Delete)!,LONG,PROC !0=ok, else returns Error code, also sets RTL ERRORCODE() ERROR() | |
cFN CSTRING(261),AUTO | |
ApiError LONG !GetLastError() when DeleteFile() fails | |
ClarionErr LONG !Api Error converted to matching Clarion Error number | |
CODE | |
cFN=clip(Fn2Delete) | |
IF 0=DeleteFile(cFn) THEN !Return 0 = Failed to DeleteFile() see GetLastError() for why | |
ApiError=GetlastError() | |
IF ~ApiError THEN ApiError=1. !Return says Failed, but no error ... so set something, should never happen | |
ClarionErr = ApiError !Most Clarion Error Numbers are the same as API Error Number | |
CASE ApiError !Translate some unusual GLE to errors to Clarion | |
OF 32 ; ClarionErr = 52 !API ERROR_SHARING_VIOLATION 32 (0x20) The process cannot access the file because it is being used by another process. | |
! Clarion Help says Error 52 = File Already Open - An attempt to OPEN a file that has already been opened by this user. | |
END | |
SetError(ClarionErr) !Set Error in RTL so caller can use ERRORCODE() just like if used RTL REMOVE() | |
ELSE !non-zero return from DeleteFile() means it worked and file was deleted | |
ClearError() !Delete worked set Error to Zero (close) in RTL so caller can use ERRORCODE() | |
END | |
RETURN ApiError !Return is Optional (PROC) so caller can check API Error Code if desired | |
!-------------------------------------------- | |
!Possible enhancement, if fails could Sleep(100) and retry 5 times, file may have | |
!just been closed and Virus scanner is looking at it, or OS is catchng up to commit delete | |
! | |
!SQLite has notes about exactly this problem. | |
! #define MX_DELETION_ATTEMPTS 5 | |
! do{ | |
! DeleteFileA(zConverted); | |
! }while( ( ((rc = GetFileAttributesA(zConverted)) != INVALID_FILE_ATTRIBUTES) | |
! || ((error = GetLastError()) == ERROR_ACCESS_DENIED)) | |
! && (++cnt < MX_DELETION_ATTEMPTS) | |
! && (Sleep(100), 1) ); | |
!--------------------------------------------- | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment