unit UDemo2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
TMyThread =
class(TThread)
private
FMemoHandle : THandle;
FUrl :
String;
protected
procedure Execute;
override;
public
constructor Create(MemoHandle: THandle; AUrl:
String);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses WinInet;
Function GetHTML(AUrl:
string):
string;
var
databuffer :
array[0..4095]
of char;
ResStr :
string;
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen,datalen,dwread,dwNumber: cardinal;
dwcode :
array[1..20]
of char;
res : pchar;
Str : pchar;
begin
ResStr:='
';
if pos('
http://',lowercase(AUrl))=0
then
AUrl:='
http://'+AUrl;
hSession:=InternetOpen('
InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0);
if assigned(hsession)
then
begin
hfile:=InternetOpenUrl(
hsession,
pchar(AUrl),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile,
HTTP_QUERY_STATUS_CODE,
@dwcode,
dwcodeLen,
dwIndex);
res := pchar(@dwcode);
dwNumber := sizeof(databuffer)-1;
if (res ='
200')
or (res ='
302')
then
begin
while (InternetReadfile(hfile,
@databuffer,
dwNumber,
DwRead))
do
begin
if dwRead =0
then
break;
databuffer[dwread]:=#0;
Str := pchar(@databuffer);
resStr := resStr + Str;
end;
end
else
ResStr := '
Status:'+res;
if assigned(hfile)
then
InternetCloseHandle(hfile);
end;
InternetCloseHandle(hsession);
Result := resStr;
end;
constructor TMyThread.Create(MemoHandle: THandle; AUrl:
String);
begin
FMemoHandle := MemoHandle;
FUrl:= AUrl;
FreeOnTerminate := True;
inherited Create(True);
end;
procedure TMyThread.Execute;
begin
inherited;
SendMessage(FMemoHandle, WM_SETTEXT, 0, Integer(@GetHTML(FUrl)[1]));
end;
procedure TermThread;
begin
Form1.Button1.Enabled := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
var thGetHTML : TMyThread;
begin
Button1.Enabled := False;
thGetHTML := TMyThread.Create(Memo1.Handle, '
www.delphipraxis.net');
with thGetHTML
do begin
@OnTerminate := @TermThread;
Suspended := False;
end;
end;
end.