fmain.pas

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

    OpenDialog1.FileName := '';
    OpenDialog1.DefaultExt := 'rsa';
    OpenDialog1.Filter := 'RSA encrypted files (*.rsa)|*.rsa|All files (*.*)|*.*';
    if OpenDialog1.Execute then begin
      sdec := ChangeFileExt(OpenDialog1.FileName, '.tmp');
      Status[0] := 'Decrypting file: ' + OpenDialog1.FileName + '...';
      RSA1.DecryptFile(OpenDialog1.FileName, sdec);
      MessageDlg('Decrypted file is: ' + sdec, mtConfirmation, [mbOK], 0);
    end;
  finally
    Screen.Cursor := crDefault;
    Status[0] := '';
  end;
end;

// sign/verify

procedure TForm1.tbSignFileClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'All files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    RSA1.SignFile(OpenDialog1.FileName);
    RSA1.SaveSignatureToFile(ChangeFileExt(OpenDialog1.FileName, '.sig'));
  end;
end;

procedure TForm1.tbVerifyFileClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'All files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    RSA1.LoadSignatureFromFile(ChangeFileExt(OpenDialog1.FileName, '.sig'));
    RSA1.VerifyFileSignature(OpenDialog1.FileName, RSA1.Signature.Memory, RSA1.Signature.Size);
    ShowMessage('Signature OK!');
  end;
end;

procedure TForm1.tbTestRsaKeyClick(Sender: TObject);
begin
  if RSA1.TestKeys then
    MessageDlg('RSA keys OK',     mtInformation, [mbOK], 0) else
    MessageDlg('RSA key invalid', mtError,       [mbOK], 0);
end;

// logging

procedure TForm1.tbClearLogClick(Sender: TObject);
begin
  MemoLog.Clear;
end;

