PureBoard

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

Gibt es eine sendHTTPFile

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

Seite 1 von 2

Gibt es eine sendHTTPFile

Verfasst: 04.06.2015 21:58
von derschutzhund
Hallöchen,

eine fertige Funktion sendHTTPFile gibt es im Gegensatz zu ReceiveHTTPFile wohl nicht fertig aber kann man soetwas erstellen?

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 04.06.2015 23:16
von NicTheQuick
Wie wäre es damit?
POST Upload klappt nicht?
Ich hab natürlich direkt den Post mit der Lösung verlinkt.

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 00:55
von derschutzhund
Hallo Nic,

vielen Dank erst mal!
Das könnte genau das sein was ich brauche!
Werde es morgen gleich mal austesten!

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 10:10
von derschutzhund
moin,

auf dem Serverpc befindet sich die Datei upload.php (testweise auch als Kopie index.php).

Code: Alles auswählen

<?php
function writeToFile($file, $label, $array, $indent = 1){
   $_newLine = "\r\n";
   if($label != NULL)
      fwrite($file, $label.$_newLine);
      
   $_intendString = "";
   
   for($i = 0; $i < $indent; $i++)
      $_intendString .= "\t";
   
   foreach($array as $k => $sub){
      if(is_array($sub))
      {
         fwrite($file, $_intendString."[".$k."]".$_newLine);
         writeToFile($file, NULL, $sub, ++$indent);
      }else
         fwrite($file, $_intendString."[".$k."] => ".$sub.$_newLine);
   }
}


$f = fopen("log.txt", "w+");

print_r($_POST);
print_r($_FILES);
print_r($_GET);

writeToFile($f, "POST", $_POST);
writeToFile($f, "FILES", $_FILES);
writeToFile($f, "GET", $_GET);

$target_path = basename( $_FILES['datei']['name']);

if(move_uploaded_file($_FILES['datei']['tmp_name'], $target_path)) {
    echo "The file ".  basename( $_FILES['datei']['name']).
    " has been uploaded";
} else{
    echo "There was an error uploading the file, please try again!";
}

fclose($f);

?>
Den PB-code habe ich auf meine Parameter angepasst:

Code: Alles auswählen

If InitNetwork() = 0
   MessageRequester("Error", "Can't initialize the network !", 0)
   End
EndIf


Global EOL$
EOL$ = Chr(13)+Chr(10)

; http://localhost:8080/test.php
server$ = "192.168.178.50"
Port = 8000   ; 80

; Alles was nach dem SERVER kommt
url$ = "/"
filename$ = "upload.php"

uploadFile$ = OpenFileRequester("Bla", "", "*.*|*.*", 0);"C:\\loaderSettings.ini"

; Mal noch was besseres einfallen lassen :-\
; Boundary name
RandomSeed(Date())
GUID.l = Random(Date())

Debug GUID

; Content Size + Header + Boundary
Size.l = 0;

Structure ContentData
  Size.i
  *Memory
EndStructure

Structure PostRequest
  Header.s
  Boundary.s
  List Content.ContentData()
EndStructure

Procedure Post_CreateRequeset(URL.s, Host.s, Port.i, Boundary.s)
  Protected *Request.PostRequest = AllocateMemory(SizeOf(PostRequest))
 
  If *Request
    InitializeStructure(*Request,PostRequest)
    *Request\Boundary = Boundary
    *Request\Header = "POST /"+URL+" HTTP/1.1"+EOL$
    *Request\Header + "Host: "+Host+":"+Str(Port)+EOL$
    *Request\Header + "Accept: */*"+EOL$
    *Request\Header + "Content-Type: multipart/form-data; boundary="+Boundary+EOL$
    ProcedureReturn *Request
   
  EndIf
 
  ProcedureReturn #False
EndProcedure

