PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

FTP Library Source

https://www.purebasic.fr/german/viewtopic.php?t=8519

Seite 1 von 1

FTP Library Source

Verfasst: 23.05.2006 21:54
von winduff
Habe im englischen Forum einen alten Code gefunden, super teil kamma vielleicht auch zu ner UserLib machen :-)

Hier der Code, von PB3.94 zu PB4.00 konvertiert:

Code: Alles auswählen

server_reply.s=Space(10240)
#FTP_PORT=21
#LFCR=Chr(13)+Chr(10)

#FTP_OK = 1
#FTP_ERROR = 0
#FTP_TimeOut = -1

Global FTP_Last_Message.s, ftp_data.l

Procedure Int_FTP_PASV(Ftp)
  
  Delay(100)
  SendNetworkString(Ftp,"PASV"+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      ;{ -- Retrieve Server IP and Data Port
      If FindString(In,"227",1)
        Argument$=Trim(In)
        startpos=FindString(Argument$, "(", 1)
        Position = FindString(Argument$, ",", 1)
        server_ip.s = Mid(Argument$, startpos+1, Position-1-startpos)+"."
        NewPosition = FindString(Argument$, ",", Position+1)
        server_ip= server_ip+Mid(Argument$, Position+1, NewPosition-Position-1)+"."
        Position = FindString(Argument$, ",", NewPosition+1)
        server_ip= server_ip+Mid(Argument$, NewPosition+1, Position-NewPosition-1)+"."
        NewPosition = FindString(Argument$, ",", Position+1)
        server_ip= server_ip+Mid(Argument$, Position+1, NewPosition-Position-1)
        server_ip = Trim(server_ip)
        ; Get the port..
        ;
        Position = FindString(Argument$, ",", NewPosition+1)
        ClientPort = Val(Mid(Argument$, NewPosition+1, Position-NewPosition-1)) << 8+Val(Right(Argument$, Len(Argument$)-Position))
        ;}
        
        ftp_data= OpenNetworkConnection(server_ip,ClientPort)
        
        If ftp_data
          ProcedureReturn #FTP_OK
        EndIf
        
      EndIf
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
EndProcedure


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

Procedure.s FTP_Last_Message()
  ProcedureReturn FTP_Last_Message
EndProcedure

Procedure FTP_Init()
  If InitNetwork()
    ProcedureReturn 1
  Else
    FTP_Last_Message="Unable to start TCP/IP stack..."
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure FTP_Connect(Server.s,Port.l) ; // Returns FTPconnection
  thread.l=OpenNetworkConnection(Server,Port)
  If thread
    ProcedureReturn thread
  Else
    FTP_Last_Message="Unable to connect to specified server..."
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure FTP_Login(Ftp.l,UserName.s,Password.s)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"USER "+UserName+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"331",1)
        time.l=Date()
        SendNetworkString(Ftp,"PASS "+Password+#LFCR)
      EndIf
      
      If FindString(In,"230",1)
        time.l=Date()
        SendNetworkString(Ftp,"TYPE A"+#LFCR)
        ProcedureReturn #FTP_OK
      EndIf
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
EndProcedure

Procedure FTP_LogOut(Ftp.l)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"QUIT"+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"221",1)
        time.l=Date()
        ProcedureReturn #FTP_OK
      EndIf
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
EndProcedure

Procedure FTP_Close(Ftp.l)
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  If CloseNetworkConnection(Ftp)
    ProcedureReturn #FTP_OK
  Else
    FTP_Last_Message="Unable to close specified ftp connection"
    ProcedureReturn #FTP_ERROR
  EndIf
EndProcedure

Procedure FTP_List(Ftp.l)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  If ftp_data=0
    If Int_FTP_PASV(Ftp)=0
      ProcedureReturn #FTP_ERROR
    EndIf
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"LIST"+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If ftp_data
      ftp_data_event=NetworkClientEvent(ftp_data)
    EndIf
    
    If ftp_data_event=2
      In.s=Space(48000)
      result=ReceiveNetworkData(ftp_data,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      Int_FTP_PASV_CLOSE()
      ProcedureReturn #FTP_OK
    EndIf
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      time.l=Date()
      
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
EndProcedure

Procedure FTP_Retrieve(Ftp.l,filename.s,Destination.s)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  If ftp_data=0
    If Int_FTP_PASV(Ftp)=0
      ProcedureReturn #FTP_ERROR
    EndIf
  EndIf
  
  mem=AllocateMemory(64000)
  
  If CreateFile(0,Destination+filename)=0 And mem
    FTP_Last_Message="Unable to create file"
    CloseNetworkConnection(ftp_data)
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"RETR "+filename+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If ftp_data
      ftp_data_event=NetworkClientEvent(ftp_data)
    EndIf
    
    If ftp_data_event=2
      result=ReceiveNetworkData(ftp_data,mem,64000)
      If result>0
        WriteData(0,mem,result)
        Goto again:
      EndIf
      CloseFile(0)
      FreeMemory(mem)
      Int_FTP_PASV_CLOSE()
      ProcedureReturn #FTP_OK
      again:
    EndIf
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"550",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
EndProcedure

Procedure FTP_CurrentDir(Ftp.l)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"PWD"+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"257",1)
        In=Trim(In)
        In=RemoveString(In,#LFCR)
        Position=FindString(In,"/",1)
        endposition=FindString(In,Chr(34),Position+3)-Position
        In=Mid(In,Position+1,endposition-1)
        FTP_Last_Message=In
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
  
EndProcedure

Procedure FTP_ChangeDir(Ftp.l,Dirname.s)
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"CWD "+Dirname+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"550",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"250",1)
        In=Trim(In)
        In=RemoveString(In,#LFCR)
        FTP_Last_Message=In
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
  
EndProcedure

Procedure FTP_Store(Ftp.l,filename.s)
  
  Block_size.l=4096
  
  If Ftp=0
    ProcedureReturn #FTP_ERROR
  EndIf
  
  
  If ftp_data=0
    If Int_FTP_PASV(Ftp)=0
      ProcedureReturn #FTP_ERROR
    EndIf
  EndIf
  
  
  file_size.l=FileSize(filename)
  
  If file_size>Block_size
    Blocks.l=file_size/Block_size
    Last_Block.l=file_size-(Block_size*Blocks)
  Else
    Blocks.l=1
    Block_size=file_size
  EndIf
  
  mem=AllocateMemory(Block_size)
  
  If OpenFile(0,filename)=0 And mem
    FTP_Last_Message="Unable to open file"
    CloseNetworkConnection(ftp_data)
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"STOR "+GetFilePart(filename)+#LFCR)
  time.l=Date()
  
  Repeat
    
    Event=NetworkClientEvent(Ftp)
    
    If ftp_data
      ftp_data_event=NetworkClientEvent(ftp_data)
    EndIf
    
    If ftp_data_event=2
      result=ReceiveNetworkData(ftp_data,mem,Block_size)
      CloseFile(0)
      FreeMemory(mem)
      Int_FTP_PASV_CLOSE()
      ProcedureReturn #FTP_OK
    EndIf
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      In=Trim(In)
      FTP_Last_Message=In
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"550",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"125",1)
        For a=1 To Blocks
          ReadData(0,mem,Block_size)
          SendNetworkData(ftp_data,mem,Block_size)
        Next
        
        If Last_Block>0
          ReadData(0,mem,Last_Block)
          SendNetworkData(ftp_data,mem,Last_Block)
        EndIf
        Int_FTP_PASV_CLOSE()
        
      EndIf
      
      If FindString(In,"226",1)
        CloseFile(0)
        FreeMemory(mem)
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
EndProcedure

Procedure FTP_MakeDir(Ftp.l,Dirname.s)
  If Ftp=0 Or Dirname=""
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"MKD "+Dirname+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"530",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      If FindString(In,"550",1)
        ProcedureReturn #FTP_OK
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"257",1)
        In=Trim(In)
        In=RemoveString(In,#LFCR)
        Position=FindString(In,"/",1)
        endposition=FindString(In,Chr(34),Position+3)-Position
        In=Mid(In,Position+1,endposition-1)
        FTP_Last_Message=In
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
  
EndProcedure

Procedure FTP_RemoveDir(Ftp.l,Dirname.s)
  
  If Ftp=0 Or Dirname=""
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"RMD "+Dirname+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"550",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"250",1)
        In=Trim(In)
        FTP_Last_Message=In
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
  
