Basic Univers

;{-*-*-*- Fonction d'acces au FTP -*-*-*-*-*
;{Credit
; FTP_Library_Include
; Original code by Num3
; Modified by TerryHough - Oct 20, 2004, May 05, 2005 Vs.0.7a
;                        - tested with zFTPServer
;                        -   DIR responds with "public" style listing
;                        - May 16, 2005 Vs.0.7b
;                        - tested with the Broker server
;                        -   DIR responds with "ftp ftp" style listing
;                        - modified FTP_DirDisplay to handle both styles
; Modified by Zapman     - June 10, 2005 Vs Z1
; Modified by Stefou       - June 26, 2006
;}
;{- Variable
#FTP_OK      =  1
#FTP_ERROR   =  - 1
#FTP_TimeOut =  - 2
#FTP_fichier = 3 ;-;pas sur
;
#BInter = 12
;
Global FTP_Last_Message.s
Global PortID.l, FTPSemaphore
;
;
Global ConnectionID.l
Global In.s
Global TotalBytesSent.l
Global TotalBytesRecd.l
Global Interrupt
Global WaitAnswer$, Numero_reponse
;
Global CLog.s, Log_Gadget
;
#LongTimeOut  = 15000
#SmallTimeOut = 10000
#VerySmallTimeOut = 1500
;
#Block_size = 8192   ; 4096
;
#TTAB = Chr(9)
#LFCR = Chr(13) + Chr(10)
#CRLF = Chr(10) + Chr(13)
;}
Structure FTPFileInfo
     Name$
     Hour$
     Day.l
     Month$
     FSize.l
     Date$
     type.l
EndStructure
;
;{-Fonction niveau 1
Procedure Minimum(a, b)
     If aProcedureReturn a
     Else
          ProcedureReturn b
     EndIf
EndProcedure
Procedure FTPDebug(Line$, Log_Gadget)
     If Line$
          Line$ = FormatDate("%hh:%ii:%ss", Date())+ ": " + Line$
          ; Debug Line$
          If IsGadget(Log_Gadget)
               ; SendMessage_(GadgetID(Log_Gadget), #WM_SETTEXT, 0, @Line$)
               
               AddGadgetItem(Log_Gadget, 0, Line$)
          EndIf
     EndIf
EndProcedure
Procedure SendNetworkString2(Ftp, message$, Log_Gadget)
     Line$ = RemoveString(message$, #LFCR)
     If UCase(Left(Line$, 5))="PASS " : Line$ = "PASS ****" : EndIf ; n'affiche pas le pass
     Line$ = "<--->" + Line$
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn SendNetworkString(Ftp, message$)
EndProcedure
;
Procedure.s Wait(Connection, Timeout, Log_Gadget)
     
     Delay(10)
     BufferLenght = 1000
     *Buffer = AllocateMemory(BufferLenght)
     If *Buffer > 0
          Text.s = ""
          Repeat
               t = ElapsedMilliseconds()
               Size = - 1
               Repeat ; attente d'un message
                    result = NetworkClientEvent(Connection)
                    If result <> #PB_NetworkEvent_Data : Delay(5) : EndIf
                    EventID = WindowEvent()
                    If EventID =#PB_Event_Gadget
                         If EventGadget()=#BInter
                              Interrupt = 1
                         EndIf
                    EndIf
               Until result = #PB_NetworkEvent_Data Or ElapsedMilliseconds()- t > Timeout Or Interrupt
               
               If result = #PB_NetworkEvent_Data
                    Size = ReceiveNetworkData(Connection, *Buffer, BufferLenght)
                    If Size > 0
                         Text.s + PeekS(*Buffer, Size)
                    EndIf
               EndIf
               If Size > 150
                    Timeout = 4000
               Else
                    Timeout = 300
               EndIf
          Until Size < 1 Or Interrupt
         
          If Interrupt
               CloseNetworkConnection(Connection)
               Text = "!! Interrupted !!"
          EndIf
          If Text
               While Right(Text, 1)= Chr(10) Or Right(Text, 1)= Chr(13) Or Right(Text, 1)=" "
                    Text = Left(Text, Len(Text)- 1)
               Wend
          Else
               Text = "!! TimeOut !!"
          EndIf
          FreeMemory(*Buffer)
     Else
          Text = "!! Memory Error !!"
     EndIf
     WaitAnswer$ = Text
     Line$ = ">---<" + ReplaceString(Text, #LFCR, "+")
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn Text
EndProcedure
Procedure Wait2(Connection, Timeout, Log_Gadget)
     In = Wait(Connection, Timeout, Log_Gadget)
EndProcedure
Procedure PassiveIP(Text.s)
     s = FindString(Text, "(", 1)+ 1
     l = FindString(Text, ")", s)- s
     Host.s = Mid(Text, s, l)
     In = StringField(Host, 1, ",")+"." + StringField(Host, 2, ",")+"." + StringField(Host, 3, ",")+"." + StringField(Host, 4, ",")
EndProcedure
Procedure PassivePort(Text.s)
     s = FindString(Text, "(", 1)+ 1
     l = FindString(Text, ")", s)- s
     Host.s = Mid(Text, s, l)
     In = Str(Val(StringField(Host, 5, ","))*256 + Val(StringField(Host, 6, ",")))
EndProcedure
Procedure LookForReply(Reponse$, Reply_chch$) ; Some servers concatenate replies - This function look for a reply into a multiline answer
     ; renvoie la position du text Reply$ dans tx$
     Reponse$ = ReplaceString(Reponse$, "-", " ")
     If Right(Reply_chch$, 1)<>" " : Reply_chch$ +" " : EndIf
     If Left(Reponse$, Len(Reply_chch$))= Reply_chch$
          pos = 1
     Else
          pos = FindString(Reponse$, #LFCR + Reply_chch$, 0)
          If pos : pos + Len(#LFCR) : EndIf
     EndIf
     ProcedureReturn pos
EndProcedure
Global DialogAnswer$
Procedure FTP_Dialog(Ftp.l, Command.s, Condition.s, Log_Gadget)
     If Ftp
          ; Online with the server
          ;
          If Right(Command, Len(#LFCR))<>#LFCR : Command + #LFCR : EndIf
          SendNetworkString2(Ftp, Command, Log_Gadget)
          nbRepeat = 2
          Repeat
               Wait2(Ftp, #SmallTimeOut, Log_Gadget)
               In = WaitAnswer$
               DialogAnswer$ = In
               ; Debug DialogAnswer$
               If Left(In, 2)="!!"
                    result = #FTP_ERROR
               Else
                    While Condition And result = 0 ; If Condition is a multiple choice, we'll look for each choice
                         p = FindString(Condition, "|", 0) : If p = 0 : p = Len(Condition)+ 1 : EndIf
                         PCond$ = Left(Condition, p - 1)
                         Condition = Right(Condition, Len(Condition)- p)
                         p = LookForReply(In, PCond$) ; Some servers concatenate replies
                         If p
                              p2 = FindString(In, #LFCR, p) : If p2 = 0 : p2 = Len(In)+ 1 : EndIf
                              result = #FTP_OK
                              DialogAnswer$ = Mid(In, p, p2 - p) ; keep the reply which we were looking for
                              Numero_reponse = Val(PCond$)
                         EndIf
                    Wend
               EndIf
               nbRepeat - 1
          Until nbRepeat = 0 Or result = #FTP_OK
     Else
          Line$ = "!!Error: No Connection ID!!"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_PASV(Ftp, Command.s, Log_Gadget)
     If ConnectionID = 0
          result = FTP_Dialog(Ftp, Command, "227", Log_Gadget)
          If result = #FTP_OK
               PassiveIP(DialogAnswer$)
               PassiveIP$ = In
               PassivePort(DialogAnswer$)
               PassivePort = Val(In)
               Line$ = "----- Connection to [" + PassiveIP$ +" Port: " + Str(PassivePort)+"]"
               
               ConnectionID = OpenNetworkConnection(PassiveIP$, PassivePort)
               
               If ConnectionID = 0
                    Line$ = "!!--- Unable to establish PASV " + Line$
                    result = #FTP_ERROR
               EndIf
          EndIf
     Else
          result = #FTP_OK
     EndIf
     
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure Int_FTP_PASV(Ftp, Log_Gadget)
     result = FTP_PASV(Ftp, "PASV", Log_Gadget)
     If result <> #FTP_OK
          result = FTP_PASV(Ftp, "passive", Log_Gadget)
     EndIf
     ProcedureReturn result
EndProcedure
Procedure Int_FTP_PASV_CLOSE(Log_Gadget)
     CloseNetworkConnection(ConnectionID)
     Line$ = "----- Passive connection closed"
     FTPDebug(Line$, Log_Gadget)
     ConnectionID = 0
EndProcedure
Procedure FTP_PutFile(Ftp, ProgBarGadgetID.l, mem, file_size, Log_Gadget)
     file_size_restant = file_size
     If Ftp
          TotalBytesSent = 0
          Repeat
               toSend.l = Minimum(file_size_restant, #Block_size)
               ReadData(#FTP_fichier, mem, toSend)
               time = ElapsedMilliseconds()
               resultS = 0
               Repeat
                    resultS = SendNetworkData(Ftp, mem, toSend)
               Until resultS = toSend Or Interrupt Or(ElapsedMilliseconds()- time)>#LongTimeOut
               If Interrupt
                    Line$ = "!!--- Data send interrupted"
                    result = #FTP_ERROR
               ElseIf resultS <> toSend
                    Line$ = "!!--- Data send error"
                    result = #FTP_ERROR
               EndIf
               ; Compute progress ----------------------------------
               TotalBytesSent + resultS
               ; If ProgBarGadgetID
               ; Display progress
               Progress = TotalBytesSent * 100/ file_size
               ; debug Progress
               ProgressBarDouble("", - 1, Progress)
               ; SetGadgetState(ProgBarGadgetID,Progress)
               ; While WindowEvent() : Wend
               ; EndIf
               ; ---------------------------------------------------
               file_size_restant - resultS ; Decrement by bytes just sent
               LastTime = Date()
          Until file_size_restant = 0 Or result
          If file_size = 0
               Line$ = "----- File sent with succes"
               result = #FTP_OK
          EndIf
     Else
          Line$ = "!!--- No Connection ID"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_GetFile(Ftp, ProgBarGadgetID.l, mem, file_size, Log_Gadget)
     file_size_restant = file_size
     If Ftp
          TotalBytesRecd = 0
          time = ElapsedMilliseconds()
          Repeat
               event = NetworkClientEvent(Ftp)
               Select event
                    Case 2
                         toRecv.l = Minimum(file_size_restant, #Block_size)
                         resultR = ReceiveNetworkData(Ftp, mem, toRecv)
                         If resultR>0
                              time = ElapsedMilliseconds()
                         EndIf
                         WriteData(#FTP_fichier, mem, resultR)
                         ;
                         TotalBytesRecd + resultR
                         ; If ProgBarGadgetID
                         ; Display progress
                         Progress = TotalBytesRecd * 100/ file_size
                         ProgressBarDouble("", - 1, Progress)
                         ; SetGadgetState(ProgBarGadgetID,Progress)
                         ; While WindowEvent() : Wend
                         ; EndIf
                         ; ---------------------------------------------------
                         file_size_restant - resultR  ; Decrement by bytes just received
                    Case 0
                         ; Nothing received from server yet
                    Case 3
                         ; A file was received - shouldn't have happened
                         Line$ = "!!--- Error - A file waiting message received"
                         result = #FTP_ERROR
               EndSelect
          Until file_size_restant = 0 Or(ElapsedMilliseconds()- time)>#LongTimeOut Or Interrupt
          If file_size_restant = 0
               Line$ = "----- File successfully received"
               result = #FTP_OK
          Else
               SendNetworkString2(Ftp, "ABOR" + #LFCR, Log_Gadget) ; to be sure to clear everything
               Wait2(Ftp, #SmallTimeOut, Log_Gadget)
               If Interrupt
                    Line$ = "!!--- File receive interrupted"
               EndIf
               result = #FTP_ERROR
          EndIf
     Else
          Line$ = "!!--- No Connection ID"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_DirList(Ftp, DontWait226, Log_Gadget)
     In = ""
     If ConnectionID
          t = ElapsedMilliseconds()
          Repeat
               Wait2(ConnectionID, #VerySmallTimeOut, Log_Gadget)
               tx$ = WaitAnswer$
               If FindString(tx$, "TimeOut", 0) And DontWait226 = 0
                    Wait2(Ftp, #VerySmallTimeOut, Log_Gadget) ; look for "226 - transfert completed"
                    R226.s = WaitAnswer$
                    If LookForReply(R226, "226") ; end of transfert, we won't wait more
                         Wait2(ConnectionID, #VerySmallTimeOut, Log_Gadget) ; we try just one more time to be sure to miss no data
                         tx$ = WaitAnswer$
                         If Left(tx$, 2) <> "!!"
                              In + tx$
                         EndIf
                    EndIf
                    ; Else
                    ; If Left(tx$,2) = "!!"
                    ; In + tx$
                    ; EndIf
               EndIf
          Until In Or ElapsedMilliseconds()- t > #LongTimeOut Or DontWait226 Or Interrupt
         
          If LookForReply(R226, "226")= 0 And DontWait226 = 0
               result = #FTP_TimeOut
               Line$ = "!!--- TimeOut"
          ElseIf In
               Line$ = "----- Dir has been received"
               result = #FTP_OK
          Else
               result = #FTP_ERROR
          EndIf
     Else
          Line$ = "!!--- No Connection ID"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure

Procedure RecupFileInfo(DirEntry$, FTPInfo)
     *FTPInfoT.FTPFileInfo = FTPInfo
     Temp = FindString(DirEntry$, Chr(10), 1)
     If Temp = 0 : Temp = Len(DirEntry$)+ 1 : EndIf
     EndLine = Temp
     While Asc(Mid(DirEntry$, Temp, 1))= 32 Or Asc(Mid(DirEntry$, Temp, 1))= 10 Or Asc(Mid(DirEntry$, Temp, 1))= 13 : Temp - 1 : Wend
     Line$ = Trim(Left(DirEntry$, Temp))
     DirEntry$ = Right(DirEntry$, Len(DirEntry$) - EndLine)
     
     ;{ on repère le type de fichier suivant le premier caractere
     *FTPInfoT\type = 0 ; ce n'est ni un fichier ni un dossier (surement un erreur)
     If Left(Line$, 1)="d" :  *FTPInfoT\type = 2 : EndIf
     If Left(Line$, 1)="-" :  *FTPInfoT\type = 1 : EndIf
     ;}
     
     Repeat ; retire tous les double ou triple espace
          Line$ = ReplaceString(Line$, "  ", " ", 0)
     Until FindString(Line$, "  ", 0)= 0
     
     ;{on récupère le nom des champs
     posd = 0
     num_champ = 0
     Repeat
          num_champ = num_champ + 1
          pos = FindString(Line$, " ", posd)
         
          Select num_champ
               Case 5
                    *FTPInfoT\FSize = Val(Mid(Line$, posd, pos - posd))
               Case 6
                    *FTPInfoT\Month$ = Mid(Line$, posd, pos - posd)
               Case 7
                    *FTPInfoT\Day = Val(Mid(Line$, posd, pos - posd))
               Case 8
                    *FTPInfoT\Hour$ = Mid(Line$, posd, pos - posd)
               Case 9
                    *FTPInfoT\Name$ = Right(Line$, Len(Line$)- posd + 1)
          EndSelect
          posd = pos + 1
     Until pos = 0
     ;}
     
     ;{on calcul de la date au format YYYYMMDDHHMM
     If FindString(*FTPInfoT\Hour$, ":", 0) ; les fichiers des année précedente perde leur date
          ; donc si il y a l'heure c'est qu'il est de cette année
          heure$ = Left(*FTPInfoT\Hour$, 2)+ Right(*FTPInfoT\Hour$, 2)
          annee$ = FormatDate("%yyyy", Date())
     Else
          annee$ = Trim(*FTPInfoT\Hour$)
          *FTPInfoT\Hour$ = "00:00"
          heure$ = "0000"
     EndIf
     Select LCase(*FTPInfoT\Month$)
          Case "jan" :  mois$ = "01"
          Case "feb" :  mois$ = "02"
          Case "mar" : mois$ = "03"
          Case "apr" : mois$ = "04"
          Case "may" : mois$ = "05"
          Case "jun" : mois$ = "06"
          Case "jul" : mois$ = "07"
          Case "aug" : mois$ = "08"
          Case "sep" : mois$ = "09"
          Case "oct" : mois$ = "10"
          Case "nov" : mois$ = "11"
          Case "dec" : mois$ = "12"
               
     EndSelect
     
     *FTPInfoT\Date$ = annee$ + mois$ + RSet(Str(*FTPInfoT\Day), 2, "0") + heure$
     ;}
     
     
     In = DirEntry$
EndProcedure

;{- CONNECTION
Procedure FTP_Init()
     If InitNetwork_fait = 0
          If InitNetwork()
               InitNetwork_fait = 1
               Line$ = "----- Successfully started the TCP/IP stack..."
               result = #FTP_OK
          Else
               Line$ = "!!--- Unable to start TCP/IP stack..."
               result = #FTP_ERROR
          EndIf
          FTPDebug(Line$, Log_Gadget)
          ProcedureReturn result
     Else
          ProcedureReturn #FTP_OK
     EndIf
     
EndProcedure
Procedure FTP_Close(Ftp.l, Log_Gadget)
     If Ftp
          ; Online with the server
          If CloseNetworkConnection(Ftp)
               ; "Successfully closed the specified ftp connection"
               Line$ = "----- Connection closed"
               result = #FTP_OK
          Else
               ; "Connection previously closed or unable to close specified ftp connection"
               Line$ = "----- Connection closed"
          EndIf
     Else
          Line$ = "----- Connection was yet closed"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_Connect(Server.s, PortNo.l, Log_Gadget) ; // Returns FTPconnection
     
     PortID.l = OpenNetworkConnection(Server, PortNo)
     ConnectionID = 0
     Interrupt = 0
     
     If PortID
          Wait2(PortID, #SmallTimeOut, Log_Gadget)
          In = WaitAnswer$
          If Left(In, 2)="!!" Or In = ""
               FTP_Close(PortID, Log_Gadget)
               PortID = 0
               result = #FTP_ERROR
          ElseIf LookForReply(In, "220")
               result = PortID
          Else
               result = #FTP_ERROR
          EndIf
     Else
          Line$ = "!!--- Unable to connect to specified server"
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
;
Procedure FTP_CHMOD(Ftp.l, Command.s, FileOrFolder.s, mod.s, Log_Gadget)
     ProcedureReturn FTP_Dialog(Ftp, Command +" " + mod + " " + FileOrFolder + #LFCR, "200", Log_Gadget)
EndProcedure
Procedure Int_FTP_CHMOD(Ftp.l, FileOrFolder.s, mod.s, Log_Gadget)
     result = FTP_CHMOD(Ftp, "CHMOD", FileOrFolder.s, mod.s, Log_Gadget)
     If result <> #FTP_OK
          result = FTP_CHMOD(Ftp, "SITE CHMOD", FileOrFolder.s, mod.s, Log_Gadget)
     EndIf
     ProcedureReturn result
EndProcedure
;
Procedure FTP_Login(Ftp.l, User.s, Pass.s, Log_Gadget)
     If FTP_Dialog(Ftp, "USER " + User, "331", Log_Gadget) = #FTP_OK
          If FTP_Dialog(Ftp, "PASS " + Pass, "230", Log_Gadget) = #FTP_OK
               result = FTP_Dialog(Ftp, "TYPE I", "200", Log_Gadget)
               If result <> #FTP_OK
                    result = FTP_Dialog(Ftp, "TYPE I", "200", Log_Gadget) ; This MUST work!!!
               EndIf
          Else
               result = #FTP_ERROR
          EndIf
     Else
          result = #FTP_ERROR
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_LogOut(Ftp.l, Log_Gadget)
     If ConnectionID
          Int_FTP_PASV_CLOSE(Log_Gadget)
          Line$ = "----- Connection closed"
          FTPDebug(Line$, Log_Gadget)
          ConnectionID = 0
     EndIf
     ;
     If Ftp
          SendNetworkString2(Ftp, "QUIT" + #LFCR, Log_Gadget)
     EndIf
     ProcedureReturn #FTP_OK
EndProcedure
;}

Procedure Parse226(CommandNumber$, tx$) ; Decode this message to extract the number of files from it.
     ; NbrOfFiles = 1 ; if the number of files is not found, we'll return 1 anyway
     ;
     While tx$ And Interrupt = 0
          pos = LookForReply(tx$, CommandNumber$)
          If pos
               pos + Len(CommandNumber$) + 1
               mpos = pos
               While(Val(Mid(tx$, pos, 1)) Or Mid(tx$, pos, 1)="0") And pos<= Len(tx$)
                    pos + 1
               Wend
               If pos > mpos
                    NbrOfFiles = Val(Mid(tx$, mpos, pos - mpos))
                    tx$ = ""
               Else
                    pos = FindString(tx$, #LFCR, pos)
                    If pos
                         tx$ = Right(tx$, Len(tx$)- pos - Len(#LFCR)+ 1)
                    Else
                         tx$ = ""
                    EndIf
               EndIf
          Else
               tx$ = ""
          EndIf
     Wend
     ;
     ProcedureReturn NbrOfFiles
EndProcedure
;}

;{-Fonction niveau 2
Procedure FTP_Help(Ftp.l, ListArg$, Log_Gadget)
     ProcedureReturn FTP_Dialog(Ftp, "HELP" + ListArg$ + #LFCR, "214", Log_Gadget)
EndProcedure
Procedure FTP_List(Ftp.l, ListArg$, Log_Gadget)
     If Ftp
          ; Attempt to create a PASV connection
          If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
               ProcedureReturn #FTP_ERROR
          EndIf
          ;
          result = FTP_Dialog(Ftp, "LIST" + ListArg$, "125|150", Log_Gadget) ;(125 = zFTPServer, 150 = Broker)
          ;
          If result = #FTP_OK
               DontWait226 = LookForReply(In, "226") ; some server send 226 in the same message
               result = FTP_DirList(Ftp, DontWait226, Log_Gadget)
               mIn.s = In
               Int_FTP_PASV_CLOSE(Log_Gadget)
               If result = #FTP_TimeOut ;            It's perhaps not a problem, because...
                    Wait2(Ftp, #SmallTimeOut, Log_Gadget) ; some server wait until PASV_CLOSE to deliver "226"
                    R226.s = WaitAnswer$
                    If LookForReply(In, "226")
                         result = #FTP_OK
                         In = mIn
                    EndIf
               EndIf
          EndIf
     Else
          Line$ = "!!--- No Connection ID"
          result = #FTP_ERROR
     EndIf
     
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure ConnectionServeur(ftp$, Name$, pass$)
     
     ;{- Connection
     ; Log_Gadget = 0
     FTP_Init()
     ; "ftp.tib-net.com","tib-net","ws0swkv3"
     ConnectID = FTP_Connect(ftp$, 21, Log_Gadget)
     FTP_Login(ConnectID, Name$, pass$, Log_Gadget)
     ;}
     ProcedureReturn ConnectID
EndProcedure
Procedure DeconnectionServeur(ConnectID)
     FTP_LogOut(ConnectID, Log_Gadget)
     FTP_Close(ConnectID, Log_Gadget)
     
EndProcedure
Procedure FTP_DownLoad(Ftp.l, filename.s, destination.s, ProgBarGadgetID.l, Log_Gadget)
     
     result = FTP_Dialog(Ftp, "SIZE " + filename, "213", Log_Gadget)
     If result = #FTP_OK
          file_size = Parse226("213", In)
         
          mem = AllocateMemory(Minimum(file_size, #Block_size))
          If mem>0
               If CreateFile(#FTP_fichier, destination) = 0
                    Line$ = "!!--- Unable to create file"
                    FreeMemory(mem)
                    result = #FTP_ERROR
               EndIf
          Else
               Line$ = "!!--- Memory error"
               result = #FTP_ERROR
          EndIf
         
          If result = #FTP_OK And ConnectionID = 0
               ; Attempt to create a PASV connection
               If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
                    CloseFile(#FTP_fichier)
                    FreeMemory(mem)
                    DeleteFile(destination )
                    result = #FTP_ERROR
               EndIf
          EndIf
         
          starttime.l = Date()
          ;
          If result = #FTP_OK
               result = FTP_Dialog(Ftp, "RETR " + filename, "125|150|226", Log_Gadget)
               ;
               If result = #FTP_OK
                    result = FTP_GetFile(ConnectionID, ProgBarGadgetID, mem, file_size, Log_Gadget)
               EndIf
               CloseFile(#FTP_fichier)
               FreeMemory(mem)
               Int_FTP_PASV_CLOSE(Log_Gadget)
               If result = #FTP_OK And LookForReply(In, "226") = 0 ; now, some server will send the #226 message and some will not
                    Wait2(Ftp, 1000, Log_Gadget) ; small TimeOut value to avoid to loose too much time
               EndIf
               If result = #FTP_OK
                    now.l = Date()
                    speed.f = 0
                    If(now - starttime) > 0
                         speed =(TotalBytesRecd / 1024) /(now - starttime)
                    Else
                         speed = TotalBytesRecd / 1024
                    EndIf
                    Line$ = "-----" + Str(TotalBytesRecd) + " bytes downloaded (" + StrF(speed, 2) + " Kb/sec)"
               Else
                    If LookForReply(In, "425") Or LookForReply(In, "426") Or LookForReply(In, "501") Or LookForReply(In, "550") ; Unable to open the connection
                         Line$ = "!!--- Data connection closed abnormally"
                    EndIf
               EndIf
          EndIf
     EndIf
     FTPDebug(Line$, Log_Gadget)
     ProcedureReturn result
EndProcedure
Procedure FTP_CurrentDir(Ftp.l, Log_Gadget)
     ProcedureReturn FTP_Dialog(Ftp, "PWD" + #LFCR, "257", Log_Gadget)
EndProcedure
Procedure FTP_ChangeDir(Ftp.l, Dirname.s, Log_Gadget)
     ProcedureReturn FTP_Dialog(Ftp, "CWD " + Dirname + #LFCR, "250|550", Log_Gadget)
EndProcedure
Procedure FTP_UpLoad(Ftp.l, filename.s, destination.s, ProgBarGadgetID.l, Log_Gadget)
     ConnectionID = 0
     If Ftp
          ; Online with the server
          file_size.l = FileSize(filename)
          If file_size = 0
               Line$  = "!!--- File is empty!!"
               result = #FTP_ERROR
          Else
               If ReadFile(#FTP_fichier, filename) = 0
                    Line$  = "!!--- Unable to open file"
                    result = #FTP_ERROR
               Else
                    result = #FTP_OK
               EndIf
          EndIf
          ;
          If result = #FTP_OK
               mem = AllocateMemory(Minimum(file_size, #Block_size))
               If mem<1
                    FTP_Last_Message = "Unable to allocate memory"
                    CloseFile(#FTP_fichier)
                    Line$  = "!!--- Memory error"
                    result = #FTP_ERROR
               EndIf
          EndIf
         
          If result = #FTP_OK And ConnectionID = 0
               ; Attempt to create PASV connection
               If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
                    CloseFile(#FTP_fichier)
                    FreeMemory(mem)
                    result = #FTP_ERROR
               EndIf
          EndIf
         
          starttime.l = Date()
          ;
          If result = #FTP_OK
               result = FTP_Dialog(Ftp, "STOR " + destination, "125|150|226", Log_Gadget)
               ;
               If result = #FTP_OK
                    result = FTP_PutFile(ConnectionID, ProgBarGadgetID, mem, file_size, Log_Gadget)
               EndIf
               
               For ct = 1 To 100
                    Delay(10) ; to be sure that all data are sent on the passive port
                    WindowEvent()
               Next
               CloseFile(#FTP_fichier)
               FreeMemory(mem)
               Int_FTP_PASV_CLOSE(Log_Gadget)
               If result = #FTP_OK
                    now.l = Date()
                    speed.f = 0
                    If(now - starttime) > 0
                         speed =(TotalBytesSent / 1024) /(now - starttime)
                    Else
                         speed = TotalBytesSent / 1024
                    EndIf
                    Line$ = "-----" + Str(TotalBytesSent) + " bytes uploaded (" + StrF(speed, 2) + " Kb/sec)"
               Else
                    If LookForReply(In, "501") Or LookForReply(In, "550") Or LookForReply(In, "553") ; Unable to open the connection
                         Line$ = "!!--- Data connection closed abnormally"
                    EndIf
               EndIf
          EndIf
     EndIf
     FTPDebug(Line$, Log_Gadget)
     

     
     ProcedureReturn result
EndProcedure
Procedure FTP_MakeDir(Ftp.l, Dirname.s, Log_Gadget)
     If Dirname
          ProcedureReturn FTP_Dialog(Ftp, "MKD " + Dirname, "257|500|550", Log_Gadget)
     Else
          ProcedureReturn #FTP_ERROR
     EndIf
EndProcedure
Procedure FTP_RemoveDir(Ftp.l, Dirname.s, Log_Gadget)
     ProcedureReturn FTP_Dialog(Ftp, "RMD " + Dirname, "250", Log_Gadget) ; "500"  ; Access denied, directory not empty
EndProcedure
Procedure FTP_Delete(Ftp.l, filename.s, Log_Gadget)
     If filename = ""
          ProcedureReturn #FTP_ERROR
     Else
          ProcedureReturn FTP_Dialog(Ftp, "DELE " + filename, "250|500", Log_Gadget) ; Note: zFTPServer responds 500 if the file doesn't exist, still OK
     EndIf
EndProcedure
Procedure FTP_Rename(Ftp.l, filename.s, newname.s, Log_Gadget)
     If filename = ""
          result = #FTP_ERROR
     Else
          result = FTP_Dialog(Ftp, "RNFR " + filename, "350|250", Log_Gadget) ; "500" = Access denied, file already exist
          If FindString(DialogAnswer$, "350", 0) ; Server responds 350 if the file to be renamed exists
               result = FTP_Dialog(Ftp, "RNTO " + filename, "250", Log_Gadget) = #FTP_OK
          EndIf
     EndIf
     ProcedureReturn result
EndProcedure
Procedure FTP_SetFileDate(Ftp.l, filename.s, YYYYMMDDHHMMSS$, Log_Gadget)
     ; ne marche pas.....
     ProcedureReturn FTP_Dialog(Ftp, "MDTM " + YYYYMMDDHHMMSS$ +" " + filename + #LFCR, "550|213", Log_Gadget)
EndProcedure
Procedure.s FTP_GetFileDate(Ftp.l, filename.s,  Log_Gadget)
     ; debug "Procedure.s FTP_GetFileDate(Ftp.l,filename.s,  Log_Gadget)"
     FTP_Dialog(Ftp, "MDTM " + filename + #LFCR, "550|213", Log_Gadget)
     pos = LookForReply(In, "213")
     ; debug pos
     ; debug In
     If pos>0
          ProcedureReturn Right(In, Len(In)- pos - 3)
     Else
          ProcedureReturn ""
     EndIf
     
EndProcedure
;}
;}