请好心的朋友帮忙写个com组件程序的例子,包括主com程序和测试程序,对这块我刚刚接触,望高手指点:主com程序(com组件程序),工程名:ComServer ,接口:RetStr,方法:Send,参数:cnt .测试程序:Test.exe ,在调用com组件时这样写:
x := CreateOleObject('ComServer .RetStr')
str:= x.send('哈哈')
运行结果 : str的值为'哈哈'谢谢了,解决问题即结贴。
x := CreateOleObject('ComServer .RetStr')
str:= x.send('哈哈')
运行结果 : str的值为'哈哈'谢谢了,解决问题即结贴。
<<delphi6 開發人員指南>>都有例子, 實現你要的
ComServ,
NumIntf in 'NumIntf.pas',
NumServ in 'NumServ.pas',
PropCom_TLB in 'PropCom_TLB.pas';exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;{$R *.TLB}{$R *.RES}
end.
unit PropCom_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 : 1.2
// File generated on 10/8/2002 12:04:56 AM from Type Library described below.// ************************************************************************ //
// Type Lib: E:\books\md7code\12\PropCom\Propcom.tlb (1)
// LIBID: {5B2EF183-3AAE-11D3-B9F1-00000100A27B}
// LCID: 0
// Helpfile:
// HelpString: PropCom Library
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interfaceuses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// 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
PropComMajorVersion = 1;
PropComMinorVersion = 0; LIBID_PropCom: TGUID = '{5B2EF183-3AAE-11D3-B9F1-00000100A27B}';
implementationuses ComObj;end.
INumberProp = interface
['{B36C5800-8E59-11D0-98D0-444553540000}']
function GetValue: Integer; stdcall;
procedure SetValue (New: Integer); stdcall;
procedure Increase; stdcall;
property Value: Integer
read GetValue write SetValue;
end;implementationend.
unit NumServ;interfaceuses
Windows, ActiveX, ComObj, NumIntf;type
TNumServer = class(TComObject, INumberProp)
private
fValue: Integer;
public
function GetValue: Integer; virtual; stdcall;
procedure SetValue (New: Integer); virtual; stdcall;
procedure Increase; virtual; stdcall;
procedure Initialize; override;
destructor Destroy; override;
end;const
Class_NumPropServer: TGUID =
'{B165F7A1-DDF9-11D1-B9F1-004845400FAA}';implementationuses ComServ;{ TNumServer }destructor TNumServer.Destroy;
begin
inherited;
MessageBox (0, 'Object Destroyed',
'TDLLNumber', mb_OK); // API call
end;function TNumServer.GetValue: Integer;
begin
Result := fValue;
end;procedure TNumServer.Increase;
begin
Inc (fValue);
end;procedure TNumServer.Initialize;
begin
inherited;
fValue := 10;
end;procedure TNumServer.SetValue(New: Integer);
begin
fValue := New;
end;initialization
TComObjectFactory.Create(ComServer, TNumServer, Class_NumPropServer,
'NumPropServer', 'Num Prop Server (Prop Com)', ciMultiInstance, tmSingle);
end.
Forms,
TestComF in 'TestComF.pas' {Form1};{$R *.RES}begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.unit TestComF;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Spin, NumIntf;// redeclare the server GUID
const
Class_Number: TGUID =
'{5B2EF181-3AAE-11D3-B9F1-00000100A27B}';type
TForm1 = class(TForm)
SpinEdit1: TSpinEdit;
Button1: TButton;
Button2: TButton;
SpinEdit2: TSpinEdit;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
Label2: TLabel;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
Num1, Num2 : INumber;
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}uses
ComObj;procedure TForm1.FormCreate(Sender: TObject);
begin
// create first object
Num1 := CreateComObject (Class_Number) as INumber;
Num1.SetValue (SpinEdit1.Value);
Label1.Caption := 'Num1: ' + IntToStr (Num1.GetValue);
Button1.Enabled := True;
Button2.Enabled := True; // create second object
Num2 := CreateComObject (Class_Number) as INumber;
Label2.Caption := 'Num2: ' + IntToStr (Num2.GetValue);
Button3.Enabled := True;
Button4.Enabled := True;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
// change
Num1.SetValue (SpinEdit1.Value);
Label1.Caption := 'Num1: ' + IntToStr (Num1.GetValue);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
// increase
Num1.Increase;
Label1.Caption := 'Num1: ' + IntToStr (Num1.GetValue);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
Num2.SetValue (SpinEdit2.Value);
Label2.Caption := 'Num2: ' + IntToStr (Num2.GetValue);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Num2.Increase;
Label2.Caption := 'Num2: ' + IntToStr (Num2.GetValue);
end;procedure TForm1.Button5Click(Sender: TObject);
var
Num3: INumber;
begin
// create a new temporary COM object
Num3 := CreateComObject (Class_Number) as INumber;
Num3.SetValue (100);
Num3.Increase;
ShowMessage ('Num3: ' + IntToStr (Num3.GetValue));
end;end.