FTP et Reprise

Droopy · Message par **Droopy** » mer. 07/mars/2007 22:11

Il existe des lib pour PureBasic qui gèrent le FTP, mais qui ne gèrent pas la pause / la reprise d'un téléchargement.

Auriez vous une idée comment gérer cela en PB ?

kwandjeen · Message par **kwandjeen** » jeu. 08/mars/2007 20:37

Tu peux voir du côté de :

FtpOpenFile
internetReadFile qui te donne le nombre d'octet téléchargé
internetsetfilepointer pour te positionner dans un fichier

internetreadfile_(hfile(donné par ftpopen),buffer réception,nombre octet à lire,@nombre octet recu)
internetsetfilepointer_(hfile,nombre d'octet à avancer,0,#FILE_BEGIN ou #FILE_CURRENT ou #FILE_END,0)

Je suis moi aussi entrain de me faire un soft de transfert FTP avec les apis windows alors je tatonne et ne te garantie pas que cela fonctionne avec ça mais si j'y suis avant toi je te posterai mes résultats.

Et si ça peux aider d'autres personnes voir pour faire une lib assez complète

Stefou · Message par **Stefou** » jeu. 08/mars/2007 21:01

Zapman avait sortie un code, qui n'inclus pas la pause mais je pense qu'il doit être façile de l'insérer dans son code.
J'y ai fait quelque modif...

De mémoire il n'y a pas d'api dedans, ce qui peut apporter une certaine stabilité...enfin moi je préfère.

Perso j'ai fait ma petite "lib" de synchronisation d'un répertoire local avec un sur le net, et cela marche tres bien.

Code : Tout sélectionner

;{-*-*-*- 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 a<b
          ProcedureReturn 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
;}
;}

Droopy · Message par **Droopy** » jeu. 08/mars/2007 21:25

Merci beaucoup, je vais regarder ça avec attention

lionel_om · Message par **lionel_om** » ven. 09/mars/2007 12:08

"ProgressBarDouble()" vient d'une de tes lib ?

Stefou · Message par **Stefou** » ven. 09/mars/2007 19:04

ProgressBar() et est procedure qui affiche une barre de progression avec le nom du fichier en cours.

Code : Tout sélectionner

