TWebbrowser HTML-Code direkt ins Dok. und dann scrollen

[DataCool]

Hi Leute,

ich habe folgenden nützlichen Code gefunden, mit dem man direkt in das Dokument eines TWebbrowser schreiben , also ist der Umweg über ein lokalen File überflüssig.
Leider bekomme ich es nicht hin, das der Webbrowser, danach nach unten scrollt.
Die herkömmlichen Methoden funktionieren nicht.
Schaut euch die Methode LoadFromStrings an, da liegt das Problem !

Code:

Unit WebHelper;

{ 
  Unit: WebHelper 

  Developer: ase, nsX-gteX 

  Compiler: Delphi, v7.0 Build 4453

  Date: 07.05.2003  19:00 --> 08.05.2003  00:15 

  Classes: TWebHelper -> This class provides capabilities to add HTML text 
                         to a TWebBrowser component without creating temprary 
                         files or stuff. 

                         Usage: See implementation part. 

  Comments: Have fun with it! 

  License: No license. Use it or leave it. My name in your copyright is not 
           required. A copy of your program would be nice but although, is not 
           required. 
} 

interface 

uses Classes, ComObj, MSHTML, SHDocVw, Variants, SyncObjs; 

type 

  TWebHelper = Class; 

  TWebHelper = Class(TInterfacedObject) 
    private 
      FBrowser: TWebBrowser; 
      FIsReady: WordBool; 
      FClear: WordBool; 
      FSave: TCriticalSection; 
      FLineBreak: WordBool; 
      FScroll2End : WordBool;

      function Get_CanPost: WordBool; 
    protected 
      procedure Event_DocumentComplete(Sender: TObject; Const pDisp: IDispatch; Var URL: OleVariant); 
    public 
      Constructor Create(ABrowser: TWebBrowser); 
      Destructor Destroy; Override; 

      procedure LoadFromStrings(AStrings: TStrings); 
      procedure WriteOneString(Const Msg: WideString); 

      property WebBrowser : TWebBrowser read FBrowser; 
      property CanPost : WordBool read Get_CanPost; 
      property ClearBeforePost : WordBool read FClear write FClear; 
      property LineBreak : WordBool read FLineBreak write FLineBreak; 
      property Scroll2End : WordBool read FScroll2End write FScroll2End;
  End; 

implementation 

uses SysUtils, ActiveX, Messages, windows; 

ResourceString sLineBreakStr = '
'; 
               sNotReady = 'Cannot display HTML code yet. Control not initialized.'; 
               sAboutBlank = 'about:blank'; 

{ 
  TWebHelper - Usage 


  Property WebBrowser: Read-Only. Returns the TWebBrowser component, TWebHelper 
                       actually controlls. You specify this control in the 
                       constructor of TWebHelper. 

  Property CanPost:    TWebHelper needs to initialize the TWebBrowser control. 
                       This initialization step is done ASYNCHRONOUSLY by the 
                       control itself. If done, the control will notify TWebHelper 
                       and from there you will be able to post data. If you try 
                       to post data wheater TWebHelper is not ready, an exception 
                       is raised. The property getter is thread safe. 

  Property ClearBeforePost: 
                       Determined if TWebHelper should clear the browser control 
                       before adding new data. If FALSE, the new data is simply 
                       added to the browser control. 

  Property LineBreak:  If TRUE, TWebHelper will add a 
 (sLineBreakStr) to 
                       every post. 

  Procedure LoadFromStrings(AStrings: TStrings) 
                       This method will add the strings in AStrings to the 
                       browser control. If CanPost is FALSE, an exception is raised. 
                       Always encapsulate this call in a Try..Except block! 
                       The method does _not_ handle exceptions. The AStrings 
                       parameter will be handled as read-only an will not be 
                       changed. 

  Procedure WriteOneString(Const Msg: WideString) 
                       With that nice trick you can add a single line to the 
                       Browser control. Usefull for administrator messages. 
                       If CanPost is FALSE, an exception is raised. 
                       Always encapsulate this call in a Try..Except block! 
                       The method does _not_ handle exceptions. 
} 

