Ftp uploading with progress dialog or callback function

[Gintaras]

This is for older QM versions. In QM 2.3.2.7 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 Ftp.FilePutWithProgress. It is not a link. It was added by the forum software because begins with ftp.

07/04/2007
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 Ftp.FilePutWithProgress

Code:

Copy      Help

;\Dialog_Editor
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>

;EXAMPLE
;Ftp f.Connect("ftp.mysite.com" "user" "password")
;f.DirSet("public_html")
;if(!f.FilePutWithProgress("$desktop$\test.exe" "" 3)) mes- "failed"


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

;BEGIN DIALOG
;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..."
;END DIALOG
;DIALOG EDITOR: "" 0x202000B "" ""


Member function Ftp.FilePutWithCallback

Code:

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.
;flags:
;;;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
;;;Arguments:
;;;;;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))
,sel(flags&3)
,,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
,wrfile+size2
,if(fa and call(fa fsize wrfile fparam))
,,inet.InternetCloseHandle hi
,,FileDel(ftpfile)
,,ret -1
,0

inet.InternetCloseHandle hi
ret 1
;e
if(hi) inet.InternetCloseHandle hi
Error

Function Ftp_FilePutProgressCb

Code:

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.

Code:

Copy      Help

Ftp f.Connect("ftp.mysite.com" "user" "password")
f.DirSet("public_html/testqmftp")
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"

[_pi]

thanks for this nice prototype.