[fpc-pascal]Strange compilation problems

[Gabor DEAK JAHN]

Hello,

I had been fighting with a stubborn problem for a few days now and the 
solution came from a corner I never expected it from. The program in 
question is a small test to drive an OLE Automation server (Corel Ventura 8 
in this case), establishing the connection and calling a simple function. I 
get the strangest differences with various versions of my program. I tried 
with FPC 1.0.2, by the way.

The problem is that the enclosed program behaves differently with and 
without the unused variable marked by {*} added to the source. Without the 
variable the program does not work (it runs to the end but receives an error 
message back from the pdisp^.vtbl^.Invoke call) while with the variable it 
does work. At first I suspected some PACKRECORDS problems but the problem 
persists in all PACKRECORD configurations.

However, when specifying -al (to retain the assembler file) both versions 
work as expected. It seems to me that -al does more than simply leave the 
assembler file there, the resulting EXEs are drastically different.

When this will be sorted out, I'll have new problems: if this program is 
divided into a unit and a main program, it does not work even with -al, but 
let's proceed one step at a time... :-)))

Note that the original Ole2.pp in FPC is not functioning, make sure to use 
the one enclosed here (although I don't know how anybody could test it 
without Ventura installed, however, it might be modified to call another OLE 
server; as far as I know, MS Office programs are possible candidates).

-------------------- TEST.PP
{$APPTYPE CONSOLE}
program VPDoctor;
{$PACKRECORDS NORMAL}
uses
  Windows, Ole2;
const
  CLSCTX_INPROC_SERVER = 1;
  CLSCTX_LOCAL_SERVER = 4;
  CLSCTX_REMOTE_SERVER = 16;
  CLSCTX_SERVER = CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER or
CLSCTX_REMOTE_SERVER;
  DISPATCH_METHOD = 1;
  IID_IUnknown : GUID = (Data1 : 0; Data2 : 0; Data3 : 0; Data4 : ($C0, 0, 0,
0, 0, 0, 0, $46));
  IID_IDispatch : GUID = (Data1 : $00020400; Data2 : 0; Data3 : 0; Data4 :
($C0, 0, 0, 0, 0, 0, 0, $46));
  IID_NULL : GUID = (Data1 : 0; Data2 : 0; Data3 : 0; Data4 : (0, 0, 0, 0, 0,
0, 0, 0));
  ProgID : PChar =
'C'#0'o'#0'r'#0'e'#0'l'#0'V'#0'e'#0'n'#0't'#0'u'#0'r'#0'a'#0'.'#0'A'#0'u'#0'
t'#0'o'#0'm'#0'a'#0't'#0'i'#0'o'#0'n'#0'.'#0'8'#0#0;
type
  PDispID = ^TDispID;
  TDispID = cardinal;
  PExcepInfo = pointer;
  PIUnknown = ^IUnknown;
  PDispParams = ^TDispParams;
  TDispParams = packed record
    rgvarg : PVariant;
    rgDispIDNamedArgs : PDispID;
    cArgs : word;
    cNamedArgs : word;
    end;
  PIDispatch = ^IDispatch;
  IDispatch = packed record
    vtbl : ^IDispatchVtbl;
    end;
  IDispatchVtbl = packed record
    QueryInterface : function (const pdisp : PIDispatch; const iid: TIID; var
obj): hResult; stdcall;
    AddRef : function (const pdisp : PIDispatch) : longint; stdcall;
    Release : function (const pdisp : PIDispatch) : longint; stdcall;
    GetTypeInfoCount : function (const pdisp : PIDispatch; pctinfo : PUINT) :
hResult; stdcall;
    GetTypeInfo : function (const pdisp : PIDispatch; iTInfo : word; lciid :
LCID; var ppTInfo) : hResult; stdcall;
    GetIDsOfNames : function (const pdisp : PIDispatch; const iid : TIID;
rgszNames : LPCWSTR; cNames : UINT; lciid : LCID; var DispID : TDispID) :
hResult; stdcall;
    Invoke : function (const pdisp : PIDispatch; dispIdMember : TDispID; const
iid : TIID; lciid : LCID; wFlags : WORD; pDP : PDispParams; pVarResult :
PVariant; pExceptInfo : PExcepInfo; puArgErr : PUINT) : hResult; stdcall;
    end;
var
  hr : hResult;
  CLSID_Ventura : TCLSID;
  punk : ^IUnknown;
  pdisp : ^IDispatch;
  dp : TDispParams;
  dispid : TDispID; {*}

function CLSIDFromProgID (lpszProgID : LPCWSTR; var pclsid : TCLSID) :
hResult;
external 'OLE32' name 'CLSIDFromProgID';
function CoCreateInstance (rclsid : TCLSID; pUnkOuter : PIUnknown;
dwClsContext
: longint; riid : TIID; var ppv) : hResult; external 'OLE32' name
'CoCreateInstance';
function OleInitialize (pvReserved : pointer) : hResult; external 'OLE32' name
'OleInitialize';
procedure OleUninitialize; external 'OLE32' name 'OleUninitialize';

begin
  dp.rgvarg := nil;
  dp.rgDispIDNamedArgs := nil;
  dp.cArgs := 0;
  dp.cNamedArgs := 0;
  hr := OleInitialize (nil);
  hr := CLSIDFromProgID (LPCWSTR(ProgID), CLSID_Ventura);
  hr := CoCreateInstance (CLSID_Ventura, nil, CLSCTX_SERVER, IID_IUnknown,
punk);
  hr := punk^.vtbl^.QueryInterface (punk, IID_IDispatch, pdisp);
  hr := pdisp^.vtbl^.Invoke (pdisp, $0883, IID_NULL, LOCALE_USER_DEFAULT,
DISPATCH_METHOD, @dp, nil, nil, nil);
  OleUnInitialize;
end.


--------------- OLE2.PP
unit ole2;
{$PACKRECORDS 1}
  interface

    uses
       windows;

    type
      PIUnknown = ^IUnknown;
      IUnknown = packed record
        vtbl : ^IUnknownVtbl;
        end;
      IUnknownVtbl = packed record
        QueryInterface : function (const punk : PIUnknown; const iid: TIID;
var
obj): HResult; stdcall;
        AddRef : function (const punk : PIUnknown) : longint; stdcall;
        Release : function (const punk : PIUnknown) : longint; stdcall;
        end;

  implementation

end.


Regards,

   Gabor DEAK JAHN

-------------------------------------------------------------------
Gabor DEAK JAHN -- Budapest, Hungary.
WWW: <http://www.tramontana.co.hu/>www.tramontana.co.hu
E-mail: djg at tramontana.co.hu