user.pas

个人写的一个操作员管理部分

unit User;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, DBCtrls, Db, DBTables, Grids, DBGrids, Menus, ComCtrls,
  ExtCtrls, ImgList,DsgnIntf;

const

  SuperManCode ='whlxt';
  SuperMan = '超级用户';
  SuperManPassword = 'express';
  cVersionInfo ='多中心操作员管理--Client/Server大型数据库版1.0';

type

  TVersionInfo = Class(TComponentEditor)
    procedure Edit; override;
  end;

  TUser = class(TComponent)
  private
    fMenu:TMenu;
    fDataBase:TDataBase;
    fProgramId : Integer;
    fCenterCode : string;
    fCenterName : string;
    fUserNo :string;
    fUserName : string;
    fPassword :string;
    fFirstLogin :Boolean;
    fMutex : HWnd;
    fRet : Integer;
    procedure SetMenu(const Value : TMenu);
    procedure SetDataBase(const Value :TDatabase);
    procedure SetProgramId(const value:Integer);
    procedure SetCenterCode(const value : string);
    procedure SetCenterName(const value : string);
    procedure Collect(ProgramId : Integer);
    procedure CollectMenuItem(item : TMenuItem;Clas,ProgramId:Integer;Var Count:Integer);
    function CheckApplicationRun : Boolean;
    { Private declarations }
  protected
    { Protected declarations }
  public
    function Login(Sender : TObject):boolean;
    procedure UserManager;
    procedure ChangePassword;
    procedure CollectGrant;
    constructor Create(AOwner : TComponent);override;
    property UserNo :String read fUserNo;
    property UserName :String read fUserName;
    property Password :String read fPassword;
    property CenterCode : string read fCenterCode write SetCenterCode;
    property CenterName : string read fCenterName write SetCenterName;
    { Public declarations }
  published
    property Menu :TMenu read fMenu Write SetMenu;
    property DataBase :TDataBase read FDatabase write SetDatabase;
    property ProgramId :Integer read fProgramId write SetProgramId;
    { Published declarations }
  end;

procedure Register;

implementation
  uses UnDlgShell,WnOptLogin,WnChange,DnUserManager,WnUserManager;
procedure Register;
begin
  RegisterComponents('医疗保险', [TUser]);
  RegisterComponentEditor(TUser,TVersionInfo);
end;

{ TUser }
constructor TUser.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  fFirstLogin := True;
  dmUserManager := TdmUserManager.Create(Application);
end;

procedure TUser.CollectGrant;
begin
  Collect(ProgramId);
end;

procedure TUser.Collect(ProgramId : Integer);
var Count : Integer;
begin
  try
    Count := 0;
    with dmUserManager do
    begin
      delMenus.Prepare;
      delMenus.ParamByName('programid').AsInteger := ProgramId;
      delMenus.ExecSQL;
      if qryMenus.Active then
      begin
        qryMenus.Close;
        qryMenus.Open;
      end else
        qryMenus.Open;
    end;
    CollectMenuItem(fMenu.Items ,1,ProgramId,Count);
  except
    ShowError('数据库操作失败');
  end;
end;

procedure TUser.CollectMenuItem(item: TMenuItem; Clas,
  ProgramId: Integer; var Count: Integer);
var I : integer;
    strCaption : String;
begin
  try
    for I := 0 to Item.Count -1  do
    begin
      if Item.Items[I].Caption <> '-' then
      begin
        Inc(Count);
        strCaption := Item.Items[I].Caption;
        if pos(' ',strCaption) > 0 then
          strCaption := Copy(strCaption,1,Pos(' ',strCaption) -1);
        with dmUserManager.qryMenus do
        begin
          Append;
          FieldByName('programid').AsInteger := ProgramId;
          FieldByName('menuno').AsInteger := Count;
          FieldByName('Classno').AsInteger := Clas;
          FieldByName('menuname').AsString := strCaption;
          ApplyUpdates;
          CommitUpdates;
        end;
      end;
      CollectMenuItem(Item.Items[I],Clas+1,ProgramId,Count);
    end;
  except
    ShowError('数据库操作失败');
  end;
end;

procedure TUser.ChangePassword;
begin
  if (fUserNo <> SuperManCode  ) and (fUserName  <> SuperMan ) and
     (fPassword <>SuperManPassword ) then
  begin
     fmChange := TfmChange.Create(Self);
    try
      fmChange.ChangePassword(fCenterCode,fUserno,fPassword);
    finally
      fmChange.Free;
    end;
  end else
  begin
    ShowInfo('您是超级用户,不需要修改密码');
    Exit;
  end;
end;
function TUser.Login(Sender : TObject):boolean;
var
  Hwnd : THandle;
begin
  Result := False;
  //...检查是否已经启动了相同的程序
  if fFirstLogin then
  begin
    if  CheckApplicationRun then
    begin
      Hwnd := FindWindow(nil,Pchar(Application.Title));
      if Hwnd <> 0 then
      begin
        SetForegroundWindow(Hwnd);
      end;
      Application.ShowMainForm := False;
      Application.Terminate;
      Exit;
    end;
  end;
  if Sender <> nil then
    TWinControl(Sender).Hide;
  fmOptLogin := TfmOptLogin.Create(Self);
  try
    fmOptLogin.SuperManCode := SuperManCode;
    fmOPtLogin.SuperMan := SuperMan ;
    fmOptLogin.SuperManPassword := SuperManPassword;
    fmOptLogin.InputMenuItem := fMenu.Items;
    fmOptLogin.CurrentProgramId := fProgramId;
    //dmUserManager.qryUsers.Open;
    dmUserManager.qryUserPosts.Open;
    if Sender <> nil then
      TWincontrol(Sender).Free;
    if fmOptLogin.ShowModal = mrok then
    begin
      fUserNo := fmOptLogin.UserNo;
      fUserName := fmOptLogin.UserName;
      fPassword := fmOptLogin.UserPassword;
      fCenterCode := fmOptLogin.CenterCode;
      fCenterName := fmOptLogin.combCenterName.Text;
      Result := True;
    end;
  finally
    dmUserManager.qryUsers.Close;
    dmUserManager.qryUserPosts.Close;
    fmOptLogin.slCenterCode.Free;
    fmOptLogin.Free;
    fFirstLogin := False;
  end;
end;

procedure TUser.SetProgramId(const value :Integer);
begin
  fProgramId := Value;
end;
procedure TUser.SetDataBase(const Value: TDatabase);
begin
  fDataBase := Value;
  try
    with dmUserManager.UserManager do
     begin
      Connected := False;
      Params.Clear;
      AliasName := '';
      AliasName := fDataBase.AliasName;
      Params :=  fDataBase.Params;
      Connected := True;
    end;
  except
    fDataBase := nil;
    with dmUserManager.UserManager do
    begin
      Connected := False;
      Params.Clear;
      AliasName :='';
    end;
  end;
end;

procedure TUser.SetMenu(const Value: TMenu);
begin
  fMenu := Value;
end;

procedure TUser.UserManager;
begin
  FmUserManager := TFmUserManager.Create(Application);
  try
    FmUserManager.CurrentCenterCode := CenterCode;
    FmUserManager.ShowModal;
  finally
    FmUserManager.Free;
  end;

end;

function TUser.CheckApplicationRun : Boolean;
var
  tmpStr : string;

begin
  Result := True;
  tmpStr := Application.Title;
  fMutex := CreateMutex(nil,False,Pchar(tmpStr));
  try
    fRet := GetLastError;
    if fRet <> Error_Already_Exists then
      Result := False;
  finally
    ReleaseMutex(fMutex);
  end;
end;

procedure TUser.SetCenterCode(const value : string);
begin
  fCenterCode := value;
end;

procedure TUser.SetCenterName(const value : string);
begin
  fCenterName := value;
end;
{ TVersionInfo }

procedure TVersionInfo.Edit;
begin
  ShowInfo(cVersionInfo);
end;

end.