fuser.pas

采用access或ms-sql, oracle数据库 功能： 1。用户管理

unit FUser;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, Buttons, StdCtrls,DBTables;

type
  TFrmuser = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    DBGrid1: TDBGrid;
    Panel2: TPanel;
    sbtnAdd: TSpeedButton;
    sbtnEdit: TSpeedButton;
    sbtnDele: TSpeedButton;
    sbtnUpdate: TSpeedButton;
    sbtnYes: TSpeedButton;
    sbtnCancel: TSpeedButton;
    SpeedButton1: TSpeedButton;
    Gbox: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    DBGrid2: TDBGrid;
    Panel3: TPanel;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    GroupBox2: TGroupBox;
    ListBox1: TListBox;
    GroupBox3: TGroupBox;
    ListBox2: TListBox;
    rightadd: TSpeedButton;
    rightall: TSpeedButton;
    leftall: TSpeedButton;
    leftadd: TSpeedButton;
    SpeedButton7: TSpeedButton;
    Edit5: TEdit;
    Label6: TLabel;
    GroupBox4: TGroupBox;
    Edit6: TEdit;
    GroupBox5: TGroupBox;
    ListBox3: TListBox;
    GroupBox6: TGroupBox;
    Edit7: TEdit;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sbtnAddClick(Sender: TObject);
    procedure sbtnEditClick(Sender: TObject);
    procedure sbtnDeleClick(Sender: TObject);
    procedure sbtnYesClick(Sender: TObject);
    procedure sbtnCancelClick(Sender: TObject);
    procedure sbtnUpdateClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure rightaddClick(Sender: TObject);
    procedure rightallClick(Sender: TObject);
    procedure leftallClick(Sender: TObject);
    procedure leftaddClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ListBox3DblClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    frmMode:String;
    procedure sbtnMode(frmMode:String);
    Procedure EditMode;
    Procedure NorMode;
    procedure EditForm(S:String);
    procedure IncMode;
  public
    { Public declarations }
  end;

var
  Frmuser: TFrmuser;

implementation
uses mainD,UTIL;
{$R *.dfm}

procedure TFrmuser.SpeedButton1Click(Sender: TObject);
begin
 close;
end;

procedure TFrmuser.EditMode;
begin
FrmMode := 'edt';
sbtnMode(FrmMode);
end;

procedure TFrmuser.NorMode;
begin
FrmMode := 'nor';
sbtnMode(FrmMode);
end;

procedure TFrmuser.sbtnMode(frmMode: String);
begin
sbtnAdd.Enabled    := false;
sbtnEdit.Enabled   := False;
sbtnDele.Enabled   := False;
sbtnUpdate.Enabled := False;
sbtnYes.Enabled    := False;
sbtnCancel.Enabled := False;
GBox.Visible       := False;
if (frmMode = 'edt') or (frmMode = 'inc')  then
begin
  sbtnAdd.Enabled    := false;
  sbtnEdit.Enabled   := False;
  sbtnDele.Enabled   := False;
  sbtnUpdate.Enabled := False;
  sbtnYes.Enabled    := true;
  sbtnCancel.Enabled := true;
  Gbox.Visible       := true;

end else if frmMode = 'nor' then
begin
  sbtnAdd.Enabled    := true;
  sbtnEdit.Enabled   := true;
  sbtnDele.Enabled   := true;
  sbtnUpdate.Enabled := true;
  sbtnYes.Enabled    := False;
  sbtnCancel.Enabled := False;
  GBox.Visible       := False;
end;
end;

procedure TFrmuser.FormCreate(Sender: TObject);
begin
with MainDfrm do
begin
   query1.SQL.Clear;
   query1.SQL.Add('SELECT * FROM Userinfo ORDER BY uID');

   uquery1.InsertSQL.Clear;
   uquery1.InsertSQL.Add('insert into Userinfo(uID,uUser,Passwd,CreateD)');
   uquery1.InsertSQL.Add('values');
   uquery1.InsertSQL.Add('(:uID,:uUser,:Passwd,:CreateD)');

