[Résolu] Problème envoye et recpetion en FTP (@Zapman...)

[olivier]

Salut à tous et particulièrement à Zapman qui sera peut être le seul à pouvoir me dépanner vu que le code vient de lui ....

Voilà je suis entrain de reprendre le code de transfert via FTP.
Je commence à le comprendre
Le passage à la V4 n'a pas posé de problème.

J'éspère ne pas m'être trompé en corrigeant le calcul de la progresse barre en upload ou download (rajout de file_size_restant)

Mon problème : j'ai fait un test avec un fichier word (text + image) et le fichier est apres l'upload ou le download, différent de l'original.

Je n'arrive pas bien à cibler le problème : problème avec le chr(13) ou avec une ligne rempli de chr(0) ????

Ce fichier est à cette adresse www.tib-net.com/test.doc

Voilà si vous quelqu'un peut me trouver une direction dans laquelle chercher cela serait bien coule.

Je joinds le code, mais il faut bien sur avoir acces à un site FTP et je ne donne pas mon mot de passe

bonne journée à tous et merci d'avance pour le temps passé.

Code : Tout sélectionner

; 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
;
#LFCR = Chr(13) + Chr(10)
#CRLF = Chr(10) + Chr(13)
;
#FTP_OK      =  1
#FTP_ERROR   =  0
#FTP_TimeOut = -1
;
;
Global FTP_Last_Message.s
Global PortID.l
Global Server$
;
;
Global ConnectionID.l
Global In.s
Global TotalBytesSent.l
Global TotalBytesRecd.l
;
Global CLog.s
;
#LongTimeOut  = 15000
#SmallTimeOut = 10000
;
#Block_size =8192   ; 128;1024;4096 ;
;
;
Structure FTPFileInfo
   Name$
   Hour$
   Day.l
   Month$
   FSize.l
EndStructure
;
Procedure Minimum(a,b)
   If a<b
      ProcedureReturn a
   Else
      ProcedureReturn b
   EndIf
