unit gethttpdoc; interface uses idHttp,IdComponent,classes,sysutils,extctrls,forms; type tgetdoc = class procedure PacketRecvd(Sender: TObject); function getdocument(url : string; var res : tmemorystream) : boolean; procedure connectionfailed(Sender : TObject); procedure failure; procedure status(Sender : TComponent;Stat : string); procedure invalidhost(var handled : boolean); procedure noti(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); end; type THttpCallback = function(error : integer;mes : string) : boolean of object; procedure killsocket; var cb : THttpCallback; bytes : longint; cli : TidHttp; cancelop : boolean = false; errorlevel : integer; errormessage : string; failed : boolean =false; implementation procedure tgetdoc.noti(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin application.processmessages; end; procedure tgetdoc.status(Sender : TComponent;Stat : string); begin cb(3,Stat); end; procedure tgetdoc.connectionfailed(Sender : TObject); begin failed:=true; end; procedure tgetdoc.failure; begin failed:=true; end; procedure tgetdoc.invalidhost(var handled : boolean); begin handled:=true; failed:=true; end; function tgetdoc.getdocument(url : string;var res : tmemorystream) : boolean; var s : string; begin failed:=false; result:=false; cli:=tidhttp.Create(nil); //cli.OnWork:=noti; //cancelop:=false; //try //cli.get(url,res); //except ///failed:=true; //end; //cli.timeout:=5000; //cli.reportlevel:=2; //i.OnConnectionFailed:=connectionfailed; //i.OnFailure:=failure; //i.OnInvalidHost:=invalidhost; //i.OnStatus:=status; res:=tmemorystream.create; errorlevel:=1; errormessage:='Contacting Server'; cb(errorlevel,errormessage); if url='' then exit; try cli.get(url,res); except failed:=true; end; if failed=true then begin cb(-1,'Error Contacting Server.'#13#10'Check you have a connection to the internet.'); exit; end; setlength(s,res.Size); res.Seek(0,soFromBeginning); res.Read(s[1],res.Size); if s <>#10+'DATA' then begin cb(-10,'Serverside error'); exit; end; cli.free; cli:=tidhttp.Create(nil); ////cli.OnWork:=noti; //cli.OnPacketRecvd:=PacketRecvd; //errorlevel:=2; errormessage:='Server Performing Search & Downloading Images'; if cb(errorlevel,errormessage)=false then exit; res.Clear; try cli.get(url+'&g=1',res); except end; //res.LoadFromFile('c:\emptemp.txt'); errorlevel:=2; errormessage:='Completed'; if cb(errorlevel,errormessage)=false then exit; result:=true; end; procedure killsocket; begin //if cli<>nil then cli.Abort; end; procedure tgetdoc.PacketRecvd(Sender: TObject); begin //if cb(3,'Downloading ('+inttostr(cli.BytesRecvd )+' bytes received)')=false then begin // cli.Abort; //end; end; end.