Login
Templates, Tools and Utilities
for Clarion Developers
Templates, Tools and Utilities
|
||
|
|
|
Icetips Article
Back to article list
Search Articles
Add Comment
Printer friendly
Direct link
Par2: Copying files and directories using API calls 1998-04-22 -- Stephen Bottomley I'm including a copy of a procedure I have used successfully in 32bit
applications on a Win95 machine copying directory trees to a Novell 4.1
server complete with directory creation. The bit's I've commented out are
just for error logs I use.
MAP
MODULE('winapi')
GetLastError(),DWORD,PASCAL,RAW,DLL(dll_mode)
CopyFile(*CSTRING lpExistingFileName,*CSTRING lpNewFileName,BOOL
bFailIfExist),BOOL,RAW,PASCAL,NAME('CopyFileA'),DLL(dll_mode)
CreateDirectory(*CSTRING lpPathName,LONG
lpSecurityAttributes),BOOL,RAW,PASCAL,NAME('CreateDirectoryA'),DLL(dll_mode)
FormatMessage(DWORD,LPCVOID,DWORD,DWORD,*LPSTR,DWORD,va_list),DWORD,PASCAL,R
AW,NAME('FormatMessageA'),DLL(dll_mode)
END
MODULE('C_LIB')
Access(*CSTRING,SIGNED),SIGNED,RAW,NAME('_access')
END
MODULE('COPYTREE.CLW')
CopyTree FUNCTION(STRING DirName,STRING TrgtDir),BYTE
END
END
CopyTree PROCEDURE (STRING DirName,STRING TrgtDir) ! Declare
Procedure
RetVal BYTE,AUTO
LogId LONG
ErrorText CSTRING(256)
SourceDir CSTRING(256),AUTO
TargetDir CSTRING(256),AUTO
ActionEntry CSTRING(256),AUTO
ActionTarget CSTRING(256),AUTO
MsgId ULONG,AUTO
RecCount LONG,AUTO
RC LONG,AUTO
SRQ QUEUE,PRE()
name STRING(13)
date LONG
time LONG
size LONG
attrib BYTE
END
SECURITY_ATTRIBUTES GROUP
nLength DWORD
lpSecurityDescriptor LPVOID
bInheritHandle BOOL
END
window WINDOW,AT(,,121,22),FONT('MS Sans
Serif',8,,),CENTER,TIMER(1),SYSTEM,GRAY,DOUBLE
END
CODE
RetVal = True !Set to Suceess
SourceDir = DirName
TargetDir = TrgtDir
if SourceDir[len(clip(SourceDir))] <> '\'
SourceDir = clip(SourceDir) & '\'
.
if TargetDir[len(clip(TargetDir))] <> '\'
TargetDir = clip(TargetDir) & '\'
.
if not access(TargetDir,0) = 0
! LogId = AddLog()
clear(ErrorText)
if not CreateDirectory(TargetDir,address(SECURITY_ATTRIBUTES))
MsgId =
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS,0,Get
LastError(),0,ErrorText,size(ErrorText),0)
! LogId = AddLog(LogId,,77,'Unable to create: ' &
clip(TargetDir),'',ErrorText)
RetVal = False
return(RetVal)
else
! LogId = AddLog(LogId,,0,'Succefull create: ' & clip(TargetDir),)
.
.
Directory(SRQ,clip(SourceDir) & '*.*',1+2+4+10h) !All files and
directories
RecCount = records(SRQ)
loop RC = RecCount to 1 by -1
get(SRQ,RC)
if band(SRQ.Attrib,10h) and (SRQ.Name = '..' or SRQ.Name = '.')
delete(SRQ) !Get rid of parent
directories
.
.
sort(SRQ,SRQ.Attrib)
open(window)
window{PROP:Hide} = True
get(SRQ,records(SRQ))
accept
case EVENT()
of EVENT:Timer
if not records(SRQ) !This needs work
post(EVENT:CloseWindow)
cycle
.
get(SRQ,records(SRQ)) !This needs work
if band(SRQ.Attrib,10h)
post(EVENT:CloseWindow)
cycle
.
ActionEntry = clip(SourceDir) & SRQ.Name
ActionTarget = clip(TargetDir) & SRQ.Name
?String1{PROP:Text} = ActionEntry
display(?String1)
LogId = AddLog()
Clear(ErrorText)
if not CopyFile(ActionEntry,ActionTarget,0)
RetVal = False
MsgId =
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS,0,Get
LastError(),0,ErrorText,size(ErrorText),0)
! AddLog(LogId,,77,ActionEntry,ActionTarget,ErrorText)
else
! AddLog(LogId,,0,ActionEntry,ActionTarget)
.
delete(SRQ)
.
.
close(window)
loop while records(SRQ)
get(SRQ,records(SRQ))
ActionEntry = clip(SourceDir) & SRQ.Name
ActionTarget = clip(TargetDir) & SRQ.Name
if not CopyTree(ActionEntry,ActionTarget)
RetVal = False
.
delete(SRQ)
.
return RetVal
Today is April 20, 2024, 5:23 am This article has been viewed 35121 times.
|
|