| 1 | //*************************************************************
 | 
|---|
| 2 | //                        EwbEvents                           *
 | 
|---|
| 3 | //                                                            *
 | 
|---|
| 4 | //                     Freeware Unit                          *
 | 
|---|
| 5 | //                       For Delphi                           *
 | 
|---|
| 6 | //                            by                              *
 | 
|---|
| 7 | //                     Serge Voloshenyuk                      *
 | 
|---|
| 8 | //      Developing Team:                                      *
 | 
|---|
| 9 | //          Serge Voloshenyuk (SergeV@bsalsa.com)             *
 | 
|---|
| 10 | //          Eran Bodankin (bsalsa) -(bsalsa@gmail.com)       *
 | 
|---|
| 11 | //                                                            *
 | 
|---|
| 12 | //       Documentation and updated versions:                  *
 | 
|---|
| 13 | //                                                            *
 | 
|---|
| 14 | //               http://www.bsalsa.com                        *
 | 
|---|
| 15 | //*************************************************************
 | 
|---|
| 16 | {LICENSE:
 | 
|---|
| 17 | THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
 | 
|---|
| 18 | EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
 | 
|---|
| 19 | WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
 | 
|---|
| 20 | YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
 | 
|---|
| 21 | AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
 | 
|---|
| 22 | AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
 | 
|---|
| 23 | OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
 | 
|---|
| 24 | OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
 | 
|---|
| 25 | INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
 | 
|---|
| 26 | OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
 | 
|---|
| 27 | AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
 | 
|---|
| 28 | DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
 | 
|---|
| 29 | 
 | 
|---|
| 30 | You may use/ change/ modify the component under 3 conditions:
 | 
|---|
| 31 | 1. In your website, add a link to "http://www.bsalsa.com"
 | 
|---|
| 32 | 2. In your application, add credits to "Embedded Web Browser"
 | 
|---|
| 33 | 3. Mail me  (bsalsa@gmail.com) any code change in the unit  for the benefit
 | 
|---|
| 34 |    of the other users.
 | 
|---|
| 35 | 4. Please, consider donation in our web site!
 | 
|---|
| 36 | {*******************************************************************************}
 | 
|---|
| 37 | //$Id: EwbEvents.pas,v 1.1.2.1 2006/11/29 22:13:01 sergev Exp $
 | 
|---|
| 38 | 
 | 
|---|
| 39 | unit EwbEvents;
 | 
|---|
| 40 | 
 | 
|---|
| 41 | interface
 | 
|---|
| 42 | 
 | 
|---|
| 43 | {$I EWB.inc}
 | 
|---|
| 44 | 
 | 
|---|
| 45 | uses
 | 
|---|
| 46 | 
 | 
|---|
| 47 |   Windows, Classes, ActiveX, Mshtml_Ewb, EwbClasses, wbhFixes;
 | 
|---|
| 48 | 
 | 
|---|
| 49 | type
 | 
|---|
| 50 |   TSinkKind = (
 | 
|---|
| 51 |     skElement,
 | 
|---|
| 52 |     skLink,
 | 
|---|
| 53 |     skForm,
 | 
|---|
| 54 |     skControl,
 | 
|---|
| 55 |     skTextContainer,
 | 
|---|
| 56 |     skImg,
 | 
|---|
| 57 |     skAnchor,
 | 
|---|
| 58 |     skLabel,
 | 
|---|
| 59 |     skSelect,
 | 
|---|
| 60 |     skButton,
 | 
|---|
| 61 |     skInputText,
 | 
|---|
| 62 |     skOptionButton,
 | 
|---|
| 63 |     skInputFile,
 | 
|---|
| 64 |     skInputImage,
 | 
|---|
| 65 |     skMarquee,
 | 
|---|
| 66 |     skWindow,
 | 
|---|
| 67 |     skDocument,
 | 
|---|
| 68 |     skMap,
 | 
|---|
| 69 |     skArea,
 | 
|---|
| 70 |     skTable,
 | 
|---|
| 71 |     skScript,
 | 
|---|
| 72 |     skObject,
 | 
|---|
| 73 |     skFrameSite,
 | 
|---|
| 74 |     skStyle,
 | 
|---|
| 75 |     skNamespace
 | 
|---|
| 76 |     );
 | 
|---|
| 77 | 
 | 
|---|
| 78 |   TEventID = Integer;
 | 
|---|
| 79 | const
 | 
|---|
| 80 |   heOnAbort = 1000;
 | 
|---|
| 81 |   heOnChange = 1001; //f
 | 
|---|
| 82 |   heOnError = 1002;
 | 
|---|
| 83 |   // HTMLWindowEvents2.onerror(const description: WideString; const url: WideString; line: Integer); dispid 1002;
 | 
|---|
| 84 |   heOnLoad = 1003;
 | 
|---|
| 85 |   heOnSelect = 1006;
 | 
|---|
| 86 |   heOnSubmit = 1007; //f
 | 
|---|
| 87 |   heOnUnload = 1008;
 | 
|---|
| 88 |   heOnBounce = 1009;
 | 
|---|
| 89 |   heOnFinish = 1010;
 | 
|---|
| 90 |   heOnStart = 1011;
 | 
|---|
| 91 |   heOnScroll = 1014;
 | 
|---|
| 92 |   heOnReset = 1015; //f
 | 
|---|
| 93 |   heOnresize = 1016;
 | 
|---|
| 94 |   heOnBeforeUnload = 1017;
 | 
|---|
| 95 |   heOncontextmenu = 1023; //f
 | 
|---|
| 96 |   heOnBeforePrint = 1024;
 | 
|---|
| 97 |   heOnAfterPrint = 1025;
 | 
|---|
| 98 |   heOnStop = 1026; //f
 | 
|---|
| 99 |   heOnBeforeEditFocus = 1027;
 | 
|---|
| 100 |   heOnlayoutcomplete = 1030;
 | 
|---|
| 101 |   heOnPage = 1031;
 | 
|---|
| 102 |   heOnMousewheel = 1033; //f
 | 
|---|
| 103 |   heOnBeforeDeactivate = 1034; //f
 | 
|---|
| 104 |   heOnMove = 1035;
 | 
|---|
| 105 |   heOnControlSelect = 1036; //f
 | 
|---|
| 106 |   heOnSelectionChange = 1037;
 | 
|---|
| 107 |   heOnMoveStart = 1038; //f
 | 
|---|
| 108 |   heOnMoveEnd = 1039;
 | 
|---|
| 109 |   heOnResizeStart = 1040; //f
 | 
|---|
| 110 |   heOnResizeEnd = 1041;
 | 
|---|
| 111 |   heOnMouseEnter = 1042;
 | 
|---|
| 112 |   heOnMouseLeave = 1043;
 | 
|---|
| 113 |   heOnActivate = 1044;
 | 
|---|
| 114 |   heOnDeactivate = 1045;
 | 
|---|
| 115 |   heOnBeforeActivate = 1047; //f
 | 
|---|
| 116 |   heOnfocusIn = 1048;
 | 
|---|
| 117 |   heOnfocusOut = 1049;
 | 
|---|
| 118 | 
 | 
|---|
| 119 |   heOnClick = -600; //f
 | 
|---|
| 120 |   heOnDblClick = -601; //f
 | 
|---|
| 121 |   heOnKeyDown = -602;
 | 
|---|
| 122 |   heOnKeyPress = -603; //f
 | 
|---|
| 123 |   heOnKeyUp = -604;
 | 
|---|
| 124 |   heOnMouseDown = -605;
 | 
|---|
| 125 |   heOnMouseMove = -606;
 | 
|---|
| 126 |   heOnMouseUp = -607;
 | 
|---|
| 127 |   heOnReadyStateChange = -609;
 | 
|---|
| 128 | 
 | 
|---|
| 129 |   heOnCellChange = -2147418078;
 | 
|---|
| 130 |   heOnRowsInserted = -2147418079;
 | 
|---|
| 131 |   heOnRowsDelete = -2147418080;
 | 
|---|
| 132 |   heOnBeforePaste = -2147418081; //f
 | 
|---|
| 133 |   heOnBeforeCopy = -2147418082; //f
 | 
|---|
| 134 |   heOnBeforeCut = -2147418083; //f
 | 
|---|
| 135 |   heOnPaste = -2147418084; //f
 | 
|---|
| 136 |   heOnCopy = -2147418085; //f
 | 
|---|
| 137 |   heOnCut = -2147418086; //f
 | 
|---|
| 138 |   heOnDrop = -2147418087; //f
 | 
|---|
| 139 |   heOnDragLeave = -2147418088;
 | 
|---|
| 140 |   heOnDragOver = -2147418089; //f
 | 
|---|
| 141 |   heOnDragEnter = -2147418090; //f
 | 
|---|
| 142 |   heOnDragEnd = -2147418091;
 | 
|---|
| 143 |   heOnDrag = -2147418092; //f
 | 
|---|
| 144 |   //  heOnObjReadyStateChange  = -2147418092; //HTMLObjectElementEvents2
 | 
|---|
| 145 |   heOnPropertyChange = -2147418093;
 | 
|---|
| 146 |   //  heOnObjError        = -2147418093; //f HTMLObjectElementEvents2
 | 
|---|
| 147 |   heOnLoseCapture = -2147418094;
 | 
|---|
| 148 |   heOnFilterChange = -2147418095;
 | 
|---|
| 149 |   heOnDatasetComplete = -2147418096;
 | 
|---|
| 150 |   heOnDataAvailable = -2147418097;
 | 
|---|
| 151 |   heOnDatasetChanged = -2147418098;
 | 
|---|
| 152 |   heOnErrorUpdate = -2147418099; //f
 | 
|---|
| 153 |   heOnSelectStart = -2147418100; //f
 | 
|---|
| 154 |   heOnDragStart = -2147418101; //f
 | 
|---|
| 155 |   heOnHelp = -2147418102; //f
 | 
|---|
| 156 |   heOnMouseOut = -2147418103;
 | 
|---|
| 157 |   heOnMouseOver = -2147418104;
 | 
|---|
| 158 |   heOnRowEnter = -2147418105;
 | 
|---|
| 159 |   heOnRowExit = -2147418106; //f
 | 
|---|
| 160 |   heOnAfterUpdate = -2147418107;
 | 
|---|
| 161 |   heOnBeforeUpdate = -2147418108; //f
 | 
|---|
| 162 |   heOnFocus = -2147418111;
 | 
|---|
| 163 |   heOnBlur = -2147418112;
 | 
|---|
| 164 | 
 | 
|---|
| 165 | type
 | 
|---|
| 166 |   IHubLink = interface
 | 
|---|
| 167 |     ['{EC22D916-CC24-4D88-A7ED-20C5E9AE0852}']
 | 
|---|
| 168 |     procedure Disconnect;
 | 
|---|
| 169 |   end;
 | 
|---|
| 170 | 
 | 
|---|
| 171 |   TMshtmlHandler = function(Sender: IUnknown): Boolean of object;
 | 
|---|
| 172 | 
 | 
|---|
| 173 |   TMSHTMLEventHandler = class(TInterfacedDispatchObject, IDispatchEx)
 | 
|---|
| 174 |   private
 | 
|---|
| 175 |     FHandler: TMshtmlHandler;
 | 
|---|
| 176 |   protected
 | 
|---|
| 177 |     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
 | 
|---|
| 178 |       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
 | 
|---|
| 179 |       override; stdcall;
 | 
|---|
| 180 |     {IDispatchEx}
 | 
|---|
| 181 |     function GetDispID(const bstrName: TBSTR; const grfdex: DWORD;
 | 
|---|
| 182 |       out id: TDispID): HResult; stdcall;
 | 
|---|
| 183 |     function InvokeEx(const id: TDispID; const lcid: LCID; const wflags:
 | 
|---|
| 184 |       WORD; const pdp: PDispParams; out varRes: OleVariant; out pei:
 | 
|---|
| 185 |       TExcepInfo; const pspCaller: PServiceProvider): HResult; stdcall;
 | 
|---|
| 186 |     function DeleteMemberByName(const bstr: TBSTR;
 | 
|---|
| 187 |       const grfdex: DWORD): HResult; stdcall;
 | 
|---|
| 188 |     function DeleteMemberByDispID(const id: TDispID): HResult; stdcall;
 | 
|---|
| 189 |     function GetMemberProperties(const id: TDispID; const grfdexFetch:
 | 
|---|
| 190 |       DWORD; out grfdex: DWORD): HResult; stdcall;
 | 
|---|
| 191 |     function GetMemberName(const id: TDispID; out bstrName: TBSTR):
 | 
|---|
| 192 |       HResult; stdcall;
 | 
|---|
| 193 |     function GetNextDispID(const grfdex: DWORD; const id: TDispID;
 | 
|---|
| 194 |       out nid: TDispID): HResult; stdcall;
 | 
|---|
| 195 |     function GetNameSpaceParent(out unk: IUnknown): HResult; stdcall;
 | 
|---|
| 196 |   public
 | 
|---|
| 197 |     constructor Create(Handler: TMshtmlHandler);
 | 
|---|
| 198 |     destructor Destroy; override;
 | 
|---|
| 199 |   end;
 | 
|---|
| 200 | 
 | 
|---|
| 201 | function MSHTMLEventHandler(Handler: TMshtmlHandler): IDispatchEx;
 | 
|---|
| 202 | const
 | 
|---|
| 203 |   mshtmlEventGUIDs: array[TSinkKind] of PGUID = (
 | 
|---|
| 204 |     @DIID_HTMLElementEvents2, //IHTMLElement
 | 
|---|
| 205 |     @DIID_HTMLLinkElementEvents2, //IHTMLLinkElement
 | 
|---|
| 206 |     @DIID_HTMLFormElementEvents2, //IHTMLFormElement
 | 
|---|
| 207 |     @DIID_HTMLControlElementEvents2, //IHTMLControlElement
 | 
|---|
| 208 |     @DIID_HTMLTextContainerEvents2, //IHTMLTextContainer
 | 
|---|
| 209 |     @DIID_HTMLImgEvents2, //IHTMLImgElement
 | 
|---|
| 210 |     @DIID_HTMLAnchorEvents2, //IHTMLAnchorElement
 | 
|---|
| 211 |     @DIID_HTMLLabelEvents2, //IHTMLLabelElement
 | 
|---|
| 212 |     @DIID_HTMLSelectElementEvents2, //IHTMLSelectElement
 | 
|---|
| 213 |     @DIID_HTMLButtonElementEvents2, //IHTMLButtonElement
 | 
|---|
| 214 |     @DIID_HTMLInputTextElementEvents2, //IHTMLInputTextElement
 | 
|---|
| 215 |     @DIID_HTMLOptionButtonElementEvents2, //IHTMLOptionButtonElement
 | 
|---|
| 216 |     @DIID_HTMLInputFileElementEvents2, //IHTMLInputFileElement
 | 
|---|
| 217 |     @DIID_HTMLInputImageEvents2, //IHTMLInputImage
 | 
|---|
| 218 |     @DIID_HTMLMarqueeElementEvents2, //IHTMLMarqueeElement
 | 
|---|
| 219 |     @DIID_HTMLWindowEvents2, //IHTMLWindow2
 | 
|---|
| 220 |     @DIID_HTMLDocumentEvents2, //IHTMLDocument
 | 
|---|
| 221 |     @DIID_HTMLMapEvents2, //IHTMLMapElement
 | 
|---|
| 222 |     @DIID_HTMLAreaEvents2, //IHTMLAreaElement
 | 
|---|
| 223 |     @DIID_HTMLTableEvents2, //IHTMLTable
 | 
|---|
| 224 |     @DIID_HTMLScriptEvents2, //IHTMLScriptElement
 | 
|---|
| 225 |     @DIID_HTMLObjectElementEvents2, //IHTMLObjectElement
 | 
|---|
| 226 |     @DIID_HTMLFrameSiteEvents2,
 | 
|---|
| 227 |     @DIID_HTMLStyleElementEvents2, //IHTMLStyleElement
 | 
|---|
| 228 |     @DIID_HTMLNamespaceEvents //IHTMLNamespace
 | 
|---|
| 229 |     );
 | 
|---|
| 230 | 
 | 
|---|
| 231 | implementation
 | 
|---|
| 232 | uses SysUtils;
 | 
|---|
| 233 | 
 | 
|---|
| 234 | { TMSHTMLEventHandler }
 | 
|---|
| 235 | 
 | 
|---|
| 236 | function MSHTMLEventHandler(Handler: TMshtmlHandler): IDispatchEx;
 | 
|---|
| 237 | begin
 | 
|---|
| 238 |   Result := TMSHTMLEventHandler.Create(Handler) as IDispatchEx;
 | 
|---|
| 239 | end;
 | 
|---|
| 240 | 
 | 
|---|
| 241 | constructor TMSHTMLEventHandler.Create(Handler: TMshtmlHandler);
 | 
|---|
| 242 | begin
 | 
|---|
| 243 |   inherited Create;
 | 
|---|
| 244 |   FHandler := Handler;
 | 
|---|
| 245 | end;
 | 
|---|
| 246 | 
 | 
|---|
| 247 | destructor TMSHTMLEventHandler.Destroy;
 | 
|---|
| 248 | begin
 | 
|---|
| 249 |   inherited;
 | 
|---|
| 250 | end;
 | 
|---|
| 251 | 
 | 
|---|
| 252 | function TMSHTMLEventHandler.DeleteMemberByDispID(const id: TDispID): HResult;
 | 
|---|
| 253 | begin
 | 
|---|
| 254 |   Result := S_FALSE;
 | 
|---|
| 255 | end;
 | 
|---|
| 256 | 
 | 
|---|
| 257 | function TMSHTMLEventHandler.DeleteMemberByName(const bstr: TBSTR;
 | 
|---|
| 258 |   const grfdex: DWORD): HResult;
 | 
|---|
| 259 | begin
 | 
|---|
| 260 |   Result := S_FALSE;
 | 
|---|
| 261 | end;
 | 
|---|
| 262 | 
 | 
|---|
| 263 | function TMSHTMLEventHandler.GetDispID(const bstrName: TBSTR;
 | 
|---|
| 264 |   const grfdex: DWORD; out id: TDispID): HResult;
 | 
|---|
| 265 | begin
 | 
|---|
| 266 |   Result := DISP_E_UNKNOWNNAME;
 | 
|---|
| 267 | end;
 | 
|---|
| 268 | 
 | 
|---|
| 269 | function TMSHTMLEventHandler.GetMemberName(const id: TDispID;
 | 
|---|
| 270 |   out bstrName: TBSTR): HResult;
 | 
|---|
| 271 | begin
 | 
|---|
| 272 |   Result := DISP_E_UNKNOWNNAME;
 | 
|---|
| 273 | end;
 | 
|---|
| 274 | 
 | 
|---|
| 275 | function TMSHTMLEventHandler.GetMemberProperties(const id: TDispID;
 | 
|---|
| 276 |   const grfdexFetch: DWORD; out grfdex: DWORD): HResult;
 | 
|---|
| 277 | begin
 | 
|---|
| 278 |   Result := DISP_E_UNKNOWNNAME;
 | 
|---|
| 279 | end;
 | 
|---|
| 280 | 
 | 
|---|
| 281 | function TMSHTMLEventHandler.GetNameSpaceParent(
 | 
|---|
| 282 |   out unk: IUnknown): HResult;
 | 
|---|
| 283 | begin
 | 
|---|
| 284 |   Result := E_NOTIMPL;
 | 
|---|
| 285 | end;
 | 
|---|
| 286 | 
 | 
|---|
| 287 | function TMSHTMLEventHandler.GetNextDispID(const grfdex: DWORD;
 | 
|---|
| 288 |   const id: TDispID; out nid: TDispID): HResult;
 | 
|---|
| 289 | begin
 | 
|---|
| 290 |   Result := S_FALSE;
 | 
|---|
| 291 | end;
 | 
|---|
| 292 | 
 | 
|---|
| 293 | function TMSHTMLEventHandler.Invoke(DispID: Integer; const IID: TGUID;
 | 
|---|
| 294 |   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 | 
|---|
| 295 |   ArgErr: Pointer): HResult;
 | 
|---|
| 296 | var
 | 
|---|
| 297 |   Instance: IUnknown;
 | 
|---|
| 298 |   R: Boolean;
 | 
|---|
| 299 | begin
 | 
|---|
| 300 |   Result := S_OK;
 | 
|---|
| 301 |   if (Flags and DISPATCH_METHOD = 0) then Exit;
 | 
|---|
| 302 |   try
 | 
|---|
| 303 |     Instance := POleVariant(TDispParams(Params).rgvarg)^;
 | 
|---|
| 304 |     R := FHandler(Instance);
 | 
|---|
| 305 |     if VarResult <> nil then
 | 
|---|
| 306 |       POleVariant(VarResult)^ := R;
 | 
|---|
| 307 |   except
 | 
|---|
| 308 |     on E: Exception do
 | 
|---|
| 309 |     begin
 | 
|---|
| 310 |       Result := DISP_E_EXCEPTION;
 | 
|---|
| 311 |       with PExcepInfo(ExcepInfo)^ do
 | 
|---|
| 312 |       begin
 | 
|---|
| 313 |         wCode := 9999;
 | 
|---|
| 314 |         bstrDescription := E.Message;
 | 
|---|
| 315 |         bstrSource := E.ClassName;
 | 
|---|
| 316 |         dwHelpContext := E.HelpContext;
 | 
|---|
| 317 |       end;
 | 
|---|
| 318 |     end;
 | 
|---|
| 319 |   end;
 | 
|---|
| 320 | end;
 | 
|---|
| 321 | 
 | 
|---|
| 322 | 
 | 
|---|
| 323 | function TMSHTMLEventHandler.InvokeEx(const id: TDispID; const lcid: LCID;
 | 
|---|
| 324 |   const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant;
 | 
|---|
| 325 |   out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult;
 | 
|---|
| 326 | var
 | 
|---|
| 327 |   Instance: IUnknown;
 | 
|---|
| 328 | begin
 | 
|---|
| 329 |   Result := S_OK;
 | 
|---|
| 330 |   if (wflags and DISPATCH_METHOD = 0) then Exit;
 | 
|---|
| 331 |   try
 | 
|---|
| 332 |     Instance := POleVariant(pdp.rgvarg)^;
 | 
|---|
| 333 |     varRes := FHandler(Instance);
 | 
|---|
| 334 |   except
 | 
|---|
| 335 |     on E: Exception do
 | 
|---|
| 336 |     begin
 | 
|---|
| 337 |       Result := DISP_E_EXCEPTION;
 | 
|---|
| 338 |       with pei do
 | 
|---|
| 339 |       begin
 | 
|---|
| 340 |         wCode := 9999;
 | 
|---|
| 341 |         bstrDescription := E.Message;
 | 
|---|
| 342 |         bstrSource := E.ClassName;
 | 
|---|
| 343 |         dwHelpContext := E.HelpContext;
 | 
|---|
| 344 |       end;
 | 
|---|
| 345 |     end;
 | 
|---|
| 346 |   end;
 | 
|---|
| 347 | end;
 | 
|---|
| 348 | 
 | 
|---|
| 349 | end.
 | 
|---|