home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / INFO / DI9802TS.ZIP / ScriptSite.pas < prev    next >
Pascal/Delphi Source File  |  1997-08-27  |  5KB  |  156 lines
  1. { This implements the required IActiveScriptSite Interface }
  2. unit ScriptSite;
  3.  
  4. interface
  5.  
  6. Uses Windows, SysUtils, comobj, activeX, Activscp, Dialogs, Forms, ComServ,
  7.      Demo_TLB;
  8.  
  9. Type
  10.   { TActiveScriptSite Declaration }
  11.   TActiveScriptSite = class(TComObject, IActiveScriptSite,
  12.                             IActiveScriptSiteWindow)
  13.   protected
  14.     { IActiveScriptSite }
  15.     function GetLCID(var wLCID: TLCID): HResult;  virtual; stdcall;
  16.     function GetDocVersionString(var VersionString: TBSTR): HResult;  virtual; stdcall;
  17.     function GetItemInfo(ItemName: WideString; dwReturnMask: DWord;
  18.       out UnkItem: IUnknown; out TypeInfo: ITypeInfo): HResult;  virtual; stdcall;
  19.     function OnScriptTerminate(var VarResult: OleVariant;
  20.       var ExcepInfo: TExcepInfo): HResult;  virtual; stdcall;
  21.     function OnStateChange(ScriptState: LongInt): HResult;  virtual; stdcall;
  22.     function OnScriptError(pAse: IActiveScriptError): HResult;  virtual; stdcall;
  23.     function OnEnterScript: HResult;  virtual; stdcall;
  24.     function OnLeaveScript: HResult;  virtual; stdcall;
  25.     { IActiveScriptSiteWindow }
  26.     function GetWindow(var Hwnd: THandle): HResult; stdcall;
  27.     function EnableModeless(FEnable: WordBool): HResult; stdcall;
  28.   end;
  29.  
  30. implementation
  31.  
  32. { TActiveScriptSite - Protected Implementation }
  33.  
  34. function TActiveScriptSite.GetLCID(var wLCID: TLCID): HResult;
  35. begin
  36.   {  No need for us to do anything here. }
  37.   Result := S_OK;
  38. end;
  39.  
  40.  
  41. function TActiveScriptSite.GetItemInfo(ItemName: WideString; dwReturnMask: DWord;
  42.    out UnkItem: IUnknown; out TypeInfo: ITypeInfo): HResult;
  43. var
  44.   ObjDispatch : IDispatch;
  45. begin
  46.   { This method is called when the engine wants information about an object
  47.     that we submitted by calling AddNamedItem.  Using Delphi 3, the instances
  48.     created here will free when they go out of context. }
  49.  
  50.   { Does the engine want the Automation Object's IUnknown Pointer? }
  51.   if (dwReturnMask = SCRIPTINFO_IUNKNOWN) and (ItemName = 'MyObj') then
  52.     UnkItem := CoMyObj.Create;
  53.  
  54.   { Does the engine want the Automation Object's type information? }
  55.   if (dwReturnMask = SCRIPTINFO_ITYPEINFO) and (ItemName = 'MyObj') then
  56.   begin
  57.     ObjDispatch := CoMyObj.Create;
  58.  
  59.     { Get a handle to our Automation Object's Type Library }
  60.     ObjDispatch.GetTypeInfo(0,0,TypeInfo);
  61.   end;
  62.  
  63.   Result := S_OK;
  64. end;
  65.  
  66.  
  67. function TActiveScriptSite.GetDocVersionString(var VersionString: TBSTR): HResult;
  68. begin
  69.   { Tell engine that we will accept it's default. ie. not implemented }
  70.   Result := E_NOTIMPL;
  71. end;
  72.  
  73.  
  74. function TActiveScriptSite.OnScriptTerminate(var VarResult: OleVariant;
  75.    var ExcepInfo: TExcepInfo): HResult;
  76. begin
  77.   {  This tells us that the script is completed }
  78.   Result := S_OK;
  79. end;
  80.  
  81.  
  82. function TActiveScriptSite.OnStateChange(ScriptState: LongInt): HResult;
  83. begin
  84.   { Alerts us when engine states are changing }
  85.   Result := S_OK;
  86. end;
  87.  
  88.  
  89. function TActiveScriptSite.OnScriptError(pAse: IActiveScriptError): HResult;
  90. var
  91.   wCookie:      Word;
  92.   ErrString:    String;
  93.   ExcepInfo:    TExcepInfo;
  94.   CharNo:       LongInt;
  95.   LineNo:       LongInt;
  96. begin
  97.  
  98.   wCookie := 0;
  99.   LineNo  := 0;
  100.   CharNo  := 0;
  101.  
  102.   if Assigned(pAse) then begin
  103.     pAse.GetExceptionInfo(ExcepInfo);
  104.     pAse.GetSourcePosition(wCookie, LineNo, CharNo);
  105.  
  106.     ErrString := concat(ExcepInfo.bstrSource, ' ',
  107.                         ExcepInfo.bstrDescription, ' ',
  108.                         'Line ', intToStr(LineNo),
  109.                         '. Column ', intToStr(CharNo));
  110.  
  111.     ShowMessage(ErrString);
  112.   end;
  113.  
  114.   pase := nil;
  115.   result := E_FAIL;     {  Halt script execution! }
  116.  
  117. end;
  118.  
  119.  
  120. function TActiveScriptSite.OnEnterScript(): HResult;
  121. begin
  122.   Result := S_OK;
  123. end;
  124.  
  125.  
  126. function TActiveScriptSite.OnLeaveScript(): HResult;
  127. begin
  128.   Result := S_OK;
  129. end;
  130.  
  131. { IActiveScriptSite Window Implementation }
  132.  
  133. function TActiveScriptSite.GetWindow(var Hwnd: THandle): HResult;
  134. begin
  135.   { ActiveX Scripting uses this to get a window handle from our application.
  136.     This allows the script engine to display information on the interface, such
  137.     as a dialog box.}
  138.  
  139.   Hwnd := Application.Handle;
  140.   Result := S_OK;
  141. end;
  142.  
  143.  
  144. function TActiveScriptSite.EnableModeless(FEnable: WordBool): HResult;
  145. begin
  146.   { Causes the host to enable or disable its main window as well as any
  147.    modeless dialog boxes.  We won't need this for our demo }
  148.   Result := S_OK;
  149. end;
  150.  
  151.  
  152. Initialization
  153.   TComObjectFactory.Create(ComServer, TActiveScriptSite, IID_IActiveScriptSite,
  154.                             'ActiveScript Host', '',ciMultiInstance);
  155. end.
  156.