frmusers.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

//
// Users dialog
//
// (c) Chicony Software 20001                                                            in
//
// When        Who     Why
// ---------   ---     ------------------------------------------------------------
// 2001.6.13   Century Initial Version
//
unit frmUsers;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ImgList, ToolWin, ExtCtrls, Menus, Buttons,
  vafuncs, utils, frmDataGrid,wpfuncs,prefs, Spin, CheckLst,DBmain;
type
  Tref = Record
    t_eUsername,t_eDescription,t_edEmail:string;
    t_rbNevExp,t_rbExpired:boolean;
    t_cbRithgs:string;
    t_days:integer;
  end;

type
  TfrmAS_Users = class(TForm)
    PageControl: TPageControl;
    tsMain: TTabSheet;
    Label1: TLabel;
    eUsername: TEdit;
    eDescription: TEdit;
    Label2: TLabel;
    Label4: TLabel;
    ePassword: TEdit;
    Label3: TLabel;
    Label5: TLabel;
    edConform: TEdit;
    rbExpired: TRadioButton;
    rbNevExp: TRadioButton;
    gpExp: TGroupBox;
    Label7: TLabel;
    SpinEdit1: TSpinEdit;
    GroupBox1: TGroupBox;
    cbRights: TComboBox;
    GroupBox2: TGroupBox;
    cbStatus: TComboBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    tsGroups: TTabSheet;
    btCreate: TBitBtn;
    btClose: TBitBtn;
    edId: TEdit;
    sbtnDelete: TSpeedButton;
    sbtnAdd: TSpeedButton;
    listgroups: TListBox;
    listAccGroup: TListBox;
    Label8: TLabel;
    Label9: TLabel;
    tsRights: TTabSheet;
    sbtnAdd1: TSpeedButton;
    sbtnDelete1: TSpeedButton;
    Label10: TLabel;
    Label11: TLabel;
    GroupBox5: TGroupBox;
    lstTarget: TListBox;
    GroupBox6: TGroupBox;
    lstSource: TListBox;
    cbgroup: TComboBox;
    EDZW: TEdit;
    procedure tbExitClick(Sender: TObject);
    procedure rbExpiredClick(Sender: TObject);
    procedure rbNevExpClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btCreateClick(Sender: TObject);
    procedure SpinEdit1Exit(Sender: TObject);
    procedure sbtnAddClick(Sender: TObject);
    procedure listgroupsDblClick(Sender: TObject);
    procedure sbtnDeleteClick(Sender: TObject);
    procedure listAccGroupDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lstSourceDblClick(Sender: TObject);
    procedure lstTargetDblClick(Sender: TObject);
    procedure sbtnAdd1Click(Sender: TObject);
    procedure sbtnDelete1Click(Sender: TObject);



  private


    g_Users: OleVariant;                     // Temporary storage
    g_DataModified: Boolean;                 // TRUE if any rows have been
                                             // inserted, updated, or deleted.
                                             // See WasDataModified
    procedure InitUserGroups;
    procedure InitUserPolicy;
    function CheckInList(str:string;List:TCustomListBox):boolean;
  public
    isChange:Boolean;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    function ShowModal(new, modify: Boolean): Integer; reintroduce; overload;
    function WasDataModified: Boolean;

  end;

var

  isAdministrator,isManager,isSuperuser,isImpersonator,isGeneral:Boolean;
  isClose:Boolean;
  t_Tref:Tref;
implementation

{$R *.DFM}

//==============================================================================
//
// Creation & destruction
//

// Create form & initialise global data
constructor TfrmAS_Users.Create(Owner: TComponent);
begin
     inherited Create(owner);

     // Globals
     g_Users:=Unassigned;
     g_DataModified:=FALSE;
end;

// Destroy form & free any resources used
destructor TfrmAS_Users.Destroy;
begin
     // Globals
     g_Users:=Unassigned;
     inherited Destroy;
