PHP DM Gate v0.9 » Error: "Интерфейс не поддерживается" <span class="vd">[Delphi, Windows]</span>

Andrey_Gor (30.05.06 15:50) [0]

С чем связана ошибка "Интерфейс не поддерживается"?
COM сервер запускается без ошибок, в реестре на него ссылки имеются, а вот клиент ругается на попытку его вызова.
И существуют ли какие-либо др. средства дл отладки COM/DCOM приложений.

<Цитата>
umbra © (30.05.06 16:25) [1]

> С чем связана ошибка "Интерфейс не поддерживается"?

или интерфейса с таким именем не существует (опечатка?), или (при позднем связывании) этот интерфейс не публикует свои свойства и методы с помощью
IDispatch

<Цитата>
Andrey_Gor (30.05.06 16:37) [2]

На опечатку проверял, находил в реестре записи - все нормально.
Поясните, PLS, что тогда делать с
IDispatch

.
Я только начал разбираться с COM/DCOM? поэтому не все могу сразу понять.
Каким образом можно заставить его публиковать свойства и методы?
..пробовал создавать пустые серверы с одним методом, проблема с их вызовом остается.
Еще они не появляются в Import ActiveX Library, хотя как я понимаю должны.

<Цитата>
umbra © (30.05.06 16:51) [3]

а можно немного кода? как вы объявляете интерфейс и реализуете его?

<Цитата>
Andrey_Gor (30.05.06 17:02) [4]

unit Unit2;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, ActiveX, Classes, ComObj, TestClient_TLB, StdVcl, SysUtils, Variants;

type
TRCS2 = class(TTypedComObject, IRCS2)
private
LogFile: TextFile;
protected
procedure Set_FN(const FileName: WideString); stdcall;
function Get_FN: WideString; stdcall;
function InitAlg(Level, Num: Integer; const AlgName: WideString;
CLSID: TGUID): HResult; stdcall;
function Training(T_Fact, F_Fact: OleVariant; T_size,
F_size: Integer): HResult; stdcall;
function Test(Data: OleVariant): Single; stdcall;
{Declare IRCS2 methods here}
property FName: WideString read Get_FN write Set_FN;
end;

implementation

uses ComServ;

procedure TRCS2.Set_FN(const FileName: WideString);
begin
FName:=FileName;
end;

function TRCS2.Get_FN: WideString;
begin
Result:=FName;
end;

function TRCS2.InitAlg(Level, Num: Integer; const AlgName: WideString;
CLSID: TGUID): HResult;
var LogF:string;
Server: Variant;
begin
...............
end;

function TRCS2.Training(T_Fact, F_Fact: OleVariant; T_size,
F_size: Integer): HResult;
begin
......

end;

function TRCS2.Test(Data: OleVariant): Single;
begin
........
end;

initialization
TTypedComObjectFactory.Create(ComServer, TRCS2, Class_RCS2,
ciMultiInstance, tmApartment);
end.

*******************************
unit TestClient_TLB;

{$TYPEDADDRESS OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;

const
TestClientMajorVersion = 1;
TestClientMinorVersion = 0;

LIBID_TestClient: TGUID = '{3348457C-F1FB-4E44-8D5B-2C72E0E2597B}';

IID_IRCS2: TGUID = '{703B2A95-E269-4E8C-9711-7D29E49B0D96}';
CLASS_RCS2: TGUID = '{1AB5D2FF-DEE5-4B56-92D8-75CF43D934A8}';
type

IRCS2 = interface;
RCS2 = IRCS2;

IRCS2 = interface(IUnknown)
['{703B2A95-E269-4E8C-9711-7D29E49B0D96}']
function Get_FN: WideString; stdcall;
procedure Set_FN(const FileName: WideString); stdcall;
function InitAlg(Level: Integer; Num: Integer; const AlgName: WideString; CLSID: TGUID): HResult; stdcall;
function Training(T_Fact: OleVariant; F_Fact: OleVariant; T_size: Integer; F_size: Integer): HResult; stdcall;
function Test(Data: OleVariant): Single; stdcall;
end;

CoRCS2 = class
class function Create: IRCS2;
class function CreateRemote(const MachineName: string): IRCS2;
end;

implementation

uses ComObj;

class function CoRCS2.Create: IRCS2;
begin
Result := CreateComObject(CLASS_RCS2) as IRCS2;
end;

class function CoRCS2.CreateRemote(const MachineName: string): IRCS2;
begin
Result := CreateRemoteComObject(MachineName, CLASS_RCS2) as IRCS2;
end;

end.

<Цитата>
isasa © (31.05.06 11:16) [5]

Рекомендуют так
...
TRCS2 = class(TAutoObject, IRCS2)

В редакторе ATL измени для интерфейсов Parent interface -> IDispatch.
IRCS2 = interface(IDispatch)
...

<Цитата>
AbrosimovA © (31.05.06 16:43) [6]

Вот процедура :

procedure EnumInterface(Dispatch: IDispatch; Entries: TStrings; Functions: Boolean);
var
TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr;
FuncDesc: PFuncDesc;
Vardesc: PVarDesc;
hr: HResult;
iMethode: Integer;
nNames : integer;
sNameLst: TBSTRList;
begin
Dispatch.GetTypeInfoCount(iMethode);
if iMethode > 0 then
begin
hr := Dispatch.GetTypeInfo(0,GetUserDefaultLCID,TypeInfo);
OleCheck(hr);
hr := TypeInfo.GetTypeAttr(TypeAttr);
OleCheck(hr);
if Functions then
begin
for iMethode := 0 to TypeAttr.cFuncs-1 do
begin
hr := TypeInfo.GetFuncDesc(iMethode, FuncDesc);
OleCheck(hr);
hr := TypeInfo.GetNames(FuncDesc.memid, @sNameLst,1,nNames);
OleCheck(hr);
Entries.Add(Format('%d-%s', [FuncDesc.memid, sNameLst[0]]));
end;
end
else
begin
for iMethode := 0 to TypeAttr.cVars-1 do
begin
hr := TypeInfo.GetVarDesc(iMethode, Vardesc);
OleCheck(hr);
hr := TypeInfo.GetNames(Vardesc.memid, @sNameLst,1,nNames);
OleCheck(hr);
Entries.Add(Format('%d-%s', [Vardesc.memid, sNameLst[0]]));
end;
end;
end;
end;

А это её вызов:

EnumInterface(Srv,ListBox1.Items,True)

<Цитата>