userlogonfrm.pas

来自「群星医药系统源码」· PAS 代码 · 共 258 行

unit UserLogonFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzBorder, RzBtnEdt, ComCtrls, RzDTP, StdCtrls, RzCmboBx, ActnList,
  Mask, RzEdit, RzButton, ExtCtrls, RzPanel, ImgList, MConnect, IniFiles,
  IMainFrm, xBaseFrm, RzRadChk;

type
  TAcctInfo = Record
    Name: WideString;
    Remark: WideString;
    Visible: Boolean;
  end;

  TFmUserLogon = class(TxBaseForm)
    RzPanel1: TRzPanel;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    edUserID: TRzEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edAcctName: TRzButtonEdit;
    RzBorder1: TRzBorder;
    ActionList1: TActionList;
    ImageList1: TImageList;
    ActLogon: TAction;
    ActCancel: TAction;
    edPasswd: TRzEdit;
    mmLog: TRzMemo;
    ckClearTempFile: TRzCheckBox;
    procedure ActLogonExecute(Sender: TObject);
    procedure ActCancelExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure edAcctNameButtonClick(Sender: TObject);
    procedure edAcctNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edAcctNameDblClick(Sender: TObject);
    procedure ckClearTempFileClick(Sender: TObject);
    procedure edAcctNameKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain: IMainForm;
    OleAccounts: OleVariant;
    sDefAccount: String;
    Accounts: Array of TAcctInfo;
    procedure ClearTempFile;
  public
    SvrConn: TDispatchConnection;
    ClientID, DepartID, DBScanRange, DBModiRange: Integer;
    AcctName, DBConnStr, UserID, UserPasswd: WideString;
  end;

var
  FmUserLogon: TFmUserLogon;

implementation

uses SeltAccountFrm;

{$R *.dfm}

procedure TFmUserLogon.FormCreate(Sender: TObject);
var IniFile: TIniFile;
begin
//  AcctList := TStringList.Create;
//  AcctRemarks := TStringList.Create;
  IFmMain := Application.MainForm as IMainForm;
  IniFile := TIniFile.Create(IFmMain.IniFileName);
  sDefAccount := IniFile.ReadString('LocaSetting', 'DefAccount', '');
  ckClearTempFile.Checked := IniFile.ReadBool('UserLogon', 'ClearTempFile', false);
  IniFile.Free;
  edAcctName.Text := sDefAccount;
end;

procedure TFmUserLogon.FormShow(Sender: TObject);
var i, k: Integer;
begin
  SvrConn.AppServer.GetAccounts(OleAccounts);
  if (not VarIsNull(OleAccounts))and(VarArrayDimCount(OleAccounts)=2) then begin
    i := VarArrayLowBound(OleAccounts, 1);
    k := VarArrayHighBound(OleAccounts, 1);
    SetLength(Accounts, k-i+1);
    while i<=k do begin
      Accounts[i].Name := OleAccounts[i, 0];
      Accounts[i].Remark := OleAccounts[i, 1];
      Accounts[i].Visible:= OleAccounts[i, 2];
      Inc(i);
    end;
  end;
  edAcctName.ReadOnly := true;
  if edAcctName.Text<>'' then
    edUserID.SetFocus;
end;

procedure TFmUserLogon.FormDestroy(Sender: TObject);
begin
//  AcctList.Free;
//  AcctRemarks.Free;
end;

procedure TFmUserLogon.edAcctNameButtonClick(Sender: TObject);
var Form: TFmSeltAccount;
    i, k: integer;
    Item: TListItem;
    IniFile: TIniFile;