end;

//==============================================================================
//
// Entry points
//

//
// Display a users dialog box
//
// Args: framework object to use
//       name of user to load (empty string means none)
//       description of user to load (empty string means none)
//       description (Unassigned if not known)
//       if delete is TRUE then user can delete rows
//       if new is TRUE then user can create rows
//       if modify is TRUE then user can modify rows
//       if find is TRUE then user can find new rows
//
// Returns: GE_OK on success
//
// Note: If a user is to be loaded then pass its name, else if the user has
//       already been loaded it can be passed in the users_row argument
//       (only the first user is loaded). If the ID is not known then the
//       name may be passed.
//
// Returns: mrAbort on failure
//
function TfrmAS_Users.ShowModal(new, modify: Boolean): Integer;
begin
     // Initialise

     if (not new) and (not modify) then begin
         btCreate.visible:=false;  //Caption:='OK';
         tsGroups.tabvisible:=false;
         eUsername.ReadOnly:=TRUE;
         eDescription.ReadOnly:=TRUE;
         ePassword.ReadOnly:=TRUE;
     end;
     if new then begin
        tsGroups.tabvisible:=false;
        cbrights.ItemIndex:=0;

     end;
     // Delete
     if  modify  then begin
         btCreate.Caption:='确认';
     end;

     InitUserGroups;
     InitUserPolicy;
     // Continue with standard
     Result:=inherited ShowModal;
end;

// Returns TRUE if data was modified
function TfrmAS_Users.WasDataModified: Boolean;
begin
     Result:=g_DataModified;
end;


//
// Exit
//
procedure TfrmAS_Users.tbExitClick(Sender: TObject);
begin
     Close;
end;


//
// User wants to modify the current record in the database
//
procedure TfrmAS_Users.rbExpiredClick(Sender: TObject);
begin
  gpExp.visible:=true;
  isChange:=true;
end;

procedure TfrmAS_Users.rbNevExpClick(Sender: TObject);
begin
  gpExp.visible:=false;
  isChange:=true;
end;

procedure TfrmAS_Users.btCloseClick(Sender: TObject);
begin
  isclose:=true;
  Close;
end;

procedure TfrmAS_Users.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:=isclose;
end;