Procedure Post_AddFileContent(*Request.PostRequest, ParameterName.s, FileName.s, *Memory, Length.i, Last.i=#False)
  If *Request
   
    Protected ContentHeader.s = "--" + *Request\Boundary + EOL$
   
    ContentHeader + "Content-Disposition: form-Data; name="+Chr(34)+ParameterName+Chr(34)+"; filename="+Chr(34)+FileName+Chr(34) + EOL$
    ContentHeader + "Content-Type: application/octet-stream"+EOL$+EOL$
   
    Protected ContentEnd.s = ""
   
    ContentEnd = EOL$ + "--" + *Request\Boundary
    If Last
      ContentEnd + "--"
    EndIf
    ContentEnd + EOL$
   
    AddElement(*Request\Content())
   
    *Request\Content()\Size = Len(ContentHeader) + Length + Len(ContentEnd)
    *Request\Content()\Memory = AllocateMemory(*Request\Content()\Size+1) ;0 Character which we do not need..
   
    If *Request\Content()\Memory
   
      PokeS(*Request\Content()\Memory,ContentHeader, Len(ContentHeader),#PB_Ascii)
      CopyMemory(*Memory, *Request\Content()\Memory + Len(ContentHeader), Length)
      PokeS(*Request\Content()\Memory + Len(ContentHeader) + Length, ContentEnd, Len(ContentEnd),#PB_Ascii)
     
      ProcedureReturn #True
     
    EndIf
   
    DeleteElement(*Request\Content())
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure Post_SendRequest(*Request.PostRequest, ConnectionID)
  If *Request
 
    Protected ContentLength.i = 0
   
    ForEach *Request\Content()
      ContentLength + *Request\Content()\Size
    Next
   
    *Request\Header + "Content-Length: "+Str(ContentLength)+EOL$+EOL$
   
    SendNetworkString(ConnectionID, *Request\Header)
   
    ForEach *Request\Content()
      SendNetworkData(ConnectionID, *Request\Content()\Memory,*Request\Content()\Size)
    Next
   
    SendNetworkString(ConnectionID,EOL$)
    ProcedureReturn #True
 
  EndIf

EndProcedure


Procedure Post_Free(*Request.PostRequest)
  If *Request
   
    ForEach *Request\Content()
      FreeMemory(*Request\Content()\Memory)
      DeleteElement(*Request\Content())
    Next   
   
    ClearStructure(*Request, PostRequest)
    FreeMemory(*Request)
 
  EndIf

EndProcedure


*buff = AllocateMemory(FileSize(uploadFile$))
If ReadFile(1, uploadFile$)
   Debug "File Loaded"
   ReadData(1,*buff, MemorySize(*buff))
   CloseFile(1)
EndIf


ConnectionID = OpenNetworkConnection(server$, Port)

If ConnectionID

  Test = Post_CreateRequeset(filename$,server$, Port, "-------------------------------"+Str(GUID))
 
  If Test
 
    If Post_AddFileContent(Test, "datei","test.png",*buff, MemorySize(*buff),#True)
      Post_SendRequest(Test, ConnectionID)
      Debug "File has been sent!"
    EndIf
   
    Post_Free(Test)
  EndIf
 
 
   CloseNetworkConnection(ConnectionID)
Else
   MessageRequester("PureBasic - Client", "Can't find the server (Is it launched ?).", 0)
EndIf

End
Die Verbindung besteht und von Hand kann ich etwas hochladen aber leider nicht mit dem PB-Code!
Es wird zwar angezeigt, dass "File has been sent!" aber es is dann nix da auf dem ServerPC in dem Startverzeichnis.

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 16:58
von derschutzhund
Irgendwie haut das alles nicht so hin!
Habe jetzt mal versucht eine Verbindung per ftp aufzubauen.
Dazu den Atomic FTP Server auf einem PC (Linux) gestartet und auf einem anderen LAN-PC zunächst mit dem Beispiel code

Code: Alles auswählen

InitNetwork()

If OpenFTP(0, "192.168.178.50", "test", "test", 21)

  Result = SendFTPFile(0, OpenFileRequester("Choose a file to send", "", "*.*", 0), "purebasic_sent.file", 1)
  
  Repeat
    Debug FTPProgress(0)
    Delay(300)
  Until FTPProgress(0) = -3 Or FTPProgress(0) = -2

  Debug "finished"
  
Else
  MessageRequester("Error", "Can't connect to the FTP server")
EndIf
versucht. Dann auch mal mit einem fertigen FTP-Clientprog.
Auf beiden PC sind die Firewalls abgeschaltet.

Ich kann keine Verbindung herstellen.
Was mir in dem Zusammenhang nicht klar ist, wo im code von Atomic der zulässige username und passwort eingetragen wird / ist?

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 17:12
von Andreas21
Was mir in dem Zusammenhang nicht klar ist, wo im code von Atomic der zulässige username und passwort eingetragen wird / ist?
Atomic FTP Server.pb
Ohne den Code nun getestet zu haben denke ich mal das hier das PW
Zeile 116

Code: Alles auswählen

.....
    Case "PWD"
      Gosub Command_PWD
.....
Zeile 203

Code: Alles auswählen

....
Command_PWD:
  SendNetworkString(ClientID, "257 /"+EOL$)
Return
......
Und hier der Username empfangen wird
Zeile 122

Code: Alles auswählen

.....
    Case "USER"
      Gosub Command_USER
......
Zeile 213

Code: Alles auswählen

.......
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

  SendNetworkString(ClientID, a$)
Return
........

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 17:23
von derschutzhund
Hallo Andreas,

mit welchem User , Passwort läuft denn die Anmeldung in diesem Fall?
Als ich mit dem fertigen FTP-client getestet habe kommt, wenn ich als user "test" angebe, die Abfrage nach dem Passwort.
Habe es dann mit "test", "", "anonymous" getestet, leider ohne Erfolg! Es wird keine Verbindung erstellt.
Ich würde denken, dass im Atomic irgendwo ein Username und ein Passwort gesetzt werden müsste?

EDIT: Inzwischen tut sich was. Mit dem externen FTP-Programm bekomme ich folgende Anzeige beim Start:
Verbindung mit 192.168.178.50 erfolgreich:21
220 - Atomic FTP Server v0.1 ready
USER test
500 - Unknow command
Beende Verbindung mit Gegenstelle 192.168.178.50


Wenn ich bei user nichts eingebe "" dann kommt als Rückmeldung bei USER anonymous (was ja richtig ist), bricht aber dann auch ab.
Verbindung mit 192.168.178.50 erfolgreich:21
220 - Atomic FTP Server v0.1 ready
USER anonymous
500 - Unknow command
Beende Verbindung mit Gegenstelle 192.168.178.50

[/quote]

Mit dem Beispielcode:

Code: Alles auswählen

InitNetwork()

If OpenFTP(0, "192.168.178.50", "", "", 21)

  Result = SendFTPFile(0, OpenFileRequester("Choose a file to send", "", "*.*", 0), "purebasic_sent.file", 1)
  
  Repeat
    Debug FTPProgress(0)
    Delay(300)
  Until FTPProgress(0) = -3 Or FTPProgress(0) = -2

  Debug "finished"
  
Else
  MessageRequester("Error", "Can't connect to the FTP server")
EndIf
Kann keine Verbindung hergestellt werden.

Das muss doch gehen!!!

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 20:11
von derschutzhund
Bin jetzt mal zu Windows gewechselt (server und client)
Im Grunde gleiches Problem.
Was mir aber aufgefallen ist:

Code: Alles auswählen

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

Port = 21

ConnectionID = OpenNetworkConnection("192.168.178.50", Port)
If ConnectionID
  MessageRequester("PureBasic - Client", "Client connected to server...", 0)
  
  SendNetworkString(ConnectionID, "An hello from a client !!! :-)")
    
  MessageRequester("PureBasic - Client", "A string has been sent to the server, please check it before quit...", 0)
  
  CloseNetworkConnection(ConnectionID)
Else
  MessageRequester("PureBasic - Client", "Can't find the server (Is it launched ?).", 0)
EndIf
  
End
Baut eine Verbindung zum Server auf und sendet auch den String.
Auf dem Server wird allerdings dieser String nicht lesbar angezeigt sondern in unlesbaren Zeichen!
Das ist sowohl unter Linux als auch unter Windows gleich.
Die Frage ist auch noch warum mit OpenFTP keine stabile Verbindung aufgebaut werden kann???

Irgendwie mach ich da noch was falsch!

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 05.06.2015 21:26
von derschutzhund
Es geht voran!
Ich kann nun einen Text vom Client auf den Server übertragen wo er sogar gelesen werden kann! :)
Server:

Code: Alles auswählen

#Version = "0.3"

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0) : End
EndIf

ClientIP.s
Port = 21
BaseDirectory$    = "ftp/"
CurrentDirectory$ = BaseDirectory$
AtomicTitle$      = "Atomic FTP Server v"+#Version

EOL$ = Chr(13)+Chr(10)

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)

  OpenWindow(0, 300, 300, 230, 30, "Atomic FTP Server (Port "+Str(Port)+")")

  TextGadget(1, 10, 8, 200, 20, "Atomic FTP Server Ready.")
  
  Repeat
    
    WEvent = WindowEvent()
    SEvent = NetworkServerEvent()
  
    If WEvent = #PB_Event_CloseWindow
      Quit = 1
    EndIf

    If SEvent
      ClientID = EventClient()
  
      Select SEvent
      
        Case 1  ; New client connected
          SetGadgetText(1, "New client connected !")
          SendNetworkString(ClientID, "220 - Atomic FTP Server v0.1 ready"+EOL$)

        Case 4  ; New client has closed the connection
  
        Default
          RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
           
          If RequestLength > 3
            PokeL(*Buffer+RequestLength-2, 0)
          EndIf
          Gosub ProcessRequest
          
      EndSelect
    Else
      Delay(20)
    EndIf
    
  Until Quit = 1 
  
  CloseNetworkServer(0)
Else
  MessageRequester("Error", "Can't create the server (port in use ?).", 0)
EndIf

End 


ProcessRequest:

  Command$ = PeekS(*Buffer,#PB_Unicode)
  Debug Command$
   
  Position = FindString(Command$, " ", 1)
  If Position
   Argument$ = Mid(Command$, Position+1, Len(Command$)-Position)
    Command$ = UCase(RTrim(Left(Command$, Position-1)))
  EndIf

  SetGadgetText(1, "Last command: "+Command$)

  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:
  SendNetworkString(ClientID, "214 - You wanna some help ? :-D"+EOL$)
Return


Command_LIST:
  SendNetworkString(ClientID, "150 - Opening connection"+EOL$)
  
  FTPConnection = OpenNetworkConnection(ClientIP, ClientPort)
  If FTPConnection
    
    a$ = ""
    If ExamineDirectory(0, CurrentDirectory$, "*.*")
    
      NumberFiles = -1
      While NextDirectoryEntry(0)
        
        If DirectoryEntryType(0) = 2
          a$ = a$+"drwxr-xr-x 6 1024 512 Jan 23 10:18 "+DirectoryEntryName(0)+EOL$
        ElseIf Type = 1
          a$ = a$+"rwxr-xr-x 6 512 "+Str(DirectoryEntrySize(0))+" Jan 23 10:18 "+DirectoryEntryName(0)+EOL$
        EndIf
        
        NumberFiles+1
      Wend
    EndIf
    
    SendNetworkString(FTPConnection, "total "+Str(NumberFiles)+EOL$+a$)
    CloseNetworkConnection(FTPConnection)
  EndIf
  
  SendNetworkString(ClientID, "226 - Listing finished"+EOL$)
Return


Command_PASS:
  SendNetworkString(ClientID, "230 - Welcome, enjoy this FTP site"+EOL$)
Return


Command_PORT:

  ; Build a real IP
  ;
  ClientIP = ""
  
  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 = Trim(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))

  SendNetworkString(ClientID, "200 - Ok"+EOL$)
Return


Command_PWD:
  SendNetworkString(ClientID, "257 /"+EOL$)
Return


Command_UNKNOWN:
  SendNetworkString(ClientID, "500 - Unknow command"+EOL$)
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

  SendNetworkString(ClientID, a$)
Return

Command_SYST:
  SendNetworkString(ClientID, "215 - Atomic FTP Server v"+#Version+EOL$)
Return
und der Test-client

Code: Alles auswählen

EnableExplicit

;
; ------------------------------------------------------------
;
;   PureBasic - Network (Client) example file
;
;    (c) 2003 - Fantaisie Software
;
; ------------------------------------------------------------
;

Define Port.i, ConnectionID.i, EOL$

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

Port = 21

EOL$ = Chr(13)+Chr(10)


ConnectionID = OpenNetworkConnection("192.168.178.50", Port)
If ConnectionID
  MessageRequester("PureBasic - Client", "Client connected to server...", 0)
  
;  SendNetworkString(ConnectionID, "An hello from a client !!! :-)"+EOL$,#PB_Unicode)
  SendNetworkString(ConnectionID, "HELP Anna"+EOL$,#PB_Unicode)
    
  MessageRequester("PureBasic - Client", "A string has been sent to the server, please check it before quit...", 0)
  
  CloseNetworkConnection(ConnectionID)
Else
  MessageRequester("PureBasic - Client", "Can't find the server (Is it launched ?).", 0)
EndIf
  
End
Inzwischen bin ich durch den Servercode soweit durchgestiegen, dass ich beliebige Befehle einbauen könnte.
Die Frage ist jetzt aber wie ich Dateien übertragen kann??

Vermutlich geht da was mit "SendNetworkData"? Aber wie?
Und mit dieser Funktion ist doch dann auch die Dateigröße auf 2000 bzw. 65536 Byte begrenzt?
Also, wie kann ich da jetzt Dateien hin und her schieben???

LG

Wolfgang

Re: Gibt es eine sendHTTPFile

Verfasst: 06.06.2015 01:26
von Bisonte
Nur kurz : Die verwirrenden Zeichen, die bei Anmeldung bei einem FTP Server erscheinen ....

Das liegt daran, das FTP Kommandos in ASCII sein müssen. Du wirst dein Programm höchstwahrscheinlich in Unicode kompiliert haben...
Es geht zwar auch, allerdings muss man dann selbst einen ASCII String senden (per SendNetworkData() und nicht per SendNetWorkString())

Wenn Du natürlich beide Programme (also Server UND Client) selbst mit PB erstellst, muss man dann selbst darauf achten, das beide Seiten das
gleiche "Protokoll" benutzen. Nützt nix, wenn der Server nur koreanisch spricht und der Client nur russisch (so mal als krasses Beispiel) ;)
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de