Constructor TWebHelper.Create(ABrowser: TWebBrowser); 
Var v: OleVariant; 
Begin 
  Inherited Create; 
  // private initialization... 
  FIsReady := False; 
  FSave := TCriticalSection.Create; 
  FClear := False; 
  FLineBreak := True; 
  FScroll2End := true;

  // Init the browser. We need to do this step to prevent the browser from 
  // setting FBrowser.Document to NIL. We need the document property. The browser 
  // will initialize it only if he has a valid document. 'ABOUT:BLANK' is valid. 
  // Search www.msdn.micro$oft.com for more details. 

  FBrowser := ABrowser; 
  FBrowser.OnDocumentComplete := Event_DocumentComplete; 
  v := sAboutBlank; 
  FBrowser.Navigate2(v); 
End; 

procedure TWebHelper.Event_DocumentComplete(Sender: TObject; Const pDisp: IDispatch; Var URL: OleVariant); 
begin 
  // Browser calls us that he has finished his initialization. Fine! 
  try 
   FSave.Enter; 

    FIsReady := True; 
  finally 
    FSave.Leave; 
  end; 
end; 

procedure TWebHelper.WriteOneString(Const Msg: WideString); 
Var Doc: IHTMLDocument2; 
    v: OleVariant; 
begin 
  // Are we ready? 
  If not CanPost then 
    Raise Exception.Create(sNotReady); 

  try 
    // Get the Document interface. 
    OleCheck(FBrowser.DefaultInterface.Document.QueryInterface(IHTMLDocument2, Doc)); 

    // Do we have to clear the page? 
    If FClear then 
      Doc.close; 

    // Create the array with only one element. Attention: varOleStr does not work. 
    // Only God knows why because it should: MSDN. 
    v := VarArrayCreate([0, 0], varVariant); 

    If FLineBreak then 
      v[0] := Msg + sLineBreakStr 
    else 
      v[0] := Msg; 

    // Send the data to the browser. 
    Doc.write(PSafeArray(TVarData(v).VArray));
    // Scroll to the end if necassary
    if FScroll2End then
      //FBrowser.Perform(WM_VSCROLL,SB_ENDSCROLL,0);
      doc.parentWindow.scrollBy(0,doc.parentWindow.screen.height);
  finally 
    // clear the array and release the document. 
    v := Unassigned; 
    Doc := Nil; 
  end; 
end; 

function TWebHelper.Get_CanPost: WordBool; 
begin 
  // Thread save. 
  FSave.Enter; 
  try 
    Result := FIsReady; 
  finally 
    FSave.Leave; 
  end; 
end; 

procedure TWebHelper.LoadFromStrings(AStrings: TStrings); 
Var Doc: IHTMLDocument2; 
    v: OleVariant; 
    i: Integer; 
begin 
  // Are we ready? 
  If not CanPost then 
    raise Exception.Create(sNotReady); 

  try 
    // Get document interface 
    OleCheck(FBrowser.DefaultInterface.Document.QueryInterface(IHTMLDocument2, Doc)); 

    // Clear the window if neccessary. 
    If FClear then 
      Doc.close; 

    // Create the array and copy the string list into it. 
    v := VarArrayCreate([0, AStrings.Count - 1], varVariant); 

    for i := 0 to AStrings.Count - 1 do begin
      If (i = AStrings.Count - 1) and FLineBreak then 
        v[i] := AStrings[i] + sLineBreakStr 
      else 
        v[i] := AStrings[i]; 
    end;
    // Send the data. 
    Doc.write(PSafeArray(TVarData(v).VArray));
    if FScroll2End then begin
      FBrowser.SetFocus;
      SendMessage(FBrowser.Handle,WM_KEYDOWN,VK_CONTROL,0);
      SendMessage(FBrowser.Handle,WM_KEYDOWN,VK_END,0);
      SendMessage(FBrowser.Handle,WM_KEYUP,VK_END,0);
      SendMessage(FBrowser.Handle,WM_KEYUP,VK_CONTROL,0);
      (*
      FBrowser.Perform(WM_KEYDOWN,VK_CONTROL,0);
      FBrowser.Perform(WM_KEYDOWN,VK_END,0);
      FBrowser.Perform(WM_KEYUP,VK_END,0);
      FBrowser.Perform(WM_KEYUP,VK_CONTROL,0);
      *)
    end;
      //doc.parentWindow.scrollBy(0,doc.parentWindow.screen.height);
      //FBrowser.Perform(WM_VSCROLL,SB_ENDSCROLL,0);
      //doc.parentWindow.scrollBy(0,10000); 
  finally 
    // free the array and release the interface pointer. 
    v := Unassigned; 
    Doc := Nil; 
  end; 