;{Procedure pour lister les fichiers sur internet
Procedure ProgressBarDouble(message$,pourcent=0,pourcent2=0); la barre de progression double pour le web
     ;{Sauvegarde du dernier message; si seulement les pourcentage change on garde l'ancien message
     If message$="" : message$=der_message$ : EndIf
     If pourcent=-1 : pourcent=der_pourcent : EndIf
     der_message$=message$
     der_pourcent= pourcent
     ;}
     
     l=ImageWidth(#synchro_im_barre_progress)
     h=ImageHeight(#synchro_im_barre_progress)
     If  StartDrawing(ImageOutput(#synchro_im_barre_progress))
          
          ;{Dessin du fond orange de la bar
          d=5
          For i=0 To h/2
               LineXY(0,h/2-i,l,h/2-i,RGB(209+i*d,140+i*d,62+i*d))
               LineXY(0,h/2+i,l,h/2+i,RGB(209+i*d,140+i*d,62+i*d))
          Next
          ;}
          
          ;{Dessin de la barre Verte(Progression principal)
          If pourcent>0
               d=5
               For i=0 To h/2
                    LineXY(0,h/2-i,pourcent*l/100,h/2-i,RGB(70-i*d,215-i*d,86-i*d))
                    LineXY(0,h/2+i,pourcent*l/100,h/2+i,RGB(70-i*d,215-i*d,86-i*d))
               Next
          EndIf
          ;}
          
          ;{Dessin de la barre Jaune (progression fichier en cours)
          ph=h*2/3
          If pourcent2>0
               
               d=20
               For i=0 To 3
                    LineXY(0,h-3-i,pourcent2*l/100,h-3-i,RGB(241-i*d,239-i*d,139-i*d))
                    LineXY(0,h-3+i,pourcent2*l/100,h-3+i,RGB(241-i*d,239-i*d,139-i*d))
               Next
          EndIf
          ;}
          
          ;{Affichage du texte
          FrontColor(0)
          DrawingMode(1)
          
          If pourcent2>0 : fin_message$=" "+Str(pourcent2)+" %" : Else : fin_message$="" : EndIf
          DrawText(3,1," "+message$+fin_message$)
          StopDrawing()
          ;}
          
     EndIf
     
     SetGadgetState(#synchro_im_barre_progress,ImageID(#synchro_im_barre_progress))
     
EndProcedure

lionel_om · Message par **lionel_om** » ven. 09/mars/2007 21:43

J'ai plusieurs questions :
* Pourquoi tu n'utilise pas la constante #PB_Any pour les images ?
* Pourquoi tu ne passes pas l'ID du Gadget dans ta fonction
* Il faut que tu fasse un DeleteImage() après SetGadgetState()

Avec ces modifs tu pourrais réutiliser plus facilement ta fonction dans d'autres projets

Lio

Stefou · Message par **Stefou** » sam. 10/mars/2007 8:59

Salut Lionel

Pourquoi, pourquoi, pourquoi ?

Ben parce qu'a lorsque j'ai écrit ce code je ne connaissais pas #Pb_any, je ne sais pas toujours où je vais et comment je vais y aller. Cela ne fait que 2 ans que je programme.

Que j'ai toujours énormément de projet pour prendre le temps de corrigé un code qui fait ce que j'ai besoins.

Mais cela dit tes conseils sont judicieux, et je t'en remercie

Il faut que tu fasse un DeleteImage() après SetGadgetState()

Dans quel but étant donné que cette image sert toute les secondes ?.

Bonne journée

lionel_om · Message par **lionel_om** » sam. 10/mars/2007 14:43

Stefou a écrit :
Il faut que tu fasse un DeleteImage() après SetGadgetState()
Dans quel but étant donné que cette image sert toute les secondes ?.

A ne pas saturer la mémoire !!!

Fais tourner ton programme pendant une heure, voir plus et selon ta RAM, je suis sûr que tu vas avoir un problème de mémoire disponible...

kwandjeen · Message par **kwandjeen** » dim. 11/mars/2007 17:37

Bon comme promis voici avec les apis windows et cela fonctionne nickel chez moi :

Code : Tout sélectionner

If InternetAttemptConnect_(0) = 0
  netcon.l = InternetOpen_("", 1, 0, 0, 0)
  ftpcon.l = InternetConnect_(netcon, @serveur, 21, @login, @pass, 1, 0, 0)
endif
hfile.l = FtpOpenFile_(ftpcon,"fichier",#GENERIC_READ,2,0)
CreateFile(1, "c:\monfichier") 
  fin_fichier.b=0
  octet_recu.l=0 
  octet_a_lire.l = 4096
  tampon = AllocateMemory(octet_a_lire)
Repeat
    InternetReadFile_(hfile, tampon, octet_a_lire, @octet_recu)
    if octet_recu = 0
       fin_fichier = 1
    else
       WriteData(1,tampon, octet_recu)      
    EndIf
    if condition pour pause
       procedure pause
    endif
  Until fin_fichier = 1
  CloseFile(1)

J'ai mis l'essentiel si vous avez un prob j'expliquerai plus en détail.

++

Stefou · Message par **Stefou** » mar. 13/mars/2007 8:23

@Lionel_om

A ne pas saturer la mémoire !!! Laughing
Fais tourner ton programme pendant une heure, voir plus et selon ta RAM, je suis sûr que tu vas avoir un problème de mémoire disponible...

En est-tu si sur ? Tu rajoutes un petit bonhomme qui rigole, comme si ma question est impertinante, mais a tu testé tes dire ?

Bon allez je me lance, car mon but est de savoir le vrai du faux et de comprendre.
Voici un petit exemple dans lequel je recrée même une image à chaque fois, l'un sature et pas l'autre.... même sans DeleteImage(). Celui qui sature, sature de façon normale car je créer une nouvelle image à chaque fois. Il permet de voir la mémoire se saturer.

Code : Tout sélectionner

Global compt
compt=0
#l=680
#h=450
Procedure charge_image()
     compt=compt+1
     If compt>680 : compt=1 : EndIf
     id_im=CreateImage(#PB_Any,#l,#h)
     StartDrawing(ImageOutput(id_im))
     Box(0,0,#l,#h,$58CF6E)
     Box(0,0,compt,#h,$48BADF)
     StopDrawing()
     SetGadgetState(1,ImageID(id_im))
EndProcedure
Procedure charge_image2();sans satu
     compt=compt+1
     If compt>680 : compt=1 : EndIf
     id_im=7
     CreateImage(id_im,#l,#h)
     StartDrawing(ImageOutput(id_im))
     Box(0,0,#l,#h,$58CF6E)
     Box(0,0,compt,#h,$48BADF)
     StopDrawing()
     SetGadgetState(1,ImageID(id_im))
EndProcedure
OpenWindow(0,10,10,700,500,"Test")
CreateGadgetList(WindowID(0))
ImageGadget(1,2,44,#l,#h,0)
ButtonGadget(2,2,2,200,20,"Avec saturation de mémoire")
ButtonGadget(4,2,22,200,20,"Sans saturation de mémoire")

Repeat
     event=WaitWindowEvent()
     Select event
          Case #PB_Event_Gadget
               Select EventGadget()
                    Case 2
                         For i=1 To 1000
                              Delay(7)
                              charge_image()
                         Next
                    Case 4
                         For i=1 To 1000
                              Delay(7)
                              charge_image2()
                         Next
               EndSelect
               
               
     EndSelect
     
     
Until event=#WM_CLOSE

Stefou · Message par **Stefou** » mar. 13/mars/2007 11:41

Je viens de finir de nettoyer mon code d'utilisation des fonctions FTP, je l'ai poster dans Truc et Astuces

Bonne journée