收录日期:2019/03/21 00:19:27 时间:2016/05/24 10:41:42 标签:网络通信/分布式开发
最近我学习com+碰到问题:运行后提示“灾难性故障”。程序为一个简单的登录程序,输入姓名,密码,服务器名后点登录按钮登陆。这是李维《Delphi 5.X ADO_MTS_COM+高级程序设计篇》的例子。请指点。QQ:49984041,Email:thebestofbest@21cn.com

源码:
//com+单元
unit UDemomtsprofile;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, bdemts, DataBkr,Contnrs, DBClient,
  MtsRdm, Mtx, PDemoProfile_TLB;
type
    TSimpleProfile=class(TObject)
    private
      FName:string;
      FPassword:string;
      FCookie:string;
    protected

    public
      property Name:string read FName write FName;
      property Password:string read FPassword write FPassword;
      property Cookie:string read FCookie write FCookie;
    end;
type
  TmtsSecurityObj = class(TMtsDataModule, ImtsSecurityObj)
  private
    { Private declarations }
    aProfile:TObjectList;
    procedure SetupDemoProfiles;

  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure login(const sName, sPassword: WideString;
      var vCookie: OleVariant); safecall;
  public
    procedure Initialize;
    destructor Destroy;override;
    { Public declarations }
  end;

var
  mtsSecurityObj: TmtsSecurityObj;

implementation

{$R *.DFM}

class procedure TmtsSecurityObj.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

procedure TmtsSecurityObj.login(const sName, sPassword: WideString;
  var vCookie: OleVariant);
var iCount:integer;
  aPerson:TSimpleProfile;
begin
  vCookie:='';
  for iCount:=0 to aProfile.count-1 do
    begin
      aPerson:=TSimpleProfile(aProfile.items[iCount]);
      if ((aPerson.Name =sName) and (aPerson.Password =sPassword)) then
        vCookie:=aPerson.Cookie ;
    end;
end;

destructor TmtsSecurityObj.Destroy;
begin

  inherited;
  aProfile.clear;
  aProfile.free;
end;

procedure TmtsSecurityObj.Initialize;
begin
  inherited;
  aProfile:=TObjectList.create;
  SetupDemoProfiles;  
end;

procedure TmtsSecurityObj.SetupDemoProfiles;
var
  aPerson:TSimpleprofile;
begin
  aPerson:=TSimpleprofile.create;
  aPerson.Name :='aaa';
  aPerson.Password :='111';
  aPerson.Cookie :=CreateClassID;
  aProfile.add(aPerson);
  aPerson.Name :='bbb';
  aPerson.Password :='222';
  aPerson.Cookie :=CreateClassID;
  aProfile.add(aPerson);
end;

initialization
  TComponentFactory.Create(ComServer, TmtsSecurityObj,
    Class_mtsSecurityObj, ciMultiInstance, tmApartment);
end.

//登录窗体单元 edit1 姓名,edit2 密码,edit3 返回GUID,edit4 服务器名
unit UClientlogin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,PDemoProfile_TLB, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Edit4: TEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  loginObj:ImtsSecurityObj;
  vCookie:OleVariant;
begin
  loginObj:=ComtsSecurityObj.createRemote('jjj');
  loginObj.login(edit1.text,edit2.text,vCookie);
  if (vCookie<>'') then
  begin
    edit3.text:=vCookie;
    edit3.visible:=true;
  end
  else
    showmessage('无效的登录!');
end;

end.



问题可能出在SetupDemoProfiles上,因为缺省底TObjectList在释放时会释放包含的对象,在SetupDemoProfiles里面你的aPerson只被创建了一次,却被Add了两次,所以在释放时会被重复释放。你应该在添加add完了以后再创建一个。
procedure TmtsSecurityObj.SetupDemoProfiles;
var
  aPerson:TSimpleprofile;
begin
  aPerson:=TSimpleprofile.create;
  aPerson.Name :='aaa';
  aPerson.Password :='111';
  aPerson.Cookie :=CreateClassID;
  aProfile.add(aPerson);

  aPerson:=TSimpleprofile.create; //注意加这一行

  aPerson.Name :='bbb';
  aPerson.Password :='222';
  aPerson.Cookie :=CreateClassID;
  aProfile.add(aPerson);

end;
To:superatom(超级原子) 
问题在Iitialize中
procedure TmtsSecurityObj.Initialize;
begin
  inherited;
  aProfile:=TObjectList.create;//1
  SetupDemoProfiles;           //2
end;
如果我把1,2句放到其它放法或函数中就正常,我认为是initialize没有执行但又不知怎么改
注:书中是 procedure Initialize;override; 重载的,但在D7中提示在基类中找不到方法,
    所以我将override去掉。
请指教!!!

程序员写在11.11... 问大家一个数据库每日定时执行的问题,任务计划 急急急! if() {}else{do{while()}}植入网页里不知道}那里错误了!看的眼晕! 光棍节快乐 javascript中是值是怎么交换了? 关于蓝牙WSALookupServiceNext()错误10050的问题 关于多线程操作1和队列对象时的锁问题 请问在web开发中如何固定div高度并且使得div中内容放得下 开发测试工程师招聘流程、面试内容和工作内容 C#中string.contains(string str)忽略大小写 如何通过判断光标的位置来显示不同说明信息 只为博梁妹妹一笑 这种功能怎么实现? 可否在windows上编写一个程序,直接调用网卡驱动来实现以太网通讯? 大数据量操作,如果提高系统性能 帮忙看下想要4列5行,为什么出来是1列20行啊 可以违反“程序和数据相互独立”原则吗? 求jboss3与4的区别!!!! 爆料啦--关于中国四代歼击机以及601所与611所之争:新歼名--歼20(ZT) 谁有CMenuXP类啊 POST问题 高薪诚聘:PHP程序员 mysql_store_result(conn);出错。来高手看下 有个女女,送个我一个晴天娃娃,我想知道晴天娃娃有什么寓意? 这周要到腾讯公司面试 想在asp页面做一个语音提示的功能! treeview问题 如何把picturebox做成按钮一样的 急!求linux高手!静态页面乱码!