имею
Код: Выделить всё
unit Gal_COM;
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses
activeX,Windows, Messages, SysUtils, Variants, Classes, StdVCL, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
IAtlantisAppSrv = interface(IDispatch)
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
function Connect(const uName: WideString; const uPass: WideString): HResult; stdcall;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant;
out aRetVal: Integer): HResult; stdcall;
function LoadVip(const Name: WideString; out ifc: IDispatch): HResult; stdcall;
end;
IAtlantisAppSrvDisp = dispinterface
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
procedure Connect(const uName: WideString; const uPass: WideString); dispid 100;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant): Integer; dispid 101;
function LoadVip(const Name: WideString): IDispatch; dispid 102;
end;
IUsers = interface(IUnknown)
['{CA477FE3-A426-4F3E-949E-8EDF6725F4EB}']
function GhostMethod_IUsers_0_1: HResult; stdcall;
function GhostMethod_IUsers_4_2: HResult; stdcall;
function GhostMethod_IUsers_8_3: HResult; stdcall;
function SendMessageToActiveUsers(const msg: WideString): HResult; stdcall;
end;
IAtlantisApp = IAtlantisAppSrv;
IAtlantisIfc = IDispatch;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const IID_IAtlantisAppSrv : TIID = '{13AAEF50-CE08-11d5-A27B-00204CE40998}';
const CLSID_AtlantisAppSrv : TIID = '{2C4CF260-DAA2-11d5-A29D-00204CE40998}';
const LIBID_FULLLib: TGUID = '{BBB198A1-11BF-42B0-A066-B9D80B6DC746}';
const IID_IUsers: TGUID = '{CA477FE3-A426-4F3E-949E-8EDF6725F4EB}';
var
Form1: TForm1;
hr : HRESULT;
pIAtlantisApp : IAtlantisApp;
pIAtlantisIfc : IAtlantisIfc;
vPar : Integer;
p : OleVariant;
ret : longint;
pMainObj : IUsers;
d : double;
s : WideString;
c1,c2 : int64;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
pIAtlantisApp := nil;
pIAtlantisIfc := nil;
//pMainObj := nil;
hr := CoInitialize (nil);
if hr <> 0 then ShowMessage ('Ev1 '+intToHex (hr,8));
hr := CoCreateInstance (CLSID_AtlantisAppSrv,
nil, CLSCTX_LOCAL_SERVER,
IID_IAtlantisAppSrv,
pIAtlantisApp);
ShowMessage (intToHex(CO_E_SERVER_EXEC_FAILURE,8)+' Ev2 '+intToHex (hr,8));
hr := pIAtlantisApp.Connect ('aa','aa');
ShowMessage ('Ev3 '+intToHex (hr,8));
p := 5;
hr := pIAtlantisApp.LoadVip ('UTILS::Users',pIAtlantisIfc);
ShowMessage ('Ev4 '+intToHex (hr,8));
hr := pIAtlantisIfc.QueryInterface (IID_IUsers,pMainObj);
ShowMessage ('Ev5 '+intToHex (hr,8));
s := 'QQ';
hr := pMainObj.SendMessageToActiveUsers(s);
ShowMessage ('Ev6 '+intToHex (hr,8));
end;
end.
вот в этом месте---------------------------
Gal_com_prj
---------------------------
Access violation at address 00000000. Read of address 00000000.
---------------------------
ОК
---------------------------
Код: Выделить всё
hr := pMainObj.SendMessageToActiveUsers(s);