The results of my question in the forum about a working FTP Client Code is now available on my PureBasic page.
Code: Select all
; FTP File Exchanger for transferring files via FTP protocol
; written by Terry Hough, updated 05/20/2003
; Many thanks for code, ideas, examples, etc. to Fweil, Freak, PB, Paul,
; Danillo and others on the PureBasic Forum.
h=LoadLibrary_("Shell32.dll")
#MCM_GETCURSEL = $1001
#DTM_SETSYSTEMTIME = $1002
#MAX_PATH = 260
#FILE_ATTRIBUTE_READONLY = 1
#FILE_ATTRIBUTE_HIDDEN = 2
#FILE_ATTRIBUTE_SYSTEM = 4
#FILE_ATTRIBUTE_DIRECTORY = 16
#FILE_ATTRIBUTE_ARCHIVE = 32
#FILE_ATTRIBUTE_NORMAL = 128
#FILE_ATTRIBUTE_TEMPORARY = 256
#FILE_ATTRIBUTE_COMPRESSED = 2048
#NO_ERROR = 0
#ERROR_NO_MORE_FILES = 18
#ERROR_INTERNET_EXTENDED_ERROR = 12003
#FTP_TRANSFER_TYPE_BINARY = 2
#INTERNET_OPEN_TYPE_DIRECT = 1
#INTERNET_DEFAULT_FTP_PORT = 21
#INTERNET_SERVICE_FTP = 1
#INTERNET_SERVICE_PASSIVE = $8000000 ;expressed in hex: 134217728 as decimal
Structure PB_FIND_DATA
FileAttributes.l
CreationTimeL.l
CreationTimeH.l
LastAccessTimeL.l
LastAccessTimeH.l
LastWriteTimeL.l
LastWriteTimeH.l
FileSizeHigh.l
FileSizeLow.l
OID.l
FileName.s[#MAX_PATH]
EndStructure
Define.WIN32_FIND_DATA PB_FIND_DATA
; --------------------------------------------------------------------------
; The following structure is passed to the GetFileFTP thread procedure
; so that the variables can be shared between the main progam and the thread.
; --------------------------------------------------------------------------
Structure Get_FTP
I.w
FilesToSend.w
FilesToGet.w
FileSizeTotal.l
RecvFiles.w
ArchFiles.w
ArchiveDnLoads.s
ArchiveUpLoads.s
SentBytes.l
FilesSent.w
SendFailed.b
RecvFailed.b
RecvBytes.l
Bytes.l
FileName.s
FTPUploadDir.s
FTPDnloadDir.s
FileToRecv.s
FileToSend.s
hInternetConnect.l
ThreadActive.b
EndStructure
; ---------------------------------------------------------------------------
; Support procedures follow
; ---------------------------------------------------------------------------
; --------------------------------------------------------------------------
; Threaded procedure to Get (Receive) files via FTP
; --------------------------------------------------------------------------
Procedure GetFileFTP(*p.Get_FTP)
If FtpGetFile_(*p\hInternetConnect, *p\FileName, *p\FileToRecv, 0, #FILE_ATTRIBUTE_NORMAL, #FTP_TRANSFER_TYPE_BINARY,0)
*p\RecvBytes = *p\RecvBytes + *p\Bytes ; Accum bytes received
*p\RecvFiles = *p\RecvFiles + 1 ; Accum files received
If *p\ArchiveDnLoads = "Y"
; Yes, the option is turned on, so archive the file at the host.
; This is done by renaming the host's file to a different
; directory. Note: Some FTP servers have problems with this.
; First, delete the file from the archive area if it already exists there
If FtpDeleteFile_(*p\hInternetConnect,"SENT/"+*p\FileName)
; It was successfully deleted from the archive area.
EndIf
If FtpRenameFile_(*p\hInternetConnect, *p\FileName, "SENT/"+*p\FileName)
; File was "archived" in the SENT directory at the host.
*p\ArchFiles = *p\ArchFiles + 1
Else
; Drat! That failed, so report it with the error code.
MessageRequester("Error","Can't archive this file: "+*p\FileName + Str(GetLastError_()),0)
EndIf
EndIf
Else
; Drat! That failed, so try to delete it in the archive directory and try again.
MessageRequester("Error","Can't receive this file: "+*p\FileToRecv + " " + Str(GetLastError_()),0)
*p\RecvFailed = 1 ; Set the failure flag
EndIf
*p\ThreadActive = 1 ; Set the flag to be returned
ProcedureReturn *p\ThreadActive ; to indicate the thread has ended.
EndProcedure
; --------------------------------------------------------------------------
; Threaded procedure to Put (Send) files via FTP
; --------------------------------------------------------------------------
Procedure PutFileFTP(*p.Get_FTP)
If FtpPutFile_(*p\hInternetConnect, *p\FileToSend, *p\FileName, 0, 0)
*p\SentBytes = *p\SentBytes + *p\Bytes ; Accum bytes sent
*p\FilesSent = *p\FilesSent + 1 ; Accum files sent
TextGadget(08, 20, 90, 300, 20, "Uploaded "+Str(*p\FilesSent)+" files to the host: " + Str(*p\SentBytes) + " bytes")
; Optionally delete the file at the Host when successfully received
If DeleteFile(*p\FileToSend)
; It was successfully deleted.
Else
MessageRequester("Error","Can't delete this sent file: "+*p\FileToSend,0)
EndIf
Else
; Oops! The file send failed... report it with the error code.
MessageRequester("Error","Can't send this file: "+*p\FileToSend + Str(GetLastError_()),0)
*p\SendFailed = 1
EndIf
*p\ThreadActive = 1 ; Set the flag to be returned
ProcedureReturn *p\ThreadActive ; to indicate the thread has ended.
EndProcedure
; --------------------------------------------------------------------------
; Procedure to request input from the user via the keyboard
; --------------------------------------------------------------------------
Procedure.s InputRequesterS(lTitle.s, lDefault.s, casechange.w)
; Constants are set for possible integration
#InputRequesterSWID = 99
#InputRequesterSGID = 198
lXSize.l = 200
lYSize.l = 25
; GetSystemMetrics_ API function gives access to screen dimensions
If OpenWindow(#InputRequesterSWID, (GetSystemMetrics_(#SM_CXSCREEN) - lXSize) / 2, (GetSystemMetrics_(#SM_CYSCREEN) - lYSize) / 2, lXSize + 40, lYSize, lTitle,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
AddKeyboardShortcut(#InputRequesterSWID, #PB_Shortcut_Return, 10)
AddKeyboardShortcut(#InputRequesterSWID, #PB_Shortcut_Escape, 99)
; If CreateGadgetList(WindowID(#InputRequesterSWID))
StringGadget(#InputRequesterSGID, 2, 2, lXSize - 4, lYSize - 5, lDefault)
ButtonGadget(#InputRequesterSGID + 1, lXSize + 5, lYSize - 25, 30, 20, "OK")
SetActiveGadget(#InputRequesterSGID)
; EndIf
lResult.s = GetGadgetText(#InputRequesterSGID)
lQuit.l = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
lQuit = #True
Case #PB_Event_Menu
Select EventMenu()
Case 10
lResult = GetGadgetText(#InputRequesterSGID)
lQuit = #True
Case 99
lQuit = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case (#InputRequesterSGID + 1)
lResult = GetGadgetText(#InputRequesterSGID)
lQuit = #True
EndSelect
EndSelect
Until lQuit
RemoveKeyboardShortcut(#InputRequesterSWID, #PB_Shortcut_All)
CloseWindow(#InputRequesterSWID)
If casechange = 1
lResult = UCase(lResult)
ElseIf casechange = 2
lResult = LCase(lResult)
EndIf
EndIf
ProcedureReturn lResult
EndProcedure
; ---------------------------------------------------------------------------
; End of Support procedures
; ---------------------------------------------------------------------------
File.Get_FTP ; set up structure for global use
lvc.LV_COLUMN ; set up structure for global use
lvc\mask = #LVCF_FMT
lvc\fmt = #LVCFMT_RIGHT
DefaultUser.s = "########"
DefaultPass.s = "########"
; --------------------------------------------------------------------------
; Create / Read the .INI file
; --------------------------------------------------------------------------
ReCreateTheINIFile:
; See if an INI file exists. If not, create a default one.
If FileSize("FTPXCHG.INI") = -1
If CreatePreferences("FTPXCHG.INI")
PreferenceGroup("FTPXCHG.INI")
WritePreferenceString("Username", DefaultUser)
WritePreferenceString("Password", DefaultPass)
PreferenceGroup("FTP")
; edit the 2nd parameter in each of the following for your info
; enter the title of the host
WritePreferenceString("HostDescription", "PureBasic FTP Center")
; enter the URL or IP Address of the host
WritePreferenceString("IPAddress", "82.64.19.146")
; OR WritePreferenceString("IPAddress", "ftp.ftpserver.com") to use URL
; enter the port to use, normally 21 for FTP servers
WritePreferenceString("Port", "21")
; turn logging on or off, not implemented in this version
WritePreferenceString("Logging", "Y")
; enter the directory where the files to be uploaded reside locally
WritePreferenceString("FTPUploadDir", "\up\send")
; enter the directory where downloaded files are to be placed
WritePreferenceString("FTPDnloadDir", "\up\receive")
; enter your choice for the window title
WritePreferenceString("WindowCaption", "FTP File Exchanger")
; turn uploads archiving on or off (Y/N)
WritePreferenceString("ArchiveUpLoads", "Y")
; turn downloads archiving on or off (Y/N)
WritePreferenceString("ArchiveDnLoads", "Y")
PreferenceComment(" ")
PreferenceComment(" This is a default INI file created by FTP File Exchange.")
ClosePreferences()
EndIf
EndIf
; -------------------- Created a default INI file --------------------------
; -------- Read the EFREMOTE.INI file to get the preferences setup ---------
OpenPreferences("FTPXCHG.INI")
PreferenceGroup("FTPXCHG.INI")
Username.s = ReadPreferenceString("Username", "")
Password.s = ReadPreferenceString("Password", "")
PreferenceGroup("FTP")
HostDescription.s = ReadPreferenceString("HostDescription", "")
IPAddress.s = ReadPreferenceString("IPAddress", "")
Port.s = ReadPreferenceString("Port", "")
Logging.s = ReadPreferenceString("Logging", "")
File\FTPUploadDir = ReadPreferenceString("FTPUploadDir", "")
File\FTPDnloadDir = ReadPreferenceString("FTPDnloadDir", "")
WindowCaption.s = ReadPreferenceString("WindowCaption", "")
File\ArchiveUpLoads = ReadPreferenceString("ArchiveUpLoads", "")
File\ArchiveDnLoads = ReadPreferenceString("ArchiveDnLoads", "")
RereadFlag.w = 0 ; Zero the Reread flag
If Username = "########" Or Username = ""
; Prompt for the Username
DefaultUser = InputRequesterS("Enter your Username", "", 1)
RereadFlag = 1 ; Set the flag
EndIf
If Password = "########" Or Password = ""
; Prompt for the Password
DefaultPass = InputRequesterS("Enter your Password", "", 1)
RereadFlag = 1 ; Set the flag
EndIf
ClosePreferences()
If RereadFlag = 1
DeleteFile("FTPXCHG.INI") ; Delete the INI file
Goto ReCreateTheINIFile ; and go recreate it.
EndIf
; --------------------------------------------------------------------------
; End of reading the .INI file to use to setup the program
; --------------------------------------------------------------------------
; --------------------------------------------------------------------------
; Start the main program here
; --------------------------------------------------------------------------
; ------------------------ Create a centered window ------------------------
hwnd=OpenWindow(0, 120, 133, 530, 350, WindowCaption, #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
; CreateGadgetList(WindowID())
; -------------------- Add an icon to the System Tray ----------------------
AddSysTrayIcon(1, WindowID(0), LoadIcon_(0, #IDI_WINLOGO))
ChangeSysTrayIcon (1, LoadImage(0, "Lightnin.ico"))
SysTrayIconToolTip(1, "File Exchange")
; --------------------------------------------------------------------------
; ---------------------- Show an image on the window -----------------------
TextGadget(17, 346, 286, 100, 15, "Powered by")
UseJPEGImageDecoder()
LoadImage(01, "purebasic.jpg")
ImageGadget(02, 346, 300, 30, 30, ImageID(1))
; --------------------------------------------------------------------------
; ----------------- Create an animation area on the window------------------
AniWin=CreateWindowEx_(0,"SysAnimate32","",#ACS_AUTOPLAY|#ACS_CENTER|#ACS_TRANSPARENT|#WS_CHILD|#WS_VISIBLE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS,030,288,280, 50, hwnd,0,GetModuleHandle_(0),0)
; --------------------------------------------------------------------------
; -------------------- Start showing what is going on ----------------------
Date$ = FormatDate("%mm/%dd/%yyyy - %hh:%ii:%ss", Date())
TextGadget(1, 20, 10, 400, 15, "Accessing the " + HostDescription + " - "+Date$)
TextGadget(04, 20, 30, 300, 20, "Trying to connect to " + HostDescription)
; ---------------------- Open an internet connection -----------------------
SendMessage_(AniWin,#ACM_OPEN,h,152) ; show the Search Computer AVI
hInternetSession.l = InternetOpen_("FTP", #INTERNET_OPEN_TYPE_DIRECT, "", "", 0)
If hInternetSession <> 0
; ------------------------ Connect to the FTP server -----------------------
File\hInternetConnect = InternetConnect_(hInternetSession.l, IPAddress, #INTERNET_DEFAULT_FTP_PORT, UserName, Password, #INTERNET_SERVICE_FTP, 0, 0)
If File\hInternetConnect <> 0
RemoteExists=FtpGetFile_(File\hInternetConnect, "EXPIRED.DAT",File\FTPDnloadDir+"\EXPIRED.DAT", 0, #FILE_ATTRIBUTE_NORMAL, #FTP_TRANSFER_TYPE_BINARY,0)
TextGadget(05, 20, 30, 280, 20, "Online with the " + HostDescription)
;---------------------------------------------------------------------
; Prepare to UPLOAD files TO the server.
; Before uploading, each local file may be optionally archived.
; Get the list of Local files.
;---------------------------------------------------------------------
; Create a ListIcon box to show the file list
; ------------------------------------------------------------------
LI=ListIconGadget(40, 330, 25, 180, 80, "File", 100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_CheckBoxes)
AddGadgetColumn(40, 1, "Bytes", 60)
SendMessage_(LI, #LVM_SETCOLUMN, 1, @lvc) ; Right justify column
; ClearGadgetItemList(40) ; Clear the ListIcon box
File\FileSizeTotal = 0 ; Zero the size counter
File\FilesToSend = 0 ; Zero the file counter
; ------------------------------------------------------------------
; Examine the directory and list the files to be sent
; ------------------------------------------------------------------
If ExamineDirectory(0, File\FTPUploadDir, "*.*")
Repeat
FileType = NextDirectoryEntry(0)
If FileType
If FileType = 1 ; it is a file, so list it
File\FileName = DirectoryEntryName(0)
File\Bytes = FileSize(File\FTPUploadDir+"\"+File\FileName)
AddGadgetItem(40, -1, File\FileName+Chr(10)+Str(File\Bytes))
File\FileSizeTotal = File\FileSizeTotal + File\Bytes
File\FilesToSend = File\FilesToSend + 1
EndIf
EndIf
Until FileType = 0
EndIf
; ------------------------------------------------------------------
; List is built, now see if there are files to send
; ------------------------------------------------------------------
If File\FilesToSend = 0
TextGadget(06, 20, 50, 300, 20, "No local files to be sent.")
HideGadget(40,1) ; Hide the ListView box
Goto DownloadEm
Else
; Yes, there are files to send, so change to the host's
; receive directory to prepare for the file(s) upload.
If FtpSetCurrentDirectory_(File\hInternetConnect, "RECEIVE")
Else
MessageRequester("Error","Can't change to the upload directory: RECEIVE" + Str(GetLastError_()),0)
SendFailed.w = 1
EndIf
EndIf
; ------------------------------------------------------------------
; Optionally, archive by copying the files to another directory
; ------------------------------------------------------------------
If File\ArchiveUploads = "Y"
; Yes, the option is turned on, so archive the files now.
TextGadget(06, 20, 50, 300, 20, "Archive the " +Str(File\FilesToSend)+" files to be sent.")
If CopyDirectory(File\FTPUploadDir, File\FTPUploadDir+"\SENT","")
; Copy the files in the directory to the archive directory
Else
MessageRequester("Error","Can't archive this file: "+File\FileName,0)
EndIf
SetGadgetText(06, "Archive the " +Str(File\FilesToSend)+ " files to be sent: Completed.")
EndIf
; ------------------------------------------------------------------
; Finished the optional files archive
; ------------------------------------------------------------------
; ------------------------------------------------------------------
; Upload the files to the Host via FTP
; ------------------------------------------------------------------
; ------------------------------------------------------------------
; Setup the upload progress reporting
; ------------------------------------------------------------------
TextGadget(07, 20, 70, 300, 20, "Upload "+Str(File\FilesToSend)+" files to the host: " + Str(File\FileSizeTotal) + " bytes")
TextGadget(15,1,230,530,15,"Upload Progress",#PB_Text_Center)
ProgressBarGadget(41, 4, 245, 522, 10, 0, 100,#PB_ProgressBar_Smooth)
SetGadgetState(41, 0)
ProgressBarGadget(44,511, 25, 8, 80, 0, 100,#PB_ProgressBar_Smooth|#PB_ProgressBar_Vertical)
SetGadgetState(44, 0)
File\SentBytes = 0 ; Zero the sent counter
File\FilesSent = 0 ; Zero the file counter
File\SendFailed = 0 ; Zero the failure flag
; --------------------------------------------------------------
; Read the files list and send sequentially to the Host via FTP
For I = 0 To File\FilesToSend - 1
SendMessage_(LI,#LVM_ENSUREVISIBLE,I,0)
SetGadgetState(40, I)
While WindowEvent():Wend
File\FileName = GetGadgetItemText(40, I, 0)
File\FileToSend = File\FTPUploadDir+"\"+File\FileName
File\Bytes = FileSize(File\FileToSend)
SendMessage_(AniWin,#ACM_OPEN,h,160) ; show the Files Copy AVI
File\ThreadActive=0 ; Set an thread activity flag
; Get the file using a threaded procedure
Thread1 = CreateThread(@PutFileFTP(),@File)
; Now, wait for the thread to complete
While File\ThreadActive=0:While WindowEvent():Wend:Wend
; WaitThread(Thread1) ; Wait for the thread to complete
; works but stops main program action too.
TextGadget(17, 20, 90, 300, 20, "Uploaded " +Str(File\FilesSent)+" files to the host: " + Str(File\SentBytes) + " bytes")
RedrawWindow_(AniWin,0,0,#RDW_INVALIDATE | #RDW_ERASE)
SetGadgetItemState(40, I, #PB_ListIcon_Checked) ; Check the box when finished
; ----------------------------------------------------------------
; Update the progress information
; ----------------------------------------------------------------
If File\FileSizeTotal
; Yes, we have sent some data, so compute the progress
Progress.w = Round((File\SentBytes / File\FileSizeTotal*100),1)
; and then report it.
SetGadgetState(41, Progress) ; Update horizontal bar
SetGadgetState(44, Progress) ; Update vertical bar
While WindowEvent():Wend ; Make window repaint
EndIf
; ----------------------------------------------------------------
Next
If File\SendFailed
; Drat! Something went wrong, so don't show completion message.
Else
; Success! Show the completion messages and update the window.
SetGadgetText(07, "Upload "+Str(File\FilesSent)+" files to the host: Completed.")
SetGadgetText(15,"Upload Complete")
; HideGadget(40,1) ; Hide the ListView box if desired
; HideGadget(44,1) ; Hide the Vertical Progress bar
While WindowEvent():Wend ; Make window repaint
EndIf
DownloadEm:
; We should still be online, so let's download some files
;---------------------------------------------------------------------
; Prepare to DOWNLOAD files FROM the server.
; After downloading, optionaly archive each remote source file.
;---------------------------------------------------------------------
; Create a ListIcon box to show the file list
;---------------------------------------------------------------------
LI=ListIconGadget(42, 330, 107, 180, 80, "File", 100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_CheckBoxes)
AddGadgetColumn(42, 1, "Bytes", 60)
SendMessage_(LI, #LVM_SETCOLUMN, 1, @lvc)
; ClearGadgetItemList(42) ; Clear the ListIcon box
File\FileSizeTotal = 0 ; Zero the size counter
File\FilesToGet = 0 ; Zero the files counter
; --------------------------------------------------------------------
If File\FilesToSend > 0
; We changed away from the default directory to upload files,
; so we have to change back to the default directory.
If FtpSetCurrentDirectory_(File\hInternetConnect, "..")
; Set back to the default directory.
Else
; Drat! That failed, so report it with the error code.
MessageRequester("Error","Can't change to the root directory: \" + Str(GetLastError_()),0)
EndIf
EndIf
;---------------------------------------------------------------------
; Change the Host's current directory to SEND. That is where the
; files to download should be.
;---------------------------------------------------------------------
If FtpSetCurrentDirectory_(File\hInternetConnect, "SEND")
; Set the Host's cd to the SEND directory
Else
; Drat! That failed, so report it with the error code.
MessageRequester("Error","Can't change to the Send directory: SEND\" + Str(GetLastError_()),0)
EndIf
; --------------------------------------------------------------------
; Get the Host's directory listing to see if there are files
; to be downloaded. If so, create a list of them.
; Here, I want all the entries, but it could be restricted to a file
; type if desired, eg. "*.EXE" to get just the executable files.
; --------------------------------------------------------------------
; Get via FTP the first item from the Host's directory.
;---------------------------------------------------------------------
LShFindFile = FtpFindFirstFile_(File\hInternetConnect, "*.*", @PB_FIND_DATA, 0, 0)
If LShFindFile
; There was at least one entry, so interpret it.
While GetLastError_() <> #ERROR_NO_MORE_FILES And GetLastError_() <> #ERROR_FILE_NOT_FOUND
; Load the stored file information in local specific variables
; -------------------------------------------------------------
LSFileAttributes = PeekL( @PB_FIND_DATA )
LSCreationTimeL = PeekL( @PB_FIND_DATA + 4 )
LSCreationTimeH = PeekL( @PB_FIND_DATA + 8 )
LSLastAccessTimeL = PeekL( @PB_FIND_DATA + 12 )
LSLastAccessTimeH = PeekL( @PB_FIND_DATA + 16 )
LSLastWriteTimeL = PeekL( @PB_FIND_DATA + 20 )
LSLastWriteTimeH = PeekL( @PB_FIND_DATA + 24 )
LSFileSizeHigh = PeekL( @PB_FIND_DATA + 28 )
LSFileSizeLow = PeekL( @PB_FIND_DATA + 32 )
LSOID = PeekL( @PB_FIND_DATA + 36 )
LSFileName.s = PeekS( @PB_FIND_DATA + 44 )
If #FILE_ATTRIBUTE_DIRECTORY & LSFileAttributes
; It is a Directory entry, so ignore it
Else
; It is a File entry, so get all the info
File\FileName = Trim(LSFileName) ; Get the file name
File\Bytes = (LSFileSizeLow + 1024 * LSFileSizeHigh) ; and size
File\FileSizeTotal = File\FileSizeTotal + File\Bytes ; Accum the file size
File\FilesToGet = File\FilesToGet + 1 ; Accum the file count
; Now, store the file name in our list
AddGadgetItem(42, -1, File\FileName+Chr(10)+Str(File\Bytes))
EndIf
; And, ask for the next entry in the directory
InternetFindNextFile_(LShFindFile, @PB_FIND_DATA)
; until there are no more entries.
Wend
InternetCloseHandle_(LShFindFile)
Else
; There were no files meeting the specs to be downloaded.
FilesToGet = 0
EndIf
; --------------------------------------------------------------------
; List is built, now see if there are files to download.
; --------------------------------------------------------------------
If File\FilesToGet = 0
TextGadget(10, 20,130, 300, 20, "No files available on the host to download.")
HideGadget(42,1) ; Hide the ListIcon box
Goto OutAHere
EndIf
; Yes, there are files to download.
; --------------------------------------------------------------------
If File\ArchiveDnloads = "Y"
; Yes, the option is turned on, so report that we will be archiving.
TextGadget(10, 20,130, 300, 20, "Archive the " + Str(File\FilesToGet) + " files to be received from the host.")
EndIf
; --------------------------------------------------------------------
; Download the files from the Host via FTP -----------------
; --------------------------------------------------------------------
; Setup the download progress reporting
; --------------------------------------------------------------------
TextGadget(16,1,257,530,15,"Download Progress",#PB_Text_Center)
ProgressBarGadget(43, 4, 272, 522, 10, 0, 100,#PB_ProgressBar_Smooth)
SetGadgetState(43, 0)
ProgressBarGadget(45,511, 107, 8, 80, 0, 100,#PB_ProgressBar_Smooth|#PB_ProgressBar_Vertical)
SetGadgetState(45, 0)
File\RecvBytes = 0 ; Zero the byte counter
File\RecvFiles = 0 ; Zero the file counter
File\ArchFiles = 0 ; Zero the archive counter
File\RecvFailed = 0 ; Zero the failure flag
TextGadget(11, 20, 150, 300, 20, "Download " + Str(File\FilesToGet) + " files from the host: "+Str(File\FileSizeTotal)+" bytes.")
; --------------------------------------------------------------------
; Read the files list and download sequentially from the Host via FTP
; --------------------------------------------------------------------
For I = 0 To File\FilesToGet - 1
SendMessage_(LI,#LVM_ENSUREVISIBLE,I,0)
SetGadgetState(42, I)
While WindowEvent():Wend
File\FileName = GetGadgetItemText(42, I, 0)
File\Bytes = Val(GetGadgetItemText(42,I,1))
File\FileToRecv = File\FTPDnloadDir+"\"+File\FileName
SendMessage_(AniWin,#ACM_OPEN,h,160) ;FilesCpy.avi
; Go get the file with a threaded procedure
File\ThreadActive=0 ; Set an thread activity flag
Thread1 = CreateThread(@GetFileFTP(),@File)
; Now, wait for the thread to complete
While File\ThreadActive=0:While WindowEvent():Wend:Wend
; WaitThread(Thread1) ; Wait for the thread to complete
; works but stop main program action too.
TextGadget(08, 20, 170, 300, 20, "Downloaded " + Str(File\RecvFiles) + " files from the host: "+Str(File\RecvBytes)+" bytes.")
RedrawWindow_(AniWin,0,0,#RDW_INVALIDATE | #RDW_ERASE)
SetGadgetItemState(42, I, #PB_ListIcon_Checked) ; Check the box when finished
; -------------------- End downloading the file --------------------
; ------------------------------------------------------------------
; Update the progress information
; ------------------------------------------------------------------
If File\FileSizeTotal
; Yes, we have sent some data, so compute the progress
Progress.w = Round((File\RecvBytes / File\FileSizeTotal*100),1)
; and then report it.
SetGadgetState(43, Progress) ; Update horizontal bar
SetGadgetState(45, Progress) ; Update vertical bar
While WindowEvent():Wend ; Make window repaint
EndIf
; ------------------------------------------------------------------
Next
; --------------------------------------------------------------------
; If optionally archiving the files on the host, report it.
If File\ArchiveDnLoads = "Y"
SetGadgetText(10, "Archive the " + Str(File\ArchFiles) + " files received from the host: Completed.")
EndIf
; --------------------------------------------------------------------
; See if successful downloading all the files
If File\RecvFailed
; The downloads were unsuccessful
Else
SetGadgetText(11, "Download " + Str(File\RecvFiles) + " files from the host: Completed.")
TextGadget(12, 20, 170, 300, 20, "Downloaded the host's " + Str(File\RecvFiles) + " files successfully: "+Str(File\RecvBytes)+ " bytes.")
SetGadgetText(16,"Download Complete")
; HideGadget(42,1) ; Hide the ListIcon box if desired
; HideGadget(45,1) ; Hide the Vertical Progress bar
While WindowEvent():Wend ; Make window repaint
EndIf
; --------------------------------------------------------------------
Else
; Couldn't connect with the host. Report it with the error code.
TextGadget(05, 20, 30, 300, 20, "Did not connect with " + HostDescription)
EndIf
Else
; Couldn't create a connection with the Internet. Report it with the error code.
TextGadget(05, 20, 30, 300, 20, "Internet connection open failed - " + Str(GetLastError_()))
EndIf
OutAHere:
SendMessage_(AniWin,#ACM_OPEN,h,152) ; show the Search Computer AVI
RedrawWindow_(AniWin,0,0,#RDW_INVALIDATE | #RDW_ERASE)
If File\hInternetConnect = 0
; Report the failure to connect to the Host.
TextGadget(13, 20, 190, 400, 20, "Could not connect to the " + HostDescription + " - " + Str(GetLastError_()))
Else
; Show the time of the disconnection from the Host.
Date$ = FormatDate("%mm/%dd/%yyyy - %hh:%ii:%ss", Date())
TextGadget(13, 20, 190, 400, 20, "Disconnecting from the" + HostDescription + " - " + Date$)
EndIf
; --------------------------------------------------------------------------
; Disconnect the Internet session.
; --------------------------------------------------------------------------
If hInternetSession
If File\hInternetConnect
InternetCloseHandle_(File\hInternetConnect)
File\hInternetConnect = #False
Else
TextGadget(13, 20, 190, 300, 20, "No network connection to close")
EndIf
InternetCloseHandle_(hInternetSession)
hInternetSession = #False
Else
TextGadget(13, 20, 190, 400, 20, "No Internet access to close")
EndIf
; --------------------------------------------------------------------------
; Hangup the modem if the program created the connection automatically.
; --------------------------------------------------------------------------
If InternetAutodialHangup_(0)
Else
MessageRequester("Failure warning!","You will have to disconnect your internet connection manually!"+Chr(10)+Chr(10)+"Sorry, my automated attempt has failed...",0)
EndIf
; --------------------------------------------------------------------------
; Show info of some kind just for the exercise here or
; maybe include it in the Message Window shown below
; --------------------------------------------------------------------------
Today.s = FormatDate("%mm%dd%yyyy", Date())
Tod.l = DayOfYear(Date())
Beg.l = DayOfYear(ParseDate("%yyyy/%mm/%dd", "2003/01/01"))
NextYear.l = DayOfYear(ParseDate("%yyyy/%mm/%dd", "2004/12/31"))
Jul.l = Tod - Beg
EndSeason.l = DayOfYear(ParseDate("%yyyy/%mm/%dd", "2003/06/21"))
If Jul > 172
TillNext.l = NextYear - Tod
Else
LeftToGo = EndSeason - Tod
EndIf
If Jul > 172
TextGadget(15, 20, 210, 300, 20, "There are " + Str(TillNext) + " days to the start of summer.")
Else
TextGadget(15, 20, 210, 300, 20, "There are " + Str(LeftToGo) + " more days to the end of summer.")
EndIf
While WindowEvent():Wend
Delay(4000)
; --------------------------------------------------------------------------
; Display a Message Window
; --------------------------------------------------------------------------
; The following code is based on an "ToolWindow" example by Vanleth and PB.
;
; Creates a ToolWindow (window with small title bar that doesn't
; appear in the TaskBar). The fake menu is required to stop a
; graphic glitch at the top of the window. If using a real menu
; in your app, just remove the CreateMenu() code from this example.
; Notes by TerryHough: This is used to create a pseudo MessageRequester
; that times out and then disappears. Since MessageRequester has no
; automatic removal option, this could be very useful. Include text or
; graphics as desired. Also usable for an About message display.
;
; I included this code here to duplicate a feature that existed in the
; language my original file exchanger program as written in. Probably
; will make a procedure out of it and put in my include files at some point.
; --------------------------------------------------------------------------
; Load an image
UseJPEGImageDecoder()
LoadImage(02, "PUREBASIC.JPG")
; --------------------------------------------------------------------------
; Create the window to display
If OpenWindow(1,200,200,399,199,"FTP Exchange Message",#PB_Window_WindowCentered|#PB_Window_Invisible|#PB_Window_SystemMenu)
; CreateGadgetList(WindowID(1)) ; Create some gadgets in the window.
TextGadget (101, 20, 10, 300, 20, "FTP File Exchanger")
TextGadget (102, 20, 30, 300, 20, "Written by: Terry Hough")
TextGadget (103, 80, 45, 300, 20, "Datagroup Inc.")
TextGadget (104, 20, 90, 300, 20, "FTP file transfer powered by")
ImageGadget(105, 108, 110, 30, 30, ImageID(1))
SetWindowLong_(WindowID(1),#GWL_EXSTYLE,GetWindowLong_(WindowID(1),#GWL_EXSTYLE)!#WS_EX_TOOLWINDOW)
ResizeWindow(1,200,200,400, 200)
ShowWindow_(WindowID(1),#SW_SHOW)
While WindowEvent():Wend ; Give the window a chance to display
Delay(4000) ; pause for a while before ending
EndIf
If SendFailed = 0 And RecvFailed = 0
End
EndIf
Repeat
ev=WaitWindowEvent()
Until ev=#PB_Event_CloseWindow
End
; --------------------------------------------------------------------------
; End of the code: FTP File Exchanger written by Terry Hough
; --------------------------------------------------------------------------It is a complete FTP File Exchange program. See the README.DOC in the download for more information.
Reference the following post for more details
viewtopic.php?t=2578&highlight=ftp
Also see
viewtopic.php?t=2813&highlight=ftp
Thanks to everyone on the forum for participating and providing code that helps beginners like me get started.
Terry
