[Résolu]Accès FTP

Ollivier · Message par **Ollivier** » mer. 25/juil./2007 19:59

Est-ce qu'il est possible de traiter un répertoire FTP sous PB?
(Ouverture : -3 chaînes en tant que paramètres-
Adresse URL "FTP:// etc..."
Nom utilisateur
Mot de passe utilisateur)

Droopy · Message par **Droopy** » mer. 25/juil./2007 21:03

peut tu préciser svp, je pas comprendre

Ollivier · Message par **Ollivier** » jeu. 26/juil./2007 0:00

Puissé-je jouir d'une connection à mon répertoire FTP par une procédure dans laquelle je précise 3 paramètres :
URL.S = "FTP://monsite.orange.fr/"
NomMessagerie.S = "Tartempion"
MotDePasseMessagerie.S = "x5v18z3"

Et zoup, il se connecte à mon répertoire distant!

Droopy · Message par **Droopy** » jeu. 26/juil./2007 0:09

Je plaisantais pour 'pas comprendre'

Voici un code de DoubleDutch mis à ma sauce ( pour pb 3.94 )

Code : Tout sélectionner

;/ DoubleDutch : http://www.purebasic.fr/english/viewtopic.php?t=25662&highlight=ftp

;{ Versions
; #6 = Ajout #PB_Any pour les fichiers

;}

