You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
144 lines
3.6 KiB
144 lines
3.6 KiB
unit ufrmCheckAdmin;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
|
|
System.Classes, Vcl.Graphics, System.UITypes,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
|
|
|
|
type
|
|
TfrmCheckAdmin = class(TForm)
|
|
lbl_user: TLabel;
|
|
edt_user: TEdit;
|
|
lbl_password: TLabel;
|
|
edt_password: TEdit;
|
|
btn_ok: TButton;
|
|
btn_cancel: TButton;
|
|
procedure btn_cancelClick(Sender: TObject);
|
|
procedure btn_okClick(Sender: TObject);
|
|
procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
|
|
var Resize: Boolean);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormKeyPress(Sender: TObject; var Key: Char);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
private
|
|
procedure WMMoving(var MSG: TWMMoving); message WM_MOVING;
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
frmCheckAdmin: TfrmCheckAdmin;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses udtmSystem;
|
|
|
|
procedure TfrmCheckAdmin.btn_cancelClick(Sender: TObject);
|
|
begin
|
|
if (MessageDlg
|
|
('Deseja realmente cancelar o término de sessão? Se sim o programa será terminado.',
|
|
mtcustom, [mbok, mbcancel], 0)) = mrCancel then
|
|
begin
|
|
Abort;
|
|
end;
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.btn_okClick(Sender: TObject);
|
|
begin
|
|
with dtmsystem do
|
|
begin
|
|
if ((not tblUsuarios.Locate('TX_USUARIO', AnsiUpperCase(edt_user.Text), []))
|
|
and (not tblUsuarios.Locate('TX_USUARIO', AnsiLowerCase(edt_user.Text),
|
|
[])) and (not tblUsuarios.Locate('TX_USUARIO', edt_user.Text, []))) then
|
|
begin
|
|
MessageDlg
|
|
('Usuário e/ou Senha Inexistente/Incorreto. O programa irá finalizar agora.',
|
|
mtWarning, [mbok], 0);
|
|
frmCheckAdmin.ModalResult := mrCancel;
|
|
end
|
|
else
|
|
begin
|
|
if tblUsuariosID_GRUPO.AsInteger <> 1 then
|
|
begin
|
|
MessageDlg
|
|
('Este Usuário não possúi privilégios de administrador. O programa irá finalizar agora.',
|
|
mtWarning, [mbok], 0);
|
|
frmCheckAdmin.ModalResult := mrCancel;
|
|
end
|
|
else
|
|
begin
|
|
if AnsiUpperCase(edt_password.Text) <>
|
|
AnsiUpperCase(tblUsuariosTX_SENHA.AsString) then
|
|
begin
|
|
MessageDlg
|
|
('Usuário e/ou Senha Inexistente/Incorreto. O programa irá finalizar agora.',
|
|
mtWarning, [mbok], 0);
|
|
frmCheckAdmin.ModalResult := mrCancel;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.FormCanResize(Sender: TObject;
|
|
var NewWidth, NewHeight: Integer; var Resize: Boolean);
|
|
begin
|
|
Resize := false;
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
Action := caFree;
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if Key = VK_ESCAPE then
|
|
begin
|
|
Key := 0;
|
|
Close;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.FormKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
// faz o enter funcionar como 'tab'
|
|
if (Key = #13) then
|
|
begin
|
|
SelectNext(ActiveControl as TWinControl, true, true);
|
|
Key := #0;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCheckAdmin.WMMoving(var MSG: TWMMoving);
|
|
var
|
|
workArea: TRect;
|
|
begin
|
|
workArea := Screen.WorkareaRect;
|
|
|
|
with MSG.DragRect^ do
|
|
begin
|
|
if left < workArea.left then
|
|
OffsetRect(MSG.DragRect^, workArea.left - left, 0);
|
|
|
|
if top < workArea.top then
|
|
OffsetRect(MSG.DragRect^, 0, workArea.top - top);
|
|
|
|
if Right > workArea.Right then
|
|
OffsetRect(MSG.DragRect^, workArea.Right - Right, 0);
|
|
|
|
if Bottom > workArea.Bottom then
|
|
OffsetRect(MSG.DragRect^, 0, workArea.Bottom - Bottom);
|
|
end;
|
|
|
|
end;
|
|
|
|
end.
|