收录日期:2018/11/19 05:28:53 时间: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去掉。
请指教!!!

PERL的TK疑问。。。UP50分。。。 请教如何使数据窗口份屏显示?如何是数据窗口里的某个数据暗格显示,以示无效状态? 在客户端显示服务期端的时间,我应该怎么做?? 如何在信使服务中传递文件? DOTNET问题:手机聊天室如何实现自动刷新? 请问如何通过ado.net更新sqlserver的Datetime列 怎么样清除\"密码小偷\" 打开一个文件后,如何判断该文件是否为空? 本人收集的笑话1奉送给大家 问个关于矩阵的问题,请指教 交流--查询第X页,每页Y条记录 PowerDesigner9.5里如何设置一个int字段的默认值为0? 如何将oracle数据库里的表格跟excell表格互相导入导出 急需sock的书 本人收集的笑话2奉送给大家 小问题:关于Math类中的IEEEremainder(arg1,arg2)函数 PowerDesigner9.5里如何设置一个int字段的默认值为0? 我写的一个数据库访问类,请各位帮我提些意见 恭喜MEIZZ,散分! 关于VDSL的问题。我要下岗了! 局域网中机器之间数据库合并复制时的问题? PowerDesigner9.5里如何设置一个int字段的默认值为0? 公司邮箱服务器问题! 达人乱入!! 吐血控诉,深圳市最無師德,最爛的私立學校---寶安區松崗東升實驗學校(來者有分) 吐血控诉,深圳市最無師德,最爛的私立學校---寶安區松崗東升實驗學校 请教各位大虾,ComboBox.AddItem() 怎么使用? 求其他贴子的问题 对话框是不是用控件个数限制的? 在linux下用javac找不到javax.swing.*,大家帮个忙 ActiveReport2中,如果字段内容因过长分行显示时,画在旁边的竖线却不会自动延长,怎么办?