1:

  WebBrowser1.Navigate('about:XXX');					

1:

(WebBrowser1.Document as IHTMLDocument2).Write{Ln}					

1:
2:

  If not Supports(WebBrowser1.Document, IHTMLDocument2) then
    ShowMessage('Geht nich!');					

1:
2:

if supports(WebChat.Document, IHTMLDocument2) then
  (WebChat.Document as IHTMLDocument2).Write(strLChat.text);					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:

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);
                      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 = '<br>';
               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 <br> (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));
  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));
  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!