//   uquery1.ModifySQL.Clear;
//   uquery1.ModifySQL.Add('UPDATE Userinfo SET');
//   uquery1.ModifySQL.Add('User ='''+edit2.Text+''',');
//   uquery1.ModifySQL.Add('Passwd ='''+edit3.Text+'''');
//   uquery1.ModifySQL.Add('WHERE uID='''+Trim(edit1.Text)+'''');

   uquery1.ModifySQL.Clear;
   uquery1.ModifySQL.Add('UPDATE Userinfo SET');
   uquery1.ModifySQL.Add('uUser =:uUser,Passwd =:passwd,CreateD=:CreateD');
   uquery1.ModifySQL.Add('WHERE uID=:uID');

   uquery1.DeleteSQL.Clear;
   uquery1.DeleteSQL.Add('DELETE FROM Userinfo WHERE');
   uquery1.DeleteSQL.add('uID=:uID');

   query1.Close;
   query1.Open;
end;
NorMode;

end;

procedure TFrmuser.sbtnAddClick(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'useradd')=False then exit;
editForm('add');
MainDFrm.query1.Append;
IncMode;
edit1.SetFocus;
end;

procedure TFrmuser.sbtnEditClick(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'useredt')=False then exit;
editForm('edit');
MainDFrm.query1.Edit;
editMode;
edit2.SetFocus;
end;

procedure TFrmuser.sbtnDeleClick(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'userdel')=False then exit;
EditForm('edit');
if edit1.Text = 'admin' then
begin
MessageBox(Application.handle,'不能删除系统管理员！','提示',mb_ICONWarning+mb_OK);
 exit;
 end;
