fmmain.pas

这是不可多得的源代码

unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, PCountDemo_TLB, ComObj, ComServ;

type
  TForm1 = class(TForm)
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    LabeledEdit3: TLabeledEdit;
    BitBtn4: TBitBtn;
    LabeledEdit4: TLabeledEdit;
    ListBox1: TListBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowStartMode;
    procedure ShowObjCount;
    procedure ShowObjCount1;
    procedure ShowClassInfo(Factory : TComObjectFactory);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ActiveX;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  iObj : ICountObjDemo;
begin
  iObj := CoCountObjDemo.Create;

  ShowStartMode;
  ShowObjCount;
end;

procedure TForm1.ShowObjCount;
begin
  Self.LabeledEdit2.Text := IntToStr(ComServer.ObjectCount);
end;

procedure TForm1.ShowObjCount1;
begin
  Self.LabeledEdit3.Text := IntToStr(ComServer.ObjectCount);
end;

procedure TForm1.ShowStartMode;
begin
  case ComServer.StartMode of    //
    ComServ.smStandalone : Self.LabeledEdit1.Text := 'Standalone';
    ComServ.smAutomation : Self.LabeledEdit1.Text := 'Automation';
    ComServ.smRegServer : Self.LabeledEdit1.Text := 'RegServer';
    ComServ.smUnregServer : Self.LabeledEdit1.Text := 'UnregServer';
  end;    // case
end;

const
  IID_Factory: TGUID = '{00000001-0000-0000-C000-000000000046}';

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  aIntf : ICountObjDemo;
  aFactory : IClassFactory;
begin
  OleCheck(CoGetClassObject(CLASS_CountObjDemo, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER,
           nil, IID_Factory, aFactory));

  aFactory.CreateInstance(nil, IID_ICountObjDemo, aIntf);
  ShowObjCount1;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  aFactory : TComObjectFactory;
//  aObj : TComObject;
begin
  ComClassManager.ForEachFactory(ComServer, ShowClassInfo);
//  aFactory := ComClassManager.GetFactoryFromClassID(CLASS_CountObjDemo);
//  Self.LabeledEdit4.Text := aFactory.ProgID;
//  aObj := aFactory.CreateComObject(nil);

end;

procedure TForm1.ShowClassInfo(Factory: TComObjectFactory);
begin
  ListBox1.Items.Add(Factory.ProgID);
end;

end.