程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 在Delphi.net中調用COM/COM+

在Delphi.net中調用COM/COM+

編輯:Delphi
 客戶的系統是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 FilesBorlandDelphi7Projectscomtest2ComProject.tlb (1)
  // LIBID: {92B46A1D-8A31-46C5-98FE-C03FEA98DC21}
  // LCID: 0
  // Helpfile:
  // HelpString: ComProject Library
  // DepndLst:
  //   (1) v2.0 stdole, (D:Windowssystem32stdole2.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
                 
                  runat="server" text="Button">
      </ASP:button>
      <ASP:label id=Label1
                
                 runat="server">Label</ASP:label>
    </form>
  </body>
  </Html>
  

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved