大致是这样的吧
unit ASIM2Lib_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : $Revision: 1.130 $
// File generated on 2004-5-19 11:34:24 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:/WINDOWS/Desktop/ASIM2.dll (1)
// LIBID: {04C7B48C-9A9D-43C9-8258-AB414B9784DC}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/SYSTEM/stdole2.tlb)
// Errors:
// Error creating palette bitmap of (TIM) : No Server registered for this CoClass
// Error creating palette bitmap of (TMsg) : No Server registered for this CoClass
// ************************************************************************ //
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
interface
uses ActiveX, Classes, Graphics, OleServer, StdVCL, Variants, Windows;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
ASIM2LibMajorVersion = 1;
ASIM2LibMinorVersion = 0;
LIBID_ASIM2Lib: TGUID = '{04C7B48C-9A9D-43C9-8258-AB414B9784DC}';
IID_IIM: TGUID = '{DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}';
CLASS_IM: TGUID = '{30B01BB1-D2C6-435F-82D2-C9967E9E4832}';
IID_IMsg: TGUID = '{8E7945FC-DF61-48D4-9B56-B2B46537FC70}';
CLASS_Msg: TGUID = '{4A6A7D7D-F7A0-4626-A2BE-6E8657ABF7A8}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IIM = interface;
IIMDisp = dispinterface;
IMsg = interface;
IMsgDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
IM = IIM;
Msg = IMsg;
// *********************************************************************//
// Interface: IIM
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}
// *********************************************************************//
IIM = interface(IDispatch)
['{DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}']
procedure Init(const bszServer: WideString
const bszUserID: WideString
const bszPassword: WideString)
safecall;
procedure SendMsg(const bszSubject: WideString
const bszBody: WideString
const bszReceiverID: WideString
nStyle: Integer)
safecall;
procedure InitForWeb(const bszUserID: WideString
const bszPassword: WideString)
safecall;
function Get_IMServer: WideString
safecall;
procedure Set_IMServer(const pVal: WideString)
safecall;
procedure SendMsgEx(const pMsg: IMsg
const bszReceiverID: WideString)
safecall;
property IMServer: WideString read Get_IMServer write Set_IMServer;
end;
// *********************************************************************//
// DispIntf: IIMDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}
// *********************************************************************//
IIMDisp = dispinterface
['{DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}']
procedure Init(const bszServer: WideString
const bszUserID: WideString
const bszPassword: WideString)
dispid 1;
procedure SendMsg(const bszSubject: WideString
const bszBody: WideString
const bszReceiverID: WideString
nStyle: Integer)
dispid 2;
procedure InitForWeb(const bszUserID: WideString
const bszPassword: WideString)
dispid 3;
property IMServer: WideString dispid 4;
procedure SendMsgEx(const pMsg: IMsg
const bszReceiverID: WideString)
dispid 5;
end;
// *********************************************************************//
// Interface: IMsg
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {8E7945FC-DF61-48D4-9B56-B2B46537FC70}
// *********************************************************************//
IMsg = interface(IDispatch)
['{8E7945FC-DF61-48D4-9B56-B2B46537FC70}']
procedure AddAttachment(const bszFileName: WideString)
safecall;
function Get_Subject: WideString
safecall;
procedure Set_Subject(const pVal: WideString)
safecall;
function Get_Body: WideString
safecall;
procedure Set_Body(const pVal: WideString)
safecall;
property Subject: WideString read Get_Subject write Set_Subject;
property Body: WideString read Get_Body write Set_Body;
end;
// *********************************************************************//
// DispIntf: IMsgDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {8E7945FC-DF61-48D4-9B56-B2B46537FC70}
// *********************************************************************//
IMsgDisp = dispinterface
['{8E7945FC-DF61-48D4-9B56-B2B46537FC70}']
procedure AddAttachment(const bszFileName: WideString)
dispid 1;
property Subject: WideString dispid 2;
property Body: WideString dispid 3;
end;
// *********************************************************************//
// The Class CoIM provides a Create and CreateRemote method to
// create instances of the default interface IIM exposed by
// the CoClass IM. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoIM = class
class function Create: IIM;
class function CreateRemote(const MachineName: string): IIM;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TIM
// Help String : IM Class
// Default Interface: IIM
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TIMProperties= class;
{$ENDIF}
TIM = class(TOleServer)
private
FIntf: IIM;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TIMProperties;
function GetServerProperties: TIMProperties;
{$ENDIF}
function GetDefaultInterface: IIM;
protected
procedure InitServerData
override;
function Get_IMServer: WideString;
procedure Set_IMServer(const pVal: WideString);
public
constructor Create(AOwner: TComponent)
override;
destructor Destroy
override;
procedure Connect
override;
procedure ConnectTo(svrIntf: IIM);
procedure Disconnect
override;
procedure Init(const bszServer: WideString
const bszUserID: WideString
const bszPassword: WideString);
procedure SendMsg(const bszSubject: WideString
const bszBody: WideString
const bszReceiverID: WideString
nStyle: Integer);
procedure InitForWeb(const bszUserID: WideString
const bszPassword: WideString);
procedure SendMsgEx(const pMsg: IMsg
const bszReceiverID: WideString);
property DefaultInterface: IIM read GetDefaultInterface;
property IMServer: WideString read Get_IMServer write Set_IMServer;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TIMProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TIM
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TIMProperties = class(TPersistent)
private
FServer: TIM;
function GetDefaultInterface: IIM;
constructor Create(AServer: TIM);
protected
function Get_IMServer: WideString;
procedure Set_IMServer(const pVal: WideString);
public
property DefaultInterface: IIM read GetDefaultInterface;
published
property IMServer: WideString read Get_IMServer write Set_IMServer;
end;
{$ENDIF}
// *********************************************************************//
// The Class CoMsg provides a Create and CreateRemote method to
// create instances of the default interface IMsg exposed by
// the CoClass Msg. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMsg = class
class function Create: IMsg;
class function CreateRemote(const MachineName: string): IMsg;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TMsg
// Help String : Msg Class
// Default Interface: IMsg
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TMsgProperties= class;
{$ENDIF}
TMsg = class(TOleServer)
private
FIntf: IMsg;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TMsgProperties;
function GetServerProperties: TMsgProperties;
{$ENDIF}
function GetDefaultInterface: IMsg;
protected
procedure InitServerData
override;
function Get_Subject: WideString;
procedure Set_Subject(const pVal: WideString);
function Get_Body: WideString;
procedure Set_Body(const pVal: WideString);
public
constructor Create(AOwner: TComponent)
override;
destructor Destroy
override;
procedure Connect
override;
procedure ConnectTo(svrIntf: IMsg);
procedure Disconnect
override;
procedure AddAttachment(const bszFileName: WideString);
property DefaultInterface: IMsg read GetDefaultInterface;
property Subject: WideString read Get_Subject write Set_Subject;
property Body: WideString read Get_Body write Set_Body;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TMsgProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TMsg
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TMsgProperties = class(TPersistent)
private
FServer: TMsg;
function GetDefaultInterface: IMsg;
constructor Create(AServer: TMsg);
protected
function Get_Subject: WideString;
procedure Set_Subject(const pVal: WideString);
function Get_Body: WideString;
procedure Set_Body(const pVal: WideString);
public
property DefaultInterface: IMsg read GetDefaultInterface;
published
property Subject: WideString read Get_Subject write Set_Subject;
property Body: WideString read Get_Body write Set_Body;
end;
{$ENDIF}
procedure Register;
resourcestring
dtlServerPage = 'Servers';
implementation
uses ComObj;
class function CoIM.Create: IIM;
begin
Result := CreateComObject(CLASS_IM) as IIM;
end;
class function CoIM.CreateRemote(const MachineName: string): IIM;
begin
Result := CreateRemoteComObject(MachineName, CLASS_IM) as IIM;
end;
procedure TIM.InitServerData;
const
CServerData: TServerData = (
ClassID: '{30B01BB1-D2C6-435F-82D2-C9967E9E4832}';
IntfIID: '{DF6AB720-05EB-48F1-8DBC-8DED4C2D8DF0}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TIM.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as IIM;
end;
end;
procedure TIM.ConnectTo(svrIntf: IIM);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TIM.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TIM.GetDefaultInterface: IIM;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TIM.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TIMProperties.Create(Self);
{$ENDIF}
end;
destructor TIM.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TIM.GetServerProperties: TIMProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TIM.Get_IMServer: WideString;
begin
Result := DefaultInterface.IMServer;
end;
procedure TIM.Set_IMServer(const pVal: WideString);
{ Warning: The property IMServer has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.IMServer := pVal;
end;
procedure TIM.Init(const bszServer: WideString
const bszUserID: WideString
const bszPassword: WideString);
begin
DefaultInterface.Init(bszServer, bszUserID, bszPassword);
end;
procedure TIM.SendMsg(const bszSubject: WideString
const bszBody: WideString
const bszReceiverID: WideString
nStyle: Integer);
begin
DefaultInterface.SendMsg(bszSubject, bszBody, bszReceiverID, nStyle);
end;
procedure TIM.InitForWeb(const bszUserID: WideString
const bszPassword: WideString);
begin
DefaultInterface.InitForWeb(bszUserID, bszPassword);
end;
procedure TIM.SendMsgEx(const pMsg: IMsg
const bszReceiverID: WideString);
begin
DefaultInterface.SendMsgEx(pMsg, bszReceiverID);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TIMProperties.Create(AServer: TIM);
begin
inherited Create;
FServer := AServer;
end;
function TIMProperties.GetDefaultInterface: IIM;
begin
Result := FServer.DefaultInterface;
end;
function TIMProperties.Get_IMServer: WideString;
begin
Result := DefaultInterface.IMServer;
end;
procedure TIMProperties.Set_IMServer(const pVal: WideString);
{ Warning: The property IMServer has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.IMServer := pVal;
end;
{$ENDIF}
class function CoMsg.Create: IMsg;
begin
Result := CreateComObject(CLASS_Msg) as IMsg;
end;
class function CoMsg.CreateRemote(const MachineName: string): IMsg;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Msg) as IMsg;
end;
procedure TMsg.InitServerData;
const
CServerData: TServerData = (
ClassID: '{4A6A7D7D-F7A0-4626-A2BE-6E8657ABF7A8}';
IntfIID: '{8E7945FC-DF61-48D4-9B56-B2B46537FC70}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TMsg.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as IMsg;
end;
end;
procedure TMsg.ConnectTo(svrIntf: IMsg);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TMsg.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TMsg.GetDefaultInterface: IMsg;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TMsg.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TMsgProperties.Create(Self);
{$ENDIF}
end;
destructor TMsg.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TMsg.GetServerProperties: TMsgProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TMsg.Get_Subject: WideString;
begin
Result := DefaultInterface.Subject;
end;
procedure TMsg.Set_Subject(const pVal: WideString);
{ Warning: The property Subject has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Subject := pVal;
end;
function TMsg.Get_Body: WideString;
begin
Result := DefaultInterface.Body;
end;
procedure TMsg.Set_Body(const pVal: WideString);
{ Warning: The property Body has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Body := pVal;
end;
procedure TMsg.AddAttachment(const bszFileName: WideString);
begin
DefaultInterface.AddAttachment(bszFileName);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TMsgProperties.Create(AServer: TMsg);
begin
inherited Create;
FServer := AServer;
end;
function TMsgProperties.GetDefaultInterface: IMsg;
begin
Result := FServer.DefaultInterface;
end;
function TMsgProperties.Get_Subject: WideString;
begin
Result := DefaultInterface.Subject;
end;
procedure TMsgProperties.Set_Subject(const pVal: WideString);
{ Warning: The property Subject has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Subject := pVal;
end;
function TMsgProperties.Get_Body: WideString;
begin
Result := DefaultInterface.Body;
end;
procedure TMsgProperties.Set_Body(const pVal: WideString);
{ Warning: The property Body has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant to set the property instead. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Body := pVal;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents(dtlServerPage, [TIM, TMsg]);
end;
end.
