Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Comobj support for FPC

Browse Source
This commit is contained in:
pchev 2014-05-19 10:11:51 +02:00
parent b015e2522a
commit 8ce29b39c5
8 changed files with 63 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Source/PascalScriptFCL.lpk
View File

@ -51,7 +51,7 @@ Carlo Kok
RemObjects Software
"/>
<Version Build="1"/>
<Files Count="25">
<Files Count="28">
<Item1>
<Filename Value="uPSRuntime.pas"/>
<UnitName Value="uPSRuntime"/>
@ -152,6 +152,18 @@ RemObjects Software
<Filename Value="x86.inc"/>
<Type Value="Include"/>
</Item25>
<Item26>
<Filename Value="uPSComponent_COM.pas"/>
<UnitName Value="uPSComponent_COM"/>
</Item26>
<Item27>
<Filename Value="uPSC_comobj.pas"/>
<UnitName Value="uPSC_comobj"/>
</Item27>
<Item28>
<Filename Value="uPSR_comobj.pas"/>
<UnitName Value="uPSR_comobj"/>
</Item28>
</Files>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>

9
Source/PascalScriptFPC.inc
View File

@ -1,7 +1,9 @@
{$DEFINE PS_HAVEVARIANT}
{$DEFINE PS_DYNARRAY}
{$DEFINE PS_NOIDISPATCH}
{$ifndef mswindows}
{$DEFINE PS_NOIDISPATCH}
{$endif}
{.$if (fpc_version=2) and (fpc_release>=3) and (fpc_patch>=1)}
{$if (fpc_version=2) and ((fpc_release=2) and (fpc_patch>=4)) or (fpc_release>2)}
{$UNDEF FPC_OLD_FIX}
@ -9,6 +11,11 @@
{$UNDEF PS_FPCSTRINGWORKAROUND}
{$DEFINE PS_RESBEFOREPARAMETERS}
{$DEFINE x64_string_result_as_varparameter}
{$ifdef mswindows}
{$if (fpc_version=2) and (fpc_release>5)}
{$DEFINE PS_FPC_HAS_COM}
{$endif}
{$endif}
{FreePascal 2.3.1 and above has much Delphi compatibility bugs fixed}
{$else}
{$DEFINE FPC_OLD_FIX}

4
Source/PascalScript_Core_Reg.pas
View File

@ -30,9 +30,7 @@ uses
uPSComponent,
uPSDebugger,
uPSComponent_Default,
{$IFNDEF FPC}
uPSComponent_COM,
{$ENDIF}
uPSComponent_DB,
uPSComponent_Forms,
uPSComponent_Controls,
@ -45,9 +43,7 @@ begin
TPSDllPlugin,
TPSImport_Classes,
TPSImport_DateUtils,
{$IFNDEF FPC}
TPSImport_ComObj,
{$ENDIF}
TPSImport_DB,
TPSImport_Forms,
TPSImport_Controls,

2
Source/pascalscript.pas
View File

@ -15,7 +15,7 @@ uses
uPSDisassembly, uPSPreProcessor, uPSR_buttons, uPSR_classes, uPSR_controls,
uPSR_dateutils, uPSR_DB, uPSR_dll, uPSR_extctrls, uPSR_forms,
uPSR_graphics, uPSR_menus, uPSR_std, uPSR_stdctrls, uPSUtils,
LazarusPackageIntf;
uPSComponent_COM, uPSC_comobj, uPSR_comobj, LazarusPackageIntf;
implementation

14
Source/uPSC_comobj.pas
View File

@ -21,6 +21,19 @@ 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');
@ -34,6 +47,7 @@ begin
{$ENDIF}
cl.AddDelphiFunction('function CreateOleObject(const ClassName: String): IDispatch;');
cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: String): IDispatch;');
{$ENDIF}
end;
end.

2
Source/uPSCompiler.pas
View File

