function GetActiveBrowsersURL(Service:
string):
string;
var
ClDDE: TDDEClientConv;
zwi: PChar;
begin
ClDDE := TDDEClientConv.Create(
nil);
with ClDDE
do
begin
SetLink(Service, '
WWW_GetWindowInfo');
zwi := RequestData('
0xFFFFFFFF');
CloseLink;
end;
Result := StrPas(zwi);
StrDispose(zwi);
ClDDE.Free;
end;
Function GetHTML(AUrl:
string):
string;
var
databuffer :
array[0..4095]
of char;
ResStr :
string;
hSession, hfile: hInternet;
dwindex,dwcodelen,dwread,dwNumber: cardinal;
dwcode :
array[1..20]
of char;
res : pchar;
Str : pchar;
begin
ResStr:='
';
Result:='
';
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 Try
hfile:=InternetOpenUrl(
hsession,
pchar(AUrl),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
if assigned(hfile)
then Try
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))
AND (dwRead <>0)
do begin
databuffer[dwread]:=#0;
Str := pchar(@databuffer);
resStr := resStr + Str;
Application.ProcessMessages;
end;
end else
ResStr := '
Status:'+res;
Finally
InternetCloseHandle(hfile);
End;
Finally
InternetCloseHandle(hsession);
End;
Result := ResStr;
end;
procedure TFrameForm.FirefoxQuelltextbernehmen1Click(Sender: TObject);
var
s:
string;
i: integer;
begin
try
Server := True;
Url := GetActiveBrowsersURL('
firefox');
if url = '
'
then exit;
Delete(
Url,1,1);
i := Pos('
"',
Url);
Delete(
Url,i,Length(
Url)-(i-1));
//ShowMessage(Url);
FrameForm.New1Click(Sender);
with ActiveMDIChild
as TEditForm
do
begin
SynEdit1.ClearAll;
synEdit1.Lines.Add('
****************************************');
SynEdit1.Lines.Add(
Url);
SynEdit1.Lines.Add('
****************************************');
SynEdit1.Text := GetHTML(
Url);
SynEdit1.Text := StringReplace(SynEdit1.Text, '
', #13#10, [rfReplaceAll]);
Viewer.LoadStrings(SynEdit1.Lines, '
');
SynEdit1.Modified := True;
end;
except
ShowMessage('
Fehler bei Übernahme des Quelltextes!');
end;
end;