Chris, thanks for that routine.
Although I have solved the current task without it you routine looked
interesting and potentially quite useful so I thought I would test it out a
bit further. I found it necessary to make a couple of changes:
1). Impersonate Administrator user & then reset to normal user when
complete.
2). Create a SyncErr cursor to record failures.
3). Test if each action is successful, else write to aforementioned cursor.
4). Record file/directory attributes so we can establish which are read-only
when updating or deleting.
5). Remove read-only attribute when necessary.
Outstanding problem:
If a directory is to be deleted and the files in it are read-only then:
DELETE FILE *.* in AGRD() fails. Need to find a way to either remove
read-only attrib from all files in a directory or loop through all files
removing it one by one.
Regards,
Nick
New updated but untidy code below:
* Impersonate user code from the Fox Wiki by Hugo Ranea
#define LOGON32_PROVIDER_DEFAULT 0
#define LOGON32_LOGON_INTERACTIVE 2
#define LOGON32_LOGON_NETWORK 3
#define LOGON32_LOGON_BATCH 4
#define LOGON32_LOGON_SERVICE 5
#define LOGON32_LOGON_UNLOCK 7
DECLARE integer LogonUser IN AdvApi32.DLL;
string szUsername,;
string lpszDomain,;
string lpszPassword,;
integer dwLogonType,;
integer dwLogonProvider,;
integer @phToken
DECLARE integer ImpersonateLoggedOnUser IN AdvApi32.DLL integer hToken
DECLARE integer RevertToSelf IN AdvApi32.DLL
CLEAR
local nToken
nToken = 0
?
LogonUser("Administrator","MyServer","NotMyAdminPassword:)",LOGON32_LOGON_IN
TERACTIVE, LOGON32_PROVIDER_DEFAULT, @nToken)
? nToken
? ImpersonateLoggedOnUser(nToken)
CREATE CURSOR SyncErr (ctype c(1),csource m(10),ccopy m(10),cAttribs c(6))
SET ESCAPE ON
SET MESSAGE TO
DO Sync WITH "C:\Data", "D:\Archive"
? RevertToSelf()
RETURN
PROCEDURE Sync
LPARAMETERS lcsource,lccopy
? "Syncronising: ",lcsource," to ",lccopy," - "
LOCAL lcreturn,llreturn
llreturn=.t.
lcreturn=""
IF PARAMETERS()<2
lcreturn="Parameters not specified"
llreturn=.f.
ELSE
IF VARTYPE(lcsource)<>"C" OR VARTYPE(lccopy)<>"C"
lcreturn="Parameters Invalid"
llreturn=.f.
ELSE
IF !DIRECTORY(lcsource) OR !DIRECTORY(lccopy)
lcreturn="Directory Invalid"
llreturn=.f.
ENDIF
ENDIF
ENDIF
IF llreturn
SELECT 0
CREATE CURSOR sync (ctype c(1),csource m(10),ccopy m(10),cAttribs
c(6))
?? " Examining differences..."
m.Start=SECONDS()
SET MESSAGE TO
=proc_sync(lcsource,lccopy)
?? " took: ",ALLTRIM(STR(SECONDS()-m.Start,10,3)),"secs - "
?? " Updating..."
m.Start=SECONDS()
SELECT sync
SCAN
SCATTER MEMVAR memo
IF "R"$cAttribs
? "removing read-only: ",m.cCopy
SetFileAttribs(m.ccopy, "r") && turn Off
Read-only
ENDIF
DO CASE
CASE ctype="C"
COPY FILE (m.csource) TO (m.ccopy)
IF FILE(m.ccopy)
SET MESSAGE TO "Copied file:
"+m.ccopy
ELSE
INSERT INTO SyncErr FROM MEMVAR
ENDIF
CASE ctype="D"
MD (m.ccopy)
IF DIRECTORY(m.ccopy)
SET MESSAGE TO "Created directory:
"+m.ccopy
ELSE
INSERT INTO SyncErr FROM MEMVAR
ENDIF
CASE ctype="U"
DELETE FILE (m.ccopy)
IF FILE(m.ccopy)
INSERT INTO SyncErr FROM MEMVAR
ELSE
COPY FILE (m.csource) TO (m.ccopy)
IF FILE(m.ccopy)
SET MESSAGE TO "Updated
file: "+m.ccopy
ELSE
INSERT INTO SyncErr FROM
MEMVAR
ENDIF
ENDIF
CASE ctype="X"
DELETE FILE (m.ccopy)
IF FILE(m.ccopy)
INSERT INTO SyncErr FROM MEMVAR
ELSE
SET MESSAGE TO "Deleted file:
"+m.ccopy
ENDIF
CASE ctype="Z"
=AGRD (m.ccopy)
RD (m.ccopy)
IF DIRECTORY(m.ccopy)
INSERT INTO SyncErr FROM MEMVAR
ELSE
SET MESSAGE TO "Removed directory:
"+m.ccopy
ENDIF
ENDCASE
ENDSCAN
?? " took: ",ALLTRIM(STR(SECONDS()-m.Start,10,3)),"secs."
ENDIF
RETURN lcreturn
ENDPROC
***
PROCEDURE agrd
LPARAMETERS lcdir
LOCAL lchome,lndirs,lncounter
LOCAL ARRAY ladeldirs(1)
lchome=SYS(5)+CURDIR()
CD (lcdir)
SET SAFETY Off
DELETE FILE *.*
SET SAFETY on
lndirs=ADIR(ladeldirs,"","D",1)
IF lndirs>0
FOR lncounter = 1 TO ALEN(ladeldirs,1)
IF ladeldirs(lncounter,1)<>"." AND
ladeldirs(lncounter,1)<>".."
=agrd(lcdir+"\"+ladeldirs(lncounter,1))
endif
endfor
ENDIF
IF lndirs>0
FOR lncounter = 1 TO ALEN(ladeldirs,1)
IF ladeldirs(lncounter,1)<>"." AND
ladeldirs(lncounter,1)<>".."
RD (lcdir+"\"+ladeldirs(lncounter,1))
endif
endfor
ENDIF
CD (lchome)
RETURN
***
PROCEDURE proc_sync
LPARAMETERS lcsource,lccopy
LOCAL
llreturn,lnfiles,lndirs,lncopy,lncounter,lchome,lcaction,llcopies,lncopies,l
nresult,lnlocdirs
LOCAL array lafiles(1)
LOCAL array ladirs(1)
LOCAL ARRAY lacopies(1)
LOCAL ARRAY lalocdirs(1)
LOCAL ARRAY lacopy(1)
lcsource=ALLTRIM(lcsource)
lccopy=ALLTRIM(lccopy)
lchome=SYS(5)+CURDIR()
llcopies=.f.
IF DIRECTORY(lccopy)
CD (lccopy)
llcopies=.t.
lncopies=ADIR(lacopies,"*.*","",1)
lnlocdirs=ADIR(lalocdirs,"","D",1)
ENDIF
CD (lcsource)
lnfiles=ADIR(lafiles,"*.*","",1)
lndirs=ADIR(ladirs,"","D",1)
IF lnfiles>0
FOR lncounter = 1 TO ALEN(lafiles,1)
lcaction=""
IF !FILE(lccopy+"\"+lafiles(lncounter,1))
lcaction="C"
ELSE
lncopy=ADIR(lacopy,lccopy+"\"+lafiles(lncounter,1))
IF lncopy=1
DO case
CASE
lafiles(lncounter,3)>lacopy(1,3)
lcaction="U"
CASE
lafiles(lncounter,3)=lacopy(1,3) AND lafiles(lncounter,4)>lacopy(1,4)
lcaction="U"
ENDCASE
ENDIF
ENDIF
IF !EMPTY(lcaction)
INSERT INTO sync (ctype,csource,ccopy,cAttribs);
VALUES
(lcaction,ALLTRIM(lcsource)+"\"+ALLTRIM(lafiles(lncounter,1)),ALLTRIM(lccopy
)+"\"+ALLTRIM(lafiles(lncounter,1)),ALLTRIM(lafiles(lncounter,5)))
ENDIF
ENDFOR
ENDIF
IF lndirs>0
FOR lncounter = 1 TO ALEN(ladirs,1)
IF ladirs(lncounter,1)<>"." AND ladirs(lncounter,1)<>".."
IF !DIRECTORY(lccopy+"\"+ladirs(lncounter,1))
INSERT INTO sync(ctype,csource,ccopy);
VALUES
("D","",ALLTRIM(lccopy)+"\"+ALLTRIM(ladirs(lncounter,1)))
ENDIF
=proc_sync(lcsource+"\"+ladirs(lncounter,1),lccopy+"\"+ladirs(lncounter,1))
ENDIF
ENDFOR
ENDIF
IF llcopies
IF lncopies>0
FOR lncounter = 1 TO ALEN(lacopies,1)
lcaction=""
lnresult=ASCAN(lafiles,lacopies(lncounter,1),-1,-1,1,1)
IF lnresult=0
lcaction="X"
ENDIF
IF !EMPTY(lcaction)
INSERT INTO sync (ctype,csource,ccopy,cAttribs);
VALUES
(lcaction,"",ALLTRIM(lccopy)+"\"+ALLTRIM(lacopies(lncounter,1)),ALLTRIM(laco
pies(lncounter,5)))
ENDIF
ENDFOR
ENDIF
ENDIF
IF llcopies
IF lnlocdirs>0
FOR lncounter = 1 TO ALEN(lalocdirs,1)
lcaction=""
lnresult=ASCAN(ladirs,lalocdirs(lncounter,1),-1,-1,1,1)
IF lnresult=0
lcaction="Z"
ENDIF
IF !EMPTY(lcaction)
INSERT INTO sync (ctype,csource,ccopy);
VALUES
(lcaction,"",ALLTRIM(lccopy)+"\"+ALLTRIM(lalocdirs(lncounter,1)))
ENDIF
endfor
endif
endif
CD (lchome)
RETURN
PROCEDURE SetFileAttribs
LPARAMETERS pcFile, pcAttr
* Author: William GC Steinford 2003
* Takes a file and a list of attributes to change on the file, and does the
change
*
* pcFile : either just the file name or the full path to the file.
* Either way, the full path will be resolved using FULLPATH()
* pcAttrs : a list of attributes to change on the file
* if the attribute character is Uppercase it will be turned on,
* Lowercase, it will be turned off,
* Not listed, it will be left alone.
* a,A - Archive
* s,S - System
* h,H - Hidden
* r,R - Read Only
* i,I - Not Content-Indexed
* t,T - Temporary Storage (try to keep in memory)
* N - Normal (clear all other attributes)
*!* BOOL SetFileAttributes(
*!* LPCTSTR lpFileName, // file name
*!* DWORD dwFileAttributes // attributes
*!* )
*!* DWORD GetFileAttributes(
*!* LPCTSTR lpFileName // name of file or directory
*!* )
#define FILE_ATTRIBUTE_READONLY 0x00000001
#define FILE_ATTRIBUTE_HIDDEN 0x00000002
#define FILE_ATTRIBUTE_SYSTEM 0x00000004
#define FILE_ATTRIBUTE_DIRECTORY 0x00000010
#define FILE_ATTRIBUTE_ARCHIVE 0x00000020
#define FILE_ATTRIBUTE_ENCRYPTED 0x00000040
#define FILE_ATTRIBUTE_NORMAL 0x00000080
#define FILE_ATTRIBUTE_TEMPORARY 0x00000100
#define FILE_ATTRIBUTE_SPARSE_FILE 0x00000200
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#define FILE_ATTRIBUTE_COMPRESSED 0x00000800
#define FILE_ATTRIBUTE_OFFLINE 0x00001000
#define FILE_ATTRIBUTE_NOT_CONTENT_INDEXED 0x00002000
DECLARE INTEGER GetFileAttributes IN kernel32;
STRING lpFileName
DECLARE SHORT SetFileAttributes IN kernel32;
STRING lpFileName,;
INTEGER dwFileAttributes
LOCAL lcFile, lnAttr, lcAttr, laDir[1]
lcFile = FULLPATH(pcFile)
* File() doesn't see Hidden or system files: if NOT FILE(pcFile)
IF adir(laDir,lcFile,'DHS')=0
RETURN .F.
endif
lcAttr = upper(pcAttr)
if 'N' $ pcAttr
* "NORMAL" must be used alone.
lnRes = SetFileAttributes(lcFile,FILE_ATTRIBUTE_NORMAL)
RETURN (lnRes<>0)
endif
lnAttr = GetFileAttributes( lcFile )
* These attributes Can't be set using SetFileAttributes:
lnAttr = BitAnd( lnAttr, BitNot( FILE_ATTRIBUTE_COMPRESSED ;
+ FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_ENCRYPTED ;
+ FILE_ATTRIBUTE_REPARSE_POINT ;
+ FILE_ATTRIBUTE_SPARSE_FILE ) )
if 'A' $ lcAttr
if 'A' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_ARCHIVE )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_ARCHIVE) )
endif
endif
if 'R' $ lcAttr
if 'R' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_READONLY )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_READONLY) )
endif
endif
if 'H' $ lcAttr
if 'H' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_HIDDEN )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_HIDDEN) )
endif
endif
if 'S' $ lcAttr
if 'S' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_SYSTEM )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_SYSTEM) )
endif
endif
if 'I' $ lcAttr
if 'I' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_NOT_CONTENT_INDEXED )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_NOT_CONTENT_INDEXED) )
endif
endif
if 'T' $ lcAttr
if 'S' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_TEMPORARY )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_TEMPORARY) )
endif
endif
if 'N' $ lcAttr
lnAttr = iif('N'$pcAttr, FILE_ATTRIBUTE_NORMAL, lnAttr )
endif
lnRes = SetFileAttributes(lcFile,lnAttr)
RETURN (lnRes<>0)
FUNCTION GetFileAttrib( tcFName )
*GetFileAttrib( cFName ) Return the File Attributes (RSHA)
*!* DWORD GetFileAttributes(
*!* LPCTSTR lpFileName // name of file or directory
*!* )
DECLARE LONG GetFileAttributes IN Win32Api AS util_GetFileAttributes ;
STRING LPCTSTR_lpFileName
LOCAL lnAttr, lcAttr
lnAttr = util_GetFileAttributes( tcFName )
CLEAR DLLS util_GetFileAttributes
if lnAttr=0xFFFF
RETURN 'error'
ENDIF
lcAttr = iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_READONLY )>0, 'R', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_HIDDEN )>0, 'H', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_SYSTEM )>0, 'S', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_ARCHIVE )>0, 'A', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_DIRECTORY)>0, 'D', '' )
RETURN lcAttr
ENDFUNC
************************ end ******************************
_______________________________________________
Post Messages to: [email protected]
Subscription Maintenance: http://leafe.com/mailman/listinfo/profox
OT-free version of this list: http://leafe.com/mailman/listinfo/profoxtech
** All postings, unless explicitly stated otherwise, are the opinions of the
author, and do not constitute legal or medical advice. This statement is added
to the messages for those lawyers who are too stupid to see the obvious.
