{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Author: Angus Robertson, Magenta Systems Ltd Description: ICS SSL Json Object Signing (Jose) Demos Creation: Apr 2018 Updated: Mar 2026 Version: V9.6 EMail: francois.piette@overbyte.be http://www.overbyte.be Support: https://en.delphipraxis.net/forum/37-ics-internet-component-suite/ Legal issues: Copyright (C) 1997-2026 by François PIETTE Rue de Grady 24, 4053 Embourg, Belgium. This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented, you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. 4. You must register this software by sending a picture postcard to the author. Use a nice stamp and mention your name, street address, EMail address and any comment you like to say. History: 25 Apr 2018 - 8.54 baseline 04 May 2020 - 8.64 Corrected jose-ras files to jose-rsa and rsapsss to rsapss. Added new Json/XML tab that allows blocks of Json or XML to be copy/pasted and parsed to objects in a grid, repeatedly. Also pretty prints Json, all to help Json debugging. 18 Nov 2020 - 8.65 Split Jose and transcoding tests to separate tabs. Using INI file to keep settings. Added testing of JWK to public and private key for servers, reads and writes JWKs. Added testing of JWS/JWT verification for servers. Allow clicking on Json array line to display only that record. Feb 23 2021 V8.66 Renamed all OpenSSL functions to original names removing ICS f_ prefix. Added support for YuOpenSSL which provides OpenSSL in a pre-built DCU linked into applications, rather than using external DLLs. Sep 27 2021 V8.67 Log OpenSSL version, support OpenSSL 3.0. Replaced EVP_PKEY_cmp with TX509Base method. Added PKey Parameters button to show private key parameters using new OpenSSL 3.0 APIs. Oct 07 2021 V8.68 Support OpenSSL 3.0 for YuOpenSSL. Aug 08, 2023 V9.0 Updated version to major release 9. Jan 28, 2024 V9.1 Added OverbyteIcsSslBase which now includes TSslContext,TX509Base and TX509List. Added tests for TBytes versions of various hash and base64 functions, better to use TBytes version instead of AnsiString for binary data. Fixed a bug creating a new private key sometimes failed. Oct 11, 2024 V9.4 'Sign/Verify Data' now supports hashes other than SHA-256, selected from the Key and Signing Hash Algorithm drop down list. Also, a private key matching that selection is created automatically, including X25519. Beware changing the algorithm clears the last private key, so select this first, before loading your own private key. Updated Base64 encoding functions to IcsBase64 functions. Sep 08, 2025 V9.5 Hex decodes uses IcsHexToTB, then recodes to hex. Added encryption and decryption samples from PemTools, easier to use and debug without any Windows dialogs. Use RSA private key and Blowfish-cbc encryption, pending adding AES types. 'RSA Encrypt Private Key' takes a PEM file loaded with 'Load Key File' with an RSA key or just creates a new key, encrypts and decrypts. 'Encrypt Text With Password' encrypts a string with Blowfish-cbc with the password 'password' and decrypts again. 'Encrypt Stream With PW' is similar, but uses a stream to illustrate how to handle large volumes of data. Pending using AES. Added 'Sign ECDSA IEEE Digest' tick box for Sign/Verify Data which causes EC key signing to output a shorter IEEE P1363 digest that many applications expect instead of the longer ASN.1 digest OpenSSL generates. Applies to all functions that sign and verify using Elliptic Curve keys. Mar 24, 2026 V9.6 Updated to use more private key types, specifically Post Quantum ML-DSA. Generating private keys now shows the DER binary size and raw key sizes for some types of key. 'Sign/Verify Data' now checks the private key matches the signing algorithm specified, and if not creates a new matching key. Added tests for TIcsSymCrypto component, to encrypt and decrypt strings and streams with most of the ciphers supported by OpenSSL, AES, etc. Added buttons to test IcsJoseStrEncPKey and IcsJoseStrDecPKey, using public and private RSA keys, maybe other key types as well. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} unit OverbyteIcsJoseTst1; {$IF CompilerVersion < 15} {$MESSAGE FATAL 'This demo requires at least Delphi 7 or better'}; {$IFEND} {$B-} { Enable partial boolean evaluation } {$T-} { Untyped pointers } {$X+} { Enable extended syntax } {$H+} { Use long strings } {$J+} { Allow typed constant to be modified } { If you use Delphi 7, you may wants to disable warnings for unsage type, } { unsafe code and unsafe typecast in the project options. Those warning are } { intended for .NET programs. You may also want to turn off deprecated } { symbol and platform symbol warnings. } {$I Include\OverbyteIcsDefs.inc} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TypInfo, ComCtrls, ExtCtrls, Buttons, OverbyteIcsWSocket, OverbyteIcsUtils, OverbyteIcsMimeUtils, OverbyteIcsURL, OverbyteIcsSha1, OverbyteIcsSSLEAY, OverbyteIcsLibeay, OverbyteIcsSslX509Utils, { V8.65 } OverbyteIcsTypes, { V8.64 } OverbyteIcsSuperObject, OverbyteIcsSuperXMLParser, { V8.64 } OverbyteIcsIniFiles, OverbyteIcsSslJose, OverbyteIcsSslBase { V9.1 TSslContext, TX509Bas, TX509List } {$IFDEF YuOpenSSL}, YuOpenSSL{$ENDIF YuOpenSSL}; { V9.6 } type TJsonDemoForm = class(TForm) // saved items Base64Text: TEdit; CodeTextLines: TMemo; CompactXML: TCheckBox; HexText: TEdit; JoseTextLines: TMemo; JsonInput: TMemo; JwkPrivate: TCheckBox; LogJson: TCheckBox; RawJWK: TMemo; ShowRawKey: TCheckBox; TestHmacKey: TEdit; TestPrivKeyFile: TComboBox; URLText: TEdit; SignECDSAIEEE: TCheckBox; CipherName: TEdit; CipherPwSalt: TEdit; CipherRawKey: TEdit; CipherRawIV: TEdit; CipherPassword: TEdit; EncKeyType: TRadioGroup; CipherBFBits: TRadioGroup; CipherFileName: TEdit; CipherAEAD: TEdit; CipherRandomSalt: TCheckBox; // not saved LogWin: TMemo; OpenDlg: TOpenDialog; PageControl: TPageControl; TabSheetJson: TTabSheet; JsonGrid: TListView; PanelButtons: TPanel; Label33: TLabel; doParseJson: TButton; doLoadFile: TButton; doParseXML: TButton; TabSheetJose: TTabSheet; Label25: TLabel; Label26: TLabel; Label27: TLabel; Label1: TLabel; doTestSign: TButton; doJWSCreate: TButton; doSignHmac: TButton; TabSheet1: TTabSheet; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; doBase64Enc: TButton; doB64URLEn: TButton; doTestUrlEnc: TButton; doHexEncode: TButton; doEncodeURL: TButton; doBase64Dec: TButton; doB64URLDec: TButton; doHashDigest: TButton; doHexDec: TButton; doDecodeURL: TButton; Label4: TLabel; doJWKCreate: TButton; Label2: TLabel; doJKWRead: TButton; doNewPrivKey: TButton; doClear: TButton; SelFile: TBitBtn; LabelPKey: TLabel; doJWSRead: TButton; doLoadKeyFile: TButton; doKeyParams: TButton; NewprivKey: TListBox; TestJWSAlg: TListBox; Label5: TLabel; TabSheetCrypto: TTabSheet; doEncryprPWText: TButton; doEncryptPkeyNew: TButton; doEncryprPWFile: TButton; doEncryptPkeyExt: TButton; ListCiphers: TListBox; Label3: TLabel; CryptTextIn: TMemo; Label10: TLabel; LabelCipher: TLabel; Label11: TLabel; Label12: TLabel; doCheckCrypt: TButton; doEncryptText: TButton; doDecryptText: TButton; CryptTextOut: TMemo; Label13: TLabel; Label14: TLabel; Label15: TLabel; CipherICsTypes: TListBox; Label16: TLabel; Label17: TLabel; Label18: TLabel; Label19: TLabel; SelCiphFile: TBitBtn; Label20: TLabel; doQuickEncrypt: TButton; doEncryptStream: TButton; doEncryptFile: TButton; Label21: TLabel; procedure doBase64DecClick(Sender: TObject); procedure doBase64EncClick(Sender: TObject); procedure doB64URLEnClick(Sender: TObject); procedure doB64URLDecClick(Sender: TObject); procedure doTestUrlEncClick(Sender: TObject); procedure doHexDecClick(Sender: TObject); procedure doHexEncodeClick(Sender: TObject); procedure doEncodeURLClick(Sender: TObject); procedure doDecodeURLClick(Sender: TObject); procedure doSignHmacClick(Sender: TObject); procedure doTestSignClick(Sender: TObject); procedure doJWSCreateClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure doHashDigestClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure JoseTextLinesDblClick(Sender: TObject); procedure doParseClick(Sender: TObject); procedure doLoadFileClick(Sender: TObject); procedure JsonGridDblClick(Sender: TObject); procedure CodeTextLinesDblClick(Sender: TObject); procedure doJWKCreateClick(Sender: TObject); procedure doNewPrivKeyClick(Sender: TObject); procedure SelFileClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure TestPrivKeyFileChange(Sender: TObject); procedure doJKWReadClick(Sender: TObject); procedure doClearClick(Sender: TObject); procedure doJWSReadClick(Sender: TObject); procedure doLoadKeyFileClick(Sender: TObject); procedure doKeyParamsClick(Sender: TObject); procedure TestJWSAlgoldChange(Sender: TObject); procedure doEncryptPkeyClick(Sender: TObject); procedure doEncryprPWTextClick(Sender: TObject); procedure doEncryprPWFileClick(Sender: TObject); procedure NewprivKeyClick(Sender: TObject); // procedure doEncryptPkeyClick(Sender: TObject); procedure doEncryptPkeyExtClick(Sender: TObject); procedure ListCiphersClick(Sender: TObject); procedure doCheckCryptClick(Sender: TObject); procedure doEncryptTextClick(Sender: TObject); procedure doDecryptTextClick(Sender: TObject); procedure CipherNameClick(Sender: TObject); procedure CipherICsTypesClick(Sender: TObject); procedure SelCiphFileClick(Sender: TObject); procedure doQuickEncryptClick(Sender: TObject); procedure doEncryptStreamClick(Sender: TObject); procedure doEncryptFileClick(Sender: TObject); procedure CipherBFBitsClick(Sender: TObject); private { Private declarations } public { Public declarations } FPrivateKey: TSslCertTools; FVerifyPKey: TX509Base; procedure AddLog (const S: string) ; function LoadPKeyFile(fname: string): boolean; procedure GetCiphers; procedure ReportCipherInfo; end; var JsonDemoForm: TJsonDemoForm; // FProgDir: String; FIniFileName: String; FInitialized: Boolean; JArrayTot: Integer; { V8.65 } JArrayItems: Array of String; { V8.65 } PkeyfromFile: Boolean = False; { V9.4 } IcsSymCrypto: TIcsSymCrypto; { V9.6 new Jose symmetrical encryption component } const SectionMainWindow = 'MainWindow'; KeyTop = 'Top'; KeyLeft = 'Left'; KeyWidth = 'Width'; KeyHeight = 'Height'; SectionData = 'Data'; implementation {$R *.dfm} Uses OverbyteIcsJoseTst2; procedure TJsonDemoForm.FormCreate(Sender: TObject); var // I: Integer; FProgDir: String; KT: TSslPrivKeyType; Alg: TJoseAlg; Ciph: TEvpCipher; begin FProgDir := ExtractFilePath(ParamStr(0)); FIniFileName := GetIcsIniFileName; // V9.6 ignore OpenSSL 4 and use OpenSSL 3, only if resource files not used // GSSLEAY_DLL_IgnoreNew := True; GSSL_DLL_DIR := FProgDir; { only from our directory } GSSL_SignTest_Check := True; { check digitally signed } GSSL_SignTest_Certificate := True; { check digital certificate } GSSLEAY_LOAD_LEGACY := True; { V8.67 OpenSSL 3.0 legacy provider for old algorithms } IcsSslRootCAStore.Initialise; { V9.1 if internal not loaded, do it } LibeayLoadProviders(True, False); { V9.1 need legacy provider } FPrivateKey := TSslCertTools.Create(self); FVerifyPKey := TX509Base.Create(self); NewPrivKey.Items.Clear; CipherICsTypes.Items.Clear; for KT := Low(TSslPrivKeyType) to High(TSslPrivKeyType) do NewPrivKey.Items.Add(SslPrivKeyTypeLits[KT]); // V9.6 for Alg := Low(TJoseAlg) to High(TJoseAlg) do TestJWSAlg.Items.Add(JoseAlgDescLits[Alg]); // V9.6 for Ciph := Low(TEvpCipher) to High(TEvpCipher) do CipherICsTypes.Items.Add(GetEnumName(TypeInfo(TEvpCipher), Ord(Ciph))); // V9.6 IcsSymCrypto := TIcsSymCrypto.Create; { V9.6 new Jose symmetrical encryption component } GetCiphers; { V9.6 get all cipher names } end; procedure TJsonDemoForm.FormDestroy(Sender: TObject); var IniFile : TIcsIniFile; temp, section: String; begin IniFile := TIcsIniFile.Create(FIniFileName); IniFile.WriteInteger(SectionMainWindow, KeyTop, Top); IniFile.WriteInteger(SectionMainWindow, KeyLeft, Left); IniFile.WriteInteger(SectionMainWindow, KeyWidth, Width); IniFile.WriteInteger(SectionMainWindow, KeyHeight, Height); with IniFile do begin section := SectionData; WriteString (section, 'Base64Text_Text', Base64Text.Text) ; WriteString (section, 'CodeTextLines_Lines', CodeTextLines.Lines.CommaText) ; if CompactXML.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'CompactXML_Checked', temp) ; WriteString (section, 'HexText_Text', HexText.Text) ; WriteString (section, 'JoseTextLines_Lines', JoseTextLines.Lines.CommaText) ; WriteString (section, 'JsonInput_Lines', JsonInput.Lines.CommaText) ; if JwkPrivate.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'JwkPrivate_Checked', temp) ; if LogJson.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'LogJson_Checked', temp) ; WriteInteger (section, 'NewPrivKey_ItemIndex', NewPrivKey.ItemIndex) ; WriteString (section, 'RawJWK_Lines', RawJWK.Lines.CommaText) ; if ShowRawKey.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'ShowRawKey_Checked', temp) ; WriteString (section, 'TestHmacKey_Text', TestHmacKey.Text) ; WriteInteger (section, 'TestJWSAlg_ItemIndex', TestJWSAlg.ItemIndex) ; WriteString (section, 'TestPrivKeyFile_Text', TestPrivKeyFile.Text) ; WriteString (section, 'URLText_Text', URLText.Text) ; if SignECDSAIEEE.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'SignECDSAIEEE_Checked', temp) ; { V9.5 } WriteString (section, 'CipherName_Text', CipherName.Text) ; { following V9.6 } WriteString (section, 'CipherPwSalt_Text', CipherPwSalt.Text) ; WriteString (section, 'CipherRawKey_Text', CipherRawKey.Text) ; WriteString (section, 'CipherRawIV_Text', CipherRawIV.Text) ; WriteString (section, 'CipherPassword_Text', CipherPassword.Text) ; WriteInteger (section, 'EncKeyType_ItemIndex', EncKeyType.ItemIndex) ; WriteString (section, 'CipherFileName_Text', CipherFileName.Text) ; WriteString (section, 'CipherAEAD_Text', CipherAEAD.Text) ; WriteInteger (section, 'CipherRandomSalt_State', Ord (CipherRandomSalt.State)) ; if CipherRandomSalt.Checked then temp := 'True' else temp := 'False' ; WriteString (section, 'CipherRandomSalt_Checked', temp) ; end; IniFile.UpdateFile; IniFile.Free; FPrivateKey.Free; FVerifyPKey.Free; IcsSymCrypto.Free; { V9.6 } end; procedure TJsonDemoForm.FormShow(Sender: TObject); var IniFile: TIcsIniFile; section: String; begin if not FInitialized then begin FInitialized := TRUE; IniFile := TIcsIniFile.Create(FIniFileName); Width := IniFile.ReadInteger(SectionMainWindow, KeyWidth, Width); Height := IniFile.ReadInteger(SectionMainWindow, KeyHeight, Height); Top := IniFile.ReadInteger(SectionMainWindow, KeyTop, (Screen.Height - Height) div 2); Left := IniFile.ReadInteger(SectionMainWindow, KeyLeft, (Screen.Width - Width) div 2); with IniFile do begin section := SectionData; Base64Text.Text := ReadString (section, 'Base64Text_Text', Base64Text.Text) ; CodeTextLines.Lines.CommaText := ReadString (section, 'CodeTextLines_Lines', CodeTextLines.Lines.CommaText) ; if ReadString (section, 'CompactXML_Checked', 'False') = 'True' then CompactXML.Checked := true else CompactXML.Checked := false ; HexText.Text := ReadString (section, 'HexText_Text', HexText.Text) ; JoseTextLines.Lines.CommaText := ReadString (section, 'JoseTextLines_Lines', JoseTextLines.Lines.CommaText) ; JsonInput.Lines.CommaText := ReadString (section, 'JsonInput_Lines', JsonInput.Lines.CommaText) ; if ReadString (section, 'LogJson_Checked', 'False') = 'True' then LogJson.Checked := true else LogJson.Checked := false ; if ReadString (section, 'JwkPrivate_Checked', 'False') = 'True' then JwkPrivate.Checked := true else JwkPrivate.Checked := false ; NewPrivKey.ItemIndex := ReadInteger (section, 'NewPrivKey_ItemIndex', 0) ; RawJWK.Lines.CommaText := ReadString (section, 'RawJWK_Lines', '') ; if ReadString (section, 'ShowRawKey_Checked', 'False') = 'True' then ShowRawKey.Checked := true else ShowRawKey.Checked := false ; TestHmacKey.Text := ReadString (section, 'TestHmacKey_Text', TestHmacKey.Text) ; TestJWSAlg.ItemIndex := ReadInteger (section, 'TestJWSAlg_ItemIndex', 0) ; TestPrivKeyFile.Text := ReadString (section, 'TestPrivKeyFile_Text', TestPrivKeyFile.Text) ; URLText.Text := ReadString (section, 'URLText_Text', URLText.Text) ; if ReadString (section, 'SignECDSAIEEE_Checked', 'False') = 'True' then SignECDSAIEEE.Checked := true else SignECDSAIEEE.Checked := false ; { V9.5 } CipherName.Text := ReadString (section, 'CipherName_Text', CipherName.Text) ; { following V9.6 } CipherPwSalt.Text := ReadString (section, 'CipherPwSalt_Text', CipherPwSalt.Text) ; CipherRawKey.Text := ReadString (section, 'CipherRawKey_Text', CipherRawKey.Text) ; CipherRawIV.Text := ReadString (section, 'CipherRawIV_Text', CipherRawIV.Text) ; CipherPassword.Text := ReadString (section, 'CipherPassword_Text', CipherPassword.Text) ; EncKeyType.ItemIndex := ReadInteger (section, 'EncKeyType_ItemIndex', EncKeyType.ItemIndex) ; CipherFileName.Text := ReadString (section, 'CipherFileName_Text', CipherFileName.Text) ; CipherAEAD.Text := ReadString (section, 'CipherAEAD_Text', CipherAEAD.Text) ; if ReadString (section, 'CipherRandomSalt_Checked', 'False') = 'True' then CipherRandomSalt.Checked := true else CipherRandomSalt.Checked := false ; end; IniFile.Free; end; LogWin.Lines.Add('SSL/TLS ' + IcsReportOpenSSLVer(True)); { V9.1 simplify } LogWin.Lines.Add('Built With ' + IcsBuiltWithEx); { V8.70 } end; procedure TJsonDemoForm.AddLog (const S: string) ; begin if Pos (IcsLF, S) > 0 then LogWin.Lines.Text := LogWin.Lines.Text + S + IcsCRLF else LogWin.Lines.Add (S) ; end; procedure TJsonDemoForm.doClearClick(Sender: TObject); begin LogWin.Lines.Clear; end; function TJsonDemoForm.LoadPKeyFile(fname: string): boolean; begin Result := False; if NOT FileExists (fname) then begin AddLog ('Can not find private key: ' + fname); Exit ; end; try FPrivateKey.ClearAll; LabelPKey.Caption := 'Private Key: '; FPrivateKey.PrivateKeyLoadFromPemFile (fname, '') ; except on E:Exception do begin AddLog ('Failed to load private key file: ' + fname + ' - ' + E.Message); Exit ; end; end; if NOT FPrivateKey.IsPKeyLoaded then begin AddLog ('Failed to load private key: ' + fname); Exit ; end; AddLog('Loaded private key file OK: ' + fname + ' - ' + FPrivateKey.PrivateKeyInfo); LabelPKey.Caption := 'Private Key: ' + FPrivateKey.PrivateKeyInfo; PkeyfromFile := True; { V9.4 } Result := True; end; procedure TJsonDemoForm.NewprivKeyClick(Sender: TObject); { V9.6 clear key when type changed } begin FPrivateKey.ClearAll; LabelPKey.Caption := 'Private Key: '; end; procedure TJsonDemoForm.doNewPrivKeyClick(Sender: TObject); var PkeyB64: String; DerPkeyTB, RawPrivTB, RawPubTB: TBytes; begin PkeyfromFile := False; { V9.4 } doNewPrivKey.Enabled := false; try try FPrivateKey.ClearAll; FPrivateKey.PrivKeyType := TSslPrivKeyType(NewPrivKey.ItemIndex); { V9.1 after clearing key } LabelPKey.Caption := 'Private Key: '; AddLog('Generating private and public key pair, please wait: ' + NewPrivKey.Items[NewPrivKey.ItemIndex]); FPrivateKey.DoKeyPair; PKeyB64 := FPrivateKey.SavePKeyToText; { V9.6 get DER key so we can report length } DerPKeyTB := IcsBase64UrlDecodeTB(PKeyB64); RawPrivTB := IcsEvpGetParamTB(FPrivateKey.PrivateKey, OSSL_PKEY_PARAM_PRIV_KEY); RawPubTB := IcsEvpGetParamTB(FPrivateKey.PrivateKey, OSSL_PKEY_PARAM_PUB_KEY); AddLog('Generated private and public key pair OK: ' + FPrivateKey.PrivateKeyInfo); AddLog('Private Key Can Sign Messages: ' + IcsGetTrueFalse(IcsPKeyCanSign(FPrivateKey.PrivateKey))); { V9.6 } AddLog('TSslPrivKeyType: ' + SslPrivKeyTypeLits[IcsGetPkeyType(fPrivateKey.PrivateKey)]); { V9.6 } AddLog('Lengths: DER: ' + IntToStr(Length(DerPkeyTB)) + ', Raw Private Key: ' + IntToStr(Length(RawPrivTB)) + ', Raw Public Key: ' + IntToStr(Length(RawPubTB)) ); { V9.6 } if ShowRawKey.Checked then AddLog(FPrivateKey.GetPKeyRawText(False)); { V9.6 show raw key } AddLog(''); LabelPKey.Caption := 'Private Key: ' + FPrivateKey.PrivateKeyInfo; doJWKCreate.Enabled := True; except on E:Exception do AddLog(E.Message); end; finally doNewPrivKey.Enabled := true; end; end; procedure TJsonDemoForm.doLoadKeyFileClick(Sender: TObject); begin if LoadPKeyFile (TestPrivKeyFile.Text) then doJWKCreate.Enabled := True; end; procedure TJsonDemoForm.SelFileClick(Sender: TObject); begin OpenDlg.InitialDir := ExtractFilePath(TestPrivKeyFile.Text); OpenDlg.FileName := TestPrivKeyFile.Text; if OpenDlg.FileName = '' then Exit; if OpenDlg.Execute then begin TestPrivKeyFile.Text := OpenDlg.FileName; FPrivateKey.ClearAll ; end; end; procedure TJsonDemoForm.TestPrivKeyFileChange(Sender: TObject); begin if NOT PkeyfromFile then { V9.4 } FPrivateKey.ClearAll ; end; procedure TJsonDemoForm.JoseTextLinesDblClick(Sender: TObject); begin JoseTextLines.Lines.Clear; end; procedure TJsonDemoForm.doEncodeURLClick(Sender: TObject); begin AddLog (URLEncode(trim(CodeTextLines.Lines.Text))); end; procedure TJsonDemoForm.doHashDigestClick(Sender: TObject); var AnsiData, Digest: AnsiString; DataTB, DigestTB: TBytes; { V9.1 } Sha1Digest: SHA1DigestString; begin try AnsiData := AnsiString(Trim(CodeTextLines.Lines.Text)); DataTB := IcsStringToTBytes(Trim(CodeTextLines.Lines.Text)); Sha1Digest := SHA1ofStr(AnsiData); AddLog ('SHA1ofStr (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Sha1Digest)); Digest := IcsHashDigest(AnsiData, Digest_sha1); AddLog ('IcsHashDigest Sha1 (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Digest)); Digest := IcsHashDigest(AnsiData, Digest_sha256); AddLog ('IcsHashDigest Sha256 (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Digest)); AddLog ('IcsHashDigest Sha256 Base4Url: ' + IcsBase64UrlEncode (String(Digest))); DigestTB := IcsHashDigestTB(DataTB, Digest_sha512); AddLog ('IcsHashDigestTB Sha512 (len ' + IntToStr(Length(DigestTB)) + ') Hex: ' + IcsTBToHex(DigestTB)); AddLog ('IcsHashDigestTB Sha512 Base4Url: ' + IcsBase64UrlEncodeTB (DigestTB)); Digest := IcsHashDigest(AnsiData, Digest_sha3_256); AddLog ('IcsHashDigest Sha3-256 (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Digest)); AddLog ('IcsHashDigest Sha3-256 Base4Url: ' + IcsBase64UrlEncode (String(Digest))); DigestTB := IcsHashDigestTB(DataTB, Digest_sha3_512); AddLog ('IcsHashDigestTB Sha3-512 (len ' + IntToStr(Length(DigestTB)) + ') Hex: ' + IcsTBToHex(DigestTB)); AddLog ('IcsHashDigestTB Sha3-512 Base4Url: ' + IcsBase64UrlEncodeTB(DigestTB)); Digest := IcsHashDigest(AnsiData, Digest_shake128); AddLog ('IcsHashDigest Shake128 (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Digest)); AddLog ('IcsHashDigest Shake128 Base4Url: ' + IcsBase64UrlEncode (String(Digest))); Digest := IcsHashDigest(AnsiData, Digest_shake256); AddLog ('IcsHashDigest Shake256 (len ' + IntToStr(Length(Digest)) + ') Hex: ' + IcsBufferToHex(Digest)); AddLog ('IcsHashDigest Shake256 Base4Url: ' + IcsBase64UrlEncode (String(Digest))); // Digest := IcsHashDigest(AnsiData, Digest_None); // should raise exception except on E:Exception do AddLog ('Hash digest exception - ' + E.Message); end; AddLog (''); end; procedure TJsonDemoForm.doHexDecClick(Sender: TObject); var Bin: TBytes; begin // AddLog (String(IcsHexToBin(AnsiString(Trim(HexText.Text))))); Bin := IcsHexToTB(AnsiString(Trim(HexText.Text))); AddLog('IcsHexToTB Decoded, and Encoded again: ' + IcsTBtoHex(Bin)); AddLog (''); end; procedure TJsonDemoForm.doHexEncodeClick(Sender: TObject); begin AddLog (IcsLowerCase(IcsBufferToHex(AnsiString(Trim(CodeTextLines.Lines.Text))))); AddLog (''); end; procedure TJsonDemoForm.doTestUrlEncClick(Sender: TObject); var Data, Decoded, Encoded: String; EncodedA: AnsiString; begin Data := Trim(CodeTextLines.Lines.Text); AddLog ('Data: ' + Data); EncodedA := IcsBase64EncodeA(AnsiString(Data)); Base64Text.Text := String(EncodedA); AddLog ('IcsBase64Encode: ' + String(EncodedA)) ; Encoded := IcsBase64UrlEncode(Data); AddLog ('IcsBase64UrlEncode: ' + Encoded) ; Decoded := IcsBase64UrlDecode(Encoded); AddLog ('IcsBase64UrlDecode: ' + Decoded) ; if Decoded <> Data then AddLog ('Encode/Decode Failed Comparison, InLen=' + IntToStr(Length(Data)) + ', DecLen=' + IntToStr(Length(Decoded)) ) ; AddLog (''); end; procedure TJsonDemoForm.doB64URLEnClick(Sender: TObject); begin AddLog (IcsBase64UrlEncode(Trim(CodeTextLines.Lines.Text))) ; AddLog (''); end; procedure TJsonDemoForm.CodeTextLinesDblClick(Sender: TObject); begin CodeTextLines.Lines.Clear; end; procedure TJsonDemoForm.doB64URLDecClick(Sender: TObject); begin AddLog (IcsBase64UrlDecode(Trim(Base64Text.Text))) ; AddLog (''); end; procedure TJsonDemoForm.doDecodeURLClick(Sender: TObject); begin AddLog (URLDecode(trim(CodeTextLines.Lines.Text))); AddLog (''); end; procedure TJsonDemoForm.doBase64DecClick(Sender: TObject); var ADecode: AnsiString; begin ADecode := IcsBase64Decode(Trim(Base64Text.Text)); AddLog ('Base64: ' + String(ADecode)) ; AddLog ('Base64(hex): ' + IcsBufferToHex(ADecode)) ; AddLog (''); end; procedure TJsonDemoForm.doBase64EncClick(Sender: TObject); var Data, Encoded, ADecode: AnsiString; DataTB, DecTB: TBytes; begin // Encoded := Base64EncodeA(Trim(CodeTextLines.Lines.Text)); // AddLog ('Encode OldBase64: ' + Encoded) ; // Decoded := Base64Decode(Encoded); // AddLog ('Decode OldBase64: ' + Decoded) ; Data := AnsiString(Trim(CodeTextLines.Lines.Text)); Encoded := IcsBase64EncodeA(Data); Base64Text.Text := String(Encoded); AddLog ('Base64: ' + String(Encoded)) ; ADecode := IcsBase64DecodeA(Encoded); AddLog ('Decode Base64: ' + String(ADecode)) ; if ADecode <> Data then AddLog ('Encode/Decode Failed Comparison, InLen=' + IntToStr(Length(Data)) + ', DecLen=' + IntToStr(Length(ADecode)) ) ; AddLog (''); // repeat with TBytes functions DataTB := IcsStringAToTBytes(Data); Encoded := IcsBase64EncodeTB(DataTB); AddLog ('Base64TB: ' + String(Encoded)) ; DecTB := IcsBase64DecodeTB(Encoded); AddLog ('Decode Base64TB: ' + IcsTBytesToString(DecTB)) ; if NOT IcsTBytesCompare(DecTB, DataTB) then AddLog ('Encode/DecodeTB Failed Comparison, InLen=' + IntToStr(Length(Data)) + ', DecLen=' + IntToStr(Length(DecTB)) ) ; AddLog (''); end; procedure TJsonDemoForm.doSignHmacClick(Sender: TObject); var AnsiData, AnsiSecret, Digest: AnsiString; DataTB, SecretTB, DigestTB: TBytes; { V9.1 } S: String; Flag: Boolean; begin AddLog ('Testing Various HMAC Digests with Different SHA keys'); AnsiData := AnsiString(Trim(JoseTextLines.Lines.Text)); AnsiSecret := AnsiString(TestHmacKey.Text); DataTB := IcsStringToTBytes(Trim(JoseTextLines.Lines.Text)); { V9.1 testing TBBytes versions } SecretTB := IcsStringToTBytes(TestHmacKey.Text); AddLog ('Test Data: ' + String(AnsiData) + ', HMAC Key: ' + String(AnsiSecret)); try Digest := HMAC_SHA1_EX(AnsiData, AnsiSecret); AddLog ('HMAC_SHA1_EX (len ' + IntToStr(Length(Digest)) + ') Base64: ' + String(IcsBase64EncodeA (Digest))); Digest := IcsHMACDigest(AnsiData, AnsiSecret, Digest_sha1); AddLog ('IcsHMACDigest Sha1 (len ' + IntToStr(Length(Digest)) +') Base64: ' + String(IcsBase64EncodeA (Digest))); Digest := IcsHMACDigest(AnsiData, AnsiSecret, Digest_sha256); AddLog ('IcsHMACDigest Sha256 (len ' + IntToStr(Length(Digest)) + ') Base64: ' + String(IcsBase64EncodeA (Digest))); DigestTB := IcsHMACDigestTB(DataTB, SecretTB, Digest_sha512); { V9.1 testing TBBytes versions } AddLog ('IcsHMACDigestTB Sha512 (len ' + IntToStr(Length(DigestTB)) + ') Base64: ' + String(IcsBase64EncodeTB (DigestTB))); Digest := IcsHMACDigestEx(AnsiData, AnsiSecret, Digest_sha1); AddLog ('IcsHMACDigestEx Sha1 (len ' + IntToStr(Length(Digest)) + ') Base64: ' + String(IcsBase64EncodeA (Digest))); DigestTB := IcsHMACDigestExTB(DataTB, SecretTB, Digest_sha256); { V9.1 testing TBBytes versions } AddLog ('IcsHMACDigestExTB Sha256 (len ' + IntToStr(Length(Digest)) + ') Base64: ' + String(IcsBase64EncodeTB (DigestTB))); Digest := IcsHMACDigestEx(AnsiData, AnsiSecret, Digest_sha512); AddLog ('IcsHMACDigestEx Sha512 (len ' + IntToStr(Length(Digest)) + ') Base64: ' + String(IcsBase64EncodeA (Digest))); Flag := IcsHMACDigestVerify(AnsiData, AnsiSecret, Digest, Digest_sha512); S := 'Failed Verify'; if Flag then S := 'Passed Verify'; AddLog ('IcsHMACDigestVerify (len ' + IntToStr(Length(Digest)) + ') Sha512: ' + S); except on E:Exception do AddLog ('Hash digest exception - ' + E.Message); end; AddLog (''); end; procedure TJsonDemoForm.TestJWSAlgoldChange(Sender: TObject); { V9.4 clear private key ready for new key } begin FPrivateKey.ClearAll; LabelPKey.Caption := 'Private Key: '; end; procedure TJsonDemoForm.doTestSignClick(Sender: TObject); var DataTB, SigTB: TBytes; { V9.1 } // SigIEEETB, Sig2TB: TBytes; { V9.5 } PublicKeyStr, S, SignPKeyName: String; Flag: Boolean; JoseAlg: TJoseAlg; SignDigest: TEvpDigest; SignPkeyType: TSslPrivKeyType; { V9.6 } begin DataTB := IcsStringToTBytes(Trim(JoseTextLines.Lines.Text)); if TestJWSAlg.ItemIndex <= 0 then begin AddLog ('Need to select Key and Signing Hash Algorithm, First'); Exit; end; if TestJWSAlg.ItemIndex > Ord(High(TJoseAlg)) then begin { V9.6 } AddLog ('Unknown Key and Signing Hash Algorithm'); Exit; end; JoseAlg := TJoseAlg(TestJWSAlg.ItemIndex); { V9.4 allow digests other then sha256 } if JoseAlg < jsigRsa256 then begin { V9.6 } AddLog ('Asymmetic MAC Hash Needs Private Key Hash Algorithm'); Exit; end; SignDigest := IcsJoseFindHash(JoseAlg); try // check if loaded private key matches algo if Assigned(FPrivateKey.PrivateKey) then begin SignPkeyType := IcsGetPkeyType(FPrivateKey.PrivateKey); { V9.6 ICS TSslPrivKeyType } SignPKeyName := String(SslPKeyTypNames[SignPkeyType]); { V9.6 ASCII name } if (SignPkeyType > PrivKeyNone) and (SignPkeyType <> JoseAlgPribvKeyTypes[JoseAlg]) then begin AddLog('Old private key does not match signing Hash, cleared: ' + SignPKeyName); SignPkeyType := PrivKeyNone; end end else SignPkeyType := PrivKeyNone; if (SignPkeyType = PrivKeyNone) then begin FPrivateKey.ClearAll; SignPkeyType := JoseAlgPribvKeyTypes[JoseAlg]; { V9.6 table to find pkey type for algo } SignPKeyName := String(SslPKeyTypNames[SignPkeyType]); { V9.6 ASCII name } FPrivateKey.PrivKeyType := SignPkeyType; LabelPKey.Caption := 'Private Key: '; AddLog('Generating private and public key pair according to Signing Hash, please wait'); FPrivateKey.DoKeyPair; AddLog('Generated private and public key pair OK: ' + FPrivateKey.PrivateKeyInfo); LabelPKey.Caption := 'Private Key: ' + FPrivateKey.PrivateKeyInfo; end; // sign data with private key and asymmetic MAC hash keyed message authentication code AddLog ('Asymmetic MAC Hash Signing: ' + JoseAlgDescLits[JoseAlg] + IcsCRLF + 'Data: ' + JoseTextLines.Lines.Text + IcsCRLF + 'Private Key: ' + fPrivateKey.PrivateKeyInfo + IcsCRLF + 'Digest Type: ' + EvpDigestLits[SignDigest] ); SigTB := IcsAsymSignDigestTB(DataTB, fPrivateKey.PrivateKey, SignDigest, SignECDSAIEEE.Checked); { V9.5 added IEEE } if SignPKeyName = 'EC' then begin { V9.5 tell them } if SignECDSAIEEE.Checked then AddLog ('ECDA Digest IEEE P1363 Format') else AddLog ('ECDA Digest ASN.1 Format'); end; AddLog ('Digest Length (binary): ' + IntToStr(Length(SigTB)) + ' bytes, Expected Lenght: ' + IntToStr(SslPubKeyLen[IcsGetPkeyType(fPrivateKey.PrivateKey)])); { V9.6 expected len } AddLog ('IcsAsymSignDigestTB IcsBase64UrlEncodeTB: ' + IcsBase64UrlEncodeTB (SigTB)); AddLog ('IcsAsymSignDigestTB Hex: ' + IcsLowerCase(IcsTBToHex (SigTB))); // testing ECDSA convert ASN.1 to IEEE P1363, don't use with ignECDSAIEEE.Checked (* if PKeyType = EVP_PKEY_EC then begin SigIEEETB := IcsDigestAsntoIEEE(SigTB); { V9.5 convert ASN.1 to IEEE P1363 } AddLog ('IEEE Digest Length (binary): ' + IntToStr(Length(SigIEEETB )) + ' bytes'); AddLog ('IcsDigestAsntoIEEE( Hex: ' + IcsLowerCase(IcsTBToHex (SigIEEETB))); Sig2TB := IcsDigestIEEEtoAsn(SigIEEETB); AddLog ('Digest Length (binary): ' + IntToStr(Length(Sig2TB)) + ' bytes'); AddLog ('IcsDigestIEEEtoAsn Hex: ' + IcsLowerCase(IcsTBToHex (Sig2TB))); if IcsCompareTBytes(SigTB, Sig2TB) <> 0 then begin AddLog('IcsDigestIEEE Conversion Failed Compare'); Exit; end; end; *) // horrible way to get a public key from a private key, no simple way to do this with TX509Base PublicKeyStr := fPrivateKey.PublicKeySaveToText; FVerifyPKey.PublicKeyLoadFromText(PublicKeyStr); AddLog('Public key: ' + FVerifyPKey.GetKeyDesc(FVerifyPKey.PrivateKey)); // verify data with public key Flag := IcsAsymVerifyDigestTB(DataTB, SigTB, FVerifyPKey.PrivateKey, SignDigest, SignECDSAIEEE.Checked); { V9.5 added IEEE } S := 'Failed Verify'; if Flag then S := 'Passed Verify'; AddLog ('IcsAsymVerifyDigest: ' + S); except on E:Exception do AddLog ('Signing exception - ' + E.Message); end; AddLog (''); end; function B64Url2Hex(const S: String): String; var TempTB: TBytes; begin // Result := IcsLowerCase(IcsBufferToHex(AnsiString(IcsBase64UrlDecode(S)))); TempTB := IcsBase64UrlDecodeTB(S); { V9.4 } Result := LowerCase(IcsTBToHex(TempTB)); { V9.4 } // Result := IcsLowerCase(IcsTBToHex(IcsBase64UrlDecodeTB(S))); { V9.4 } end; // build Json Web Key from private key, get public key from JWK and check it procedure TJsonDemoForm.doJWKCreateClick(Sender: TObject); var JwkPub, Mykid, Myalg, NewSecret, NewKeyid: String; JoseAlg: TJoseAlg; JwkJson: ISuperObject; // PKeyType{, NewKeyType, BaseType}: Integer; begin RawJWK.Lines.Clear; try Mykid := TimeToStr(Now); if TestJWSAlg.ItemIndex <= 0 then begin AddLog ('Need to select Key and Signing Hash Algorithm, First'); Exit; end; AddLog ('Creating Json Web Key using Algorithm:: ' + TestJWSAlg.Items[TestJWSAlg.ItemIndex]); JoseAlg := TJoseAlg(TestJWSAlg.ItemIndex); // PkeyType := IcsJoseFindAlgPkey(JoseAlg); if JoseAlg >= jsigRsa256 then begin if NOT Assigned(FPrivateKey.PrivateKey) then doNewPrivKeyClick(Self); end; // create Json Web Key MyAlg := IcsJoseFindAlg(JoseAlg, FPrivateKey.PrivateKey); if JoseAlg >= jsigRsa256 then begin AddLog ('Private Key: ' + FPrivateKey.PrivateKeyInfo); if ShowRawKey.Checked then AddLog (FPrivateKey.GetPKeyRawText); { V8.64 } JwkPub := IcsJoseJWKPubKey(FPrivateKey.PrivateKey, Myalg, Mykid, JoseLituse_sig, JwkPrivate.Checked); RawJWK.Lines.Text := JwkPub; AddLog ('Ics Jose JWK Pkey Raw: ' + JwkPub); { V8.64 } JwkJson := SO(JwkPub); if JwkJson.S[JoseParamk_kty] = JoseLitkty_RSA then begin AddLog ('Hex N: ' + B64Url2Hex(JwkJson.S[JoseParamkr_n])); AddLog ('Hex E: ' + B64Url2Hex(JwkJson.S[JoseParamkr_e])); if JwkPrivate.Checked then AddLog ('Hex D: ' + B64Url2Hex(JwkJson.S[JoseParamkr_d])); end; if JwkJson.S[JoseParamk_kty] = JoseLitkty_EC then begin AddLog ('Base64 X: ' + JwkJson.S[JoseParamke_x]); AddLog ('Hex X: ' + B64Url2Hex(JwkJson.S[JoseParamke_x])); AddLog ('Hex Y: ' + B64Url2Hex(JwkJson.S[JoseParamke_y])); if JwkPrivate.Checked then AddLog ('Hex D: ' + B64Url2Hex(JwkJson.S[JoseParamke_d])); end; if JwkJson.S[JoseParamk_kty] = JoseLitkty_OKP then begin AddLog ('Hex Public: ' + B64Url2Hex(JwkJson.S[JoseParamko_pub])); if JwkPrivate.Checked then AddLog ('Hex Private: ' + B64Url2Hex(JwkJson.S[JoseParamko_priv])); end; if JwkJson.S[JoseParamk_kty] = JoseLitkty_AKP then begin { V9.6 } AddLog ('Hex Public: ' + B64Url2Hex(JwkJson.S[JoseParamka_pub])); if JwkPrivate.Checked then AddLog ('Hex Private: ' + B64Url2Hex(JwkJson.S[JoseParamka_priv])); end; end else begin AddLog ('HMAC secret: ' + TestHmacKey.Text ); JwkPub := IcsJoseJWKHmac(TestHmacKey.Text, Myalg, Mykid, JoseLituse_sig); RawJWK.Lines.Text := JwkPub; AddLog ('Ics Jose JWK HMAC Raw: ' + JwkPub); { V8.64 } end; AddLog (''); // get private key from Json Web Signature if JoseAlg >= jsigRsa256 then begin AddLog ('Getting Private Key from JWK'); FVerifyPKey.PrivateKey := IcsJoseJWKGetPKey(JwkPub, NewKeyid); if Assigned(FVerifyPKey.PrivateKey) then begin AddLog('Private key from JWK: ' + FVerifyPKey.PrivateKeyInfo); if ShowRawKey.Checked then begin AddLog (FVerifyPKey.GetPKeyRawText(NOT JwkPrivate.Checked)); end; { V8.67 now got a function to compare key } try if FPrivateKey.ComparePkey(FVerifyPKey) then AddLog ('JWK key matches original private key') else AddLog ('Error, JWK key does not match private key'); except on E:Exception do AddLog ('Failed to compare keys - ' + E.Message); end; end else AddLog ('No JWK public key found'); end else begin AddLog ('Getting HMAC secret from JWK'); NewSecret := IcsJoseJWKGetHmac(JwkPub); if NewSecret = TestHmacKey.Text then AddLog ('JWK HMAC secret matches original HMAC secret, result ' + NewSecret) else AddLog ('Error, JWK HMAC secret does not match HMAC secret, result ' + NewSecret); end; except on E:Exception do AddLog ('Json Web Key exception - ' + E.Message); end; AddLog (''); end; // get public key or secret from existing Json Web Key (as Json) procedure TJsonDemoForm.doJKWReadClick(Sender: TObject); var NewSecret, KeyType, NewKeyid: String; JoseAlg: TJoseAlg; JwkJson: ISuperObject; begin AddLog ('Ics Jose JWK Pkey Raw: ' + RawJWK.Lines.Text); { V8.64 } // get public key from Json Web Signature try JwkJson := SO(RawJWK.Lines.Text); JoseAlg := IcsJoseFindAlgType(JwkJson.S[JoseParamk_alg]); KeyType := JwkJson.S[JoseParamk_kty]; if (JoseAlg >= jsigRsa256) or (KeyType <> JoseLitkty_oct) then begin AddLog ('Getting public key from JWK'); FVerifyPKey.PrivateKey := IcsJoseJWKGetPKey(RawJWK.Lines.Text, NewKeyid); if Assigned(FVerifyPKey.PrivateKey) then begin if ShowRawKey.Checked then begin AddLog (FVerifyPKey.GetPKeyRawText(True)); end; AddLog ('JWK public key found: ' + FVerifyPKey.PrivateKeyInfo); end else AddLog ('No JWK public key found'); end else begin AddLog ('Getting HMAC secret from JWK'); NewSecret := IcsJoseJWKGetHmac(RawJWK.Lines.Text); if NewSecret <> '' then AddLog ('JWK HMAC secret found: ' + NewSecret) else AddLog ('Error, JWK HMAC secret not found'); end; except on E:Exception do AddLog ('Json Web Key exception - ' + E.Message); end; AddLog (''); end; // create Json Web Key, sign data with JWK, check signature procedure TJsonDemoForm.doJWSCreateClick(Sender: TObject); var Data, S, KwkPub, Mykid, Myalg: String; {CompactJWSKey,} JsonJWSKey, {CompactJWSKid,} JsonJWSKid: String; JoseAlg: TJoseAlg; RespJson: ISuperObject; procedure VerifyJWS(const MyJWS: String); var NewKeyid, Nonce, Payload: string; VerifyRes: TJoseVerify; NewPubKey: PEVP_PKEY; begin NewKeyid := MyKid; NewPubKey := FVerifyPKey.PrivateKey; Nonce := ''; // not using this yet AddLog ('CheckJWS: ' + MyJWS); VerifyRes := IcsJoseCheckJWS(MyJWS, Nonce, TestHmacKey.Text, NewPubKey, NewKeyid, Payload, SignECDSAIEEE.Checked); { V9.5 added IEEE } AddLog ('Verify Result: ' + JoseVerifyLits[VerifyRes]); // need to save new public key if VerifyRes = JVerifyOkNewPubKey then begin FVerifyPKey.PrivateKey := NewPubKey; AddLog('Saved JWK: ' + Trim(FVerifyPKey.PublicKeySaveToText)); end; if VerifyRes = JVerifyNeedPubKey then begin if NewKeyid = MyKid then begin AddLog ('Repeating with saved public key for KID: ' + NewKeyid); NewPubKey := FVerifyPKey.PrivateKey; VerifyRes := IcsJoseCheckJWS(MyJWS, Nonce, '', NewPubKey, NewKeyid, Payload, SignECDSAIEEE.Checked); { V9.5 added IEEE } AddLog ('Verify Result: ' + JoseVerifyLits[VerifyRes]); end; end; if Payload <> '' then AddLog (Payload); AddLog (''); end; begin Data := Trim(JoseTextLines.Lines.Text); AddLog ('Create Json Web Key, sign data with JWK, check signature'); AddLog ('Building Json Web Key using Algorithm: ' + TestJWSAlg.Items[TestJWSAlg.ItemIndex]); AddLog ('Data: ' + Data); try Mykid := '1234'; // IntToStr(GetTickCount); // ideally random number if TestJWSAlg.ItemIndex < 1 then Exit; JoseAlg := TJoseAlg(TestJWSAlg.ItemIndex); if JoseAlg >= jsigRsa256 then begin if NOT Assigned(FPrivateKey.PrivateKey) then begin AddLog ('Need to create new private key or load old key file, first'); Exit; end; if NOT IcsPKeyCansign(FPrivateKey.PrivateKey) then begin { V9.6 } AddLog ('Private key can not sign messages: ' + IcsPKeyTypeName(FPrivateKey.PrivateKey)); Exit; end; // V8.65 keep public key for verify without JWK FVerifyPKey.PublicKeyLoadFromText(FPrivateKey.PublicKeySaveToText); AddLog ('Public Key: ' + FPrivateKey.PublicKeySaveToText); AddLog (''); end; // build Json Web Key MyAlg := IcsJoseFindAlg(JoseAlg, FPrivateKey.PrivateKey); if JoseAlg >= jsigRsa256 then begin if ShowRawKey.Checked then AddLog (FPrivateKey.GetPKeyRawText); { V8.64 } KwkPub := IcsJoseJWKPubKey(FPrivateKey.PrivateKey, Myalg, Mykid, JoseLituse_sig); AddLog ('IcsJoseJWKPkey Raw: ' + KwkPub); { V8.64 } AddLog (''); // RespJson := SO(KwkPub); // AddLog ('IcsJoseJWK Pkey: ' + RespJson.AsJson(true, false)); end else begin AddLog ('HMAC secret: ' + TestHmacKey.Text ); KwkPub := IcsJoseJWKHmac(TestHmacKey.Text, Myalg, Mykid, JoseLituse_sig); RespJson := SO(KwkPub); AddLog ('IcsJoseJWK HMac: ' + RespJson.AsJson(true, false)); end; AddLog (''); // build Json header, unsiged S := String(IcsJoseHeader(Myalg, 'jws', KwkPub, '', 'Nonce')); AddLog ('IcsJoseHeader Raw: ' + S); AddLog (''); RespJson := SO(S); AddLog ('IcsJoseHeader: ' + RespJson.AsJson(true, false)); AddLog (''); // build JWS in compacyt (x.x.x) and Json formats AddLog ('Building Json Web Signatures, sending JWK or KID'); { gone, only used for Acme v1 CompactJWSKey := IcsJoseJWSComp(JoseAlg, Data, TestHmacKey.Text, FPrivateKey.PrivateKey, 'jws', KwkPub, '', '101'); AddLog ('IcsJoseJWS Compact JWK: ' + CompactJWSKey) ; CompactJWSKid := IcsJoseJWSComp(JoseAlg, Data, TestHmacKey.Text, FPrivateKey.PrivateKey, 'jws', '', MyKid, '102'); AddLog ('IcsJoseJWS Compact KID: ' + CompactJWSKid) ; AddLog (''); } JsonJWSKey := IcsJoseJWSJson(JoseAlg, Data, TestHmacKey.Text, FPrivateKey.PrivateKey, 'jws', KwkPub, '', '103', '', SignECDSAIEEE.Checked); { V9.5 added IEEE } RawJWK.Text := JsonJWSKey; RespJson := SO(JsonJWSKey); AddLog ('IcsJoseJWS Json JWK: ' + RespJson.AsJson(true, false)); JsonJWSKid := IcsJoseJWSJson(JoseAlg, Data, TestHmacKey.Text, FPrivateKey.PrivateKey, 'jws', '', MyKid, '104', '', SignECDSAIEEE.Checked); { V9.5 added IEEE } RespJson := SO(JsonJWSKid); AddLog ('IcsJoseJWS Json KID: ' + RespJson.AsJson(true, false)); AddLog (''); // verify JWS then all // AddLog ('Verifying Json Web Signature - Compact JWS with new key'); gone, only used for Acme v1 // VerifyJWS(CompactJWSKey); // AddLog ('Verifying Json Web Signature - Compact JWS with KID'); // VerifyJWS(CompactJWSKid); AddLog ('Verifying Json Web Signature - Json JWS with new key'); VerifyJWS(JsonJWSKey); AddLog ('Verifying Json Web Signature - Json JWS with KID'); VerifyJWS(JsonJWSKid); except on E:Exception do AddLog ('Json Web Signature exception - ' + E.Message); end; AddLog (''); end; procedure TJsonDemoForm.doJWSReadClick(Sender: TObject); var NewKeyid, Payload: string; VerifyRes: TJoseVerify; NewPubKey: PEVP_PKEY; begin NewPubKey := FVerifyPKey.PrivateKey; AddLog ('CheckJWS: ' + RawJWK.Text); VerifyRes := IcsJoseCheckJWS(RawJWK.Text, '', TestHmacKey.Text, NewPubKey, NewKeyid, Payload, SignECDSAIEEE.Checked); { V9.5 added IEEE } AddLog ('Verify Result: ' + JoseVerifyLits[VerifyRes]); // need to save new public key if VerifyRes = JVerifyOkNewPubKey then begin FVerifyPKey.PrivateKey := NewPubKey; AddLog('Saved JWK: ' + Trim(FVerifyPKey.PublicKeySaveToText)); end; if Payload <> '' then AddLog (Payload); AddLog (''); end; procedure TJsonDemoForm.doLoadFileClick(Sender: TObject); begin if OpenDlg.Execute then begin JsonInput.Lines.LoadFromFile(OpenDlg.FileName); end; end; procedure TJsonDemoForm.doParseClick(Sender: TObject); var JsonItem: TSuperAvlEntry; JsonObj, RespObj: ISuperObject; JsonEnum: TSuperAvlIterator; I, CWid: integer; FirstCol, FirstRow: Boolean; SourceTxt: UnicodeString; CVal, ErrStr: String; begin RespObj := Nil; JsonGrid.Items.Clear; SourceTxt := JsonInput.Lines.Text; // look for Json response } if ((Pos('{', SourceTxt) > 0) or (Pos('[', SourceTxt) > 0) or (Sender = doParseJson)) then begin try RespObj := TSuperObject.ParseStringEx(PWideChar(SourceTxt), True, ErrStr); if ErrStr <> '' then AddLog('Error parsing Json: ' + ErrStr); except on E:Exception do AddLog('Error parsing Json: ' + E.Message); end; if Assigned(RespObj) then AddLog ('Json main content type: ' + GetEnumName(TypeInfo(TSuperType), Ord(RespObj.DataType))); end; // V8.64 look for XML response } if ((Pos(' 0) or (Sender = doParseXML)) then begin try RespObj := XMLParseString(SourceTxt, CompactXML.Checked); except on E:Exception do AddLog('Error parsing XML: ' + E.Message); end; end; if NOT Assigned(RespObj) then Exit; // nothing to show // parse Json or XML response to grid if LogJson.Checked then AddLog (RespObj.AsJson (True, False)); // formatted try // note that values containing objects are displayed as raw Json JArrayTot := 0; if RespObj.DataType = stObject then begin JsonGrid.Columns.Clear; with JsonGrid.Columns.Add do begin Caption := 'Name'; Width := 100; end; with JsonGrid.Columns.Add do begin Caption := 'Type'; Width := 70; end; with JsonGrid.Columns.Add do begin Caption := 'Value'; Width := 1000; end; with JsonGrid.Columns.Add do begin Caption := ''; Width := 100; end; JsonEnum := RespObj.AsObject.GetEnumerator; try while JsonEnum.MoveNext do begin JsonItem := JsonEnum.GetIter; with JsonGrid.Items.Add do begin Caption := JsonItem.Name; SubItems.Add(GetEnumName(TypeInfo(TSuperType), Ord(JsonItem.Value.DataType))); CVal := JsonItem.Value.AsString; SubItems.Add(CVal); end; end; finally JsonEnum.Free; end; end; // one column per Value, with Name as title if RespObj.DataType = stArray then begin JsonGrid.Items.BeginUpdate; JsonGrid.Columns.Clear; JArrayTot := RespObj.AsArray.Length; if JArrayTot = 0 then Exit; SetLength(JArrayItems, JArrayTot); FirstRow := True; for I := 0 to JArrayTot - 1 do begin JsonObj := RespObj.AsArray[I]; JArrayItems[I] := RespObj.AsArray[I].AsString; { V8.65 keep lines so we display them later } FirstCol := True; with JsonGrid.Items.Add do begin JsonEnum := JsonObj.AsObject.GetEnumerator; while JsonEnum.MoveNext do begin JsonItem := JsonEnum.GetIter; CVal := JsonItem.Value.AsString; if FirstRow then begin CWid := (Length(CVal) * 5) + 30; if CWid > 400 then CWid := 400; with JsonGrid.Columns.Add do begin Caption := JsonItem.Name; Width := CWid; end; end; if FirstCol then Caption := CVal else SubItems.Add(CVal); FirstCol := False; end; end; FirstRow := False; end; JsonGrid.Items.EndUpdate; end; except on E:Exception do AddLog('Error parsing Json: ' + E.Message); end; end; procedure TJsonDemoForm.JsonGridDblClick(Sender: TObject); var I: Integer; begin if NOT Assigned(FormObject) then Exit; if JsonGrid.ItemIndex < 0 then Exit; FormObject.SubJsonGrid.Items.Clear; if (JArrayTot > 0) and (Length(JArrayItems) = JArrayTot) then begin { V8.65 one array element } FormObject.DispJson(JArrayItems[JsonGrid.ItemIndex]); end else begin with JsonGrid.Items[JsonGrid.ItemIndex] do begin if (SubItems.Count >= 2) and ((SubItems[0] = 'stArray') or (SubItems[0] = 'stObject')) then FormObject.DispJson(SubItems[1]) // V8.64 array may have Json object in any column, search for first, sorry ignore others... else if ((Pos ('{', Caption) = 1) or (Pos ('[', Caption) = 1)) then FormObject.DispJson(Caption) else if (SubItems.Count > 0) then begin for I := 0 to SubItems.Count - 1 do begin if ((Pos ('{', SubItems[I]) = 1) or (Pos ('[', SubItems[I]) = 1)) then begin FormObject.DispJson(SubItems[I]); break; end; end; end; FormObject.BringToFront; end; end; end; // report lots of private key parameters procedure TJsonDemoForm.doKeyParamsClick(Sender: TObject); begin if NOT Assigned(FPrivateKey.PrivateKey) then begin AddLog ('Need to create new private key or load old key file, first'); Exit; end; // report key parameters, OpenSSL 3.0 and later AddLog ('IcsPkeyParamGettable: ' + IcsCRLF + IcsPkeyParamGettable(FPrivateKey.PrivateKey)); // AddLog ('IcsPkeyParamSettable: ' + IcsCRLF + IcsPkeyParamSettable(FPrivateKey.PrivateKey)); only for new key try AddLog (IcsPkeyParamsGetAll(FPrivateKey.PrivateKey)); except on E:Exception do AddLog('Error printing parameters: ' + E.Message); end; end; // moved from PemTools sample, uses RSA public key to encrypt text, private key to decrypt again // new RSA key will be generated procedure TJsonDemoForm.doEncryptPkeyClick(Sender: TObject); var {$IFDEF OpenSSL_Deprecated} { V9.5 } EncStrOld: AnsiString; DecStrOld: String; {$ENDIF OpenSSL_Deprecated} { V9.5 } EncStrNew: AnsiString; DecStrNew: String; PubKey: TX509Base; begin try PubKey := TX509Base.Create(Self); FPrivateKey.ClearAll; FPrivateKey.PrivKeyType := PrivKeyRsa2048; LabelPKey.Caption := 'Private Key: '; AddLog('Generating private and public key pair, please wait'); FPrivateKey.DoKeyPair; AddLog('Generated private and public key pair OK: ' + FPrivateKey.PrivateKeyInfo); LabelPKey.Caption := 'Private Key: ' + FPrivateKey.PrivateKeyInfo; AddLog ('Data to Encrypt: ' + Trim(JoseTextLines.Lines.Text) + IcsCRLF + 'Private Key: ' + fPrivateKey.PrivateKeyInfo); PubKey.PublicKeyLoadFromText(FPrivateKey.PublicKeySaveToText); // get just the public key from the private key } { Encrypt using public key, string is Base64 encoded } EncStrNew := IcsJoseStrEncPKey(PubKey.PrivateKey, StringToUtf8(Trim(JoseTextLines.Text)), TRUE); AddLog('RSA 3.0 encrypted with Private Key and Base64 encoded: ' + String(EncStrNew)); { Decrypt Base64 using the private key. } DecStrNew := Utf8ToStringW(IcsJoseStrDecPkey(fPrivateKey.PrivateKey, EncStrNew, TRUE)); AddLog('RSA 3.0 decrypted text again: ' + DecStrNew); {$IFDEF OpenSSL_Deprecated} { V9.5 } { Encrypt using public key, string is Base64 encoded } EncStrOld := StrEncRsa(PubKey.PrivateKey, StringToUtf8(Trim(JoseTextLines.Text)), TRUE); AddLog('RSA legacy encrypted with Private Key and Base64 encoded: ' + String(EncStrOld)); { Decrypt Base64 using the private key. } DecStrOld := Utf8ToStringW(StrDecRsa(fPrivateKey.PrivateKey, EncStrOld, TRUE)); AddLog('RSA legacy decrypted text again: ' + DecStrOld); {$ENDIF OpenSSL_Deprecated} { V9.5 } PubKey.Free; AddLog(''); except on E:Exception do AddLog ('RSA Encryption exception - ' + E.Message); end; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TJsonDemoForm.doEncryptPkeyExtClick(Sender: TObject); var {EncStrOld,} EncStrNew: AnsiString; {DecStrOld,} DecStrNew: String; PubKey: TX509Base; begin try if NOT Assigned(FPrivateKey.PrivateKey) then begin AddLog ('Need to create new private key or load old key file, first'); Exit; end; PubKey := TX509Base.Create(Self); LabelPKey.Caption := 'Private Key: ' + FPrivateKey.PrivateKeyInfo; AddLog ('Data to Encrypt: ' + Trim(JoseTextLines.Lines.Text) + IcsCRLF + 'Private Key: ' + fPrivateKey.PrivateKeyInfo); PubKey.PublicKeyLoadFromText(FPrivateKey.PublicKeySaveToText); // get just the public key from the private key } { Encrypt using public key, string is Base64 encoded } EncStrNew := IcsJoseStrEncPKey(PubKey.PrivateKey, StringToUtf8(Trim(JoseTextLines.Text)), TRUE); AddLog('RSA 3.0 encrypted with Private Key and Base64 encoded: ' + String(EncStrNew)); { Decrypt Base64 using the private key. } DecStrNew := Utf8ToStringW(IcsJoseStrDecPkey(fPrivateKey.PrivateKey, EncStrNew, TRUE)); AddLog('RSA 3.0 decrypted text again: ' + DecStrNew); PubKey.Free; AddLog(''); except on E:Exception do AddLog ('RSA Encryption exception - ' + E.Message); end; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} // moved from PemTools sample, uses Blowfish ctBfCbc to password encrypt text, and decrypt again // simple text procedure TJsonDemoForm.doEncryprPWTextClick(Sender: TObject); {$IFDEF OpenSSL_Deprecated} { V9.5 } var IV : TBytes; EncStr: AnsiString; DecStr: String; {$ENDIF OpenSSL_Deprecated} { V9.5 } begin {$IFDEF OpenSSL_Deprecated} { V9.5 } AddLog('Data to Encrypt: ' + Trim(CryptTextIn.Text)); // RAND_bytes(@IV, SizeOf(IV)); IV := IcsStringToTBytes(Trim(CipherRawIV.Text)); SetLength(IV, 8); EncStr := StrEncBF(StringToUtf8(Trim(CryptTextIn.Text)), AnsiString(Trim(CipherPassword.Text)), @IV, TCipherKeyLen(CipherBFBits.ItemIndex), TRUE); AddLog('Blowfish Encrypted: ' + String(EncStr)); DecStr := Utf8ToStringW(StrDecBF(EncStr, AnsiString(Trim(CipherPassword.Text)), @IV, TCipherKeyLen(CipherBFBits.ItemIndex), TRUE)); AddLog('Blowfish Decrypted: ' + DecStr); AddLog(''); {$ENDIF OpenSSL_Deprecated} { V9.5 } end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} // moved from PemTools sample, uses Blowfish ctBfCbc to password encrypt a stream, and decrypt again // using simple text here, but streams are unlimited size procedure TJsonDemoForm.doEncryprPWFileClick(Sender: TObject); {$IFDEF OpenSSL_Deprecated} { V9.5 } var RawStr, S: AnsiString; DecStr: String; Src, Dest : TStream; EncCtx, DecCtx : TCiphContext; {$ENDIF OpenSSL_Deprecated} { V9.5 } begin {$IFDEF OpenSSL_Deprecated} { V9.5 } FillChar(EncCtx, SizeOf(EncCtx), #0); FillChar(DecCtx, SizeOf(DecCtx), #0); { We use one context for encryption and another one for decryption, } { IV will be calculated from the password, key size default = 128-bits } CiphInitialize(EncCtx, AnsiString(Trim(CipherPassword.Text)), nil, nil, {ctBfEcb ctBfOfb} ctBfCbc, TCipherKeyLen(CipherBFBits.ItemIndex), True); CiphInitialize(DecCtx, AnsiString(Trim(CipherPassword.Text)), nil, nil, {ctBfEcb ctBfOfb} ctBfCbc, TCipherKeyLen(CipherBFBits.ItemIndex), False); try AddLog('Data to Encrypt: ' + Trim(JoseTextLines.Text)); RawStr := StringToUtf8(Trim(JoseTextLines.Text)); Src := TMemoryStream.Create; Dest := TMemoryStream.Create; try { Populate the source stream } Src.WriteBuffer(RawStr[1], Length(RawStr)); { Encrytion takes place here } StreamEncrypt(Src, Dest, 1024, EncCtx, False); { Just to display cipher text } SetLength(S, Dest.Size); Dest.Position := 0; Dest.Read(S[1], Length(S)); AddLog('Blowfish Encrypted: ' + String(IcsBase64EncodeA(S))); { Decrytion takes place here } StreamDecrypt(Dest, Src, 1024, DecCtx, False); { Just to display decrypted plain result } SetLength(S, Src.Size); Src.Position := 0; Src.Read(S[1], Length(S)); DecStr := Utf8ToStringW(S); AddLog('Blowfish Decrypted: ' + DecStr); AddLog(''); finally Src.Free; Dest.Free; end; finally CiphFinalize(EncCtx); CiphFinalize(DecCtx); end; {$ENDIF OpenSSL_Deprecated} { V9.5 } end; { V9.6 new Jose symmetrical encryption component } procedure TJsonDemoForm.GetCiphers; var Tot: integer; begin Tot := 0; try Tot := IcsSymCrypto.GetAllCiphers; // returns total, but not all have names added to list except on E:Exception do AddLog ('Cipher exception - ' + E.Message); end; if Tot > 0 then begin AddLog ('Total ciphers found: ' + IntToStr(Tot)); ListCiphers.Items.Assign(IcsSymCrypto.AllCiphers); end; end; procedure TJsonDemoForm.ReportCipherInfo; var S: String; begin S := 'Cipher Name:' + IcsSymCrypto.ReqName + IcsCRLF + 'Raw Key Length: ' + IntToStr(IcsSymCrypto.ReqKeyLength) + IcsCRLF + 'Init Vector Length: ' + IntToStr(IcsSymCrypto.ReqIVectorLen) + IcsCRLF + 'Block Size: ' + IntToStr(IcsSymCrypto.ReqBlockSize) + IcsCRLF + 'Cipher Mode: ' + IcsSymCrypto.ModeAsString + IcsCRLF; S := S + IcsSymCrypto.FlagsAsString + IcsCRLF; LabelCipher.Caption := S; end; procedure TJsonDemoForm.SelCiphFileClick(Sender: TObject); begin OpenDlg.InitialDir := ExtractFilePath(CipherFileName.Text); OpenDlg.FileName := CipherFileName.Text; if OpenDlg.InitialDir = '' then begin OpenDlg.InitialDir := 'c:\'; OpenDlg.FileName := '*.*'; end; if OpenDlg.Execute then begin CipherFileName.Text := OpenDlg.FileName; end; end; // get cipher from list built from OpenSSL into AllCiphers TStringList procedure TJsonDemoForm.ListCiphersClick(Sender: TObject); var CName: String; // PEvpCipher: PEVP_CIPHER; begin if ListCiphers.ItemIndex < 0 then Exit; CName := IcsSymCrypto.AllCiphers[ListCiphers.ItemIndex]; CipherName.Text := CName; CipherNameClick(Self); { we can also set the cipher pointer directly by object instead of name PEvpCipher := PEVP_CIPHER(IcsSymCrypto.AllCiphers.Objects[Item]); if Assigned(PEvpCipher) then begin IcsSymCrypto.PEvpCipher := PEvpCipher; ReportCipherInfo; end; } end; // update cipher details if bits change, Blowfish only procedure TJsonDemoForm.CipherBFBitsClick(Sender: TObject); begin CipherNameClick(Self); end; // get cipher from ICS TEvpCipher literal list procedure TJsonDemoForm.CipherICsTypesClick(Sender: TObject); begin if CipherICsTypes.ItemIndex < 0 then Exit; IcsSymCrypto.EvpCipher := TEvpCipher(CipherICsTypes.ItemIndex); IcsSymCrypto.CipherBFLen := TCipherBFLen(CipherBFBits.ItemIndex) ; // only needed for Blowfish ReportCipherInfo; CipherName.Text := IcsSymCrypto.ReqName; end; // get cipher from ASCII name procedure TJsonDemoForm.CipherNameClick(Sender: TObject); begin if CipherName.Text = '' then Exit; IcsSymCrypto.CipherName := CipherName.Text; IcsSymCrypto.CipherBFLen := TCipherBFLen(CipherBFBits.ItemIndex) ; // only needed for Blowfish ReportCipherInfo; end; // set and check encyption parameters, procedure TJsonDemoForm.doCheckCryptClick(Sender: TObject); begin try CipherNameClick(Self); IcsSymCrypto.CKeyDerMethod := TCKeyDerMethod(EncKeyType.ItemIndex); if IcsSymCrypto.CKeyDerMethod = cktRaw then begin IcsSymCrypto.CipherKey := IcsStringToTBytes(Trim(CipherRawKey.Text)); IcsSymCrypto.PwSalt := IcsStringToTBytes(Trim(CipherPwSalt.Text)); IcsSymCrypto.IVector := IcsStringToTBytes(Trim(CipherRawIV.Text)); end else IcsSymCrypto.Password := Trim(CipherPassword.Text); // not needed for KeyType := cktRaw; IcsSymCrypto.PwSalt := IcsStringToTBytes(CipherPwSalt.Text); // must be 8 bytes or blank IcsSymCrypto.AddRandomSalt := CipherRandomSalt.Checked; // adds a random 8 byte PwSalt to the output, or reads it if NOT IcsSymCrypto.InitEncrypt then AddLog ('Initialise failed: ' + IcsSymCrypto.LastError) else begin AddLog ('Initialised OK for: ' + IcsSymCrypto.ReqName); AddLog ('Key Derivation: ' + EncKeyType.Items[EncKeyType.ItemIndex]); AddLog ('Raw Cipher Key: ' + IcsTBToHex(IcsSymCrypto.CipherKey)); AddLog ('Raw IVector: ' + IcsTBToHex(IcsSymCrypto.IVector)); if IcsSymCrypto.AddRandomSalt then AddLog ('Random PW Salt') else AddLog ('Raw PW Salt: ' + IcsTBToHex(IcsSymCrypto.PwSalt)); end; except on E:Exception do AddLog ('Initialisation failed - ' + E.Message); end; end; // this methods tests the TIcsSymCrypto compooent to encrypt and decrypt a string, with all the different properties procedure TJsonDemoForm.doEncryptTextClick(Sender: TObject); var Encrypted: TBytes; OrigStr, EncStr, DecStr: String; begin doCheckCryptClick(Self); if NOT IcsSymCrypto.IsInitialised then Exit; CryptTextOut.Lines.Clear; OrigStr := Trim(CryptTextIn.Text); AddLog ('String to Encrypt: ' + origStr); try Encrypted := IcsSymCrypto.StrEncrypt(OrigStr); if IcsSymCrypto.ReqAEADMode then begin CipherAEAD.Text := IcsTBToHex(IcsSymCrypto.AEADTag); // keep AEAD tag calculed during encryption AddLog ('Authenticated-Encryption with Associated-Data (AEAD): ' + CipherAEAD.Text); end; EncStr := String(IcsBase64EncodeTB(Encrypted)); AddLog ('B64 Encrypted: ' + EncStr); // AddLog ('Hex Encrypted: ' + IcsStrBeakup(IcsTBToHex(Encrypted), 64)); CryptTextOut.Lines.Text := IcsStrBeakup(EncStr, 32); AddLog ('Orignal Len=' + IntToStr(Length(OrigStr)) + ', Encrypted Len=' + IntToStr(Length(Encrypted))); DecStr := IcsSymCrypto.StrDecrypt(Encrypted); AddLog ('String Decrypted: ' + DecStr); if DecStr = OrigStr then AddLog ('Encrypt and Decrypt Matched OK') else AddLog ('Encrypt and Decrypt Failed'); except on E:Exception do AddLog ('Encryption exception - ' + E.Message); end; AddLog (''); end; procedure TJsonDemoForm.doDecryptTextClick(Sender: TObject); var Encrypted: TBytes; DecStr: String; begin doCheckCryptClick(Self); if NOT IcsSymCrypto.IsInitialised then Exit; if IcsSymCrypto.ReqAEADMode then IcsSymCrypto.AEADTag := IcsBase64DecodeTB(AnsiString(CipherAEAD.Text)); // needed to decode AEAD AddLog ('String to Decrypt: ' + CryptTextOut.Lines.Text); try Encrypted := IcsBase64DecodeTB(AnsiString(CryptTextOut.Lines.Text)); DecStr := IcsSymCrypto.StrDecrypt(Encrypted); AddLog ('String Decrypted: ' + DecStr); except on E:Exception do AddLog ('Decryption exception - ' + E.Message); end; AddLog (''); end; // this methods tests two standalone functions to encrypt and decrypt a string, with simple parameters procedure TJsonDemoForm.doQuickEncryptClick(Sender: TObject); var Encrypted: TBytes; OrigStr, EncStr, DecStr: String; begin CryptTextOut.Lines.Clear; OrigStr := Trim(CryptTextIn.Text); AddLog ('String to Encrypt: ' + origStr); try Encrypted := IcsJoseStrEncrypt(OrigStr, Trim(CipherPassword.Text) {, Cipher_aes_256_cbc, cktpkcs5v15} ); // cipher and key are defaulted EncStr := String(IcsBase64EncodeTB(Encrypted)); AddLog ('B64 Encrypted: ' + EncStr); CryptTextOut.Lines.Text := IcsStrBeakup(EncStr, 32); DecStr := IcsJoseStrDecrypt(Encrypted, Trim(CipherPassword.Text) {, Cipher_aes_256_cbc, cktpkcs5v15} ); // cipher and key are defaulted AddLog ('String Decrypted: ' + DecStr); if DecStr = OrigStr then AddLog ('Encrypt and Decrypt Matched OK') else AddLog ('Encrypt and Decrypt Failed'); except on E:Exception do AddLog ('Encryption exception - ' + E.Message); end; AddLog (''); end; procedure TJsonDemoForm.doEncryptStreamClick(Sender: TObject); var Encrypted, Decrypted: TBytes; OrigStr, EncStr, DecStr: String; SrcStream, DestStream: TStream; begin doCheckCryptClick(Self); if NOT IcsSymCrypto.IsInitialised then Exit; CryptTextOut.Lines.Clear; OrigStr := Trim(CryptTextIn.Text); AddLog ('String to Encrypt as a Stream: ' + origStr); try SrcStream := TMemoryStream.Create; DestStream := TMemoryStream.Create; try { Populate the source stream with UTF8 encoded text } SrcStream.WriteBuffer(IcsStringToTBytes(OrigStr, CP_UTF8), 0, Length(OrigStr)); { Encryption takes place here } IcsSymCrypto.StreamEncrypt(SrcStream, DestStream, 2048); { Just to display cipher text } SetLength(Encrypted, DestStream.Size); DestStream.Position := 0; DestStream.Read(Encrypted[0], Length(Encrypted)); EncStr := String(IcsBase64EncodeTB(Encrypted)); AddLog ('B64 Encrypted Stream: ' + EncStr); // AddLog ('Hex Encrypted: ' + IcsStrBeakup(IcsTBToHex(Encrypted), 64)); CryptTextOut.Lines.Text := IcsStrBeakup(EncStr, 32); { Decryption takes place here } SrcStream.Size := 0; IcsSymCrypto.StreamDecrypt(DestStream, SrcStream, 2048); { Just to display decrypted plain result } SetLength(Decrypted, SrcStream.Size); SrcStream.Position := 0; SrcStream.Read(Decrypted[0], Length(Decrypted)); DecStr := IcsTBytesToString(Decrypted, 0, cp_utf8); AddLog ('Stream Decrypted: ' + DecStr); if DecStr = OrigStr then AddLog ('Encrypt and Decrypt Matched OK') else AddLog ('Encrypt and Decrypt Failed'); finally SrcStream.Free; DestStream.Free; end; except on E:Exception do AddLog ('Encryption exception - ' + E.Message); end; AddLog(''); end; procedure TJsonDemoForm.doEncryptFileClick(Sender: TObject); var RawStreamTB, DecryptedTB: TBytes; OrigFName, NewFName, DecFName: String; OrigLen, NewLen: Integer; SrcStream, DestStream, DecrypStream: TFileStream; begin doCheckCryptClick(Self); if NOT IcsSymCrypto.IsInitialised then Exit; OrigFName := CipherFileName.Text; if NOT FileExists(OrigFName) then begin AddLog ('File not found: ' + OrigFName); Exit; end; NewFName := OrigFName + '_encrypted'; DecFName := OrigFName + '_decrypted'; if FileExists(NewFName) then IcsDeleteFile(NewFName, True); if FileExists(DecFName) then IcsDeleteFile(DecFName, True); try SrcStream := TFileStream.Create(OrigFName, fmOpenRead); DestStream := TFileStream.Create(NewFName, fmCreate); DecrypStream := TFileStream.Create(DecFName, fmCreate); // only needed if testing decryption AddLog ('Creating encrypted file: ' + NewFName); OrigLen := SrcStream.Size; AddLog ('Original file length: ' + IcsIntToCStr(OrigLen)); try SetLength(RawStreamTB, OrigLen); SrcStream.Position := 0; SrcStream.Read(RawStreamTB[0], OrigLen); { Encryption takes place here } IcsSymCrypto.StreamEncrypt(SrcStream, DestStream, 2048); AddLog ('Encrypted file length: ' + IcsIntToCStr(DestStream.Size)); { Decryption takes place here } IcsSymCrypto.StreamDecrypt(DestStream, DecrypStream, 2048); { Just to check input and output are the same } NewLen := DecrypStream.Size; AddLog ('Decrypted file as: ' + DecFName + ', file length: ' + IcsIntToCStr(NewLen)); if OrigLen <> NewLen then begin AddLog ('Decrypted file different size: ' + IcsIntToCStr(NewLen)); Exit; end; SetLength(DecryptedTB, NewLen); DecrypStream.Position := 0; DecrypStream.Read(DecryptedTB[0], NewLen); if IcsTBytesCompare(RawStreamTB, DecryptedTB) then AddLog ('Encrypt and Decrypt Matched OK') else AddLog ('Encrypt and Decrypt Failed'); finally SrcStream.Free; DestStream.Free; DecrypStream.Free; end; except on E:Exception do AddLog ('Encryption exception - ' + E.Message); end; AddLog(''); end; end.