;{- Procédures FTP API

Procedure FtpOpen(server.s,user.s,Password.s,) 
  
  Static Init
  If Init=0
    Init=1
    NewList Liste.WIN32_FIND_DATA()
  EndIf
  
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  
  ftp_hopen=InternetOpen_("FTP",1,"","",0) 
  If ftp_hopen 
     
    ftp_hconnect=InternetConnect_(ftp_hopen,server,21,user,Password,1,0,0) 
    If ftp_hconnect 
      result=#True 
    Else 
      InternetCloseHandle_(ftp_hopen) 
      ftp_hopen=0 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure.l FtpDir() 
  
  ClearList(Liste())
  
  Shared ftp_hopen,ftp_hconnect
  
  hFind=FtpFindFirstFile_(ftp_hconnect,"*.*",@file.WIN32_FIND_DATA,0,0)
  
  If hFind
    Repeat
      
      If PeekS(@file\cFileName)<>"." And PeekS(@file\cFileName)<>".."
        AddElement(Liste())
        CopyMemory(@file,@Liste(),SizeOf(WIN32_FIND_DATA))
      EndIf
     
    Until InternetFindNextFile_(hFind,@file)=0
    InternetCloseHandle_(hFind) 
  EndIf
  
  ProcedureReturn CountList(Liste())
EndProcedure 

Procedure FtpSetPath(dir.s) ; "" A VERIFIER
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    result=FtpSetCurrentDirectory_(ftp_hconnect,dir) 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure.s FtpGetPath() ; "" A VERIFIER
  
  Shared ftp_hopen,ftp_hconnect 
  
  If ftp_hconnect 
    dir.s=Space(#MAX_PATH)
    ldir=Len(dir)
    FtpGetCurrentDirectory_(ftp_hconnect,@dir,@ldir) 
  EndIf 
  ProcedureReturn dir
EndProcedure 

Procedure FtpCreateDirectory(dir.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    dir=Trim(dir) 
    If dir<>"" 
      result=FtpCreateDirectory_(ftp_hconnect,dir) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpDeleteDirectory(dir.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  
  ReplaceString(dir,"\","/",2) 
  result=#False 
  If ftp_hconnect 
    dir=Trim(dir) 
    If dir<>"" 
      result=FtpRemoveDirectory_(ftp_hconnect,dir) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpDeleteFile(file.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    file=Trim(file) 
    If file<>"" 
      result=FtpDeleteFile_(ftp_hconnect,file) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpRename(source.s,dest.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    source=Trim(source) 
    dest=Trim(dest) 
    If source<>"" And dest<>"" 
      result=FtpRenameFile_(ftp_hconnect,source,dest) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpDownload(source.s,dest.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    source=Trim(source) 
    If source<>"" 
      If dest="" 
        dest=source 
      EndIf 
      result=FtpGetFile_(ftp_hconnect,source,dest,0,0,2,0) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpUpload(source.s,dest.s) 
  
  Shared ftp_hopen,ftp_hconnect 
  
  result=#False 
  If ftp_hconnect 
    source=Trim(source) 
    If source<>"" 
      If dest="" 
        dest=source 
      EndIf 
      result=FtpPutFile_(ftp_hconnect,source,dest,2,0) 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure FtpClose() 
  
  Shared ftp_hopen,ftp_hconnect 
  
  If ftp_hconnect 
    InternetCloseHandle_(ftp_hconnect) 
    InternetCloseHandle_(ftp_hopen) 
  EndIf 
EndProcedure

Procedure FtpDownload2Mem(source.s) ; ts-soft
  
  Shared ftp_hopen,ftp_hconnect  
 
  Protected hFile.l, Mem.l, hSize.l, hSizeError.l, lpdwNumberOfBytesRead.l 
  hFile = FtpOpenFile_(ftp_hconnect, @source, #GENERIC_READ, 2, 0) 
  hSize = FtpGetFileSize_(hFile, @hSizeError) 
  If hSize > 0 
    Mem = AllocateMemory(hSize) 
    If Mem <> 0 
      If InternetReadFile_(hFile, Mem, hSize, @lpdwNumberOfBytesRead) 
        ProcedureReturn Mem 
      Else 
        FreeMemory(Mem) 
        ProcedureReturn -1 
      EndIf 
    EndIf 
  EndIf 
EndProcedure 

Procedure.l FtpUploadProgress(source.s, dest.s, ProgressID.l) ; -1 = Pas de gadget / Code by al90
  
  ;/Thread : http://www.purebasic.fr/german/viewtopic.php?t=11867&postdays=0&postorder=asc&highlight=ftpdownloadprogress&start=20
  
  Shared ftp_hopen,ftp_hconnect,ftpFlagStop,ftpTailleEnCours
  ftpTailleEnCours=0

  Bytes.l = 0 
  BlockSize.l=4096 
  x=FileSize(source)
  blocks.l=x/BlockSize : rest.l=x-(blocks*BlockSize) 
  dest=ReplaceString(dest,"\","/") 
  Mem.l=AllocateMemory(BlockSize) 
  
  hFile.l = FtpOpenFile_(ftp_hconnect, @dest, #GENERIC_WRITE, 0, 0) 
  
  If hFile <> #Null 
    Fid=ReadFile(#PB_Any,source) 
    If Fid

      If blocks>0 
        For i=1 To blocks 
          
          ;/ Annule l'upload si FtpStop
          If ftpFlagStop
            InternetCloseHandle_(hFile)
            CloseFile(Fid) 
            ftpFlagStop=#False
            ProcedureReturn
          EndIf
          
          If ProgressID<>-1
            percent.f=i/blocks*100
            SetGadgetState(ProgressID,percent) 
          EndIf
           
          ReadData(Mem, BlockSize) 
          y.l=InternetWriteFile_(hFile, Mem, BlockSize, @Bytes) 
          ftpTailleEnCours=Loc()
          If y=#False : rest=0 : Break : EndIf 
        Next 
      EndIf 
      If rest>0 
        ReadData(Mem, rest) 
        y.l=InternetWriteFile_(hFile, Mem, rest, @Bytes) 
        ftpTailleEnCours=Loc()
        If ProgressID<>-1
          SetGadgetState(ProgressID,100) 
        EndIf
      EndIf 
      CloseFile(Fid) 
    EndIf 
    InternetCloseHandle_(hFile) 
  EndIf 
  
  FreeMemory(Mem) 
  ProcedureReturn y 
  
EndProcedure 

Procedure.l FtpDownloadProgress(source.s, dest.s, ProgressID.l) ; -1 = Pas de gadget / Code by al90
  
  ;/Thread : http://www.purebasic.fr/german/viewtopic.php?t=11867&postdays=0&postorder=asc&highlight=ftpdownloadprogress&start=20
  
  Shared ftp_hopen,ftp_hconnect,ftpFlagStop,ftpTailleEnCours
  ftpTailleEnCours=0
  
  hFile.l = FtpOpenFile_(ftp_hconnect, @source, #GENERIC_READ, 2, 0) 
  x=FtpGetFileSize_(hFile, @hSizeError)
  
  Bytes.l = 0 
  BlockSize.l=4096 
  blocks.l=x/BlockSize : rest.l=x-(blocks*BlockSize) 
  ReplaceString(source,"\","/",2) 
  Mem.l=AllocateMemory(BlockSize) 
  
  If hFile <> #Null 
    Fid=CreateFile(#PB_Any,dest) 
    If Fid
      
      If blocks>0 
        For i=1 To blocks 
          
          ;/ Annule l'upload si FtpStop
          If ftpFlagStop
            InternetCloseHandle_(hFile)
            CloseFile(Fid) 
            ftpFlagStop=#False
            ProcedureReturn
          EndIf
          
          If ProgressID<>-1
            percent.f=i/blocks*100
            SetGadgetState(ProgressID,percent) 
            ftpTailleEnCours=Loc()
          EndIf
          
          y.l=InternetReadFile_(hFile, Mem, BlockSize, @Bytes) 
          WriteData(Mem, BlockSize) 
          ftpTailleEnCours=Loc()
          If y=#False : rest=0 : Break : EndIf 
        Next 
      EndIf 
      
      If rest>0
        
        y.l=InternetReadFile_(hFile, Mem, rest, @Bytes) 
        WriteData(Mem, rest) 
        If ProgressID<>-1
          SetGadgetState(ProgressID,100) 
        EndIf
      EndIf 
      CloseFile(Fid) 
    EndIf 
    InternetCloseHandle_(hFile) 
  EndIf 
  
  FreeMemory(Mem) 
  ProcedureReturn y 
  
EndProcedure 

Procedure FtpFileSize(source.s)
  
  Shared ftp_hopen,ftp_hconnect 
  
  hFile.l = FtpOpenFile_(ftp_hconnect, @source, #GENERIC_READ, 2, 0) 
  x=FtpGetFileSize_(hFile, @hSizeError)
  Debug "---> " +Str(x)
  
  InternetCloseHandle_(hFile) 
  ProcedureReturn x
  
EndProcedure  

Procedure FtpStop() ; Annule FtpUploadProgress / FtpDownloadProgress
  Shared ftpFlagStop
  
  ftpFlagStop=#True
EndProcedure

Procedure FtpTailleEnCours()
  Shared ftpTailleEnCours
  ProcedureReturn ftpTailleEnCours
EndProcedure

;}

;{/ Tests divers
; Debug FtpOpen("localhost","anonymous","")
; Debug FtpDir("*.*")
; FtpClose()
; 
; Debug FtpOpen("localhost","anonymous","")
; Debug FtpDir("*.*")
; FtpClose()

  
; FtpOpen("172.16.30.208","anonymous","")
; Debug FtpDir()
; ForEach Liste()
  ; Debug "Fichier n° "+Str(ListIndex(Liste()))+" : "+PeekS(@Liste()\cFileName)
  ; Debug "Attribut : "+Str(Liste()\dwFileAttributes) ;/ 16 = Répertoire
  ; Debug "Taille : "+Str(Liste()\nFileSizeLow)
  ; Debug "Date de création : "+Str(Liste()\ftCreationTime)
  ; Debug ""
; Next  
;}

;{/ Test Visuel #1
#Fichier="puca.swf"

Procedure DoIt()
  CopyFile("C:\puca\animations\Pucca 30 - Winter Story.swf","c:\"+#Fichier)
  Debug FtpOpen("localhost","anonymous","")
  FtpUploadProgress("c:\"+#Fichier,#Fichier,0)
  FtpDownloadProgress(#Fichier,"c:\puca2.swf",0)
  
  FtpDir()
  Debug "Taille "+Str(FtpFileSize(#Fichier))
  FtpClose()
  
  Debug MD5FileFingerprint(#Fichier)
  Debug MD5FileFingerprint("c:\puca2.swf")
  
  End
 
EndProcedure

; OpenWindow(0,0,0,320,40,#PB_Window_SystemMenu | #PB_Window_ScreenCentered,"FTP")
; CreateGadgetList(WindowID(0))
; ProgressBarGadget(0,10,10,300,20,0,100,#PB_ProgressBar_Smooth  )
; CreateThread(@DoIt(),0)
  ; 
; Repeat :Until WaitWindowEvent()=#PB_Event_CloseWindow
;}

;{/ Idées
;/ InternetSetFilePointer --> Définit emplacement pour reprise ?

;/ Incase anyone is interested Or searching, i was finally able To do this by using the function FtpCommand And 
;/ manually sending the "REST" command allong with the byte number i would like To resume from... ex: "REST 1024" 
;/ To resume starting on the 1024th byte. You then must download the file using FtpOpenFile And InternetReadFile. 
;/ the FtpCommand must come BEFORE the open file Or the downloading will not work.
;}

;{/ Autre Visuel 

Enumeration
  #ProgressBar
  #Texte
  #StatusBar
  #Bouton
EndEnumeration

Procedure AfficheTailleEnCours()
  Repeat
    Delay(10)
    T=FtpTailleEnCours()
    If T>0
      StatusBarText(#StatusBar,1,Str(T/1024)+" Ko  ",#PB_StatusBar_Right)
    Else
      StatusBarText(#StatusBar,1,"")
    EndIf
  ForEver
EndProcedure
      

Procedure DoIt2()
  StatusBarText(#StatusBar,0," Creating File")
  CreateSizedFile("c:\1.txt",200)
  FtpOpen("172.16.30.208","anonymous","")
  StatusBarText(#StatusBar,0," Uploading")
  HideGadget(#ProgressBar,#False)
  FtpUploadProgress("c:\1.txt","1.txt",#ProgressBar)
  StatusBarText(#StatusBar,0," Downloading")
  FtpDownloadProgress("1.txt","c:\1.txt",#ProgressBar)
  FtpClose()
  HideGadget(#ProgressBar,#True)
  StatusBarText(#StatusBar,1,"")
  StatusBarText(#StatusBar,0," Done")
  
EndProcedure

; OpenWindow(0,0,0,320,60,#PB_Window_SystemMenu | #PB_Window_ScreenCentered,"Test de la librairie FTP")
; CreateGadgetList(WindowID(0))
; TextGadget(#Texte,10,10,200,20,"PureBasic FTP with Win32 API")
; ButtonGadget(#Bouton,220,10,90,20,"ANNULER")
; StaturBarId=CreateStatusBar(#StatusBar,WindowID())
; AddStatusBarField(240)
; AddStatusBarField(80)
; CreateGadgetList(StaturBarId)
; ProgressBarGadget(#ProgressBar,80,7,150,10,0,100,#PB_ProgressBar_Smooth)
; HideGadget(#ProgressBar,#True)
; CreateThread(@DoIt2(),0)
; CreateThread(@AfficheTailleEnCours(),0)
  ; 
; Repeat
  ; Event=WaitWindowEvent()
  ; If Event=#PB_Event_Gadget And EventGadgetID()=#Bouton And EventType()=#PB_EventType_LeftClick 
    ; FtpStop()
  ; EndIf
; Until Event=#PB_Event_CloseWindow
;}