@ -1724,7 +1724,7 @@ procedure DisposeVariant(p: PIfRVariant);
implementation
uses {$IFDEF DELPHI5}ComObj, {$ENDIF}Classes, typInfo;
uses {$IFDEF DELPHI5}ComObj, {$ENDIF}{$IFDEF PS_FPC_HAS_COM}ComObj, {$ENDIF}Classes, typInfo;
{$IFDEF DELPHI3UP}
resourceString

23
Source/uPSR_comobj.pas
View File

@ -11,11 +11,16 @@ uses
procedure RIRegister_ComObj(cl: TPSExec);
implementation
uses
{$IFDEF DELPHI3UP}
ComObj;
{$IFDEF FPC}
{$IFDEF PS_FPC_HAS_COM}
uses SysUtils, ComObj;
{$ENDIF}
{$ELSE}
SysUtils, Ole2;
{$IFDEF DELPHI3UP}
uses ComObj;
{$ELSE}
uses SysUtils, Ole2;
{$ENDIF}
{$ENDIF}
{$IFNDEF DELPHI3UP}
@ -89,6 +94,15 @@ end;
procedure RIRegister_ComObj(cl: TPSExec);
begin
{$IFDEF FPC}
{$IFDEF PS_FPC_HAS_COM}
cl.RegisterDelphiFunction(@OleCheck, 'OleCheck', cdRegister);
cl.RegisterDelphiFunction(@StringToGUID, 'StringToGUID', cdRegister);
cl.RegisterDelphiFunction(@CreateComObject, 'CreateComObject', cdRegister);
cl.RegisterDelphiFunction(@CreateOleObject, 'CREATEOLEOBJECT', cdRegister);
cl.RegisterDelphiFunction(@GetActiveOleObject, 'GETACTIVEOLEOBJECT', cdRegister);
{$ENDIF}
{$ELSE}
cl.RegisterDelphiFunction(@OleCheck, 'OleCheck', cdRegister);
{$IFNDEF PS_NOINTERFACES}
{$IFDEF DELPHI3UP}
@ -98,6 +112,7 @@ begin
{$ENDIF}
cl.RegisterDelphiFunction(@CreateOleObject, 'CREATEOLEOBJECT', cdRegister);
cl.RegisterDelphiFunction(@GetActiveOleObject, 'GETACTIVEOLEOBJECT', cdRegister);
{$ENDIF}
end;
end.

8
Source/uPSRuntime.pas
View File

@ -1101,7 +1101,7 @@ function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: tbtS
implementation
uses
TypInfo {$IFDEF DELPHI3UP}{$IFNDEF FPC}{$IFNDEF KYLIX} , ComObj {$ENDIF}{$ENDIF}{$ENDIF};
TypInfo {$IFDEF DELPHI3UP}{$IFNDEF FPC}{$IFNDEF KYLIX} , ComObj {$ENDIF}{$ENDIF}{$ENDIF}{$IFDEF PS_FPC_HAS_COM}, ComObj{$ENDIF};
{$IFDEF DELPHI3UP }
resourceString
@ -9378,7 +9378,9 @@ begin
RegisterDelphiFunction(@VarIsEmpty, 'VARISEMPTY', cdRegister);
RegisterDelphiFunction(@Null, 'NULL', cdRegister);
RegisterDelphiFunction(@VarIsNull, 'VARISNULL', cdRegister);
{$IFNDEF FPC}
RegisterDelphiFunction(@VarType, 'VARTYPE', cdRegister);
{$ENDIF}
{$IFNDEF PS_NOIDISPATCH}
RegisterDelphiFunction(@IDispatchInvoke, 'IDISPATCHINVOKE', cdregister);
{$ENDIF}
@ -12654,7 +12656,11 @@ begin
if not Succeeded(i) then
begin
if i = DISP_E_EXCEPTION then
{$IFDEF FPC}
raise Exception.Create(ExceptInfo.Source+': '+ExceptInfo.Description)
{$ELSE}
raise Exception.Create(ExceptInfo.bstrSource+': '+ExceptInfo.bstrDescription)
{$ENDIF}
else
raise Exception.Create(SysErrorMessage(i));
end;