Здравствуйте, ratttx, Вы писали:

R>Здравствуйте, Ihor Osovyak.

R>Большое спасибо за вашу статью, но прочитав ее я понял, на сколько я глупый.... )

а зря, статья расчитана на бегин0левел ...

R>Я сильно извиняюсь но не могли бы вы написать небольшой кодик на простой буттон(или ОНДОКУМЕНТкомплит), что бы он просто вынимал ХТМЛкод из всех фреймов и заносил их все в мемо... В статье, я так и не понял, как это делается, потыкался, потыкался и опять сполз на 0...
R>Еще раз извиняюсь за принесенные неудобства....


выдернуто из того, что под рукой....

unit fIEFrames;

interface
uses Mshtml;

type
  TOneStepSearchCondForHtmlDocWithFrames = function(iDoc: IHtmlDocument2; addPrm: integer): boolean;

function FinderFirstCondForHtmlDocWithFrames(iDoc: IHtmlDocument2;
  addPrm: integer;
  aDoer: TOneStepSearchCondForHtmlDocWithFrames): boolean;


implementation

uses sysutils;

function FinderFirstCondForHtmlDocWithFrames(iDoc: IHtmlDocument2;
  addPrm: integer;
  aDoer: TOneStepSearchCondForHtmlDocWithFrames): boolean;
{  The procedure aDoer  will be caused for each IHtmlDocument2, beginning
   from main and finishing any level of frames
   while aDoer will return false;
}
var
  frames: IHTMLFramesCollection2;
  i: integer;
  ov1: OleVariant;
  iDisp: IDispatch;
  IWindow2: IHTMLWindow2;
begin
  result := false;
  if not assigned(aDoer) then
    Exit;
  result := aDoer(iDoc, addPrm);
  if result then
    Exit;
  frames := iDoc.frames;
  if not assigned(frames) then
    exit;
  if frames.length = 0 then
    exit;

  for i := 1 to frames.length do
  begin
    ov1 := i - 1;
    try
      iDisp := frames.item(ov1);
      iDisp.QueryInterface(IHTMLWindow2, IWindow2);
      if assigned(IWindow2) then
      begin
        result := false;
        try
          if assigned(IWindow2.document) then
            result := FinderFirstCondForHtmlDocWithFrames(IWindow2.document, addPrm, aDoer);
        except
        end;
        if result then
          exit;
      end;
    except
      { ShowMessage('Find error !!!');}
    end;
  end;
end;

end.

и далее

unit e0_PrimParser;

interface

uses classes, Mshtml, SHDocVw;

....

function GetHtmlAllFrames(pDisp: IDispatch): string;
function GetHtmlAllFrames2(iDoc: IHtmlDocument2): string;

function GetTxtAllFrames2(iDoc: IHtmlDocument2): string;
function GetTxtAllFrames(pDisp: IDispatch): string;


implementation

uses
  variants,
  activeX,
  sysutils,
  fIEFrames;

type

.....
  pdataFor_getTextAllFrames = ^dataFor_getTextAllFrames;
  dataFor_getTextAllFrames = record
    sStr: string;
  end;


......

function fGetAllHTMOneFrame(iDoc: IHtmlDocument2; addPrm: integer): boolean;

var
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  iElement: IHTMLElement;
  i: integer;
  //subStr:string;
  tag: string;
begin
  result := false;
  if addPrm = 0 then
    Exit;

  if not assigned(iDoc) then
    Exit;
  tag := 'BODY';
  ov := tag;

  IDisp := iDoc.all.tags(ov);
  if not assigned(IDisp) then
    exit;
  IDisp.QueryInterface(IHTMLElementCollection, iColl);
  if not assigned(iColl) then
    exit;

  for i := 1 to iColl.Get_length do
  begin
    iDisp := iColl.item(pred(i), 0);
    if not assigned(iDisp) then
      continue;
    iDisp.QueryInterface(IHTMLElement, iElement);
    if not assigned(iElement) then
      continue;
    try
      with pdataFor_getTextAllFrames(addPrm)^ do
        sStr := sStr + iElement.outerHTML;
    except
    end;
  end;
end;

function fGetTxtOneFrame(iDoc: IHtmlDocument2; addPrm: integer): boolean;

var
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  iElement: IHTMLElement;
  i: integer;
  //subStr:string;
  tag: string;
begin
  result := false;
  if addPrm = 0 then
    Exit;

  if not assigned(iDoc) then
    Exit;
  tag := 'BODY';
  ov := tag;

  IDisp := iDoc.all.tags(ov);
  if not assigned(IDisp) then
    exit;
  IDisp.QueryInterface(IHTMLElementCollection, iColl);
  if not assigned(iColl) then
    exit;

  for i := 1 to iColl.Get_length do
  begin
    iDisp := iColl.item(pred(i), 0);
    if not assigned(iDisp) then
      continue;
    iDisp.QueryInterface(IHTMLElement, iElement);
    if not assigned(iElement) then
      continue;
    try
      with pdataFor_getTextAllFrames(addPrm)^ do
        sStr := sStr + iElement.outerText;
    except
    end;
  end;
end;

function GetHtmlAllFrames2(iDoc: IHtmlDocument2): string;
var
  data: dataFor_getTextAllFrames;
begin
  result := '';

  if not assigned(iDoc) then
    Exit;

  fillChar(data, sizeof(data), 0);
  data.sStr := '';

  FinderFirstCondForHtmlDocWithFrames(iDoc, integer(@Data), fGetAllHTMOneFrame);
  result := data.sStr;

  data.sStr := '';

end;

function GetTxtAllFrames2(iDoc: IHtmlDocument2): string;
var
  data: dataFor_getTextAllFrames;
begin
  result := '';

  if not assigned(iDoc) then
    Exit;

  fillChar(data, sizeof(data), 0);
  data.sStr := '';

  FinderFirstCondForHtmlDocWithFrames(iDoc, integer(@Data), fGetTxtOneFrame);

  result := data.sStr;

  data.sStr := '';

end;

function GetHtmlAllFrames(pDisp: IDispatch): string;
var
  iDoc: IHtmlDocument2;

begin
  result := '';

  if not assigned(pDisp) then
    Exit;
  if not assigned((pDisp as IWebBrowser2).Document) then
    Exit;

  iDoc := (pDisp as IWebBrowser2).Document as IHtmlDocument2;

  result := GetHtmlAllFrames2(iDoc);

end;

function GetTxtAllFrames(pDisp: IDispatch): string;
var
  iDoc: IHtmlDocument2;

begin
  result := '';

  if not assigned(pDisp) then
    Exit;
  if not assigned((pDisp as IWebBrowser2).Document) then
    Exit;

  iDoc := (pDisp as IWebBrowser2).Document as IHtmlDocument2;

  result := GetTxtAllFrames2(iDoc);

end;
....

end.

возможно, что ничего не опустил... Возможно, что есть мелкие баги — но в проекте, где єто юзалось — претензий к функциональности не было..



да, в
function GetTxtAllFrames(pDisp: IDispatch): string;
function GetHtmlAllFrames(pDisp: IDispatch): string;

в качестве pDisp: IDispatch нужно передавать WB.DefaultInterface, впрочем это понятно из реализации..

удачи в борьбе с TWebBrouser-ом и com-интерфейсами...