servercontroller.pas

Delphi 应用举例

unit ServerController;
{PUBDIST}

interface

uses
  Classes,
  DatamoduleUnit,
  IWServerControllerBase, IWAppForm, IWApplication,
  SysUtils,dtmdl,DBTables,db;

type
  TIWServerController = class(TIWServerControllerBase)
    procedure IWServerControllerBaseNewSession(ASession: TIWApplication;
      var VMainForm: TIWAppForm);
    procedure IWServerControllerBaseCreate(Sender: TObject);
    procedure IWServerControllerBaseDestroy(Sender: TObject);
    procedure IWServerControllerBaseCloseSession(ASession: TIWApplication);
  private
  public
  end;

  // This is a class which you can add variables to that are specific to the user. Add variables
  // to this class instead of creating global variables. This object can references by using:
  //   UserSession
  // So if a variable named UserName of type string is added, it can be referenced by using:
  //   UserSession.UserName
  // Such variables are similar to globals in a normal application, however these variables are
  // specific to each user.
  //
  // See the IntraWeb Manual for more details.
  TUserSession = class(TComponent)
  public
    userID:string;
    DataModule1: TDataModule1;
    //
    constructor Create(AOwner: TComponent); override;
  end;
  //

  TuserInfo=record
     userID,pwd,mail:string;
     kind:integer;
  end;
  TuserList=class(Tobject)
  public
     locked:boolean;
     function load:integer;
     function find(userID:string):TuserInfo;
     procedure add(newUser:TuserInfo);
     procedure delete(userID:string);
     function checkUser(userID,pwd:string):boolean;
     constructor create;
  end;
// Procs

  var Gdtdml:TDtMdl_userInfo ;
      userList:TuserList;
      userOnLine:integer;
  function UserSession: TUserSession;

implementation
{$R *.dfm}

uses
  IWInit;

function UserSession: TUserSession;
begin
  Result := TUserSession(RWebApplication.Data);
end;

{ TUserSession }

constructor TUserSession.Create(AOwner: TComponent);
begin
  inherited;
  Datamodule1 := TDatamodule1.Create(AOwner);
end;

procedure TIWServerController.IWServerControllerBaseNewSession(
  ASession: TIWApplication; var VMainForm: TIWAppForm);
begin
  ASession.Data := TUserSession.Create(ASession);
  userOnLine:=userOnLine+1;
end;

function TuserList.load:integer;
begin
   //从数据库加载用户信息

   while locked do;//知道解锁
   //轮到我操作了：
   //首先lock，不让别人修改
   locked:=true;
   //下面是操作：
   with Gdtdml.Tbl_user do begin
      close;
      open; 
   end;

   //最后，操作之后要接锁
   locked:=false;
end;
function TuserList.find(userID:string):TuserInfo;
begin
   //如果别人正在使用，则等待
   while locked do;
   //轮到我操作了：
   //首先lock，让别人等待
   locked:=true;

   // 操作：
   result.userID:='';
   with Gdtdml.Tbl_user do begin
      if not active then open;
      if locate('userID',userID,[loCaseInsensitive]) then begin
         result.userID:=userID;
         result.pwd:=fieldbyname('pwd').asString;
         result.mail:=fieldbyname('mail').asString;
         result.kind:=fieldbyname('actor').asinteger;
      end;
   end;

   //最后，操作之后要解锁，以便别人使用
   locked:=false;
end;
procedure TuserList.add(newUser:TuserInfo);
begin
   while locked do;//知道解锁
   //轮到我操作了：
   //首先lock，不让别人修改
   locked:=true;

   with Gdtdml.Tbl_user do begin
      if not active then open;
      if not locate('userID',newUser.userID,[loCaseInsensitive]) then begin
         append;
         fieldbyname('userID').asstring:=newUser.userID;
      end;
      fieldbyname('pwd').asString:=newUser.pwd;
      fieldbyname('mail').asString:=newUser.mail;
      fieldbyname('actor').asinteger:=newUser.kind;
      post;
   end;


   //最后，操作之后要接锁
   locked:=false;
end;
procedure TuserList.delete(userID:string);
begin
   while locked do;//知道解锁
   //轮到我操作了：
   //首先lock，不让别人修改
   locked:=true;

    with Gdtdml.Tbl_user do begin
      if not active then open;
      if locate('userID',userID,[loCaseInsensitive]) then delete;
   end;

   //最后，操作之后要接锁
   locked:=false;
end;
constructor TuserList.create;
begin
   load;
end;
function TuserList.checkUser(userID,pwd:string):boolean;
var buf:TUserinfo;
begin
   result:=false;
   buf:=find(userID);
   if buf.userID='' then exit;
   result:=buf.pwd=pwd;
end;
//
procedure TIWServerController.IWServerControllerBaseCreate(
  Sender: TObject);
begin
  Gdtdml:=TDtMdl_userInfo.Create(self) ;
  userList:=TuserList.create;
  userOnLine:=0;
end;

procedure TIWServerController.IWServerControllerBaseDestroy(
  Sender: TObject);
begin
  Gdtdml.Free;
  userList.Free;
end;



procedure TIWServerController.IWServerControllerBaseCloseSession(
  ASession: TIWApplication);
begin
  userOnLine:=userOnLine-1;
end;

end.