end; 

Destructor TWebHelper.Destroy; 
begin 
  // we do _NOT_ free the browser. this is the VCL's job guy! 
  FBrowser := Nil; 
  // But the CS is ours... 
  FSave.Free; 
  Inherited Destroy; 
end; 

end. 

// GREETZ!

Ich habs jetzt schon mit senden von Tastatur eingaben versucht, oder mit scrollby des Dokuments alles hilft nicht 100%.

Jemand noch ne Idee ?

[DataCool]

Hi,

Lösung mit Hilfes des Authors der Unit gefunden !

Für alle die es interessiert :

Code:

Unit WebHelper;

{
  Unit: WebHelper

  Developer: ase, nsX-gteX

  Compiler: Delphi, v7.0 Build 4453

  Date: 07.05.2003  19:00 --> 08.05.2003  00:15

  Classes: TWebHelper -> This class provides capabilities to add HTML text
                         to a TWebBrowser component without creating temprary
                         files or stuff.

                         Usage: See implementation part.

  Comments: Have fun with it!

  License: No license. Use it or leave it. My name in your copyright is not
           required. A copy of your program would be nice but although, is not
           required.
}

Interface

  Uses Classes, ComObj, MSHTML, SHDocVw, Variants, SyncObjs;

  Type TWebHelper = Class;

       TWebHelper = Class(TInterfacedObject)
                      Private
                        FBrowser: TWebBrowser;
                        FIsReady: WordBool;
                        FClear: WordBool;
                        FSave: TCriticalSection;
                        FLineBreak: WordBool;

                        Function Get_CanPost: WordBool;
                      Protected
                        Procedure Event_DocumentComplete(Sender: TObject;
                          Const pDisp: IDispatch; Var URL: OleVariant);
                        Procedure ScrollDown();
                      Public
                        Constructor Create(ABrowser: TWebBrowser);
                        Destructor Destroy; Override;

                        Procedure LoadFromStrings(AStrings: TStrings);
                        Procedure WriteOneString(Const Msg: WideString);

                        Property WebBrowser: TWebBrowser read FBrowser;
                        Property CanPost: WordBool read Get_CanPost;
                        Property ClearBeforePost: WordBool read FClear write FClear;
                        Property LineBreak: WordBool read FLineBreak write FLineBreak;
                    End;

Implementation

Uses SysUtils, ActiveX;

ResourceString sLineBreakStr = '
';
               sNotReady = 'Cannot display HTML code yet. Control not initialized.';
               sAboutBlank = 'about:blank';

{
  TWebHelper - Usage


  Property WebBrowser: Read-Only. Returns the TWebBrowser component, TWebHelper
                       actually controlls. You specify this control in the
                       constructor of TWebHelper.

  Property CanPost:    TWebHelper needs to initialize the TWebBrowser control.
                       This initialization step is done ASYNCHRONOUSLY by the
                       control itself. If done, the control will notify TWebHelper
                       and from there you will be able to post data. If you try
                       to post data wheater TWebHelper is not ready, an exception
                       is raised. The property getter is thread safe.

  Property ClearBeforePost:
                       Determined if TWebHelper should clear the browser control
                       before adding new data. If FALSE, the new data is simply
                       added to the browser control.

  Property LineBreak:  If TRUE, TWebHelper will add a 
 (sLineBreakStr) to
                       every post.

  Procedure LoadFromStrings(AStrings: TStrings)
                       This method will add the strings in AStrings to the
                       browser control. If CanPost is FALSE, an exception is raised.
                       Always encapsulate this call in a Try..Except block!
                       The method does _not_ handle exceptions. The AStrings
                       parameter will be handled as read-only an will not be
                       changed.

  Procedure WriteOneString(Const Msg: WideString)
                       With that nice trick you can add a single line to the
                       Browser control. Usefull for administrator messages.
                       If CanPost is FALSE, an exception is raised.
                       Always encapsulate this call in a Try..Except block!
                       The method does _not_ handle exceptions.
}

