{*******************************************************} { } { Tocsg.Encrypt } { } { Copyright (C) 2022 kku } { } {*******************************************************} unit Tocsg.Encrypt; interface uses Tocsg.Obj, System.Classes, System.SysUtils, Tocsg.Exception, Winapi.Windows, aes_type; const BUF_LEN_32K = 1024 * 32; BUF_LEN_64K = 1024 * 64; type TTgEncKind = (ekNone, ekAes128cbc, ekAes192cbc, ekAes256cbc); TTgPassHash = (phNone, phSha1, phSha256); TTgEncrypt = class(TTgObject) private bEncInit_, bDecInit_: Boolean; evWorkBegin_: TTgEvtWorkBegin; evWorkEnd_: TTgEvtWorkEnd; evWork_: TTgEvtWork; sPass_: String; // AES nBit_: Integer; ACtx_: TAESContext; ABlk_: TAESBlock; AesKeyBuf_: TBytes; cFillPassChar_: AnsiChar; protected EncKind_: TTgEncKind; procedure WorkBeginEvent(llMax: LONGLONG); procedure WorkEndEvent(llPos, llMax: LONGLONG); procedure WorkEvent(llPos: LONGLONG); procedure SetPassword(const sPass: String); procedure SetEncryptKind(aEncKind: TTgEncKind); procedure ClearAlgo; public Constructor Create; overload; Constructor Create(const aPassword: String; aEncryptKind: TTgEncKind = ekAes256cbc; cFillPassChar: AnsiChar = '*'); overload; Constructor Create(pKey: TBytes; aEncryptKind: TTgEncKind = ekAes256cbc); overload; class function CheckSign(aStream: TStream; sSign: AnsiString): Boolean; overload; class function CheckSign(sPath: String; sSign: AnsiString): Boolean; overload; procedure InitEncrypt; procedure FinalEncrypt; procedure InitDecrypt; procedure FinalDecrypt; function DecryptBuffer(pSrcBuf: Pointer; nBufLen: Integer; bDoUnpadding: Boolean = false): TBytes; function EncryptBuffer(pSrcBuf: Pointer; nBufLen: Integer; bDoPadding: Boolean = false): TBytes; function EncryptBufferEx(pSrcBuf: Pointer; const dwBufLen: DWORD): TBytes; function DecryptBufferEx(pSrcBuf: Pointer; const dwBufLen: DWORD): TBytes; function EncryptStream(SrcStream, DesStream: TStream; sSig: AnsiString = ''; aPassHash: TTgPassHash = phSha1): Boolean; function DecryptStream(SrcStream, DesStream: TStream; sSig: AnsiString = ''; aPassHash: TTgPassHash = phSha1): Boolean; property OnWorkBegin: TTgEvtWorkBegin write evWorkBegin_; property OnWorkEnd: TTgEvtWorkEnd write evWorkEnd_; property OnWork: TTgEvtWork write evWork_; property EncKind: TTgEncKind read EncKind_ write SetEncryptKind; end; EKzEncrypt = class(ETgException); function EncStrToBinStr(aEncAlgo: TTgEncKind; const sPass, sSrcStr: String): String; function DecBinStrToStr(aEncAlgo: TTgEncKind; const sPass, sSrcStr: String): String; implementation uses // EM.SHA1, Tocsg.Safe, Tocsg.Binary, aes_cbc, Tocsg.Hash, EM.Tocsg.hash; function BlockPadding(aData: Pointer; nDataSize, nBlockSize: Integer; var aBuf: TBytes): Integer; var m: WORD; begin Result := 0; try if nDataSize < nBlockSize then begin Result := nBlockSize; SetLength(aBuf, nBlockSize); // PKCS7 �е� 18_0410 09:43:58 kku FillMemory(aBuf, nBlockSize, nBlockSize - nDataSize); end else begin m := nDataSize mod nBlockSize; if m > 0 then Result := nDataSize + nBlockSize - m else Result := nDataSize + nBlockSize; SetLength(aBuf, Result); // PKCS7 �е� 18_0410 09:43:58 kku if m > 0 then FillMemory(aBuf, Result, nBlockSize - m) else FillMemory(aBuf, Result, nBlockSize); end; CopyMemory(aBuf, aData, nDataSize); except on E: Exception do begin EKzEncrypt.TraceException(E, 'Fail .. BlockPadding()'); Result := 0; end; end; end; // PKCS7 �е� Ȯ�� �� ���� ������ ũ�� ���� 18_0410 09:44:29 kku procedure UnpaddingPKCS7(var aDecBuf: TBytes; nBlockSize: Integer); var nLen, nCutLen, i: Integer; begin nLen := Length(aDecBuf); if nLen < nBlockSize then exit; nCutLen := aDecBuf[nLen - 1]; if nCutLen > nBlockSize then exit; for i := nLen - nCutLen to nLen - 1 do begin if aDecBuf[i] <> nCutLen then exit; end; // �� ���� ä���ش�. // AnsiString�� ��� ������ �������� ����� �� �ִ�. 18_0410 10:05:39 kku ZeroMemory(@aDecBuf[nLen - nCutLen], nCutLen); SetLength(aDecBuf, nLen - nCutLen); end; function StrKeyToBitPadding(const sKey: AnsiString; wBit: WORD; var aBuf: TBytes; cFillChar: AnsiChar = #0): WORD; var wKeyLen: WORD; begin SetLength(aBuf, 0); Result := 0; case wBit of 128, 192, 256 : ; else exit; end; try SetLength(aBuf, wBit); FillChar(aBuf[0], wBit, cFillChar); wKeyLen := Length(sKey); if wKeyLen > wBit then CopyMemory(aBuf, @sKey[1], wBit) else CopyMemory(aBuf, @sKey[1], wKeyLen); Result := Length(aBuf) * 8; except on E: Exception do EKzEncrypt.TraceException(E, 'Fail .. StrKeyToBitPadding()'); end; end; { TTgEncrypt } Constructor TTgEncrypt.Create; begin Inherited Create; nBit_ := 0; bEncInit_ := false; bDecInit_ := false; EncKind_ := ekNone; cFillPassChar_ := '*'; end; Constructor TTgEncrypt.Create(const aPassword: String; aEncryptKind: TTgEncKind = ekAes256cbc; cFillPassChar: AnsiChar = '*'); begin Create; sPass_ := aPassword; cFillPassChar_ := cFillPassChar; SetEncryptKind(aEncryptKind); end; Constructor TTgEncrypt.Create(pKey: TBytes; aEncryptKind: TTgEncKind = ekAes256cbc); var nLen: Integer; begin Create; nLen := Length(pKey); SetLength(AesKeyBuf_, nLen); CopyMemory(AesKeyBuf_, pKey, nLen); SetEncryptKind(aEncryptKind); end; procedure TTgEncrypt.InitEncrypt; begin if not bEncInit_ then begin case EncKind_ of ekAes256cbc, ekAes192cbc, ekAes128cbc : begin ZeroMemory(@ACtx_, SizeOf(ACtx_)); if AES_CBC_Init_Encr(AesKeyBuf_[0], nBit_, ABlk_, ACtx_) <> 0 then begin _Trace('Faill .. InitEncrypt() .. AES_CBC_Init_Encr() ..'); exit; end; end; end; bEncInit_ := true; end; end; procedure TTgEncrypt.FinalEncrypt; begin bEncInit_ := false; end; // ���� ũ�Ⱑ �Ѿ�� �ڿ����� �Ϻ�ȣȭ �ȵ� function TTgEncrypt.EncryptBuffer(pSrcBuf: Pointer; nBufLen: Integer; bDoPadding: Boolean = false): TBytes; var nLen: Integer; pInBuf: TBytes; begin SetLength(Result, 0); if not bEncInit_ then exit; try case EncKind_ of ekNone: begin SetLength(Result, nBufLen); CopyMemory(Result, pSrcBuf, nBufLen); end; ekAes256cbc, ekAes192cbc, ekAes128cbc : begin if bDoPadding then begin nLen := BlockPadding(pSrcBuf, nBufLen, AESBLKSIZE, pInBuf); ASSERT(nLen >= AESBLKSIZE); end else begin nLen := nBufLen; SetLength(pInBuf, nLen); CopyMemory(pInBuf, pSrcBuf, nBufLen); end; SetLength(Result, nLen); if AES_CBC_Encrypt(pInBuf, Result, nLen, ACtx_) <> 0 then begin _Trace('Faill .. EncryptBuffer() .. AES_CBC_Encrypt() ..'); SetLength(Result, nBufLen); CopyMemory(Result, pSrcBuf, nBufLen); exit; end; end; end; except on E: Exception do EKzEncrypt.TraceException(Self, E, 'Fail .. CryptBuffer()'); end; end; procedure TTgEncrypt.InitDecrypt; begin if not bDecInit_ then begin case EncKind_ of ekAes256cbc, ekAes192cbc, ekAes128cbc : begin ZeroMemory(@ACtx_, SizeOf(ACtx_)); if AES_CBC_Init_Decr(AesKeyBuf_[0], nBit_, ABlk_, ACtx_) <> 0 then begin _Trace('Faill .. InitDecrypt() .. AES_CBC_Init_Decr() ..'); exit; end; end; end; bDecInit_ := true; end; end; procedure TTgEncrypt.FinalDecrypt; begin bDecInit_ := false; end; function TTgEncrypt.DecryptBuffer(pSrcBuf: Pointer; nBufLen: Integer; bDoUnpadding: Boolean = false): TBytes; begin SetLength(Result, 0); if not bDecInit_ then exit; try case EncKind_ of ekNone: begin SetLength(Result, nBufLen); CopyMemory(Result, pSrcBuf, nBufLen); end; ekAes256cbc, ekAes192cbc, ekAes128cbc : begin SetLength(Result, nBufLen); if AES_CBC_Decrypt(pSrcBuf, Result, nBufLen, ACtx_) <> 0 then begin _Trace('Faill .. EncryptBuffer() .. AES_CBC_Decrypt() ..'); SetLength(Result, nBufLen); CopyMemory(Result, pSrcBuf, nBufLen); exit; end; if bDoUnpadding then UnpaddingPKCS7(Result, AESBLKSIZE); end; end; except on E: Exception do EKzEncrypt.TraceException(Self, E, 'Fail .. DecryptBuffer()'); end; end; // 32kb ������ �߶� �Ϻ�ȣȭ 14_0704 17:58:13 kku function TTgEncrypt.EncryptBufferEx(pSrcBuf: Pointer; const dwBufLen: DWORD): TBytes; var dwRead, dwReaded: DWORD; nLen: Integer; pInBuf: TBytes; begin case EncKind_ of ekNone: begin SetLength(Result, dwBufLen); CopyMemory(Result, pSrcBuf, dwBufLen); end; ekAes256cbc, ekAes192cbc, ekAes128cbc : begin // if not bAEncInit_ then // begin ZeroMemory(@ACtx_, SizeOf(ACtx_)); if AES_CBC_Init_Encr(AesKeyBuf_[0], nBit_, ABlk_, ACtx_) <> 0 then begin _Trace('Faill .. EncryptBufferEx() .. AES_CBC_Init_Encr() ..'); EncKind_ := ekNone; Result := EncryptBufferEx(pSrcBuf, dwBufLen); exit; end; // bAEncInit_ := true; // end; nLen := BlockPadding(pSrcBuf, dwBufLen, AESBLKSIZE, pInBuf); SetLength(Result, nLen); dwReaded := 0; while dwReaded < nLen do begin dwRead := nLen - dwReaded; if dwRead > BUF_LEN_32K then dwRead := BUF_LEN_32K; if AES_CBC_Encrypt(@pInBuf[dwReaded], @Result[dwReaded], dwRead, ACtx_) <> 0 then begin _Trace('Faill .. EncryptBufferEx() .. AES_CBC_Encrypt() ..'); SetLength(Result, dwBufLen); CopyMemory(Result, pSrcBuf, dwBufLen); exit; end; Inc(dwReaded, dwRead); end; end; end; end; function TTgEncrypt.DecryptBufferEx(pSrcBuf: Pointer; const dwBufLen: DWORD): TBytes; var dwRead, dwReaded: DWORD; begin case EncKind_ of ekNone: begin SetLength(Result, dwBufLen); CopyMemory(Result, pSrcBuf, dwBufLen); end; ekAes256cbc, ekAes192cbc, ekAes128cbc : begin // if not bADecInit_ then // begin ZeroMemory(@ACtx_, SizeOf(ACtx_)); if AES_CBC_Init_Decr(AesKeyBuf_[0], nBit_, ABlk_, ACtx_) <> 0 then begin _Trace('Faill .. DecryptBufferEx() .. AES_CBC_Init_Decr() ..'); EncKind_ := ekNone; Result := EncryptBufferEx(pSrcBuf, dwBufLen); exit; end; // bADecInit_ := true; // end; SetLength(Result, dwBufLen); ZeroMemory(Result, dwBufLen); dwReaded := 0; while dwReaded < dwBufLen do begin dwRead := dwBufLen - dwReaded; if dwRead > BUF_LEN_32K then dwRead := BUF_LEN_32K; if AES_CBC_Decrypt(@TBytes(pSrcBuf)[dwReaded], @Result[dwReaded], dwRead, ACtx_) <> 0 then begin _Trace('Faill .. DecryptBufferEx() .. AES_CBC_Encrypt() ..'); SetLength(Result, dwBufLen); CopyMemory(Result, pSrcBuf, dwBufLen); exit; end; Inc(dwReaded, dwRead); end; UnpaddingPKCS7(Result, AESBLKSIZE); end; end; end; function TTgEncrypt.EncryptStream(SrcStream, DesStream: TStream; sSig: AnsiString = ''; aPassHash: TTgPassHash = phSha1): Boolean; var nPassLen: Integer; pBufIn: array[0..BUF_LEN_64K-1] of Byte; pBufOut: TBytes; nRead, nWrite, nBufOutLen: Integer; begin Result := true; nPassLen := Length(sPass_); if nPassLen < 4 then begin Result := false; _Trace('EncryptStream() - �н����尡 4�ڸ� �����Դϴ�.'); exit; end; SrcStream.Position := 0; if (sSig <> '') or (aPassHash <> phNone) then DesStream.Position := 0; if sSig <> '' then DesStream.Write(sSig[1], Length(sSig)); case aPassHash of phNone : ; phSha1 : begin var SHA1Hash: TSHA1Hash; var PassSHA1: TSHA1Digest; Guard(SHA1Hash, TSHA1Hash.Create); SHA1Hash.SetBuffer(PWideChar(sPass_), nPassLen*2); if not SHA1Hash.WorkFinalToDigest(PassSHA1) then begin Result := false; _Trace('EncryptStream() - �н������� �ؽø� ������ ������ �߻��Ͽ����ϴ�.'); exit; end; if DesStream.Write(PassSHA1, SizeOf(PassSHA1)) <> SizeOf(PassSHA1) then begin Result := false; _Trace('EncryptStream() - �ؽ� ���� ����'); exit; end; end; phSha256 : begin var SHA256Hash: TSHA256Hash; var PassSHA256: TSHA256Digest; Guard(SHA256Hash, TSHA256Hash.Create); SHA256Hash.SetBuffer(PWideChar(sPass_), nPassLen*2); if not SHA256Hash.WorkFinalToDigest(PassSHA256) then begin Result := false; _Trace('EncryptStream() - �н������� �ؽø� ������ ������ �߻��Ͽ����ϴ�.'); exit; end; if DesStream.Write(PassSHA256, SizeOf(PassSHA256)) <> SizeOf(PassSHA256) then begin Result := false; _Trace('EncryptStream() - �ؽ� ���� ����'); exit; end; end; end; WorkBeginEvent(SrcStream.Size); InitEncrypt; try Repeat nRead := SrcStream.Read(pBufIn, BUF_LEN_64K); pBufOut := EncryptBuffer(@pBufIn, nRead, SrcStream.Position = SrcStream.Size); nBufOutLen := Length(pBufOut); nWrite := DesStream.Write(pBufOut[0], nBufOutLen); if nBufOutLen <> nWrite then begin Result := false; _Trace('EncryptStream() - ��ȣȭ ���� ����'); exit; end; WorkEvent(DesStream.Size); Until nRead <> BUF_LEN_64K; finally FinalEncrypt; end; WorkEndEvent(DesStream.Size, SrcStream.Size); end; function TTgEncrypt.DecryptStream(SrcStream, DesStream: TStream; sSig: AnsiString = ''; aPassHash: TTgPassHash = phSha1): Boolean; var pBufIn: array[0..BUF_LEN_64K-1] of Byte; pBufOut: TBytes; nRead, nWrite, nBufOutLen: Integer; begin Result := true; if (sSig <> '') or (aPassHash <> phNone) then SrcStream.Position := 0; DesStream.Position := 0; if SrcStream.Size = 0 then begin Result := false; _Trace('DecryptStream() - ��ȣȭ �� �����Ͱ� �������� �ʽ��ϴ�.'); exit; end; if sSig <> '' then begin var nLen: Integer := Length(sSig); SetLength(pBufOut, nLen); SrcStream.Read(pBufOut[0], nLen); if not CompareMem(@pBufOut[0], @sSig[1], nLen) then begin _Trace('DecryptStream() - �ñ״�ó ���� �ٸ��ϴ�.'); Result := false; exit; end; end; case aPassHash of phNone : ; phSha1 : begin var PassSHA1: TSHA1Digest; var CheckPass: TSHA1Digest; var SHA1Hash: TSHA1Hash; var nPassLen: Integer := Length(sPass_); Guard(SHA1Hash, TSHA1Hash.Create); SHA1Hash.SetBuffer(PWideChar(sPass_), nPassLen*2); if not SHA1Hash.WorkFinalToDigest(PassSHA1) then begin Result := false; _Trace('DecryptStream() - �н������� �ؽø� ������ ������ �߻��Ͽ����ϴ�.'); exit; end; if SrcStream.Read(CheckPass, SizeOf(CheckPass)) <> SizeOf(CheckPass) then begin Result := false; _Trace('DecryptStream() - ��� ��Ƽ�� �б� ����.'); exit; end; if not CompareMem(@PassSHA1, @CheckPass, SizeOf(PassSHA1)) then begin Result := false; _Trace('DecryptStream() - Error Message'); exit; end; end; phSha256 : begin var PassSHA256: TSHA256Digest; var CheckPass: TSHA256Digest; var SHA256Hash: TSHA256Hash; var nPassLen: Integer := Length(sPass_); Guard(SHA256Hash, TSHA1Hash.Create); SHA256Hash.SetBuffer(PWideChar(sPass_), nPassLen*2); if not SHA256Hash.WorkFinalToDigest(PassSHA256) then begin Result := false; _Trace('DecryptStream() - �н������� �ؽø� ������ ������ �߻��Ͽ����ϴ�.'); exit; end; if SrcStream.Read(CheckPass, SizeOf(CheckPass)) <> SizeOf(CheckPass) then begin Result := false; _Trace('DecryptStream() - ��� ��Ƽ�� �б� ����.'); exit; end; if not CompareMem(@PassSHA256, @CheckPass, SizeOf(PassSHA256)) then begin Result := false; _Trace('DecryptStream() - Error Message'); exit; end; end; end; WorkBeginEvent(SrcStream.Size); InitDecrypt; try Repeat nRead := SrcStream.Read(pBufIn, BUF_LEN_64K); pBufOut := DecryptBuffer(@pBufIn, nRead, SrcStream.Position = SrcStream.Size); nBufOutLen := Length(pBufOut); nWrite := DesStream.Write(pBufOut[0], nBufOutLen); if nBufOutLen <> nWrite then begin Result := false; _Trace('DecryptStream() - ��ȣȭ ���� ����'); exit; end; WorkEvent(DesStream.Size); Until nRead <> BUF_LEN_64K; finally FinalDecrypt; end; WorkEndEvent(DesStream.Size, SrcStream.Size); SrcStream.Position := 0; DesStream.Position := 0; end; procedure TTgEncrypt.WorkBeginEvent(llMax: LONGLONG); begin if Assigned(evWorkBegin_) then evWorkBegin_(Self, llMax); end; procedure TTgEncrypt.WorkEndEvent(llPos, llMax: LONGLONG); begin if Assigned(evWorkEnd_) then evWorkEnd_(Self, llPos, llMax); end; procedure TTgEncrypt.WorkEvent(llPos: LONGLONG); begin if Assigned(evWork_) then evWork_(Self, llPos); end; procedure TTgEncrypt.SetPassword(const sPass: String); begin if sPass_ <> sPass then sPass_ := sPass; end; procedure TTgEncrypt.SetEncryptKind(aEncKind: TTgEncKind); begin if EncKind_ <> aEncKind then begin ClearAlgo; case aEncKind of ekNone : ; ekAes256cbc, ekAes192cbc, ekAes128cbc : begin case aEncKind of ekAes256cbc : nBit_ := 256; ekAes192cbc : nBit_ := 192; else nBit_ := 128; end; if sPass_ <> '' then begin if not StrKeyToBitPadding(sPass_, nBit_, AesKeyBuf_, cFillPassChar_) = nBit_ then begin EncKind_ := ekNone; exit; end; end; CopyMemory(@ABlk_, AesKeyBuf_, AESBLKSIZE); end; end; EncKind_ := aEncKind; end; end; procedure TTgEncrypt.ClearAlgo; begin // end; // test �ȵ� 22_0906 12:38:17 kku class function TTgEncrypt.CheckSign(aStream: TStream; sSign: AnsiString): Boolean; var nLen: Integer; pBuf: TBytes; begin Result := false; try nLen := Length(sSign); SetLength(pBuf, nLen); aStream.Position := 0; if aStream.Read(pBuf[0], nLen) <> nLen then exit; Result := CompareMem(@pBuf[0], @sSign[1], nLen); except on E: Exception do ETgException.TraceException(E, 'Fail .. CheckSign() .. 1', 5); end; end; class function TTgEncrypt.CheckSign(sPath: String; sSign: AnsiString): Boolean; var fs: TFileStream; begin Result := false; try Guard(fs, TFileStream.Create(sPath, fmOpenRead)); Result := CheckSign(fs, sSign); except {$IFDEF DEBUG} // �ǻ���� �αװ� �ʹ� ���� ���� on E: Exception do ETgException.TraceException(E, 'Fail .. CheckSign() .. 2', 5); {$ENDIF} end; end; function EncStrToBinStr(aEncAlgo: TTgEncKind; const sPass, sSrcStr: String): String; var enc: TTgEncrypt; pBuf: TBytes; nLen: Integer; begin Result := ''; nLen := Length(sSrcStr); if nLen > 0 then begin try Guard(enc, TTgEncrypt.Create(sPass, aEncAlgo)); pBuf := enc.EncryptBufferEx(@sSrcStr[1], nLen * 2); Result := ConvBytesToHexStr(PByte(pBuf), Length(pBuf)); except on E: Exception do ETgException.TraceException(E, 'Fail .. EncStrToBinStr() ...', 1); end; end; end; function DecBinStrToStr(aEncAlgo: TTgEncKind; const sPass, sSrcStr: String): String; var enc: TTgEncrypt; pBuf: TBytes; nLen: Integer; // sDec: String; begin Result := ''; try Guard(enc, TTgEncrypt.Create(sPass, aEncAlgo)); nLen := ConvHexStrToBytes(sSrcStr, pBuf); if nLen = 0 then exit; pBuf := enc.DecryptBufferEx(@pBuf[0], nLen); // nLen := Length(pBuf); // 복호화 길이와 실체 복호화된 버퍼의 길이가 다르다 Result := TEncoding.Unicode.GetString(pBuf); // sDec := StrPas(PChar(@pBuf[0])); // Result := Copy(sDec, 1, nLen div 2); except on E: Exception do ETgException.TraceException(E, 'Fail .. DecBinStrToStr() ...', 1); end; end; end.