have anybody a idea for a ftpserver with upload and download features the Atomic FTP Server cant this, im cant understand why is the Atomic FTP Server an example then this programm cant FileTransPort.
Best Regards,
Peter
Code: Select all
;
; ------------------------------------------------------------
;
; Atomic FTP Server in PureBasic by AlphaSND
;
; (c) 2001 - Fantaisie Software
;
; ------------------------------------------------------------
;
; This program isn't finished, the harder is done but I don't
; time to implement the whole RFC 959 commands :-).
;
;
; 19/03/2001
; Listing is now working.
;
; 18/03/2001
; Based on the Atomic Web Server code..
; First version.
;
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0) : End
EndIf
DefType.l
ClientIP.s
Port = 21
BaseDirectory$ = "ftp\"
CurrentDirectory$ = BaseDirectory$
AtomicTitle$ = "Atomic FTP Server v0.1"
Global EOL$, ClientID
EOL$ = Chr(13)+Chr(10)
*Buffer = GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, 10000)
If CreateNetworkServer(Port)
OpenWindow(0, 100, 100, 230, 0, #PB_Window_SystemMenu, "Atomic FTP Server (Port "+Str(Port)+")")
Repeat
WEvent.l = WindowEvent()
SEvent.l = NetworkServerEvent()
If WEvent = #PB_EventCloseWindow
Quit = 1
EndIf
If SEvent
ClientID.l = NetworkClientID()
Select SEvent
Case 1 ; New client connected
a$ = "220 - Atomic FTP Server v0.1 ready"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Case 4 ; New client has closed the connection
Default
RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
If RequestLength > 3
PokeL(*Buffer+RequestLength-2, 0)
EndIf
Gosub ProcessRequest
EndSelect
Else
Sleep_(20)
EndIf
Until Quit = 1
CloseNetworkServer()
Else
MessageRequester("Error", "Can't create the server (port in use ?).", 0)
EndIf
End
ProcessRequest:
Command$ = PeekS(*Buffer)
Position = FindString(Command$, " ", 1)
If Position
Argument$ = Mid(Command$, Position+1, Len(Command$)-Position)
Command$ = UCase(StripTrail(Left(Command$, Position-1)))
EndIf
Select Command$
Case "HELP"
Gosub Command_HELP
Case "LIST"
Gosub Command_LIST
Case "PASS"
Gosub Command_PASS
Case "PORT"
Gosub Command_PORT
Case "PWD"
Gosub Command_PWD
Case "SYST"
Gosub Command_SYST
Case "USER"
Gosub Command_USER
Default
Gosub Command_UNKNOWN
EndSelect
Return
Command_HELP:
a$ = "214 - You wanna some help ? :-D"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_LIST:
a$ = "150 - Opening connection"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
If OpenNetworkConnection(ClientIP, ClientPort)
SetCurrentDirectory_(CurrentDirectory$)
Directory = FindFirstFile_("*.*", @Test.WIN32_FIND_DATA)
Continue = Directory
a$ = ""
NumberFiles = 0
While Continue
If Test\dwFileAttributes & #FILE_ATTRIBUTE_DIRECTORY
a$ = a$+"drwxr-xr-x 6 12545 512 Jan 23 10:18 "+PeekS(@Test\cFileName[0])+EOL$
Else
a$ = a$+"rwxr-xr-x 6 12545 512 Jan 23 10:18 "+PeekS(@Test\cFileName[0])+EOL$
EndIf
Continue = FindNextFile_(Directory, @Test)
NumberFiles+1
Wend
a$ = "total "+Str(NumberFiles)+EOL$+a$
SendNetworkData(0, @a$, len(a$))
CloseNetworkConnection()
EndIf
a$ = "226 - Listing finished"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_PASS:
a$ = "230 - Welcome, enjoy this FTP site"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_PORT:
a$ = "200 - Ok"+EOL$
; Build a real IP
;
Position = FindString(Argument$, ",", 1)
ClientIP.s = ClientIP+Mid(Argument$, 1, Position-1)+"."
NewPosition = FindString(Argument$, ",", Position+1)
ClientIP = ClientIP+Mid(Argument$, Position+1, NewPosition-Position-1)+"."
Position = FindString(Argument$, ",", NewPosition+1)
ClientIP = ClientIP+Mid(Argument$, NewPosition+1, Position-NewPosition-1)+"."
NewPosition = FindString(Argument$, ",", Position+1)
ClientIP = ClientIP+Mid(Argument$, Position+1, NewPosition-Position-1)
ClientIP = StripLead(StripTrail(ClientIP))
; Get the port..
;
Position = FindString(Argument$, ",", NewPosition+1)
ClientPort = Val(Mid(Argument$, NewPosition+1, Position-NewPosition-1)) << 8+Val(Right(Argument$, Len(Argument$)-Position))
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_PWD:
a$ = "257 /"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_UNKNOWN:
a$ = "500 - Unknow command"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_USER:
If Argument$ = "anonymous"
a$ = "331 - User anonymous accepted. Please enter your e-mail"+EOL$
Else
a$ = "331 - Hello "+Argument$+". Please enter your password"+EOL$
EndIf
SendNetworkData(ClientID, @a$, len(a$))
Return
Command_SYST:
a$ = "215 - Atomic FTP Server v0.1"+EOL$
SendNetworkData(ClientID, @a$, len(a$))
Return