Constructor TWebHelper.Create(ABrowser: TWebBrowser);
Var v: OleVariant;
Begin
  Inherited Create;
  // private initialization...
  FIsReady := False;
  FSave := TCriticalSection.Create;
  FClear := False;
  FLineBreak := True;

  // Init the browser. We need to do this step to prevent the browser from
  // setting FBrowser.Document to NIL. We need the document property. The browser
  // will initialize it only if he has a valid document. 'ABOUT:BLANK' is valid.
  // Search www.msdn.micro$oft.com for more details.

  FBrowser := ABrowser;
  FBrowser.OnDocumentComplete := Event_DocumentComplete;
  v := sAboutBlank;
  FBrowser.Navigate2(v);
End;

Procedure TWebHelper.Event_DocumentComplete(Sender: TObject; Const pDisp: IDispatch;
  Var URL: OleVariant);
Begin
  // Browser calls us that he has finished his initialization. Fine!
  Try
    FSave.Enter;

    FIsReady := True;
  Finally
    FSave.Leave;
  End;
End;

Procedure TWebHelper.WriteOneString(Const Msg: WideString);
Var Doc: IHTMLDocument2;
    v: OleVariant;
Begin
  // Are we ready?
  If not CanPost then
    Raise Exception.Create(sNotReady);

  Try
    // Get the Document interface.
    OleCheck(FBrowser.DefaultInterface.Document.QueryInterface(IHTMLDocument2, Doc));

    // Do we have to clear the page?
    If FClear then
      Doc.close;

    // Create the array with only one element. Attention: varOleStr does not work.
    // Only God knows why because it should: MSDN.
    v := VarArrayCreate([0, 0], varVariant);

    If FLineBreak then
      v[0] := Msg + sLineBreakStr
        Else
      v[0] := Msg;

    // Send the data to the browser.
    Doc.write(PSafeArray(TVarData(v).VArray));

    ScrollDown();
  Finally
    // clear the array and release the document.
    v := Unassigned;
    Doc := Nil;
  End;
End;

Function TWebHelper.Get_CanPost: WordBool;
Begin
  Try
    // Thread save.
    FSave.Enter;

    Result := FIsReady;
  Finally
    FSave.Leave;
  End;
End;

Procedure TWebHelper.LoadFromStrings(AStrings: TStrings);
Var Doc: IHTMLDocument2;
    v: OleVariant;
    i: Integer;
Begin
  // Are we ready?
  If not CanPost then
    Raise Exception.Create(sNotReady);

  Try
    // Get document interface
    OleCheck(FBrowser.DefaultInterface.Document.QueryInterface(IHTMLDocument2, Doc));

    // Clear the window if neccessary.
    If FClear then
      Doc.close;

    // Create the array and copy the string list into it.
    v := VarArrayCreate([0, AStrings.Count - 1], varVariant);

    For i := 0 to AStrings.Count - 1 do
      If (i = AStrings.Count - 1) and FLineBreak then
        v[i] := AStrings[i] + sLineBreakStr
          Else
        v[i] := AStrings[i];

    // Send the data.
    Doc.write(PSafeArray(TVarData(v).VArray));
    doc.close;

    ScrollDown();
  Finally
    // free the array and release the interface pointer.
    v := Unassigned;
    Doc := Nil;
  End;
End;

Procedure TWebHelper.ScrollDown();
Var doc: IHTMLDocument2;
Begin
  // Are we ready?
  If not CanPost then
    Raise Exception.Create(sNotReady);

  Try
    // Get document interface
    OleCheck(FBrowser.DefaultInterface.Document.QueryInterface(IHTMLDocument2, Doc));

    Doc.parentWindow.scroll(0, 0);
    Doc.parentWindow.scroll(0, MaxInt);
  Finally
    Doc := Nil;
  End;
End;

Destructor TWebHelper.Destroy;
Begin
  // we do _NOT_ free the browser. this is the VCL's job guy!
  FBrowser := Nil;
  // But the CS is ours...
  FSave.Free;
  Inherited Destroy;
End;

End.

// GREETZ!