EndProcedure

Procedure FTP_Delete(Ftp.l, filename.s)
  
  If Ftp=0 Or filename=""
    ProcedureReturn #FTP_ERROR
  EndIf
  
  Delay(100)
  SendNetworkString(Ftp,"DELE "+filename+#LFCR)
  
  time.l=Date()
  
  Repeat
    Event=NetworkClientEvent(Ftp)
    
    If Event=0
      
      now=Date()
      If now-time > 20
        FTP_Last_Message="Time out"
        ProcedureReturn #FTP_TimeOut
      EndIf
      
    ElseIf Event=2
      
      In.s=Space(10240)
      result=ReceiveNetworkData(Ftp,@In,Len(In))
      
      ;{ -- Analise data --
      
      ; -- Error Parsing
      If FindString(In,"550",1)
        ProcedureReturn #FTP_ERROR
      EndIf
      
      ; -- OK Parsing
      
      If FindString(In,"250",1)
        In=Trim(In)
        FTP_Last_Message=In
        ProcedureReturn #FTP_OK
      EndIf
      
      time.l=Date()
      
      ;}
      
    EndIf
    
    Delay(50)
    
  Until quit=1
  
  quit=0
  
  ProcedureReturn #FTP_OK
  
EndProcedure

;/////////////////
;Example of usage

; Delays are needed to wait for server sync!!!


If FTP_Init()
  Com_port.l=FTP_Connect("yourserver",21)
  
  If Com_port
    
    If FTP_Login(Com_port,"yourlogin","yourpassword")
      Debug ">>> Login Sucessful"
      
      
      If FTP_MakeDir(Com_port,"test")
        Debug ">>> Directory created!"
      EndIf
      
      Delay(500)
      
      If FTP_ChangeDir(Com_port,"test")
        Debug ">>> Changed Directory"
      EndIf
      
      Delay(500)
      
      If FTP_CurrentDir(Com_port)
        Debug ">>> Current Directory:" + FTP_Last_Message()
      EndIf
      
      Delay(500)
      
      Debug ">>> Sending File "
      If FTP_Store(Com_port,"d:\casa.pdf")
        Debug ">>> File Uploaded..."
      EndIf
      
      Delay(500)
      
      If FTP_List(Com_port)
        Debug ">>> File List Has Follows..."
        Debug FTP_Last_Message()
      EndIf
      
      Delay(500)
      
      Debug ">>> Downloading File "
      If FTP_Retrieve(Com_port,"casa.pdf","e:\")
        Debug ">>> File Saved "
      Else
        Debug FTP_Last_Message()
      EndIf
      
      Delay(500)
      
      If FTP_Delete(Com_port,"casa.pdf")
        Debug ">>> File deleted!"
      EndIf
      
      If FTP_ChangeDir(Com_port,"..")
        Debug ">>> Changed Directory"
      EndIf
      
      
      If FTP_RemoveDir(Com_port,"test")
        Debug ">>> Directory deleted!"
      EndIf
      
      Delay(500)
      
      FTP_LogOut(Com_port)
    EndIf
    
    FTP_Close(Com_port)
  Else
    Debug FTP_Last_Message()
  EndIf
Else
  Debug FTP_Last_Message()
EndIf

End
Fragen zum englischen -> Helfe gerne, ansonsten dürften die Befehle leicht zu verstehen sein!

Link zum originalthread:

http://www.purebasic.fr/english/viewtop ... ftp+upload

Verfasst: 23.05.2006 22:13
von ts-soft
Da solltest Du erstmal NUM3 anschreiben, ob Du das darfst, bzw. er es nicht
selber vorhat. Schick im ein Autogram von David Hasselhoff, dann wird er
es schon erlauben :wink:

Verfasst: 24.05.2006 00:12
von Kiffi
> Schick im ein Autogram von David Hasselhoff, dann wird er es schon erlauben :wink:

Hasselhoff nun auch in diesem Forum? ;-)

@winduff:

Kannst ja folgendes nehmen:

Bild

Grüße ... Kiffi

Verfasst: 24.05.2006 00:22
von winduff
lol hrhr mal sehn, warscheinlich stempelt er mich gleich als schwul ab :mrgreen:

Verfasst: 24.05.2006 00:24
von ts-soft
Auf jedenfall sollte die Lib für dieses OS geeignet sein:
Bild

Verfasst: 24.05.2006 03:49
von Zaphod
Oh man, danke, jetzt ist mir übel...

Verfasst: 24.05.2006 06:05
von DarkDragon
:lol: Jetzt geht dieses "Gehasselhoffe" hier im deutschen Forum auch noch los.

http://www.purebasic.fr/english/viewtop ... 9128#89128

Da hab ich auch ein paar Funktionen gepostet. Hier im Forum sind sie auch noch irgendwo.

Verfasst: 24.05.2006 08:05
von HeX0R
Das hier von Lars ist genial:
http://www.purebasic.fr/german/viewtopi ... highlight=
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de