[RESOLU]Problème avec SetFTPDirectory

omega · Message par **omega** » dim. 24/mars/2013 15:29

Salut

Voici un exemple trouvé sur l'aide pb:

If SetFTPDirectory(0, "pub")
      If SetFTPDirectory(0, "linux")
        Debug "Cool, changed to '/pub/linux'"
        Debug GetFTPDirectory(0)
EndIf

Pour parcourir un répertoire ftp on fait:
If SetFTPDirectory(0, "pub")
etc.
etc..

Et si on veut pacourir un sous-répertoire de celui ci, on fait
If SetFTPDirectory(0, "linux")

Ici on est là: /pub/linux

Mais si je veux retourner au répertoire pub? comment faire? (ou rép précédent?)

merci

Message par **Fred** » dim. 24/mars/2013 15:34

essaies SetFTPDirectory(0, "..")

omega · Message par **omega** » dim. 24/mars/2013 15:47

Non... ça n'a pas marché Fred...

Je vais essayer une autre astuce s'il n'y a pas de solution ftp

(par exemple mémoriser les chemins avec des indices etc..) bon on verra

Merci quand même Fred

Azur · Message par **Azur** » lun. 25/mars/2013 1:13

Hello.
Bah attend c'est quand même bizarre ton problème.
T'es sur que avec un directory du type "..\" ou ".." ça marche pas ?
Pasque vas y gérer les chemins dans des listes bonjour l'usine à gaz. Et puis comment tu vas gérer la création d'un nouveau répertoire pas un autre utilisateur qui FTP en même temps depuis un autre poste ?
Non sérieux a mon avis y a plus simple.
Pourquoi tu créerais pas une variable dossierParent.s par exemple au moment de descendre d'un niveau dans l'arborescence.
Et puis tu devrais tenir plus compte des réponses du petit Frédéric, c'est sûr qu'il paye pas de mine mais il a l'air de bien maitriser PB je trouve.
Bon plaisanteries mises à part, bonne continuation à toi et tiens nous au courant, le coup du ".." ou "..\" faudrait qu'on sache et j'ai pas de quoi tester un ftp là sous la main.
++

Message par **Fred** » lun. 25/mars/2013 10:56

Ici, ca marche:

Code : Tout sélectionner

  InitNetwork()
  
  If OpenFTP(0, "ftp.free.fr", "anonymous", "")
    
    Debug "Successfully connected"
    
    If SetFTPDirectory(0, "pub")
      If SetFTPDirectory(0, "linux")
        Debug "Cool, changed to '/pub/linux'"
        Debug GetFTPDirectory(0)
        SetFTPDirectory(0, "..")
        Debug GetFTPDirectory(0)
      Else
        Debug "Can't change to '/pub/linux'"
      EndIf
    Else
      Debug "Can't change to 'pub'"
    EndIf
    
  Else
    Debug "Can't connect to ftp.free.fr"
  EndIf

omega · Message par **omega** » lun. 25/mars/2013 11:33

Bonjour

Ok Fred! ça marche, c'est moi qui déconne. Le changement de chemin marche bien, c'est l'affichage de ce répertoire qui ne marche pas à mon niveau, je vais voir pourquoi ...

Merci beaucoup

@ Azur! tu as pris quoi ce matin?? (rire)

omega · Message par **omega** » lun. 25/mars/2013 11:35

Ah j'allais oublier !

@azur
Quelle est la différence entre ".." et "..\" ??

Merci

Azur · Message par **Azur** » lun. 25/mars/2013 13:21

Salut, bah a priori ca fonctionne bien avec '..' , si j'avais eu le bug mon premier reflex aurait ete de mettre '..\' un peu comme pour adresser la racine tu ferais 'c:\' . Ca m'aurait donne l'impression de nommer explicitement un emplacement, mais bon ...

omega · Message par **omega** » lun. 25/mars/2013 13:49

Bon, le ".." marche bien. Mais maintenant, je constate un autre problème, cette fois c'est vraiment bizarre, car je n'ai jamais cru qu'un bug de ce genre puisse avoir lieu... C'est vraiment bizarre croyez-moi: voici ce qui se passe:

Quand je teste le changement des chemins et l'affichage du contenu, ça marche très bien sur un serveur X, mais quand je teste un autre serveur, ça ne marche pas du tout, ni du côté changement de répertoire ni du côté affichage du contenu, j'ai ajouté un debug pour voir si le répertoire a changé, la réponse est non. C'est donc le SetFTPDirectory() qui ne fonctionne pas...
Il ne s'agit pas seulement du répertoire précédent ".." mais même pour les chemins nommés (rep1, rep2 etc..)
Ce que je ne comprends pas, c'est que ça marche bien sur un premier serveur mais ça ne marche pas du tout sur un deuxième serveur...

Pourriez-vous tester avec vos différents serveurs (il faut essayer plusieurs)...

Merci

omega · Message par **omega** » lun. 25/mars/2013 14:01

Voici le code (à tester sur différents serveurs)

Code : Tout sélectionner

Enumeration
#Mainform
#SeparLigne1
#SeparLigne2
#Source
#Destination
#Connection
#Deconnection
#FrameFtpInfo
#FTP_Serveur_Txt
#FTP_Serveur
#exemple1
#FTP_User_Txt
#FTP_User
#exemple2
#FTP_Mp_Txt
#FTP_Mp
#FTP_LocalPath_Txt
#FTP_LocalPath
#FTP_Path_Txt
#FTP_Path
#exemple3
#exemple4

#FTP_SupprimerServeur
#FTP_SupprimerTout

#CheckMemoriser_Param
#CheckMemoriser_Mp

#FrameFtpCon
#Previous_PathFTP
#Ftp_Prog
#FTP_Parcourir

#FTP_Progres

#Dir

#HOME_Explorer_Rep
#HOME_Explorer

#FTP_Explorer_Rep
#FTP_Explorer

#Transferer
#StatutList
#Ftp

#FTP_Delete

#FrameObs
#Obs
#FrameProt
#CheckApsi
#Apsi

#CopyRight
EndEnumeration

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseSQLiteDatabase()

trans=CatchImage(0, ?trans)
parcourir=CatchImage(1, ?parcourir)
connecter=CatchImage(2, ?connecter)
previouspath=CatchImage(3, ?previouspath)
connecter=CatchImage(4, ?deconnecter)
supprimer=CatchImage(5, ?supprimer)

DataSection
trans:
IncludeBinary "images\trans.jpg"
parcourir:
IncludeBinary "images\open.jpg"
connecter:
IncludeBinary "images\connecter.jpg"
previouspath:
IncludeBinary "images\previous.jpg"
deconnecter:
IncludeBinary "images\deconnecter.jpg"
supprimer:
IncludeBinary "images\supprimer.ico"
EndDataSection

Structure FileType
    Nom.s
    Taille.s
    Type.s
    DateM.s
    Icone.l
EndStructure

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
Global Wsql.s,IdLog,ErrorFound,Result,WChemin$,wFileSelected$,wLineSelected,Fichier$,wType$,wPv
Global NbreFT,NbreEchec,Item,FullPath_Local$,FullPath_Ftp$,FolderIcon,Wtaux,wMax
Global wServeurFTP$,WuserFtp$,WMpFtp$,LocalPath$,FtpPath$,NewList FileList.FileType()
Global FileToDelete,CheckConnection

CheckConnection=0

;------------------------------------------------------------

Procedure CheckDatabaseUpdate(Database, Query$)
   Result = DatabaseUpdate(Database, Query$)
   If Result = 0
      Debug DatabaseError() + "    Ligne " +  Str(wLigne)
   EndIf
   
   ProcedureReturn Result
EndProcedure

;----------------------------------------------------------------------------------------------------------
Procedure CheckDatabaseQuery(Database, Query$)
   Define Resultat
   Resultat = DatabaseQuery(Database, Query$)
   If Resultat = 0
      Debug DatabaseError() + "    Ligne " +  Str(wLigne)
   EndIf
   
   ProcedureReturn Resultat
EndProcedure

;------------------------------------------------------------
Dbs$="DataLog/DataLog.ftp"
If Not OpenDatabase(IdLog, Dbs$, "", "")
   Debug"Ouverture fichier paramètres impossible"
   End
EndIf

;------------------------------------------------------------

Procedure GetAssociatedFileIcon(IconPath.s, Value.l)
  Protected FileInfo.SHFILEINFO
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | Value) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure

