Try the following code with your large file. It uses the asynchronous method and shows the file transfer progress.
I've been using a version of this for some time now and it has always been fast and reliable.
Code: Select all
; FTP_Send_A_File - terryhough
; previously updated 09/11/2009
; updated for PB 4.61 and tested with 20Mb file 06/20/2012
; updated for a small speed improvement 06/25/2012
Declare FindLocalSize(FileNameToFind.s)
Global CurDir$
Global Hdr$
Global Msg$
Global Directoryname$
Global SearchFileSize.l
Global ServerDirectory$
; Substitute your information in this area -----------------------------------------------
; Host parameters fictional - substitute your own legitimate parameters
; where you have the permission to store a file.
IPAddress.s = "ftp.server.somewhere" ; <<<<---- enter your server name here
Username.s = "username" ; <<<<---- enter your user name here
Password.s = "password" ; <<<<---- enter your password here
Filename.s = "C:\biglongfile.pdf" ; <<<<---- enter the file to upload here
Filelen.l = FindLocalSize(Filename) ; Get the local file's details before the transfer.
; alternately use Filelen.l = FileSize(Filename)
ServerDirectory$ = "/receive/recd" ; <<<<---- enter your FTP server directory info here
; ----------------------------------------------------------------------------------------
; Set up directory listing headers
Hdr$ = LSet("Filename",15) + " "
Hdr$ + LSet("Date", 19) + " "
Hdr$ + LSet("Bytes",9) + " "
Hdr$ + "Type"
Procedure FindLocalSize(FileNameToFind.s) ; One method to determine the local file details.
; This code is similar to the code necessary to get
; file details from the FTP server. Sure, you
; could used other PB commands to get the local filesize,
; etc. except for easy access to file type.
LCD.l = ExamineDirectory(#PB_Any,GetPathPart(FileNameToFind),"*.*")
If LCD
While NextDirectoryEntry(LCD)
If UCase(DirectoryEntryName(LCD)) = UCase(GetFilePart(FileNameToFind) )
; Use to display complete file info from FTP server
AddGadgetItem(1,-1, "")
AddGadgetItem(1,-1, "Check the local file details.")
AddGadgetItem(1,-1, Hdr$)
AddGadgetItem(1,-1, "-----------------------------------------------------")
Msg$ = LSet(DirectoryEntryName(LCD),15) + " "
Msg$ + FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", DirectoryEntryDate(LCD,#PB_Date_Modified)) + " "
SearchFileSize.l = DirectoryEntrySize(LCD)
Msg$ + RSet(Str(SearchFileSize),9) + " "
Msg$ + Str(DirectoryEntryType(LCD))
AddGadgetItem(1,-1, Msg$)
AddGadgetItem(1,-1, "-----------------------------------------------------")
AddGadgetItem(1,-1, "")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
Msg$ = ""
; -------------------------------------------------
FinishDirectory(LCD)
ProcedureReturn SearchFileSize
EndIf
Wend
FinishDirectory(LCD)
AddGadgetItem(1,-1, FileNameToFind + " does not exist on the local system in that directory.")
While WindowEvent() : Wend
ProcedureReturn -1 ; File not found
Else
AddGadgetItem(1,-1, "Cannot examine the local directory.")
While WindowEvent() : Wend
ProcedureReturn -2 ; Can't examine the directory
EndIf
EndProcedure
Procedure FindFileSize(FTPC.l,FileNameToFind.s) ; Get file information from the FTP server.
If CheckFTPConnection(FTPC) ; Check to see if connection is still open
AddGadgetItem(1,-1, "")
AddGadgetItem(1,-1, "Check the server file details.")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
; Store the FTP server's current directory.
CurDir$ = GetFTPDirectory(FTPC)
AddGadgetItem(1,-1,"Current server directory is: " + CurDir$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
; ------------------------------------------------------------------------------
If ExamineFTPDirectory(FTPC)
While NextFTPDirectoryEntry(FTPC)
If FTPDirectoryEntryName(FTPC) = FileNameToFind
SearchFileSize.l = FTPDirectoryEntrySize(FTPC)
; Use to display complete file info from FTP server
AddGadgetItem(1,-1, Hdr$)
AddGadgetItem(1,-1, "-----------------------------------------------------")
Msg$ = LSet(FTPDirectoryEntryName(FTPC),15) + " "
Msg$ + FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", FTPDirectoryEntryDate(FTPC)) + " "
Msg$ + RSet(Str(SearchFileSize),9) + " "
Msg$ + Str(FTPDirectoryEntryType(FTPC))
AddGadgetItem(1,-1, Msg$)
AddGadgetItem(1,-1, "-----------------------------------------------------")
AddGadgetItem(1,-1, "")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
; --- End display of file's info from FTP server ---
FinishFTPDirectory(FTPC)
ProcedureReturn SearchFileSize
EndIf
Wend
FinishFTPDirectory(FTPC)
Msg$ = "File could not be found."
AddGadgetItem(1,-1, Msg$)
ProcedureReturn -1 ; File not found
Else
Msg$ = "Can not examine the directory."
AddGadgetItem(1,-1, Msg$)
ProcedureReturn -2 ; Can't examine the directory
EndIf
Else
Msg$ = "Connection is not open."
AddGadgetItem(1,-1, Msg$)
ProcedureReturn -3 ; Connection is not open
EndIf
EndProcedure
; --- Timed Message Box --------------------------------------------------------
#MessageBox_Timeout = -1
Global g_hwndTimedOwner
Global g_bTimedOut, g_dwTimeout, g_Quiz_ButtonHandle
Procedure MessageBoxStatus(hwnd, uiMsg, idEvent, dwTime)
Static numseconds=0
Static firstrun=1
If firstrun
numseconds = g_dwTimeout / 1000
firstrun = 0
EndIf
numseconds-1
If IsWindow_(g_Quiz_ButtonHandle)
SetWindowText_(g_Quiz_ButtonHandle, "&Yes (" +Str(numseconds) + " sec)")
Else
KillTimer_(hwnd, idEvent)
firstrun = 1
EndIf
If numseconds < 0
KillTimer_(hwnd, idEvent)
firstrun = 1
EndIf
EndProcedure
Procedure FindButton(hwnd, param)
ButtonText.s = Space(50)
GetWindowText_(hwnd, @ButtonText, 49)
If ButtonText = PeekS(param)
g_Quiz_ButtonHandle = hwnd
ProcedureReturn 0
Else
ProcedureReturn 1
EndIf
EndProcedure
Procedure WindowProc(hwnd, msg, wparam, lparam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_ACTIVATE
If wparam & $FFFF = #WA_INACTIVE
class.s = Space(50)
caption.s = Space(50)
GetClassName_(lparam, @class, 49)
GetWindowText_(lparam, @caption, 49)
If class = "#32770"
If caption = "Internet Updater"
EnumChildWindows_(lparam, @FindButton(), @"&Yes")
If IsWindow_(g_Quiz_ButtonHandle)
SetWindowText_(g_Quiz_ButtonHandle, "&Yes (" +Str(g_dwTimeout/1000) + " sec)")
EndIf
idStatusTimer.l = SetTimer_(#Null, 0, 1000, @MessageBoxStatus())
EndIf
EndIf
EndIf
EndSelect
ProcedureReturn result
EndProcedure
Procedure MessageBoxTimer(hwnd, uiMsg, idEvent, dwTime)
g_bTimedOut = #True
If g_hwndTimedOwner
EnableWindow_(g_hwndTimedOwner, #True)
EndIf
PostQuitMessage_(0)
EndProcedure
Procedure TimedMessageBox(hwndOwner, pszMessage.s, pszTitle.s, flags, dwTimeout)
Protected idTimer.l, iResult.l
g_hwndTimedOwner = #Null
g_bTimedOut = #False
g_dwTimeout = dwTimeout
If hwndOwner And IsWindowEnabled_(hwndOwner)
g_hwndTimedOwner = hwndOwner
EndIf
idTimer.l = SetTimer_(#Null, 0, dwTimeout, @MessageBoxTimer())
iResult.l = MessageBox_(hwndOwner, pszMessage, pszTitle, flags)
KillTimer_(#Null, idTimer)
If g_bTimedOut
PeekMessage_(@msg.MSG, #Null, #WM_QUIT, #WM_QUIT, #PM_REMOVE)
iResult = #MessageBox_Timeout
EndIf
ProcedureReturn iResult
EndProcedure
; --- Timed Message Box ends --------------------------------------------------------
; --- Optional: Get filename and server directory from program parameters area. -----------
;Filename.s = ProgramParameter()
;Filelen.l = FindLocalSize(Filename) ; Get the local file's details before the transfer.
; ; alternately use Filelen.l = FileSize(Filename)
;ServerDirectory$ = ProgramParameter()
; -----------------------------------------------------------------------------------------
ReplaceString(ServerDirectory$,"\","/",#PB_String_InPlace)
; Open main window
hwnd=OpenWindow(0, 0, 0, 630, 450, "FTP - Send A File", #PB_Window_SystemMenu)
;CreateGadgetList(WindowID(0))
ListViewGadget(1, 4, 10, 622, 400)
While WindowEvent() : Wend
While WindowEvent() : Wend
If LoadFont(1, "COURIER", 12)
SetGadgetFont(1, FontID(1))
EndIf
TextGadget(2, 4, 420, 622, 15,"")
ProgressBarGadget(41, 4, 435, 622, 10, 0, 100,#PB_ProgressBar_Smooth)
AddGadgetItem(1,-1,"Starting actvity")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
AddGadgetItem(1,-1,"Send file to server: " + GetFilePart(Filename) + ", " + Str(FileLen) + " bytes")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
InitNetwork()
AddGadgetItem(1,-1,"Initialized the network")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
Connect.l = OpenFTP(#PB_Any, IPAddress, Username, Password)
If Connect
Result.l = 0
Received.l = 0
AddGadgetItem(1,-1,"Opened FTP Session " + Str(Connect))
AddGadgetItem(1,-1,"")
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
; SetFTPDirectory() - only an immediate directory change is allowed.
; To change to several levels of directory, this command will have to be called several time.
; Eg. SetFtpDirectory(Connect, "pub/support") is invalid on most servers.
For Ctr = 2 To CountString(ServerDirectory$, "/")+1
If Trim(StringField(ServerDirectory$,Ctr,"/")) <> ""
Result = SetFTPDirectory(Connect, StringField(ServerDirectory$,Ctr,"/"))
If Result = #False
Msg$ = "Could not change to " +StringField(ServerDirectory$,Ctr,"/") + " on the server." + #LF$
Msg$ + #LF$ + " " + Chr(149) + " " + "Verify the directory name exists on the server."
Msg$ + #LF$ + " " + Chr(149) + " " + "Directory name may be case sensitive at this server."
MessageRequester("FTP Send A File",Msg$,#MB_ICONSTOP)
End
Else
;MessageRequester("DB","Changed Server's current directory to: " + GetFTPDirectory(Connect),#MB_ICONINFORMATION)
EndIf
EndIf
Next
; Just verifying server's current directory is correct. This code could be removed. ------
Directoryname$ = GetFTPDirectory(Connect)
AddGadgetItem(1,-1,"Server's current directory was changed to: " + Directoryname$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
; ----------------------------------------------------------------------------------------
; *** Start the timer *** -----
rTime.f = ElapsedMilliseconds()
; -----------------------------
; Send a file to the server using the asynchronous mode
SendFTPFile(Connect, Filename, GetFilePart(Filename), #True)
Repeat
Delay(10)
Until FTPProgress(Connect) = #PB_FTP_Started
Msg$ = "The file transfer has been initialized."
AddGadgetItem(1,-1, Msg$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
Repeat
Result.l = FTPProgress(Connect)
Select Result
Case #PB_FTP_Error
Msg$ = "Send/Recv error occurred."
AddGadgetItem(1,-1, Msg$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
Break
Case #PB_FTP_Finished
SetGadgetState(41, 100) ; update progress bar
eTime = ElapsedMilliseconds()
eMilliSeconds.f = eTime - rTime
FindFileSize(Connect,GetFilePart(Filename))
rBytesPerSecond.f = Round(SearchFileSize/((eMilliSeconds)/1000)/1024,#True)
SetGadgetText(2,"Sent: " + Str(SearchFileSize) + " bytes @ " + StrF(rBytesPerSecond,1) + " kb/second, " + StrF((eTime - rTime)/1000,3) + " seconds")
While WindowEvent() : Wend
Msg$ = "File transfer finished correctly."
AddGadgetItem(1,-1, Msg$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
Break
Default
SetGadgetState(41, Round((Result / Filelen)*100, #True)) ; update progress bar
eTime = ElapsedMilliseconds()
eMilliSeconds.f = eTime - rTime
rBytesPerSecond.f = Round(Result/((eMilliSeconds)/1000)/1024,#True)
SetGadgetText(2,"Sent: " + Str(Result) + " bytes @ " + StrF(rBytesPerSecond,1) + " kb/second, " + StrF((eTime - rTime)/1000,3) + " seconds")
While WindowEvent() : Wend
EndSelect
Delay(1)
ForEver
Delay(100)
; Just verifying server's current directory is correct. This code could be removed. -----
Directoryname$ = GetFTPDirectory(Connect)
AddGadgetItem(1,-1,"Server's current directory is: " + Directoryname$)
SetGadgetState(1,CountGadgetItems(1)-1)
While WindowEvent() : Wend
TMResult = TimedMessageBox(#Null, Msg$, "FTP_Send_A_File", #MB_OK, 5000)
End
; ----------------------------------------------------------------------------------------
Else
Msg$ = "Failed to connect to the server." + #LF$
Msg$ + #LF$ + IPAddress
Msg$ + #LF$ + " " + Chr(149) + " " + "Verify server address is correct."
Msg$ + #LF$ + " " + Chr(149) + " " + "Verify user name and password are correct."
MessageRequester("FTP Send A File", Msg$, #MB_ICONERROR)
End
EndIf
While WindowEvent() : Wend
Repeat : Delay(5) : Until WaitWindowEvent() = #PB_Event_CloseWindow
CloseFTP(Connect)
End