
EatHTTP - Library
-
- Addict
- Posts: 1648
- Joined: Mon Sep 20, 2004 3:52 pm
- Contact:
-
- PureBasic Expert
- Posts: 4229
- Joined: Sat Apr 26, 2003 8:27 am
- Location: Strasbourg / France
- Contact:
I am always interesteddracflamloc wrote:(ive actually hacked together a 3.94 version. I'll post if anyones interested)

For free libraries and tools, visit my web site (also home of jaPBe V3 and PureFORM).
-
- Addict
- Posts: 1648
- Joined: Mon Sep 20, 2004 3:52 pm
- Contact:
-
- Addict
- Posts: 1648
- Joined: Mon Sep 20, 2004 3:52 pm
- Contact:
3.94 version. Be careful with that thread, and I also put in some of my own code to use a progressbar instead of a console, as well as handled errors more gracefully and no more 100% cpu usage:
Code: Select all
; -----------------------------------
; - EatHTTP - Lib for Purebasic3.94 -
; -----------------------------------
; - Author: ToastEater, modded by dracflamloc for 3.94 -
; - Thanks to: From PB -
; - NetMaestro and Srod And PBforum -
; - For help me with pointers and -
; - Winsock -
; -----------------------------------
InitNetwork()
Global line.s : line = Chr(13) + Chr(10)
Structure GetFile
dlw.l
http.s
localfile.s
max.l
time.l
status.b
; Status for downloading
; 0 Initilate Download
; 1: Downloading
; 2: Finish :D - this what we want :D
; 3: Failed
EndStructure
Dim header.s(10,1)
Global head.s
Global done.b
Declare.s FindValue(find.s)
Declare GetHeader(address.s,timeout.l)
Declare DownloadFile(*inp.GetFile)
; Returns of GetHeader
;
; -1 No host
; -2 No respons from server in the Timeout(Default 5seconds)
Procedure.l GetHeader(address.s,timeout.l)
head=""
If timeout=0
timeout=5000
EndIf
host.s = StringField(address,1,"/")
wsc = OpenNetworkConnection(host,80)
If wsc=0
Print("No Host")
ProcedureReturn -1
EndIf
SendNetworkString(wsc,"GET /" + Mid(address,Len(host) + 2,100) + " HTTP/1.1" + line + "Host: " + host + line + line)
*buffer = AllocateMemory(2)
temper.s = ""
stime = ElapsedMilliseconds()
Repeat
event = NetworkClientEvent(wsc)
If event = 2
ReceiveNetworkData(wsc,*buffer,1)
temper = temper + PeekS(*buffer)
If Right(temper,4) = line + line
temper = Left(temper,Len(temper) - 4)
header(0,0) = StringField(temper,1,line)
header(0,1) = StringField(temper,2," ")
temper = Right(temper,Len(temper) - Len(header(0,0)))
Break
EndIf
ElseIf ElapsedMilliseconds() - stime > timeout ; TimeRan Out
Print("Failed...")
ProcedureReturn -2
EndIf
ForEver
For i = 1 To CountString(temper,line)
temp.s = StringField(temper,i,line)
header(i,0) = Mid(StringField(temp,1,":"),2,1000)
header(i,1) = Mid(temp,Len(header(i,0)) + 4,100)
Next
ProcedureReturn wsc
EndProcedure
Procedure DownloadFile(*inp.GetFile)
done=0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; MAKE HEADER ARRAY AND GET HEADER ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
wsc = GetHeader(*inp\http,5000)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; MAKE SPACE FOR INFORMATION ;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
*buffer = AllocateMemory(2)
*inp\dlw = 0
*inp\max = Val(FindValue("Content-Length"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;; ERROR CHECKING ;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If header(0,1) <> "200"
If header(0,1) = "302" ; File Found ?
SetGadgetText(#txtCurrentFile,"Error Code: "+header(0,1))
*inp\status = 3 ;0
ProcedureReturn
ElseIf *inp\max = 0 ; Bad header ?
SetGadgetText(#txtCurrentFile,"Bad header request")
*inp\status = 3
ProcedureReturn
ElseIf wsc = 0 ; Lost Connection ?
SetGadgetText(#txtCurrentFile,"Lost or no connection")
*inp\status = 3
ProcedureReturn
Else
SetGadgetText(#txtCurrentFile,"Error Code: "+header(0,1))
*inp\status = 3
ProcedureReturn
EndIf
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ss = CreateFile(0,*inp\localfile)
*inp\time = ElapsedMilliseconds()
*inp\status = 1
*buffer2=AllocateMemory(4096)
While 1
If *inp\max <= *inp\dlw
*inp\status = 2
Break
ElseIf NetworkClientEvent(wsc) = 2
len=ReceiveNetworkData(wsc,*buffer2,4096)
WriteData(*buffer2,len)
*inp\dlw = *inp\dlw + len
Delay(1)
Else
Delay(1)
EndIf
Wend
CloseFile(0)
FreeMemory(ss)
FreeMemory(*buffer)
FreeMemory(*buffer2)
done=1
EndProcedure
Procedure.s FindValue(find.s)
For i = 1 To 10
If LCase(find) = LCase(header(i,0))
ProcedureReturn header(i,1)
Break
EndIf
Next
ProcedureReturn "0"
EndProcedure
Procedure NiceDownload(file.s,localfile.s)
done=0
;OpenConsole()
easy.GetFile
easy\status = 0 ; VERY IMPORTEN without this it may crash
easy\http = file
easy\localfile = localfile
;PrintN("Start downloading of " + easy\http + "...")
;EnableGraphicalConsole(1)
CreateThread(@DownloadFile(),@easy)
;p("[",0,24)
;p("]",79,24)
status.f = 0
last.l
While easy\status = 0
WindowEvent()
Delay(50)
Wend
While 1
If easy\dlw > 1 And easy\max > 1
last=status
status = easy\dlw / easy\max * 100
EndIf
If last <> status ; Not Needed but reduce the flicking
;p("*",1+ status * 0.77,24)
SetGadgetState(#ProgressBar,status)
EndIf
;ConsoleLocate(0,25)
;Print(Str(status) + "% Downloaded: " + Str(easy\dlw) + "/" + Str(easy\max) + " KBs: " + Str( easy\dlw / (ElapsedMilliseconds() - easy\time) ))
If Str(easy\dlw / (ElapsedMilliseconds() - easy\time))+" KB/s"<>GetGadgetText(#txtRate)
SetGadgetText(#txtRate,Str(easy\dlw / (ElapsedMilliseconds() - easy\time))+" KB/s")
EndIf
If easy\status = 2
;p("SUCCESS",0,7)
SetGadgetText(#txtCurrentFile,"SUCCESS")
log + "Successfully Downloaded: "+GetFilePart(localfile)+line
done=1
Break
ElseIf easy\status = 3
;p("FAILED",0,7)
SetGadgetText(#txtCurrentFile,"FAILED")
log + "Error Downloading: "+header(0,1)+line
done=1
Break
EndIf
If WindowEvent()=#PB_Event_CloseWindow
Goto exitprog
EndIf
Delay(50)
Wend
EndProcedure
; IDE Options = PureBasic v3.94 (Windows - x86)
; DisableDebugger
; HideErrorLog
-
- PureBasic Expert
- Posts: 4229
- Joined: Sat Apr 26, 2003 8:27 am
- Location: Strasbourg / France
- Contact:
Thanksdracflamloc wrote:3.94 version. Be careful with that thread, and I also put in some of my own code to use a progressbar instead of a console, as well as handled errors more gracefully and no more 100% cpu usage
For free libraries and tools, visit my web site (also home of jaPBe V3 and PureFORM).
-
- User
- Posts: 49
- Joined: Tue Jul 25, 2006 5:07 pm
Sorry but ima kinda stopped with try work with proxy its too damn hard :S.
If any interested in try make it with Proxy be my guest.
I've improved, some error checkers didnt work etc heres the totaly new version
As you can see there is no NiceDownload, its not included anymore instead i've try improve so its easier to work with.
Heres some example
I've have try make one with GUI but im new to GUI programming with PB so still not working. Should be easy to import if you know GUI programming with PB.
Hope its helps i'll try improve so make even easier to work with.
Please report bugs.
Regardz
If any interested in try make it with Proxy be my guest.
I've improved, some error checkers didnt work etc heres the totaly new version
Code: Select all
; -----------------------------------
; - EatHTTP 1.00 -
; - Lib for Purebasic4.0 -
; -----------------------------------
; - Author: ToastEater -
; - Thanks to: From PB -
; - NetMaestro and Srod And PBforum -
; - For help me with pointers and -
; - Winsock <3 -
; -----------------------------------
InitNetwork()
Structure eathttp
; Variables
*wsc.l ; WinSocket Connected
*fhd.l ; File HanDler
url.s
localfile.s
; Header returns
date.s
version.s
errorcode.l
server.s
length.l
;Dynamic Variables
procent.f ; Procent downloaded
kbs.l ; KiloBytes Per Second downloading
dlw.l ; Bytes downloaded
time.l ; Time since started
status.b ; Status for downloading
; 1: Downloading
; 2: Finish :D - this what we want :D
; 3: Failed
EndStructure
Procedure HTTPGetHeader(*this.eathttp)
Protected lala.s
lala = Mid(*this\url,8,FindString(*this\url, "/", 8) - 8)
*this\wsc = OpenNetworkConnection(lala,80)
If *this\wsc = 0
*this\status = 3
ProcedureReturn
EndIf
SendNetworkString(*this\wsc,"GET " + *this\url + " HTTP/1.1" + #CRLF$ + "Host: " + lala + #CRLF$ + #CRLF$)
temper.s = ""
*buffer = AllocateMemory(2)
stime = ElapsedMilliseconds()
Repeat
If NetworkClientEvent(*this\wsc) = #PB_NetworkEvent_Data
ReceiveNetworkData(*this\wsc,*buffer,1)
temper = temper + PeekS(*buffer)
If Right(temper,4) = #CRLF$ + #CRLF$:Break: EndIf
ElseIf ElapsedMilliseconds() - stime > 10000 ; Timeout
ProcedureReturn -2
EndIf
ForEver
temp.s
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; SET ALL DATA ;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
*this\version = Mid(temper,6,3)
*this\errorcode = Val(Mid(temper,10,3))
For i = 2 To CountString(temper,#CRLF$) - 1
temp = Mid(StringField(temper,i,#CRLF$),2,100)
Select StringField(temp,1,":")
Case "Content-Length"
*this\length = Val(StringField(temp,2,":"))
Case "Date"
*this\date = StringField(temp,2,":")
Case "Server"
*this\server = StringField(temp,2,":")
EndSelect
Next
If *this\errorcode = 302 Or *this\length = 0 Or *this\wsc = 0
*this\status = 3
EndIf
EndProcedure
Procedure HTTPDownload(*this.eathttp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; CREATE FILE AND INITIATE ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CreateFile(*this\fhd,*this\localfile) ; Open File for write
*this\dlw = 0 ; Downloaded so far
*buffer = AllocateMemory(2)
stime = ElapsedMilliseconds() ; Time elapsed
*this\status = 1 ; Status start download
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; FILE START DOWNLOADING ;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Repeat
*this\time = ElapsedMilliseconds() - stime ; time
If *this\dlw > 0
*this\procent = *this\dlw / *this\length * 100
EndIf
If *this\dlw > 1 And *this\time > 1 ; Kbs
*this\kbs = *this\dlw / *this\time
EndIf
If *this\length = *this\dlw ; If file finish downloaded ?
*this\status = 2
Break
ElseIf NetworkClientEvent(*this\wsc) = #PB_NetworkEvent_Data ; Byte received?
ReceiveNetworkData(*this\wsc,*buffer,1)
WriteData(*this\fhd,*buffer,1)
*this\dlw = *this\dlw + 1
timecompare = ElapsedMilliseconds()
EndIf
ForEver
EndProcedure
Macro HTTPEasyHeader(lib,urll,localfilel)
lib.eathttp
lib\url = urll
lib\localfile = localfilel
EndMacro
As you can see there is no NiceDownload, its not included anymore instead i've try improve so its easier to work with.
Heres some example
Code: Select all
IncludeFile "eatHTTP.pb" ; Load eatHTTP - Preprocessing
; Initiate console
OpenConsole()
EnableGraphicalConsole(1)
; Initiate httpheader to http
HTTPEasyHeader(http,"http://download.nullsoft.com/winamp/client/winamp523_full_emusic-7plus.exe","winamp.exe")
;HTTPEasyHeader Is just a macro for speed up you can also define by you self Like this
;http.eathttp
;http\url = "http://download.nullsoft.com/winamp/client/winamp523_full_emusic-7plus.exe"
;http\localfile = "winniex.exe"
; Get the header
HTTPGetHeader(@http)
If http\status = 3 ; If Error
PrintN("failed")
Input()
End
EndIf
; Starts a new thread there start downloading
CreateThread(@HTTPDownload(),http)
; Repeat ForEver
Repeat
; Show the bytes needed
ConsoleLocate(0,10)
PrintN("Need1 " + Str((http\length - http\dlw)) + " ")
If http\status = 2 Or http\status = 3 ; end if error or finish
Break
EndIf
Delay(50)
ForEver
Input()
Code: Select all
IncludeFile "eathttp.pb"
Procedure p(text.s,x.l,y.l)
ConsoleLocate(x,y)
Print(text)
EndProcedure
OpenConsole()
http.eathttp
http\url = "http://download.nullsoft.com/winamp/client/winamp523_full_emusic-7plus.exe"
http\localfile = "winamp.exe"
EnableGraphicalConsole(0)
PrintN("")
PrintN("Started PureBasic4 EatHTTP library by ToastEater..")
PrintN("")
PrintN("Downloading: " + http\url + "...")
EnableGraphicalConsole(1)
HTTPGetHeader(@http)
If http\status = 3
PrintN("failed")
Input()
End
EndIf
CreateThread(@HTTPDownload(),http)
p("[",0,15)
p("]",30,15)
status.d = 0
last.l
Repeat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; PERCENT AND STATUSBAR ;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ConsoleLocate(1 + http\procent * 0.28,15)
Print("=")
ConsoleLocate(32,15)
Print(Str(http\procent) + "%")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
p("Time: " + Str(http\time / 1000),1,16) ; Time print
Print(" KBs: " + Str(http\kbs))
If http\status = 2
p("SUCCESS",0,7)
Break
ElseIf http\status = 3
p("FAILED",0,7)
Break
EndIf
Delay(50)
ForEver
Input()
I've have try make one with GUI but im new to GUI programming with PB so still not working. Should be easy to import if you know GUI programming with PB.
Hope its helps i'll try improve so make even easier to work with.
Please report bugs.
Regardz
Sorry for my damn english
amour au PB et au traducteur de google d'ofcourse
amour au PB et au traducteur de google d'ofcourse
-
- Addict
- Posts: 1648
- Joined: Mon Sep 20, 2004 3:52 pm
- Contact:
-
- User
- Posts: 49
- Joined: Tue Jul 25, 2006 5:07 pm
- netmaestro
- PureBasic Bullfrog
- Posts: 8451
- Joined: Wed Jul 06, 2005 5:42 am
- Location: Fort Nelson, BC, Canada