if MessageBox(Application.Handle,'确认要删除吗？','删除提示',
    mb_ICONInformation+mb_YESNO+mb_DEFbutton2)=mryes then
  begin
   with MainDFrm do
   begin
    uquery1.DeleteSQL.Clear;
    uquery1.DeleteSQL.Add('DELETE FROM Userinfo WHERE');
    uquery1.DeleteSQL.add('uID='''+Edit1.Text+'''');

   query1.Delete;
     try
       query1.Database.StartTransaction;
       query1.ApplyUpdates;
       query1.CommitUpdates;
       query1.Database.Commit;
     except
       query1.Database.Rollback;
       query1.CancelUpdates;
       MessageBox(Application.handle,'存盘失败！','提示',mb_ICONInformation+mb_OK);
     end;
   end;
  end;
  norMode;
  EditForm('');
  end;

procedure TFrmuser.sbtnYesClick(Sender: TObject);
begin
if edit1.Text = '' then exit;
if edit2.Text = '' then exit;
if edit3.Text = '' then exit;
if (edit4.Text = '') or (edit3.Text <>edit4.Text) then
begin
   ShowMessage('输入密码不正确');
   edit3.SetFocus;
   edit3.SelectAll;
   exit;
end;
 if Length(edit3.Text)<4 then
 begin
    ShowMessage('输入确认密码不能少于4位');
    exit;
 end ;

if frmMode = 'inc' then
if MainDFrm.CheckUserID(Edit1.Text) = True then exit;
  With MainDfrm  do
  begin
   try
    query1.FieldByName('uID').AsString := Edit1.Text;
    query1.FieldByName('uUser').AsString := Edit2.Text;
    query1.FieldByName('Passwd').AsString := Encrypt(edit3.text,1357,2,1);
    query1.FieldByName('CreateD').AsString := DatetoStr(Date);
    query1.Post;
    query1.Database.StartTransaction;
    query1.ApplyUpdates;
    query1.CommitUpdates;
    query1.Database.Commit;
  except
    query1.Database.Rollback;
    query1.CancelUpdates;
    MessageBox(Application.handle,'存盘失败！','提示',mb_ICONInformation+mb_OK);
   end;
  end;
norMode;
EditForm('');
end;

procedure TFrmuser.sbtnCancelClick(Sender: TObject);
begin
if MessageBox(Application.Handle,'确认要取消吗？','提示',
    mb_ICONInformation+mb_YESNO+mb_DEFbutton2)=mryes then
   MainDFrm.query1.Cancel;
norMode;
end;
//
procedure TFrmuser.EditForm(S: String);
begin
edit1.Enabled  := False;
    edit1.Text := '';
    edit2.Text := '';
    edit3.Text := '';
    edit4.Text := '';
 if s = 'add' then
 begin
    edit1.Enabled := True;
    edit1.Text := '';
    edit2.Text := '';
    edit3.Text := '';
    edit4.Text := '';
 end else if s = 'edit' then
 begin
    edit1.Enabled := False;
    edit1.Text := MainDfrm.query1.Fields.Fields[0].AsString;
    edit2.Text := MainDfrm.query1.Fields.Fields[1].AsString;
    edit3.Text := MainDfrm.query1.Fields.Fields[2].AsString;
    edit4.Text := MainDfrm.query1.Fields.Fields[2].AsString;
 end;
end;
//更新数据====================//
procedure TFrmuser.sbtnUpdateClick(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'userupdt')=False then exit;
MainDFrm.query1.SQL.Clear;
MainDFrm.query1.SQL.Add('SELECT * FROM Userinfo ORDER BY uID');
MainDFrm.query1.close;
MainDFrm.query1.Open;
end;
//退出系统========================//
procedure TFrmuser.SpeedButton2Click(Sender: TObject);
begin
Application.Terminate;
end;
//编辑模式=======================//
procedure TFrmuser.IncMode;
begin
FrmMode := 'inc';
sbtnMode(FrmMode);
end;
//授予权限====================//
procedure TFrmuser.rightaddClick(Sender: TObject);
begin
if listbox1.ItemIndex <0 then exit;
if listbox1.Items.Count = 0 then
 begin
   rightadd.Enabled := false;
   rightall.Enabled := false;
   exit;
 end;
listbox2.Items.Add(listbox1.Items[listbox1.itemindex]);
listbox1.Items.Delete(listbox1.itemindex);
leftall.Enabled := true;
leftadd.Enabled := true;

end;
//授予全部权限 ===================//
procedure TFrmuser.rightallClick(Sender: TObject);
begin
listbox2.Items.AddStrings(Listbox1.Items);
listbox1.Items.Clear;
rightadd.Enabled := false;
rightall.Enabled := false;
leftall.Enabled := true;
leftadd.Enabled := true;
end;
//取消全部权限 ==================//
procedure TFrmuser.leftallClick(Sender: TObject);
begin
  listbox1.Items.AddStrings(Listbox2.Items);
  listbox2.Items.Clear;
  rightadd.Enabled := true;
  rightall.Enabled := true;
  leftadd.Enabled  := false;
  leftall.Enabled  := false;
end;
//取消权限
procedure TFrmuser.leftaddClick(Sender: TObject);
begin
if listbox2.ItemIndex <0 then exit;
if listbox2.Items.Count = 0 then
 begin
 leftadd.Enabled := false;
 leftall.Enabled := false;
 exit;
 end;
listbox1.Items.Add(listbox2.Items[listbox2.itemindex]);
listbox2.Items.Delete(listbox2.itemindex);
rightadd.Enabled := true;
rightall.Enabled := true;

end;

//选择页面改变时================//
procedure TFrmuser.PageControl1Change(Sender: TObject);
var
tmpstr:string;
     i:integer;
begin
if PageControl1.ActivePageIndex = 1 then
begin
  edit6.Text := UserID;
  edit7.text := UserName;
//  combobox1.Enabled := false;
  with MainDFrm do
  begin
    Qgrant.SQL.Clear;
    Qgrant.SQL.Add('SELECT funt.fID,funt.fName FROM funt,bgrant');
    Qgrant.SQL.Add(' where funt.fID= bgrant.fID');
    Qgrant.SQL.Add('and bgrant.uID='''+UserID+'''');
    Qgrant.SQL.Add('and bgrant.gright=1');
    Qgrant.SQL.Add('order by funt.fID');

    Qgrant.Close;
    Qgrant.Open;
    listbox1.Clear;
    listbox2.Clear;
    leftadd.Enabled := false;
    leftall.Enabled := false;
    Qgrant.First;
    while not Qgrant.Eof  do
    begin
     listbox1.Items.Add(Qgrant.fields.Fields[1].AsString);
    Qgrant.Next;
     end;
   end;


  with MainDFrm  do
  begin
    Qgrant.SQL.Clear;
    Qgrant.SQL.Add('SELECT * FROM Userinfo');
    Qgrant.close;
    Qgrant.open;
    combobox1.Clear;
    Qgrant.First;
    while not Qgrant.Eof do
     begin
        tmpstr := Qgrant.fieldbyname('uID').asString;
        if (tmpstr <> UserID) or ( tmpstr <> 'admin') then
        combobox1.Items.Add(tmpstr);
        Qgrant.Next;
      end;
    for i:=0 to combobox1.Items.Count-1 do
     if (combobox1.Items[i] = UserID) or
        (combobox1.Items[i] = 'admin') then
         combobox1.Items.Delete(i);
  end;

   end else if  PageControl1.ActivePageIndex = 2 then
   begin
   MainDfrm.tbhistory.Open;
   end;


end;

procedure TFrmuser.ComboBox1Change(Sender: TObject);
var
  str:String;
  q1 :TQuery;
   i:integer;
begin
   listbox3.Clear;
   str := trim(combobox1.Items[combobox1.itemindex]);
   edit5.Text := MainDFrm.FeedUuser(str);
   GroupBox5.Caption := edit5.Text +'[双击取消权限]';

   q1 := TQuery.Create(application.Owner);
   try
    q1.DatabaseName := 'main';
    q1.SQL.Clear;
    q1.SQL.Add('SELECT bgrant.fID,funt.fName FROM funt');
    q1.SQL.Add(',bgrant where funt.fID= bgrant.fID');
    q1.SQL.Add('and bgrant.uID='''+str+'''');
    q1.SQL.Add('and bgrant.gright=1');
    q1.SQL.Add('order by bgrant.fID');
    q1.Close;
    q1.Open;
    q1.First;
    for i:=0 to q1.RecordCount-1 do
    begin
     listbox3.Items.Add(q1.fields.Fields[1].AsString);
     q1.Next;
     end;
   finally
    q1.Free;
   end;
end;

procedure TFrmuser.SpeedButton7Click(Sender: TObject);
var
  str,strfid: string;
  i     :integer;
  uid  :String;
begin
if combobox1.Text = '' then exit;
if MaindFrm.CheckPermission(UserID,'grant')=False then exit;
  uid := trim(combobox1.Text);
  if listbox2.Items.Count = 0 then exit;
    with MainDFrm do
   begin
   for i:=0 to listbox2.Items.Count-1 do
   begin
     str    := trim(listbox2.Items[i]);
     strfid := CheckRight(uid,str);
  if strfid <>'' then
     begin
       QGrant.SQL.Clear;
       QGrant.SQL.Add('update bgrant set');
       Qgrant.SQL.Add('gright = 1 ');
       Qgrant.SQL.add('where fID ='''+strfid+'''');
       QGrant.SQL.Add('and uID='''+uid+'''');
       QGrant.Close;
       QGrant.ExecSQL;
     end else begin

       QGrant.SQL.Clear;
       QGrant.SQL.Add('insert into bgrant(fID,uID,gright)');
       QGrant.SQL.add('Values(');
       QGrant.SQL.Add(''''+FeedfuID(str)+''',');
       QGrant.SQL.Add(''''+uid+''',1)');
       QGrant.Close;
        QGrant.ExecSQL;
     end;

   end;
  end;
 leftall.Click;
ComboBox1Change(Sender);
end;

procedure TFrmuser.SpeedButton5Click(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'delhis')=False then exit;
MainDFrm.tbhistory.Delete;
end;

procedure TFrmuser.SpeedButton3Click(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'delhis')=False then exit;
if MessageBox(Application.Handle,'确认要清空吗？','提示',mb_ICONInformation+mb_YESNO)= mrYES then
 with MainDFrm do
 begin
    tbhistory.Active := false;
    tbhistory.EmptyTable;
    tbhistory.Active := True;
 end;


end;
procedure TFrmuser.ListBox3DblClick(Sender: TObject);
begin
if MaindFrm.CheckPermission(UserID,'grantdel')=False then exit;
  MainDFrm.Qgrant.SQL.Clear;
  MainDFrm.Qgrant.SQL.Add('update bgrant set gright=0');
  MainDFrm.Qgrant.SQL.Add('where uID='''+combobox1.Items[combobox1.itemindex]+'''');
  MainDFrm.Qgrant.SQL.add('and fID = (Select funt.fID from funt ');
  MainDFrm.Qgrant.SQL.Add('where fName='''+listbox3.Items[listbox3.itemindex]+''')');
  MainDFrm.Qgrant.close;
  MainDFrm.Qgrant.ExecSQL;
  listbox3.Items.Delete(listbox3.ItemIndex);
end;

procedure TFrmuser.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canClose := True;
if (frmmode = 'inc') or (frmmode = 'edt') then
begin
  MessageBox(application.Handle,'请先结束输入模式后再离开','警告',
  mb_ICONWarning+mb_OK);
  canClose := False;
end;

end;

end.