procedure TForm1.CryptAfterDecrypt(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterDecrypt');
end;

procedure TForm1.CryptAfterDecryptBlock(Sender: TObject; Block: Pointer; Offset, Size: DWord);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterDecryptBlock');
  Application.ProcessMessages;
end;

procedure TForm1.CryptAfterEncrypt(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterEncrypt');
end;

procedure TForm1.CryptAfterEncryptBlock(Sender: TObject; Block: Pointer; Offset, Size: DWord);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterEncryptBlock');
  Application.ProcessMessages;
end;

procedure TForm1.CryptAfterGenKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterGenKeys');
end;

procedure TForm1.CryptAfterLoadKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterLoadKeys');
end;

procedure TForm1.CryptAfterSaveKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterSaveKeys');
end;

procedure TForm1.CryptBeforeDecrypt(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeDecrypt');
end;

procedure TForm1.CryptBeforeDecryptBlock(Sender: TObject; Block: Pointer; Offset, Size: DWord);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeDecryptBlock');
  Application.ProcessMessages;
end;

procedure TForm1.CryptBeforeEncrypt(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeEncrypt');
end;

procedure TForm1.CryptBeforeEncryptBlock(Sender: TObject; Block: Pointer; Offset, Size: DWord);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeEncryptBlock');
  Application.ProcessMessages;
end;

procedure TForm1.CryptBeforeGenKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeGenKeys');
end;

procedure TForm1.CryptBeforeLoadKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeLoadKeys');
end;

procedure TForm1.CryptBeforeSaveKeys(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeSaveKeys');
end;

procedure TForm1.SymmChangeInitVector(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': ChangeInitVector');
end;

procedure TForm1.SymmChangeKey(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': ChangeKey');
end;

procedure TForm1.SymmPostValidateKey(Sender: TObject; Key: Pointer;
  KeyByteLen: Integer; var KeyValid: Boolean);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': PostValidateKey');
end;

procedure TForm1.AS_PrimeGenerator1TryRandomPrime(Sender: TObject;  prime: GiantInt);
begin
  MemoLog.Lines.Add(Format('Check random is prime: %s', [GiantIntToHex(prime)]));
  Application.ProcessMessages;
end;

procedure TForm1.AS_PrimeGenerator1AfterGenPrime(Sender: TObject; prime: GiantInt);
begin
  MemoLog.Lines.Add(Format('Found prime: %s', [GiantIntToHex(prime)]));
end;

procedure TForm1.RSA1ChangeKeyD(Sender: TObject);
begin
  MemoLog.Lines.Add(Format('RSA: key D changed: %s', [RSA1.KeyDHexStr]));
end;

procedure TForm1.RSA1ChangeKeyE(Sender: TObject);
begin
  MemoLog.Lines.Add(Format('RSA: key E changed: %s', [RSA1.KeyEHexStr]));
end;

procedure TForm1.RSA1ChangeKeyN(Sender: TObject);
begin
  MemoLog.Lines.Add(Format('RSA: key N changed: %s', [RSA1.KeyNHexStr]));
end;

// Digest

procedure TForm1.rbMD2Click(Sender: TObject);
begin
  MDX1.Version := dgMD2;
  EditDigest.Text := '';
end;

procedure TForm1.rbMD4Click(Sender: TObject);
begin
  MDX1.Version := dgMD4;
  EditDigest.Text := '';
end;

procedure TForm1.rbMD5Click(Sender: TObject);
begin
  MDX1.Version := dgMD5;
  EditDigest.Text := '';
end;

procedure TForm1.rbSHA1Click(Sender: TObject);
begin
  EditDigest.Text := '';
end;

procedure TForm1.rbRipEmdClick(Sender: TObject);
begin
  EditDigest.Text := '';
end;

procedure TForm1.btDigestClick(Sender: TObject);
var P: Pointer; len: DWord;
begin
  if rbDgDataHex.Checked then begin
    P := HexStrToBuffer(EditDgData.Text, len);
    if rbSHA1.Checked   then SHA1.CalcDigest(P, len) else
    if rbRipEmd.Checked then Rip1.CalcDigest(P, len) else
      MDX1.CalcDigest(P, len);
  end
  else begin
    if rbSHA1.Checked   then SHA1.CalcDigestOfString(EditDgData.Text) else
    if rbRipEmd.Checked then Rip1.CalcDigestOfString(EditDgData.Text) else
      MDX1.CalcDigestOfString(EditDgData.Text);
  end;
  if rbSHA1.Checked     then EditDigest.Text := BytesToHexStr(SHA1.Digest, SHA1.DigestSize, False) else
  if rbRipEmd.Checked   then EditDigest.Text := BytesToHexStr(Rip1.Digest, Rip1.DigestSize, False) else
    EditDigest.Text := BytesToHexStr(MDX1.Digest, MDX1.DigestSize, False);
end;

procedure TForm1.rbDgDataHexClick(Sender: TObject);
begin
  EditDgData.Text := StrToHexStr(EditDgData.Text, False);
end;

procedure TForm1.rbDgDataStrClick(Sender: TObject);
begin
  EditDgData.Text := HexStrToStr(EditDgData.Text, False);
end;

procedure TForm1.tbDigestFileClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'All files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    if rbSHA1.Checked then begin
      SHA1.CalcDigestOfFile(OpenDialog1.FileName);
      EditDigest.Text := BytesToHexStr(SHA1.Digest, SHA1.DigestSize, False);
    end else
    if rbRipEmd.Checked then begin
      Rip1.CalcDigestOfFile(OpenDialog1.FileName);
      EditDigest.Text := BytesToHexStr(Rip1.Digest, Rip1.DigestSize, False);
    end
    else begin
      MDX1.CalcDigestOfString(OpenDialog1.FileName);
      EditDigest.Text := BytesToHexStr(MDX1.Digest, MDX1.DigestSize, False);
    end;
  end;
end;

// encoding /decoding

procedure TForm1.tbEncodeFileClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'All files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    if rbBase64.Checked then begin
      Base641.EncodeFile(OpenDialog1.FileName, ChangeFileExt(OpenDialog1.FileName, '.b64'));
    end;
  end;
end;

procedure TForm1.tbDecodeFileClick(Sender: TObject);
begin
  OpenDialog1.FileName := '';
  OpenDialog1.Filter := 'All files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    if rbBase64.Checked then begin
      Base641.DecodeFile(OpenDialog1.FileName, ChangeFileExt(OpenDialog1.FileName, '.tmp'));
    end;
  end;
end;

procedure TForm1.btEncodeClick(Sender: TObject);
begin
  if rbBase64.Checked then begin
    EditEncoded.Text := Base641.EncodeString(EditCodeSource.Text);
    EditDecoded.Text := Base641.DecodeString(EditEncoded.Text);
  end;
end;

procedure TForm1.btDecodeClick(Sender: TObject);
begin
  if rbBase64.Checked then begin
    EditDecoded.Text := Base641.DecodeString(EditEncoded.Text);
  end;
end;

// logging

procedure TForm1.AfterCalcDigest(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterCalcDigest');
end;

procedure TForm1.BeforeCalcDigest(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeCalcDigest');
end;

procedure TForm1.RSA1AfterSign(Sender: TObject; Data: Pointer; DataSize: Cardinal);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterSign');
end;

procedure TForm1.RSA1AfterVerify(Sender: TObject; Data: Pointer;
  DataSize: Cardinal; SignData: Pointer; SignSize: Cardinal);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterVerify');
end;

procedure TForm1.RSA1BeforeSign(Sender: TObject; Data: Pointer; DataSize: Cardinal);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': beforeSign');
end;

procedure TForm1.RSA1BeforeVerify(Sender: TObject; Data: Pointer;
  DataSize: Cardinal; SignData: Pointer; SignSize: Cardinal);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeVerify');
end;

procedure TForm1.Base641AfterDecode(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterDecode');
end;

procedure TForm1.Base641AfterEncode(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': AfterEncode');
end;

procedure TForm1.Base641BeforeDecode(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeDecode');
end;

procedure TForm1.Base641BeforeEncode(Sender: TObject);
var s: string;
begin
  s := Copy(TComponent(Sender).Name, 1, Length(TComponent(Sender).Name)-1);
  MemoLog.Lines.Add(s + ': BeforeEncode');
end;

procedure TForm1.AS_RandomGenerator1AfterGenRandom(Sender: TObject; rnd: GiantInt);
begin
  Status[0] := Format('Generating RSA key...  (%f sec elapsed)', [(Now - FStartMoment) * 24 * 3600]);
end;

end.