收录日期:2019/01/17 21:41:33 时间: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去掉。
请指教!!!

删除视图问题 netbeans下的项目在myeclipse运行总是报错,帮忙解答下吧! 网站填表有2页,连续自动填表的问题 「100分」 ajax 入门问题ajax+servlet 图片旋转 短信猫为什么只发送了一条短信 请教关于new 和 delete 的问题(程序运行后,我先按下开始,然后按结束,没有问题,再按开始,再按结束,就出现该内存不能为read的错误,求教各路大神) Oracle数据转移 请介绍本java数据库编程 android程序开发选择测试手机型号 MSSQL server 2008 硬盘占用高 关于SQL Server连接的问题 如何用堆栈实现随机生成句子 【要不是她躲进女厕,非抽她两耳光不可!!】 mini2440内核启动出错 JPBM4.4 用户组问题!急急急! 撑不住了 怎么办? 怎么让ReadFile读取指定的数据 网站填表有2页,连续自动填表的问题 devexpress gridControl控件请教 C# 操作word自动刷新域 EDIT滚动的问题 关于qtopia2.2.0 arp报文中,协议地址长度是什么? [请教]windows下nginx+tomcat配置 快速隐藏任务栏 西安公积金贷款,商业贷款的月供和收入的关系 PLSQL9.0.2无法链接到Oracle数据库,弹白框!!! My Sql中建表时的错误该怎么解决 NND!!! 这么写为什么就不对!!!!