Codeschnipsel für den Zugriff auf den PlainText des TWebBrowser



/*****************************************************************************/
  gezeigt wird, wie auf den Plaintext zugegrifen wird. Dieser wird
  in ein TMemo geladen. Weiterhin werden Möglichkeiten zur wahlweisen
  Unterstützung der Funktionstasten (Strg+C, Strg+V) oder der
  Entertaste gezeigt. Der Inhalt stammt aus unterschiedlichen Foren.
  Die Bedeutung der einzelnen Funktionen ist dort nachzuelesen.
/*****************************************************************************/

uses
  ..., ActiveX;

type
  TForm1 = class(TForm)
    CheckBoxTaSt: TCheckbox;
    WebBrowser1: TWebBrowser;
    Memo1.TMemo;
    EditURL: TEdit;
    BtnNav: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBoxTaStClick(Sender: TObject);
    procedure BtnNavClick(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    FOleInPlaceActiveObject: IOleInPlaceActiveObject; // wg. Entertastenproblematik
    procedure SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream);
    procedure ExtractDataFromHtml;
    procedure FillMemo;
    procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
  end;

implementation

procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
const
  DialogKeys: set of Byte = [VK_LEFT, VK_RIGHT, VK_BACK, $30..$39, $41..$5A];
var
  iOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin
   if (WebBrowser1 = nil) then begin
    Handled := System.False;
    Exit;
  end;
  Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = System.True);
  if (Handled) and (not WebBrowser1.Busy) then begin
    if FOleInPlaceActiveObject = nil then begin
      Dispatch := WebBrowser1.Application;
      if Dispatch <> nil then begin
        Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
        if iOIPAO <> nil then FOleInPlaceActiveObject := iOIPAO;
      end;
    end;
    if FOleInPlaceActiveObject <> nil then
      if not (((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and (Msg.wParam in DialogKeys)) then
        FOleInPlaceActiveObject.TranslateAccelerator(Msg);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FOleInPlaceActiveObject := nil;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MsgHandler;
end;

procedure TForm1.CheckBoxTaStClick(Sender: TObject);
begin
  // Schaltet zwischen Unterstützung Entertaste und Steuertasten um
  if CheckBox4.Checked then
    Application.OnMessage := MsgHandler
  else
    Application.OnMessage := nil;
end;

procedure TForm1.SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream);
var PersistStreamInit: IPersistStreamInit;
  StreamAdapter: IStream;
begin
  Stream.Size:= 0;
  Stream.Position:= 0;
  if Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then begin
    StreamAdapter:= TStreamAdapter.Create(Stream, soReference);
    PersistStreamInit.Save(StreamAdapter, False);
    StreamAdapter:= nil;
  end;
end;

procedure TForm1.FillMemo;
var sStr: TStringStream;
begin
  // speicher den Plaintext in ein TMemo
  sStr := TStringStream.Create('');
  SaveDocumentSourceToStream(WebBrowser1.Document, sStr);
  Memo1.Text := sStr.DataString;
  sStr.Free;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
  FillMemo;
end;

procedure TForm1.BtnNavClick(Sender: TObject);
begin
  WebBrowser1.Navigate( EditURL.Text );
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.