FolderIcon = GetAssociatedFileIcon(GetHomeDirectory(), #SHGFI_SMALLICON)

;--------------------------------------------------------------------------------------
Procedure OpenWindows()
ExamineDesktops()
Wlargeur=DesktopWidth(0)
Whauteur=DesktopHeight(0)
If OpenWindow(#Mainform, 0,0, Wlargeur, Whauteur, "Test_FTP", WindowStyle)
   If CreateGadgetList(WindowID(#Mainform))
      WLar=(Wlargeur-100)/2:WHaut=(Whauteur/2)-50 : wrow=260 : wcol=70+wlar 

      Frame3DGadget(#FrameFtpInfo,10,10,460,170,"Paramètres de connexion...")
      TextGadget(#FTP_Serveur_Txt, 20, 30, 100, 20,"Serveur FTP :")
      ComboBoxGadget(#FTP_Serveur, 120, 30, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple1, 330, 30, 110, 20,"(ex.: ftp.purebasic.com)")
      TextGadget(#FTP_User_Txt, 20, 55, 100, 20,"Nom utilisateur :")
      ComboBoxGadget(#FTP_User, 120, 55, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple2, 330, 55, 110, 20,"(ex.: omega)")
      TextGadget(#FTP_Mp_Txt, 20, 80, 100, 20,"Mot de passe :")
      StringGadget(#FTP_Mp, 120, 80, 200, 20,"",#PB_String_Password)      
      TextGadget(#FTP_LocalPath_Txt, 20, 105, 100, 20,"Répertoire local")
      ButtonImageGadget(#FTP_Parcourir, 96, 102, 25, 22, ImageID(1))
      StringGadget(#FTP_LocalPath, 122, 105, 198, 20,"")      
      TextGadget(#Exemple3, 330, 105, 110, 20,"(ex.: c:\mes fichiers\")
      TextGadget(#FTP_Path_Txt, 20, 130, 100, 20,"Répertoire distant")
      StringGadget(#FTP_Path, 120, 130, 200, 20,"")      
      TextGadget(#Exemple4, 330, 130, 110, 20,"(ex.: /public_html")
      CheckBoxGadget(#CheckMemoriser_Param,20,155,230,20,"Mémoriser les paramètres de connexion")     
      CheckBoxGadget(#CheckMemoriser_Mp,300,155,150,20,"Enregistrer le mot de passe")     

      ButtonGadget(#FTP_SupprimerServeur, 10, 210, 200, 30, "Ne plus afficher le serveur ftp en cours...")
      ButtonGadget(#FTP_SupprimerTout, wlar-190, 210, 200, 30, "Supprimer tous les serveurs mémorisés...")
            
      ButtonImageGadget(#Connection, 16+wlar, 45, 45, 40, ImageID(2))
      ButtonImageGadget(#Deconnection,16+wlar, 130, 45, 40, ImageID(4))
      ButtonImageGadget(#Transferer, 15+wlar, wrow+90, 45, 40, ImageID(0))

      Frame3DGadget(#FrameFtpCon,wcol,10,460,170,"Journal...")
      ListViewGadget(#StatutList, wcol+10, 30, 440,135)

      Frame3DGadget(#SeparLigne1,10,wrow-70,wlargeur-42,6,"",#PB_Frame3D_Single)

      TextGadget(#HOME_Explorer_Rep, 10, wrow-15, wlar, 20,"", #PB_Text_Border)
      ExplorerListGadget(#HOME_Explorer, 10, wrow+10, Wlar, whaut, "", #PB_Explorer_MultiSelect)

      TextGadget(#FTP_Progres, wcol, wrow-60, wlar, 20,"") 
      ProgressBarGadget(#FTP_Prog, wcol, wrow-40, wlar, 15,0, 200) 
      ButtonImageGadget(#Previous_PathFTP, wcol, wrow-18, 35, 25, ImageID(3))
      TextGadget(#FTP_Explorer_Rep, wcol+36, wrow-15, wlar-36, 20,"", #PB_Text_Border)
      ListIconGadget(#Ftp_Explorer, wcol, wrow+10, wlar, whaut,Space(20)+"Nom",160,#PB_ListIcon_GridLines | #PB_ListIcon_MultiSelect)
      AddGadgetColumn(#Ftp_Explorer,1, "Taille", 50)
      AddGadgetColumn(#Ftp_Explorer,2, "   Type", 80)
      AddGadgetColumn(#Ftp_Explorer,3, "Date modification", 100)

      ButtonImageGadget(#FTP_Delete, 15+wlar, wrow+165, 45, 40, ImageID(5))
 
      wrow=whaut+wrow+20
      Frame3DGadget(#FrameObs,10,wrow,460,40,"REMARQUE")
      TextGadget(#Obs, 20, wrow+16, 470, 20,"Une fois le transfert démarré, il est recommandé de ne pas l'interrompre")
      
      ;Frame3DGadget(#FrameProt,Wcol,wrow,460,40,"PROTECTION On LINE")
      ;CheckBoxGadget(#CheckApsi,Wcol+10,wrow+16,120,20,"Activer l'agent APSI")     
      ;ButtonGadget(#apsi, Wlargeur-214, wrow+10, 180, 27, "Pourquoi activer l'agent APSI ?")

      Frame3DGadget(#SeparLigne2,10,wrow+50,wlargeur-42,6,"",#PB_Frame3D_Single)
       
      TextGadget(#CopyRight, 10, wrow+66, 600, 20,"test_FTP V.1 (c) www.omegasite.com (Mars 2013) - Tous Droits Réservés - ")
   EndIf 
EndIf
EndProcedure

;--------------------------------------------------------------------------------------
Procedure MemoriserParam()
;Récupérer les paramètres de connexion
wServeurFTP$=GetGadgetText(#FTP_Serveur)
WuserFtp$=GetGadgetText(#FTP_User)
WMpFtp$=GetGadgetText(#FTP_Mp)
LocalPath$=GetGadgetText(#FTP_LocalPath)
FtpPath$=GetGadgetText(#FTP_Path)
;Serveur_Ftp,User_Ftp,Mp_Ftp,Local_path,Remote_path 

;Le mot de passe doit être enregistré?
If GetGadgetState(#CheckMemoriser_Param)=1
   wMp$=WMpFtp$
Else
   wMp$="*****"
EndIf   

;------------ à cause des tests j'enlève cette partie
;Enregistrer les paramètres de connexion
;WSql=  "SELECT * FROM Flog WHERE Serveur_FTP=" + Chr(34) + wServeurFTP$ + Chr(34)
;CheckDatabaseQuery(IdLog,Wsql)
;If NextDatabaseRow(IdLog)
;   Wsql= "UPDATE Flog SET "
;   Wsql+ "User_FTP="    + Chr(34) + wUSerFTP$ + Chr(34) +","
;   Wsql+ "Mp_FTP="      + Chr(34) + wMp$       + Chr(34) +","
;   Wsql+ "Local_path="  + Chr(34) + LocalPath$ + Chr(34) +","
;   Wsql+ "Remote_path=" + Chr(34) + FtpPath$   + Chr(34) 
;   Wsql+ "WHERE Serveur_FTP=" + Chr(34) + wServeurFTP$ + Chr(34)
;   CheckDatabaseUpdate(IdLog,Wsql)
;Else
;   Wsql= "INSERT INTO Flog (Serveur_Ftp,User_Ftp,Mp_Ftp,Local_path,Remote_path)" 
;   Wsql+ "Values("
;   Wsql+  Chr(34) + wServeurFTP$ + Chr(34) +","
;   Wsql+  Chr(34) + wUSerFTP$    + Chr(34) +","
;   Wsql+  Chr(34) + wMp$          + Chr(34) +","
;   Wsql+  Chr(34) + LocalPath$    + Chr(34) +","
;   Wsql+  Chr(34) + FtpPath$      + Chr(34) +")"
;   CheckDatabaseUpdate(IdLog,Wsql)
;EndIf   
EndProcedure
 
;--------------------------------------------------------------------------------------
Procedure SetGadgetColors()
SetGadgetColor(#StatutList,#PB_Gadget_BackColor,RGB(98, 98, 98))
SetGadgetColor(#StatutList,#PB_Gadget_FrontColor,RGB(230, 230, 230))
SetGadgetColor(#exemple1,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple2,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple3,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple4,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
;-----------ToolTip()
GadgetToolTip(#Transferer, "Démarrer le transfert...") 
GadgetToolTip(#FTP_Parcourir, "Parcourir...") 
GadgetToolTip(#Connection, "Se connecter...") 
GadgetToolTip(#Deconnection, "Se déconnecter...") 
GadgetToolTip(#Previous_pathFTP, "Chemin précédent...") 
GadgetToolTip(#FTP_Delete, "Supprimer les fichiers sélectionnés...") 
EndProcedure

;--------------------------------------------------------------------------------------
Procedure SetDefaulValues()
;Initialiser les paramètres de connection
ClearGadgetItemList(#FTP_Serveur)
ClearGadgetItemList(#FTP_User)

SetGadgetText(#FTP_Serveur,"")
SetGadgetText(#FTP_User,"")
SetGadgetText(#FTP_Mp,"")
SetGadgetText(#FTP_LocalPath,"c:\")
SetGadgetText(#FTP_Path,"public_html")

DisableGadget(#FTP_SupprimerServeur,1)
DisableGadget(#FTP_SupprimerTout,1)

;Afficher tous les serveurs ftp enregistés dans le combobox
;WSql=  "SELECT * FROM Flog ORDER BY Serveur_FTP"
;CheckDatabaseQuery(IdLog,Wsql)
;While NextDatabaseRow(IdLog)
;   wServeurFTP$=GetDatabaseString(IdLog,0)
;   wUSerFTP$=GetDatabaseString(IdLog,1)
;   wMpFtp$=GetDatabaseString(IdLog,2)
;   LocalPath$=GetDatabaseString(IdLog,3)
;   FtpPath$=GetDatabaseString(IdLog,4);;

;   AddGadgetItem(#FTP_Serveur,-1,wServeurFTP$)
;Wend
  
;Afficher le 1er serveur ftp par défaut
;WSql=  "SELECT * FROM Flog ORDER BY Serveur_FTP"
;CheckDatabaseQuery(IdLog,Wsql)
;If NextDatabaseRow(IdLog)
;   wServeurFTP$=GetDatabaseString(IdLog,0)
;   wUSerFTP$=GetDatabaseString(IdLog,1)
;   wMpFtp$=GetDatabaseString(IdLog,2)
;   LocalPath$=GetDatabaseString(IdLog,3)
;   FtpPath$=GetDatabaseString(IdLog,4);

   SetGadgetText(#FTP_Serveur,wServeurFTP$)
   SetGadgetText(#FTP_User,WuserFtp$)
   SetGadgetText(#FTP_Mp,WMpFtp$)
   SetGadgetText(#FTP_LocalPath,LocalPath$)
   SetGadgetText(#FTP_Path,FtpPath$)

   SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
   SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
;EndIf

;-------------------
wDate$ = FormatDate("%dd/%mm/%yyyy", Date())
;-------------------
EndProcedure

;--------------------------------------------------------------------------------------
Procedure GetFileType()
 ;Pour l'instant je fais comme les débutants.. plus tard on verra...
 If UCase(Right(Fichier$,4))=".EXE" : wtype$="application" :  EndIf
 If UCase(Right(Fichier$,4))=".GIF" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".PNG" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".JPG" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".ICO" : wtype$="icône" :  EndIf
 If UCase(Right(Fichier$,3))=".PB"  : wtype$="fichier Pb" :  EndIf
 If UCase(Right(Fichier$,4))=".PBI" : wtype$="fichier Pbi":  EndIf
 If UCase(Right(Fichier$,4))=".PHP" : wtype$="fichier PHP":  EndIf
 If UCase(Right(Fichier$,5))=".HTML": wtype$="fichier HTML": EndIf
 If UCase(Right(Fichier$,4))=".CSS" : wtype$="fichier CSS":  EndIf
 If UCase(Right(Fichier$,4))=".DOC" : wtype$="fichier WORD":  EndIf
 If UCase(Right(Fichier$,5))=".DOCX": wtype$="fichier WORD":  EndIf
 If UCase(Right(Fichier$,4))=".XLS" : wtype$="fichier EXCEL": EndIf
EndProcedure

;--------------------------------------------------------------------------------------
Procedure GetFtpInfos()
wServeurFTP$=GetGadgetText(#FTP_Serveur)
WuserFtp$=GetGadgetText(#FTP_User)
WMpFtp$=GetGadgetText(#FTP_Mp)
LocalPath$=GetGadgetText(#FTP_LocalPath)
FtpPath$=GetGadgetText(#FTP_Path)

SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
SetGadgetText(#FTP_Explorer_Rep,FtpPath$)

EndProcedure

;--------------------------------------------------------------------------------------
Procedure Afficher_Fichiers_Ftp()
ClearGadgetItemList(#FTP_Explorer)
If SetFTPDirectory(#Ftp, FtpPath$)
   If ExamineFTPDirectory(#Ftp)
      While NextFTPDirectoryEntry(#Ftp)
             Wtype=FTPDirectoryEntryType(#Ftp)
             Wdate=FTPDirectoryEntryDate(#Ftp)
             wDate$ = FormatDate("%dd/%mm/%yyyy", wDate)
             If wtype =#PB_FTP_File
                Fichier$ =  FTPDirectoryEntryName(#Ftp)
                wSize =  FTPDirectoryEntrySize(#Ftp)/1024
                Icon = GetAssociatedFileIcon(Fichier$, #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
                wType$="fichier"
                GetFileType(); c'st le type de fichier en clair (doc, image, etc..)
                AddElement(FileList())
                FileList()\Nom=Fichier$
                FileList()\Taille=Str(wsize)+" KB"
                FileList()\Type=wType$
                FileList()\DateM=wdate$
                FileList()\Icone=icon
             EndIf
             If wtype =#PB_FTP_Directory And FTPDirectoryEntryName(#Ftp)<>"." And FTPDirectoryEntryName(#Ftp)<>".."
                AddElement(FileList())
                FileList()\Nom=FTPDirectoryEntryName(#Ftp)
                FileList()\Taille=""
                FileList()\Type="dossier"
                FileList()\DateM=wdate$
                FileList()\Icone=FolderIcon
          EndIf
      Wend
      ;Tri / Sort Structu
      SortStructuredList(FileList(), #PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(FileType\Type), #PB_Sort_String)

      ;Affichage trié sur type de fichier (Ftp)...
       ForEach(FileList())
          AddGadgetItem(#FTP_Explorer,-1,FileList()\Nom+Chr(10)+FileList()\Taille+Chr(10)+FileList()\Type+Chr(10)+FileList()\DateM,FileList()\Icone)
       Next
       FinishFTPDirectory(#FTP) 
   EndIf
EndIf
ClearList(FileList())

EndProcedure

;--------------------------------------------------------------------------------------
Procedure Demarrer_Transfert_FTP()

;Desactiver tout durant le transfert
DisableGadget(#Connection,1)
DisableGadget(#Deconnection,1)
DisableGadget(#FTP_Serveur,1)
DisableGadget(#FTP_Parcourir,1)
DisableGadget(#Transferer,1)
DisableGadget(#FTP_Delete,1)
DisableGadget(#HOME_Explorer_Rep,1)

Wpv=1
SetGadgetState(#FTP_Prog,0) 
wmax=CountGadgetItems(#HOME_Explorer)

For item=0 To CountGadgetItems(#HOME_Explorer)
    If GetGadgetItemState(#HOME_Explorer, item) & #PB_Explorer_Selected    
       wFileSelected$=GetGadgetItemText(#HOME_Explorer, item)   
       If GetGadgetItemState(#HOME_Explorer, item) & #PB_Explorer_Directory 
          ;il s'agit d'un dossier, voir s'il existe dans ftp files, sinon le créer
           If Not SetFTPDirectory(#Ftp, wFileSelected$)
              SetGadgetText(#FTP_Progres,"Le dossier "+ wFileSelected$ +" est inexistant ")
              ;dossier inexistant dans ftp, il faut le créer...
              If CreateFTPDirectory(#Ftp, wFileSelected$)
                 SetGadgetText(#FTP_Progres,"le dossier "+ wFileSelected$ +" a été créé" )
              Else
                 SetGadgetText(#FTP_Progres,"le dossier "+ wFileSelected$ +" n'a pas pu être créé")
              EndIf
           EndIf

           ;Copier les fichiers de ce répertoire
           SetFTPDirectory(#Ftp, FtpPath$)
           SetFTPDirectory(#Ftp, wFileSelected$)
           If ExamineDirectory(#Dir, LocalPath$+"\"+wFileSelected$, "*.*")  
              While NextDirectoryEntry(#Dir)
                   If DirectoryEntryType(#Dir) = #PB_DirectoryEntry_File
                      wFile$=DirectoryEntryName(#Dir)
                      If SendFTPFile(#Ftp, LocalPath$+"\"+wFileSelected$+"\"+wFile$,wFile$,#True)
                         Repeat
                           SetGadgetText(#FTP_Progres,"Transfert en cours : " + wFileSelected$+"\"+wFile$ + "     (" + Str(NbreFt) + "/" + Str(wmax) + ")")
                           Delay(300)
                         Until FTPProgress(#FTP) = -3 Or FTPProgress(#FTP) = -2
                         AddGadgetItem (#StatutList,-1,". " + "Transfert de : " + wFileSelected$+"\"+wFile$ + "...")
                         Wpv=Wpv+1
                         SetGadgetState(#FTP_Prog,wpv) 
                         AddGadgetItem (#StatutList,-1,". " +wFileSelected$+"\"+wFile$ + " a été transféré avec succès")
                         NbreFt=NbreFt+1
                      Else
                         AddGadgetItem (#StatutList,-1,". " +wFileSelected$+"\"+wFile$ + " n'a pas pu être transféré")
                         NbreEchec=NbreEchec+1
                      EndIf
                   EndIf   
             Wend
             FinishDirectory(#Dir)
          EndIf
     
        Else
           ;il s'agit d'un fichier, le copier directement...
            FullPath_Local$=LocalPath$+wFileSelected$
            FullPath_Ftp$=FtpPath$+"/"+wFileSelected$
            If SendFTPFile(#Ftp, FullPath_Local$,FullPath_ftp$,1)
               Repeat
                 SetGadgetText(#FTP_Progres,"Transfert en cours : " + wFileSelected$ + "     (" + Str(NbreFt) + "/" + Str(wmax) + ")")
                 Delay(300)
               Until FTPProgress(#FTP) = -3 Or FTPProgress(#FTP) = -2
               AddGadgetItem (#StatutList,-1,". " + "Transfert de : " + wFileSelected$ + "...")
               Wpv=Wpv+1
               SetGadgetState(#FTP_Prog,wpv) 
               AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " a été transféré avec succès")
               NbreFt=NbreFt+1
            Else
               AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " n'a pas pu être transféré")
               NbreEchec=NbreEchec+1
            EndIf
       EndIf   
   EndIf    
Next item    
SetGadgetState(#FTP_Prog,200) 

;Réactiver tout : fin de transfert
DisableGadget(#Connection,0)
DisableGadget(#Deconnection,0)
DisableGadget(#FTP_Serveur,0)
DisableGadget(#FTP_Parcourir,0)
DisableGadget(#Transferer,0)
DisableGadget(#FTP_Delete,0)
DisableGadget(#HOME_Explorer_Rep,0)

EndProcedure

;--------------------------------------------------------------------------------------
Procedure FTP_DeleteFiles()
NbreFt=0 : NbreEchec=0
AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
AddGadgetItem (#StatutList,-1,"")
AddGadgetItem (#StatutList,-1,". " +"Suppression en cours...")

For item=0 To CountGadgetItems(#FTP_Explorer)
     If GetGadgetItemState(#FTP_Explorer, item) & #PB_ListIcon_Selected
        wFileSelected$=GetGadgetItemText(#FTP_Explorer, item)   
        FullPath_Ftp$=FtpPath$+"/"+wFileSelected$
        wType$=GetGadgetItemText(#FTP_Explorer,item,2)
        If wType$<>"dossier"
           If DeleteFTPFile(#Ftp,FullPath_Ftp$)
              AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " a été supprimé avec succès")
              NbreFt=NbreFt+1
           Else
              AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " n'a pas pu être supprimé")
              NbreEchec=NbreEchec+1
           EndIf                
        Else
           If DeleteFTPDirectory(#Ftp,FullPath_Ftp$)
              AddGadgetItem (#StatutList,-1,". " + " Le dossier " + wFileSelected$ + " a été supprimé avec succès")
              NbreFt=NbreFt+1
           Else
              AddGadgetItem (#StatutList,-1,". " + " Le dossier " + wFileSelected$ + " n'a pas pu être supprimé")
              NbreEchec=NbreEchec+1
           EndIf                
        EndIf   
        RemoveGadgetItem(#FTP_Explorer,item)
     EndIf          
Next item

AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
AddGadgetItem (#StatutList,-1,". " + " Suppression terminée !")
AddGadgetItem (#StatutList,-1,". " + " Nombre de fichiers supprimés: " + Str(NbreFt))
AddGadgetItem (#StatutList,-1,". " + " Nombre de fichiers non supprimés: " + Str(Nbreechec))
AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")

EndProcedure

;--------------------------------------------------------------------------------------

OpenWindows()
SetGadgetColors()
SetDefaulValues()
GetFtpInfos()

SetGadgetState(#FTP_Prog,0) 

InitNetwork()

Repeat 
EventID = WaitWindowEvent()

If EventID = #PB_Event_CloseWindow
   End
EndIf
             
If EventID = #PB_Event_Gadget
   Select EventGadget()

   Case #Connection
         ClearGadgetItemList(#FTP_Explorer)
         GetFtpInfos()
         ErrorFound=0 
         If wServeurFTP$=""
            MessageRequester("Erreur","Adresse FTP incorrecte  ! ")
            ErrorFound=1 
         ElseIf wUserFtp$=""
            MessageRequester("Erreur","Nom utilisateur incorrect  ! ")
            ErrorFound=1 
         ElseIf wMpFtp$=""
            MessageRequester("Erreur","Mot de passe incorrect  ! ")
            ErrorFound=1 
         ElseIf localPath$=""
            MessageRequester("Erreur","Saisissez le répertoire initial local ! ")
            ErrorFound=1 
         ElseIf FtpPath$=""
            MessageRequester("Erreur","Indiquez le répertoire initial distant ! ")
            ErrorFound=1 
         EndIf
         
         If ErrorFound=0 
            ClearGadgetItemList (#StatutList)
            AddGadgetItem (#StatutList,-1,". " + " Connection en cours...")
            SetGadgetText(#FTP_Progres,"Connection en cours...")
              
            If OpenFTP(#ftp, wServeurFTP$, WuserFtp$, wMpFtp$)
               If GetGadgetState(#CheckMemoriser_Param)=1
                  MemoriserParam()
               EndIf
                  
               AddGadgetItem (#StatutList,-1,". " +" Serveur ftp connecté avec succès...")
               SetGadgetText(#FTP_Progres,"Connection réussie...")
               CheckConnection=1
               SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
               DisableGadget(#FTP_SupprimerServeur,1)
               Afficher_Fichiers_Ftp()
            Else
               MessageRequester("Erreur de connection...", "Impossible de se connecter au serveur !")
               AddGadgetItem (#StatutList,-1,". " +"Impossible de se connecter au serveur !")
               SetGadgetText(#FTP_Progres,"Impossible de se connecter au serveur !")
               DisableGadget(#FTP_SupprimerServeur,0)
               CheckConnection=0
            EndIf
         EndIf
             
   Case #HOME_Explorer
        If EventType()=#PB_EventType_Change
           wchemin$=GetGadgetText(#HOME_Explorer)
           SetGadgetText(#HOME_Explorer_Rep,wchemin$)
           LocalPath$=wchemin$
        EndIf
    
   Case #FTP_Parcourir
         WChemin$=PathRequester("Sélectionnez un dossier:", LocalPath$)
         If wchemin$
            SetGadgetText(#HOME_Explorer_Rep,wChemin$)
            SetGadgetText(#FTP_LocalPath,wChemin$)
            ResizeGadget(#HOME_Explorer, #PB_Ignore, #PB_Ignore,#PB_Ignore, #PB_Ignore)
            LocalPath$=wchemin$
         EndIf    

   Case #Transferer
         ErrorFound=0
         NbreFt=0
         NbreEchec=0
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté au serveur ftp !")
         Else   
            DisableGadget(#FTP_SupprimerServeur,1)

            ;------------ Transfert de fichiers (chemin local vers chemin ftp ----------------
            Demarrer_Transfert_FTP()

            ;Résultat du transfert...
            If NbreEchec=0 And NbreFt=0
               MessageRequester("Erreur","Aucun fichier n'a été sélectionné pour le tansfert !")
            Else   
               ;Affichage des fichiers transférés dans la liste de destination (ftp) = réaffichage du chemin ftp 
                Afficher_Fichiers_Ftp()
            
               ;Affichage du statut...
                AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
                AddGadgetItem (#StatutList,-1,". " +" Transfert terminé !")
                AddGadgetItem (#StatutList,-1,". " +" Nbre de fichiers transférés : " + Str(NbreFt))
                AddGadgetItem (#StatutList,-1,". " +" Nbre de fichiers non transférés : " + Str(NbreEchec))
                AddGadgetItem (#StatutList,-1,"")
             EndIf
                     
          EndIf
          
          SetGadgetText(#FTP_Progres,"")
          DisableGadget(#FTP_SupprimerServeur,0)

   Case #FTP_Explorer
        Select EventType()
        Case #PB_EventType_LeftDoubleClick
              wLineSelected=GetGadgetState(#FTP_Explorer)
              If wLineSelected>=0 And wLineSelected<CountGadgetItems(#FTP_Explorer)
                 wFolderName$=GetGadgetItemText(#FTP_Explorer,wLineSelected,0)
                 wType$=GetGadgetItemText(#FTP_Explorer,wLineSelected,2)
                 If wType$="dossier"
                    wchemin$=wFolderName$
                    SetGadgetText(#FTP_Explorer_Rep,"/"+wchemin$)
                    FtpPath$=Trim(wchemin$)
                    Afficher_Fichiers_Ftp()
                EndIf   
              EndIf   
        EndSelect

   Case #Previous_PathFTP
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté ! ")
         Else
            FtpPath$=".."
            Afficher_Fichiers_Ftp()
         EndIf
         
   Case #FTP_Delete
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté ! ")
            DisableGadget(#FTP_SupprimerServeur,0)
         Else
         ;voir s'il y a des fichiers sélectionnés 
         FileToDelete=0
         For item=0 To CountGadgetItems(#FTP_Explorer)
             If GetGadgetItemState(#FTP_Explorer, item) & #PB_ListIcon_Selected
                FileToDelete=1
                Break
             EndIf
         Next item
         
         If FileToDelete=1
            FTP_DeleteFiles()
            DisableGadget(#FTP_SupprimerServeur,1)
         Else
            MessageRequester("Erreur","Aucun fichier n'a été sélectionné pour la suppression ! ")
         EndIf
         EndIf
         
   Case #FTP_Serveur
         n=GetGadgetState(#FTP_Serveur)
         If n>=0
            wServeurFTP$=GetGadgetItemText(#FTP_Serveur,n)
            WSql=  "SELECT * FROM Flog Where Serveur_FTP=" + Chr(34) + wServeurFTP$+ Chr(34)
            CheckDatabaseQuery(IdLog,Wsql)
            If NextDatabaseRow(IdLog)
               wUSerFTP$=GetDatabaseString(IdLog,1)
               wMpFtp$=GetDatabaseString(IdLog,2)
               LocalPath$=GetDatabaseString(IdLog,3)
               FtpPath$=GetDatabaseString(IdLog,4)

               SetGadgetText(#FTP_User,WuserFtp$)
               SetGadgetText(#FTP_Mp,WMpFtp$)
               SetGadgetText(#FTP_LocalPath,LocalPath$)
               SetGadgetText(#FTP_Path,FtpPath$)

               SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
               SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
               CheckConnection=0
           EndIf
       EndIf
 
       DisableGadget(#FTP_SupprimerServeur,0)
       
   Case #Deconnection
         If CheckConnection=1
            CloseFTP(#ftp)
         EndIf   
         SetGadgetText(#FTP_Progres,"Vous êtes déconnecté du serveur..  !")
         ClearGadgetItemList (#StatutList)
         ClearGadgetItemList (#FTP_Explorer)
         DisableGadget(#FTP_SupprimerServeur,0)
         CheckConnection=0

   EndSelect

EndIf    
ForEver
End

Merci

omega · Message par **omega** » lun. 25/mars/2013 14:09

J'ai oublié d'enlever les parties inutiles pour les tests (bdd, fichier param etc..)

Code corrigé

Code : Tout sélectionner

Enumeration
#Mainform
#SeparLigne1
#SeparLigne2
#Source
#Destination
#Connection
#Deconnection
#FrameFtpInfo
#FTP_Serveur_Txt
#FTP_Serveur
#exemple1
#FTP_User_Txt
#FTP_User
#exemple2
#FTP_Mp_Txt
#FTP_Mp
#FTP_LocalPath_Txt
#FTP_LocalPath
#FTP_Path_Txt
#FTP_Path
#exemple3
#exemple4

#FTP_SupprimerServeur
#FTP_SupprimerTout

#CheckMemoriser_Param
#CheckMemoriser_Mp

#FrameFtpCon
#Previous_PathFTP
#Ftp_Prog
#FTP_Parcourir

#FTP_Progres

#Dir

#HOME_Explorer_Rep
#HOME_Explorer

#FTP_Explorer_Rep
#FTP_Explorer

#Transferer
#StatutList
#Ftp

#FTP_Delete

#FrameObs
#Obs
#FrameProt
#CheckApsi
#Apsi

#CopyRight
EndEnumeration

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseSQLiteDatabase()

trans=CatchImage(0, ?trans)
parcourir=CatchImage(1, ?parcourir)
connecter=CatchImage(2, ?connecter)
previouspath=CatchImage(3, ?previouspath)
connecter=CatchImage(4, ?deconnecter)
supprimer=CatchImage(5, ?supprimer)

DataSection
trans:
IncludeBinary "images\trans.jpg"
parcourir:
IncludeBinary "images\open.jpg"
connecter:
IncludeBinary "images\connecter.jpg"
previouspath:
IncludeBinary "images\previous.jpg"
deconnecter:
IncludeBinary "images\deconnecter.jpg"
supprimer:
IncludeBinary "images\supprimer.ico"
EndDataSection

Structure FileType
    Nom.s
    Taille.s
    Type.s
    DateM.s
    Icone.l
EndStructure

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
Global Wsql.s,IdLog,ErrorFound,Result,WChemin$,wFileSelected$,wLineSelected,Fichier$,wType$,wPv
Global NbreFT,NbreEchec,Item,FullPath_Local$,FullPath_Ftp$,FolderIcon,Wtaux,wMax
Global wServeurFTP$,WuserFtp$,WMpFtp$,LocalPath$,FtpPath$,NewList FileList.FileType()
Global FileToDelete,CheckConnection

CheckConnection=0

;------------------------------------------------------------
;Procedure CheckDatabaseUpdate(Database, Query$)
;   Result = DatabaseUpdate(Database, Query$)
;   If Result = 0
;      Debug DatabaseError() + "    Ligne " +  Str(wLigne)
;   EndIf
   
;   ProcedureReturn Result
;EndProcedure

;----------------------------------------------------------------------------------------------------------
;Procedure CheckDatabaseQuery(Database, Query$)
;   Define Resultat
;   Resultat = DatabaseQuery(Database, Query$)
;   If Resultat = 0
;      Debug DatabaseError() + "    Ligne " +  Str(wLigne)
;   EndIf
   
;   ProcedureReturn Resultat
;EndProcedure

;------------------------------------------------------------
;Dbs$="DataLog/DataLog.ftp"
;If Not OpenDatabase(IdLog, Dbs$, "", "")
;   Debug"Ouverture fichier paramètres impossible"
;   End
;EndIf

;------------------------------------------------------------

Procedure GetAssociatedFileIcon(IconPath.s, Value.l)
  Protected FileInfo.SHFILEINFO
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | Value) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure

FolderIcon = GetAssociatedFileIcon(GetHomeDirectory(), #SHGFI_SMALLICON)

;--------------------------------------------------------------------------------------
Procedure OpenWindows()
ExamineDesktops()
Wlargeur=DesktopWidth(0)
Whauteur=DesktopHeight(0)
If OpenWindow(#Mainform, 0,0, Wlargeur, Whauteur, "Test_FTP", WindowStyle)
   If CreateGadgetList(WindowID(#Mainform))
      WLar=(Wlargeur-100)/2:WHaut=(Whauteur/2)-50 : wrow=260 : wcol=70+wlar 

      Frame3DGadget(#FrameFtpInfo,10,10,460,170,"Paramètres de connexion...")
      TextGadget(#FTP_Serveur_Txt, 20, 30, 100, 20,"Serveur FTP :")
      ComboBoxGadget(#FTP_Serveur, 120, 30, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple1, 330, 30, 110, 20,"(ex.: ftp.purebasic.com)")
      TextGadget(#FTP_User_Txt, 20, 55, 100, 20,"Nom utilisateur :")
      ComboBoxGadget(#FTP_User, 120, 55, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple2, 330, 55, 110, 20,"(ex.: omega)")
      TextGadget(#FTP_Mp_Txt, 20, 80, 100, 20,"Mot de passe :")
      StringGadget(#FTP_Mp, 120, 80, 200, 20,"",#PB_String_Password)      
      TextGadget(#FTP_LocalPath_Txt, 20, 105, 100, 20,"Répertoire local")
      ButtonImageGadget(#FTP_Parcourir, 96, 102, 25, 22, ImageID(1))
      StringGadget(#FTP_LocalPath, 122, 105, 198, 20,"")      
      TextGadget(#Exemple3, 330, 105, 110, 20,"(ex.: c:\mes fichiers\")
      TextGadget(#FTP_Path_Txt, 20, 130, 100, 20,"Répertoire distant")
      StringGadget(#FTP_Path, 120, 130, 200, 20,"")      
      TextGadget(#Exemple4, 330, 130, 110, 20,"(ex.: /public_html")
      CheckBoxGadget(#CheckMemoriser_Param,20,155,230,20,"Mémoriser les paramètres de connexion")     
      CheckBoxGadget(#CheckMemoriser_Mp,300,155,150,20,"Enregistrer le mot de passe")     

      ButtonGadget(#FTP_SupprimerServeur, 10, 210, 200, 30, "Ne plus afficher le serveur ftp en cours...")
      ButtonGadget(#FTP_SupprimerTout, wlar-190, 210, 200, 30, "Supprimer tous les serveurs mémorisés...")
            
      ButtonImageGadget(#Connection, 16+wlar, 45, 45, 40, ImageID(2))
      ButtonImageGadget(#Deconnection,16+wlar, 130, 45, 40, ImageID(4))
      ButtonImageGadget(#Transferer, 15+wlar, wrow+90, 45, 40, ImageID(0))

      Frame3DGadget(#FrameFtpCon,wcol,10,460,170,"Journal...")
      ListViewGadget(#StatutList, wcol+10, 30, 440,135)

      Frame3DGadget(#SeparLigne1,10,wrow-70,wlargeur-42,6,"",#PB_Frame3D_Single)

      TextGadget(#HOME_Explorer_Rep, 10, wrow-15, wlar, 20,"", #PB_Text_Border)
      ExplorerListGadget(#HOME_Explorer, 10, wrow+10, Wlar, whaut, "", #PB_Explorer_MultiSelect)

      TextGadget(#FTP_Progres, wcol, wrow-60, wlar, 20,"") 
      ProgressBarGadget(#FTP_Prog, wcol, wrow-40, wlar, 15,0, 200) 
      ButtonImageGadget(#Previous_PathFTP, wcol, wrow-18, 35, 25, ImageID(3))
      TextGadget(#FTP_Explorer_Rep, wcol+36, wrow-15, wlar-36, 20,"", #PB_Text_Border)
      ListIconGadget(#Ftp_Explorer, wcol, wrow+10, wlar, whaut,Space(20)+"Nom",160,#PB_ListIcon_GridLines | #PB_ListIcon_MultiSelect)
      AddGadgetColumn(#Ftp_Explorer,1, "Taille", 50)
      AddGadgetColumn(#Ftp_Explorer,2, "   Type", 80)
      AddGadgetColumn(#Ftp_Explorer,3, "Date modification", 100)

      ButtonImageGadget(#FTP_Delete, 15+wlar, wrow+165, 45, 40, ImageID(5))
 
      wrow=whaut+wrow+20
      Frame3DGadget(#FrameObs,10,wrow,460,40,"REMARQUE")
      TextGadget(#Obs, 20, wrow+16, 470, 20,"Une fois le transfert démarré, il est recommandé de ne pas l'interrompre")
      
      ;Frame3DGadget(#FrameProt,Wcol,wrow,460,40,"PROTECTION On LINE")
      ;CheckBoxGadget(#CheckApsi,Wcol+10,wrow+16,120,20,"Activer l'agent APSI")     
      ;ButtonGadget(#apsi, Wlargeur-214, wrow+10, 180, 27, "Pourquoi activer l'agent APSI ?")

      Frame3DGadget(#SeparLigne2,10,wrow+50,wlargeur-42,6,"",#PB_Frame3D_Single)
       
      TextGadget(#CopyRight, 10, wrow+66, 600, 20,"test_FTP V.1 (c) www.omegasite.com (Mars 2013) - Tous Droits Réservés - ")
   EndIf 
EndIf
EndProcedure

;--------------------------------------------------------------------------------------
Procedure MemoriserParam()
;Récupérer les paramètres de connexion
wServeurFTP$=GetGadgetText(#FTP_Serveur)
WuserFtp$=GetGadgetText(#FTP_User)
WMpFtp$=GetGadgetText(#FTP_Mp)
LocalPath$=GetGadgetText(#FTP_LocalPath)
FtpPath$=GetGadgetText(#FTP_Path)
;Serveur_Ftp,User_Ftp,Mp_Ftp,Local_path,Remote_path 

;Le mot de passe doit être enregistré?
If GetGadgetState(#CheckMemoriser_Param)=1
   wMp$=WMpFtp$
Else
   wMp$="*****"
EndIf   

;------------ à cause des tests j'enlève cette partie
;Enregistrer les paramètres de connexion
;WSql=  "SELECT * FROM Flog WHERE Serveur_FTP=" + Chr(34) + wServeurFTP$ + Chr(34)
;CheckDatabaseQuery(IdLog,Wsql)
;If NextDatabaseRow(IdLog)
;   Wsql= "UPDATE Flog SET "
;   Wsql+ "User_FTP="    + Chr(34) + wUSerFTP$ + Chr(34) +","
;   Wsql+ "Mp_FTP="      + Chr(34) + wMp$       + Chr(34) +","
;   Wsql+ "Local_path="  + Chr(34) + LocalPath$ + Chr(34) +","
;   Wsql+ "Remote_path=" + Chr(34) + FtpPath$   + Chr(34) 
;   Wsql+ "WHERE Serveur_FTP=" + Chr(34) + wServeurFTP$ + Chr(34)
;   CheckDatabaseUpdate(IdLog,Wsql)
;Else
;   Wsql= "INSERT INTO Flog (Serveur_Ftp,User_Ftp,Mp_Ftp,Local_path,Remote_path)" 
;   Wsql+ "Values("
;   Wsql+  Chr(34) + wServeurFTP$ + Chr(34) +","
;   Wsql+  Chr(34) + wUSerFTP$    + Chr(34) +","
;   Wsql+  Chr(34) + wMp$          + Chr(34) +","
;   Wsql+  Chr(34) + LocalPath$    + Chr(34) +","
;   Wsql+  Chr(34) + FtpPath$      + Chr(34) +")"
;   CheckDatabaseUpdate(IdLog,Wsql)
;EndIf   
EndProcedure
 
;--------------------------------------------------------------------------------------
Procedure SetGadgetColors()
SetGadgetColor(#StatutList,#PB_Gadget_BackColor,RGB(98, 98, 98))
SetGadgetColor(#StatutList,#PB_Gadget_FrontColor,RGB(230, 230, 230))
SetGadgetColor(#exemple1,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple2,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple3,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple4,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
;-----------ToolTip()
GadgetToolTip(#Transferer, "Démarrer le transfert...") 
GadgetToolTip(#FTP_Parcourir, "Parcourir...") 
GadgetToolTip(#Connection, "Se connecter...") 
GadgetToolTip(#Deconnection, "Se déconnecter...") 
GadgetToolTip(#Previous_pathFTP, "Chemin précédent...") 
GadgetToolTip(#FTP_Delete, "Supprimer les fichiers sélectionnés...") 
EndProcedure

;--------------------------------------------------------------------------------------
Procedure SetDefaulValues()
;Initialiser les paramètres de connection
ClearGadgetItemList(#FTP_Serveur)
ClearGadgetItemList(#FTP_User)

SetGadgetText(#FTP_Serveur,"")
SetGadgetText(#FTP_User,"")
SetGadgetText(#FTP_Mp,"")
SetGadgetText(#FTP_LocalPath,"c:\")
SetGadgetText(#FTP_Path,"public_html")

DisableGadget(#FTP_SupprimerServeur,1)
DisableGadget(#FTP_SupprimerTout,1)

;Afficher tous les serveurs ftp enregistés dans le combobox
;WSql=  "SELECT * FROM Flog ORDER BY Serveur_FTP"
;CheckDatabaseQuery(IdLog,Wsql)
;While NextDatabaseRow(IdLog)
;   wServeurFTP$=GetDatabaseString(IdLog,0)
;   wUSerFTP$=GetDatabaseString(IdLog,1)
;   wMpFtp$=GetDatabaseString(IdLog,2)
;   LocalPath$=GetDatabaseString(IdLog,3)
;   FtpPath$=GetDatabaseString(IdLog,4);;

;   AddGadgetItem(#FTP_Serveur,-1,wServeurFTP$)
;Wend
  
;Afficher le 1er serveur ftp par défaut
;WSql=  "SELECT * FROM Flog ORDER BY Serveur_FTP"
;CheckDatabaseQuery(IdLog,Wsql)
;If NextDatabaseRow(IdLog)
;   wServeurFTP$=GetDatabaseString(IdLog,0)
;   wUSerFTP$=GetDatabaseString(IdLog,1)
;   wMpFtp$=GetDatabaseString(IdLog,2)
;   LocalPath$=GetDatabaseString(IdLog,3)
;   FtpPath$=GetDatabaseString(IdLog,4);

   SetGadgetText(#FTP_Serveur,wServeurFTP$)
   SetGadgetText(#FTP_User,WuserFtp$)
   SetGadgetText(#FTP_Mp,WMpFtp$)
   SetGadgetText(#FTP_LocalPath,LocalPath$)
   SetGadgetText(#FTP_Path,FtpPath$)

   SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
   SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
;EndIf

;-------------------
wDate$ = FormatDate("%dd/%mm/%yyyy", Date())
;-------------------
EndProcedure

;--------------------------------------------------------------------------------------
Procedure GetFileType()
 ;Pour l'instant je fais comme les débutants.. plus tard on verra...
 If UCase(Right(Fichier$,4))=".EXE" : wtype$="application" :  EndIf
 If UCase(Right(Fichier$,4))=".GIF" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".PNG" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".JPG" : wtype$="image" :  EndIf
 If UCase(Right(Fichier$,4))=".ICO" : wtype$="icône" :  EndIf
 If UCase(Right(Fichier$,3))=".PB"  : wtype$="fichier Pb" :  EndIf
 If UCase(Right(Fichier$,4))=".PBI" : wtype$="fichier Pbi":  EndIf
 If UCase(Right(Fichier$,4))=".PHP" : wtype$="fichier PHP":  EndIf
 If UCase(Right(Fichier$,5))=".HTML": wtype$="fichier HTML": EndIf
 If UCase(Right(Fichier$,4))=".CSS" : wtype$="fichier CSS":  EndIf
 If UCase(Right(Fichier$,4))=".DOC" : wtype$="fichier WORD":  EndIf
 If UCase(Right(Fichier$,5))=".DOCX": wtype$="fichier WORD":  EndIf
 If UCase(Right(Fichier$,4))=".XLS" : wtype$="fichier EXCEL": EndIf
EndProcedure

;--------------------------------------------------------------------------------------
Procedure GetFtpInfos()
wServeurFTP$=GetGadgetText(#FTP_Serveur)
WuserFtp$=GetGadgetText(#FTP_User)
WMpFtp$=GetGadgetText(#FTP_Mp)
LocalPath$=GetGadgetText(#FTP_LocalPath)
FtpPath$=GetGadgetText(#FTP_Path)

SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
SetGadgetText(#FTP_Explorer_Rep,FtpPath$)

EndProcedure

;--------------------------------------------------------------------------------------
Procedure Afficher_Fichiers_Ftp()
ClearGadgetItemList(#FTP_Explorer)
If SetFTPDirectory(#Ftp, FtpPath$);---------- <----- Le problème est ici ----------------
   If ExamineFTPDirectory(#Ftp)
      While NextFTPDirectoryEntry(#Ftp)
             Wtype=FTPDirectoryEntryType(#Ftp)
             Wdate=FTPDirectoryEntryDate(#Ftp)
             wDate$ = FormatDate("%dd/%mm/%yyyy", wDate)
             If wtype =#PB_FTP_File
                Fichier$ =  FTPDirectoryEntryName(#Ftp)
                wSize =  FTPDirectoryEntrySize(#Ftp)/1024
                Icon = GetAssociatedFileIcon(Fichier$, #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
                wType$="fichier"
                GetFileType(); c'st le type de fichier en clair (doc, image, etc..)
                AddElement(FileList())
                FileList()\Nom=Fichier$
                FileList()\Taille=Str(wsize)+" KB"
                FileList()\Type=wType$
                FileList()\DateM=wdate$
                FileList()\Icone=icon
             EndIf
             If wtype =#PB_FTP_Directory And FTPDirectoryEntryName(#Ftp)<>"." And FTPDirectoryEntryName(#Ftp)<>".."
                AddElement(FileList())
                FileList()\Nom=FTPDirectoryEntryName(#Ftp)
                FileList()\Taille=""
                FileList()\Type="dossier"
                FileList()\DateM=wdate$
                FileList()\Icone=FolderIcon
          EndIf
      Wend
      ;Tri / Sort Structu
      SortStructuredList(FileList(), #PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(FileType\Type), #PB_Sort_String)

      ;Affichage trié sur type de fichier (Ftp)...
       ForEach(FileList())
          AddGadgetItem(#FTP_Explorer,-1,FileList()\Nom+Chr(10)+FileList()\Taille+Chr(10)+FileList()\Type+Chr(10)+FileList()\DateM,FileList()\Icone)
       Next
       FinishFTPDirectory(#FTP) 
   EndIf
EndIf
ClearList(FileList())

EndProcedure

;--------------------------------------------------------------------------------------
Procedure Demarrer_Transfert_FTP()

;Desactiver tout durant le transfert
DisableGadget(#Connection,1)
DisableGadget(#Deconnection,1)
DisableGadget(#FTP_Serveur,1)
DisableGadget(#FTP_Parcourir,1)
DisableGadget(#Transferer,1)
DisableGadget(#FTP_Delete,1)
DisableGadget(#HOME_Explorer_Rep,1)

Wpv=1
SetGadgetState(#FTP_Prog,0) 
wmax=CountGadgetItems(#HOME_Explorer)

For item=0 To CountGadgetItems(#HOME_Explorer)
    If GetGadgetItemState(#HOME_Explorer, item) & #PB_Explorer_Selected    
       wFileSelected$=GetGadgetItemText(#HOME_Explorer, item)   
       If GetGadgetItemState(#HOME_Explorer, item) & #PB_Explorer_Directory 
          ;il s'agit d'un dossier, voir s'il existe dans ftp files, sinon le créer
           If Not SetFTPDirectory(#Ftp, wFileSelected$)
              SetGadgetText(#FTP_Progres,"Le dossier "+ wFileSelected$ +" est inexistant ")
              ;dossier inexistant dans ftp, il faut le créer...
              If CreateFTPDirectory(#Ftp, wFileSelected$)
                 SetGadgetText(#FTP_Progres,"le dossier "+ wFileSelected$ +" a été créé" )
              Else
                 SetGadgetText(#FTP_Progres,"le dossier "+ wFileSelected$ +" n'a pas pu être créé")
              EndIf
           EndIf

           ;Copier les fichiers de ce répertoire
           SetFTPDirectory(#Ftp, FtpPath$)
           SetFTPDirectory(#Ftp, wFileSelected$)
           If ExamineDirectory(#Dir, LocalPath$+"\"+wFileSelected$, "*.*")  
              While NextDirectoryEntry(#Dir)
                   If DirectoryEntryType(#Dir) = #PB_DirectoryEntry_File
                      wFile$=DirectoryEntryName(#Dir)
                      If SendFTPFile(#Ftp, LocalPath$+"\"+wFileSelected$+"\"+wFile$,wFile$,#True)
                         Repeat
                           SetGadgetText(#FTP_Progres,"Transfert en cours : " + wFileSelected$+"\"+wFile$ + "     (" + Str(NbreFt) + "/" + Str(wmax) + ")")
                           Delay(300)
                         Until FTPProgress(#FTP) = -3 Or FTPProgress(#FTP) = -2
                         AddGadgetItem (#StatutList,-1,". " + "Transfert de : " + wFileSelected$+"\"+wFile$ + "...")
                         Wpv=Wpv+1
                         SetGadgetState(#FTP_Prog,wpv) 
                         AddGadgetItem (#StatutList,-1,". " +wFileSelected$+"\"+wFile$ + " a été transféré avec succès")
                         NbreFt=NbreFt+1
                      Else
                         AddGadgetItem (#StatutList,-1,". " +wFileSelected$+"\"+wFile$ + " n'a pas pu être transféré")
                         NbreEchec=NbreEchec+1
                      EndIf
                   EndIf   
             Wend
             FinishDirectory(#Dir)
          EndIf
     
        Else
           ;il s'agit d'un fichier, le copier directement...
            FullPath_Local$=LocalPath$+wFileSelected$
            FullPath_Ftp$=FtpPath$+"/"+wFileSelected$
            If SendFTPFile(#Ftp, FullPath_Local$,FullPath_ftp$,1)
               Repeat
                 SetGadgetText(#FTP_Progres,"Transfert en cours : " + wFileSelected$ + "     (" + Str(NbreFt) + "/" + Str(wmax) + ")")
                 Delay(300)
               Until FTPProgress(#FTP) = -3 Or FTPProgress(#FTP) = -2
               AddGadgetItem (#StatutList,-1,". " + "Transfert de : " + wFileSelected$ + "...")
               Wpv=Wpv+1
               SetGadgetState(#FTP_Prog,wpv) 
               AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " a été transféré avec succès")
               NbreFt=NbreFt+1
            Else
               AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " n'a pas pu être transféré")
               NbreEchec=NbreEchec+1
            EndIf
       EndIf   
   EndIf    
Next item    
SetGadgetState(#FTP_Prog,200) 

;Réactiver tout : fin de transfert
DisableGadget(#Connection,0)
DisableGadget(#Deconnection,0)
DisableGadget(#FTP_Serveur,0)
DisableGadget(#FTP_Parcourir,0)
DisableGadget(#Transferer,0)
DisableGadget(#FTP_Delete,0)
DisableGadget(#HOME_Explorer_Rep,0)

EndProcedure

;--------------------------------------------------------------------------------------
Procedure FTP_DeleteFiles()
NbreFt=0 : NbreEchec=0
AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
AddGadgetItem (#StatutList,-1,"")
AddGadgetItem (#StatutList,-1,". " +"Suppression en cours...")

For item=0 To CountGadgetItems(#FTP_Explorer)
     If GetGadgetItemState(#FTP_Explorer, item) & #PB_ListIcon_Selected
        wFileSelected$=GetGadgetItemText(#FTP_Explorer, item)   
        FullPath_Ftp$=FtpPath$+"/"+wFileSelected$
        wType$=GetGadgetItemText(#FTP_Explorer,item,2)
        If wType$<>"dossier"
           If DeleteFTPFile(#Ftp,FullPath_Ftp$)
              AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " a été supprimé avec succès")
              NbreFt=NbreFt+1
           Else
              AddGadgetItem (#StatutList,-1,". " + wFileSelected$ + " n'a pas pu être supprimé")
              NbreEchec=NbreEchec+1
           EndIf                
        Else
           If DeleteFTPDirectory(#Ftp,FullPath_Ftp$)
              AddGadgetItem (#StatutList,-1,". " + " Le dossier " + wFileSelected$ + " a été supprimé avec succès")
              NbreFt=NbreFt+1
           Else
              AddGadgetItem (#StatutList,-1,". " + " Le dossier " + wFileSelected$ + " n'a pas pu être supprimé")
              NbreEchec=NbreEchec+1
           EndIf                
        EndIf   
        RemoveGadgetItem(#FTP_Explorer,item)
     EndIf          
Next item

AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
AddGadgetItem (#StatutList,-1,". " + " Suppression terminée !")
AddGadgetItem (#StatutList,-1,". " + " Nombre de fichiers supprimés: " + Str(NbreFt))
AddGadgetItem (#StatutList,-1,". " + " Nombre de fichiers non supprimés: " + Str(Nbreechec))
AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")

EndProcedure

;--------------------------------------------------------------------------------------

OpenWindows()
SetGadgetColors()
SetDefaulValues()
GetFtpInfos()

SetGadgetState(#FTP_Prog,0) 

InitNetwork()

Repeat 
EventID = WaitWindowEvent()

If EventID = #PB_Event_CloseWindow
   End
EndIf
             
If EventID = #PB_Event_Gadget
   Select EventGadget()

   Case #Connection
         ClearGadgetItemList(#FTP_Explorer)
         GetFtpInfos()
         ErrorFound=0 
         If wServeurFTP$=""
            MessageRequester("Erreur","Adresse FTP incorrecte  ! ")
            ErrorFound=1 
         ElseIf wUserFtp$=""
            MessageRequester("Erreur","Nom utilisateur incorrect  ! ")
            ErrorFound=1 
         ElseIf wMpFtp$=""
            MessageRequester("Erreur","Mot de passe incorrect  ! ")
            ErrorFound=1 
         ElseIf localPath$=""
            MessageRequester("Erreur","Saisissez le répertoire initial local ! ")
            ErrorFound=1 
         ElseIf FtpPath$=""
            MessageRequester("Erreur","Indiquez le répertoire initial distant ! ")
            ErrorFound=1 
         EndIf
         
         If ErrorFound=0 
            ClearGadgetItemList (#StatutList)
            AddGadgetItem (#StatutList,-1,". " + " Connection en cours...")
            SetGadgetText(#FTP_Progres,"Connection en cours...")
              
            If OpenFTP(#ftp, wServeurFTP$, WuserFtp$, wMpFtp$)
               If GetGadgetState(#CheckMemoriser_Param)=1
                  MemoriserParam()
               EndIf
                  
               AddGadgetItem (#StatutList,-1,". " +" Serveur ftp connecté avec succès...")
               SetGadgetText(#FTP_Progres,"Connection réussie...")
               CheckConnection=1
               SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
               DisableGadget(#FTP_SupprimerServeur,1)
               Afficher_Fichiers_Ftp()
            Else
               MessageRequester("Erreur de connection...", "Impossible de se connecter au serveur !")
               AddGadgetItem (#StatutList,-1,". " +"Impossible de se connecter au serveur !")
               SetGadgetText(#FTP_Progres,"Impossible de se connecter au serveur !")
               DisableGadget(#FTP_SupprimerServeur,0)
               CheckConnection=0
            EndIf
         EndIf
             
   Case #HOME_Explorer
        If EventType()=#PB_EventType_Change
           wchemin$=GetGadgetText(#HOME_Explorer)
           SetGadgetText(#HOME_Explorer_Rep,wchemin$)
           LocalPath$=wchemin$
        EndIf
    
   Case #FTP_Parcourir
         WChemin$=PathRequester("Sélectionnez un dossier:", LocalPath$)
         If wchemin$
            SetGadgetText(#HOME_Explorer_Rep,wChemin$)
            SetGadgetText(#FTP_LocalPath,wChemin$)
            ResizeGadget(#HOME_Explorer, #PB_Ignore, #PB_Ignore,#PB_Ignore, #PB_Ignore)
            LocalPath$=wchemin$
         EndIf    

   Case #Transferer
         ErrorFound=0
         NbreFt=0
         NbreEchec=0
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté au serveur ftp !")
         Else   
            DisableGadget(#FTP_SupprimerServeur,1)

            ;------------ Transfert de fichiers (chemin local vers chemin ftp ----------------
            Demarrer_Transfert_FTP()

            ;Résultat du transfert...
            If NbreEchec=0 And NbreFt=0
               MessageRequester("Erreur","Aucun fichier n'a été sélectionné pour le tansfert !")
            Else   
               ;Affichage des fichiers transférés dans la liste de destination (ftp) = réaffichage du chemin ftp 
                Afficher_Fichiers_Ftp()
            
               ;Affichage du statut...
                AddGadgetItem (#StatutList,-1,". " + "____________________________________________________")
                AddGadgetItem (#StatutList,-1,". " +" Transfert terminé !")
                AddGadgetItem (#StatutList,-1,". " +" Nbre de fichiers transférés : " + Str(NbreFt))
                AddGadgetItem (#StatutList,-1,". " +" Nbre de fichiers non transférés : " + Str(NbreEchec))
                AddGadgetItem (#StatutList,-1,"")
             EndIf
                     
          EndIf
          
          SetGadgetText(#FTP_Progres,"")
          DisableGadget(#FTP_SupprimerServeur,0)

   Case #FTP_Explorer
        Select EventType()
        Case #PB_EventType_LeftDoubleClick
              wLineSelected=GetGadgetState(#FTP_Explorer)
              If wLineSelected>=0 And wLineSelected<CountGadgetItems(#FTP_Explorer)
                 wFolderName$=GetGadgetItemText(#FTP_Explorer,wLineSelected,0)
                 wType$=GetGadgetItemText(#FTP_Explorer,wLineSelected,2)
                 If wType$="dossier"
                    wchemin$=wFolderName$
                    SetGadgetText(#FTP_Explorer_Rep,"/"+wchemin$)
                    FtpPath$=Trim(wchemin$)
                    Afficher_Fichiers_Ftp()
                EndIf   
              EndIf   
        EndSelect

   Case #Previous_PathFTP
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté ! ")
         Else
            FtpPath$=".."
            Afficher_Fichiers_Ftp()
         EndIf
         
   Case #FTP_Delete
         If CheckConnection=0
            MessageRequester("Erreur","Vous n'êtes pas connecté ! ")
            DisableGadget(#FTP_SupprimerServeur,0)
         Else
         ;voir s'il y a des fichiers sélectionnés 
         FileToDelete=0
         For item=0 To CountGadgetItems(#FTP_Explorer)
             If GetGadgetItemState(#FTP_Explorer, item) & #PB_ListIcon_Selected
                FileToDelete=1
                Break
             EndIf
         Next item
         
         If FileToDelete=1
            FTP_DeleteFiles()
            DisableGadget(#FTP_SupprimerServeur,1)
         Else
            MessageRequester("Erreur","Aucun fichier n'a été sélectionné pour la suppression ! ")
         EndIf
         EndIf
         
   Case #FTP_Serveur
         n=GetGadgetState(#FTP_Serveur)
         If n>=0
            wServeurFTP$=GetGadgetItemText(#FTP_Serveur,n)
            WSql=  "SELECT * FROM Flog Where Serveur_FTP=" + Chr(34) + wServeurFTP$+ Chr(34)
            CheckDatabaseQuery(IdLog,Wsql)
            If NextDatabaseRow(IdLog)
               wUSerFTP$=GetDatabaseString(IdLog,1)
               wMpFtp$=GetDatabaseString(IdLog,2)
               LocalPath$=GetDatabaseString(IdLog,3)
               FtpPath$=GetDatabaseString(IdLog,4)

               SetGadgetText(#FTP_User,WuserFtp$)
               SetGadgetText(#FTP_Mp,WMpFtp$)
               SetGadgetText(#FTP_LocalPath,LocalPath$)
               SetGadgetText(#FTP_Path,FtpPath$)

               SetGadgetText(#HOME_Explorer_Rep,LocalPath$)
               SetGadgetText(#FTP_Explorer_Rep,FtpPath$)
               CheckConnection=0
           EndIf
       EndIf
 
       DisableGadget(#FTP_SupprimerServeur,0)
       
   Case #Deconnection
         If CheckConnection=1
            CloseFTP(#ftp)
         EndIf   
         SetGadgetText(#FTP_Progres,"Vous êtes déconnecté du serveur..  !")
         ClearGadgetItemList (#StatutList)
         ClearGadgetItemList (#FTP_Explorer)
         DisableGadget(#FTP_SupprimerServeur,0)
         CheckConnection=0

   EndSelect

EndIf    
ForEver
End

falsam · Message par **falsam** » lun. 25/mars/2013 14:27

Bonjour omega. Pour une fois c'est toi qui va tester ce code poru voir si il fonctionne bien avec ton serveur

Contrainte par contre. Tu vas fermer ta version 4.60 de Pure Basic et charger et installer la version 5.11 dans un autre dossier de maniéré à ne pas perdre ta précieuse version 4.60.

Je laisse mes identifiant pour te montrer que ce code fonctionne. Tu peux cliquer sur les "..." comme sur les dossiers.
Je ne traite pas le transfert de fichier. Juste te montrer que la navigation fonctionne à l'intérieur d'un serveur ftp fonctionne bien.
Un plus dans ce code. je charge les icônes (*.ico) si tu coches la case adéquate. Le tri aussi fonctionne.

Code : Tout sélectionner

; FTP : Lecture du contenu d'une connexion FTP
;
; Contributor : falsam 
; OS          : Windows
; Purebasic   : 4.50++


EnableExplicit

Enumeration
  #Ftp
  #Mainform
  #SortSelect
  #ViewIcon
  #FileExplorer
EndEnumeration

Define.l Event, GEvent, TEvent

;Structure qui contiendra les informations des fichiers ou dossiers
Structure DirectoryEntry
  Sort.s
  Type.s
  Name.s
  Size.l
  ExtName.s
  DateUpdate.l
EndStructure

Global NewList FTPDirectory.DirectoryEntry()

;Style de la fenetre principale
Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered

;Icone des dossiers par defaut
Global FolderIcon.l

;Identifiant du thread
Global Thread.i

;Plan de l'application.
Declare JustifyGadgetColumn(Gadget.l, Column.i, FMT.i) ;Justifier une colonne 
Declare GetAssociatedFileIcon(IconPath.s, Value.l) ;Connaitre l'icone d'un fichier (Si icone possible)

Declare FTPConnect() ;Connection serveur FTP
Declare FTPDirectoryRead() ;Lecture du contenu du FTP et mémorisation dans une liste
Declare FTPDirectoryShow() ;Affichage de la liste dan un listicongadget

Declare StartThread(*Value)

Declare Open_MainForm() ;Fenetre principale de l'application

Declare Start() ;ça demarre ici

;Cadrer une colonne à droite gauche ou au centre.
Procedure JustifyGadgetColumn(Gadget.l, Column.i, FMT.i)
  Protected Lvc.LV_COLUMN
  Lvc\Mask = #LVCF_FMT
  Lvc\FMT = FMT ;#LVCFMT_LEFT or #LVCFMT_CENTER or #LVCFMT_RIGHT                   
  SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMN, Column, @Lvc)
EndProcedure

;Récupère l'icône associée à un fichier
Procedure GetAssociatedFileIcon(IconPath.s, Value.l)
  Protected FileInfo.SHFILEINFO
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | Value) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure

;Connection à un serveur ftp
Procedure FTPConnect()
 Protected FtpUrl.s, FtpPort.i, FtpUser.s, FTPPassWord.s
 
 ;Renseignez vos identifiants ftp
 FtpUrl = "s242132022.onlinehome.fr"
 FtpPort = 21
 FtpUser = "u48983622-pbr"
 FTPPassWord = "purebasicdemo"
 
 If Not OpenFTP(#ftp, FtpUrl, FTPUser, FTPPassWord, #PB_Ignore, FtpPort)
   MessageRequester ("Information","Ooops la connexion n'a pas pu se faire",#PB_MessageRequester_Ok)  
 EndIf
  
EndProcedure

;Lecture des fichiers se trouvant sur le serveur ftp
;Chaque noms de fichier et dossiers est stocké dans une list
Procedure FTPDirectoryRead()
  SetGadgetData(#FileExplorer, #False)
  ;If Thread<>0
  ;  KillThread(Thread)
  ;EndIf
    
  ClearList(FTPDirectory())
  
  SetGadgetText(#FileExplorer,"")
  If ExamineFTPDirectory(#ftp)
      While NextFTPDirectoryEntry(#ftp)
        AddElement(FTPDirectory())
        FTPDirectory()\Type=Str(FTPDirectoryEntryType(#ftp)) 
        FTPDirectory()\Name=FTPDirectoryEntryName(#ftp)        
        FTPDirectory()\Size=FTPDirectoryEntrySize(#ftp)
        FTPDirectory()\DateUpdate=FTPDirectoryEntryDate(#ftp)
        Select FTPDirectoryEntryType(#Ftp)
          Case #PB_FTP_File 
            FTPDirectory()\Sort="1"+FTPDirectoryEntryName(#Ftp)
            FTPDirectory()\ExtName = GetExtensionPart(FTPDirectory()\Name) + FTPDirectory()\Name
            
          Case #PB_FTP_Directory
            FTPDirectory()\Sort="0"+FTPDirectoryEntryName(#Ftp)
            
        EndSelect
        Wend
        
    EndIf
EndProcedure


;Affichage de la liste 
Procedure FTPDirectoryShow()
  Protected Name.s, Type.s, Size.s, Date.s, Icon.l
  
  ClearGadgetItems(#FileExplorer)
  SetGadgetData(#FileExplorer, #True)
  
  ;Comment doit on trier la liste
  Select GetGadgetState(#SortSelect) ;Quel est l'élément sélectionné pour le tri
    Case 0
      SortStructuredList(FTPDirectory(),#PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(DirectoryEntry\sort),#PB_Sort_String)
      
    Case 1 ;Trie par noms de fichiers ascendant
      SortStructuredList(FTPDirectory(),#PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(DirectoryEntry\Name),#PB_Sort_String)
      
    Case 2 ;Trie par noms de fichiers descendant
      SortStructuredList(FTPDirectory(),#PB_Sort_Descending|#PB_Sort_NoCase, OffsetOf(DirectoryEntry\Name),#PB_Sort_String)
      
    Case 3 ;Trie par extensions et noms de fichiers ascendant
      SortStructuredList(FTPDirectory(),#PB_Sort_Ascending|#PB_Sort_NoCase, OffsetOf(DirectoryEntry\ExtName),#PB_Sort_String)
      
    Case 4 ;Trie par extensions et noms de fichiers descendant
      SortStructuredList(FTPDirectory(),#PB_Sort_Descending|#PB_Sort_NoCase, OffsetOf(DirectoryEntry\ExtName),#PB_Sort_String)
      
      
  EndSelect

  ForEach FTPDirectory()
    
    Name = FTPDirectory()\Name
    Date = FormatDate("%dd/%mm/%yyyy %hh:%mm", FTPDirectory()\DateUpdate)

    Select FTPDirectory()\Type
      Case "1"
        Type="Fichier"
        Size = Str(FTPDirectory()\size)
        Icon = GetAssociatedFileIcon(FTPDirectory()\Name, #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
        
        ;Cas de l'extension .ico
        If GetExtensionPart(FTPDirectory()\Name)="ico" And GetGadgetState(#ViewIcon) = #PB_Checkbox_Checked  
          ReceiveFTPFile(#Ftp, FTPDirectory()\Name, GetHomeDirectory()+FTPDirectory()\Name)
          Icon = ImageID(LoadImage(#PB_Any, GetHomeDirectory()+FTPDirectory()\Name))
          DeleteFile(GetHomeDirectory()+FTPDirectory()\Name)
        EndIf       
        
      Case "2"
        Type="Dossier"
        Size=""
        Icon = FolderIcon
    EndSelect
    
    If Name <>"."
      AddGadgetItem(#FileExplorer,-1,Name + Chr(10) + Type + Chr(10) + Size + Chr(10) + Date, Icon)
    EndIf
    
    If GetGadgetData(#FileExplorer)=#False
      Break
    EndIf  
  Next
EndProcedure  

Procedure StartThread(*Value)  
  FTPDirectoryShow()
  
  While GetGadgetData(#FileExplorer)=#True
  Wend
EndProcedure


Procedure Open_MainForm()
  OpenWindow(#Mainform, 0, 0, 500, 400, "Ftp Demo", WindowStyle)
  
  TextGadget(#PB_Any, 10, 10, 60, 20, "Ordre de tri")
  ComboBoxGadget(#SortSelect, 80, 10, 300, 22)
  AddGadgetItem(#SortSelect, -1, "Noms de dossiers et fichiers (Par defaut)")
  AddGadgetItem(#SortSelect, -1, "Noms de fichiers Ascendant")
  AddGadgetItem(#SortSelect, -1, "Noms de fichiers Descendant")
  AddGadgetItem(#SortSelect, -1, "Extension et noms de fichiers Ascendant")
  AddGadgetItem(#SortSelect, -1, "Extension et noms de fichiers Descendant")
  SetGadgetState(#SortSelect, 0) ;Selectionne le premier élément de la liste
  
  CheckBoxGadget(#ViewIcon, 390, 10, 100, 20, "Voir les icones") 
  
  ListIconGadget(#FileExplorer, 10, 40, 480, 350, "File", 200, #PB_ListIcon_FullRowSelect      )
  AddGadgetColumn(#FileExplorer, 1, "Type", 60)
  AddGadgetColumn(#FileExplorer, 2, "Taille", 60)
  AddGadgetColumn(#FileExplorer, 3, "Date", 100)
  justifyGadgetColumn(#FileExplorer, 2, #LVCFMT_RIGHT)
EndProcedure

Procedure Start()
  InitNetwork()
  Open_MainForm()
  FolderIcon = GetAssociatedFileIcon(GetHomeDirectory(), #SHGFI_SMALLICON)
  FTPConnect()
  FTPDirectoryRead()
  SetGadgetData(#FileExplorer, #True)
  CreateThread(@StartThread(), 0)
EndProcedure

Start()

Repeat
  Event  = WaitWindowEvent(0)
  GEvent = EventGadget()
  TEvent = EventType()
  
  Select Event
    Case #PB_Event_Gadget
      SetGadgetData(#FileExplorer, #False)
      Select GEvent   
        Case #FileExplorer
          If TEvent=#PB_EventType_LeftDoubleClick And GetGadgetItemText(#FileExplorer,GetGadgetState(#FileExplorer), 1) = "Dossier"
            SetGadgetData(#FileExplorer, #False)
            SetFTPDirectory(#Ftp, GetGadgetItemText(#FileExplorer,GetGadgetState(#FileExplorer), 0))
            FTPDirectoryRead()
            CreateThread(@StartThread(), 0)
          EndIf
          
        Case #SortSelect, #ViewIcon
          SetGadgetData(#FileExplorer, #False)
          CreateThread(@StartThread(), 0)
                                 
      EndSelect
           
    Case #PB_Event_CloseWindow
      SetGadgetData(#FileExplorer, #False)      
      CloseFTP(#ftp) 
      End
      
  EndSelect
ForEver

Message par **Fred** » mar. 26/mars/2013 13:51

@omega: il est préférable d'éditer un post pour une correction, plutot que de reposter le code dans un nouveau post, merci.

omega · Message par **omega** » jeu. 28/mars/2013 11:41

Désolé Fred mais je crois que je viens de faire une bétise... Je viens de poster encore une nouvelle fois (toujours dans ce domaine mais il s'agit d'un problème différent) comment faire dans ce cas alors?il s'agit d'un problème différent Fred.

Merci

PureBasic

[RESOLU]Problème avec SetFTPDirectory

[RESOLU]Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: Problème avec SetFTPDirectory

Re: [RESOLU]Problème avec SetFTPDirectory

Re: [RESOLU]Problème avec SetFTPDirectory