在Delphi.net中调用COM/COM+

最新推荐文章于 2015-04-19 16:54:03 发布

zgqtxwd

最新推荐文章于 2015-04-19 16:54:03 发布

阅读量395

点赞数

分类专栏： delphi 文章标签： webform library button class delphi function

delphi 专栏收录该内容

758 篇文章 0 订阅

订阅专栏

客户的系统是C/S和B/S的结合，B/S部分原来计划用IntraWeb,
刚好COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>net出现，所以B/S部分改用COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>net;
在开发过程中出现了一个问题：加密算法是COM" target=_blank>COM" target=_blank>Delphi 7开发的，
时间太紧不可能用COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>net重写加密算法，于是想到COM" target=_blank>COM/COM" target=_blank>COM+,
只可惜COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>net资料很少，与COM" target=_blank>COM/COM" target=_blank>COM+互操作的资料就更少了。
于是自己摸索，便有下文(源码附后)：

1，在COM" target=_blank>COM" target=_blank>Delphi 7中建立COM" target=_blank>COM/COM" target=_blank>COM+
(1)在IDE中File -> New -> Other -> ActiveX -> ActiveX Library,
将工程文件保存为COM" target=_blank>COMProject;
(2)在IDE中File -> New -> Other -> ActiveX -> COM" target=_blank>COM Object,
在Class Name栏填上Test,该单元保存为Test;
(3)在IDE中View -> Type Library给ITest加一个名为GetMsg的过程;
(4)Ctrl + F9;
(5)在IDE中Run -> Register ActiveX Server; // 注册COM" target=_blank>COM/COM" target=_blank>COM+也可用命令行
2, 在COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>netCOM" target=_blank>COM" target=_blank>中调用COM" target=_blank>COM/COM" target=_blank>COM+
(1)在IDE中File -> New -> ASP.COM" target=_blank>COM" target=_blank>net Web Application,
可能会遇到很多麻烦要你自己搞定哦！
(2)添加COM" target=_blank>COM/COM" target=_blank>COM+的引用:
在IDE中Project ->Add Reference -> COM" target=_blank>COM Imports,
选中刚才注册的COM" target=_blank>COMProject,点击Add Reference 添加引用，
单击OK(要注意你的项目文件(ASP.COM" target=_blank>COM" target=_blank>net Web Application)
的路径(Path)不能使用中文哦);
(3)在WebForm1得uses中添加COM" target=_blank>COMProject;
(4)调用COM" target=_blank>COM/COM" target=_blank>COM+
在WebForm1上方上两个Web Control：一个Button，一个Label;
双击Button，在过程中写上:
var
Msg: string;
Obj: TObject;
begin
Obj := Server.CreateObject('COM" target=_blank>COMProject.Test'); // 建立COM" target=_blank>COM/COM" target=_blank>COM+
Test(Obj).GetMsg(Msg); // 将Obj转换为Test，调用GetMsg方法;
Label1.Text := Msg;
end;
(5)在WebForm1.aspx的Page行中加上AspCOM" target=_blank>COMpat="true",
如:<%@ Page language="c#" Debug="true" Codebehind="WebForm1.pas" AutoEventWireup="false" Inherits="WebForm1.TWebForm1" AspCOM" target=_blank>COMpat="true"%>
(6)Ctrl + F9,Run ->Run(或者Run Without Debugging);
(7)在网页中点击Button，是不是搞定了！

// 以下为源码部分:

