useradmin.pas

三層源碼,DELPHI寫的三層源碼,三層源碼,

unit useradmin;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, xpButton, CheckLst;

type
  Tuser_admin = class(TForm)
    xpButton1: TxpButton;
    xpButton2: TxpButton;
    xpButton3: TxpButton;
    xpButton4: TxpButton;
    Bevel1: TBevel;
    ListBox1: TListBox;
    CheckListBox1: TCheckListBox;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure xpButton1Click(Sender: TObject);
    procedure xpButton2Click(Sender: TObject);
    procedure xpButton3Click(Sender: TObject);
    procedure xpButton4Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    sel_user,sel_authorty:string;
    function getcheckauthorty:string;
    procedure authortytocheck;
    procedure refreshlist;
    function getcheckvalue(s:string):char;
    procedure setcheckvalue(s:string;n:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  user_admin: Tuser_admin;

implementation
uses sldata, useradminmodify, useradminnew,shareunit;
{$R *.DFM}

function Tuser_admin.getcheckvalue(s:string):char;
var n:integer;
begin
result:='0';
n:=checklistbox1.Items.IndexOf(s);
if n>=0 then
if checklistbox1.Checked[n] then result:='1';
end;

procedure Tuser_admin.setcheckvalue(s:string;n:integer);
var i:integer;
begin
i:=checklistbox1.Items.IndexOf(s);
if i>=0 then
checklistbox1.Checked[i]:=sel_authorty[n]='1';
end;

function Tuser_admin.getcheckauthorty:string;
var s:string;
begin
s:=authority_blank;
s[6]:=getcheckvalue('部门工种-新建');
s[7]:=getcheckvalue('部门工种-修改');
s[8]:=getcheckvalue('部门工种-删除');
s[9]:=getcheckvalue('部门工种-复制');
//-----------------------------------
s[30]:=getcheckvalue('宿舍管理-查看');
s[26]:=getcheckvalue('宿舍管理-新建');
s[27]:=getcheckvalue('宿舍管理-修改');
s[28]:=getcheckvalue('宿舍管理-删除');
//-----------------------------------
s[15]:=getcheckvalue('员工资料-查看');
s[11]:=getcheckvalue('员工资料-新建');
s[12]:=getcheckvalue('员工资料-修改');
s[13]:=getcheckvalue('员工资料-删除');
//-----------------------------------
s[50]:=getcheckvalue('事件提醒-查看');
s[46]:=getcheckvalue('事件提醒-新建');
s[47]:=getcheckvalue('事件提醒-修改');
s[48]:=getcheckvalue('事件提醒-删除');
//-----------------------------------
s[70]:=getcheckvalue('税率表-查看');
s[66]:=getcheckvalue('税率表-新建');
s[67]:=getcheckvalue('税率表-修改');
s[68]:=getcheckvalue('税率表-删除');
//-----------------------------------
s[75]:=getcheckvalue('医疗保险-查看');
s[72]:=getcheckvalue('医疗保险-修改');
s[73]:=getcheckvalue('医疗保险-删除');
//-----------------------------------
s[80]:=getcheckvalue('养老金-查看');
s[77]:=getcheckvalue('养老金-修改');
s[78]:=getcheckvalue('养老金-删除');
//-----------------------------------
s[85]:=getcheckvalue('个人所得税-查看');
s[82]:=getcheckvalue('个人所得税-修改');
s[83]:=getcheckvalue('个人所得税-删除');
result:=s;
end;

procedure Tuser_admin.authortytocheck;
begin
if sel_authorty<>'' then
  begin
  //-----------------------------------
  setcheckvalue('部门工种-新建',6);
  setcheckvalue('部门工种-修改',7);
  setcheckvalue('部门工种-删除',8);
  setcheckvalue('部门工种-复制',9);
  //-----------------------------------
  setcheckvalue('宿舍管理-查看',30);
  setcheckvalue('宿舍管理-新建',26);
  setcheckvalue('宿舍管理-修改',27);
  setcheckvalue('宿舍管理-删除',28);
  //-----------------------------------
  setcheckvalue('员工资料-查看',15);
  setcheckvalue('员工资料-新建',11);
  setcheckvalue('员工资料-修改',12);
  setcheckvalue('员工资料-删除',13);
  //-----------------------------------
  setcheckvalue('事件提醒-查看',50);
  setcheckvalue('事件提醒-新建',46);
  setcheckvalue('事件提醒-修改',47);
  setcheckvalue('事件提醒-删除',48);
  //-----------------------------------
  setcheckvalue('税率表-查看',70);
  setcheckvalue('税率表-新建',66);
  setcheckvalue('税率表-修改',67);
  setcheckvalue('税率表-删除',68);
  //-----------------------------------
  setcheckvalue('医疗保险-查看',75);
  setcheckvalue('医疗保险-修改',72);
  setcheckvalue('医疗保险-删除',73);
  //-----------------------------------
  setcheckvalue('养老金-查看',80);
  setcheckvalue('养老金-修改',77);
  setcheckvalue('养老金-删除',78);
  //-----------------------------------
  setcheckvalue('个人所得税-查看',85);
  setcheckvalue('个人所得税-修改',82);
  setcheckvalue('个人所得税-删除',83);
  end;
end;


procedure Tuser_admin.FormShow(Sender: TObject);
begin
refreshlist;
end;

procedure tuser_admin.refreshlist;
begin
listbox1.Clear;
sl_data.getuserlist(listbox1.Items);
end;

procedure Tuser_admin.ListBox1Click(Sender: TObject);
var n:integer;
begin
if listbox1.SelCount>0 then
   begin
   n:=listbox1.ItemIndex;
   sel_user:=listbox1.Items.Strings[n];
   if sel_user<>'' then
    begin
    sel_authorty:=sl_data.getuserinfo(sel_user);
    authortytocheck;
    end;
   end;
end;

procedure Tuser_admin.FormPaint(Sender: TObject);
begin
sl_data.formonpaint(self);
end;

procedure Tuser_admin.xpButton1Click(Sender: TObject);
begin
with tuseradmin_modify.Create(self) do
  try
  showmodal;
  finally
  free;
  end;
end;

procedure Tuser_admin.xpButton2Click(Sender: TObject);
var msg:string;
begin
if sel_user<>'' then
  begin
  with tstringlist.create do
    try
    add(makeparams('tuid',sel_user));
    add(makeparams('authority',getcheckauthorty));
    msg:=text;
    finally
    free;
    end;
 if sl_data.user_model(public_modify,msg) then
   begin
   sel_authorty:=getcheckauthorty;
   showmessage('权限修改成功.');
   end else begin
   authortytocheck;
   showmessage('权限修改失败.');
   end;
  end;
end;

procedure Tuser_admin.xpButton3Click(Sender: TObject);
begin
with tuseradmin_new.create(self) do
  try
  showmodal;
  finally
  free;
  end;
refreshlist;
end;

procedure Tuser_admin.xpButton4Click(Sender: TObject);
var msg:string;
begin
if sel_user<>'' then
   begin
   with tstringlist.create do
    try
    add(makeparams('tuid',sel_user));
    msg:=text;
    finally
    free;
    end;
   if sl_data.user_model(public_del,msg) then
      begin
      sel_user:='';
      showmessage('帐号删除成功.注意超级管理员不能被删除.');
      refreshlist;
      end else showmessage('帐号删除失败.');
   end;
end;

procedure Tuser_admin.Label1Click(Sender: TObject);
begin
checkbox1.Checked:=not checkbox1.Checked;
checkbox1.OnClick(nil);
end;

procedure Tuser_admin.CheckBox1Click(Sender: TObject);
var i:integer;
begin
for i:=1 to checklistbox1.Items.Count do
   checklistbox1.Checked[i-1]:=checkbox1.Checked;
end;

end.