ulogin.pas

电脑锁定

unit uLogin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math;

type
  TProcessorTimeInfo = record
    IdleTime: int64;
    KernelTime: int64;
    UserTime: int64;
    DpcTime: int64;
    InterruptTime:int64;
    InterruptCount:cardinal;
  end;

  TfrmLogin = class(TForm)
    Bevel1: TBevel;
    lblNameLabel: TLabel;
    lblUserLabel: TLabel;
    lblLogoffLabel: TLabel;
    lblUpTimeLabel: TLabel;
    lblNetworkLabel: TLabel;
    lblComputerLabel: TLabel;
    lblComputerName: TLabel;
    lblCurrentUser: TLabel;
    lblLogoffTime: TLabel;
    lblTotalUpTime: TLabel;
    lblNetworkUsage: TLabel;
    lblComputerUsage: TLabel;
    lblTimeLabel: TLabel;
    lblCurrentTime: TLabel;
    lblPasswordLabel: TLabel;
    edPassword: TEdit;
    btnLogin: TButton;
    GroupBox1: TGroupBox;
    btnLogoff: TButton;
    btnShutdown: TButton;
    btnRestart: TButton;
    tmrUpdate: TTimer;
    cbDeletePassword: TCheckBox;
    lblIncorrect: TLabel;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDeactivate(Sender: TObject);
    procedure tmrUpdateTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure btnShutdownClick(Sender: TObject);
    procedure btnRestartClick(Sender: TObject);
    procedure btnLogoffClick(Sender: TObject);
    procedure edPasswordKeyPress(Sender: TObject; var Key: Char);
    procedure btnLoginClick(Sender: TObject);
  private
    IsTop : Boolean;
    CloseMe : Boolean;
    Incorrect : Integer;
    { Private declarations }
  public
    S1, S2 : Int64;
    { Public declarations }
  end;

function NtQuerySystemInformation(si_class: DWORD; si: Pointer; si_length: DWORD; ret_length: DWORD): DWORD; stdcall; external 'ntdll.dll';

var
  frmLogin : TfrmLogin;

implementation

uses uMain, IPHelper, IPHLPAPI, TrafficUnit, uLockHook;

var
  Network : TTraffic = nil;
  TrafficMain : Integer;

{$R *.dfm}

function WindowsExit(RebootParam: Longword): Boolean;
var
  TTokenHd : THandle;
  TTokenPvg : TTokenPrivileges;
  cbtpPrevious : DWORD;
  rTTokenPvg : TTokenPrivileges;
  pcbtpPreviousRequired : DWORD;
  tpResult : Boolean;
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  If Win32Platform = VER_PLATFORM_WIN32_NT Then
    begin
    tpResult := OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY,TTokenHd);
    If tpResult Then
      begin
      tpResult := LookupPrivilegeValue(nil,SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid);
      TTokenPvg.PrivilegeCount := 1;
      TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      cbtpPrevious := SizeOf(rTTokenPvg);
      pcbtpPreviousRequired := 0;
      If tpResult Then
        begin
        Windows.AdjustTokenPrivileges(TTokenHd,False,TTokenPvg,cbtpPrevious,rTTokenPvg,pcbtpPreviousRequired);
      end;
    end;
  end;
  Result := ExitWindowsEx(RebootParam,0);
end;

procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
  FileStream : TFileStream;
  BufferLen : PDWORD;
begin
  If MD5(edPassword.Text) = frmMain.MD5Password Then
    begin
    If cbDeletePassword.Checked Then
      begin
      RenameFile(ParamStr(0),ChangeFileExt(ParamStr(0),'.bak'));
      CopyFile(PChar(ChangeFileExt(ParamStr(0),'.bak')),PChar(ParamStr(0)),False);
      FileStream := TFileStream.Create(ParamStr(0),fmOpenReadWrite);
      BufferLen := AllocMem(4);
      FileStream.Position := FileStream.Size - 8;
      FileStream.Read(BufferLen^,4);
      FileStream.Position := FileStream.Size - 8 - BufferLen^;
      FileStream.Size := FileStream.Position;
      FileStream.Free;
    end;
    CloseMe := True;
    Close;
  end
  Else
    begin
    Inc(Incorrect);
    lblIncorrect.Caption := Format('Incorrect Password Attempt %d/3',[Incorrect]);
    lblIncorrect.Visible := True;
    edPassword.Text := '';
    If Incorrect = 3 Then
      begin
      btnLogin.OnClick := nil;
      edPassword.Enabled := False;
      btnLogin.Enabled := False;
      lblIncorrect.Caption := 'Incorrect Password Attempt 3/3 - Locked Out!';
    end;
  end;
end;

