+ infrastructure for DispInterface call dispatching

git-svn-id: trunk@5793 -

rtl/inc/compproc.inc

@@ -313,6 +313,7 @@ procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
 procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
 function  fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
 function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: IDispatch;DispDesc: Pointer; Params: Pointer); compilerproc;
 {$endif FPC_HAS_FEATURE_CLASSES}
 
 

rtl/inc/objpas.inc

@@ -13,6 +13,20 @@
 
  **********************************************************************}
 
+    procedure DoDispCallByIDError(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer);
+      begin
+        handleerrorframe(RuntimeErrorExitCodes[reVarDispatch],get_frame);
+      end;
+
+
+    procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: IDispatch;
+      DispDesc: Pointer; Params: Pointer); compilerproc;
+      type
+        TDispProc = procedure(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer);
+      begin
+        TDispProc(DispCallByIDProc)(Result,Dispatch,DispDesc,Params);
+      end;
+
 {****************************************************************************
                   Internal Routines called from the Compiler
 ****************************************************************************}

rtl/inc/objpash.inc

@@ -330,3 +330,5 @@
            vtQWord      : (VQWord: PQWord);
        end;
 
+  var
+    DispCallByIDProc : pointer;

rtl/win32/system.pp

@@ -1143,4 +1143,5 @@ begin
   initvariantmanager;
   initwidestringmanager;
   InitWin32Widestrings;
+  DispCallByIDProc:=@DoDispCallByIDError;
 end.

rtl/win64/system.pp

@@ -1167,4 +1167,5 @@ begin
   initvariantmanager;
   initwidestringmanager;
   InitWin32Widestrings;
+  DispCallByIDProc:=@DoDispCallByIDError;
 end.

rtl/wince/system.pp

@@ -1807,9 +1807,8 @@ initialization
   initvariantmanager;
   initwidestringmanager;
   InitWinCEWidestrings
-
+  DispCallByIDProc:=@DoDispCallByIDError;
-finalization
-  { Cleanup }
-  SysCleanup;
   
+finalization
+  SysCleanup;
 end.