1 unit Unit2;
 2 
 3 {$WARN SYMBOL_PLATFORM OFF}
 4 
 5 interface
 6 
 7 uses
 8   ComObj, ActiveX, D2007ComServer_TLB, StdVcl,
 9   Variants;//Variants必须引入
10 type
11   TD2007TestD2007Test = class(TAutoObject, ID2007Test)
12   private
13     function TextToOleData(const AText: string): OleVariant;
14     function OleDataToText(const AData: OleVariant): string;
15   public
16     //在此不得不说，COM中用的数据类型与咱们之前在DLEPHI的程序中有所不同。必须注意
17     //A+B 加法
18     procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;//整型数据处理
19     //A&B 拼接
20     procedure AddString(const AString1: WideString; const AString2: WideString;
21                         out AReturn: OleVariant); safecall;//字符串数据处理
22   end;
23 
24 implementation
25 
26 uses ComServ;
27 
28 { Td7test }
29 
30 procedure TD2007TestD2007Test.AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);
31 begin
32   AReturn :=  ANumber1 + ANumber2;
33 end;
34 
35 procedure TD2007TestD2007Test.AddString(const AString1: WideString; const AString2: WideString;
36   out AReturn: OleVariant);
37 begin
38   AReturn := AString1 + ' ' + AString2;
39 end;
40 
41 function TD2007TestD2007Test.OleDataToText(const AData: OleVariant): string;
42 var
43   nSize: Integer;
44   pData: Pointer;
45 begin
46   if AData = Null then
47     Result := ''
48   else begin
49     nSize := VarArrayHighBound(AData, 1) - VarArrayLowBound(AData, 1) + 1;
50     SetLength(Result, nSize);
51     pData := VarArrayLock(AData);
52     try
53       Move(pData^, Pchar(Result)^, nSize);
54     finally
55       VarArrayUnlock(AData);
56     end;
57   end;
58 end;
59 
60 function TD2007TestD2007Test.TextToOleData(const AText: string): OleVariant;
61 var
62   nSize: Integer;
63   pData: Pointer;
64 begin
65   nSize := Length(AText);
66   if nSize = 0 then
67     Result := Null
68   else begin
69     Result := VarArrayCreate([0, nSize - 1], varByte);
70     pData := VarArrayLock(Result);
71     try
72       Move(Pchar(AText)^, pData^, nSize);
73     finally
74       VarArrayUnlock(Result);
75     end;
76   end;
77 end;
78 
79 initialization
80   TAutoObjectFactory.Create(ComServer, TD2007TestD2007Test, Class_D2007Test,
81     ciMultiInstance, tmApartment);
82 end.

  1 unit D2007ComServer_TLB;
  2 
  3 // ************************************************************************ //
  4 // WARNING                                                                    
  5 // -------                                                                    
  6 // The types declared in this file were generated from data read from a       
  7 // Type Library. If this type library is explicitly or indirectly (via        
  8 // another type library referring to this type library) re-imported, or the   
  9 // 'Refresh' command of the Type Library Editor activated while editing the   
 10 // Type Library, the contents of this file will be regenerated and all        
 11 // manual modifications will be lost.                                         
 12 // ************************************************************************ //
 13 
 14 // $Rev: 8291 $
 15 // File generated on 2016/8/15 14:49:21 from Type Library described below.
 16 
 17 // ************************************************************************  //
 18 // Type Lib: E:\D2007Com\D2007ComServer\D2007ComServer.tlb (1)
 19 // LIBID: {DF65EF04-7A4E-4A68-9132-7D357AF71708}
 20 // LCID: 0
 21 // Helpfile: 
 22 // HelpString: D2007ComServer Library
 23 // DepndLst:
 24 //   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
 25 // ************************************************************************ //
 26 {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
 27 {$WARN SYMBOL_PLATFORM OFF}
 28 {$WRITEABLECONST ON}
 29 {$VARPROPSETTER ON}
 30 interface
 31 
 32 uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
 33   
 34 
 35 // *********************************************************************//
 36 // GUIDS declared in the TypeLibrary. Following prefixes are used:        
 37 //   Type Libraries     : LIBID_xxxx                                      
 38 //   CoClasses          : CLASS_xxxx                                      
 39 //   DISPInterfaces     : DIID_xxxx                                       
 40 //   Non-DISP interfaces: IID_xxxx                                        
 41 // *********************************************************************//
 42 const
 43   // TypeLibrary Major and minor versions
 44   D2007ComServerMajorVersion = 1;
 45   D2007ComServerMinorVersion = 0;
 46 
 47   LIBID_D2007ComServer: TGUID = '{DF65EF04-7A4E-4A68-9132-7D357AF71708}';
 48 
 49   IID_ID2007Test: TGUID = '{BA65E10E-369E-4285-B7B7-4FE85678EAC0}';
 50   CLASS_D2007Test: TGUID = '{3C531DD1-361D-4F28-B817-3EA79DE2205A}';
 51 type
 52 
 53 // *********************************************************************//
 54 // Forward declaration of types defined in TypeLibrary                    
 55 // *********************************************************************//
 56   ID2007Test = interface;
 57   ID2007TestDisp = dispinterface;
 58 
 59 // *********************************************************************//
 60 // Declaration of CoClasses defined in Type Library                       
 61 // (NOTE: Here we map each CoClass to its Default Interface)              
 62 // *********************************************************************//
 63   D2007Test = ID2007Test;
 64 
 65 
 66 // *********************************************************************//
 67 // Interface: ID2007Test
 68 // Flags:     (4416) Dual OleAutomation Dispatchable
 69 // GUID:      {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
 70 // *********************************************************************//
 71   ID2007Test = interface(IDispatch)
 72     ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
 73     procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;
 74     procedure AddString(const AString1: WideString; const AString2: WideString; 
 75                         out AReturn: OleVariant); safecall;
 76   end;
 77 
 78 // *********************************************************************//
 79 // DispIntf:  ID2007TestDisp
 80 // Flags:     (4416) Dual OleAutomation Dispatchable
 81 // GUID:      {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
 82 // *********************************************************************//
 83   ID2007TestDisp = dispinterface
 84     ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
 85     procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); dispid 201;
 86     procedure AddString(const AString1: WideString; const AString2: WideString; 
 87                         out AReturn: OleVariant); dispid 202;
 88   end;
 89 
 90 // *********************************************************************//
 91 // The Class CoD2007Test provides a Create and CreateRemote method to          
 92 // create instances of the default interface ID2007Test exposed by              
 93 // the CoClass D2007Test. The functions are intended to be used by             
 94 // clients wishing to automate the CoClass objects exposed by the         
 95 // server of this typelibrary.                                            
 96 // *********************************************************************//
 97   CoD2007Test = class
 98     class function Create: ID2007Test;
 99     class function CreateRemote(const MachineName: string): ID2007Test;
