Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Ftp uploading with progress dialog or callback function
This is for older QM versions. In QM and later, use functions SetProgressDialog and/or SetProgressCallback.

Note 1. The first two must be member functions (use menu File -> New -> New Member Function).
Note 2. Don't click http://Ftp.FilePutWithProgress. It is not a link. It was added by the forum software because begins with ftp.

1. Fixed bug that prevented uploading multiple files on single connection.
2. ftpfile now is optional.
3. ifexists and ascii arguments joined into single flags argument.

Member function http://Ftp.FilePutWithProgress
Copy      Help
function# $localfile [$ftpfile] [flags]

;Uploads localfile to ftp server. The same as Ftp.FilePutWithCallback, but shows progress dialog.
;Returns 1 on success, -1 on Cancel. On failure returns 0.

;See also: <Ftp.FilePutWithCallback>

;Ftp f.Connect("" "user" "password")
;if(!f.FilePutWithProgress("$desktop$\test.exe" "" 3)) mes- "failed"

str controls = "4"
str e4
int h=ShowDialog("" 0 &controls 0 1)
int r=FilePutWithCallback(localfile ftpfile flags &Ftp_FilePutProgressCb h)
clo h; err
ret r

;0 "" 0x10C80A44 0x100 0 0 194 68 "QM - Ftp Upload"
;3 msctls_progress32 0x54000000 0x4 6 34 184 12 ""
;2 Button 0x54030000 0x0 68 50 48 14 "Cancel"
;4 Edit 0x54030880 0x0 6 6 184 12 ""
;5 Static 0x54000000 0x0 6 20 184 13 "Preparing to upload..."
;DIALOG EDITOR: "" 0x202000B "" ""

Member function http://Ftp.FilePutWithCallback
Copy      Help
function# $localfile [$ftpfile] [flags] [fa] [fparam] ;;flags: 1 fail if exists, 2 don't check if exists, 3 msgbox if exists, 4 ascii

;Uploads localfile to ftp server. Similar to Ftp.FilePut, but here you can use a callback function.
;Returns 1 on success, -1 on cancel (if callback function returns 1). On failure returns 0.

;localfile - file to upload.
;ftpfile - destination file. If "", gets filename from localfile.
;;;0-3 - what to do if the file already exists: 0 delete, 1 fail, 2 don't check (faster), 3 message box.
;;;4 - use ASCII mode. By default, uses binary mode.
;fa - address of callback function that will be called repeatedly while uploading. Can be used to show progress.
;;;function# nbAll nbRead fparam
;;;;;nbAll - file size.
;;;;;nbRead - the number of bytes uploaded so far.
;;;Return value: 0 continue, 1 cancel.
;fparam - some value to pass to the callback function.

if(!dir(localfile)) ret
if(!len(ftpfile)) ftpfile=_s.getfilename(localfile 1)
if(flags&3!=2 and Dir(ftpfile))
,,case 0 FileDel(ftpfile)
,,case 1 out "%s already exists" ftpfile; ret
,,case 3 if(mes("%s[][]This file already exists on the FTP server. Overwrite?" "" "OC!" ftpfile)='O') FileDel(ftpfile); else ret -1

int hi=inet.FtpOpenFile(m_hi ftpfile GENERIC_WRITE iif(flags&4 inet.FTP_TRANSFER_TYPE_ASCII inet.FTP_TRANSFER_TYPE_BINARY) 0)
if(!hi) goto e

__HFile hfile.Create(localfile OPEN_EXISTING GENERIC_READ FILE_SHARE_READ); err out _error.description; ret
int fsize=GetFileSize(hfile 0)
if(fa and call(fa fsize 0 fparam))
,inet.InternetCloseHandle hi
,ret -1

int wrfile size size2 bufsize(2*1024)
str buf.all(bufsize)
for wrfile 0 fsize 0
,if(!ReadFile(hfile buf bufsize &size 0)) ret
,if(!inet.InternetWriteFile(hi buf size &size2) or size2!=size) goto e
,if(fa and call(fa fsize wrfile fparam))
,,inet.InternetCloseHandle hi
,,ret -1

inet.InternetCloseHandle hi
ret 1
if(hi) inet.InternetCloseHandle hi

Function Ftp_FilePutProgressCb
Copy      Help
function# nbAll nbRead hDlg

if(!IsWindow(hDlg)) ret 1 ;;Cancel
str s.format("%i KB / %i KB" nbRead/1024 nbAll/1024); s.setwintext(id(5 hDlg))
SendMessage id(3 hDlg) PBM_SETPOS nbRead*100L/nbAll 0

Example of uploading all files from a folder, not including subfolders, skipping files >=1MB.
Copy      Help
Ftp f.Connect("" "user" "password")
Dir d
foreach(d "$Desktop$\*" FE_Dir)
,str sPath=d.FileName(1)
,if(d.FileSize>=1024*1024) continue
,;out sPath
,if(!f.FilePutWithProgress(sPath "" 2)) mes- "failed"
thanks for this nice prototype.

Forum Jump:

Users browsing this thread: 1 Guest(s)