COM" target=_blank>COM/COM" target=_blank>COM+工程文件(COM" target=_blank>COMProject.dpr):

library COM" target=_blank>COMProject;

uses
COM" target=_blank>COMServ,
COM" target=_blank>COMProject_TLB in 'COM" target=_blank>COMProject_TLB.pas',
Test in 'Test.pas' {Test: CoClass};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

//COM" target=_blank>COM/COM" target=_blank>COM+的Test单元(Test.pas):

unit Test;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, ActiveX, Classes, COM" target=_blank>COMObj, COM" target=_blank>COMProject_TLB, StdVcl;

type
TTest = class(TTypedCOM" target=_blank>COMObject, ITest)
protected
function GetMsg(out Msg: WideString): HResult; stdcall;
{Declare ITest methods here}
end;

implementation

uses COM" target=_blank>COMServ;

function TTest.GetMsg(out Msg: WideString): HResult;
begin
Msg := 'COM" target=_blank>COM/COM" target=_blank>COM+测试成功!';
end;

initialization
TTypedCOM" target=_blank>COMObjectFactory.Create(COM" target=_blank>COMServer, TTest, Class_Test,
ciMultiInstance, tmApartment);
end.

//COM" target=_blank>COM/COM" target=_blank>COM+的类型库t单元(COM" target=_blank>COMProject_TLB.pas):

unit COM" target=_blank>COMProject_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' COM" target=_blank>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 2004-2-6 13:28:46 from Type Library described below.

// ************************************************************************ //
// Type Lib: D:Program FilesBorlandCOM" target=_blank>COM" target=_blank>Delphi7ProjectsCOM" target=_blank>COMtest2COM" target=_blank>COMProject.tlb (1)
// LIBID: {92B46A1D-8A31-46C5-98FE-C03FEA98DC21}
// LCID: 0
// Helpfile:
// HelpString: COM" target=_blank>COMProject Library
// DepndLst:
// (1) v2.0 stdole, (D:WINDOWSsystem32stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be COM" target=_blank>COMpiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses 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
COM" target=_blank>COMProjectMajorVersion = 1;
COM" target=_blank>COMProjectMinorVersion = 0;

LIBID_COM" target=_blank>COMProject: TGUID = '{92B46A1D-8A31-46C5-98FE-C03FEA98DC21}';

IID_ITest: TGUID = '{96CECA70-1438-4C54-982E-67C378F085E8}';
CLASS_Test: TGUID = '{CA54722F-C5EF-4814-A8DB-C1C357832F08}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
ITest = interface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Test = ITest;

// *********************************************************************//
// Interface: ITest
// Flags:     (256) OleAutomation
// GUID:      {96CECA70-1438-4C54-982E-67C378F085E8}
// *********************************************************************//
ITest = interface(IUnknown)
    ['{96CECA70-1438-4C54-982E-67C378F085E8}']
    function GetMsg(out Msg: WideString): HResult; stdcall;
end;

// *********************************************************************//
// The Class CoTest provides a Create and CreateRemote method to
// create instances of the default interface ITest exposed by
// the CoClass Test. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoTest = class
    class function Create: ITest;
    class function CreateRemote(const MachineName: string): ITest;
end;

implementation

uses COM" target=_blank>COMObj;

class function CoTest.Create: ITest;
begin
Result := CreateCOM" target=_blank>COMObject(CLASS_Test) as ITest;
end;

class function CoTest.CreateRemote(const MachineName: string): ITest;
begin
Result := CreateRemoteCOM" target=_blank>COMObject(MachineName, CLASS_Test) as ITest;
end;

end.

/以下为COM" target=_blank>COM" target=_blank>Delphi.COM" target=_blank>COM" target=_blank>net调用COM" target=_blank>COM/COM" target=_blank>COM+源码

//WebForm1.pas单元:

unit WebForm1;

interface

uses
System.Collections, System.COM" target=_blank>COMponentModel,
System.Data, System.Drawing, System.Web, System.Web.SessionState,
System.Web.UI, System.Web.UI.WebControls, System.Web.UI.HtmlControls,
COM" target=_blank>COMProject;

type
TWebForm1 = class(System.Web.UI.Page)
{$REGION 'Designer Managed Code'}
strict private
    procedure InitializeCOM" target=_blank>COMponent;
    procedure Button1_Click(sender: System.Object; e: System.EventArgs);
{$ENDREGION}
strict private
    procedure Page_Load(sender: System.Object; e: System.EventArgs);
strict protected
    Button1: System.Web.UI.WebControls.Button;
    Label1: System.Web.UI.WebControls.Label;
    procedure OnInit(e: EventArgs); override;
private
    { Private Declarations }
public
    { Public Declarations }
end;

implementation

{$REGION 'Designer Managed Code'}
/// <summary>
/// Required method for Designer support -- do not modify
/// the contents of this method with the code editor.
/// </summary>
procedure TWebForm1.InitializeCOM" target=_blank>COMponent;
begin
Include(Self.Button1.Click, Self.Button1_Click);
Include(Self.Load, Self.Page_Load);
end;
{$ENDREGION}

procedure TWebForm1.Page_Load(sender: System.Object; e: System.EventArgs);
begin
// TODO: Put user code to initialize the page here
end;

procedure TWebForm1.OnInit(e: EventArgs);
begin
//
// Required for Designer support
//
InitializeCOM" target=_blank>COMponent;
inherited OnInit(e);
end;

procedure TWebForm1.Button1_Click(sender: System.Object; e: System.EventArgs);
var
Msg: string;
Obj: TObject;
begin
Obj := Server.CreateObject('COM" target=_blank>COMProject.Test');
Test(Obj).GetMsg(Msg);
Label1.Text := Msg;
end;

end.

///WebForm1.aspx单元:

<%@ Page language="c#" Debug="true" Codebehind="WebForm1.pas" AutoEventWireup="false" Inherits="WebForm1.TWebForm1" AspCOM" target=_blank>COMpat="true"%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">

<body ms_positioning="GridLayout">
<form runat="server">
    <asp:button id=Button1
                style="Z-INDEX: 1; LEFT: 238px; POSITION: absolute; TOP: 158px"
                runat="server" text="Button">
    </asp:button>
    <asp:label id=Label1
               style="Z-INDEX: 2; LEFT: 190px; POSITION: absolute; TOP: 54px"
               runat="server">Label</asp:label>
</form>
</body>
</html>