passlist.pas

用delphi写的密码管理工具.

unit PassList;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Menus, StdCtrls, ExtCtrls, Clipbrd, Buttons, ImgList, ToolWin, PassAction;

const
  MaxGroups = 64;

type
  TfraPassList = class(TFrame)
    ListBox1: TListBox;
    PopupMenu1: TPopupMenu;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    lblServer: TLabel;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    btnAutoLocate: TToolButton;
    ToolButton1: TToolButton;
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
    procedure MenuItemOnClick(Sender: TObject);
  public
    { Public declarations }
    slPassGroup: TStringList;
    slUserName, slPass, slTitle: array [0..MaxGroups - 1] of TStringList;
    PassActions: array [0..63] of TPassAction;
    PassActionCount: Integer;
    procedure Initialize;
    procedure Finalize;
    procedure LoadPassList;
    procedure CreateMenu;
    procedure AutoLocate;
    procedure GenList;
  end;

implementation

uses SNDKEY32, Main, SelectWin, Log;

{$R *.DFM}

const
  WeekDayStr: array [1..7] of string = ('星期日', '星期一', '星期二', '星期三', '星期四', '星期五', '星期六');
  WeekDayStr2: array [1..7] of string = ('日', '一', '二', '三', '四', '五', '六');

procedure TfraPassList.Initialize;
var
  i: Integer;
begin
  slPassGroup := TStringList.Create;
  for i := 0 to MaxGroups - 1 do
  begin
    slUserName[i] := TStringList.Create;
    slPass[i] := TStringList.Create;
    slTitle[i] := TStringList.Create;
  end;

  PassActionCount := 0;
end;

procedure TfraPassList.Finalize;
var
  i: Integer;
begin
  slPassGroup.Free;
  for i := 0 to MaxGroups - 1 do
  begin
    slUserName[i].Free;
    slPass[i].Free;
    slTitle[i].Free;
  end;

  for i := 0 to PassActionCount - 1 do
    PassActions[i].Free;
end;

procedure TfraPassList.LoadPassList;

  procedure LoadPassListFromFile(FileName: string);
  var
    f: TextFile;
    i, iPos: Integer;
    s: string;
  begin
    if not FileExists(FileName) then
    begin
      Application.MessageBox(PChar('文件找不到：' + FileName), '错误', MB_OK);
      Exit;
    end;

    AssignFile(f, FileName);
    try
      i := slPassGroup.Count - 1;
      Reset(f);
      while not Eof(f) do
      begin
        Readln(f, s);
        if s = '---------------Page---------------' then
        begin
          Inc(i);
          Readln(f, s);
          slPassGroup.Add(s);
          Readln(f, s);
        end;
        iPos := Pos(Chr(9), s);
        if iPos > 0 then
        begin
          slTitle[i].Add(Copy(s, 1, iPos - 1));
          s := Trim(Copy(s, iPos + 1, MaxInt));

          iPos := Pos(Chr(9), s);
          if iPos > 0 then
          begin
            slUserName[i].Add(Copy(s, 1, iPos - 1));
            slPass[i].Add(Trim(Copy(s, iPos + 1, MaxInt)));
          end
          else
            raise Exception.Create('密码表文件第' + IntToStr(i) + '行格式不正确。');
        end
        else begin
          slTitle[i].Add(s);
          Readln(f, s);
          slUserName[i].Add(s);
          Readln(f, s);
          slPass[i].Add(s);
        end;
      end;
    finally
      CloseFile(f);
    end;
  end;

var
  i: Integer;
begin
  if ParamCount = 0 then
    LoadPassListFromFile(ExtractFilePath(Application.ExeName) + '密码表.txt')
  else
    for i := 1 to ParamCount do
      LoadPassListFromFile(ParamStr(i));
end;

procedure TfraPassList.CreateMenu;
var
  i: Integer;
  mi: TMenuItem;
begin
  for i := 0 to PassActionCount - 1 do
  begin
    mi := TMenuItem.Create(PopupMenu1.Items);
    mi.Caption := PassActions[i].Name;
    mi.Tag := i;
    mi.ShortCut := PassActions[i].HotKey;
    mi.OnClick := MenuItemOnClick;
    PopupMenu1.Items.Add(mi);
  end;
end;

procedure TfraPassList.AutoLocate;
var
  i, iHour: Integer;
  sWeekDay, sTimePeriod: string;
begin
  sWeekDay := WeekDayStr2[DayOfWeek(Date)];
  iHour := StrToInt(FormatDateTime('HH', Now));
  if (iHour >= 0) and (iHour < 8) then
    sTimePeriod := '0:00 - 8:00'
  else if (iHour >= 8) and (iHour < 16) then
    sTimePeriod := '8:00 - 16:00'
  else
    sTimePeriod := '16:00 - 24:00';

  for i := 0 to ListBox1.Items.Count - 1 do
    if (Pos(sWeekDay, ListBox1.Items[i]) > 0) and (Pos(sTimePeriod, ListBox1.Items[i]) > 0) then
    begin
      ListBox1.ItemIndex := -1;
      ListBox1.ItemIndex := i;
      Break;
    end;
end;

procedure TfraPassList.GenList;
begin
  ListBox1.Items.Assign(slTitle[frmMain.SelGrpIndex]);
  lblServer.Caption := slPassGroup[frmMain.SelGrpIndex] + '   ';
  StatusBar1.Panels[0].Text := '';
  StatusBar1.Panels[1].Text := '';
  AutoLocate;
end;

procedure TfraPassList.MenuItemOnClick(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    raise Exception.Create('请选中一行');
  PassActions[TMenuItem(Sender).Tag].DoAction(
    slUserName[frmMain.SelGrpIndex][ListBox1.ItemIndex],
    slPass[frmMain.SelGrpIndex][ListBox1.ItemIndex],
    slPassGroup[frmMain.SelGrpIndex]
    );
end;

//----------------------------------------------------------------------------------------

procedure TfraPassList.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i: Integer;
begin
  if Key = 13 then
    ListBox1DblClick(Sender);

  for i := 0 to PassActionCount - 1 do
    if ShortCut(Key, Shift) = PassActions[i].HotKey then
    begin
      if ListBox1.ItemIndex = -1 then
        raise Exception.Create('请选中一行');
      PassActions[i].DoAction(
        slUserName[frmMain.SelGrpIndex][ListBox1.ItemIndex],
        slPass[frmMain.SelGrpIndex][ListBox1.ItemIndex],
        slPassGroup[frmMain.SelGrpIndex]
        );
      Key := 0;
      Break;
    end;
end;

procedure TfraPassList.ListBox1DblClick(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    raise Exception.Create('请选中一行');
  StatusBar1.Panels[0].Text := slUserName[frmMain.SelGrpIndex][ListBox1.ItemIndex];
  StatusBar1.Panels[1].Text := slPass[frmMain.SelGrpIndex][ListBox1.ItemIndex];
end;

procedure TfraPassList.ListBox1Click(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := '';
  StatusBar1.Panels[1].Text := '';
end;

procedure TfraPassList.SpeedButton1Click(Sender: TObject);
begin
  AutoLocate;
end;

procedure TfraPassList.ToolButton1Click(Sender: TObject);
begin
  if PopupMenu1.Items.Count > 0 then
    PopupMenu1.Items[0].Click;
end;

end.