begin
  Form := TFmSeltAccount.Create(self);
  with Form do begin
    lvAccounts.Items.Clear;
    k := Length(Accounts);
    for i:=0 to k-1 do begin
      if Accounts[i].Visible then begin
        Item := lvAccounts.Items.Add;
        Item.ImageIndex := 0;
        Item.Caption := Accounts[i].Name;
        Item.SubItems.Add(Accounts[i].Remark);
        if Accounts[i].Name=sDefAccount then
        begin
          lvAccounts.Selected := Item;
          lvAccounts.ItemFocused := Item;
          chkSetDefAccount.Checked := true;
        end;
      end;
    end;
    if ShowModal=mrOk then
    begin
      edAcctName.Text := lvAccounts.Selected.Caption;
      IniFile := TIniFile.Create(IFmMain.IniFileName);
      if chkSetDefAccount.Checked then
      begin
        sDefAccount := edAcctName.Text;
        IniFile.WriteString('LocaSetting', 'DefAccount', sDefAccount)
      end else if edAcctName.Text=sDefAccount then
        IniFile.WriteString('LocaSetting', 'DefAccount', '');
      IniFile.Free;
    end;
    Free;
  end;
end;

procedure TFmUserLogon.ActLogonExecute(Sender: TObject);
const
  cLine = '----------------------------------------';
  cFail = '登录失败！';
var sAcctName, sUserID, LogInfo: String;
    i, iLogonFlag: Integer;
begin
  mmLog.Lines.Add(cLine);
  sAcctName := edAcctName.Text;
  if sAcctName='' then begin
    edAcctName.Button.Click;
    sAcctName := edAcctName.Text;
    if sAcctName='' then begin
      mmLog.Lines.Add('请选择登录帐套！');
      Exit;
    end;
  end;
  sUserID := edUserID.Text;
  if sUserID='' then begin
    mmLog.Lines.Add('请输入用户编号！');
    mmLog.Lines.Add(cFail);
    edUserID.SetFocus;
    Exit;
  end;
  //如果登录失败LogInfo返回错误信息，成功则返回员工部门及数据库连接串，用";"号分隔
  iLogonFlag := SvrConn.AppServer.UserLogon(sAcctName, sUserID, edPasswd.Text, LogInfo);
  if iLogonFlag=0 then begin
    mmLog.Lines.Add(LogInfo);
    mmLog.Lines.Add(cFail);
    Exit;
  end;
  ClientID := iLogonFlag;
  //解析出用户所属部门
  i := AnsiPos(';', LogInfo);
  DepartID := StrToInt(Copy(LogInfo, 1, i-1));
  Delete(LogInfo, 1, i);
  //解析出用户资料浏览范围
  i := AnsiPos(';', LogInfo);
  DBScanRange := StrToInt(Copy(LogInfo, 1, i-1));
  Delete(LogInfo, 1, i);
  //解析出用户资料修改范围
  i := AnsiPos(';', LogInfo);
  DBModiRange := StrToInt(Copy(LogInfo, 1, i-1));
  Delete(LogInfo, 1, i);
  //剩下的是数据库连接字符串
  DBConnStr:= LogInfo;

  AcctName := sAcctName;
  UserID := sUserID;
  UserPasswd := edPasswd.Text;

  if ckClearTempFile.Checked then
    ClearTempFile;


  ModalResult := mrOK;
end;

procedure TFmUserLogon.ActCancelExecute(Sender: TObject);
begin
  Close;
end;

procedure TFmUserLogon.edAcctNameKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift=[ssCtrl] then
    edAcctName.Tag := 1
  else if (Key=13)and(edAcctName.Text='') then
    edAcctName.Button.Click;
end;

procedure TFmUserLogon.edAcctNameKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  edAcctName.Tag := 0;
end;

procedure TFmUserLogon.edAcctNameDblClick(Sender: TObject);
begin
  if edAcctName.Tag=1 then
    edAcctName.ReadOnly := not edAcctName.ReadOnly
  else
    edAcctName.Button.Click;
end;

procedure TFmUserLogon.ClearTempFile;
var xmlPath, xmlFile: String;
    sr: TSearchRec;
begin
  xmlPath := ExtractFilePath(Application.ExeName)+'XML\';
  xmlFile := xmlPath+'*.xml';
  if FindFirst(xmlFile, faArchive, sr) = 0 then
  begin
    repeat
      if FileExists(xmlPath + sr.Name) then
        DeleteFile(xmlPath + sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

procedure TFmUserLogon.ckClearTempFileClick(Sender: TObject);
var IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(IFmMain.IniFileName);
  IniFile.WriteBool('UserLogon', 'ClearTempFile', ckClearTempFile.checked);
  IniFile.Free;
end;

end.