Background webpage "grab"...

[DoubleDutch]

This routine will grab a webpage in the program background. Shouldn't need threading enabled.

Code: Select all

Structure ThreadURL
	webpage$
	identity$
	webaddr.l
	idaddr.l
	memory.l
	memorysize.l
	status.l
EndStructure

Procedure ThreadGrabURL(*WebData.ThreadURL)
	If InternetGetConnectedState_(#Null,#Null)
		hInet=InternetOpen_(*WebData\idaddr,0,#Null,#Null,0) 
		If hInet
			hURL=InternetOpenUrl_(hInet,*WebData\webaddr,#Null,0,$80000000,0)
			MemoryNeeded=0
			Delay(300)
 			If InternetQueryDataAvailable_(hURL,@MemoryNeeded,0,0)
 				*WebData\memorysize=MemoryNeeded
 				If *WebData\memorysize
	 				*WebData\memory=AllocateMemory(*WebData\memorysize)
	 				If *WebData\memory
	 					Debug("Memory size:"+Str(*WebData\memorysize))
	 					done=#False
	 					grabbed=0
	 					position=0
	 					Repeat
	 						If InternetReadFile_(hURL,*WebData\memory+position,MemoryNeeded,@grabbed)
	 							If grabbed
	 								position+grabbed
	 								Delay(100)
	 								MemoryNeeded=0
									InternetQueryDataAvailable_(hURL,@MemoryNeeded,0,0)
 									If MemoryNeeded
 										NewSize=*WebData\memorysize+MemoryNeeded
 										NewMemory=ReAllocateMemory(*WebData\memory,NewSize)
 										If NewMemory
 											*WebData\memory=NewMemory
 											*WebData\memorysize=NewSize
 										Else
 											*WebData\status=-5
 											FreeMemory(*WebData\memory)
 											*WebData\memory=0
 										EndIf
 									Else
 										done=#True
 									EndIf
	 							Else
	 								done=#True
	 							EndIf
	 						Else
	 							done=#True
	 						EndIf
	 					Until done
	 					*WebData\status=#True
	 				Else
	 					*WebData\status=-5	; not enough free memory
	 				EndIf
	 			Else
	 				*Webdata\status=-4	; pagesize = zero!
 				EndIf
 			Else
 				*WebData\status=-3	; cannot return pagesize
 			EndIf
 			InternetCloseHandle_(hURL)
		Else
			*WebData\status=-2	; cannot open
		EndIf
		InternetCloseHandle_(hInet)
	Else
		*WebData\status=-1	; no internet error
	EndIf
EndProcedure

Procedure StartGrabURL(*WebData.ThreadURL)
	result=0
	If *WebData\status=0
		*WebData\webaddr=AllocateMemory(Len(*WebData\webpage$)+1)
		If *WebData\webaddr
			*WebData\idaddr=AllocateMemory(Len(*Webdata\identity$)+1)
			If *WebData\idaddr
				PokeS(*WebData\webaddr,*Webdata\webpage$)
				PokeS(*WebData\idaddr,*WebData\identity$)
				result=CreateThread(@ThreadGrabURL(),*WebData)
				If Not result
					FreeMemory(*WebData\idaddr)
					*Webdata\idaddr=0
				EndIf
			Else
				FreeMemory(*WebData\webaddr)
				*WebData\webaddr=0
			EndIf
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.s StopGrabURL(*WebData.ThreadURL)
	If *WebData\status=1
		result$=PeekS(*WebData\memory,*WebData\memorysize)
	Else
		result$=""
	EndIf
	If *WebData\memory
		FreeMemory(*WebData\memory)
		*WebData\memory=0
	EndIf
	If *WebData\idaddr
		FreeMemory(*WebData\idaddr)
		*WebData\idaddr=0
	EndIf
	If *WebData\webaddr
		FreeMemory(*WebData\webaddr)
		*WebData\webaddr=0
	EndIf
	*Webdata\status=0
	ProcedureReturn result$
EndProcedure

MyGrab.ThreadURL
MyGrab\webpage$="http://www.PureBasic.com"
MyGrab\identity$="ThreadWebGrab"
StartGrabURL(@MyGrab)

Repeat
	Delay(1)
Until MyGrab\status<>0

Debug(Str(MyGrab\status))
Debug(StopGrabURL(@MyGrab))

End

You should be able to have multiple grabs going on without problems, but I haven't tested it. I don't know how much it will effect memory fragmentation as I don't know how the reallocatememory() command works internally. Fred?

[Ollivier]

joli!

I often use *New = ReAllocateMemory(*Old, MemSize(*Old) + 4) and I don't meet problems. Sometimes, this op is repeated lots of times without problem.