Mir war mal wieder etwas langweilig, da hab ich aus aktuellem Anlass einen kleinen FTP-client zu Demonstrierzwecken gezaubert.
Das Beispiel demonstriert, wie man die PB-FTP-Bibliothek nutzen kann und wie das alles geht.
Zum Testen:
Serveradresse eingeben, dann auf "Verbinden" klicken... mit einem Doppelklick auf ein Verzeichnes oeffnet man es, mit einem Doppelklick auf eine Datei ladet man die markierte Datei herunter...
Mit einem Klick auf "Download"...
- ladet man eine markierte Datei herunter
- ladet man einen markiersten Ordner + alle Unterordner herunter.
Code: Alles auswählen
;*************************
;* *
;* FTP-Client *
;* by Dare Devil 2009 *
;* Pure Basic 4.30 *
;* *
;* normalerweise *
;* plattformunabhaengig, *
;* jedoch nur unter *
;* Windows getestet! *
;* *
;*************************
Enumeration ;Konstanendeklarationen
#fenster
#ordner
#downloadbutton
#adress
#connectbutton
#ftpObj
#userpass
EndEnumeration
#title = "FTP-Client" ;Titel der einzelnen Fenster und Messagerequestern
Global Username.s = "anonymous" ;Username zum verbinden
Global Password.s ;Passwort zum verbinden
Declare GetUsernamePassword() ;Fenster oeffnen und Benutzer nach Daten (Passwort und Benutzername) fragen
Declare DownloadFile(filename$) ;eine einzelne Datei downloaden
Declare DownloadDir(dirname$) ;ein Ordner + Subordner downloaden
If InitNetwork() = 0 ;Netzwerkumgebung initialisieren
MessageRequester(#title, "Fehler beim initialisieren der Netzwerkumgebung", #MB_ICONERROR)
End
EndIf
;Fenster oefnnen
If OpenWindow(#fenster, 0, 0, 600, 300, #title, #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
MessageRequester(#title, "Das Fenster konnte nicht geoeffnet werden!")
End
EndIf
;Gadgets oeffnen - duerfte selbsterklaerend sein, fuer was die gut sind
TextGadget(#PB_Any, 5, 35, 300, 15, "Liste aller Ordner und Dateien auf dem vorhandenen Server:")
ListIconGadget(#ordner, 5, 50, 590, 100, "Typ", 60)
AddGadgetColumn(#ordner, 1, "Bezeichnung", 525)
ButtonGadget(#downloadbutton, 500, 160, 90, 30, "Download!")
TextGadget(#PB_Any, 5, 160, 80, 15, "FTP-Adresse: ")
StringGadget(#adress, 85, 157, 200, 20, "")
ButtonGadget(#connectbutton, 290, 157, 100, 20, "Verbinden")
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
Break
ElseIf EventID = #PB_Event_Gadget
If EventGadget() = #connectbutton ;wenn auf den Verbinden-Button geklickt wurde...
If GetUsernamePassword() = 1 ;...dann frage Benutzer nach Passwort und Username
If OpenFTP(#ftpObj, GetGadgetText(#adress), Username, Password) = 0 ;Pruefen ob erfolgreich verbunden wurde
MessageRequester(#title, "Konnte nicht zu " + GetGadgetText(#adress) + " verbinden!")
Else
;wenn ja, starte die Untersuchung der enthaltenen Ordner + Dateien
If ExamineFTPDirectory(#ftpObj) = 0
MessageRequester(#title, "Es ist ein Fehler aufgetreten!")
CloseFTP(#ftpObj)
Else
;evtl. vorhandene Dateien + Ordner aus der Liste entfernen
ClearGadgetItems(#ordner)
;die "Ein Ordner zurueck"-Funktion implementieren
AddGadgetItem(#ordner, 0, "Dir" + Chr(10) + "..")
While NextFTPDirectoryEntry(#ftpObj)
If FTPDirectoryEntryType(#ftpObj) = #PB_FTP_File
;wenn Datei.. fuege es zur Liste hinzu
AddGadgetItem(#ordner, CountGadgetItems(#ordner), "File" + Chr(10) + FTPDirectoryEntryName(#ftpObj))
Else
;wenn Ordner...
AddGadgetItem(#ordner, CountGadgetItems(#ordner), "Dir" + Chr(10) + FTPDirectoryEntryName(#ftpObj))
EndIf
Wend
EndIf
EndIf
EndIf
;wenn auf ein Eintrag in der Liste doppelgeklickt wurde...
ElseIf EventGadget() = #ordner And EventType() = #PB_EventType_LeftDoubleClick
If IsFTP(#ftpObj) And GetGadgetItemText(#ordner, GetGadgetState(#ordner), 0) = "Dir"
;wenn es ein Ordner ist...
;... dann setze den neuen Ordner
If SetFTPDirectory(#ftpObj, GetGadgetItemText(#ordner, GetGadgetState(#ordner), 1)) = 0
MessageRequester(#title, "Fehler beim oeffnen von " + GetGadgetItemText(#ordner, GetGadgetState(#ordner), 1))
Else
;alte Eintraege loeschen
ClearGadgetItems(#ordner)
AddGadgetItem(#ordner, 0, "Dir" + Chr(10) + "..")
If ExamineFTPDirectory(#ftpObj) = 0
MessageRequester(#title, "Es ist ein Fehler beim Laden aufgetreten!")
Else
;Starte die Untersuchung aller vorhandenen Dateien + Ordner
;im ausgewaehlten Verzeichnis
While NextFTPDirectoryEntry(#ftpObj)
If FTPDirectoryEntryType(#ftpObj) = #PB_FTP_File
AddGadgetItem(#ordner, CountGadgetItems(#ordner), "File" + Chr(10) + FTPDirectoryEntryName(#ftpObj))
Else
AddGadgetItem(#ordner, CountGadgetItems(#ordner), "Dir" + Chr(10) + FTPDirectoryEntryName(#ftpObj))
EndIf
Wend
EndIf
EndIf
;wenn es nun eine Datei war, auf die doppelgeklickt wurde...
ElseIf IsFTP(#ftpObj) And GetGadgetItemText(#ordner, GetGadgetState(#ordner), 0) = "File"
;dann downloade die Datei
Ergebnis = DownloadFile(GetGadgetItemText(#ordner, GetGadgetState(#ordner), 1))
;ueberprufen, ob alles gut gelaufen ist
If Ergebnis = 0
MessageRequester(#title, "Es ist ein Fehler beim Downloaden der Datei aufgetreten!")
ElseIf Ergebnis <> 0 And Ergebnis <> -1
MessageRequester(#title, "Datei erfolgreich heruntergeladen!")
EndIf
EndIf
;wenn auf den Downloadbutton geklickt wurde...
ElseIf EventGadget() = #downloadbutton
If IsFTP(#ftpObj)
;wenn eine Datei markiert ist, downloade die Datei
If GetGadgetItemText(#ordner, GetGadgetState(#ordner), 0) = "File"
Ergebnis = DownloadFile(GetGadgetItemText(#ordner, GetGadgetState(#ordner), 1))
If Ergebnis = 0
MessageRequester(#title, "Es ist ein Fehler beim Downloaden der Datei aufgetreten!")
ElseIf Ergebnis <> 0 And Ergebnis <> -1
MessageRequester(#title, "Datei erfolgreich heruntergeladen!")
EndIf
;wenn ein Verzeichnis markiert ist, downloade das Verzeichnis
ElseIf GetGadgetItemText(#ordner, GetGadgetState(#ordner), 0) = "Dir"
Ergebnis = DownloadDir(GetGadgetItemText(#ordner, GetGadgetState(#ordner), 1))
If Ergebnis = 0
MessageRequester(#title, "Es ist ein Fehler beim Downloaden des Verzeichnisses aufgetreten!")
ElseIf Ergebnis <> 0 And Ergebnis <> -1
MessageRequester(#title, "Verzeichnis erfolgreich heruntergeladen!")
EndIf
EndIf
EndIf
EndIf
EndIf
ForEver
If IsFTP(#ftpObj)
;evtl. noch vorhandene Verbindung schliessen
;uebernimmt PB aber glaub ich von automatisch
CloseFTP(#ftpObj)
EndIf
End
Procedure DownloadDir(dirname$)
;Downloaden des ausgewaehlten Verzeichnisses + Unterverzeichnisse
Protected path$
Protected ftppath$
;Zielordner ermitteln
path$ = PathRequester("Ordner speichern unter ...", "")
;dynamischer Array, um darauf zu speichern,
;welche Unterverzeichnisse schon untersucht und erfolgreich gedownloadet wurden
NewList CreatedDirs.s()
AddElement(CreatedDirs())
If Not path$
;wenn auf 'Abbrechen' geklickt wurde
ProcedureReturn -1
Else
;ansonsten beginnen wir mit dem Download...
SetCurrentDirectory(path$) ;ausgewaehltes Verzeichnis setzen
CreateDirectory(dirname$) ;neues Verzeichnis darin erstellen
;(das Verzeichnis, dass ausgewaehlt wurde)
SetCurrentDirectory(GetCurrentDirectory() + dirname$) ;dieses neues Verzeichnis auswaehlen
;um dort evtl. neue Verzeichnisse zu erstellen,
;falls welche existieren
If SetFTPDirectory(#ftpObj, dirname$) = 0 ;das markierte FTP-Verzeichnis fuer Untersuchung laden
ProcedureReturn 0
EndIf
If ExamineFTPDirectory(#ftpObj) = 0 ;Starte mit der Untersuchung
ProcedureReturn 0
Else
ftppath$ = GetFTPDirectory(#ftpObj) ;aktuelles FTP-Verzeichnis ermitteln
Repeat
If Not NextFTPDirectoryEntry(#ftpObj)
If Not GetFTPDirectory(#ftpObj) = ftppath$ ;wenn wir uns nicht im Ursprungsverzeichnis befinden...
If SetFTPDirectory(#ftpObj, "..") = 0 ;...dann heisst das, wir muessen einen Ordner zurueck
;gehen
ProcedureReturn 0
Else
If ExamineFTPDirectory(#ftpObj) = 0 ;ExamineFTPDirectory muss immer neu gestartet
;werden, wenn das Verzeichnis gewechselt wurde...
;... warum auch immer ...
ProcedureReturn 0
EndIf
SetCurrentDirectory(GetCurrentDirectory() + "..") ;auch auf der Festplatte einen Ordner 'zurueckgehen'
EndIf
Else
Break ;wenn es nix mehr gibt zum downloaden, dann beende die Schleife
EndIf
EndIf
If FTPDirectoryEntryType(#ftpObj) = #PB_FTP_File ;wenn es eine Datei ist...
If ReceiveFTPFile(#ftpObj, FTPDirectoryEntryName(#ftpObj), GetCurrentDirectory() + FTPDirectoryEntryName(#ftpObj)) = 0
;dann lade sie herunter....
ProcedureReturn 0
EndIf
ElseIf FTPDirectoryEntryType(#ftpObj) = #PB_FTP_Directory ;wenn der EIntrag ein Verzeichnis ist...
;jetzt wird mit der Untersuchung gestartet
;ob wir das Verzeichnis bereits downgeloadet haben...
FirstElement(CreatedDirs())
Ergebnis = 1
ForEach CreatedDirs()
If FTPDirectoryEntryName(#ftpObj) = CreatedDirs()
;wenn ein EIntrag gefunden wurde, dann ist das ergebnis falsch
;und wir starten erneut mit der Untersuchung
;ansonsten... wenn kein Eintrag in der Liste gefunden wurde,
;dann ist das Ergebnis logischerweise wahr
Ergebnis = 0
EndIf
Next
If Ergebnis = 1
CreatedDirs() = FTPDirectoryEntryName(#ftpObj)
;nun fuegen das neue Verzeichnis in die Liste ein
AddElement(CreatedDirs())
;anschliessen erstellen wir das Verzeichnis auch auf dem PC
CreateDirectory(FTPDirectoryEntryName(#ftpObj))
;und setzen das Verzeichnis auch wieder
SetCurrentDirectory(GetCurrentDirectory() + FTPDirectoryEntryName(#ftpObj))
If SetFTPDirectory(#ftpObj, FTPDirectoryEntryName(#ftpObj)) = 0
;anschliessend wechseln wir in dieses neue Verzeichnis,
;um dort die Untersuchungen fortzufuehren
ProcedureReturn 0
Else
;wie oben bereits beschrieben, muss ExamineFTPDirectory immer neu
;gestartet werden, wenn das Verzeichnis gewechselt wurde
If ExamineFTPDirectory(#ftpObj) = 0
ProcedureReturn 0
EndIf
EndIf
EndIf
EndIf
ForEver
;wenn alles geklappt hat, wahr zurueckgeben,
;dass alles gut geklappt hat
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure DownloadFile(filename$)
;Download einer einzelnen Datei
Protected ZielDatei$
Protected Ergebnis
;OpenRequester zum auswahlen des Zielpfades
ZielDatei$ = OpenFileRequester("Speichern als ...", GetFilePart(filename$), GetExtensionPart(filename$) + " | *." + GetExtensionPart(filename$), 0)
If Not ZielDatei$
;wenn auf abbrechen geklickt wurde...
ProcedureReturn -1
Else
;ansonsten Datei downloaden und das Ergebnis der Behandlung zurueckgeben.
Ergebnis = ReceiveFTPFile(#ftpObj, filename$, ZielDatei$)
ProcedureReturn Ergebnis
EndIf
EndProcedure
Procedure GetUsernamePassword()
;Funktion, um Passwort und Username
;vom Benutzer zu bekommen
;duerfte selbsterklaerend sein,
;deswegen schreib ich dazu mal nix ;)
Protected pass
Protected user
Protected button
Protected EventID
DisableWindow(#fenster, 1)
If OpenWindow(#userpass, 0, 0, 200, 130, "Authentifizierung", #PB_Window_SystemMenu | #PB_Window_ScreenCentered, WindowID(#fenster)) = 0
MessageRequester(#title, "Konnte Fenster nicht oeffnen")
ProcedureReturn 0
EndIf
TextGadget(#PB_Any, 5, 25, 80, 15, "Username:")
TextGadget(#PB_Any, 5, 50, 80, 15, "Passwort:")
user = StringGadget(#PB_Any, 85, 22, 100, 20, Username)
pass = StringGadget(#PB_Any, 85, 47, 100, 20, Password)
button = ButtonGadget(#PB_Any, 85, 90, 50, 20, "OK!")
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
DisableWindow(#fenster, 0)
CloseWindow(#userpass)
UseGadgetList(WindowID(#fenster))
ProcedureReturn 0
ElseIf EventID = #PB_Event_Gadget
If EventGadget() = button
Username = GetGadgetText(user) ;globale Variablen
Password = GetGadgetText(pass)
Break
EndIf
EndIf
ForEver
DisableWindow(#fenster, 0)
CloseWindow(#userpass)
UseGadgetList(WindowID(#fenster))
ProcedureReturn 1
EndProcedureHoffe, der Code ist hilfreich.
Unter Windows funktioniert es einwandfrei.
Viel Spass noch beim basteln!
//edit
uff - alles ausfuehrlich kommentiert... Rechtschreibfehler duerft ihr behalten, falls ihr welche findet
+ 
