I have 2 problems with the code below!
1.
I would like that the app copies immediatly after opening without the COPY button. When I try to remove it and add the code for the copy process under a CASE @IDINITDIALOG then the WINDOW appears after the copy process.
How can I avoid that? It does not make sense to show the progress afterwards.
(I used a different location for copying to make sure that the copy process is not too short until the WINDOW got time to load.)
2.
I would like to change the RICHTEXT STATUS to a ProgressBar but what ever I tried it just did not work.
Any suggestions?
QuoteCONST CSIDL_LOCAL_APPDATA = 0x001c
CONST CSIDL_COMMON_DOCUMENTS = 0x2e
WINDOW dummy
'-----------------------------------------------------------------
'GetFolderLocation
'Helper sub for getting the path of a system folder from a CSIDL value
'-----------------------------------------------------------------
DECLARE "shell32",SHGetSpecialFolderLocation(HWND:INT,nFolder:INT,LPITEMIDLIST:POINTER),int
DECLARE "shell32",SHGetPathFromIDList(ITEMIDLIST:INT,PATH:STRING),int
DECLARE "ole32",CoTaskMemFree(pidl:int)
DEF count:INT
DEF overwrite, fail:INT
DEF source, destiny:STRING
'initial source and destiny directory
source = GetFolderLocation(dummy, CSIDL_LOCAL_APPDATA) + "\\Microsoft\\Outlook"
destiny = "C:\\Outlook"
'create constants for all controls
CONST lblSource = 5
CONST editSource = 6
CONST lblDestiny = 7
CONST editDestiny = 8
CONST chkOverwrite = 9
CONST btnCopy = 10
CONST lblProgress = 11
CONST editProgress = 12
'create a dialog with controls
DEF main:DIALOG
CREATEDIALOG main, 100,100,520,360, @MINBOX | @SYSMENU | @CAPTION, 0, "Recursively copy directory", &handlerMain
CONTROL main, @STATIC, "Source:", 20, 20, 60,20, 0, lblSource
CONTROL main, @EDIT, source, 80, 20, 400,20, @TABSTOP | @CTEDITAUTOH, editSource
CONTROL main, @STATIC, "Destiny:", 20, 50, 60,20, 0, lblDestiny
CONTROL main, @EDIT, destiny, 80, 50, 400,20, @TABSTOP | @CTEDITAUTOH, editDestiny
CONTROL main, @CHECKBOX, "Overwrite existing files", 80, 80, 140,20, @TABSTOP, chkOverwrite
CONTROL main, @SYSBUTTON, "Copy Directory", 360, 80, 120,28, @TABSTOP, btnCopy
CONTROL main, @STATIC, "Progress:", 20, 135, 60,20, 0, lblProgress
CONTROL main, @RICHEDIT, "", 80, 135, 400,200, @CTEDITMULTI | @CTEDITRO | @VSCROLL | @CTEDITAUTOV | @TABSTOP | @BORDER, editProgress
'show the dialog
DOMODAL main
'end the program
END
'________________________________________________________________________
SUB handlerMain
'handler for the main dialog
SELECT @MESSAGE
CASE @IDINITDIALOG
CASE @IDCLOSEWINDOW
'close the window
CLOSEWINDOW Main
CASE @IDCONTROL
SELECT @CONTROLID
CASE btnCopy
'get the entered source and destiny folders
source = GETCONTROLTEXT main, editSource
destiny = GETCONTROLTEXT main, editDestiny
overwrite = GETSTATE main, chkOverwrite
IF overwrite=True THEN fail=False ELSE fail=True :'(if fail=false existing files will be overwritten)
'copy the directory
count = copydir(main, editProgress, source, destiny, fail)
addInfoLine(main, editProgress, "")
addInfoLine(main, editProgress, "Ready." + STR$(count) + " files copied.")
ENDSELECT
ENDSELECT
RETURN
ENDSUB
'________________________________________________________________________
SUB addInfoLine(win:WINDOW, ctl:INT, text:STRING)
'add a line with info to the editbox
DEF length:INT
SETFOCUS win, ctl
'get the length of the content of the richedit
length = CONTROLCMD win, ctl, @RTGETTEXTLENGTH
'place the cursor at the end of the sheet
CONTROLCMD win, ctl, @RTSETSELECTION, length, length
'insert a Return and the new text
CONTROLCMD win, ctl, @RTREPLACESEL, "\n" + text
'give the CPU some space
WAIT 1
RETURN
ENDSUB
'________________________________________________________________________
SUB copydir(win:WINDOW, ctl:INT, sourcepath:STRING, destinypath:STRING, fail:INT),INT
'copy all files and subdirectories from sourcepath to destinypath
'for example sourcepath="C:\\test" and destinypath="G:\\test"
'if fail=false then existing files will be overwritten
DEF count:INT
DEF dir,attrib:INT
DEF filename:STRING
DEF fullname:STRING
count = 0
IF RIGHT$(sourcepath,1) <>"\\" THEN sourcepath+="\\"
IF RIGHT$(destinypath,1) <>"\\" THEN destinypath+="\\"
'first make the destiny directory
mkDir(destinypath)
dir = FINDOPEN(sourcepath + "*.*")
IF(dir)
DO
filename = FINDNEXT(dir,attrib)
IF filename<>""
IF attrib & @FILE_DIRECTORY
'this is a directory
IF(filename <> ".") & (filename <> "..")
newsourcepath = sourcepath + filename
newdestinypath = destinypath + filename
count = count + copydir(win, ctl, newsourcepath, newdestinypath, fail)
ENDIF
ELSE
'this is a file
IF COPYFILE(sourcepath + filename, destinypath + filename, fail)
'copying file succeeded
addInfoLine(win, ctl, destinypath + filename)
ELSE
'copying file was not succesfull
addInfoLine(win, ctl, destinypath + filename + " [failed]")
ENDIF
count = count + 1
ENDIF
ENDIF
'the exit case is when there are no more entries
'in the current directory
UNTIL filename = ""
FINDCLOSE dir
ENDIF
RETURN count
ENDSUB
'________________________________________________________________________
SUB MkDir(path:STRING)
'make a directory
'Each level will be created individually
DEF lowerpath:STRING
DEF pos, lastpos:INT
'find the last slash "\" in the path
lastpos=0
pos=0
DO
pos = INSTR(path, "\\", pos+1)
IF pos THEN lastpos = pos
UNTIL pos=0
IF lastpos
'first make the lower level directory
lowerpath = LEFT$(path, lastpos-1)
MkDir(lowerpath)
ENDIF
CREATEDIR path
RETURN
ENDSUB
'--------------------------------------------------------------------------
SUB GetFolderLocation(win:WINDOW,nFolder:INT),STRING
DEF path:STRING
DEF pidl:INT
DEF ppidl:POINTER
ppidl = pidl
SHGetSpecialFolderLocation(win.hwnd,nFolder,ppidl)
SHGetPathFromIDList(pidl,path)
CoTaskMemFree(pidl)
RETURN path
ENDSUB