PureBoard

Code: Alles auswählen

; by DarkDragon


InitNetwork()

#TIMEOUT = 1500

Procedure.s ReceiveLine(ConnectionID)
  Text.s = ""
  While Char.b <> #LF
    Char = 0
    ReceiveNetworkData(ConnectionID, @Char, 1)
    If Char <> 0
      Text.s + Chr(Char)
    EndIf
  Wend
 
  ProcedureReturn RemoveString(RemoveString(Text, #CR$), #LF$)
EndProcedure

Procedure HTTPRequest(URL.s, *EndSize.Long, PacketSize, *Callback)
  Protected Size.l, Data_.s, s.l, Method.s, File.s, content.s, Text.s, length.l, Line.s
  Protected CurSize.l, oSize.l, t.l, ConnectionID.l
 
  If Left(URL, 7) = "http://" : URL = Right(URL, Len(URL)-7) : EndIf
  s = FindString(URL, "/", 1)
  Host.s = "" : File.s = ""
  If s <> 0 : Host.s = Left(URL, s-1) : File.s = Right(URL, Len(URL)-s) : Else : Host = URL : EndIf
 
  s = FindString(File, "?", 1)
  If s <> 0
    Method.s = "POST"
    File = Left(File, s)
    content.s = Right(File, Len(File)-(s+1))
  Else
    Method.s = "GET"
    content.s = ""
  EndIf
 
 
  ConnectionID = OpenNetworkConnection(Host, 80)
  If ConnectionID
    Data_.s = Method+" /"+File+" HTTP/1.0"+#CRLF$
    Data_.s + "Host: "+Host+#CRLF$
    Data_.s + "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.12) Gecko/20050915 Firefox/1.0.7"+#CRLF$
    If content <> ""
      Data_.s + "Connection: close"+#CRLF$
      Data_.s + "Content-Type: text/html"+#CRLF$
      Data_.s + "Content: "+content.s+#CRLF$+#CRLF$
    Else
      Data_.s + "Connection: close"+#CRLF$+#CRLF$
    EndIf
   
    SendNetworkString(ConnectionID, Data_)
    While NetworkClientEvent(ConnectionID) <> 2 : Delay(10) : Wend
   
    length = 0
    Line.s = ""
    Repeat
      Line = ReceiveLine(ConnectionID)
      Select LCase(StringField(Line, 1, ":"))
        Case "content-length"
         
          length = Val(Trim(StringField(Line, 2, ":")))
      EndSelect
    Until Len(Trim(Line)) <= 4
   
    Size = 0
    If length <> 0
     
      *Result = AllocateMemory(length)
     
      While Size < length
        If CurSize > 0
          Size + CurSize
          If *Callback
            CallFunctionFast(*Callback, Size, length)
          EndIf
        EndIf
        If Size > (length-PacketSize)
          PacketSize = length-Size
        EndIf
        If PacketSize > 0
          CurSize = ReceiveNetworkData(ConnectionID, *Result+Size, PacketSize)
        EndIf
      Wend
     
    Else
     
      *Buffer = AllocateMemory(PacketSize)
      *Result = AllocateMemory(1)
      t = ElapsedMilliseconds()
      While ElapsedMilliseconds()-t <= #TIMEOUT
        If NetworkClientEvent(ConnectionID) = 2
          CurSize = ReceiveNetworkData(ConnectionID, *Buffer, PacketSize)
          If CurSize > 0
            oSize = Size
            Size + CurSize
            *Result = ReAllocateMemory(*Result, Size)
            CopyMemory(*Buffer, *Result+oSize, CurSize)
            If *Callback
              CallFunctionFast(*Callback, Size, 0)
            EndIf
          EndIf
          t = ElapsedMilliseconds()
        EndIf
      Wend
      length = Size
     
    EndIf
   
    *EndSize\l = length
    If *Callback
      CallFunctionFast(*Callback, Size, length)
    EndIf
   
    CloseNetworkConnection(ConnectionID)
   
    ProcedureReturn *Result
  EndIf
EndProcedure

Procedure HTTPRequest_Password(URL.s, *EndSize.Long, PacketSize, Username.s, Password.s, *Callback)
  Protected Size.l, Data_.s, s.l, Method.s, File.s, content.s, Text.s, length.l, Line.s
  Protected CurSize.l, oSize.l, t.l, ConnectionID.l
 
  If Left(URL, 7) = "http://" : URL = Right(URL, Len(URL)-7) : EndIf
  s = FindString(URL, "/", 1)
  Host.s = "" : File.s = ""
  If s <> 0 : Host.s = Left(URL, s-1) : File.s = Right(URL, Len(URL)-s) : Else : Host = URL : EndIf
 
  s = FindString(File, "?", 1)
  If s <> 0
    Method.s = "POST"
    File = Left(File, s)
    content.s = Right(File, Len(File)-(s+1))
  Else
    Method.s = "GET"
    content.s = ""
  EndIf
 
  InputBuffer.s = Username+":"+Password
  OutputBuffer.s = Space(256)
  Base64Encoder(@InputBuffer, Len(InputBuffer), @OutputBuffer, 255)
 
  ConnectionID = OpenNetworkConnection(Host, 80)
  If ConnectionID
    Data_.s = Method+" /"+File+" HTTP/1.0" + #CRLF$
    Data_.s + "Host: "+Host + #CRLF$
    Data_.s + "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.12) Gecko/20050915 Firefox/1.0.7" + #CRLF$
    Data_.s + "Authorization: Basic "+ OutputBuffer + #CRLF$
    If content <> ""
      Data_.s + "Connection: close" + #CRLF$
      Data_.s + "Content-Type: text/html" + #CRLF$
      Data_.s + "Content: "+content.s +#CRLF$ + #CRLF$
    Else
      Data_.s + "Connection: close" + #CRLF$ + #CRLF$
    EndIf
   
    SendNetworkString(ConnectionID, Data_)
    While NetworkClientEvent(ConnectionID) <> 2 : Delay(10) : Wend
   
    length = 0
    Line.s = ""
    Repeat
      Line = ReceiveLine(ConnectionID)
      Select LCase(StringField(Line, 1, ":"))
        Case "content-length"
         
          length = Val(Trim(StringField(Line, 2, ":")))
      EndSelect
    Until Len(Trim(Line)) <= 4
   
    Size = 0
    If length <> 0
     
      *Result = AllocateMemory(length)
     
      While Size < length
        If CurSize > 0
          Size + CurSize
          If *Callback
            CallFunctionFast(*Callback, Size, length)
          EndIf
        EndIf
        If Size > (length-PacketSize)
          PacketSize = length-Size
        EndIf
        If PacketSize > 0
          CurSize = ReceiveNetworkData(ConnectionID, *Result+Size, PacketSize)
        EndIf
      Wend
     
    Else
     
      *Buffer = AllocateMemory(PacketSize)
      *Result = AllocateMemory(1)
      t = ElapsedMilliseconds()
      While ElapsedMilliseconds()-t <= #TIMEOUT
        If NetworkClientEvent(ConnectionID) = 2
          CurSize = ReceiveNetworkData(ConnectionID, *Buffer, PacketSize)
          If CurSize > 0
            oSize = Size
            Size + CurSize
            *Result = ReAllocateMemory(*Result, Size)
            CopyMemory(*Buffer, *Result+oSize, CurSize)
            If *Callback
              CallFunctionFast(*Callback, Size, 0)
            EndIf
          EndIf
          t = ElapsedMilliseconds()
        EndIf
      Wend
      length = Size
     
    EndIf
   
    *EndSize\l = length
    If *Callback
      CallFunctionFast(*Callback, Size, length)
    EndIf
   
    CloseNetworkConnection(ConnectionID)
   
    ProcedureReturn *Result
  EndIf
EndProcedure




*Buffer = HTTPRequest("http://www.google.ch/", @Size, 16, 0)

html$ =  PeekS(*Buffer, Size)
FreeMemory(*Buffer)



If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  WebGadget(0, 10, 10, 580, 280, "")
 
  CreateFile(0, GetTemporaryDirectory() + "mypage.html")
  WriteString(0, html$)
  CloseFile(0)
 
  SetGadgetText(0, "file://"+GetTemporaryDirectory() + "mypage.html")
 
  Repeat
   
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf