unit1.pas

提供字符串、文件 及 Memory Streams 加密/解密的控件 ( 2.1 版

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Mask, StdCtrls, KBCrypt, ExtCtrls, ShellApi;

type
  TForm1 = class(TForm)
    EditStr: TEdit;
    BCrStr: TButton;
    BDeStr: TButton;
    EditPwd: TEdit;
    BSetPwd: TButton;
    Label1: TLabel;
    EditHash: TEdit;
    Label3: TLabel;
    Panel1: TPanel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    OpenDialog1: TOpenDialog;
    BCFile: TButton;
    BDFile: TButton;
    EditFile: TEdit;
    Label7: TLabel;
    Button3: TButton;
    Label8: TLabel;
    BLoad: TButton;
    BSave: TButton;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    EditStream: TEdit;
    Button1: TButton;
    Label12: TLabel;
    EditChkPwd: TEdit;
    Label13: TLabel;
    EditChkHash: TEdit;
    label15: TLabel;
    BtnChkPasswd: TButton;
    CryptLib1: TCryptLib;
    Label14: TLabel;
    Label2: TLabel;
    BCrack: TButton;
    Box: TComboBox;
    Label16: TLabel;
    procedure BCrStrClick(Sender: TObject);
    procedure BSetPwdClick(Sender: TObject);
    procedure BDeStrClick(Sender: TObject);
    procedure BCFileClick(Sender: TObject);
    procedure BDFileClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BLoadClick(Sender: TObject);
    procedure BSaveClick(Sender: TObject);
    procedure BtnChkPasswdClick(Sender: TObject);
    procedure CryptLib1BadPassword(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Label5Click(Sender: TObject);
    procedure Label6Click(Sender: TObject);
    procedure BCrackClick(Sender: TObject);
    procedure CryptLib1FileCrypt(Sender: TObject);
    procedure CryptLib1MemCrypt(Sender: TObject);
    procedure BoxChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  BadFlag : boolean =false ;
var
  Form1: TForm1;
  DemoStream : TMemoryStream;
implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.BCrStrClick(Sender: TObject);
begin
  EditStr.Text:=CryptLib1.EncryptStr(EditStr.Text);
end;

procedure TForm1.BSetPwdClick(Sender: TObject);
begin
  CryptLib1.Password:=Trim(EditPwd.Text);
  EditHash.Text:=CryptLib1.PasswdHash;
  EditChkHash.Text:=EditHash.Text;
  EditChkPwd.Text:=EditPwd.Text;
end;

procedure TForm1.BDeStrClick(Sender: TObject);
begin
  EditStr.Text:=CryptLib1.DecryptStr(EditStr.Text);
end;

procedure TForm1.BCFileClick(Sender: TObject);
var t : tdatetime;
begin
  if not FileExists(EditFile.Text) then exit;
  t:=time();
  With CryptLib1 do
  begin
    Infile:=EditFile.Text;
    Outfile:=EditFile.Text;
    EncryptFile;
  end;
  ShowMessage(CryptLib1.Infile+' encrypted !     time: '+TimeToStr(Time()-t));
end;

procedure TForm1.BDFileClick(Sender: TObject);
var t : tdatetime;
begin
  if not FileExists(EditFile.Text) then exit;
  t:=time();
  BadFlag:=false;
  With CryptLib1 do
  begin
    Infile :=EditFile.Text;
    Outfile:=EditFile.Text;
    DecryptFile;
  end;
  if not BadFlag then ShowMessage(CryptLib1.Infile+' decrypted !     time: '+TimeToStr(Time()-t));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then EditFile.Text:=OpenDialog1.Filename;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then EditStream.Text:=OpenDialog1.Filename;
end;

procedure TForm1.BLoadClick(Sender: TObject);
var t : tdatetime;
begin
  if not FileExists(EditStream.Text) then exit;
  if DemoStream.Size=0  then
  begin
    t:=time();
    DemoStream.LoadFromFile(EditStream.Text);
    CryptLib1.EncryptMemory(DemoStream);
    // you can save encrypted memory stream to file 
    // DemoStream.SaveToFile(EditStream.Text+'~mem~enc');
    ShowMessage(EditStream.Text+' encrypted to memory stream !     time: '+TimeToStr(Time()-t));
    BLoad.Enabled:=false;
    BSave.Enabled:=true;
  end;
end;

procedure TForm1.BSaveClick(Sender: TObject);
var t : tdatetime;
begin
  if DemoStream.Size<>0 then
  begin
    t:=time();
    CryptLib1.DecryptMemory(DemoStream);
    DemoStream.SaveToFile(EditStream.Text+'~mem~dec');
    DemoStream.Clear;
    ShowMessage('Memory stream decrypted to file '+EditStream.Text+'~mem~dec     time: '+TimeToStr(Time()-t));
    BLoad.Enabled:=true;
    BSave.Enabled:=false;
  end;
end;

procedure TForm1.BtnChkPasswdClick(Sender: TObject);
begin
  if CryptLib1.PasswdIsGood(trim(EditChkHash.Text), trim(EditChkPwd.Text))
    then ShowMessage('Your password is good !')
    else ShowMessage('Your password is bad !');
end;

procedure TForm1.CryptLib1BadPassword(Sender: TObject);
begin
  ShowMessage('File password is bad !');
  BadFlag:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label2.Caption:='AddKey='+IntToStr(CryptLib1.AddKey)+'      MultKey='+IntToStr(CryptLib1.MultKey);
  EditPwd.Text:='My  Password';
  CryptLib1.Password:=EditPwd.Text;
  DemoStream:=TMemoryStream.Create;
  BSetPwdClick(Self);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DemoStream.Free;
end;

procedure TForm1.Label5Click(Sender: TObject);
begin
  ShellExecute(Application.Handle, nil, 'mailto:[e-mail]'+#0, nil, nil, SW_SHOWNORMAL)
end;

procedure TForm1.Label6Click(Sender: TObject);
begin
  ShellExecute(Application.Handle, nil, 'http://ntadm.euro.ru'+#0, nil, nil, SW_SHOWNORMAL)
end;

procedure TForm1.BCrackClick(Sender: TObject);
begin
  Form2:=TForm2.Create(Application);
  Form2.ShowModal;
  Form2.Free;
end;

procedure TForm1.CryptLib1FileCrypt(Sender: TObject);
begin
  Application.ProcessMessages;
end;

procedure TForm1.CryptLib1MemCrypt(Sender: TObject);
begin
  Application.ProcessMessages;
end;               

procedure TForm1.BoxChange(Sender: TObject);
begin
  if Box.Items.Strings[Box.ItemIndex]='none' then CryptLib1.Compression:=none;
  if Box.Items.Strings[Box.ItemIndex]='Z'    then CryptLib1.Compression:=Z;
  if Box.Items.Strings[Box.ItemIndex]='LZ'   then CryptLib1.Compression:=LZ;
end;

end.