100   end;
101 
102 implementation
103 
104 uses ComObj;
105 
106 class function CoD2007Test.Create: ID2007Test;
107 begin
108   Result := CreateComObject(CLASS_D2007Test) as ID2007Test;
109 end;
110 
111 class function CoD2007Test.CreateRemote(const MachineName: string): ID2007Test;
112 begin
113   Result := CreateRemoteComObject(MachineName, CLASS_D2007Test) as ID2007Test;
114 end;
115 
116 end.

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls,
 8   D2007ComServer_TLB, ActiveX, OleServer, jpeg, ExtCtrls;
 9 
10 type
11   TForm1 = class(TForm)
12     Button1: TButton;
13     Label1: TLabel;
14     Label2: TLabel;
15     Image1: TImage;
16     procedure Button1Click(Sender: TObject);
17   private
18     { Private declarations }
19   public
20     { Public declarations }
21   end;
22 
23 var
24   Form1: TForm1;
25 
26 implementation
27 
28 {$R *.dfm}
29 
30 procedure TForm1.Button1Click(Sender: TObject);
31 var
32   oD2007Test :TD2007Test;
33   iInteger1, iInteger2: sysint;
34   iResult: OleVariant;
35   sString1, sString2: string;
36   sResult: OleVariant;
37 begin
38   oD2007Test := TD2007Test.Create(nil);
39   oD2007Test.ConnectKind := ckRunningOrNew;
40   //数字处理
41   iInteger1 := 1;
42   iInteger2 := 2;
43   iResult := 0;
44   oD2007Test.AddNumber(iInteger1, iInteger2, iResult);
45   Label1.Caption := IntToStr(iResult);
46   //字符处理
47   sString1 := '3';
48   sString2 := '4';
49   sResult := '';
50   oD2007Test.AddString(sString1, sString2, sResult);
51   Label2.Caption := sResult;
52 end;
53 
54 end.

  1 unit D2007ComServer_TLB;
  2 
  3 // ************************************************************************ //
  4 // WARNING                                                                    
  5 // -------                                                                    
  6 // The types declared in this file were generated from data read from a       
  7 // Type Library. If this type library is explicitly or indirectly (via        
  8 // another type library referring to this type library) re-imported, or the   
  9 // 'Refresh' command of the Type Library Editor activated while editing the   
 10 // Type Library, the contents of this file will be regenerated and all        
 11 // manual modifications will be lost.                                         
 12 // ************************************************************************ //
 13 
 14 // $Rev: 8291 $
 15 // File generated on 2016/8/15 14:29:34 from Type Library described below.
 16 
 17 // ************************************************************************  //
 18 // Type Lib: E:\D2007Com\D2007ComServer\D2007ComServer.exe (1)
 19 // LIBID: {DF65EF04-7A4E-4A68-9132-7D357AF71708}
 20 // LCID: 0
 21 // Helpfile: 
 22 // HelpString: D2007ComServer Library
 23 // DepndLst: 
 24 //   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
 25 // ************************************************************************ //
 26 // *************************************************************************//
 27 // NOTE:                                                                      
 28 // Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties  
 29 // which return objects that may need to be explicitly created via a function 
 30 // call prior to any access via the property. These items have been disabled  
 31 // in order to prevent accidental use from within the object inspector. You   
 32 // may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively   
 33 // removing them from the $IFDEF blocks. However, such items must still be    
 34 // programmatically created via a method of the appropriate CoClass before    
 35 // they can be used.                                                          
 36 {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
 37 {$WARN SYMBOL_PLATFORM OFF}
 38 {$WRITEABLECONST ON}
 39 {$VARPROPSETTER ON}
 40 interface
 41 
 42 uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
 43   
 44 
 45 // *********************************************************************//
 46 // GUIDS declared in the TypeLibrary. Following prefixes are used:        
 47 //   Type Libraries     : LIBID_xxxx                                      
 48 //   CoClasses          : CLASS_xxxx                                      
 49 //   DISPInterfaces     : DIID_xxxx                                       
 50 //   Non-DISP interfaces: IID_xxxx                                        
 51 // *********************************************************************//
 52 const
 53   // TypeLibrary Major and minor versions
 54   D2007ComServerMajorVersion = 1;
 55   D2007ComServerMinorVersion = 0;
 56 
 57   LIBID_D2007ComServer: TGUID = '{DF65EF04-7A4E-4A68-9132-7D357AF71708}';
 58 
 59   IID_ID2007Test: TGUID = '{BA65E10E-369E-4285-B7B7-4FE85678EAC0}';
 60   CLASS_D2007Test: TGUID = '{3C531DD1-361D-4F28-B817-3EA79DE2205A}';
 61 type
 62 
 63 // *********************************************************************//
 64 // Forward declaration of types defined in TypeLibrary                    
 65 // *********************************************************************//
 66   ID2007Test = interface;
 67   ID2007TestDisp = dispinterface;
 68 
 69 // *********************************************************************//
 70 // Declaration of CoClasses defined in Type Library                       
 71 // (NOTE: Here we map each CoClass to its Default Interface)              
 72 // *********************************************************************//
 73   D2007Test = ID2007Test;
 74 
 75 
 76 // *********************************************************************//
 77 // Interface: ID2007Test
 78 // Flags:     (4416) Dual OleAutomation Dispatchable
 79 // GUID:      {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
 80 // *********************************************************************//
 81   ID2007Test = interface(IDispatch)
 82     ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
 83     procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;
 84     procedure AddString(const AString1: WideString; const AString2: WideString; 
 85                         out AReturn: OleVariant); safecall;
 86   end;
 87 
 88 // *********************************************************************//
 89 // DispIntf:  ID2007TestDisp
 90 // Flags:     (4416) Dual OleAutomation Dispatchable
 91 // GUID:      {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
 92 // *********************************************************************//
 93   ID2007TestDisp = dispinterface
 94     ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
 95     procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out ARet