procedure TfrmLogin.btnLogoffClick(Sender: TObject);
begin
  WindowsExit(EWX_LOGOFF Or EWX_FORCE);
end;

procedure TfrmLogin.btnRestartClick(Sender: TObject);
begin
  WindowsExit(EWX_REBOOT Or EWX_FORCE);
end;

procedure TfrmLogin.btnShutdownClick(Sender: TObject);
begin
  WindowsExit(EWX_SHUTDOWN Or EWX_FORCE);
end;

procedure TfrmLogin.edPasswordKeyPress(Sender: TObject; var Key: Char);
begin
  If Key = #13 Then
    begin
    If Length(edPassword.Text) > 0 Then
      begin
      btnLogin.Click;
    end;
  end;
end;

procedure TfrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IsTop := False;
  tmrUpdate.Enabled := False;
  frmMain.Close;
end;

procedure TfrmLogin.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := CloseMe;
end;

procedure TfrmLogin.FormCreate(Sender: TObject);
var
  Buffer : PChar;
  BufSize : DWORD;
begin
  CloseMe := False;
  IsTop := False;
  Incorrect := 0;
  lblLogoffTime.Caption := FormatDateTime('hh:nn:ss AM/PM',Now);
  BufSize := 1024;
  Buffer := AllocMem(BufSize);
  Try
    GetComputerName(Buffer,BufSize);
    lblComputerName.Caption := Buffer;
    ZeroMemory(Buffer,BufSize);
    GetUserName(Buffer,BufSize);
    lblCurrentUser.Caption := Buffer;
  Finally
    FreeMem(Buffer);
  end;
end;

procedure TfrmLogin.FormDeactivate(Sender: TObject);
begin
  If Not(IsTop) Then Exit;
  SetFocus;
end;

procedure TfrmLogin.FormShow(Sender: TObject);
begin
  IsTop := True;
end;

procedure ProcessMIBData;
var
 MibArr : IpHlpAPI.TMIBIfArray;
 I : integer;
 ATraffic : TTraffic;
begin
  Get_IfTableMIB(MibArr);
  For I := 0 To High(MibArr) Do
    begin
    ATraffic := Network;
    If Assigned(ATraffic) then
      begin
      If I <> TrafficMain Then Continue;
      ATraffic.NewCycle(MIBArr[I].dwInOctets, MIBArr[I].dwOutOctets, MIBArr[I].dwSpeed);
    end
    Else
      begin
      Network := TTraffic.Create(MIBArr[I],nil);
      Network.Found := True;
      If Network.IP = '127.0.0.1' Then
        begin
        FreeAndNil(Network);
      end
      Else
        begin
        TrafficMain := I;
      end;
    end;
  end;
end;

procedure TfrmLogin.tmrUpdateTimer(Sender: TObject);
var
  UpTime : Int64;
  CPUUsage : Integer;
  Buffer : Array[0..299999] Of Char;
  TimeInfo : ^TProcessorTimeInfo;
  TotalSpeed : DWORD;
  SpeedText : String;
  function MSecToTime: String;
  var
    DT : TDateTime;
  begin
    DT := UpTime / MSecsPerSec / SecsPerDay;
    Result := Format('%.2d:%s',[Trunc(DT),FormatDateTime('hh:nn:ss',Frac(DT))]);
  end;
begin
  If Incorrect > 0 Then
    begin
    lblIncorrect.Visible := Not(lblIncorrect.Visible);
  end;
  NtQuerySystemInformation(8,@Buffer,300000,0);
  TimeInfo := @Buffer;
  S2 := TimeInfo^.KernelTime + TimeInfo^.UserTime - TimeInfo^.IdleTime;
  CPUUsage := Round((S2-S1) / 100000);
  S1 := S2;
  UpTime := GetTickCount;
  lblTotalUpTime.Caption := MSecToTime;
  lblCurrentTime.Caption := FormatDateTime('hh:nn:ss AM/PM',Now);
  lblComputerUsage.Caption := Format('%d%%',[Min(CPUUsage,100)]);
  ProcessMIBData;
  If Assigned(Network) Then
    begin
    TotalSpeed := Network.InPerSec + Network.OutPerSec;
    SpeedText := '';
    If TotalSpeed < 1024 Then
      begin
      SpeedText := Format('%d b/s',[TotalSpeed]);
    end
    Else If TotalSpeed < (1024 * 1024) Then
      begin
      SpeedText := Format('%f Kb/s',[TotalSpeed / 1024]);
    end
    Else
      begin
      SpeedText := Format('%f Mb/s',[TotalSpeed / (1024 * 1024)]);
    end;
    lblNetworkUsage.Caption := SpeedText;
  end;
end;

end.