I have convert the Atomic FTP Server code for runnig under PB 3.8 and 3.9 and add a messagebox.
now im need help for any funktions
my main problem are is :
RETR : Command_RETR() this is for sending files or data to a ftpclient
and
STOR : Command_STOR() this is for receiving files and data
have someone experience to help me ?
Best regards,
Peter
Code: Select all
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0) : End
EndIf
#INTERNET_SERVICE_FTP=1
#INTERNET_OPEN_TYPE_DIRECT=1
#FTP_TRANSFER_ASCII=1
#FTP_TRANSFER_BINARY=2
#MMTB = 100
#GENERIC_READ = $80000000
#GENERIC_WRITE = $40000000
Global CurrentDirectory.s, ClientIP.s, ClientAnswer.s, EOL.s, Command.s, Argument.s, Commandcomplete.s
Global SendFile.s
Global ClientID.l, ClientPort.l, Port.l, *Buffer.l, WEvent.l, SEvent.l, Quit.l, RequestLength.l, Position.l, Socket.l
Global directory.l, NumberFiles.l, DirContinue.l, NewPosition.l, MMTextBox.l
EOL = Chr(13)+Chr(10)
*Buffer = GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, 10000)
Port = 22
GetPathPart(ExePath$)
ExePath$ = Space(1024)
GetModuleFileName_(0,@ExePath$,1024)
CurrentDirectory = GetPathPart(ExePath$)
ProgramPathforIDE.s = Space(1024) ; remove
GetCurrentDirectory_(1024, @ProgramPathforIDE) ; remove
CurrentDirectory = ProgramPathforIDE ; remove
Procedure.l FTPUpload(hConnect.l,Source.s,Dest.s)
ProcedureReturn FTPPutFile_(hConnect,Source,Dest,0,0)
EndProcedure
Procedure Message (M.s)
WriteMessage.s
WriteMessage +Chr(13)+Chr(10)+M
SetGadgetText(#MMTB,GetGadgetText(#MMTB) + WriteMessage )
SendMessage_(MMTextBox,$00B6,0,10000)
EndProcedure
Procedure Command_RETR()
Message(Commandcomplete)
SendFile = Mid(Commandcomplete,6,Len(Commandcomplete)-5)
Debug SendFile
If FileSize(SendFile):Debug "OK file is present":EndIf
Debug CurrentDirectory
Message("SendFile = " + CurrentDirectory + "\" + SendFile )
ConID = OpenNetworkConnection(ClientIP, ClientPort)
Debug "ConID in RETR = " + Str(ConID)
Message("ConID = " + Str(ConID) + " for Client/Port : " + ClientIP + ":" + Str(ClientPort))
;FTPPutFile_(ConID,CurrentDirectory + "\" + SendFile,SendFile,#FTP_TRANSFER_BINARY,0)
;FtpOpenFile_(ConID,CurrentDirectory + "\" + SendFile,#GENERIC_READ,#FTP_TRANSFER_BINARY,0)
SendNetworkFile(ConID, CurrentDirectory + "\" + SendFile)
CloseNetworkConnection(ConID)
EndProcedure
Procedure Command_STOR()
Message("500 - sorry this Command : " + Commandcomplete +" is not available")
ClientAnswer = "500 - sorry this Command : " + Commandcomplete +" is not available" +EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_HELP()
Message("214 - HELP")
ClientAnswer = "214 - You wanna some help ? :-D"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_PWD()
Message("257 - PWD")
ClientAnswer = "257 /"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_UNKNOWN()
Message("500 - UNKNOWN : " + Commandcomplete)
ClientAnswer = "500 - Unknow command : "+ Commandcomplete +EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_USER()
Message("331 - USER")
If Argument = "anonymous"
ClientAnswer = "331 - User anonymous accepted. Please enter your e-mail"+EOL
Else
ClientAnswer = "331 - Hello "+Argument+". Please enter your password"+EOL
EndIf
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_SYST()
Message("215 - SYST")
ClientAnswer = "215 - Atomic FTP Server v0.1"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_PORT()
Message("200 - Get PORT")
ClientAnswer = "200 - Ok"+EOL
; Build a real IP
;
Position = FindString(Argument, ",", 1)
ClientIP = 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 = RTrim(LTrim(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))
Message("ClientIP/Port = " + ClientIP +" : " + Str(ClientPort))
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_PASS()
Message("Send Welcome to Client")
ClientAnswer = "230 - Welcome, enjoy this FTP site"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
EndProcedure
Procedure Command_LIST()
ClientAnswer = "150 - Opening connection"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
ConID = OpenNetworkConnection(ClientIP, ClientPort)
Message("ConID = " + Str(ConID) + " for Client/Port : " + ClientIP + ":" + Str(ClientPort))
Message("Send CurrentDirectory to Client")
If ConID
SetCurrentDirectory_(CurrentDirectory)
directory = FindFirstFile_("*.*", @Test.WIN32_FIND_DATA)
Debug "Directory = " + Str(directory)
DirContinue = directory
ClientAnswer = ""
NumberFiles = 0
While DirContinue
If Test\dwFileAttributes & #FILE_ATTRIBUTE_DIRECTORY
ClientAnswer = ClientAnswer+"drwxr-xr-x 6 12545 512 Jan 23 10:18 "+PeekS(@Test\cFileName[0])+EOL
Else
ClientAnswer = ClientAnswer+"rwxr-xr-x 6 12545 512 Jan 23 10:18 "+PeekS(@Test\cFileName[0])+EOL
EndIf
DirContinue = FindNextFile_(directory, @Test)
NumberFiles+1
Wend
ClientAnswer = "total "+Str(NumberFiles)+EOL+ClientAnswer
SendNetworkData(ConID, @ClientAnswer, Len(ClientAnswer))
CloseNetworkConnection(ConID)
EndIf
ClientAnswer = "226 - Listing finished"+EOL
Message("Listing finished")
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
ClientPort = 0
ClientIP=""
EndProcedure
Procedure Command_QUIT()
Message("Client has Disconnect")
Debug "in Command_QUIT()"
CloseNetworkServer()
Socket = CreateNetworkServer(Port)
Debug "Socket = " + Str(Socket)
ClientPort = 0
ClientIP=""
EndProcedure
Procedure ProcessRequest()
Command = PeekS(*Buffer)
Commandcomplete = Command
Debug "Command = " + Command
Position = FindString(Command, " ", 1)
If Position
Argument = Mid(Command, Position+1, Len(Command)-Position)
Command = UCase(LTrim(Left(Command, Position-1)))
EndIf
Select Command
Case "STOR":Command_STOR()
Case "QUIT":Command_QUIT()
Case "HELP":Command_HELP()
Case "LIST":Command_LIST()
Case "PASS":Command_PASS()
Case "PORT":Command_PORT()
Case "PWD":Command_PWD()
Case "SYST":Command_SYST()
Case "USER":Command_USER()
Case "RETR":Command_RETR()
Default:Command_UNKNOWN()
EndSelect
EndProcedure
Procedure Main()
If Socket
OpenWindow(0, 300, 300, 360, 220, #PB_Window_SystemMenu, "Atomic FTP Server (Port "+Str(Port)+")")
If CreateGadgetList(WindowID())
MMTextBox=StringGadget(#MMTB, 0, 2, WindowWidth()-1,WindowHeight()-4 ,"Purebasic Atomic FTP Server" ,#PB_String_MultiLine|#ES_AUTOVSCROLL|#WS_VSCROLL|#PB_String_ReadOnly)
EndIf
Repeat
WEvent = WindowEvent()
SEvent = NetworkServerEvent()
If WEvent = #PB_EventCloseWindow
Quit = 1
EndIf
If SEvent
ClientID.l = NetworkClientID()
Select SEvent
Case 1 ; New client connected
Message("New client connected" + EOL)
ClientAnswer = "220 - Atomic FTP Server v0.1 ready"+EOL
SendNetworkData(ClientID, @ClientAnswer, Len(ClientAnswer))
Case 4 ; New client has closed the connection
Debug "in Case 4"
Default
RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
If RequestLength > 3
PokeL(*Buffer+RequestLength-2, 0)
EndIf
ProcessRequest()
EndSelect
Else
Sleep_(20)
EndIf
Until Quit = 1
CloseNetworkServer()
Else
MessageRequester("Error", "Can't create the server (port in use ?).", 0)
EndIf
End
EndProcedure
Socket = CreateNetworkServer(Port)
Main()