⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 genpass.pas

📁 用delphi写的密码管理工具.
💻 PAS
字号:
unit GenPass;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Clipbrd;

type
  TfraGenPass = class(TFrame)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    editPassLen: TEdit;
    UpDown1: TUpDown;
    editPassCount: TEdit;
    UpDown2: TUpDown;
    btnGen: TButton;
    btnClear: TButton;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    chkDigit: TCheckBox;
    chkUpper: TCheckBox;
    chkLower: TCheckBox;
    editCharSet: TEdit;
    Label3: TLabel;
    editPrefix: TEdit;
    btnCopy: TButton;
    procedure chkUpperClick(Sender: TObject);
    procedure editCharSetChange(Sender: TObject);
    procedure chkLowerClick(Sender: TObject);
    procedure chkDigitClick(Sender: TObject);
    procedure btnGenClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnCopyClick(Sender: TObject);
  private
    { Private declarations }
    function RandomStr(Length: Integer; CharSetStr: string): string;
  public
    { Public declarations }
  end;

implementation

uses Main;

{$R *.DFM}

function TfraGenPass.RandomStr(Length: Integer; CharSetStr: string): string;
var
  i: Integer;
begin
  SetLength(Result, Length);
  for i := 1 to Length do
    Result[i] := CharSetStr[Random(System.Length(CharSetStr) - 1) + 1];
end;

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

procedure TfraGenPass.editCharSetChange(Sender: TObject);
var
  s: string;
  c: Char;
  i, j, iMin, iLen: Integer;
begin
  { 按ASCII码排序 }
  s := editCharSet.Text;
  iLen := Length(s);
  for i := 1 to iLen - 1 do
  begin
    iMin := i;
    for j := i + 1 to iLen do
      if s[iMin] > s[j] then
        iMin := j;
    if iMin <> i then
    begin
      c := s[iMin];
      s[iMin] := s[i];
      s[i] := c;
    end;
  end;

  { 去掉重复的 }
  i := 1;
  while i <= Length(s) do
  begin
    s := Copy(s, 1, i) + StringReplace(Copy(s, i + 1, MaxInt), s[i], '', [rfReplaceAll]);
    Inc(i);
  end;

  editCharSet.Text := s;
end;

procedure TfraGenPass.chkUpperClick(Sender: TObject);
var
  c: Char;
  sCharSet: string;
begin
  sCharSet := editCharSet.Text;

  if chkUpper.Checked then
  begin
    for c := 'A' to 'Z' do
      if Pos(c, sCharSet) = 0 then
        sCharSet := sCharSet + c
  end
  else begin
    for c := 'A' to 'Z' do
      if Pos(c, sCharSet) <> 0 then
        sCharSet := StringReplace(sCharSet, c, '', [rfReplaceAll]);
  end;

  editCharSet.Text := sCharSet;
end;


procedure TfraGenPass.chkLowerClick(Sender: TObject);
var
  c: Char;
  sCharSet: string;
begin
  sCharSet := editCharSet.Text;

  if chkLower.Checked then
  begin
    for c := 'a' to 'z' do
      if Pos(c, sCharSet) = 0 then
        sCharSet := sCharSet + c
  end
  else begin
    for c := 'a' to 'z' do
      if Pos(c, sCharSet) <> 0 then
        sCharSet := StringReplace(sCharSet, c, '', [rfReplaceAll]);
  end;

  editCharSet.Text := sCharSet;
end;

procedure TfraGenPass.chkDigitClick(Sender: TObject);
var
  c: Char;
  sCharSet: string;
begin
  sCharSet := editCharSet.Text;

  if chkDigit.Checked then
  begin
    for c := '0' to '9' do
      if Pos(c, sCharSet) = 0 then
        sCharSet := sCharSet + c
  end
  else begin
    for c := '0' to '9' do
      if Pos(c, sCharSet) <> 0 then
        sCharSet := StringReplace(sCharSet, c, '', [rfReplaceAll]);
  end;

  editCharSet.Text := sCharSet;
end;

procedure TfraGenPass.btnGenClick(Sender: TObject);
var
  i: Integer;
begin
  if editCharSet.Text = '' then
    raise Exception.Create('字符集为空');

  if StrToInt(editPassLen.Text) <= Length(editPrefix.Text) then
    raise Exception.Create('前缀长度已经等于或超过密码长度。');

  Randomize;
  for i := 1 to StrToInt(editPassCount.Text) do
    Memo1.Lines.Add(editPrefix.Text +
      RandomStr(StrToInt(editPassLen.Text) - Length(editPrefix.Text), editCharSet.Text));
end;

procedure TfraGenPass.btnClearClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TfraGenPass.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = Ord('A')) and (Shift = [ssCtrl]) then
    Memo1.SelectAll;
end;

procedure TfraGenPass.btnCopyClick(Sender: TObject);
begin
  if Memo1.SelText = '' then
    Clipboard.SetTextBuf(PChar(Memo1.Text))
  else
    Clipboard.SetTextBuf(PChar(Memo1.SelText));
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -