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
|
{ compiletime ComObj support }
unit uPSC_comobj;
{$I PascalScript.inc}
interface
uses
uPSCompiler, uPSUtils;
{
Will register:
function CreateOleObject(const ClassName: String): IDispatch;
function GetActiveOleObject(const ClassName: String): IDispatch;
}
procedure SIRegister_ComObj(cl: TPSPascalCompiler);
implementation
procedure SIRegister_ComObj(cl: TPSPascalCompiler);
begin
{$IFDEF FPC}
{$IFDEF PS_FPC_HAS_COM}
cl.AddTypeS('HResult', 'LongInt');
cl.AddTypeS('TGUID', 'record D1: LongWord; D2: Word; D3: Word; D4: array[0..7] of Byte; end;');
cl.AddTypeS('TCLSID', 'TGUID');
cl.AddTypeS('TIID', 'TGUID');
cl.AddDelphiFunction('procedure OleCheck(Result: HResult);');
cl.AddDelphiFunction('function StringToGUID(const S: string): TGUID;');
cl.AddDelphiFunction('function CreateComObject(const ClassID: TGUID): IUnknown;');
cl.AddDelphiFunction('function CreateOleObject(const ClassName: string): IDispatch;');
cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: string): IDispatch;');
{$ENDIF}
{$ELSE}
cl.AddTypeS('HResult', 'LongInt');
cl.AddTypeS('TGUID', 'record D1: LongWord; D2: Word; D3: Word; D4: array[0..7] of Byte; end;');
cl.AddTypeS('TCLSID', 'TGUID');
cl.AddTypeS('TIID', 'TGUID');
cl.AddDelphiFunction('procedure OleCheck(Result: HResult);');
{$IFNDEF PS_NOINTERFACES}
{$IFDEF DELPHI3UP}
cl.AddDelphiFunction('function StringToGUID(const S: string): TGUID;');
cl.AddDelphiFunction('function CreateComObject(const ClassID: TGUID): IUnknown;');
{$ENDIF}
{$ENDIF}
cl.AddDelphiFunction('function CreateOleObject(const ClassName: string): IDispatch;');
cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: string): IDispatch;');
{$ENDIF}
end;
end.
|