EndProcedure
;
Procedure SendNetworkString2(CID, message$)
   If UCase(Left(message$,4))="PASS"
      CLog + "<---> PASS ****" + #LFCR
   Else
      CLog + "<---> "+RemoveString(message$, #LFCR) + #LFCR
   EndIf
   Debug "<---> "+RemoveString(message$, #LFCR) + #LFCR
   ProcedureReturn SendNetworkString(CID, message$)
EndProcedure
;
;
Procedure.s Wait(Connection, Timeout)
   Delay(10)
   BufferLenght = 32000
   *Buffer = AllocateMemory(BufferLenght)
   If *Buffer > 0
      Text.s = ""
      Repeat
         t = ElapsedMilliseconds()
         Size = -1
         Repeat
            result = NetworkClientEvent(Connection)
            If result <> 2 : Delay(5) : EndIf
         Until result = 2 Or ElapsedMilliseconds()-t > Timeout
         If result = 2
            Size = ReceiveNetworkData(Connection, *Buffer, BufferLenght)
            If Size > 0
               Text.s + PeekS(*Buffer,Size)
            EndIf
         EndIf
         If Size > 150
            Timeout = 1000
         Else
            Timeout = 50
         EndIf
      Until Size < 1
      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
         FreeMemory(*Buffer)
         CLog + ">---< "+Text + #LFCR
         Debug ">---< "+Text + #LFCR
         ProcedureReturn Text
      Else
         CLog + "Time Out" + #LFCR
         Debug "!!!  Time Out  !!!"
         FreeMemory(*Buffer)
         ProcedureReturn "TimeOut"
      EndIf
   EndIf
EndProcedure
;
Procedure.s PassiveIP(Text.s)
   s = FindString(Text, "(", 1)+1
   l = FindString(Text, ")", s)-s
   Host.s = Mid(Text, s, l)
   IP.s = StringField(Host, 1, ",")+"."+StringField(Host, 2, ",")+"."+StringField(Host, 3, ",")+"."+StringField(Host, 4, ",")
   ProcedureReturn IP.s
EndProcedure
;
Procedure.l PassivePort(Text.s)
   s = FindString(Text, "(", 1)+1
   l = FindString(Text, ")", s)-s
   Host.s = Mid(Text, s, l)
   Port = Val(StringField(Host, 5, ","))*256+Val(StringField(Host, 6, ","))
   ProcedureReturn Port
EndProcedure
;
Procedure Int_FTP_PASV(Ftp, Log_Gadget)
   If Log_Gadget
      AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PASV")
   EndIf
   If ConnectionID = 0
      ;
      SendNetworkString2(Ftp, "PASV" + #LFCR)
      ;
      In = Wait(Ftp, #SmallTimeOut)
      If In = "TimeOut"
         FTP_Last_Message = "Timed out"
         ProcedureReturn #FTP_TimeOut
      ElseIf In
         ; -- Analyze data --
         Select Left(In,3)
            
            Case "530" ; -- Error Parsing
               ProcedureReturn #FTP_ERROR
               
            Case "227" ; -- OK Parsing
               ; -- Get the PASV port assignment
               FTP_Last_Message + " [Port " + Str(PassivePort(In)) + "]"
               If Log_Gadget
                  AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + FTP_Last_Message)
               EndIf
               
               ConnectionID = OpenNetworkConnection(PassiveIP(In),PassivePort(In))
               
               If ConnectionID
                  ProcedureReturn #FTP_OK
               Else
                  ;MessageRequester("Debug","Failed to connect on PASV ClientPort: "+Str(ClientPort)+Chr(10)+Server$ + Chr(10) + PassiveIP(In),0)
                  FTP_Last_Message + Chr(10) + "Unable to establish PASV connection"
                  ProcedureReturn #FTP_ERROR
               EndIf
         EndSelect
      EndIf
   Else
      ProcedureReturn #FTP_OK
   EndIf
EndProcedure

Procedure Int_FTP_PASV_CLOSE()
   CloseNetworkConnection(ConnectionID)
   ConnectionID = 0
EndProcedure

Procedure.s FTP_Last_Message()
   ProcedureReturn FTP_Last_Message
EndProcedure

Procedure FTP_PutFile(ProgBarGadgetID.l,mem,file_size)
   file_size_restant=file_size
   If ConnectionID
      TotalBytesSent = 0
      Repeat
         toSend.l = Minimum(file_size_restant, #Block_size)

         ReadData(0,mem,toSend)

         Repeat
            result = SendNetworkData(ConnectionID, mem, toSend)
         Until result = toSend
 
         If result <> toSend
            FTP_Last_Message = "Data send failure"
            ProcedureReturn #FTP_ERROR
         EndIf
         ; Compute progress ----------------------------------
         TotalBytesSent + result
         If ProgBarGadgetID

            Progress.f = TotalBytesSent / file_size * 100
            SetGadgetState(ProgBarGadgetID,Progress)
            While WindowEvent() : Wend
         EndIf
         ; ---------------------------------------------------
         file_size_restant - result ; Decrement by bytes just sent
      Until file_size_restant = 0
      ProcedureReturn #FTP_OK
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_GetFile(ProgBarGadgetID.l,mem,file_size)
   file_size_restant=file_size
   If ConnectionID
      TotalBytesRecd = 0
      Repeat
         event = NetworkClientEvent(ConnectionID)
         Select event
            Case 2
               toRecv.l = Minimum(file_size_restant, #Block_size)
               result = ReceiveNetworkData(ConnectionID, mem, toRecv)
               WriteData(1,mem,result)
               ; Compute progress ----------------------------------
               TotalBytesRecd + result
               If ProgBarGadgetID
                  ; Display progress
                  Progress.f = TotalBytesRecd / file_size * 100
                  SetGadgetState(ProgBarGadgetID,Progress)
                  While WindowEvent() : Wend
               EndIf
               ; ---------------------------------------------------
               file_size_restant - result  ; Decrement by bytes just received
            Case 0
               ; Nothing received from server yet
            Case 3
               ; A file was received - shouldn't have happened
               FTP_Last_Message = "Error - A file waiting message received"
               ProcedureReturn #FTP_ERROR
         EndSelect
      Until file_size_restant = 0
      ProcedureReturn #FTP_OK
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_DirList(Ftp)
   FTP_Last_Message = ""
   If ConnectionID
      For vr = 1 To 10
         In = Wait(ConnectionID, 1000)
         If In = "TimeOut"
            R226.s = Wait(Ftp, 1000) ; look for "226 - transfert completed"
            If Left(R226,3)="226" ; end of transfert, we won't wait more
               In = Wait(ConnectionID, 1000) ; we try just one more time to be sure to miss no data
               vr = 10 ;                          and get out the loop
               If In = "TimeOut"
                  In = "" ; The directory is empty. We'll return #FTP_OK
               EndIf
            EndIf
         Else
            vr = 10 ; to get out the loop
         EndIf
      Next
      If Left(R226,3)<>"226"
         Wait(Ftp, #LongTimeOut)
      EndIf
      If In = "TimeOut"
         FTP_Last_Message = "Timed out while reading catalog"
         ProcedureReturn #FTP_TimeOut
      Else
         FTP_Last_Message + Trim(In.s)
         ProcedureReturn #FTP_OK
      EndIf
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure
;
Procedure.s ExtractFileInfo(DirEntry$,FTPInfo)
   *FTPInfoT.FTPFileInfo = FTPInfo
   DirEntry$ = ReplaceString(DirEntry$, "public", "ftp ftp", 1) ; modify for zFTP
   DirEntry$ = ReplaceString(DirEntry$, "  ", " ", 0)
   DirEntry$ = Trim(ReplaceString(DirEntry$, "  ", " ", 0))
   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)
   
   Temp = Len(Line$)
   For ct = 5 To 1 Step - 1 ; Examine data from end to start
      posf = Temp
      While Temp>0 And Asc(Mid(Line$,Temp,1))<>32 : Temp - 1 : Wend ; Look for space (separator)
      posd = Temp + 1
      Select ct
         Case 5
            *FTPInfoT\Name$ = Mid(Line$,posd,posf-posd + 1)
         Case 4
            *FTPInfoT\Hour$ = Mid(Line$,posd,posf-posd + 1)
         Case 3
            *FTPInfoT\Day   = Val(Mid(Line$,posd,posf-posd + 1))
         Case 2
            *FTPInfoT\Month$= Mid(Line$,posd,posf-posd + 1)
         Case 1
            *FTPInfoT\FSize = Val(Mid(Line$,posd,posf-posd + 1))
      EndSelect
      Temp - 1
      posf = Temp
   Next
   ProcedureReturn DirEntry$
EndProcedure
;
Procedure.s FTP_DirDisplay(gadget)
   Debug "Procedure.s FTP_DirDisplay(gadget)"
   DirEntry$ = Trim(In)
   Debug DirEntry$
   While DirEntry$
      DirEntry$ = ExtractFileInfo(DirEntry$,FTPInfo.FTPFileInfo)
      FileName$ = FTPInfo\Name$
      Debug "nom : "+FileName$ 
      file_size = FTPInfo\FSize
      Debug "taill "+Str(file_size)
      Debug "h "+FTPInfo\Hour$
      Debug "D "+Str(FTPInfo\Day)
      Debug "M "+FTPInfo\Month$
     ; Debug " "+FTPInfo\
      If FTPInfo\Name$<>"." And FTPInfo\Name$<>".."
         dir.s + FTPInfo\Name$ + Chr(13)
      EndIf
      If file_size And FileName$ <> "" And gadget
         FileType$ = LCase(StringField(FileName$,2,"."))
         FileName$ = RemoveString(FileName$,"." + FileType$,1)
         AddGadgetItem(gadget, -1, Chr(10) + FileName$ + Chr(10) + FileType$ + Chr(10) + Str(file_size))
         SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE,  CountGadgetItems(gadget) - 1, 0) ; Center justify column
         While WindowEvent() : Wend
         FileType$ = ""
         FileName$ = ""
      EndIf
      ;
   Wend
   ProcedureReturn dir
EndProcedure

;{Connection
Procedure FTP_Init()
   If InitNetwork()
      FTP_Last_Message = "Successfully started the TCP/IP stack..."
      ProcedureReturn #FTP_OK
   Else
      FTP_Last_Message = "Unable to start TCP/IP stack..."
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure
;
Procedure FTP_Connect(Server.s, PortNo.l) ; // Returns FTPconnection
   PortID.l = OpenNetworkConnection(Server,PortNo)
   ConnectionID = 0
   CLog = ""
   If PortID
      In = Wait(PortID, #SmallTimeOut)
      If In = "TimeOut"
         FTP_Last_Message = "Timed out"
         ProcedureReturn #FTP_TimeOut
      ElseIf In
         FTP_Last_Message = ReplaceString(FTP_Last_Message(),"***",Server,1)
         ; -- Analyze Data --
         Select Left(In,3)
            ; -- OK Parsing
            Case "220"
               If Log_Gadget
                  AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
               EndIf
               ProcedureReturn PortID
               ; -- Error Parsing
            Case "120"
            Case "421"
         EndSelect
      EndIf
   Else
      FTP_Last_Message = "Unable to connect to specified server"
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_Login(Ftp.l, User.s, Pass.s, Log_Gadget)
   If Ftp
      ; Online with the server
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "USER " + User.s)
      EndIf
      ;
      SendNetworkString2(Ftp,"USER " + User + #LFCR)
      ;
      Time.l = Date()
      Repeat
         In = Wait(Ftp, #SmallTimeOut)
         If In = "TimeOut"
            FTP_Last_Message = "Timed out"
            ProcedureReturn #FTP_TimeOut
         ElseIf In
            FTP_Last_Message = In
            ; -- Analyze Data --
            Select Left(In,3)
               
               ; -- OK Parsing
               Case "200" ; TYPE A ACCEPTED
                  If Log_Gadget
                     AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
                  EndIf
                  In.s = ""
                  ProcedureReturn #FTP_OK
               Case "230" ; LOGIN ACCEPTED
                  If Log_Gadget
                     AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
                  EndIf
                  SendNetworkString2(Ftp, "TYPE A" + #LFCR)
               Case "331"; Server requests a password
                  If Log_Gadget
                     AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PASS ********")
                  EndIf
                  SendNetworkString2(Ftp,"PASS " + Pass + #LFCR)
               Case "530"; -- Error Parsing
                  ProcedureReturn #FTP_ERROR
               Default
                  Delay(10)
                  If (Date()-Time)>#LongTimeOut
                     FTP_Last_Message = "Timed out"
                     ProcedureReturn #FTP_ERROR
                  EndIf
            EndSelect
         EndIf
      Until In = ""
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_LogOut(Ftp.l, Log_Gadget)
   If ConnectionID
      Int_FTP_PASV_CLOSE()
   EndIf
   ;
   If Ftp
      ; Online with the server
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "QUIT")
      EndIf
      ;
      SendNetworkString2(Ftp, "QUIT" + #LFCR)
      ;
      ProcedureReturn #FTP_OK
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure
;
Procedure FTP_Close(Ftp.l)
   If Ftp
      ; Online with the server
      If CloseNetworkConnection(Ftp)
         ;FTP_Last_Message="Successfully closed the specified ftp connection"
         ProcedureReturn #FTP_OK
      Else
         ;FTP_Last_Message="Connection previously closed or unable to close specified ftp connection"
         ProcedureReturn #FTP_ERROR
      EndIf
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure
;}
Procedure Parse226 () ; 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
   found = 0
   If Left(In,3) = "226"
      While In
         pos = 5
         While Val(Mid(In,pos,1)) Or Mid(In,pos,1)="0" Or pos>Len(In)
            pos + 1
         Wend
         If pos > 5
            NbrOfFiles = Val(Mid(In,5,pos-5))
            FTP_Last_Message = Str(NbrOfFiles)+" files were found"
            In = ""
         Else
            pos = FindString(In,#LFCR,0)
            If pos
               In = Right(In, Len(In)-pos-Len(#LFCR)+1)
            Else
               In = ""
            EndIf
         EndIf
      Wend
   EndIf
   ProcedureReturn NbrOfFiles
EndProcedure
;
Procedure FTP_Help(Ftp.l, ListArg$, Log_Gadget)
   If Ftp
      ; Attempt to create a PASV connection
      If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
         ProcedureReturn result
      EndIf
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "LIST"  + " " + ListArg$)
      EndIf
      ;
      SendNetworkString2(Ftp, "HELP " + ListArg$ + #LFCR)
      ;
      Time.l = Date()
      Repeat
         In = Wait(Ftp, #SmallTimeOut)
         If In = "TimeOut"
            FTP_Last_Message = "Timed out"
            ProcedureReturn #FTP_TimeOut
         ElseIf In
            ; -- Analyze data --
            If Left(In,3) = "125" Or Left(In,3) = "150"; Opened the data connection for the directory list (125 = zFTPServer, 150 = Broker)
               In = ""
               result = FTP_DirList(Ftp)
               Int_FTP_PASV_CLOSE()
               ProcedureReturn result
               ;
            ElseIf Left(In,3) = "451" Or Left(In,3) = "530"; -- Error Parsing
               Int_FTP_PASV_CLOSE()
               ProcedureReturn #FTP_ERROR
            Else
               If (Date()-Time)>#LongTimeOut
                  Int_FTP_PASV_CLOSE()
                  FTP_Last_Message = "Timed out"
                  ProcedureReturn #FTP_ERROR
               EndIf
            EndIf
         EndIf
      Until In = ""
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
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 result
      EndIf
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "LIST"  + " " + ListArg$)
      EndIf
      ;
      SendNetworkString2(Ftp, "LIST"  + " " + ListArg$ + #LFCR)
      ;
      Time.l = Date()
      Repeat
         In = Wait(Ftp, #SmallTimeOut)
         If In = "TimeOut"
            FTP_Last_Message = "Timed out"
            ProcedureReturn #FTP_TimeOut
         ElseIf In
            ; -- Analyze data --
            If Left(In,3) = "125" Or Left(In,3) = "150"; Opened the data connection for the directory list (125 = zFTPServer, 150 = Broker)
               In = ""
               result = FTP_DirList(Ftp)
               Int_FTP_PASV_CLOSE()
               ProcedureReturn result
               ;
            ElseIf Left(In,3) = "451" Or Left(In,3) = "530"; -- Error Parsing
               Int_FTP_PASV_CLOSE()
               ProcedureReturn #FTP_ERROR
            Else
               If (Date()-Time)>#LongTimeOut
                  Int_FTP_PASV_CLOSE()
                  FTP_Last_Message = "Timed out"
                  ProcedureReturn #FTP_ERROR
               EndIf
            EndIf
         EndIf
      Until In = ""
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_Retrieve(Ftp.l,filename.s,destination.s,ProgBarGadgetID.l, Log_Gadget)
   Debug filename+" to "+destination
   If Ftp
      ; Online with the server
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "SIZE"  + " " + ListArg$)
         Debug FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "SIZE"  + " " + ListArg$
      EndIf
      SendNetworkString2(Ftp,"SIZE " + filename + #LFCR) ; get the size of the file to download
      In = Wait(Ftp, #SmallTimeOut)
      If In = "TimeOut"
         FTP_Last_Message = "Timed out"
         ProcedureReturn #FTP_TimeOut
      Else
         If Left(In,3)="213"
            file_size.l = Val(Right(In, Len(In)-4))
         Else
            FTP_Last_Message = "File size has not been sent"
            ProcedureReturn #FTP_ERROR
         EndIf
      EndIf
      If file_size = 0
         FTP_Last_Message = "File size is null!"
         ProcedureReturn #FTP_ERROR
      EndIf
      Debug "OK"
      Debug file_size
      mem = AllocateMemory(Minimum(file_size, #Block_size))
      If mem>0
         If CreateFile(1,destination + "\" + filename) = 0
            FTP_Last_Message = "Unable to create file"
            FreeMemory(mem)
            ProcedureReturn #FTP_ERROR
         EndIf
      Else     
         ProcedureReturn #FTP_ERROR
      EndIf
      
      If ConnectionID = 0
         ; Attempt to create a PASV connection
         If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
            CloseFile(1)
            FreeMemory(mem)
            DeleteFile(destination + "\" + filename)
            ProcedureReturn #FTP_ERROR
         EndIf
      EndIf
      
      starttime.l = Date()
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "RETR " + filename)
      EndIf
      ;
      SendNetworkString2(Ftp,"RETR " + filename + #LFCR)
      ;
      Time.l = Date()
      Repeat
         In = Wait(Ftp, #LongTimeOut)
         If In = "TimeOut"
            FTP_Last_Message = "Timed out"
            CloseFile(1)
            FreeMemory(mem)
            Int_FTP_PASV_CLOSE()
            ProcedureReturn #FTP_TimeOut
         ElseIf In
            FTP_Last_Message = In
            
            ; -- Analyze data --
            If Left(In,3) = "125" Or Left(In,3) = "150" Or Left(In,3) = "226"
               result = FTP_GetFile(ProgBarGadgetID,mem,file_size)
               CloseFile(1)
               FreeMemory(mem)
               Int_FTP_PASV_CLOSE()
               If result <>  #FTP_OK
                  ProcedureReturn #FTP_ERROR
               EndIf
               If Left(In,3) <> "226" ; now, some server will send the #226 message and some will not
                  In = Wait(Ftp, 1000) ; we put a small timeout to avoid to loose to much time
                  If Left(In,3) = "226"
                     now.l = Date()
                     speed.f = 0
                     If (now - starttime) > 0
                        speed = (TotalBytesRecd / 1024) / (now - starttime)
                     Else
                        speed = TotalBytesRecd / 1024
                     EndIf
                     FTP_Last_Message + " -- " + Str(TotalBytesRecd) + " bytes (" + StrF(speed,2) + " Kb/sec)"
                  EndIf
               EndIf
               ProcedureReturn #FTP_OK
               
               ; -- Error Parsing
            ElseIf Left(In,3) = "425" Or Left(In,3) = "426" Or Left(In,3) = "501" Or Left(In,3) = "550" ; Unable to open the connection
               ; "426" means : "Data connection closed abnormally"
               CloseFile(1)
               FreeMemory(mem)
               Int_FTP_PASV_CLOSE()
               FTP_Last_Message = "Data connection closed abnormally"
               ProcedureReturn #FTP_ERROR
            Else
               Delay(10)
               If (Date()-Time)>#LongTimeOut
                  CloseFile(0)
                  FreeMemory(mem)
                  Int_FTP_PASV_CLOSE()
                  FTP_Last_Message = "Timed out"
                  ProcedureReturn #FTP_ERROR
               EndIf
            EndIf
         EndIf
      Until In = ""
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_CurrentDir(Ftp.l, Log_Gadget)
   If Ftp
      ; Online with server
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PWD")
      EndIf
      ;
      SendNetworkString2(Ftp, "PWD" + #LFCR)
      ;
      In = Wait(Ftp, #SmallTimeOut)
      If In = "TimeOut"
         FTP_Last_Message = "Timed out"
         ProcedureReturn #FTP_TimeOut
      ElseIf In
         
         FTP_Last_Message = In
         
         ; -- Analyze data --
         Select Left(In,3)
            ; -- OK Parsing
            Case "257"
               ProcedureReturn #FTP_OK
               ; -- Error Parsing
            Case "530"
               ProcedureReturn #FTP_ERROR
         EndSelect
      EndIf
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_ChangeDir(Ftp.l, Dirname.s, Log_Gadget)
   If Ftp
      ; Online with the server
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "CWD " + Dirname)
      EndIf
      ;
      SendNetworkString2(Ftp, "CWD " + Dirname + #LFCR)
      ;
      In = Wait(Ftp, #SmallTimeOut)
      If In = "TimeOut"
         FTP_Last_Message = "Timed out"
         ProcedureReturn #FTP_TimeOut
      ElseIf In
         FTP_Last_Message = In
         
         ; -- Analyze data --
         Select Left(In,3)
            
            Case "250" ; -- OK Parsing
               ProcedureReturn #FTP_OK
               
            Case "550" ; -- Error Parsing
               ProcedureReturn #FTP_ERROR
         EndSelect
      EndIf
   Else
      ProcedureReturn #FTP_ERROR
   EndIf
EndProcedure

Procedure FTP_Store(Ftp.l, filename.s, ProgBarGadgetID.l, Log_Gadget)
   ConnectionID = 0
   If Ftp
      ; Online with the server
      
      file_size.l = FileSize(filename)
      
      ;
      If OpenFile(0,filename) = 0
         FTP_Last_Message = "Unable to open file"
         ProcedureReturn #FTP_ERROR
      EndIf
      ;
      mem = AllocateMemory(Minimum(file_size, #Block_size)+4) ;+4 marge de sécurité
      If mem<1
         FTP_Last_Message = "Unable to allocate memory"
         CloseFile(0)
         ProcedureReturn #FTP_ERROR
      EndIf
      
      If ConnectionID = 0
         ; Attempt to create PASV connection
         If Int_FTP_PASV(Ftp, Log_Gadget) = 0
            CloseFile(0)
            FreeMemory(mem)
            ProcedureReturn #FTP_ERROR
         EndIf
      EndIf
      
      starttime.l = Date()
      If Log_Gadget
         AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "STOR " + GetFilePart(filename))
      EndIf
      ;
      SendNetworkString2(Ftp, "STOR " + GetFilePart(filename) + #LFCR)
      ;
      Time.l = Date()
      Repeat
         In = Wait(Ftp, #SmallTimeOut)
         If In = "TimeOut"
            FTP_Last_Message = "Timed out"
            CloseFile(0)
            FreeMemory(mem)
            Int_FTP_PASV_CLOSE()
            ProcedureReturn #FTP_TimeOut
         ElseIf In
            
            FTP_Last_Message = In
            
            ; -- Analyze data --
            If Left(In,3) = "125" Or Left(In,3) = "150" Or Left(In,3) = "226"
               
               result = FTP_PutFile(ProgBarGadgetID,mem,file_size)
               CloseFile(0)
               FreeMemory(mem)
               Int_FTP_PASV_CLOSE()
               If result <> #FTP_OK
                  ProcedureReturn #FTP_ERROR
               EndIf
               If Left(In,3) <> "226"
                  In = Wait(Ftp, #SmallTimeOut)
                  If Left(In,3) = "226"
                     now.l = Date()
                     speed.f = 0
                     If (now - starttime) > 0
                        speed = (TotalBytesSent / 1024) / (now - starttime)
                     Else
                        speed = TotalBytesSent / 1024
                     EndIf
                     FTP_Last_Message + " -- " + Str(TotalBytesSent) + " bytes (" + StrF(speed,2) + " Kb/sec)"
                  EndIf
               EndIf
               ProcedureReturn #FTP_OK
               ; -- Error Parsing
            ElseIf Left(In,3) = "501" Or Left(In,3) = "550"
          CloseFile(0)
          FreeMemory(mem)
          Int_FTP_PASV_CLOSE()
          ProcedureReturn #FTP_ERROR
        Else
          Delay(10)
          If (Date()-Time)>#LongTimeOut
            CloseFile(0)
            FreeMemory(mem)
            Int_FTP_PASV_CLOSE()
            FTP_Last_Message = "Timed out"
            ProcedureReturn #FTP_ERROR
          EndIf
        EndIf
      EndIf
    Until In = ""
  Else
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure

Procedure FTP_MakeDir(Ftp.l, Dirname.s, Log_Gadget)
  If Ftp
    ; Online with the server
    If Dirname = ""
      ProcedureReturn #FTP_ERROR
    EndIf
    ;
    If Log_Gadget
      AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "MKD " + Dirname)
    EndIf
    ;
    SendNetworkString2(Ftp, "MKD " + Dirname + #LFCR)
    ;
    In = Wait(Ftp, #SmallTimeOut)
    If In = "TimeOut"
      FTP_Last_Message = "Timed out"
      ProcedureReturn #FTP_TimeOut
    ElseIf In
      FTP_Last_Message = In
     
      ; -- Analyze data --
      Select Left(In,3)
       
      Case "257" ; -- OK Parsing
        In.s = ""
        ProcedureReturn #FTP_OK
      Case "500" ; Access denied, already exists
        In.s = ""
        ProcedureReturn #FTP_OK
      Case "550"
        In.s = ""
        ProcedureReturn #FTP_OK
        ; -- Error Parsing
      Case "530"
        ProcedureReturn #FTP_ERROR
      EndSelect
    EndIf
  Else
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure
;
Procedure FTP_RemoveDir(Ftp.l, Dirname.s, Log_Gadget)
  If Ftp
    ; Online with the server
    If Dirname = ""
      ProcedureReturn #FTP_ERROR
    EndIf
    ;
    If Log_Gadget
      AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "RMD " + Dirname)
    EndIf
    ;
    SendNetworkString2(Ftp, "RMD " + Dirname + #LFCR)
    ;
    In = Wait(Ftp, #SmallTimeOut)
    If In = "TimeOut"
      FTP_Last_Message = "Timed out"
      ProcedureReturn #FTP_TimeOut
    ElseIf In
      FTP_Last_Message = In
     
      ; -- Analyze data --
      Select Mid(In,1,3)
       
      Case "250" ; -- OK Parsing
        ProcedureReturn #FTP_OK
      Case "500"  ; Access denied, directory not empty
        ProcedureReturn #FTP_OK
        ; -- Error Parsing
      Case "550"
        ProcedureReturn #FTP_ERROR
      EndSelect
    EndIf
  Else
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure

Procedure FTP_Delete(Ftp.l, filename.s, Log_Gadget)
  If Ftp
    ; Online with the server
    If filename = ""
      ProcedureReturn #FTP_ERROR
    EndIf
    ;
    If Log_Gadget
      AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "DELE " + filename)
    EndIf
    ;
    SendNetworkString2(Ftp, "DELE " + filename + #LFCR)
    ;
    In = Wait(Ftp, #SmallTimeOut)
    If In = "TimeOut"
      FTP_Last_Message = "Timed out"
      ProcedureReturn #FTP_TimeOut
    ElseIf In
      FTP_Last_Message = In
     
      ; { -- Analyze data --
      Select Left(In,3)

      Case "250" ; -- OK Parsing
        ; Note: Server responds 250 if the file deleted successful or doesn't exist
        ProcedureReturn #FTP_OK
        ; -- Error Parsing
      Case "550"
        ; Note: zFTPServer responds 500 if the file doesn't exist, still OK
        ProcedureReturn #FTP_OK
      EndSelect
    EndIf
  Else
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure

Procedure FTP_Rename(Ftp.l, filename.s, newname.s, Log_Gadget)
  If Ftp
    ; Online with the server
    If filename = ""
      ProcedureReturn #FTP_ERROR
    EndIf

    If Log_Gadget
      AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "Rename " + filename + "to " + newname)
    EndIf
    ;
    SendNetworkString2(Ftp, "RNFR " + filename + #LFCR)
    ;
    In = Wait(Ftp, #SmallTimeOut)
    If In = "TimeOut"
      FTP_Last_Message = "Timed out"
      ProcedureReturn #FTP_TimeOut
    ElseIf In
      FTP_Last_Message = In
     
      ; { -- Analyze data --
      Select Left(In,3)
        ; -- OK Parsing
      Case "350"
        ; Server responds 350 if the file to be renamed exists
        ; and requests the new pathname
        SendNetworkString2(Ftp, "RNTO " + newname + #LFCR)
      Case "250"
        ; Server responds 250 if the file is successfully renamed
        ProcedureReturn #FTP_OK
        ; -- Error Parsing
      Case "500"  ; Access denied, file already exist
        ProcedureReturn #FTP_ERROR
      Case "550"
        ProcedureReturn #FTP_ERROR
      EndSelect
    EndIf
  Else
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure


FTP_Init()

ConnectID = FTP_Connect("ftp.tib-net.com", 21) 
FTP_Login(ConnectID, "tib-net","pass", Log_Gadget)
FTP_ChangeDir(ConnectID, "html/", Log_Gadget);nv_jlm/

;FTP_List(ConnectID, "*.*", Log_Gadget)
;FTP_DirDisplay(gadget)
;FTP_MakeDir(ConnectionID, "test", Log_Gadget)
;FTP_CurrentDir(ConnectID, Log_Gadget)
FTP_Store(ConnectID, "test.doc", 0, Log_Gadget)
;FTP_Retrieve(ConnectID,"test.doc","D:\JLM_Info\site\Logiciel\15_nv_synchro\test",0, Log_Gadget)

[Jacobus]

T'as essayé de le zipper ton fichier ?

Où as-tu un problème avec les chr() ?

[olivier]

Merci Jacobus de ta réponse.

Non je vais pas zipper mon fichier ou tout autre solution qui serait de ne pas envoyer mon fichier complet sur le FTP.

J'ai refais des test pour essayer de comprendre se qui se passe et lorsque j'envoie un fichier composer des caractères : 7 8 9 10 11 12 13 14 le ftp reçois un fichier : 7 8 9 13 10 11 12 Et lorsque je le download, je récupère 7 8 9 13 10 11 12
En fait le 13 se déplace, pour tant j'ai configuré l'envoye de donné de 1 Byte par 1 Byte
Et pour chaque 13 envoyé, le fichier est tranqué d'autant !

Voilà si vous avez une piste..... cela pourrait bien me dépanner car plus j'avance et plus je suis perdu....(il faudrait peut être que je fasse demi-tour avant de ne plus pouvoir revenir )

Code : Tout sélectionner

FTP_Init()

ConnectID = FTP_Connect("ftp.tib-net.com", 21) 
FTP_Login(ConnectID, "tib-net","pass", Log_Gadget)
FTP_ChangeDir(ConnectID, "html/", Log_Gadget)

CreateFile(0,"test.txt")
   For i=7 To 14
      WriteByte(0,i)
   Next
CloseFile(0)

CopyFile("test.txt","test_av.txt")



FTP_Store(ConnectID, "test_av.txt", 0, Log_Gadget)
FTP_Retrieve(ConnectID,"test_av.txt","D:\JLM_Info\site\Logiciel\15_nv_synchro",0, Log_Gadget)

FTP_LogOut(ConnectID, Log_Gadget)

[olivier]

OK merci à tous, c'est résolu,

Le prog se connectait au ftp avec un type A (ascii) au lieu d'un type I(8 bit-Binary)

J'ai trouvé la solution dans un code plus récent de Zapman (en plus je l'avais depuis le début)

Merci et bonne fin de week end !