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.