Home » Pages » Visual Foxpro

File operations with Progressbar

By Sergey - Posted on February 11th, 2008
Tagged:

It's based on the late Ed Rauh's code that uses SHFileOperation Win API and requires his Heap allocation class. It supports wild cards and shows standard Windows progress bar.

This is sample code. Add error handling and adjust to your requirements as necessary.

&& Copy file to different name
llSuccess = FileOpWithProgressbar("H:\TEMP\tord.dbf", "H:\TMP\TEST.dbf", "Copy")
&& Copy with the same name
llSuccess = FileOpWithProgressbar("H:\TEMP\tord.dbf", "H:\TMP\", "Copy")
&& Copy all dbf's
llSuccess = FileOpWithProgressbar("H:\TEMP\*.dbf", "H:\TMP\", "Copy")

&& FUNCTION FileOpWithProgressbar
&& The SHFileOperation.h is posted at the bottom of the page
#INCLUDE SHFileOperation.h
 
LPARAMETERS tcSource, tcDestination, tcAction, tlUserCanceled
LOCAL lcSourceString, lcDestString, nStringBase, lcFileOpStruct, lnFlag, lnStringBase
LOCAL loHeap, lcAction, lnRetCode, llCanceled, laActionList[1]
 
DECLARE INTEGER SHFileOperation IN SHELL32.DLL STRING @ LPSHFILEOPSTRUCT
&& Heap allocation class
SET PROCEDURE TO CLSHEAP ADDITIVE
loHeap = CREATEOBJ('Heap')
 
lcAction = UPPER(IIF( Empty( tcAction) Or VarType(tcAction) <> "C", "COPY", tcAction))
&& Convert Action name into function parameter
ALINES(laActionList, "MOVE,COPY,DELETE,RENAME", ",")
lnAction = ASCAN(laActionList, lcAction)
IF lnAction = 0
	&& Unknown action
	RETURN Null
ENDIF
 
lcSourceString = tcSource + CHR(0) + CHR(0)
lcDestString   = tcDestination + CHR(0) + CHR(0)
lnStringBase   = loHeap.AllocBlob(lcSourceString+lcDestString)
 
lnFlag = FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI
 
lcFileOpStruct  = NumToLONG(_screen.hWnd) + ;
                NumToLONG(lnAction) + ;
                NumToLONG(lnStringBase) + ;
                NumToLONG(lnStringBase + LEN(lcSourceString)) + ;
                NumToWORD(lnFlag) + ;
                NumToLONG(0) + NumToLONG(0) + NumToLONG(0)
 
lnRetCode = SHFileOperation(@lcFileOpStruct) 
 
&& Did user canceled operation?
tlUserCanceled= ( SUBSTR(lcFileOpStruct, 19, 4) <> NumToLONG(0) )
 
RETURN (lnRetCode = 0)

SHFileOperation.h
&& Shell File Operations
 
#DEFINE FO_MOVE           0x0001
#DEFINE FO_COPY           0x0002
#DEFINE FO_DELETE         0x0003
#DEFINE FO_RENAME         0x0004
 
#DEFINE FOF_MULTIDESTFILES         0x0001
#DEFINE FOF_CONFIRMMOUSE           0x0002
#DEFINE FOF_SILENT                 0x0004  && don't create progress/report
#DEFINE FOF_RENAMEONCOLLISION      0x0008
#DEFINE FOF_NOCONFIRMATION         0x0010  && Don't prompt the user.
#DEFINE FOF_WANTMAPPINGHANDLE      0x0020  && Fill in SHFILEOPSTRUCT.hNameMappings
		                                      && Must be freed using SHFreeNameMappings
#DEFINE FOF_ALLOWUNDO              0x0040  && DELETE - sends the file to the Recycle Bin
#DEFINE FOF_FILESONLY              0x0080  && on *.*, do only files
#DEFINE FOF_SIMPLEPROGRESS         0x0100  && don't show names of files
#DEFINE FOF_NOCONFIRMMKDIR         0x0200  && don't confirm making any needed dirs
#DEFINE FOF_NOERRORUI              0x0400  && don't put up error UI
#DEFINE FOF_NOCOPYSECURITYATTRIBS  0x0800  && dont copy NT file Security Attributes
#DEFINE FOF_NORECURSION            0x1000  && don't recurse into directories.

If you call this code twice
By rvc44 (not verified) - Posted on February 15th, 2008

If you call this code twice or more you can change line

SET PROCEDURE TO CLSHEAP ADDITIVE

to next code

If AT("CLSHEAP", SET("PROCEDURE")) = 0  
    SET PROCEDURE TO CLSHEAP ADDITIVE
EndIf

When I have downloaded Ed
By rvc44 (not verified) - Posted on February 15th, 2008

When I have downloaded Ed Rauh's class clsheap.zip created on 30-sep-2000 from link above I run this example for copying my big folder

llSuccess = FileOpWithProgressbar("C:\R33\DBF\*.*", "C:\public\17\DBF2\", "Copy")

Destination folder DBF2 must exist for succesfully result!
I create it before running this code.
When I run this code my folder was copied correctly, but standard Windows progress was not showing on my Windows XP SP2 system and I become no errror messages. Why?