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:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:

Unit helper;

 
{  
  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!					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

tSAFEARRAYBOUND = record
    cElements:LongInt;
    lLbound:LongInt;
  end;

  PSafeArray = ^TSafeArray;
  {$EXTERNALSYM tagSAFEARRAY}
  tagSAFEARRAY = record
    cDims: Word;
    fFeatures: Word;
    cbElements: Longint;
    cLocks: Longint;
    pvData: Pointer;
    rgsabound: array[0..0] of TSafeArrayBound;
  end;
  TSafeArray = tagSAFEARRAY;
  {$EXTERNALSYM SAFEARRAY}
  SAFEARRAY = TSafeArray;