Salut,
Quelqu'un pourrait me dire comment je peu me connecter a un ftp avec login et pass ? car network on peut pas mettre login et pass... et aussi comment je peu passer en mode passif ?
Merci d'avance pour votre réponse.
Connection a un ftp
Tiens voici un code de Zapman (enfin je pense puisqu'il ya son nom ^^) :
J'ai pas testé plus que sa mais j'ai réussi à me connecter ^^ (c'est le seul test effectué)
Code : Tout sélectionner
; FTP_Library_Include
; Original code by Num3
; Modified by TerryHough - Oct 20, 2004, May 05, 2005 Vs.0.7a
; - tested with zFTPServer
; - DIR responds with "public" style listing
; - May 16, 2005 Vs.0.7b
; - tested with the Broker server
; - DIR responds with "ftp ftp" style listing
; - modified FTP_DirDisplay to handle both styles
; Modified by Zapman - June 10, 2005 Vs Z1
;
#LFCR = Chr(13) + Chr(10)
#CRLF = Chr(10) + Chr(13)
;
#FTP_OK = 1
#FTP_ERROR = 0
#FTP_TimeOut = -1
;
;
Global FTP_Last_Message.s
Global PortID.l
Global Server$
;
;
Global ConnectionID.l
Global In.s
Global TotalBytesSent.l
Global TotalBytesRecd.l
;
Global CLog.s
;
#LongTimeOut = 15000
#SmallTimeOut = 10000
;
#Block_size = 8192 ; 4096
;
;
Structure FTPFileInfo
Name$
Hour$
Day.l
Month$
FSize.l
EndStructure
;
Procedure Minimum(a,b)
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
;
Procedure SendNetworkString2(CID, message$)
If UCase(Left(message$,4))="PASS"
CLog + "<---> PASS ****" + #LFCR
Else
CLog + "<---> "+RemoveString(message$, #LFCR) + #LFCR
EndIf
Debug "<---> "+RemoveString(message$, #LFCR) + #LFCR
ProcedureReturn SendNetworkString(CID, message$)
EndProcedure
;
;
Procedure.s Wait(Connection, Timeout)
Delay(10)
BufferLenght = 32000
*Buffer = AllocateMemory(BufferLenght)
If *Buffer > 0
Text.s = ""
Repeat
t = ElapsedMilliseconds()
Size = -1
Repeat
Result = NetworkClientEvent(Connection)
If result <> 2 : Delay(5) : EndIf
Until Result = 2 Or ElapsedMilliseconds()-t > Timeout
If Result = 2
Size = ReceiveNetworkData(Connection, *Buffer, BufferLenght)
If Size > 0
Text.s + PeekS(*Buffer,Size)
EndIf
EndIf
If size > 150
Timeout = 1000
Else
Timeout = 50
EndIf
Until Size < 1
If Text
While Right(Text,1)=Chr(10) Or Right(Text,1)=Chr(13) Or Right(Text,1)=" "
Text = Left(Text,Len(Text)-1)
Wend
FreeMemory(*Buffer)
CLog + ">---< "+Text + #LFCR
Debug ">---< "+Text + #LFCR
ProcedureReturn Text
Else
CLog + "Time Out" + #LFCR
Debug "!!! Time Out !!!"
FreeMemory(*Buffer)
ProcedureReturn "TimeOut"
EndIf
EndIf
EndProcedure
;
Procedure.s PassiveIP(Text.s)
s = FindString(Text, "(", 1)+1
l = FindString(Text, ")", s)-s
Host.s = Mid(Text, s, l)
IP.s = StringField(Host, 1, ",")+"."+StringField(Host, 2, ",")+"."+StringField(Host, 3, ",")+"."+StringField(Host, 4, ",")
ProcedureReturn IP.s
EndProcedure
;
Procedure.l PassivePort(Text.s)
s = FindString(Text, "(", 1)+1
l = FindString(Text, ")", s)-s
Host.s = Mid(Text, s, l)
Port = Val(StringField(Host, 5, ","))*256+Val(StringField(Host, 6, ","))
ProcedureReturn Port
EndProcedure
;
Procedure Int_FTP_PASV(Ftp, Log_Gadget)
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PASV")
EndIf
If ConnectionID = 0
;
SendNetworkString2(Ftp, "PASV" + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
; -- Analyze data --
Select Left(In,3)
Case "530" ; -- Error Parsing
ProcedureReturn #FTP_ERROR
Case "227" ; -- OK Parsing
; -- Get the PASV port assignment
FTP_Last_Message + " [Port " + Str(PassivePort(In)) + "]"
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + FTP_Last_Message)
EndIf
ConnectionID = OpenNetworkConnection(PassiveIP(In),PassivePort(In))
If ConnectionID
ProcedureReturn #FTP_OK
Else
;MessageRequester("Debug","Failed to connect on PASV ClientPort: "+Str(ClientPort)+Chr(10)+Server$ + Chr(10) + PassiveIP(In),0)
FTP_Last_Message + Chr(10) + "Unable to establish PASV connection"
ProcedureReturn #FTP_ERROR
EndIf
EndSelect
EndIf
Else
ProcedureReturn #FTP_OK
EndIf
EndProcedure
Procedure Int_FTP_PASV_CLOSE()
CloseNetworkConnection(ConnectionID)
ConnectionID = 0
EndProcedure
Procedure.s FTP_Last_Message()
ProcedureReturn FTP_Last_Message
EndProcedure
Procedure FTP_PutFile(ProgBarGadgetID.l,mem,file_size)
If ConnectionID
TotalBytesSent = 0
Repeat
toSend.l = Minimum(file_size, #Block_size)
ReadData(mem,toSend)
Repeat
result = SendNetworkData(ConnectionID, mem, toSend)
Until result = toSend
If result <> toSend
FTP_Last_Message = "Data send failure"
ProcedureReturn #FTP_ERROR
EndIf
; Compute progress ----------------------------------
TotalBytesSent + result
If ProgBarGadgetID
; Display progress
Progress.f = TotalBytesSent / file_size * 100
SetGadgetState(ProgBarGadgetID,Progress)
While WindowEvent() : Wend
EndIf
; ---------------------------------------------------
file_size - result ; Decrement by bytes just sent
Until file_size = 0
ProcedureReturn #FTP_OK
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_GetFile(ProgBarGadgetID.l,mem,file_size)
If ConnectionID
TotalBytesRecd = 0
Repeat
event = NetworkClientEvent(ConnectionID)
Select event
Case 2
toRecv.l = Minimum(file_size, #Block_size)
result = ReceiveNetworkData(ConnectionID, mem, toRecv)
WriteData(mem,result)
; Compute progress ----------------------------------
TotalBytesRecd + result
If ProgBarGadgetID
; Display progress
Progress.f = TotalBytesRecd / file_size * 100
SetGadgetState(ProgBarGadgetID,Progress)
While WindowEvent() : Wend
EndIf
; ---------------------------------------------------
file_size - result ; Decrement by bytes just received
Case 0
; Nothing received from server yet
Case 3
; A file was received - shouldn't have happened
FTP_Last_Message = "Error - A file waiting message received"
ProcedureReturn #FTP_ERROR
EndSelect
Until file_size = 0
ProcedureReturn #FTP_OK
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_DirList(Ftp)
FTP_Last_Message = ""
If ConnectionID
For vr = 1 To 10
In = Wait(ConnectionID, 1000)
If In = "TimeOut"
R226.s = Wait(Ftp, 1000) ; look for "226 - transfert completed"
If Left(R226,3)="226" ; end of transfert, we won't wait more
In = Wait(ConnectionID, 1000) ; we try just one more time to be sure to miss no data
vr = 10 ; and get out the loop
If In = "TimeOut"
In = "" ; The directory is empty. We'll return #FTP_OK
EndIf
EndIf
Else
vr = 10 ; to get out the loop
EndIf
Next
If Left(R226,3)<>"226"
Wait(Ftp, #LongTimeOut)
EndIf
If In = "TimeOut"
FTP_Last_Message = "Timed out while reading catalog"
ProcedureReturn #FTP_TimeOut
Else
FTP_Last_Message + Trim(In.s)
ProcedureReturn #FTP_OK
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure.s ExtractFileInfo(DirEntry$,FTPInfo)
*FTPInfoT.FTPFileInfo = FTPInfo
DirEntry$ = ReplaceString(DirEntry$, "public", "ftp ftp", 1) ; modify for zFTP
DirEntry$ = ReplaceString(DirEntry$, " ", " ", 0)
DirEntry$ = Trim(ReplaceString(DirEntry$, " ", " ", 0))
Temp = FindString(DirEntry$, Chr(10), 1)
If Temp = 0 : Temp = Len(DirEntry$)+1 : EndIf
EndLine = Temp
While Asc(Mid(DirEntry$,Temp,1))=32 Or Asc(Mid(DirEntry$,Temp,1))=10 Or Asc(Mid(DirEntry$,Temp,1))=13 : Temp - 1 : Wend
Line$ = Trim(Left(DirEntry$,Temp))
DirEntry$ = Right(DirEntry$, Len(DirEntry$) - EndLine)
Temp = Len(Line$)
For ct = 5 To 1 Step - 1 ; Examine data from end to start
posf = Temp
While Temp>0 And Asc(Mid(Line$,Temp,1))<>32 : Temp - 1 : Wend ; Look for space (separator)
posd = Temp + 1
Select ct
Case 5
*FTPInfoT\Name$ = Mid(Line$,posd,posf-posd + 1)
Case 4
*FTPInfoT\Hour$ = Mid(Line$,posd,posf-posd + 1)
Case 3
*FTPInfoT\Day = Val(Mid(Line$,posd,posf-posd + 1))
Case 2
*FTPInfoT\Month$= Mid(Line$,posd,posf-posd + 1)
Case 1
*FTPInfoT\FSize = Val(Mid(Line$,posd,posf-posd + 1))
EndSelect
Temp - 1
posf = Temp
Next
ProcedureReturn DirEntry$
EndProcedure
;
Procedure.s FTP_DirDisplay(gadget)
DirEntry$ = Trim(In)
While DirEntry$
DirEntry$ = ExtractFileInfo(DirEntry$,FTPInfo.FTPFileInfo)
FileName$ = FTPInfo\Name$
file_size = FTPInfo\FSize
If FTPInfo\Name$<>"." And FTPInfo\Name$<>".."
dir.s + FTPInfo\Name$ + Chr(13)
EndIf
If file_size And FileName$ <> "" And gadget
FileType$ = LCase(StringField(FileName$,2,"."))
FileName$ = RemoveString(FileName$,"." + FileType$,1)
AddGadgetItem(gadget, -1, Chr(10) + FileName$ + Chr(10) + FileType$ + Chr(10) + Str(file_size))
SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, CountGadgetItems(gadget) - 1, 0) ; Center justify column
While WindowEvent() : Wend
FileType$ = ""
FileName$ = ""
EndIf
;
Wend
ProcedureReturn dir
EndProcedure
Procedure FTP_Init()
If InitNetwork()
FTP_Last_Message = "Successfully started the TCP/IP stack..."
ProcedureReturn #FTP_OK
Else
FTP_Last_Message = "Unable to start TCP/IP stack..."
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure FTP_Connect(Server.s, PortNo.l) ; // Returns FTPconnection
PortID.l = OpenNetworkConnection(Server,PortNo)
ConnectionID = 0
CLog = ""
If PortID
In = Wait(PortID, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = ReplaceString(FTP_Last_Message(),"***",Server,1)
; -- Analyze Data --
Select Left(In,3)
; -- OK Parsing
Case "220"
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
EndIf
ProcedureReturn PortID
; -- Error Parsing
Case "120"
Case "421"
EndSelect
EndIf
Else
FTP_Last_Message = "Unable to connect to specified server"
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_Login(Ftp.l, User.s, Pass.s, Log_Gadget)
If Ftp
; Online with the server
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "USER " + User.s)
EndIf
;
SendNetworkString2(Ftp,"USER " + User + #LFCR)
;
Time.l = Date()
Repeat
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze Data --
Select Left(In,3)
; -- OK Parsing
Case "200" ; TYPE A ACCEPTED
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
EndIf
In.s = ""
ProcedureReturn #FTP_OK
Case "230" ; LOGIN ACCEPTED
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "---->" + Chr(10) + In)
EndIf
SendNetworkString2(Ftp, "TYPE A" + #LFCR)
Case "331"; Server requests a password
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PASS ********")
EndIf
SendNetworkString2(Ftp,"PASS " + Pass + #LFCR)
Case "530"; -- Error Parsing
ProcedureReturn #FTP_ERROR
Default
Delay(10)
If (Date()-Time)>#LongTimeOut
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_ERROR
EndIf
EndSelect
EndIf
Until In = ""
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_LogOut(Ftp.l, Log_Gadget)
If ConnectionID
Int_FTP_PASV_CLOSE()
EndIf
;
If Ftp
; Online with the server
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "QUIT")
EndIf
;
SendNetworkString2(Ftp, "QUIT" + #LFCR)
;
ProcedureReturn #FTP_OK
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure FTP_Close(Ftp.l)
If Ftp
; Online with the server
If CloseNetworkConnection(Ftp)
;FTP_Last_Message="Successfully closed the specified ftp connection"
ProcedureReturn #FTP_OK
Else
;FTP_Last_Message="Connection previously closed or unable to close specified ftp connection"
ProcedureReturn #FTP_ERROR
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure Parse226 () ; Decode this message to extract the number of files from it.
NbrOfFiles = 1 ; if the number of files is not found, we'll return 1 anyway
found = 0
If Left(In,3) = "226"
While In
pos = 5
While Val(Mid(In,pos,1)) Or Mid(In,pos,1)="0" Or pos>Len(In)
pos + 1
Wend
If pos > 5
NbrOfFiles = Val(Mid(In,5,pos-5))
FTP_Last_Message = Str(NbrOfFiles)+" files were found"
In = ""
Else
pos = FindString(In,#LFCR,0)
If pos
In = Right(In, Len(In)-pos-Len(#LFCR)+1)
Else
In = ""
EndIf
EndIf
Wend
EndIf
ProcedureReturn NbrOfFiles
EndProcedure
;
Procedure FTP_Help(Ftp.l, ListArg$, Log_Gadget)
If Ftp
; Attempt to create a PASV connection
If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
ProcedureReturn Result
EndIf
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "LIST" + " " + ListArg$)
EndIf
;
SendNetworkString2(Ftp, "HELP " + ListArg$ + #LFCR)
;
Time.l = Date()
Repeat
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
; -- Analyze data --
If Left(In,3) = "125" Or Left(In,3) = "150"; Opened the data connection for the directory list (125 = zFTPServer, 150 = Broker)
In = ""
Result = FTP_DirList(Ftp)
Int_FTP_PASV_CLOSE()
ProcedureReturn Result
;
ElseIf Left(In,3) = "451" Or Left(In,3) = "530"; -- Error Parsing
Int_FTP_PASV_CLOSE()
ProcedureReturn #FTP_ERROR
Else
If (Date()-Time)>#LongTimeOut
Int_FTP_PASV_CLOSE()
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_ERROR
EndIf
EndIf
EndIf
Until In = ""
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure FTP_List(Ftp.l, ListArg$, Log_Gadget)
If Ftp
; Attempt to create a PASV connection
If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
ProcedureReturn Result
EndIf
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "LIST" + " " + ListArg$)
EndIf
;
SendNetworkString2(Ftp, "LIST" + " " + ListArg$ + #LFCR)
;
Time.l = Date()
Repeat
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
; -- Analyze data --
If Left(In,3) = "125" Or Left(In,3) = "150"; Opened the data connection for the directory list (125 = zFTPServer, 150 = Broker)
In = ""
Result = FTP_DirList(Ftp)
Int_FTP_PASV_CLOSE()
ProcedureReturn Result
;
ElseIf Left(In,3) = "451" Or Left(In,3) = "530"; -- Error Parsing
Int_FTP_PASV_CLOSE()
ProcedureReturn #FTP_ERROR
Else
If (Date()-Time)>#LongTimeOut
Int_FTP_PASV_CLOSE()
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_ERROR
EndIf
EndIf
EndIf
Until In = ""
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_Retrieve(Ftp.l,filename.s,Destination.s,ProgBarGadgetID.l, Log_Gadget)
If Ftp
; Online with the server
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "SIZE" + " " + ListArg$)
EndIf
SendNetworkString2(Ftp,"SIZE " + filename + #LFCR) ; get the size of the file to download
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
Else
If Left(In,3)="213"
file_size.l = Val(Right(In, Len(In)-4))
Else
FTP_Last_Message = "File size has not been sent"
ProcedureReturn #FTP_ERROR
EndIf
EndIf
If file_size = 0
FTP_Last_Message = "File size is null!"
ProcedureReturn #FTP_ERROR
EndIf
;
mem = AllocateMemory(Minimum(file_size, #Block_size))
If mem>0
If CreateFile(1,Destination + "\" + filename) = 0
FTP_Last_Message = "Unable to create file"
FreeMemory(mem)
ProcedureReturn #FTP_ERROR
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
If ConnectionID = 0
; Attempt to create a PASV connection
If Int_FTP_PASV(Ftp, Log_Gadget) <> #FTP_OK
CloseFile(1)
FreeMemory(mem)
DeleteFile(Destination + "\" + filename)
ProcedureReturn #FTP_ERROR
EndIf
EndIf
starttime.l = Date()
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "RETR " + filename)
EndIf
;
SendNetworkString2(Ftp,"RETR " + filename + #LFCR)
;
Time.l = Date()
Repeat
In = Wait(Ftp, #LongTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
CloseFile(1)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
If Left(In,3) = "125" Or Left(In,3) = "150" Or Left(In,3) = "226"
Result = FTP_GetFile(ProgBarGadgetID,mem,file_size)
CloseFile(1)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
If Result <> #FTP_OK
ProcedureReturn #FTP_ERROR
EndIf
If Left(In,3) <> "226" ; now, some server will send the #226 message and some will not
In = Wait(Ftp, 1000) ; we put a small timeout to avoid to loose to much time
If Left(In,3) = "226"
now.l = Date()
speed.f = 0
If (now - starttime) > 0
speed = (TotalBytesRecd / 1024) / (now - starttime)
Else
speed = TotalBytesRecd / 1024
EndIf
FTP_Last_Message + " -- " + Str(TotalBytesRecd) + " bytes (" + StrF(speed,2) + " Kb/sec)"
EndIf
EndIf
ProcedureReturn #FTP_OK
; -- Error Parsing
ElseIf Left(In,3) = "425" Or Left(In,3) = "426" Or Left(In,3) = "501" Or Left(In,3) = "550" ; Unable to open the connection
; "426" means : "Data connection closed abnormally"
CloseFile(1)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
FTP_Last_Message = "Data connection closed abnormally"
ProcedureReturn #FTP_ERROR
Else
Delay(10)
If (Date()-Time)>#LongTimeOut
CloseFile(0)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_ERROR
EndIf
EndIf
EndIf
Until In = ""
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_CurrentDir(Ftp.l, Log_Gadget)
If Ftp
; Online with server
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "PWD")
EndIf
;
SendNetworkString2(Ftp, "PWD" + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
Select Left(In,3)
; -- OK Parsing
Case "257"
ProcedureReturn #FTP_OK
; -- Error Parsing
Case "530"
ProcedureReturn #FTP_ERROR
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_ChangeDir(Ftp.l, Dirname.s, Log_Gadget)
If Ftp
; Online with the server
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "CWD " + Dirname)
EndIf
;
SendNetworkString2(Ftp, "CWD " + Dirname + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
Select Left(In,3)
Case "250" ; -- OK Parsing
ProcedureReturn #FTP_OK
Case "550" ; -- Error Parsing
ProcedureReturn #FTP_ERROR
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_Store(Ftp.l, filename.s, ProgBarGadgetID.l, Log_Gadget)
ConnectionID = 0
If Ftp
; Online with the server
file_size.l = FileSize(filename)
;
If OpenFile(0,filename) = 0
FTP_Last_Message = "Unable to open file"
ProcedureReturn #FTP_ERROR
EndIf
;
mem = AllocateMemory(Minimum(file_size, #Block_size))
If mem<1
FTP_Last_Message = "Unable to allocate memory"
CloseFile(0)
ProcedureReturn #FTP_ERROR
EndIf
If ConnectionID = 0
; Attempt to create PASV connection
If Int_FTP_PASV(Ftp, Log_Gadget) = 0
CloseFile(0)
FreeMemory(mem)
ProcedureReturn #FTP_ERROR
EndIf
EndIf
starttime.l = Date()
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "STOR " + GetFilePart(filename))
EndIf
;
SendNetworkString2(FTP, "STOR " + GetFilePart(filename) + #LFCR)
;
Time.l = Date()
Repeat
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
CloseFile(0)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
If Left(In,3) = "125" Or Left(In,3) = "150" Or Left(In,3) = "226"
Result = FTP_PutFile(ProgBarGadgetID,mem,file_size)
CloseFile(0)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
If Result <> #FTP_OK
ProcedureReturn #FTP_ERROR
EndIf
If Left(In,3) <> "226"
In = Wait(Ftp, #SmallTimeOut)
If Left(In,3) = "226"
now.l = Date()
speed.f = 0
If (now - starttime) > 0
speed = (TotalBytesSent / 1024) / (now - starttime)
Else
speed = TotalBytesSent / 1024
EndIf
FTP_Last_Message + " -- " + Str(TotalBytesSent) + " bytes (" + StrF(speed,2) + " Kb/sec)"
EndIf
EndIf
ProcedureReturn #FTP_OK
; -- Error Parsing
ElseIf Left(In,3) = "501" Or Left(In,3) = "550"
CloseFile(0)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
ProcedureReturn #FTP_ERROR
Else
Delay(10)
If (Date()-Time)>#LongTimeOut
CloseFile(0)
FreeMemory(mem)
Int_FTP_PASV_CLOSE()
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_ERROR
EndIf
EndIf
EndIf
Until In = ""
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_MakeDir(Ftp.l, Dirname.s, Log_Gadget)
If Ftp
; Online with the server
If Dirname = ""
ProcedureReturn #FTP_ERROR
EndIf
;
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "MKD " + Dirname)
EndIf
;
SendNetworkString2(Ftp, "MKD " + Dirname + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
Select Left(In,3)
Case "257" ; -- OK Parsing
In.s = ""
ProcedureReturn #FTP_OK
Case "500" ; Access denied, already exists
In.s = ""
ProcedureReturn #FTP_OK
Case "550"
In.s = ""
ProcedureReturn #FTP_OK
; -- Error Parsing
Case "530"
ProcedureReturn #FTP_ERROR
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
;
Procedure FTP_RemoveDir(Ftp.l, Dirname.s, Log_Gadget)
If Ftp
; Online with the server
If Dirname = ""
ProcedureReturn #FTP_ERROR
EndIf
;
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "RMD " + Dirname)
EndIf
;
SendNetworkString2(Ftp, "RMD " + Dirname + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
; -- Analyze data --
Select Mid(In,1,3)
Case "250" ; -- OK Parsing
ProcedureReturn #FTP_OK
Case "500" ; Access denied, directory not empty
ProcedureReturn #FTP_OK
; -- Error Parsing
Case "550"
ProcedureReturn #FTP_ERROR
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_Delete(Ftp.l, filename.s, Log_Gadget)
If Ftp
; Online with the server
If filename = ""
ProcedureReturn #FTP_ERROR
EndIf
;
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "DELE " + filename)
EndIf
;
SendNetworkString2(Ftp, "DELE " + filename + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
;{ -- Analyze data --
Select Left(In,3)
Case "250" ; -- OK Parsing
; Note: Server responds 250 if the file deleted successful or doesn't exist
ProcedureReturn #FTP_OK
; -- Error Parsing
Case "550"
; Note: zFTPServer responds 500 if the file doesn't exist, still OK
ProcedureReturn #FTP_OK
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure
Procedure FTP_Rename(Ftp.l, filename.s, newname.s, Log_Gadget)
If Ftp
; Online with the server
If filename = ""
ProcedureReturn #FTP_ERROR
EndIf
If Log_Gadget
AddGadgetItem(Log_Gadget,-1,FormatDate("%hh:%ii:%ss", Date()) + Chr(10) + "<----" + Chr(10) + "Rename " + filename + "to " + newname)
EndIf
;
SendNetworkString2(Ftp, "RNFR " + filename + #LFCR)
;
In = Wait(Ftp, #SmallTimeOut)
If In = "TimeOut"
FTP_Last_Message = "Timed out"
ProcedureReturn #FTP_TimeOut
ElseIf In
FTP_Last_Message = In
;{ -- Analyze data --
Select Left(In,3)
; -- OK Parsing
Case "350"
; Server responds 350 if the file to be renamed exists
; and requests the new pathname
SendNetworkString2(Ftp, "RNTO " + newname + #LFCR)
Case "250"
; Server responds 250 if the file is successfully renamed
ProcedureReturn #FTP_OK
; -- Error Parsing
Case "500" ; Access denied, file already exist
ProcedureReturn #FTP_ERROR
Case "550"
ProcedureReturn #FTP_ERROR
EndSelect
EndIf
Else
ProcedureReturn #FTP_ERROR
EndIf
EndProcedure-
wolfjeremy
- Messages : 1202
- Inscription : sam. 31/déc./2005 23:52
woaw c'est long lol