fmain.pas

CryptoKit使用简便的加密解密控件。(源代码

procedure TForm1.btLoadRsaKeyClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.DefaultExt := 'keyrsa';
  OpenDialog1.Filter := 'RSA keys (*.keyrsa)|*.keyrsa';
  if OpenDialog1.Execute then begin
    RSA1.LoadKeysFromFile(OpenDialog1.FileName);
    RefreshRsaKey;
  end;
end;

procedure TForm1.btSaveSymKeyClick(Sender: TObject);
var s, sext: string;
begin
  OpenDialog1.FileName := '';
  s := Copy(FSelCrypto.Name, 1, Length(FSelCrypto.Name)-1);
  sext := 'key' + Lowercase(Copy(s, 1, 3));
  OpenDialog1.DefaultExt := sext;
  OpenDialog1.Filter := Format('%s keys (*.%s)|*.%1:s', [s, sext]);
  if OpenDialog1.Execute then FSelCrypto.SaveKeysToFile(OpenDialog1.FileName);
end;

procedure TForm1.btSaveRsaKeyClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.DefaultExt := 'keyrsa';
  OpenDialog1.Filter := 'RSA keys (*.keyrsa)|*.keyrsa';
  if OpenDialog1.Execute then RSA1.SaveKeysToFile(OpenDialog1.FileName);
end;

procedure TForm1.rbSymKeyHexClick(Sender: TObject);
begin
  EditSymKey.Text := TAS_SymmCryptography(FSelCrypto).KeyHexStr;
end;

procedure TForm1.rbSymKeyStrClick(Sender: TObject);
begin
  EditSymKey.Text := TAS_SymmCryptography(FSelCrypto).KeyText;
end;

procedure TForm1.EditSymKeyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  btUpdSymKey.Enabled := True;
end;

procedure TForm1.rbIVHexClick(Sender: TObject);
begin
  EditIV.Text := TAS_SymmCryptography(FSelCrypto).InitVectorHexStr;
  EditIV.MaxLength := 16;
end;

procedure TForm1.rbIVStrClick(Sender: TObject);
begin
  EditIV.Text := TAS_SymmCryptography(FSelCrypto).InitVectorText;
  EditIV.MaxLength := 8;
end;

procedure TForm1.EditSymKeyOptKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);
begin
  btUpdSymKey.Enabled := True;
end;

procedure TForm1.EditRsaKeyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  btUpdRsaKey.Enabled := True;
end;

// algorithm

procedure TForm1.rbDESClick(Sender: TObject);
begin
  FSelCrypto := DES1;
  RefreshSymKey;

  LabelSymKeyLim.Caption := '8..256 bytes, multiple of 8';
  EditSymKeyLen.Text     := '24';
  EditSymKeyLen.Enabled  := True;

  PanelSymKeyOpt.Visible := True;
  LabelSymKeyOpt.Caption := 'Cipher mask';
  EditSymKeyOpt.Text     := IntToStr(DES1.CipherMask);
end;

procedure TForm1.rbRC2Click(Sender: TObject);
begin
  FSelCrypto := RC21;
  RefreshSymKey;

  LabelSymKeyLim.Caption := '1..128 bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := True;

  PanelSymKeyOpt.Visible := True;
  LabelSymKeyOpt.Caption := 'Effective bits';
  EditSymKeyOpt.Text     := IntToStr(RC21.EffectiveBits);
end;

procedure TForm1.rbRC4Click(Sender: TObject);
begin
  FSelCrypto := RC41;
  RefreshSymKey;

  LabelSymKeyLim.Caption := '1 or more bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := True;

  PanelSymKeyOpt.Visible := False;
end;

procedure TForm1.rbRC5Click(Sender: TObject);
begin
  FSelCrypto := RC51;
  RefreshSymKey;

  LabelSymKeyLim.Caption := 'Up to 256 bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := True;

  PanelSymKeyOpt.Visible := True;
  LabelSymKeyOpt.Caption := 'Number of rounds';
  EditSymKeyOpt.Text     := IntToStr(RC51.NumRounds);
end;

procedure TForm1.rbBFClick(Sender: TObject);
begin
  FSelCrypto := BlowFish1;
  RefreshSymKey;

  LabelSymKeyLim.Caption := 'Up to 72 bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := True;

  PanelSymKeyOpt.Visible := False;
end;

procedure TForm1.rbCastClick(Sender: TObject);
begin
  FSelCrypto := Cast1;
  RefreshSymKey;

  LabelSymKeyLim.Caption := 'Up to 16 bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := False;
  PanelSymKeyOpt.Visible := False;
end;

procedure TForm1.rbIdeaClick(Sender: TObject);
begin
  FSelCrypto := Idea1;
  RefreshSymKey;

  LabelSymKeyLim.Caption := '16 bytes';
  EditSymKeyLen.Text     := '16';
  EditSymKeyLen.Enabled  := False;
  PanelSymKeyOpt.Visible := False;
end;

procedure TForm1.rbPkcsClick(Sender: TObject);
begin
  LabelRsaKeyLim.Caption := '32 to 512 bytes';
  EditRsaKeyLen.Text     := '32';
  RSA1.EncryptionScheme  := esPkcs1;
  PanelShemeDigest.Visible := False;
end;

procedure TForm1.rbOaepClick(Sender: TObject);
begin
  LabelRsaKeyLim.Caption := '64 to 512 bytes';
  EditRsaKeyLen.Text     := '64';
  RSA1.EncryptionScheme  := esOaep;

  PanelShemeDigest.Visible := True;
  if RSA1.EncryptingDigest = MDXforRSA then
    cbRsaDigest.ItemIndex := Ord(MDXforRSA.Version) else
    cbRsaDigest.ItemIndex := Ord(dgMD5)+1;
  EditRSA2.Text := '';
  EditRSA3.Text := '';
end;

procedure TForm1.cbRsaDigestClick(Sender: TObject);
begin
  if cbRsaDigest.ItemIndex <= Ord(dgMD5) then
    RSA1.EncryptingDigest := MDXforRSA else
    RSA1.EncryptingDigest := SHA1forRSA;
  EditRSA2.Text := '';
  EditRSA3.Text := '';
end;

(*
procedure TForm1.rbRSAClick(Sender: TObject);
begin
  FSelCrypto := Rsa1;
  GroupCM.Visible := False;

  LabelKey.Caption := 'N';
  EditKeyD.Text    := RSA1.KeyDHexStr;
  EditKeyE.Text    := RSA1.KeyEHexStr;
  EditSymKey.Text  := RSA1.KeyNHexStr;

  LabelRsaKeyLim.Caption := '32 to 512 bytes';
  EditRsaKeyLen.Text := '128';
  EditRsaKeyLen.Enabled := True;

  LabelRsaKeyOpt.Caption := '';
  EditSymKeyOpt.Visible := False;

  PanelRSA.Visible := True;
  btSignFile.Enabled := True;
  btVerifySign.Enabled := True;
end;*)

// cipher mode

procedure TForm1.rbECBClick(Sender: TObject);
begin
  TAS_SymmCryptography(FSelCrypto).CipherMode := cmECB;
  PanelIV.Visible := False;
end;

procedure TForm1.rbCBCClick(Sender: TObject);
begin
  TAS_SymmCryptography(FSelCrypto).CipherMode := cmCBC;
  PanelIV.Visible := True;
end;

procedure TForm1.rbCFBClick(Sender: TObject);
begin
  TAS_SymmCryptography(FSelCrypto).CipherMode := cmCFB;
  PanelIV.Visible := True;
end;

procedure TForm1.rbOFBClick(Sender: TObject);
begin
  TAS_SymmCryptography(FSelCrypto).CipherMode := cmOFB;
  PanelIV.Visible := True;
end;

// data

procedure TForm1.rbSymDataHexClick(Sender: TObject);
begin
  EditSym1.Text := StrToHexStr(EditSym1.Text, False);
  EditSym3.Text := StrToHexStr(EditSym3.Text, False);
end;

procedure TForm1.rbSymDataStrClick(Sender: TObject);
begin
  EditSym1.Text := HexStrToStr(EditSym1.Text, False);
  EditSym3.Text := HexStrToStr(EditSym3.Text, False);
end;

procedure TForm1.rbRsaDataHexClick(Sender: TObject);
begin
  EditRsa1.Text := StrToHexStr(EditRsa1.Text, False);
  EditRsa3.Text := StrToHexStr(EditRsa3.Text, False);
end;

procedure TForm1.rbRsaDataStrClick(Sender: TObject);
begin
  EditRsa1.Text := HexStrToStr(EditRsa1.Text, False);
  EditRsa3.Text := HexStrToStr(EditRsa3.Text, False);
end;

// encrypt/decrypt

procedure TForm1.btEncryptSymClick(Sender: TObject);
var S: string; P: Pointer; len: DWord;
begin
  if btUpdSymKey.Enabled then btUpdSymKeyClick(nil);  // save key if changed

  if rbSymDataHex.Checked then
    P := HexStrToBuffer(EditSym1.Text, len)
  else begin
    S := EditSym1.Text;
    P := @S[1];
    len := Length(S);
  end;
  FSelCrypto.Encrypt(P, len);

  if not FSelCrypto.CipherInPlace then begin
    P := FSelCrypto.EncryptedData.Memory;
    len := FSelCrypto.EncryptedData.Size;
  end;
  EditSym2.Text := BytesToHexStr(P, len, False);

  btDecryptSymClick(nil);