procedure TfrmAS_Users.btCreateClick(Sender: TObject);
begin
  isclose:=true;
  ischange:=false;
  if btCreate.caption='确认' then begin
     if (t_Tref.t_eUsername<>eUsername.text) or
        (t_Tref.t_eDescription<>eDescription.text) or
        (t_Tref.t_edEmail<>cbgroup.Text) or
        (t_Tref.t_rbNevExp<>rbNevExp.Checked) or
        (t_Tref.t_rbExpired<>rbExpired.Checked) or
        (t_Tref.t_cbRithgs<>cbRights.Text) or
        (t_Tref.t_days<>SpinEdit1.Value) then
        if MessageDlg('你想修改这个用户吗?',
                mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
                isClose:=false;
                Exit;
        end else begin
          if eUsername.Text='' then begin
              MessageDlg('必须输入用户名', mtWarning,[mbOk], 0);
              isClose:=false;
              exit;
          end;
         if eDescription.Text='' then begin
              MessageDlg('必须输入帐号', mtWarning,[mbOk], 0);
              isClose:=false;
              exit;
          end;

          if rbNevExp.Checked then SpinEdit1.value:=0;
          isChange:=true;
        end;

  end else begin
      if length(ePassword.text)<6 then begin
         MessageDlg('密码必须在6到16位之间!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;
      if ePassword.text<>edConform.text then begin
         MessageDlg('密码不匹配!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;
      if eUsername.Text='' then begin
         MessageDlg('必须输入用户名!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;
      if eDescription.Text='' then begin
              MessageDlg('必须输入帐号', mtWarning,[mbOk], 0);
              isClose:=false;
              exit;
      end;

      if rbNevExp.Checked then SpinEdit1.value:=0;
  end;

end;

procedure TfrmAS_Users.SpinEdit1Exit(Sender: TObject);
begin
  if SpinEdit1.value=0 then
     rbnevExp.Checked:=true;

end;

procedure TfrmAS_Users.InitUserGroups;
var
    ole:Olevariant;
    row:TStrings;
begin
    ole:=sup.PS_Get_groups('');
    if not VarIsEmpty(ole) then begin
        row:=Get_ColRecords(ole,2);
        listGroups.Items:=row;
    end;
    ole:=sup.PS_Get_UserGrp(eUsername.Text,'');
    if not VarIsEmpty(ole) then begin
       row:=Get_ColRecords(ole,1);
       listaccGroup.Items:=row;
       //cbGroup.Items:=row;
       //cbGroup.Items.Add('');
    end;
    OLE:=SUP.PB_GET_Roles('');
    if not VarIsEmpty(ole) then begin
       row:=GET_COLRECORDS(ole,0);
       cbGroup.Items:=row;
       cbGroup.Items.Add('');
    END;
    cbGroup.Items.Add(edZw.Text);
    cbgroup.itemindex:=cbgroup.itemS.indexof(edzw.text);
end;
//
procedure TfrmAS_Users.InitUserPolicy;
var
    ole:Olevariant;
    row:TStrings;
begin
    ole:=sup.PS_Get_Policy('');
    if not VarIsEmpty(ole) then begin
        row:=Get_ColRecords(ole,0);
        lstSource.Items:=row;
    end;
    ole:=sup.PS_Get_UserPolicy(eUsername.Text,'');
    if not VarIsEmpty(ole) then begin
       row:=Get_ColRecords(ole,0);
       lstTarget.Items:=row;
       //lstCurRights.Items:=row;
    end;


end;


procedure TfrmAS_Users.sbtnAddClick(Sender: TObject);
var i:integer;
    username,groupname:string;
begin
    if (edId.text='') or (listGroups.SelCount <= 0) then exit;
    username:=sup.PS_valStrToStr('csi_secu_user','c_user_id','c_user_name',edId.Text);
    for i:= listGroups.Items.Count - 1 downto 0 do begin
        if listGroups.Selected[i] then
        begin
          if not checkinlist(listgroups.Items.Strings[i],listAccGroup) then  begin
             groupname:=listgroups.Items.Strings[i];
             if sup.PS_Ins_UserGrp(username,groupname)=0 then begin
                listaccGroup.Items.Add(listgroups.Items.Strings[i]);
                listGroups.Items.Delete(i);

             end else showmessage(sup.PS_Lasterror);
          end else Showmessage('值已经存在.');//listGroups.Items.Delete(i);
        end;
    end;
end;
function TfrmAs_Users.CheckInList(str:string;List:TCustomListBox):boolean;
var i:integer;
begin
   result:=false;
   if List.items.Count>0 then begin
      for i:=list.items.Count-1 downto 0 do begin
          if uppercase(str)=uppercase(list.Items.Strings[i]) then
             result:=true;
      end;
   end;

end;

procedure TfrmAS_Users.listgroupsDblClick(Sender: TObject);
begin
  self.sbtnAdd.OnClick(self);
end;


procedure TfrmAS_Users.sbtnDeleteClick(Sender: TObject);
var i:integer;
    username,groupname:string;
begin
    listaccgroup.refresh;
    listgroups.refresh;
    if (edId.text='') or (listaccGroup.SelCount <= 0) then exit;
    username:=sup.PS_valStrToStr('csi_secu_user','c_user_id','c_user_name',edId.Text);
    if listAccGroup.SelCount<0 then exit;
    for i:= listaccGroup.Items.Count - 1 downto 0 do  begin
        if listaccGroup.Selected[i] then
        begin
          groupname:=listaccgroup.Items.Strings[i];
          if not checkinlist(listaccgroup.Items.Strings[i],listGroups) then  begin
             if sup.PS_Del_UserGrp(username,groupname)=0 then begin
                listGroups.Items.Add(listaccgroup.Items.Strings[i]);
                listaccGroup.Items.Delete(i);

             end else showmessage('删除失败 : '+sup.PS_LastError);
          end else begin
             if sup.PS_Del_UserGrp(username,groupname)=0 then
                listaccGroup.Items.Delete(i) else showmessage(sup.PS_LastError);
          end;
        end;
    end;

end;


procedure TfrmAS_Users.listAccGroupDblClick(Sender: TObject);
begin
  self.sbtnDelete.OnClick(self);
end;

procedure TfrmAS_Users.FormShow(Sender: TObject);
begin
   PageControl.ActivePage:=tsMain;
   t_Tref.t_eUsername:=eUsername.text;
   t_Tref.t_eDescription:=eDescription.text;
   t_Tref.t_edEmail:=cbgroup.Text;
   t_Tref.t_rbNevExp:=rbNevExp.Checked;
   t_Tref.t_rbExpired:=rbExpired.Checked;
   t_Tref.t_cbRithgs:=cbRights.Text;
   t_Tref.t_days:=SpinEdit1.Value;

end;

procedure TfrmAS_Users.lstSourceDblClick(Sender: TObject);
begin
 self.sbtnAdd1.OnClick(self);
end;

procedure TfrmAS_Users.lstTargetDblClick(Sender: TObject);
begin
self.sbtnDelete1.OnClick(self);
end;

procedure TfrmAS_Users.sbtnAdd1Click(Sender: TObject);
var i:integer;
    username,prj:string;
begin

    //showmessage(edId.text);
    if (edId.text='') or (lstSource.SelCount <= 0) then exit;
    username:=sup.PS_valStrToStr('csi_secu_user','c_user_id','c_user_name',edId.Text);
    for i:= lstSource.Items.Count - 1 downto 0 do begin
        if lstSource.Selected[i] then
        begin
          if not checkinlist(lstSource.Items.Strings[i],lstTarget) then  begin
             prj:=lstSource.Items.Strings[i];
             if sup.PS_Ins_UserPolicy(username,prj)=0 then begin
                lstTarget.Items.Add(lstSource.Items.Strings[i]);
                //lstCurRights.Items.Add(lstSource.Items.Strings[i]);
                lstSource.Items.Delete(i);


             end else showmessage(sup.PS_Lasterror);
          end else Showmessage('值已经存在.');
        end;
    end;
end;

procedure TfrmAS_Users.sbtnDelete1Click(Sender: TObject);
var i:integer;
    username,policy:string;
begin
    lstTarget.refresh;
    lstSource.refresh;
    if (edId.text='') or (lstTarget.SelCount <= 0) then exit;
    username:=sup.PS_valStrToStr('csi_secu_user','c_user_id','c_user_name',edId.Text);

    if lstTarget.SelCount<0 then exit;
    for i:= lstTarget.Items.Count - 1 downto 0 do  begin
        if lstTarget.Selected[i] then
        begin
          policy:=lstTarget.Items.Strings[i];
          if not checkinlist(lstTarget.Items.Strings[i],lstSource) then  begin
             if sup.PS_Del_UserPolicy(username,policy)=0 then begin
                lstSource.Items.Add(lstTarget.Items.Strings[i]);
                lstTarget.Items.Delete(i);
                //lstCurRights.Items.Delete(i);

             end else showmessage('删除失败 : '+sup.PS_LastError);
          end else begin
             if sup.PS_Del_UserPolicy(username,policy)=0 then begin
                lstTarget.Items.Delete(i);
                //lstCurRights.Items.Delete(i);
             end else showmessage(sup.PS_LastError);
          end;
        end;
    end;


end;





initialization

end.