在Delphi.net中调用COM/COM+

核心提示： 客户的系统是C/S和B/S的结合，B/S部分原来计划用IntraWeb,刚好Delphi.net出现，在Delphi.net中调用COM/COM+，所以B/S部分改用Delphi.net;在开发过程中出现了一个问题：加密算法是Delphi 7开发的，时间太紧不可能用Delphi.net重写加密算法，一个Label;双

 

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

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

// 以下为源码部分:

COM/COM+工程文件(ComProject.dpr):

library ComProject;

uses
  ComServ,
  ComProject_TLB in 'ComProject_TLB.pas',
  Test in 'Test.pas' {Test: CoClass};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

//COM/COM+的Test单元(Test.pas):

unit Test;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, ComProject_TLB, StdVcl;

type
  TTest = class(TTypedComObject, ITest)
  protected
　  function GetMsg(out Msg: WideString): HResult; stdcall;
　  {Declare ITest methods here}
  end;

implementation

uses ComServ;

function TTest.GetMsg(out Msg: WideString): HResult;
begin
  Msg := 'Com/Com+测试成功!';
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TTest, Class_Test,
　  ciMultiInstance, tmApartment);
end.

//COM/COM+的类型库t单元(ComProject_TLB.pas):

unit 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' 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 Files\Borland\Delphi7\Projects\comtest2\ComProject.tlb (1)
// LIBID: {92B46A1D-8A31-46C5-98FE-C03FEA98DC21}
// LCID: 0
// Helpfile:
// HelpString: ComProject Library
// DepndLst:
//　 (1) v2.0 stdole, (D:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be 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
  ComProjectMajorVersion = 1;
  ComProjectMinorVersion = 0;

  LIBID_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 ComObj;

class function CoTest.Create: ITest;
begin
  Result := CreateComObject(CLASS_Test) as ITest;
end;

class function CoTest.CreateRemote(const MachineName: string): ITest;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Test) as ITest;
end;

end.

/////////////////////////////////////以下为Delphi.net调用COM/COM+源码////////////////////////////

//WebForm1.pas单元:

unit WebForm1;

interface

uses
  System.Collections, System.ComponentModel,
  System.Data, System.Drawing, System.Web, System.Web.sessionState,
  System.Web.UI, System.Web.UI.WebControls, System.Web.UI.HtmlControls,
  ComProject;

type
  TWebForm1 = class(System.Web.UI.Page)
  {$REGION 'Designer Managed Code'}
  strict private
　  procedure InitializeComponent;
　  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.InitializeComponent;
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
  //
  InitializeComponent;
  inherited OnInit(e);
end;

procedure TWebForm1.Button1_Click(sender: System.Object; e: System.EventArgs);
var
  Msg: string;
  Obj: TObject;
begin
  Obj := Server.CreateObject('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" Aspcompat="true"%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">

<html>
  <head>
　  <title></title>
　  <meta name="GENERATOR" content="Borland Package Library 7.1">
  </head>

  <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>