usergl.pas

医院X光片资料管理系统—全部源码 这是源码。去年做的一个小软件。因为这是给一家医院做的

unit usergl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls, DB, ADODB;

type
  Tuserglfm = class(TForm)
    Panel2: TPanel;
    Panel1: TPanel;
    LabeledEdit1: TLabeledEdit;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    Panel3: TPanel;
    ListBox1: TListBox;
    Label1: TLabel;
    Panel5: TPanel;
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    Label6: TLabel;
    Label10: TLabel;
    Edit5: TEdit;
    BitBtn5: TBitBtn;
    BitBtn4: TBitBtn;
    TabSheet3: TTabSheet;
    Label7: TLabel;
    Edit6: TEdit;
    BitBtn7: TBitBtn;
    TabSheet4: TTabSheet;
    Label11: TLabel;
    Label9: TLabel;
    Edit7: TEdit;
    BitBtn9: TBitBtn;
    procedure BitBtn2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LabeledEdit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  userglfm: Tuserglfm;
  userID: string;
  SL: TStringList;
  FileName: string; //ADO打开dbsetup.ini文件使用
implementation
uses dm, main, mylib;
{$R *.dfm}

procedure listuser(qry1: Tadoquery; lstbox1: Tlistbox);
var i, j: integer;
begin
  lstbox1.Clear;
  with qry1 do
  begin
    close;
    sql.clear;
    sql.Add('select username from userdb');
    open;
  end;
  j := qry1.RecordCount;
  if j > 0 then
  begin
    with qry1 do
    begin
      for i := 1 to j do
      begin
        lstbox1.Items.Add(FieldValues['username']);
        next;
      end;
    end;
  end;
end;


procedure Tuserglfm.BitBtn2Click(Sender: TObject);
begin
  close;
end;

procedure Tuserglfm.ListBox1Click(Sender: TObject);
begin
  edit5.Text := listbox1.Items.strings[listbox1.ItemIndex];
  edit7.Text := listbox1.Items.strings[listbox1.ItemIndex];
end;

procedure Tuserglfm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  dmfm.ADOQuery1.Close;
  Action := caFree;
//      then mainform.N4.Enabled :=false;
end;

procedure Tuserglfm.BitBtn4Click(Sender: TObject);
begin
  showmessage('初始化口令用于忘记密码的用户，将口令更改为:abcd');
end;

procedure Tuserglfm.BitBtn5Click(Sender: TObject);
var s, pw, sqltxt: string;
begin
  s := trim(edit5.Text);
  pw := 'abcd';
  if s <> '' then
  begin
    sqltxt := 'update userdb set passwd=''' + pw + '''';
    sqltxt := sqltxt + 'where username=''' + s + '''';
    execadoquery(dmfm.ADOQuery1, sqltxt);
    showmessage('已经成功将密码初始化为：abcd');
  end
  else
  begin
    showmessage('请选择用户名！');
  end;

end;

procedure Tuserglfm.BitBtn7Click(Sender: TObject);
var s, pw, sqltxt: string;
begin
  s := trim(edit6.Text);
  pw := 'abcd';
  if s = '管理员' then
  begin
    showmessage('管理员只能有一个，不能增加');
    exit;
  end;
  if s <> '' then
  begin
    sqltxt := 'Insert into userdb values (''' + s + '''';
    sqltxt := sqltxt + ',''' + pw + ''')';
    execadoquery(dmfm.ADOQuery1, sqltxt);
    showmessage('成功添加新用户！缺省口令是：abcd,请此用户下次登录时及时修改口令！');
  end
  else
  begin
    showmessage('请选择用户名！');
  end;
  listuser(dmfm.ADOQuery1, listbox1);
end;

procedure Tuserglfm.BitBtn9Click(Sender: TObject);
var s, sqltxt: string;
begin
  s := trim(edit7.Text);
  if s = '管理员' then
  begin
    showmessage('管理员不能删除！');
    exit;
  end;
  if s = '' then
  begin
    showmessage('请选择用户');
    exit;
  end;
  if MessageDlg('你真的要删除用户：' + s + '吗?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    sqltxt := 'delete from userdb where username=''' + s + '''';
    execadoquery(dmfm.ADOQuery1, sqltxt);
    showmessage('成功删除！');
    edit7.Clear;
  end;
  listuser(dmfm.ADOQuery1, listbox1);
end;

procedure Tuserglfm.FormActivate(Sender: TObject);
var
  Con, s1, s2, s3: string; //ADO；连接串
begin
////-------
//  fileName := ExtractFilePath(ParamStr(0)) + 'dbsetup.ini';
//  if not FileExists(FileName) then
//  begin
//    s1 := '数据库初始化错误，无法找到数据库配置文件!';
//    s1 := s1 + '请用数据维护菜单下的配置数据库重新设定！';
//    showmessage(s1);
//    exit;
//  end;
//  if FileExists(FileName) then
//  begin
//    SL := TStringList.Create;
//    SL.LoadFromFile(FileName);
//    Con := SL.Text;
//    sl.Free;
//    try
//      DMform.ADOConnection1.Connected := false;
//      DMform.ADOConnection1.ConnectionString := Con;
//      DMform.ADOConnection1.Connected := true;
//      listuser(dmform.ADOQuery11, listbox1);
//      bitbtn1.Enabled := true;
//    except
//      begin
//        s2 := '数据库初始化错误，无法找到数据库';
//        s3 := '请用数据维护菜单下的配置数据库重新设定！';
//        showmessage(s2 + #13 + Con + #13 + s3);
//        exit;
//      end;
//    end;
//  end;
end;


procedure Tuserglfm.BitBtn3Click(Sender: TObject);
var s, s1, s2, s3, sqltxt: string;
begin
  s := trim(LabeledEdit1.text);
  s2 := '管理员';
  sqltxt := 'select username from userdb where passwd=''' + s + '''';
  sqltxt := sqltxt + ' and username=''' + s2 + '''';
  openadoquery(dmfm.ADOQuery1, sqltxt);
  if dmfm.ADOQuery1.RecordCount = 1 then
  begin
    showmessage('管理员登录成功！');
    listbox1.Enabled := true;
    PageControl1.Enabled := true;
    LabeledEdit1.Clear;
  end
  else
  begin
    showmessage('密码不对！');
  end;
end;

procedure Tuserglfm.FormShow(Sender: TObject);
begin
  listuser(dmfm.ADOQuery1, listbox1);
  LabeledEdit1.SetFocus;
end;

procedure Tuserglfm.LabeledEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['0'..'9', 'a'..'z', 'A'..'Z', #8, #13]) then key := #0;
  if key = #13 then bitbtn3.SetFocus;
end;

end.