![]() |
![]() ![]() ![]() ![]() |
|
Получить HTML-код из всех запущенных экземпляров Internet ExplorerDelphi , Интернет и Сети , БраузерПолучить HTML-код из всех запущенных экземпляров Internet Explorer
Оформил: DeeCo
uses
MSHTML_TLB, ActiveX;
function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
s: string;
ss: TStringStream;
sa: IStream;
begin
ps := WB.document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
sa:= TStreamAdapter.Create(ss, soReference) as IStream;
Result := Succeeded(ps.Save(sa, Bool(True)));
if Result then ACode.Add(ss.Datastring);
finally
ss.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
// get the running instance of Internet Explorer
for k := 0 to ShellWindow.Count do
begin
spDisp := ShellWindow.Item(k);
if spDisp = nil then Continue;
// QueryInterface determines if an interface can be used with an object
spDisp.QueryInterface(iWebBrowser2, WB);
if WB <> nil then
begin
WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
if iDoc1 <> nil then
begin
WB := ShellWindow.Item(k) as IWebbrowser2;
begin
// Add HTML Code to Memo
Memo1.Lines.Add('****************************************');
Memo1.Lines.Add(WB.LocationURL);
Memo1.Lines.Add('****************************************');
GetHTMLCode(WB, Memo1.Lines);
end;
end;
end;
end;
end;
Программа на Delphi использует библиотеки MSHTML и ActiveX для взаимодействия с экземплярами Internet Explorer (IE). Главная цель программы - это извлечь код HTML из всех запущенных экземплярах IE. Вот разбивка кода:
Вывод программы - это список кодов HTML в контроле Некоторые предложения по улучшению:
В целом, код работает корректно и предоставляет полезную функциональность. Однако он может быть улучшен, если будут приняты некоторые из предложенных выше изменений. Получить HTML-код из всех запущенных экземпляров Internet Explorer с помощью Delphi. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 | ||||