end;

procedure TForm1.btDecryptSymClick(Sender: TObject);
var P: Pointer; len: DWord;
begin
  P := HexStrToBuffer(EditSym2.Text, len);
  FSelCrypto.Decrypt(P, len);
  if not FSelCrypto.CipherInPlace then begin
    P := FSelCrypto.DecryptedData.Memory;
    len := FSelCrypto.DecryptedData.Size;
  end;
  if rbSymDataHex.Checked then
    EditSym3.Text := BytesToHexStr(P, len, False) else
    EditSym3.Text := BytesToStr(P, len, False);
end;

procedure TForm1.btEncryptRsaClick(Sender: TObject);
var S: string; P: Pointer; len: DWord;
begin
  if btUpdRsaKey.Enabled then btUpdRsaKeyClick(nil);  // save key if changed

  if rbRsaDataHex.Checked then
    P := HexStrToBuffer(EditRsa1.Text, len)
  else begin
    S := EditRsa1.Text;
    P := @S[1];
    len := Length(S);
  end;
  RSA1.Encrypt(P, len);

  P := RSA1.EncryptedData.Memory;
  len := RSA1.EncryptedData.Size;
  EditRsa2.Text := BytesToHexStr(P, len, False);

  btDecryptRsaClick(nil);
end;

procedure TForm1.btDecryptRsaClick(Sender: TObject);
var P: Pointer; len: DWord;
begin
  P := HexStrToBuffer(EditRsa2.Text, len);
  RSA1.Decrypt(P, len);
  P := RSA1.DecryptedData.Memory;
  len := RSA1.DecryptedData.Size;
  if rbRsaDataHex.Checked then
    EditRsa3.Text := BytesToHexStr(P, len, False) else
    EditRsa3.Text := BytesToStr(P, len, False);
end;

procedure TForm1.tbEncryptSymFileClick(Sender: TObject);
var s, sext, senc: string;
begin
  Screen.Cursor := crHourGlass;
  try
    OpenDialog1.FileName := '';
    OpenDialog1.Filter := 'All files (*.*)|*.*';
    if OpenDialog1.Execute then begin
      s := Copy(FSelCrypto.Name, 1, Length(FSelCrypto.Name)-1);
      sext := Lowercase(Copy(s, 1, 3));
      senc := ChangeFileExt(OpenDialog1.FileName, '.'+sext);
      Status[0] := 'Encrypting file: ' + OpenDialog1.FileName + '...';
      FSelCrypto.EncryptFile(OpenDialog1.FileName, senc);
      MessageDlg('Encrypted file is: ' + senc, mtConfirmation, [mbOK], 0);
    end;
  finally
    Screen.Cursor := crDefault;
    Status[0] := '';
  end;
end;

procedure TForm1.tbDecryptSymFileClick(Sender: TObject);
var s, sext, sdec: string;
begin
  Screen.Cursor := crHourGlass;
  try
    OpenDialog1.FileName := '';
    OpenDialog1.Filter := 'All files (*.*)|*.*';
    s := Copy(FSelCrypto.Name, 1, Length(FSelCrypto.Name)-1);
    sext := Lowercase(Copy(s, 1, 3));
    OpenDialog1.DefaultExt := sext;
    OpenDialog1.Filter := Format('%s encrypted files (*.%s)|*.%1:s|All files (*.*)|*.*', [s, sext]);
    if OpenDialog1.Execute then begin
      sdec := ChangeFileExt(OpenDialog1.FileName, '.tmp');
      Status[0] := 'Decrypting file: ' + OpenDialog1.FileName + '...';
      FSelCrypto.DecryptFile(OpenDialog1.FileName, sdec);
      MessageDlg('Decrypted file is: ' + sdec, mtConfirmation, [mbOK], 0);
    end;
  finally
    Screen.Cursor := crDefault;
    Status[0] := '';
  end;
end;

procedure TForm1.tbEncryptRsaFileClick(Sender: TObject);
var senc: string;
begin
  Screen.Cursor := crHourGlass;
  try
    OpenDialog1.FileName := '';
    OpenDialog1.Filter := 'All files (*.*)|*.*';
    if OpenDialog1.Execute then begin
      senc := ChangeFileExt(OpenDialog1.FileName, '.rsa');
      Status[0] := 'Encrypting file: ' + OpenDialog1.FileName + '...';
      RSA1.EncryptFile(OpenDialog1.FileName, senc);
      MessageDlg('Encrypted file is: ' + senc, mtConfirmation, [mbOK], 0);
    end;
  finally
    Screen.Cursor := crDefault;
    Status[0] := '';
  end;
end;

procedure TForm1.tbDecryptRsaFileClick(Sender: TObject);
var sdec: string;
begin
  Screen.Cursor := crHourGlass;
  try