PureBasic Forums - English

Code: Select all

If Not InitNetwork()
  MessageRequester("Error","No TCP/IP stack available!")
EndIf

Procedure.s DownloadToMemory(URL.s)
  Protected ServerID.l, Header.s, *Buffer = AllocateMemory(1000), String.s, Server.s, Path.s, i.l, DataLength.l
  
  URL = RemoveString(URL,"http://",1)
  i = FindString(URL,"/",1)
  If i
    Server = Left(URL,i-1)
    Path = Right(URL,Len(URL)-i)
  Else
    Server = URL
  EndIf
  
  ServerID = OpenNetworkConnection(Server,80)
  If ServerID
    ;Header for the GET request
    Header = "GET /"+Path+" HTTP/1.1"+#CRLF$
    Header + "Host: "+Server+#CRLF$+#CRLF$
    SendNetworkData(ServerID,@Header,Len(Header)) ;Send the GET request
    
    Repeat ;Wait for it to start sending data
      Delay(2) ;No need to use 100% CPU while waiting
    Until NetworkClientEvent(ServerID) = #PB_NetworkEvent_Data
    
    Repeat ;Put all recieved data in a sring
      DataLength = ReceiveNetworkData(ServerID,*Buffer,1000)
      String + PeekS(*Buffer,DataLength)
    Until DataLength = 0
    
    FreeMemory(*Buffer) ;Don't need to use this memory anymore
    
    ;Cut of the header of the recieved data
    i = FindString(String,#CRLF$+#CRLF$,1)
    String = Mid(String,i+4,Len(String)-i-3)
    ProcedureReturn String
  EndIf
EndProcedure

;Save it to a file
If CreateFile(0,"File1.txt")
  String.s = DownloadToMemory("http://www.wwitv.com/television/tvbar.htm")
  WriteData(0,@String,Len(String))
  CloseFile(0)
EndIf

;Open the file
RunProgram("File1.txt")

Code: Select all

; HTTP Commands - DarkDragon
; ***************************
; Commands:
; ---------
; HTTPRequest(URL.s, *EndSize.LONG, PacketSize, *Callback) - Result: Pointer to a buffer containing the webdata
; URL.s       - [in]  Nullterminated string with the link to the file
; *EndSize    - [out] Pointer to a long variable which receives the size of the resulting buffer
; PacketSize  - [in]  Long variable containing the size of the packets(steps) to download
; *Callback   - [in]  Pointer to a callback method receiving the following parameters: CurrentDownloadedSize.l, MaximumLength.l

; HTTPRequest_Password(URL.s, *EndSize.LONG, PacketSize, Username.s, Password.s, *Callback) - Result: Pointer to a buffer containing the webdata
; URL.s       - [in]  Nullterminated string with the link to the file
; *EndSize    - [out] Pointer to a long variable which receives the size of the resulting buffer
; PacketSize  - [in]  Long variable containing the size of the packets(steps) to download
; Username.s  - [in]  Nullterminated string containing the username
; Password.s  - [in]  Nullterminated string containing the password(NOT encoded)
; *Callback   - [in]  Pointer to a callback method receiving the following parameters: CurrentDownloadedSize.l, MaximumLength.l

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"
    Content.s = Right(File, Len(File)-s)
    File = Left(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: application/x-www-form-urlencoded"+#CRLF$
      Data_.s + "Content-Length: "+Str(Len(Content))+#CRLF$
      Data_.s + #CRLF$ + 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"
    Content.s = Right(File, Len(File)-s)
    File = Left(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: application/x-www-form-urlencoded"+#CRLF$
      Data_.s + "Content-Length: "+Str(Len(Content))+#CRLF$
      Data_.s + #CRLF$ + 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

; Example:

; *Buffer = HTTPRequest("http://www.purebasic.com/", @Size, 16, 0)
; Debug Size
; Debug PeekS(*Buffer, Size)
; FreeMemory(*Buffer)

Code: Select all

Procedure.s FindValue(header.s,find.s)
  ;OpenConsole()
  
  s.s=""
  i=FindString(header,find,1)
  If i>0
    s=Mid(header,i+Len(find),Len(header)-i-Len(find))  
  EndIf   
  
  p=FindString(s,Chr(13)+Chr(10),1)
  If p>0 And i>0
    s=Left(s,p)    
  EndIf 
  
  ProcedureReturn Trim(s)
EndProcedure

Procedure.b NiceDownload(URL.s,localfile.s)
  Protected ServerID.l, Header.s, *Buffer = AllocateMemory(1), String.s, Server.s, Path.s, i.l, DataLength.l,endOfHeader.b
 
  URL = RemoveString(URL,"http://",1)
  i = FindString(URL,"/",1)
  If i
    Server = Left(URL,i-1)
    Path = Right(URL,Len(URL)-i)
  Else
    Server = URL
  EndIf
 
  ServerID = OpenNetworkConnection(Server,80)
  If ServerID
    ;Header for the GET request
    Header = "GET /"+Path+" HTTP/1.1"+#CRLF$
    Header + "Host: "+Server+#CRLF$+#CRLF$
    SendNetworkData(ServerID,@Header,Len(Header)) ;Send the GET request
    
    Repeat
    
      Repeat ;Wait for it to start sending data
        Delay(2) ;No need to use 100% CPU while waiting
      Until NetworkClientEvent(ServerID) = #PB_NetworkEvent_Data
     
      Repeat ;Put all recieved data in a sring
        DataLength = ReceiveNetworkData(ServerID,*Buffer,1)
        String + PeekS(*Buffer,DataLength)
        If FindString(String,#CRLF$+#CRLF$,1)>0
          endOfHeader=1
          Break 
        EndIf 
      Until DataLength = 0
      
    Until endOfHeader=1
   
    FreeMemory(*Buffer) ;Don't need to use this memory anymore
    *Buffer=AllocateMemory(1024)
    maxlen=Val(FindValue(string,"Content-Length:"))
    totalr=0
    
    fid=CreateFile(#PB_Any,localfile)
    If fid<>0
      While totalr<maxlen
        Repeat ;Wait for it to start sending data
          Delay(2) ;No need to use 100% CPU while waiting
        Until NetworkClientEvent(ServerID) = #PB_NetworkEvent_Data
       
        Repeat ;Put all recieved data in a sring
          DataLength = ReceiveNetworkData(ServerID,*Buffer,1024)
          WriteData(fid,*Buffer,datalength)
          totalr + datalength
        Until DataLength < 1024  
        
        ;status = (1.0*totalr)/maxlen*100.0
        ;SetGadgetState(#ProgressBar_0,status)
        ;WindowEvent()
      Wend   
        
      CloseFile(fid)
    Else 
      ProcedureReturn 0
    EndIf 
   
    ProcedureReturn 1
  EndIf
EndProcedure

Code: Select all

OpenConsole()
ConsoleTitle("CadeX rulez")
Repeat
  PrintN("LOL n00B")
Forever