diff --git a/.gitattributes b/.gitattributes
new file mode 100644
index 0000000..b24acd2
--- /dev/null
+++ b/.gitattributes
@@ -0,0 +1,41 @@
+# Conservative policy for an upstream-synced fork: do NOT globally normalise
+# (that would drift the fork from winddriver on every sync). Only force endings
+# where a wrong one breaks the file, and keep vendored/byte-exact files intact.
+
+# Scripts & CI — a wrong ending breaks these
+*.sh text eol=lf
+*.bat text eol=crlf
+*.cmd text eol=crlf
+*.ps1 text eol=crlf
+*.yml text eol=lf
+*.yaml text eol=lf
+
+# Vendored CnPack (GBK-encoded) + patches — never normalise; stay identical to source
+CnPack/** -text
+*.patch -text
+*.diff -text
+
+# Certs / keys — exact bytes
+*.crt binary
+*.cer binary
+*.der binary
+*.pem binary
+*.key binary
+*.pfx binary
+*.p12 binary
+
+# Binaries / build artifacts
+*.png binary
+*.jpg binary
+*.gif binary
+*.ico binary
+*.res binary
+*.dcr binary
+*.dcu binary
+*.dcp binary
+*.exe binary
+*.dll binary
+*.so binary
+*.dylib binary
+# NOTE: *.pas/.dpr/.inc/.dproj are intentionally NOT listed — left to core.autocrlf
+# so the fork stays byte-close to upstream after each sync.
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..5c8da91
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,83 @@
+modules/
+dist/
+static/
+**/Win32/
+**/Win64/
+**/Linux64/
+**/__history/
+**/__recovery/
+src/*.~*
+__history/
+__recovery/
+packages/Win32/
+packages/Win64/
+packages/Linux64/
+packages/dcu/
+packages/dcp/
+packages/bpl/
+*.res
+*.exe
+*.dll
+*.bpl
+*.bpi
+*.dcp
+*.bpl
+*.so
+*.apk
+*.drc
+*.map
+*.dres
+*.rsm
+*.tds
+*.dcu
+*.lib
+*.a
+*.o
+*.ocx
+*.local
+*.identcache
+*.projdata
+*.tvsconfig
+*.dsk
+*.dcu
+*.exe
+*.ico
+*.so
+*.~*
+*.a
+*.stat
+*.skincfg
+
+# Mac
+*.DS_Store
+
+#FPC/Laz
+lib/
+backup/
+*.lps
+
+# Code coverage reports
+**/console/
+**/vcl/
+dunitx-results.xml
+*.bak
+
+# Claude Code
+.claude/settings.local.json
+.claude.json
+CLAUDE.md
+
+# Delphi build output
+__history/
+__recovery/
+*.dcu
+*.exe
+*.dll
+*.bpl
+*.dcp
+*.local
+*.identcache
+*.tvsconfig
+*.dsk
+*.dproj.local
+*.dsv
diff --git a/CnPack/Common/CnConsts.pas b/CnPack/Common/CnConsts.pas
new file mode 100644
index 0000000..792eb93
--- /dev/null
+++ b/CnPack/Common/CnConsts.pas
@@ -0,0 +1,252 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnConsts;
+{* |
+================================================================================
+* ƣ
+* ԪƣԴַ嵥Ԫ
+* ԪߣCnPack
+* ע
+* ƽ̨PWin98SE + Delphi 5.0
+* ݲԣPWin9X/2000/XP + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2005.12.24 V1.0
+* ԪֲӢַ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+const
+ ECN_OK = 0; // OK
+
+ ECN_FILE_NOT_FOUND = $10; // ļ
+
+ ECN_CUSTOM_ERROR_BASE = $1000; // 趨Ĵʼֵ
+
+//==============================================================================
+// Strings DO NOT Localize:
+//==============================================================================
+
+resourcestring
+
+ // CnPack Reg Path
+ SCnPackRegPath = '\Software\CnPack';
+
+ // Tools Reg Path
+ SCnPackToolRegPath = 'CnTools';
+
+//==============================================================================
+// Strings to be Localized:
+//==============================================================================
+
+
+var
+ // Common Information
+ SCnHint: string = 'Hint';
+ SCnInformation: string = 'Information';
+ SCnWarning: string = 'Warning';
+ SCnError: string = 'Error';
+ SCnEnabled: string = 'Enabled';
+ SCnDisabled: string = 'Disabled';
+ SCnMsgDlgOK: string = '&OK';
+ SCnMsgDlgCancel: string = '&Cancel';
+ SCnMsgDlgYes: string = '&Yes';
+ SCnMsgDlgNo: string = '&No';
+ SCnMsgDlgYesToAll: string = 'Yes to &All';
+ SCnMsgDlgNoToAll: string = 'No to A&ll';
+ SCnVersion: string = 'Version';
+ SCnNeedAdmin: string = 'Maybe Need Administrator';
+ SCnNotSupport: string = 'Operation Not Supported';
+
+const
+ // CnPack Information
+ SCnPackAbout = 'CnPack';
+ SCnPackVer = 'Ver 0.1.8.0';
+ SCnPackStr = SCnPackAbout + ' ' + SCnPackVer;
+ SCnPackUrl = 'https://www.cnpack.org';
+ SCnPackBbsUrl = 'https://bbs.cnpack.org';
+ SCnPackNewsUrl = 'news://news.cnpack.org';
+ SCnPackSourceUrl = 'https://github.com/cnpack';
+ SCnPackEmail = 'master@cnpack.org';
+ SCnPackBugEmail = 'bugs@cnpack.org';
+ SCnPackSuggestionsEmail = 'suggestions@cnpack.org';
+
+ SCnPackDonationUrl = 'https://www.cnpack.org/donation.php';
+ SCnPackDonationUrlSF = 'http://sourceforge.net/donate/index.php?group_id=110999';
+ SCnPackGroup = 'CnPack Team';
+ SCnPackCopyright = '(C)Copyright 2001-2026 ' + SCnPackGroup;
+
+ // CnPropEditors
+ SCopyrightFmtStr =
+ SCnPackStr + #13#10#13#10 +
+ 'Component Name: %s' + #13#10 +
+ 'Author: %s(%s)' + #13#10 +
+ 'Comment: %s' + #13#10 +
+ 'HomePage: ' + SCnPackUrl + #13#10 +
+ 'Email: ' + SCnPackEmail + #13#10#13#10 +
+ SCnPackCopyright;
+
+resourcestring
+
+ // Component Palette Name
+ SCnNonVisualPalette = 'CnPack Tools';
+ SCnGraphicPalette = 'CnPack VCL';
+ SCnNetPalette = 'CnPack Net';
+ SCnDatabasePalette = 'CnPack DB';
+ SCnReportPalette = 'CnPack Report';
+
+ // CnPack Developers Added from Last.
+var
+ SCnPack_Team: string = 'CnPack Team';
+ SCnPack_Zjy: string = 'Zhou JingYu';
+ SCnPack_Shenloqi: string = 'Chinbo';
+ SCnPack_xiaolv: string = 'xiaolv';
+ SCnPack_Flier: string = 'Flier Lu';
+ SCnPack_LiuXiao: string = 'Liu Xiao';
+ SCnPack_PanYing: string = 'Pan Ying';
+ SCnPack_Hubdog: string = 'Hubdog';
+ SCnPack_Wyb_star: string = 'wyb_star';
+ SCnPack_Licwing: string = 'Licwing zue';
+ SCnPack_Alan: string = 'Alan';
+ SCnPack_GuYueChunQiu: string = 'GuYueChunQiu';
+ SCnPack_Aimingoo: string = 'Aimingoo';
+ SCnPack_QSoft: string = 'QSoft';
+ SCnPack_Hospitality: string = 'ZhangJiongXuan (Hospitality)';
+ SCnPack_SQuall: string = 'SQUALL';
+ SCnPack_Hhha: string = 'Hhha';
+ SCnPack_Beta: string = 'beta';
+ SCnPack_Leeon: string = 'Leeon';
+ SCnPack_SuperYoyoNc: string = 'SuperYoyoNC';
+ SCnPack_JohnsonZhong: string = 'Johnson Zhong';
+ SCnPack_DragonPC: string = 'Dragon P.C.';
+ SCnPack_Kendling: string = 'Kending';
+ SCnPack_ccrun: string = 'ccrun';
+ SCnPack_Dingbaosheng: string = 'dingbaosheng';
+ SCnPack_LuXiaoban: string = 'Zhou Yibo(Lu Xiaoban)';
+ SCnPack_Savetime: string = 'savetime';
+ SCnPack_solokey: string = 'solokey';
+ SCnPack_Bahamut: string = 'Bahamut';
+ SCnPack_Sesame: string = 'Sesame';
+ SCnPack_BuDeXian: string = 'BuDeXian';
+ SCnPack_XiaoXia: string = 'Summer';
+ SCnPack_ZiMin: string = 'ZiMin';
+ SCnPack_rarnu: string = 'rarnu';
+ SCnPack_dejoy: string = 'dejoy';
+ SCnPack_Rain: string = 'Rain';
+ SCnPack_cnwinds: string = 'cnwinds';
+
+ // CnCommon
+ SUnknowError: string = 'Unknow error';
+ SErrorCode: string = 'Error code:';
+
+const
+ SCnPack_TeamEmail = 'master@cnpack.org';
+ SCnPack_ZjyEmail = 'zjy@cnpack.org';
+ SCnPack_ShenloqiEmail = 'Shenloqi@hotmail.com';
+ SCnPack_xiaolvEmail = 'xiaolv888@etang.com';
+ SCnPack_FlierEmail = 'flier_lu@sina.com';
+ SCnPack_LiuXiaoEmail = 'liuxiao@cnpack.org';
+ SCnPack_PanYingEmail = 'panying@sina.com';
+ SCnPack_HubdogEmail = 'hubdog@263.net';
+ SCnPack_Wyb_starMail = 'wyb_star@sina.com';
+ SCnPack_LicwingEmail = 'licwing@chinasystemsn.com';
+ SCnPack_AlanEmail = 'BeyondStudio@163.com';
+ SCnPack_GuYueChunQiuEmail = 'guyuechunqiu@cnpack.org';
+ SCnPack_AimingooEmail = 'aim@263.net';
+ SCnPack_QSoftEmail = 'hq.com@263.net';
+ SCnPack_HospitalityEmail = 'Hospitality_ZJX@msn.com';
+ SCnPack_SQuallEmail = 'squall_sa@163.com';
+ SCnPack_HhhaEmail = 'Hhha@eyou.com';
+ SCnPack_BetaEmail = 'beta@01cn.net';
+ SCnPack_LeeonEmail = 'real-like@163.com';
+ SCnPack_SuperYoyoNcEmail = 'superyoyonc@sohu.com';
+ SCnPack_JohnsonZhongEmail = 'zhongs@tom.com';
+ SCnPack_DragonPCEmail = 'dragonpc@21cn.com';
+ SCnPack_KendlingEmail = 'kendling@21cn.com';
+ SCnPack_ccRunEmail = 'info@ccrun.com';
+ SCnPack_DingbaoshengEmail = 'yzdbs@msn.com';
+ SCnPack_LuXiaobanEmail = 'zhouyibo2000@sina.com';
+ SCnPack_SavetimeEmail = 'savetime2k@hotmail.com';
+ SCnPack_solokeyEmail = 'crh611@163.com';
+ SCnPack_BahamutEmail = 'fantasyfinal@126.com';
+ SCnPack_SesameEmail = 'sesamehch@163.com';
+ SCnPack_BuDeXianEmail = 'appleak46@yahoo.com.cn';
+ SCnPack_XiaoXiaEmail = 'summercore@163.com';
+ SCnPack_ZiMinEmail = '441414288@qq.com';
+ SCnPack_rarnuEmail = 'rarnu@cnpack.org';
+ SCnPack_dejoyEmail = 'dejoybbs@163.com';
+ SCnPack_RainEmail = SCnPack_TeamEmail; // Emailÿ
+ SCnPack_cnwindsEmail = SCnPack_TeamEmail;
+
+ // CnMemProf
+ SCnPackMemMgr = 'CnMemProf';
+ SMemLeakDlgReport = 'Found %d memory leaks. [There are %d allocated before replace memory manager.]';
+ SMemMgrODSReport = 'Get = %d Free = %d Realloc = %d';
+ SMemMgrOverflow = 'Memory Manager''s list capability overflow, Please enlarge it!';
+ SMemMgrRunTime = '%d hour(s) %d minute(s) %d second(s)';
+ SOldAllocMemCount = 'There are %d allocated before replace memory manager.';
+ SAppRunTime = 'Application total run time: ';
+ SMemSpaceCanUse = 'HeapStatus.TotalAddrSpace: %d KB';
+ SUncommittedSpace = 'HeapStatus.TotalUncommitted: %d KB';
+ SCommittedSpace = 'HeapStatus.TotalCommitted: %d KB';
+ SFreeSpace = 'HeapStatus.TotalFree: %d KB';
+ SAllocatedSpace = 'HeapStatus.TotalAllocated: %d KB';
+ SAllocatedSpacePercent = 'TotalAllocated div TotalAddrSpace: %d%%';
+ SFreeSmallSpace = 'HeapStatus.FreeSmall: %d KB';
+ SFreeBigSpace = 'HeapStatus.FreeBig: %d KB';
+ SUnusedSpace = 'HeapStatus.Unused: %d KB';
+ SOverheadSpace = 'HeapStatus.Overhead: %d KB';
+ SObjectCountInMemory = 'Objects count in memory: ';
+ SNoMemLeak = ' No memory leak.';
+ SNoName = '(no name)';
+ SNotAnObject = ' Not an object';
+ SByte = 'Byte';
+ SCommaString = ',';
+ SPeriodString = '.';
+
+resourcestring
+ SCnErrorMapViewOfFile = 'MapViewOfFile Failed. ';
+ SCnErrorCreateFileMapping = 'CreateFileMapping Failed. ';
+
+function CnGetLastError: Integer;
+
+procedure _CnSetLastError(Err: Integer);
+
+implementation
+
+threadvar
+ CnErrorCode: Integer;
+
+function CnGetLastError: Integer;
+begin
+ Result := CnErrorCode;
+end;
+
+procedure _CnSetLastError(Err: Integer);
+begin
+ CnErrorCode := Err;
+end;
+
+end.
+
diff --git a/CnPack/Common/CnFloat.pas b/CnPack/Common/CnFloat.pas
new file mode 100644
index 0000000..c1df9ab
--- /dev/null
+++ b/CnPack/Common/CnFloat.pas
@@ -0,0 +1,1528 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnFloat;
+{* |
+================================================================================
+* ƣ
+* ԪƣתԪ
+* ԪߣǬԪ(wqyfavor@163.com)
+* עõԪʵ˵ȡ˫ȡչȸĽת
+*
+* ע Extended ֻ Win32 10 ֽڣMacOS/Linux x64 ¾ 16 ֽڣWin64 ARM ƽ̨ 8 ֽ
+* ңMacOS64 µ 16 ֽչȲ IEEE 754-2008 й涨 Quadruple ʽǰ 10 ֽڽضϣ
+* ڲṹͬ Win32 µչ 10 ֽڡ
+*
+* ƽ̨WinXP + Delphi 2009
+* ݲԣDelphi 2007 Extended ֻ֧Сģʽ
+* õԪеַϱػʽ
+* ļ¼2023.01.13
+* ݴ Win64 Extended 8 ֽ Double 10 ֽչȵ
+* ݴ MacOS64/Linux64 µ 16 ֽ Extendedֻضϴǰ 10 ֽڣ
+* 2022.02.17
+* FPC ı֧֣
+* 2021.09.05
+* תΪ UInt64֧ UInt64 Int64 棩ĺ
+* 2020.11.11
+* UInt64֧ UInt64 Int64 棩תΪĺ
+* 2020.06.24
+* ƴյĺ
+* 2009.1.12
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes, SysConst, {$IFDEF MSWINDOWS} Windows, {$ENDIF} CnNative;
+
+{
+ IEEE 754 涨ָʽЧڵλ 0
+
+ Single 1 λ S8 λָ E23 λЧ M 24 λ 1 4 ֽ 32 λ
+ ˫ Double 1 λ S11 λָ E52 λЧ M 53 λ 1 8 ֽ 64 λ
+ չ˫ Extended 1 λ S15 λָ E64 λЧ M 64 λʽ 1 10 ֽ 80 λ
+
+ IEEE 754-2008
+ ı Quadruple 1 λ S15 λָ E112 λЧ M 16 ֽ 128 λ
+ ˱ Octuple 1 λ S19 λָ E236 λЧ M 32 ֽ 256 λ
+
+ Уλ S0 ʾ1 ʾE Ҫȥ 127/1023/16383/16383 ָ
+ M: 淶/˫ȵĶ M ĸλӸ 1. Чչӣ 1.
+ ֵЧ 1.xxxx ʽ 2 E ηעⲻ 10 E η
+
+ S λX ָM ЧֵʵֵΪ滯˲ҿС㣩
+
+ ʽ ֽ 1 ֽ 2 ֽ 3 ֽ 4 ... ֽ nÿֽڵұߵλ 0
+
+ 4 SXXXXXXX XMMMMMMM MMMMMMMM MMMMMMMM
+ 01000110 00011100 01000000 00000000
+ 4 6 1 C 4 0 0 0 ڴΪСˣȫֵʵֵ 10000
+ Ϊ 0 10001100 00111000100000000000000
+ S0X140Ҫȥ 127 õʵ 13Mԭʼֵ 1C4000
+ λ 1 С㣬õ 100111000100000000000000 ΪʵЧ֣ʵֵ 1.001110001
+ ʵֵ1.001110001 13 λõʮ 2710.00Сȫ 0ʮ 10000 ʵʽ
+
+ ˫ 8 SXXXXXXX XXXXMMMM MMMMMMMM MMMMMMMM ... MMMMMMMM
+ 01000000 11000011 10001000 0000000000000000000000000000000000000000
+ 4 0 C 3 8 8 0 0 ڴΪСˣȫֵʵֵ 10000
+ Ϊ 0 10000001100 0011100010000000000000000000000000000000000000000000
+ S0X1036Ҫȥ 1023 õʵ 13Mԭʼֵ 3 88 00 00 00 00 00
+ λ 1 Сõ 10011100010000000000000000000000000000000000000000000 ΪʵЧ֣ʵֵ 1.001110001
+ ʵֵ1.001110001 13 λõʮ 2710.00Сȫ 0ʮ 10000 ʵʽ
+
+ չ˫ 10 SXXXXXXX XXXXXXXX 1MMMMMMM MMMMMMMM ... MMMMMMMM // עЧְ 1ʡ 1
+ 01000000 00001100 10011100 01000000 ...
+ 4 0 0 C 9 C 4 0 ڴΪСˣȫֵʵֵ 10000
+ Ϊ 0 100000000001100 1001110000100000 ...
+ S0X16396Ҫȥ 16383 õʵ 13Mԭʼֵ 9C 40 00 ...
+ λö 1ֻҪСõ 10011100 01000000 ... ΪʵЧ֣ʵֵ 1.001110001
+ ʵֵ1.001110001 13 λõʮ 2710.00Сȫ 0ʮ 10000 ʵʽ
+
+ ı 16 SXXXXXXX XXXXXXXX MMMMMMMM MMMMMMMM ... MMMMMMMM
+ ˱ 32 SXXXXXXX XXXXXXXX XXXXMMMM MMMMMMMM ... MMMMMMMM
+
+ ע⣺Little Endian ϣֽ 1 n Ԫѵ
+
+ 0ȫ 0
+ -0ȫ 0 λΪ 1
+ ָȫ 1Чȫ 0 0 1
+}
+
+type
+ TCnQuadruple = packed record
+ {* Delphi ıͣýṹָ}
+ Lo: TUInt64;
+ Hi0: Cardinal;
+ case Boolean of
+ True: (Hi1: Cardinal);
+ False: (W0, W1: Word); // С˻ϣźָ W1
+ end;
+ PCnQuadruple = ^TCnQuadruple;
+ {* ָıȽṹָ}
+
+ TCnOctuple = packed record
+ {* Delphi ް˱ͣ Int64 ָ棬}
+ F0: Int64;
+ F1: Int64;
+ F2: Int64;
+ F3: Int64;
+ end;
+ PCnOctuple = ^TCnOctuple;
+ {* ָ˱Ƚṹָ}
+
+ ECnFloatSizeError = class(Exception);
+ {* 쳣}
+
+const
+ CN_EXTENDED_SIZE_8 = 8;
+ {* Win64 µ Extended ͵ijȣֻ 8 ֽ}
+
+ CN_EXTENDED_SIZE_10 = 10;
+ {* Win32 µ Extended ͵ijȣDZ 10 ֽ}
+
+ CN_EXTENDED_SIZE_16 = 16;
+ {* MACOS64/Linux64 µ Extended ͵ijȣ 16 ֽ}
+
+ CN_SIGN_SINGLE_MASK = $80000000;
+ {* ȸķλ}
+
+ CN_SIGN_DOUBLE_MASK = $8000000000000000;
+ {* ˫ȸķλ}
+
+ CN_SIGN_EXTENDED_MASK = $8000;
+ {* չȸķλ룬Ѿȥ 8 ֽЧ}
+
+ CN_SIGN_QUADRUPLE_MASK = $80000000;
+ {* ıȸķλ룬ֻǰֽڣȥ˺}
+
+ CN_EXPONENT_SINGLE_MASK = $7F800000;
+ {* ȸָ룬Ҫ 23 λ}
+
+ CN_EXPONENT_DOUBLE_MASK = $7FF0000000000000;
+ {* ˫ȸָ룬Ҫ 52 λ}
+
+ CN_EXPONENT_EXTENDED_MASK = $7FFF;
+ {* չȸָ룬ȥ 8 ֽЧ}
+
+ CN_EXPONENT_QUADRUPLE_MASK = $7FFF;
+ {* ıȸָ룬ȥ 14 ֽЧ}
+
+ CN_SIGNIFICAND_SINGLE_MASK = $007FFFFF;
+ {* ȸЧ룬 23 λ}
+
+ CN_SIGNIFICAND_DOUBLE_MASK = $000FFFFFFFFFFFFF;
+ {* ˫ȸЧ룬 52 λ}
+
+ CN_SIGNIFICAND_EXTENDED_MASK = $FFFFFFFFFFFFFFFF;
+ {* չȸЧ룬 64 λʵȫ 8 ֽ}
+
+ CN_SIGNIFICAND_QUADRUPLE_MASK = $FFFF;
+ {* ıȸЧ룬ֻǰֽڣмϺ}
+
+ CN_SINGLE_SIGNIFICAND_BITLENGTH = 23;
+ {* ȸЧλ}
+
+ CN_DOUBLE_SIGNIFICAND_BITLENGTH = 52;
+ {* ˫ȸЧλ}
+
+ CN_EXTENDED_SIGNIFICAND_BITLENGTH = 63;
+ {* չȸЧλ}
+
+ CN_EXPONENT_OFFSET_SINGLE = 127;
+ {* ȸָƫֵʵֵָҪϸֵܴ뵥ȸָ}
+
+ CN_EXPONENT_OFFSET_DOUBLE = 1023;
+ {* ˫ȸָƫֵʵֵָҪϸֵܴ˫ȸָ}
+
+ CN_EXPONENT_OFFSET_EXTENDED = 16383;
+ {* չȸָƫֵʵֵָҪϸֵܴչȸָ10 16 ֽչȸΪֵ}
+
+ // Max ָȫ 1 Σ
+ CN_SINGLE_MIN_EXPONENT = -127;
+ {* ȸСָ}
+
+ CN_SINGLE_MAX_EXPONENT = 127;
+ {* ȸָ}
+
+ CN_DOUBLE_MIN_EXPONENT = -1023;
+ {* ˫ȸСָ}
+
+ CN_DOUBLE_MAX_EXPONENT = 1023;
+ {* ˫ȸָ}
+
+ CN_EXTENDED_MIN_EXPONENT = -16383;
+ {* չȸСָ}
+
+ CN_EXTENDED_MAX_EXPONENT = 16383;
+ {* չȸָ}
+
+procedure ExtractFloatSingle(Value: Single; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: Cardinal);
+{* ӵȸнλָλ 1 ȥСЧ֡
+ ע⣺ָΪʵָЧΪ 24 λԭʼΪ 0~22 λ 23 λΪȥ 1
+
+
+ Value: Single - ĵȸ
+ out SignNegative: Boolean - λTrue Ϊ
+ out Exponent: Integer - ָ
+ out Mantissa: Cardinal - Ч
+
+ ֵޣ
+}
+
+procedure ExtractFloatDouble(Value: Double; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: TUInt64);
+{* ˫ȸнλָλ 1 ȥСЧ֡
+ ע⣺ָΪʵָЧΪ 53 λԭʼΪ 0~51 λ 52 λΪȥ 1
+
+
+ Value: Double - ˫ȸ
+ out SignNegative: Boolean - λTrue Ϊ
+ out Exponent: Integer - ָ
+ out Mantissa: TUInt64 - Ч
+
+ ֵޣ
+}
+
+procedure ExtractFloatExtended(Value: Extended; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: TUInt64); overload;
+{* չȸнλָȥСЧ֣֧ 8 ֽڡ10 ֽڡ
+ Լ 16 ֽڽضΪ 10 ֽڵ Extended ʽúʵƽ̨ Extended ߴ硣
+ ע⣺ָΪʵָЧΪȫ 64 λλ 63 λΪԴ 1
+
+
+ Value: Extended - չȸ
+ out SignNegative: Boolean - λTrue Ϊ
+ out Exponent: Integer - ָ
+ out Mantissa: TUInt64 - Ч
+
+ ֵޣ
+}
+
+procedure ExtractFloatExtended(ValueAddr: Pointer; ExtendedSize: Integer;
+ out SignNegative: Boolean; out Exponent: Integer; out Mantissa: TUInt64); overload;
+{* ӲȵչȸڵַнλָȥСЧ֣֧ 8 ֽڡ10 ֽڡ
+ Լ 16 ֽڽضΪ 10 ֽڵ Extended ʽúʵ뱾ƽ̨ Extended ߴء
+ ע⣺ָΪʵָЧΪȫ 64 λλ 63 λΪԴ 1
+
+
+ ValueAddr: Pointer - չȸڵַ
+ ExtendedSize: Integer - չȵĴСֻ֧ 81016 ֵ
+ out SignNegative: Boolean - λTrue Ϊ
+ out Exponent: Integer - ָ
+ out Mantissa: TUInt64 - Ч
+
+ ֵޣ
+}
+
+procedure ExtractFloatQuadruple(Value: Extended; out SignNegative: Boolean;
+ out Exponent: Integer; out MantissaLo: TUInt64; out MantissaHi: TUInt64);
+{* ʮֽھȸнλָȥСЧֻ֣ Extended Ϊ 16 ֽ
+ Ҹʽ IEEE 754-2008 ıȸʱЧĿǰ Delphi ָ֧øʽ
+ ע⣺ָΪʵָЧ 112 λΪߵ֣ԭʼΪ 0~110 λ 111 λΪȥ 1
+
+
+ Value: Extended - ʮֽھȸ
+ out SignNegative: Boolean - λTrue Ϊ
+ out Exponent: Integer - ָ
+ out MantissaLo: TUInt64 - Чֵ 64 λ
+ out MantissaHi: TUInt64 - Чָ 64 λ
+
+ ֵޣ
+}
+
+procedure CombineFloatSingle(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: Cardinal; var Value: Single);
+{* ѷλָЧƴɵȸҪЧΪ滯ģҲ 24 λλΪ 1
+
+
+ SignNegative: Boolean - λTrue Ϊ
+ Exponent: Integer - ָ
+ Mantissa: Cardinal - Ч֣ 24 λЧ
+ var Value: Single - ϵĵȸ
+
+ ֵޣ
+}
+
+procedure CombineFloatDouble(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; var Value: Double);
+{* ѷλָЧƴ˫ȸҪЧΪ滯ģҲ 53 λλΪ 1
+
+
+ SignNegative: Boolean - λTrue Ϊ
+ Exponent: Integer - ָ
+ Mantissa: TUInt64 - Ч֣ 53 λЧ
+ var Value: Double - ϵ˫ȸ
+
+ ֵޣ
+}
+
+procedure CombineFloatExtended(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; var Value: Extended); overload;
+{* ѷλָЧƴչȸ֧ 10 ֽڡ
+ Լ 16 ֽڽضΪ 10 ֽڵ Extended ʽúʵƽ̨ Extended ߴ硣
+ ҪЧΪ滯ģҲ 64 λλΪ 1
+
+
+ SignNegative: Boolean - λTrue Ϊ
+ Exponent: Integer - ָ
+ Mantissa: TUInt64 - Ч֣64 λȫЧ
+ var Value: Extended - ϵչȸ
+
+ ֵޣ
+}
+
+procedure CombineFloatExtended(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; ValueAddr: Pointer; ExtendedSize: Integer); overload;
+{* ѷλָЧƴչȸ֧ 10 ֽڡ
+ Լ 16 ֽڽضΪ 10 ֽڵ Extended ʽúʵ뱾ƽ̨ Extended ߴء
+ ҪЧΪ滯ģҲ 64 λλΪ 1
+
+
+ SignNegative: Boolean - λTrue Ϊ
+ Exponent: Integer - ָ
+ Mantissa: TUInt64 - Ч֣64 λȫЧ
+ ValueAddr: Pointer - ϵչȸĵַ
+ ExtendedSize: Integer - չȵĴСֻ֧ 81016 ֵ
+
+ ֵޣ
+}
+
+procedure CombineFloatQuadruple(SignNegative: Boolean; Exponent: Integer;
+ MantissaLo: TUInt64; MantissaHi: TUInt64; var Value: Extended);
+{* ѷλָЧƴչȸֻ Extended Ϊ 16 ֽ
+ Ҹʽ IEEE 754-2008 ıȸʱЧĿǰ Delphi ָ֧øʽ
+ ҪЧΪ滯ģҲ 112 λλΪ 1
+
+
+ SignNegative: Boolean - λTrue Ϊ
+ Exponent: Integer - ָ
+ MantissaLo: TUInt64 - Чֵ 64 λ64 λȫЧ
+ MantissaHi: TUInt64 - Чָ 64 λ 48 λЧ
+ var Value: Extended - ϵʮֽھȸ
+
+ ֵޣ
+}
+
+function UInt64ToSingle(U: TUInt64): Single;
+{* Int64 зģ 64 λֵ Singleʵͬ
+
+
+ U: TUInt64 - ֵ 64 λֵ
+
+ ֵSingle - صĵȸ
+}
+
+function UInt64ToDouble(U: TUInt64): Double;
+{* Int64 зģ 64 λֵ Doubleʵͬ
+
+
+ U: TUInt64 - ֵ 64 λֵ
+
+ ֵDouble - ص˫ȸ
+}
+
+function UInt64ToExtended(U: TUInt64): Extended;
+{* Int64 зģ 64 λֵ Extendedʵͬ
+
+
+ U: TUInt64 - ֵ 64 λֵ
+
+ ֵExtended - صչȸ
+}
+
+function SingleToUInt64(F: Single): TUInt64;
+{* Single ֵ Int64 зģ 64 λͣʵͬ
+
+
+ F: Single - ֵĵȸ
+
+ ֵTUInt64 - ص 64 λֵ
+}
+
+function DoubleToUInt64(F: Double): TUInt64;
+{* Double ֵ Int64 зģ 64 λͣʵͬ
+
+
+ F: Double - ֵ˫ȸ
+
+ ֵTUInt64 - ص 64 λֵ
+}
+
+function ExtendedToUInt64(F: Extended): TUInt64;
+{* Extended ֵ Int64 зģ 64 λͣʵͬ
+
+
+ F: Extended - ֵ˫ȸ
+
+ ֵTUInt64 - ص 64 λֵ
+}
+
+function SingleIsInfinite(AValue: Single): Boolean;
+{* ȸǷ
+
+
+ AValue: Single - жϵĵȸ
+
+ ֵBoolean - Ƿ
+}
+
+function DoubleIsInfinite(AValue: Double): Boolean;
+{* ˫ȸǷ
+
+
+ AValue: Double - жϵ˫ȸ
+
+ ֵBoolean - Ƿ
+}
+
+function ExtendedIsInfinite(AValue: Extended): Boolean;
+{* չȸǷ
+
+
+ AValue: Extended - жϵչȸ
+
+ ֵBoolean - Ƿ
+}
+
+function SingleIsNan(AValue: Single): Boolean;
+{* ȸǷʵ
+
+
+ AValue: Single - жϵĵȸ
+
+ ֵBoolean - Ƿʵ
+}
+
+function DoubleIsNan(AValue: Double): Boolean;
+{* ˫ȸǷʵ
+
+
+ AValue: Double - жϵ˫ȸ
+
+ ֵBoolean - Ƿʵ
+}
+
+function ExtendedIsNan(AValue: Extended): Boolean;
+{* չȸǷʵ
+
+
+ AValue: Extended - жϵչȸ
+
+ ֵBoolean - Ƿʵ
+}
+
+function ExtendedToStr(AValue: Extended): string;
+{* չȸתΪַ֧ľȡ
+ Delphi Ĭ 15 λС 18Ҳ֧ 1234567899876543.21
+
+
+ AValue: Extended - жϵչȸ
+
+ ֵstring - ת
+}
+
+// FPCWindows 64/Linux 64 ƽ̨Լ Delphi 56 ֧
+{$IFDEF WIN32}
+{$IFDEF COMPILER7_UP}
+{
+ ˴ʵ Extended תΪˡʮַĺ
+ 㷨Ƕȡ Extended ڴеĶݽת Extended ͵˵
+ ԲοϡDouble Single Ϊϵͳֵ֧ͨĸͣ Delphi е
+ Extended ڴ洢ʽвͬ߾β Double Single β
+ Ĭϵ 1βΪ 1.001 Double Single д洢Ϊ 001ȥ
+ Сǰ 1 Extended 洢Ϊ 1001
+ NaN Ϊ "not a number"Ǹο Math.pas Ԫеij NaN
+ Infinity Ϊο Math.pas Ԫеij Infinity NegInfinity.
+ һ DecimalExp AlwaysUseExponent
+ ʮƸתʱָʽѧ㷨Щ
+ Ҳָֻʽ 1E-1000ָʱ 0.0000000...0001תָ
+ ҲӦӦƱʾʱʮƱʾָ֣ƴ
+ 1.001E101ֵΪ 100100ָʮƱһЩ 1.001D5ʾС
+ 5 λDecimalExp ָǷʮƱֵָġע⣬ʮ
+ ʾָ涨ʹ "D" ʾ"E" ΪӦƱʾ⣬
+ ʮƱȽ⣬"D" "E" ΪʮַʮƱʱʹ "^"
+ ַ 3.BD^D(12)A.BD^E(ABCE)粻ϲָʽġ
+ AlwaysUseExponent ָǷһÿѧ 100.111 λȽ٣
+ ԶжϲҪʹÿѧ AlwaysUseExponent ΪʱһΪָ
+ ʽ 1.00111E2
+ const
+ MaxBinDigits = 120;
+ MaxHexDigits = 30;
+ MaxOctDigits = 40;
+ ָλʱһʹÿѧ
+}
+
+{ FloatDecimalToBinExtended, FloatDecimalToOctExtendedFloatDecimalToHexExtended
+ FloatDecimalToBinaryExtended ̣FloatDecimalToBinaryExtended }
+
+function FloatDecimalToBinExtended(fIn: Extended; DecimalExp: Boolean;
+ AlwaysUseExponent: Boolean): AnsiString; deprecated; // Convert to binary
+
+function FloatDecimalToOctExtended(fIn: Extended; DecimalExp: Boolean;
+ AlwaysUseExponent: Boolean): AnsiString; deprecated; // Convert to octal
+
+function FloatDecimalToHexExtended(fIn: Extended; DecimalExp: Boolean;
+ AlwaysUseExponent: Boolean): AnsiString; deprecated; // Convert to hexdecimal
+
+{$ENDIF}
+{$ENDIF}
+
+implementation
+
+const
+ UINT64_EXTENDED_EXP_MAX = $4040; // UINT64 Ӧ Extended ָ
+
+resourcestring
+ SCnErrorExtendedSizeFmt = 'Extended Size Error %d';
+
+type
+ TExtendedRec10 = packed record
+ {* 10 ֽڵչȸֻ Win32 Ч}
+ Mantissa: TUInt64;
+ ExpSign: Word;
+ end;
+ PExtendedRec10 = ^TExtendedRec10;
+
+{$IFDEF WIN32}
+{$IFDEF COMPILER7_UP}
+
+type
+ PConvertFloatSystem = ^TConvertFloatSystem;
+ TConvertFloatSystem = record
+ Negative: Boolean;
+ ExpFlag, ExponentI: Integer;
+ end;
+
+const
+ MaxBinDigits = 120;
+ MaxHexDigits = 30;
+ MaxOctDigits = 40;
+
+function FloatDecimalToBinaryExtended(fIn: Extended; DecimalExp,
+ AlwaysUseExponent: Boolean; var ForHexOct: PConvertFloatSystem): AnsiString;
+var
+ Neg: Boolean;
+ i, Flag, IntExp: Integer;
+ Exp: AnsiString;
+label UseExponent;
+begin
+{
+Extended(32.125) in memory:
+0 100000000000100 10000000 10000000 00000000 00000000 00000000 00000000 00000000 00000000
+ 9 8 7 6 5 4 3 2nd Byte 1stByte 0
+sign exponent digits
+0 111111111111111 1000000000000000000000000000000000000000000000000000000000000000 + Inf
+1 111111111111111 1000000000000000000000000000000000000000000000000000000000000000 - Inf
+1 111111111111111 1100000000000000000000000000000000000000000000000000000000000000 Nan
+0 111111111111111 1100000000000000000000000000000000000000000000000000000000000000 -Nan
+}
+ SetLength(Result, 255);
+ SetLength(Exp, 2 * SizeOf(Extended) + 1);
+ Neg := False;
+ asm
+ push EBX
+ push ESI
+ mov EBX, Result // Address of Result
+ mov EBX, [EBX]
+ mov EAX, 0
+ // Test if fIN equals 0
+ lea ESI, fIn[7] // get the first byte of digits
+ mov AL, [ESI]
+ test AL, 128 // 10000000B
+ jz @Zero
+ mov ECX, 0
+ lea ESI, fIn[8]
+ mov AX, [ESI] // Get first two bytes
+ test AX, 32768 // 32768D = 1000000000000000B
+ jz @Positive
+ mov Neg, 1
+ sub AX, 32768 // Sign bit <- 0
+ @Positive:
+ // Test if fIn is NaN or Infinity
+ cmp AX, 32767
+ jnz @NotNAN_INF
+ mov DL, [ESI - 1]
+ test DL, 64 // 01000000B
+ jz @INF
+ mov Flag, 4 // NaN
+ jmp @Done
+ @INF:
+ mov Flag, 3 // INF
+ jmp @Done
+ @NotNAN_INF:
+ sub AX, 16383 // AX = AX - 011111111111111B
+ jns @ExpPositive
+ sub AX, 1
+ not AX
+ mov Flag, 2 // // Exponent sign negative
+ jmp @JudgeDecimalExp
+ @ExpPositive:
+ mov Flag, 1 // Exponent sign positive
+ @JudgeDecimalExp:
+ mov IntExp, EAX
+ cmp DecimalExp, 1
+ je @MoveDigits
+ // Binary string exponent. Convert AX to binary string and store it in Exp
+ lea EBX, Exp
+ mov EBX, [EBX]
+ push ECX
+ mov [EBX], 69 // 'E' // "D" for decimal exponent
+ mov ECX, 1
+ cmp Flag, 2
+ jnz @NoNegativeInExp
+ mov [EBX + 1], 45 // '-' // Add a "-" to exponent string
+ mov ECX, 2
+ @NoNegativeInExp:
+ mov ESI, 0 // flag whehter "1" appears
+ // Move exponent digits to Exp
+ mov DX, 32768 // 1000000000000000
+ @NextExpDigit:
+ test AX, DX
+ jz @AppendExp0
+ mov [EBX + ECX], 49 // '1'
+ mov ESI, 1
+ jmp @NextExpIncECX
+ @AppendExp0:
+ cmp ESI, 0
+ jz @NextExpNoIncECX // do not append this "0"
+ mov [EBX + ECX], 48 // '0'
+ @NextExpIncECX:
+ inc ECX
+ @NextExpNoIncECX:
+ shr DX, 1
+ cmp DX, 0
+ jne @NextExpDigit
+ pop ECX
+ mov EBX, Result
+ mov EBX, [EBX]
+ jmp @MoveDigits
+ @MoveDigits:
+ // Move digits to Result
+ mov ESI, 8
+ @NextByte:
+ dec ESI
+ mov EAX, EBX
+ lea EBX, fIn[ESI]
+ mov DL, [EBX]
+ mov EBX, EAX
+ mov AL, 128 // 10000000
+ @NextDigit:
+ test DL, AL
+ jz @Append0
+ mov [EBX + ECX], 49 // '1'
+ mov i, ECX
+ jmp @Next
+ @Append0:
+ mov [EBX + ECX], 48 // '0'
+ @Next:
+ inc ECX
+ shr AL, 1
+ cmp AL, 0
+ jne @NextDigit
+ cmp ESI, 0 // if the last byte
+ jne @NextByte
+ jmp @Done
+ @Zero:
+ mov Flag, 0
+ @Done:
+ pop ESI
+ pop EBX
+ end;
+ case Flag of
+ 0:
+ begin
+ ForHexOct := nil;
+ Result := '0';
+ Exit;
+ end;
+ 1, 2:
+ begin
+ // Delete redundant "0" in Result
+ Delete(Result, i + 2, MaxInt); // i stores the position of the last 1 in Result
+ if Assigned(ForHexOct) then
+ begin
+ // Copy to ForHexOct
+ with ForHexOct^ do
+ begin
+ Negative := Neg;
+ ExpFlag := Flag;
+ ExponentI := IntExp;
+ end;
+ Exit;
+ end;
+ // Add dot and exponent to Result
+ if (IntExp = 0) then
+ begin
+ if (Length(Result) > 1) then
+ Insert('.', Result, 2);
+ end
+ else
+ begin
+ { Decide whether use exponent. For example "1000.101" shouldn't be output
+ as 1.000101E11 when AlwaysUseExponent is False. }
+ if AlwaysUseExponent then
+ begin
+UseExponent:
+ if DecimalExp then
+ if Flag = 1 then
+ Exp := 'D' + {$IFDEF UNICODE}AnsiString{$ENDIF}(IntToStr(IntExp))
+ else
+ Exp := 'D-' + {$IFDEF UNICODE}AnsiString{$ENDIF}(IntToStr(IntExp));
+ if Length(Result) >=2 then
+ Insert('.', Result, 2);
+ Result := Result + Exp;
+ end
+ else
+ begin
+ // IntExp may be negative.
+ if Flag = 1 then
+ begin
+ // Calculate all digits required without exponent
+ if IntExp <= Length(Result) - 2 then
+ begin
+ // Do not use exponent
+ Insert('.', Result, IntExp + 2);
+ end
+ else if IntExp = Length(Result) - 1 then
+ { 1.001, Exp = 3, output 1001 }
+ else
+ begin
+ if IntExp + 1> MaxBinDigits then
+ goto UseExponent
+ else
+ begin
+ Inc(IntExp);
+ i := Length(Result);
+ // Add zeros at tail
+ SetLength(Result, IntExp);
+ for i := i + 1 to IntExp do
+ Result := '0';
+ end;
+ end;
+ end
+ else
+ begin
+ if IntExp + Length(Result) > MaxBinDigits then
+ goto UseExponent
+ else
+ begin
+ // Add leading zeros and place "."
+ SetLength(Exp, 1 + IntExp);
+ Exp[1] := '0';
+ Exp[2] := '.';
+ for i := 3 to IntExp + 1 do
+ Exp := '0'; //}
+ Result := Exp + Result;
+ end;
+ end;
+ end;
+ end;
+ end;
+ 3: // INF
+ begin
+ ForHexOct := nil;
+ Result := 'INF';
+ end;
+ 4: // NaN
+ begin
+ ForHexOct := nil;
+ Result := 'NaN';
+ Exit;
+ end;
+ end;
+ if Neg then
+ Result := '-' + Result;
+end;
+
+function FloatDecimalToBinExtended(fIn: Extended; DecimalExp,
+ AlwaysUseExponent: Boolean): AnsiString;
+var
+ PTmp: PConvertFloatSystem;
+begin
+ PTmp := nil;
+ Result := FloatDecimalToBinaryExtended(fIn, DecimalExp, AlwaysUseExponent, PTmp);
+end;
+
+function FloatDecimalToHexExtended(fIn: Extended; DecimalExp,
+ AlwaysUseExponent: Boolean): AnsiString;
+const
+ DecToHex: array[0..15] of AnsiChar =
+ ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+ BinPow: array[0..3] of Integer = (8, 4, 2, 1);
+
+ function IntToHex(Int: Integer): AnsiString;
+ var
+ k ,t: Integer;
+ Buf: array[1..5] of AnsiChar;
+ begin
+ k := 1;
+ while (Int <> 0) do
+ begin
+ Buf[k] := DecToHex[Int mod 16];
+ Inc(k);
+ Int := Int div 16;
+ end;
+ Dec(k);
+ SetLength(Result, k);
+ t := 1;
+ while (k > 0) do
+ begin
+ Result[t] := Buf[k];
+ Inc(t);
+ Dec(k);
+ end;
+ end;
+
+ function ToHex(const S: AnsiString; LeftToDot: Boolean): AnsiString;
+ var
+ i, l, t, m, k: Integer;
+ Buf: array[1..20] of AnsiChar;
+ begin
+ { LeftToDot = True, S will be patched with zeroes on its left side.
+ For example, S = '110', after patching, S = '0110'.
+ LeftToDot = False, S will be patched with zeroes on its right side.
+ S = '110', after patching, S = '1100'. }
+ l := Length(S);
+ if LeftToDot then
+ t := (4 - (l mod 4)) mod 4
+ else
+ t := 0;
+ i := 1;
+ m := 1;
+ k := 0;
+ while i <= l do
+ begin
+ k := k + BinPow[t] * (Ord(S[i]) - Ord('0'));
+ Inc(t);
+ if (t = 4) or (i = l) then
+ begin
+ Buf[m] := DecToHex[k];
+ Inc(m);
+ k := 0;
+ t := 0;
+ end;
+ Inc(i);
+ end;
+ Dec(m);
+ SetLength(Result, m);
+
+ while (m > 0) do
+ begin
+ Result[m] := Buf[m];
+ Dec(m);
+ end;
+ end;
+
+var
+ PConvertData: PConvertFloatSystem;
+ ConvertData: TConvertFloatSystem;
+ tmpS: AnsiString;
+ k, t, i, m: Integer;
+label UseExponent;
+begin
+ PConvertData := @ConvertData;
+ Result := FloatDecimalToBinaryExtended(fIn, True, True, PConvertData);
+ // See FloatDecimalToBinaryExtended, PConvertData is set to nil when result is definite.
+ if PConvertData = nil then
+ Exit;
+ with ConvertData do
+ begin
+ { 3.BD^D(12)
+ A.BD^E(ABCE)
+ AB.FFFF }
+ k := Length(Result) - 1;
+ if AlwaysUseExponent then
+ begin
+UseExponent:
+ { Algorithm:
+ X.XXXXXXXX^Y Shift Count Exp
+ 1.00000001^0 = 1.00000001 = 1.01^0 (16)
+ 1.00000001^1 = 10.0000001 = 2.02^0 (16)
+ 1.00000001^2 = 100.000001 = 4.04^0 (16)
+ 1.00000001^3 = 1000.00001 = 8.08^0 (16)
+ 1.00000001^4 = 1.00000001^100 = 1.01^1 (16)
+ 1.00000001^5 = 10.0000001^100 = 2.02^1 (16)
+ Shift Count = Y mod 4
+ Exp = Y div 4
+ X.XXXXXXXXX^Y Y < 0 Exp
+ 1.00000001^-1 = 0.100000001 = 1000.00001^-100 = 8.08^-1
+ 1.00000001^-2 = 0.0100000001 = 100.000001^-100 = 4.04^-1
+ 1.00000001^-3 = 0.00100000001 = 10.0000001^-100 = 2.02^-1
+ 1.00000001^-4 = 0.000100000001 = 1.00000001^-100 = 1.01^-1
+ 1.00000001^-5 = 0.0000100000001 = 1000.00001^-100 = 8.08^-2
+ Shift Count = 4 - (Abs(Y) mod 4)
+ Exp = -(Abs(Y) div 4 + 1) }
+ if ExpFlag = 1 then
+ begin
+ t := ExponentI div 4; // Exp
+ i := ExponentI mod 4; // Shift Count
+ end
+ else
+ begin
+ t := -((ExponentI - 1) div 4 + 1); // Exp
+ i := (4 - (ExponentI mod 4)) mod 4; // Shift Count
+ end;
+ // Get hex digits
+ if k < i then
+ begin
+ // Add extra zeroes
+ SetLength(Result, i + 1);
+ for m := k + 2 to i + 1 do
+ Result[m] := '0';
+ Result := ToHex(Result, True);
+ end
+ else if k = i then
+ Result := ToHex(Result, True)
+ else
+ begin
+ tmpS := Copy(Result, 1, i + 1);
+ Delete(Result, 1, i + 1);
+ Result := ToHex(tmpS, True) + '.' + ToHex(Result, False);
+ end;
+ if t <> 0 then
+ begin
+ // Format exponent
+ if DecimalExp then
+ Result := Result + '^D(' + {$IFDEF UNICODE}AnsiString{$ENDIF}(IntToStr(t)) + ')'
+ else
+ begin
+ if ExpFlag = 1 then
+ Result := Result + '^E(' + IntToHex(t) + ')'
+ else // t < 0
+ Result := Result + '^E(-' + IntToHex(-t) + ')';
+ end;
+ end;
+ end
+ else
+ begin
+ { Always remember that Result equals "XXXXXXXX" not "X.XXXXXXX".
+ Judge whether to use exponent:
+ There are K "X" after '.', K = Length(Result) - 1, no "." in Result originally.
+ X.XXXXXXX^Y (Binary string, ExponentI = Abs(Y))
+ case Y >= 0 (Condition: ExpFlag = 2)
+ Y <= K:
+ Y+1 binary digits on left side of '.', K-Y digits on right side
+ totally requires ((Y+1 - 1) div 4 + 1) + ((K-Y - 1) div 4 + 1) hex digits
+ Y > K:
+ Y+1 binary digits on left side, totally ((Y+1 - 1) div 4 + 1) hex digits
+ case Y<0 (Condition: ExpFlag = 1) 0.XXXX or 0.000XXXX
+ One digit '0' on left side and K+1+Abs(Y)-1 digits on right side,
+ totally 1 + ((K+1+Abs(Y)-1-1) div 4 + 1) hex digits.
+ Compare hdc = hex digit count with MaxHexDigits. If hdc > MaxHexDigits,
+ goto UseExponent. }
+ if ExponentI = 0 then
+ begin
+ if (Length(Result) > 1) then
+ Result := '1.' + ToHex(Copy(Result, 2, MaxInt), False);
+ end
+ else
+ begin
+ if ExpFlag = 1 then
+ begin
+ if ExponentI < k then
+ begin
+ // No possible that "ExponentI div 4 + (k - ExponentI - 1) div 4 + 2" > MaxHexDigits
+ tmpS := Copy(Result, 1, ExponentI + 1);
+ Delete(Result, 1, ExponentI + 1);
+ Result := ToHex(tmpS, True) + '.' + ToHex(Result, False);
+ end
+ else if ExponentI = k then
+ // 1.01^2 = 101, no ".", no extra "0".
+ Result := ToHex(Result, True)
+ else
+ begin
+ t := ExponentI div 4 + 1;
+ if t > MaxHexDigits then
+ goto UseExponent
+ else
+ begin
+ // Append "0" after Result
+ Inc(ExponentI);
+ // Add '0' to Result
+ SetLength(Result, ExponentI);
+ for t := k + 2{original Length(Result) + 1} to ExponentI do
+ Result[t] := '0';
+ Result := ToHex(Result, True);
+ end;
+ end;
+ end
+ else
+ begin
+ // ExpFlag = 2, X.XXXXXXX^Y, Y < 0
+ t := 2 + (k + ExponentI - 1) div 4; {1 + ((K+1+Abs(Y)-1-1) div 4 + 1)}
+ if t > MaxHexDigits then
+ goto UseExponent
+ else
+ begin
+ // Add leading zeroes before Result
+ SetLength(tmpS, ExponentI - 1); // tmpS stores extra zeroes
+ for t := 1 to ExponentI - 1 do
+ tmpS[t] := '0';
+ Result := '0.' + ToHex(tmpS + Result, False);
+ end;
+ end;
+ end;
+ end;
+ if Negative then
+ Result := '-' + Result;
+ end;
+end;
+
+function FloatDecimalToOctExtended(fIn: Extended; DecimalExp,
+ AlwaysUseExponent: Boolean): AnsiString;
+const
+ DecToOct: array[0..7] of AnsiChar =
+ ('0', '1', '2', '3', '4', '5', '6', '7');
+ BinPow: array[0..2] of Integer = (4, 2, 1);
+
+ function IntToOct(Int: Integer): AnsiString;
+ var
+ k ,t: Integer;
+ Buf: array[1..10] of AnsiChar;
+ begin
+ k := 1;
+ while (Int <> 0) do
+ begin
+ Buf[k] := DecToOct[Int mod 8];
+ Inc(k);
+ Int := Int div 8;
+ end;
+ Dec(k);
+ SetLength(Result, k);
+ t := 1;
+ while (k > 0) do
+ begin
+ Result[t] := Buf[k];
+ Inc(t);
+ Dec(k);
+ end;
+ end;
+
+ function ToOct(const S: AnsiString; LeftToDot: Boolean): AnsiString;
+ var
+ i, l, t, m, k: Integer;
+ Buf: array[1..30] of AnsiChar;
+ begin
+ { LeftToDot = True, S will be patched with zeroes on its left side.
+ For example, S = '110', after patching, S = '0110'.
+ LeftToDot = False, S will be patched with zeroes on its right side.
+ S = '110', after patching, S = '1100'. }
+ l := Length(S);
+ if LeftToDot then
+ t := (3 - (l mod 3)) mod 3
+ else
+ t := 0;
+ i := 1;
+ m := 1;
+ k := 0;
+ while i <= l do
+ begin
+ k := k + BinPow[t] * (Ord(S[i]) - Ord('0'));
+ Inc(t);
+ if (t = 3) or (i = l) then
+ begin
+ Buf[m] := DecToOct[k];
+ Inc(m);
+ k := 0;
+ t := 0;
+ end;
+ Inc(i);
+ end;
+ Dec(m);
+ SetLength(Result, m);
+
+ while (m > 0) do
+ begin
+ Result[m] := Buf[m];
+ Dec(m);
+ end;
+ end;
+
+var
+ PConvertData: PConvertFloatSystem;
+ ConvertData: TConvertFloatSystem;
+ tmpS: AnsiString;
+ k, t, i, m: Integer;
+label UseExponent;
+begin
+ PConvertData := @ConvertData;
+ Result := FloatDecimalToBinaryExtended(fIn, True, True, PConvertData);
+ // See FloatDecimalToBinaryExtended, PConvertData is set to nil when result is definite.
+ if PConvertData = nil then
+ Exit;
+ with ConvertData do
+ begin
+ { 3.333D12 // 12 is decimal
+ 2.22E33 // 33 is octal}
+ k := Length(Result) - 1;
+ if AlwaysUseExponent then
+ begin
+UseExponent:
+ if ExpFlag = 1 then
+ begin
+ t := ExponentI div 3; // Exp
+ i := ExponentI mod 3; // Shift Count
+ end
+ else
+ begin
+ t := -((ExponentI - 1) div 3 + 1); // Exp
+ i := (3 - (ExponentI mod 3)) mod 3; // Shift Count
+ end;
+ // Get hex digits
+ if k < i then
+ begin
+ // Add extra zeroes
+ SetLength(Result, i + 1);
+ for m := k + 2 to i + 1 do
+ Result[m] := '0';
+ Result := ToOct(Result, True);
+ end
+ else if k = i then
+ Result := ToOct(Result, True)
+ else
+ begin
+ tmpS := Copy(Result, 1, i + 1);
+ Delete(Result, 1, i + 1);
+ Result := ToOct(tmpS, True) + '.' + ToOct(Result, False);
+ end;
+ if t <> 0 then
+ begin
+ // Format exponent
+ if DecimalExp then
+ Result := Result + 'D' + {$IFDEF UNICODE}AnsiString{$ENDIF}(IntToStr(t))
+ else
+ begin
+ if ExpFlag = 1 then
+ Result := Result + 'E' + IntToOct(t)
+ else // t < 0
+ Result := Result + 'E-' + IntToOct(-t);
+ end;
+ end;
+ end
+ else
+ begin
+ if ExponentI = 0 then
+ begin
+ if (Length(Result) > 1) then
+ Result := '1.' + ToOct(Copy(Result, 2, MaxInt), False);
+ end
+ else
+ begin
+ if ExpFlag = 1 then
+ begin
+ if ExponentI < k then
+ begin
+ tmpS := Copy(Result, 1, ExponentI + 1);
+ Delete(Result, 1, ExponentI + 1);
+ Result := ToOct(tmpS, True) + '.' + ToOct(Result, False);
+ end
+ else if ExponentI = k then
+ // 1.01^2 = 101, no ".", no extra "0".
+ Result := ToOct(Result, True)
+ else
+ begin
+ t := ExponentI div 3 + 1;
+ if t > MaxHexDigits then
+ goto UseExponent
+ else
+ begin
+ // Append "0" after Result
+ Inc(ExponentI);
+ // Add '0' to Result
+ SetLength(Result, ExponentI);
+ for t := k + 2{original Length(Result) + 1} to ExponentI do
+ Result[t] := '0';
+ Result := ToOct(Result, True);
+ end;
+ end;
+ end
+ else
+ begin
+ // ExpFlag = 2, X.XXXXXXX^Y, Y < 0
+ t := 2 + (k + ExponentI - 1) div 3;
+ if t > MaxHexDigits then
+ goto UseExponent
+ else
+ begin
+ // Add leading zeroes before Result
+ SetLength(tmpS, ExponentI - 1); // tmpS stores extra zeroes
+ for t := 1 to ExponentI - 1 do
+ tmpS[t] := '0';
+ Result := '0.' + ToOct(tmpS + Result, False);
+ end;
+ end;
+ end;
+ end;
+ if Negative then
+ Result := '-' + Result;
+ end;
+end;
+
+{$ENDIF}
+{$ENDIF}
+
+procedure ExtractFloatSingle(Value: Single; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: Cardinal);
+begin
+ SignNegative := (PCardinal(@Value)^ and CN_SIGN_SINGLE_MASK) <> 0;
+ Exponent := ((PCardinal(@Value)^ and CN_EXPONENT_SINGLE_MASK) shr 23) - CN_EXPONENT_OFFSET_SINGLE;
+ Mantissa := PCardinal(@Value)^ and CN_SIGNIFICAND_SINGLE_MASK;
+ Mantissa := Mantissa or (1 shl 23); // λټӸ 1
+end;
+
+procedure ExtractFloatDouble(Value: Double; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: TUInt64);
+begin
+ SignNegative := (PUInt64(@Value)^ and CN_SIGN_DOUBLE_MASK) <> 0;
+ Exponent := ((PUInt64(@Value)^ and CN_EXPONENT_DOUBLE_MASK) shr 52) - CN_EXPONENT_OFFSET_DOUBLE;
+ Mantissa := PUInt64(@Value)^ and CN_SIGNIFICAND_DOUBLE_MASK;
+ Mantissa := Mantissa or (TUInt64(1) shl 52); // λټӸ 1
+end;
+
+procedure ExtractFloatExtended(Value: Extended; out SignNegative: Boolean;
+ out Exponent: Integer; out Mantissa: TUInt64);
+begin
+ if (SizeOf(Extended) = CN_EXTENDED_SIZE_10) or (SizeOf(Extended) = CN_EXTENDED_SIZE_16) then
+ begin
+ SignNegative := (PExtendedRec10(@Value)^.ExpSign and CN_SIGN_EXTENDED_MASK) <> 0;
+ Exponent := (PExtendedRec10(@Value)^.ExpSign and CN_EXPONENT_EXTENDED_MASK) - CN_EXPONENT_OFFSET_EXTENDED;
+ Mantissa := PExtendedRec10(@Value)^.Mantissa; // 1ü
+ end
+ else if SizeOf(Extended) = CN_EXTENDED_SIZE_8 then
+ ExtractFloatDouble(Value, SignNegative, Exponent, Mantissa)
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+procedure ExtractFloatExtended(ValueAddr: Pointer; ExtendedSize: Integer;
+ out SignNegative: Boolean; out Exponent: Integer; out Mantissa: TUInt64);
+var
+ D: Double;
+begin
+ if (ExtendedSize = CN_EXTENDED_SIZE_10) or (ExtendedSize = CN_EXTENDED_SIZE_16) then
+ begin
+ SignNegative := (PExtendedRec10(ValueAddr)^.ExpSign and CN_SIGN_EXTENDED_MASK) <> 0;
+ Exponent := (PExtendedRec10(ValueAddr)^.ExpSign and CN_EXPONENT_EXTENDED_MASK) - CN_EXPONENT_OFFSET_EXTENDED;
+ Mantissa := PExtendedRec10(ValueAddr)^.Mantissa; // 1ü
+ end
+ else if ExtendedSize = CN_EXTENDED_SIZE_8 then
+ begin
+ Move(ValueAddr^, D, SizeOf(Double));
+ ExtractFloatDouble(D, SignNegative, Exponent, Mantissa);
+ end
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+procedure ExtractFloatQuadruple(Value: Extended; out SignNegative: Boolean;
+ out Exponent: Integer; out MantissaLo, MantissaHi: TUInt64);
+begin
+ if SizeOf(Extended) <> CN_EXTENDED_SIZE_16 then
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+
+ SignNegative := (PCnQuadruple(@Value)^.W1 and CN_SIGN_QUADRUPLE_MASK) <> 0;
+ Exponent := (PCnQuadruple(@Value)^.W1 and CN_EXPONENT_QUADRUPLE_MASK) - CN_EXPONENT_OFFSET_EXTENDED;
+
+ // Extract 16 Bytes to Mantissas
+ MantissaLo := PCnQuadruple(@Value)^.Lo;
+ MantissaHi := TUInt64(PCnQuadruple(@Value)^.Hi0) or (TUInt64(PCnQuadruple(@Value)^.W0) shl 32) or (TUInt64(1) shl 48); // λټӸ 1
+end;
+
+procedure CombineFloatSingle(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: Cardinal; var Value: Single);
+begin
+ Mantissa := Mantissa and not (1 shl 23); // ȥ 23 λϵ 1еĻ
+ PCardinal(@Value)^ := Mantissa and CN_SIGNIFICAND_SINGLE_MASK;
+ Inc(Exponent, CN_EXPONENT_OFFSET_SINGLE);
+
+ PCardinal(@Value)^ := PCardinal(@Value)^ or (LongWord(Exponent) shl 23);
+ if SignNegative then
+ PCardinal(@Value)^ := PCardinal(@Value)^ or CN_SIGN_SINGLE_MASK
+ else
+ PCardinal(@Value)^ := PCardinal(@Value)^ and not CN_SIGN_SINGLE_MASK;
+end;
+
+procedure CombineFloatDouble(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; var Value: Double);
+begin
+ Mantissa := Mantissa and not (TUInt64(1) shl 52); // ȥ 52 λϵ 1еĻ
+ PUInt64(@Value)^ := Mantissa and CN_SIGNIFICAND_DOUBLE_MASK;
+ Inc(Exponent, CN_EXPONENT_OFFSET_DOUBLE);
+
+ PUInt64(@Value)^ := PUInt64(@Value)^ or (TUInt64(Exponent) shl 52);
+ if SignNegative then
+ PUInt64(@Value)^ := PUInt64(@Value)^ or CN_SIGN_DOUBLE_MASK
+ else
+ PUInt64(@Value)^ := PUInt64(@Value)^ and not CN_SIGN_DOUBLE_MASK;
+end;
+
+{$HINTS OFF}
+
+procedure CombineFloatExtended(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; var Value: Extended);
+var
+ D: Double;
+begin
+ if (SizeOf(Extended) = CN_EXTENDED_SIZE_10) or (SizeOf(Extended) = CN_EXTENDED_SIZE_16) then
+ begin
+ PExtendedRec10(@Value)^.Mantissa := Mantissa;
+ Inc(Exponent, CN_EXPONENT_OFFSET_EXTENDED);
+
+ PExtendedRec10(@Value)^.ExpSign := Exponent and CN_EXPONENT_EXTENDED_MASK;
+ if SignNegative then
+ PExtendedRec10(@Value)^.ExpSign := PExtendedRec10(@Value)^.ExpSign or CN_SIGN_EXTENDED_MASK
+ else
+ PExtendedRec10(@Value)^.ExpSign := PExtendedRec10(@Value)^.ExpSign and not CN_SIGN_EXTENDED_MASK;
+ end
+ else if SizeOf(Extended) = CN_EXTENDED_SIZE_8 then
+ begin
+ CombineFloatDouble(SignNegative, Exponent, Mantissa, D);
+ Value := D;
+ end
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+procedure CombineFloatExtended(SignNegative: Boolean; Exponent: Integer;
+ Mantissa: TUInt64; ValueAddr: Pointer; ExtendedSize: Integer);
+var
+ D: Double;
+begin
+ if (ExtendedSize = CN_EXTENDED_SIZE_10) or (ExtendedSize = CN_EXTENDED_SIZE_16) then
+ begin
+ PExtendedRec10(ValueAddr)^.Mantissa := Mantissa;
+ Inc(Exponent, CN_EXPONENT_OFFSET_EXTENDED);
+
+ PExtendedRec10(ValueAddr)^.ExpSign := Exponent and CN_EXPONENT_EXTENDED_MASK;
+ if SignNegative then
+ PExtendedRec10(ValueAddr)^.ExpSign := PExtendedRec10(ValueAddr)^.ExpSign or CN_SIGN_EXTENDED_MASK
+ else
+ PExtendedRec10(ValueAddr)^.ExpSign := PExtendedRec10(ValueAddr)^.ExpSign and not CN_SIGN_EXTENDED_MASK;
+ end
+ else if ExtendedSize = CN_EXTENDED_SIZE_8 then
+ begin
+ CombineFloatDouble(SignNegative, Exponent, Mantissa, D);
+ Move(D, ValueAddr^, SizeOf(Double));
+ end
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+{$HINTS ON}
+
+procedure CombineFloatQuadruple(SignNegative: Boolean; Exponent: Integer;
+ MantissaLo, MantissaHi: TUInt64; var Value: Extended);
+begin
+ if SizeOf(Extended) <> CN_EXTENDED_SIZE_16 then
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+
+ MantissaHi := MantissaHi and not (TUInt64(1) shl 48); // ȥ 112 λϵ 1еĻ
+ PCnQuadruple(@Value)^.Lo := MantissaLo;
+ PCnQuadruple(@Value)^.Hi0 := Cardinal(MantissaHi and $FFFFFFFF);
+ PCnQuadruple(@Value)^.Hi1 := (MantissaHi shr 32) and CN_SIGNIFICAND_QUADRUPLE_MASK;
+
+ Inc(Exponent, CN_EXPONENT_OFFSET_EXTENDED);
+ PCnQuadruple(@Value)^.W1 := Exponent and CN_EXPONENT_QUADRUPLE_MASK;
+ if SignNegative then
+ PCnQuadruple(@Value)^.Hi1 := PCnQuadruple(@Value)^.Hi1 or CN_SIGN_QUADRUPLE_MASK
+ else
+ PCnQuadruple(@Value)^.Hi1 := PCnQuadruple(@Value)^.Hi1 and not CN_SIGN_QUADRUPLE_MASK;
+end;
+
+// UInt64 Ϊ
+function UFloat(U: TUInt64): Extended;
+{$IFNDEF SUPPORT_UINT64}
+var
+ L, H: Cardinal;
+{$ENDIF}
+begin
+{$IFDEF SUPPORT_UINT64}
+ Result := U;
+{$ELSE}
+ if U < 0 then // Int64 С 0 ʱ UInt64 Ǵ Int64 ֵ
+ begin
+ H := Int64Rec(U).Hi;
+ L := Int64Rec(U).Lo;
+ Result := Int64(H) * Int64(CN_MAX_UINT16 + 1); //
+ Result := Result * (CN_MAX_UINT16 + 1);
+ Result := Result + L;
+ end
+ else
+ Result := U;
+{$ENDIF}
+end;
+
+function UInt64ToSingle(U: TUInt64): Single;
+begin
+ Result := UFloat(U);
+end;
+
+function UInt64ToDouble(U: TUInt64): Double;
+begin
+ Result := UFloat(U);
+end;
+
+function UInt64ToExtended(U: TUInt64): Extended;
+begin
+ Result := UFloat(U);
+end;
+
+// ͨ Trunc ֻܷ Int64 UInt64
+function UTrunc(F: Extended): TUInt64;
+var
+ T: Integer;
+ SignNeg: Boolean;
+ Exponent: Integer;
+ Mantissa: TUInt64;
+begin
+ // õʵָ 1 ͷЧ֣С 1
+ ExtractFloatExtended(F, SignNeg, Exponent, Mantissa);
+ if SignNeg then
+ raise ERangeError.Create(SRangeError); // ֧
+
+ // Mantissa 64 λЧ֣С 63 λָС 0 ˵СҪƣôֵ 0
+ if Exponent < 0 then
+ Result := 0
+ else
+ begin
+ // С Exponent λСߵ
+ T := 63 - Exponent; // С 0 63 λ 63 λұߣСƺ T λұ
+ if T < 0 then
+ raise ERangeError.Create(SRangeError); // Exponent ̫
+
+ Result := Mantissa shr T;
+ end;
+end;
+
+function SingleToUInt64(F: Single): TUInt64;
+begin
+ Result := UTrunc(F);
+end;
+
+function DoubleToUInt64(F: Double): TUInt64;
+begin
+ Result := UTrunc(F);
+end;
+
+function ExtendedToUInt64(F: Extended): TUInt64;
+begin
+ Result := UTrunc(F);
+end;
+
+function SingleIsInfinite(AValue: Single): Boolean;
+begin
+ Result := ((PCardinal(@AValue)^ and $7F800000) = $7F800000) and
+ ((PCardinal(@AValue)^ and $007FFFFF) = $00000000);
+end;
+
+function DoubleIsInfinite(AValue: Double): Boolean;
+begin
+ Result := ((PUInt64(@AValue)^ and $7FF0000000000000) = $7FF0000000000000) and
+ ((PUInt64(@AValue)^ and $000FFFFFFFFFFFFF) = $0000000000000000);
+end;
+
+function ExtendedIsInfinite(AValue: Extended): Boolean;
+begin
+ if (SizeOf(Extended) = CN_EXTENDED_SIZE_10) or (SizeOf(Extended) = CN_EXTENDED_SIZE_16) then
+ Result := ((PExtendedRec10(@AValue)^.ExpSign and $7FFF) = $7FFF) and
+ ((PExtendedRec10(@AValue)^.Mantissa) = 0)
+ else if SizeOf(Extended) = CN_EXTENDED_SIZE_8 then
+ Result := DoubleIsInfinite(AValue)
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+function SingleIsNan(AValue: Single): Boolean;
+begin
+ Result := ((PCardinal(@AValue)^ and $7F800000) = $7F800000) and
+ ((PCardinal(@AValue)^ and $007FFFFF) <> $00000000);
+end;
+
+function DoubleIsNan(AValue: Double): Boolean;
+begin
+ Result := ((PUInt64(@AValue)^ and $7FF0000000000000) = $7FF0000000000000) and
+ ((PUInt64(@AValue)^ and $000FFFFFFFFFFFFF) <> $0000000000000000);
+end;
+
+function ExtendedIsNan(AValue: Extended): Boolean;
+begin
+ if (SizeOf(Extended) = CN_EXTENDED_SIZE_10) or (SizeOf(Extended) = CN_EXTENDED_SIZE_16) then
+ Result := ((PExtendedRec10(@AValue)^.ExpSign and $7FFF) = $7FFF) and
+ ((PExtendedRec10(@AValue)^.Mantissa and $7FFFFFFFFFFFFFFF) <> 0)
+ else if SizeOf(Extended) = CN_EXTENDED_SIZE_8 then
+ Result := DoubleIsNan(AValue)
+ else
+ raise ECnFloatSizeError.CreateFmt(SCnErrorExtendedSizeFmt, [SizeOf(Extended)]);
+end;
+
+function ExtendedToStr(AValue: Extended): string;
+var
+ Buffer: array[0..63] of Char;
+begin
+ SetString(Result, Buffer, FloatToText(Buffer, AValue, {$IFNDEF FPC} fvExtended, {$ENDIF}
+ ffGeneral, 18, 0)); // ڲ 18
+end;
+
+end.
diff --git a/CnPack/Common/CnPack.inc b/CnPack/Common/CnPack.inc
new file mode 100644
index 0000000..3ffcc8d
--- /dev/null
+++ b/CnPack/Common/CnPack.inc
@@ -0,0 +1,3623 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2025 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+{******************************************************************************}
+{ }
+{ עõԪΪָͱ汾Ϣļ }
+{ õԪݲֲο JCL GExperts }
+{ }
+{******************************************************************************}
+
+//==============================================================================
+// ѡ
+//==============================================================================
+
+{$IFDEF FPC}
+ // Free Pascal Compiler 3.x Up Definitions
+ {$DEFINE SUPPORT_PASCAL} // Pascal
+ {$DEFINE SUPPORT_UINT64} // UInt64
+ {$DEFINE SUPPORT_32_AND_64} // ֧ 32 64 λ NativeInt
+ {$DEFINE SUPPORT_ENCODING} // Unicode ַ֧ Encoding ת
+ {$DEFINE SUPPORT_INLINE} // ֧ inline
+
+ {$DEFINE OBJECT_HAS_TOSTRING} // TObject.ToString
+ {$DEFINE TBYTES_DEFINED}
+
+ // CPU FPC ӳ䵽 Delphi
+ {$IFDEF CPU386} // Intel 32 CPU
+ {$DEFINE CPU32BITS}
+ {$DEFINE CPUX86}
+ {$asmMode intel}
+ {$ENDIF}
+ {$IFDEF CPUi386}
+ {$DEFINE CPU32BITS}
+ {$DEFINE CPUX86}
+ {$asmMode intel}
+ {$ENDIF}
+
+ {$IFDEF CPUAMD64} // Intel 64 CPU
+ {$DEFINE CPU64BITS}
+ {$DEFINE CPUX64}
+ {$asmMode intel}
+ {$ENDIF}
+ {$IFDEF CPUX86_64}
+ {$DEFINE CPU64BITS}
+ {$DEFINE CPUX64}
+ {$asmMode intel}
+ {$ENDIF}
+ {$IFDEF CPUIA64}
+ {$DEFINE CPU64BITS}
+ {$DEFINE CPUX64}
+ {$asmMode intel}
+ {$ENDIF}
+
+ {$IFDEF CPUARM} // ARM 32 bit processor
+ {$DEFINE CPU32BITS}
+ {$DEFINE CPUARM}
+ {$DEFINE CPUARM32}
+ {$ENDIF}
+
+ {$IFDEF CPUAARCH64} // ARM 64 bit processor
+ {$DEFINE CPU64BITS}
+ {$DEFINE CPUARM}
+ {$DEFINE CPUARM64}
+ {$ENDIF}
+
+ {$mode Delphi} // Delphi Compatibility, not DelphiUnicodeעԴظ
+
+ // ر Range Check Overflow Check
+ {$R- No Range checking}
+ {$OVERFLOWCHECKS OFF}
+
+{$ELSE FPC} // Below is for Delphi Compiler
+
+//{$DEFINE PERSONAL_EDITION}
+{$DEFINE ENTERPRISE_EDITION}
+
+{$IFNDEF PERSONAL_EDITION}
+ {$DEFINE SUPPORT_DB}
+ {$DEFINE SUPPORT_ADO}
+{$ENDIF}
+
+//==============================================================================
+// 汾Ϣ
+//==============================================================================
+
+{$IFDEF VER360}
+ {$DEFINE COMPILER29}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI29}
+ {$DEFINE DELPHI120_ATHENS}
+ {$DEFINE BCB28}
+ {$DEFINE BCB120_ATHENS}
+ {$DEFINE BDS23}
+{$ENDIF}
+
+{$IFDEF VER350}
+ {$DEFINE COMPILER28}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI28}
+ {$DEFINE DELPHI110_ALEXANDRIA}
+ {$DEFINE BCB28}
+ {$DEFINE BCB110_ALEXANDRIA}
+ {$DEFINE BDS22}
+{$ENDIF}
+
+{$IFDEF VER340}
+ {$DEFINE COMPILER27}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI27}
+ {$DEFINE DELPHI104_SYDNEY}
+ {$DEFINE BCB27}
+ {$DEFINE BCB104_SYDNEY}
+ {$DEFINE BDS21}
+{$ENDIF}
+
+{$IFDEF VER330}
+ {$DEFINE COMPILER26}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI26}
+ {$DEFINE DELPHI103_RIO}
+ {$DEFINE BCB26}
+ {$DEFINE BCB103_RIO}
+ {$DEFINE BDS20}
+{$ENDIF}
+
+{$IFDEF VER320}
+ {$DEFINE COMPILER25}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI25}
+ {$DEFINE DELPHI102_TOKYO}
+ {$DEFINE BCB25}
+ {$DEFINE BCB102_TOKYO}
+ {$DEFINE BDS19}
+{$ENDIF}
+
+{$IFDEF VER310}
+ {$DEFINE COMPILER24}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI24}
+ {$DEFINE DELPHI101_BERLIN}
+ {$DEFINE BCB24}
+ {$DEFINE BCB101_BERLIN}
+ {$DEFINE BDS18}
+{$ENDIF}
+
+{$IFDEF VER300}
+ {$DEFINE COMPILER23}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI23}
+ {$DEFINE DELPHI10_SEATTLE}
+ {$DEFINE BCB23}
+ {$DEFINE BCB10_SEATTLE}
+ {$DEFINE BDS17}
+{$ENDIF}
+
+{$IFDEF VER290}
+ {$DEFINE COMPILER22}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI22}
+ {$DEFINE DELPHIXE8}
+ {$DEFINE BCB22}
+ {$DEFINE BCBXE8}
+ {$DEFINE BDS16}
+{$ENDIF}
+
+{$IFDEF VER280}
+ {$DEFINE COMPILER21}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI21}
+ {$DEFINE DELPHIXE7}
+ {$DEFINE BCB21}
+ {$DEFINE BCBXE7}
+ {$DEFINE BDS15}
+{$ENDIF}
+
+{$IFDEF VER270}
+ {$DEFINE COMPILER20}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI20}
+ {$DEFINE DELPHIXE6}
+ {$DEFINE BCB20}
+ {$DEFINE BCBXE6}
+ {$DEFINE BDS14}
+{$ENDIF}
+
+{$IFDEF VER260}
+ {$DEFINE COMPILER19}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI19}
+ {$DEFINE DELPHIXE5}
+ {$DEFINE BCB19}
+ {$DEFINE BCBXE5}
+ {$DEFINE BDS12}
+{$ENDIF}
+
+{$IFDEF VER250}
+ {$DEFINE COMPILER18}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI18}
+ {$DEFINE DELPHIXE4}
+ {$DEFINE BCB18}
+ {$DEFINE BCBXE4}
+ {$DEFINE BDS11}
+{$ENDIF}
+
+{$IFDEF VER240}
+ {$DEFINE COMPILER17}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI17}
+ {$DEFINE DELPHIXE3}
+ {$DEFINE DELPHI2013}
+ {$DEFINE BCB17}
+ {$DEFINE BCBXE3}
+ {$DEFINE BCB2013}
+ {$DEFINE BDS10}
+ {$DEFINE BDS2013}
+{$ENDIF}
+
+{$IFDEF VER230}
+ {$DEFINE COMPILER16}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI16}
+ {$DEFINE DELPHIXE2}
+ {$DEFINE DELPHI2012}
+ {$DEFINE BCB16}
+ {$DEFINE BCBXE2}
+ {$DEFINE BCB2012}
+ {$DEFINE BDS9}
+ {$DEFINE BDS2012}
+{$ENDIF}
+
+{$IFDEF VER220}
+ {$DEFINE COMPILER15}
+ {$IFDEF LINUX}
+ {$DEFINE UCL10}
+ {$ELSE}
+ {$DEFINE VCL71}
+ {$ENDIF}
+ {$DEFINE DELPHI15}
+ {$DEFINE DELPHIXE}
+ {$DEFINE DELPHI2011}
+ {$DEFINE BCB15}
+ {$DEFINE BCBXE}
+ {$DEFINE BCB2011}
+ {$DEFINE BDS8}
+ {$DEFINE BDS2011}
+{$ENDIF}
+
+{$IFDEF VER210}
+ {$DEFINE COMPILER14}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI14}
+ {$DEFINE DELPHI2010}
+ {$DEFINE BCB14}
+ {$DEFINE BCB2010}
+ {$DEFINE BDS7}
+ {$DEFINE BDS2010}
+{$ENDIF}
+
+{$IFDEF VER200}
+ {$DEFINE COMPILER12}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI12}
+ {$DEFINE DELPHI2009}
+ {$DEFINE BCB12}
+ {$DEFINE BCB2009}
+ {$DEFINE BDS6}
+ {$DEFINE BDS2009}
+{$ENDIF}
+
+{$IFDEF VER185}
+ {$DEFINE COMPILER11}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI11}
+ {$DEFINE DELPHI2007}
+ {$DEFINE BCB11}
+ {$DEFINE BCB2007}
+ {$DEFINE BDS5}
+ {$DEFINE BDS2007}
+ {$UNDEF VER180}
+{$ENDIF}
+
+{$IFDEF VER180}
+ {$DEFINE COMPILER10}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI10}
+ {$DEFINE DELPHI2006}
+ {$DEFINE BCB10}
+ {$DEFINE BCB2006}
+ {$DEFINE BDS4}
+ {$DEFINE BDS2006}
+{$ENDIF}
+
+{$IFDEF VER170}
+ {$DEFINE COMPILER9}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI9}
+ {$DEFINE DELPHI2005}
+ {$DEFINE BDS3}
+ {$DEFINE BDS2005}
+{$ENDIF}
+
+{$IFDEF VER160}
+ {$DEFINE COMPILER8}
+ {$DEFINE VCL71}
+ {$DEFINE DELPHI8}
+ {$DEFINE BDS2}
+{$ENDIF}
+
+{$IFDEF VER150}
+ {$DEFINE COMPILER7}
+ {$IFDEF LINUX}
+ {$DEFINE CLX10}
+ {$ELSE}
+ {$DEFINE VCL70}
+ {$DEFINE CLX10}
+ {$IFDEF BCB}
+ {$DEFINE BCB7}
+ {$ELSE}
+ {$DEFINE DELPHI7}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER140}
+ {$DEFINE COMPILER6}
+ {$IFDEF LINUX}
+ {$DEFINE CLX10}
+ {$IFDEF CONDITIONALEXPRESSIONS}
+ {$IFDEF CompilerVersion}
+ {$IF System.RTLVersion = 14.1}
+ {$DEFINE KYLIX2}
+ {$IFEND}
+ {$IF System.RTLVersion = 14.5}
+ {$DEFINE KYLIX3}
+ {$IFEND}
+ {$ELSE}
+ {$DEFINE KYLIX1}
+ {$ENDIF}
+ {$ENDIF}
+ {$ELSE}
+ {$DEFINE VCL60}
+ {$DEFINE CLX10}
+ {$IFDEF BCB}
+ {$DEFINE BCB6}
+ {$ELSE}
+ {$DEFINE DELPHI6}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER130}
+ {$DEFINE COMPILER5}
+ {$DEFINE VCL50}
+ {$IFDEF BCB}
+ {$DEFINE BCB5}
+ {$ELSE}
+ {$DEFINE DELPHI5}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER125}
+ {$DEFINE COMPILER4}
+ {$DEFINE VCL40}
+ {$DEFINE BCB4}
+{$ENDIF}
+
+{$IFDEF VER120}
+ {$DEFINE COMPILER4}
+ {$DEFINE VCL40}
+ {$DEFINE DELPHI4}
+{$ENDIF}
+
+{$IFDEF VER110}
+ {$DEFINE COMPILER35}
+ {$DEFINE VCL30}
+ {$DEFINE BCB3}
+{$ENDIF}
+
+{$IFDEF VER100}
+ {$DEFINE COMPILER3}
+ {$DEFINE VCL30}
+ {$DEFINE DELPHI3}
+{$ENDIF}
+
+{$IFDEF VER93}
+ {$DEFINE COMPILER2}
+ {$DEFINE VCL20}
+ {$DEFINE BCB1}
+{$ENDIF}
+
+{$IFDEF VER90}
+ {$DEFINE COMPILER2}
+ {$DEFINE VCL20}
+ {$DEFINE DELPHI2}
+{$ENDIF}
+
+{$IFDEF VER80}
+ {$DEFINE COMPILER1}
+ {$DEFINE VCL10}
+ {$DEFINE DELPHI1}
+{$ENDIF}
+
+// DELPHIX_UP from DELPHIX mappings
+
+{$IFDEF DELPHI29}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI29_UP}
+ {$DEFINE DELPHI28_UP}
+ {$DEFINE DELPHI27_UP}
+ {$DEFINE DELPHI26_UP}
+ {$DEFINE DELPHI25_UP}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI120_ATHENS}
+ {$DEFINE DELPHI120_ATHENS_UP}
+ {$DEFINE DELPHI110_ALEXANDRIA_UP}
+ {$DEFINE DELPHI104_SYDNEY_UP}
+ {$DEFINE DELPHI103_RIO_UP}
+ {$DEFINE DELPHI102_TOKYO_UP}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI28}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI28_UP}
+ {$DEFINE DELPHI27_UP}
+ {$DEFINE DELPHI26_UP}
+ {$DEFINE DELPHI25_UP}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI110_ALEXANDRIA}
+ {$DEFINE DELPHI110_ALEXANDRIA_UP}
+ {$DEFINE DELPHI104_SYDNEY_UP}
+ {$DEFINE DELPHI103_RIO_UP}
+ {$DEFINE DELPHI102_TOKYO_UP}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI27}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI27_UP}
+ {$DEFINE DELPHI26_UP}
+ {$DEFINE DELPHI25_UP}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI104_SYDNEY}
+ {$DEFINE DELPHI104_SYDNEY_UP}
+ {$DEFINE DELPHI103_RIO_UP}
+ {$DEFINE DELPHI102_TOKYO_UP}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI26}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI26_UP}
+ {$DEFINE DELPHI25_UP}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI103_RIO}
+ {$DEFINE DELPHI103_RIO_UP}
+ {$DEFINE DELPHI102_TOKYO_UP}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI25}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI25_UP}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI102_TOKYO}
+ {$DEFINE DELPHI102_TOKYO_UP}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI24}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI24_UP}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI101_BERLIN}
+ {$DEFINE DELPHI101_BERLIN_UP}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI23}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI23_UP}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI10_SEATTLE}
+ {$DEFINE DELPHI10_SEATTLE_UP}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI22}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI22_UP}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE8}
+ {$DEFINE DELPHIXE8_UP}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI21}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI21_UP}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE7}
+ {$DEFINE DELPHIXE7_UP}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI20}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI20_UP}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE6}
+ {$DEFINE DELPHIXE6_UP}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI19}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI19_UP}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE5}
+ {$DEFINE DELPHIXE5_UP}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI18}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI18_UP}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE4}
+ {$DEFINE DELPHIXE4_UP}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+
+ // NO DELPHI2014 defined, so need define below here.
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI17}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI17_UP}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE3}
+ {$DEFINE DELPHIXE3_UP}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2013}
+ {$DEFINE DELPHI2013_UP}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI16}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI16_UP}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE2}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE DELPHIXE_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2012}
+ {$DEFINE DELPHI2012_UP}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI15}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI15_UP}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHIXE}
+ {$DEFINE DELPHIXE_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2011}
+ {$DEFINE DELPHI2011_UP}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI14}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI14_UP}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2010}
+ {$DEFINE DELPHI2010_UP}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI12}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI12_UP}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2009}
+ {$DEFINE DELPHI2009_UP}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI11}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI11_UP}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2007}
+ {$DEFINE DELPHI2007_UP}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI10}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI10_UP}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2006}
+ {$DEFINE DELPHI2006_UP}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI9}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI9_UP}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2005}
+ {$DEFINE DELPHI2005_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI8}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI8_UP}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI7}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI7_UP}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI6}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI6_UP}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI5}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI5_UP}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI4}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI4_UP}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI3}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI3_UP}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI2}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI2_UP}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+{$IFDEF DELPHI1}
+ {$DEFINE DELPHI}
+ {$DEFINE DELPHI1_UP}
+{$ENDIF}
+
+// BCBX_UP from BCBX mappings
+
+{$IFDEF BCB29}
+ {$DEFINE BCB}
+ {$DEFINE BCB29_UP}
+ {$DEFINE BCB28_UP}
+ {$DEFINE BCB27_UP}
+ {$DEFINE BCB26_UP}
+ {$DEFINE BCB25_UP}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB120_ATHENS}
+ {$DEFINE BCB120_ATHENS_UP}
+ {$DEFINE BCB110_ALEXANDRIA_UP}
+ {$DEFINE BCB104_SYDNEY_UP}
+ {$DEFINE BCB103_RIO_UP}
+ {$DEFINE BCB102_TOKYO_UP}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB28}
+ {$DEFINE BCB}
+ {$DEFINE BCB28_UP}
+ {$DEFINE BCB27_UP}
+ {$DEFINE BCB26_UP}
+ {$DEFINE BCB25_UP}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB110_ALEXANDRIA}
+ {$DEFINE BCB110_ALEXANDRIA_UP}
+ {$DEFINE BCB104_SYDNEY_UP}
+ {$DEFINE BCB103_RIO_UP}
+ {$DEFINE BCB102_TOKYO_UP}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB27}
+ {$DEFINE BCB}
+ {$DEFINE BCB27_UP}
+ {$DEFINE BCB26_UP}
+ {$DEFINE BCB25_UP}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB104_SYDNEY}
+ {$DEFINE BCB104_SYDNEY_UP}
+ {$DEFINE BCB103_RIO_UP}
+ {$DEFINE BCB102_TOKYO_UP}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB26}
+ {$DEFINE BCB}
+ {$DEFINE BCB26_UP}
+ {$DEFINE BCB25_UP}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB103_RIO}
+ {$DEFINE BCB103_RIO_UP}
+ {$DEFINE BCB102_TOKYO_UP}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB25}
+ {$DEFINE BCB}
+ {$DEFINE BCB25_UP}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB102_TOKYO}
+ {$DEFINE BCB102_TOKYO_UP}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+
+{$IFDEF BCB24}
+ {$DEFINE BCB}
+ {$DEFINE BCB24_UP}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB101_BERLIN}
+ {$DEFINE BCB101_BERLIN_UP}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB23}
+ {$DEFINE BCB}
+ {$DEFINE BCB23_UP}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB10_SEATTLE}
+ {$DEFINE BCB10_SEATTLE_UP}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB22}
+ {$DEFINE BCB}
+ {$DEFINE BCB22_UP}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE8}
+ {$DEFINE BCBXE8_UP}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB21}
+ {$DEFINE BCB}
+ {$DEFINE BCB21_UP}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE7}
+ {$DEFINE BCBXE7_UP}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB20}
+ {$DEFINE BCB}
+ {$DEFINE BCB20_UP}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE6}
+ {$DEFINE BCBXE6_UP}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB19}
+ {$DEFINE BCB}
+ {$DEFINE BCB19_UP}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE5}
+ {$DEFINE BCBXE5_UP}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB18}
+ {$DEFINE BCB}
+ {$DEFINE BCB18_UP}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE4}
+ {$DEFINE BCBXE4_UP}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+
+ // NO BCB2014 defined, so need define below here.
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB17}
+ {$DEFINE BCB}
+ {$DEFINE BCB17_UP}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE3}
+ {$DEFINE BCBXE3_UP}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+{$ENDIF}
+
+{$IFDEF BCB2013}
+ {$DEFINE BCB2013_UP}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB16}
+ {$DEFINE BCB}
+ {$DEFINE BCB16_UP}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE2}
+ {$DEFINE BCBXE2_UP}
+ {$DEFINE BCBXE_UP}
+{$ENDIF}
+
+{$IFDEF BCB2012}
+ {$DEFINE BCB2012_UP}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB15}
+ {$DEFINE BCB}
+ {$DEFINE BCB15_UP}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCBXE}
+ {$DEFINE BCBXE_UP}
+{$ENDIF}
+
+{$IFDEF BCB2011}
+ {$DEFINE BCB2011_UP}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB14}
+ {$DEFINE BCB}
+ {$DEFINE BCB14_UP}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB2010}
+ {$DEFINE BCB2010_UP}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB12}
+ {$DEFINE BCB}
+ {$DEFINE BCB12_UP}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB2009}
+ {$DEFINE BCB2009_UP}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB11}
+ {$DEFINE BCB}
+ {$DEFINE BCB11_UP}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB2007}
+ {$DEFINE BCB2007_UP}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB10}
+ {$DEFINE BCB}
+ {$DEFINE BCB10_UP}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB2006}
+ {$DEFINE BCB2006_UP}
+{$ENDIF}
+
+{$IFDEF BCB7}
+ {$DEFINE BCB}
+ {$DEFINE BCB7_UP}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB6}
+ {$DEFINE BCB}
+ {$DEFINE BCB6_UP}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB5}
+ {$DEFINE BCB}
+ {$DEFINE BCB5_UP}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB4}
+ {$DEFINE BCB}
+ {$DEFINE BCB4_UP}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB3}
+ {$DEFINE BCB}
+ {$DEFINE BCB3_UP}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+{$IFDEF BCB1}
+ {$DEFINE BCB}
+ {$DEFINE BCB1_UP}
+{$ENDIF}
+
+// KYLIXX_UP from KYLIXX mappings
+
+{$IFDEF KYLIX3}
+ {$DEFINE KYLIX}
+ {$DEFINE KYLIX3_UP}
+ {$DEFINE KYLIX2_UP}
+ {$DEFINE KYLIX1_UP}
+{$ENDIF}
+
+{$IFDEF KYLIX2}
+ {$DEFINE KYLIX}
+ {$DEFINE KYLIX2_UP}
+ {$DEFINE KYLIX1_UP}
+{$ENDIF}
+
+{$IFDEF KYLIX1}
+ {$DEFINE KYLIX}
+ {$DEFINE KYLIX1_UP}
+{$ENDIF}
+
+// BDSXX_UP from BDSXX mappings
+
+{$IFDEF BDS23} // 12.0 ATHENS
+ {$DEFINE BDS}
+ {$DEFINE BDS23_UP}
+ {$DEFINE BDS22_UP}
+ {$DEFINE BDS21_UP}
+ {$DEFINE BDS20_UP}
+ {$DEFINE BDS19_UP}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS22} // 11.0 ALEXANDRIA
+ {$DEFINE BDS}
+ {$DEFINE BDS22_UP}
+ {$DEFINE BDS21_UP}
+ {$DEFINE BDS20_UP}
+ {$DEFINE BDS19_UP}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS21} // 10.4 SYDNEY
+ {$DEFINE BDS}
+ {$DEFINE BDS21_UP}
+ {$DEFINE BDS20_UP}
+ {$DEFINE BDS19_UP}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS20} // 10.3 RIO
+ {$DEFINE BDS}
+ {$DEFINE BDS20_UP}
+ {$DEFINE BDS19_UP}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS19} // 10.2 Tokyo
+ {$DEFINE BDS}
+ {$DEFINE BDS19_UP}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS18} // 10.1 Berlin
+ {$DEFINE BDS}
+ {$DEFINE BDS18_UP}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS17} // 10 Seattle
+ {$DEFINE BDS}
+ {$DEFINE BDS17_UP}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS16}
+ {$DEFINE BDS}
+ {$DEFINE BDS16_UP}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS15}
+ {$DEFINE BDS}
+ {$DEFINE BDS15_UP}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS14}
+ {$DEFINE BDS}
+ {$DEFINE BDS14_UP}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS12}
+ {$DEFINE BDS}
+ {$DEFINE BDS12_UP}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS11}
+ {$DEFINE BDS}
+ {$DEFINE BDS11_UP}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+
+ // NO BDS2014 defined, so need define below here.
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS10}
+ {$DEFINE BDS}
+ {$DEFINE BDS10_UP}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2013}
+ {$DEFINE BDS2013_UP}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS9}
+ {$DEFINE BDS}
+ {$DEFINE BDS9_UP}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2012}
+ {$DEFINE BDS2012_UP}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS8}
+ {$DEFINE BDS}
+ {$DEFINE BDS8_UP}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2011}
+ {$DEFINE BDS2011_UP}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS7}
+ {$DEFINE BDS}
+ {$DEFINE BDS7_UP}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2010}
+ {$DEFINE BDS2010_UP}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS6}
+ {$DEFINE BDS}
+ {$DEFINE BDS6_UP}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2009}
+ {$DEFINE BDS2009_UP}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS5}
+ {$DEFINE BDS}
+ {$DEFINE BDS5_UP}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2007}
+ {$DEFINE BDS2007_UP}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS4}
+ {$DEFINE BDS}
+ {$DEFINE BDS4_UP}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2006}
+ {$DEFINE BDS2006_UP}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS3}
+ {$DEFINE BDS}
+ {$DEFINE BDS3_UP}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS2005}
+ {$DEFINE BDS2005_UP}
+{$ENDIF}
+
+{$IFDEF BDS2}
+ {$DEFINE BDS}
+ {$DEFINE BDS2_UP}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+{$IFDEF BDS1}
+ {$DEFINE BDS}
+ {$DEFINE BDS1_UP}
+{$ENDIF}
+
+// COMPILERX_UP from COMPILERX mappings
+
+{$IFDEF COMPILER29} // 12.0 ATHENS
+ {$DEFINE COMPILER29_UP}
+ {$DEFINE COMPILER28_UP}
+ {$DEFINE COMPILER27_UP}
+ {$DEFINE COMPILER26_UP}
+ {$DEFINE COMPILER25_UP}
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER28} // 11.0 ALEXANDRIA
+ {$DEFINE COMPILER28_UP}
+ {$DEFINE COMPILER27_UP}
+ {$DEFINE COMPILER26_UP}
+ {$DEFINE COMPILER25_UP}
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER27} // 10.4 SYDNEY
+ {$DEFINE COMPILER27_UP}
+ {$DEFINE COMPILER26_UP}
+ {$DEFINE COMPILER25_UP}
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER26} // 10.3 RIO
+ {$DEFINE COMPILER26_UP}
+ {$DEFINE COMPILER25_UP}
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER25} // 10.2 Tokyo
+ {$DEFINE COMPILER25_UP}
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER24} // 10.1 Berlin
+ {$DEFINE COMPILER24_UP}
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER23} // 10 Seattle
+ {$DEFINE COMPILER23_UP}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER22}
+ {$DEFINE COMPILER22_UP}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER21}
+ {$DEFINE COMPILER21_UP}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER20}
+ {$DEFINE COMPILER20_UP}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER19}
+ {$DEFINE COMPILER19_UP}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER18}
+ {$DEFINE COMPILER18_UP}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER17}
+ {$DEFINE COMPILER17_UP}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER16}
+ {$DEFINE COMPILER16_UP}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER15}
+ {$DEFINE COMPILER15_UP}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER14}
+ {$DEFINE COMPILER14_UP}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER12}
+ {$DEFINE COMPILER12_UP}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER11}
+ {$DEFINE COMPILER11_UP}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER10}
+ {$DEFINE COMPILER10_UP}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER9}
+ {$DEFINE COMPILER9_UP}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER8}
+ {$DEFINE COMPILER8_UP}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER7}
+ {$DEFINE COMPILER7_UP}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER6}
+ {$DEFINE COMPILER6_UP}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER5}
+ {$DEFINE COMPILER5_UP}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER4}
+ {$DEFINE COMPILER4_UP}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER35}
+ {$DEFINE COMPILER35_UP}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER3}
+ {$DEFINE COMPILER3_UP}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER2}
+ {$DEFINE COMPILER2_UP}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+{$IFDEF COMPILER1}
+ {$DEFINE COMPILER1_UP}
+{$ENDIF}
+
+// VCLXX_UP from VCLXX mappings
+
+{$IFDEF UCL10}
+ {$DEFINE UCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL71}
+ {$DEFINE VCL71_UP}
+ {$DEFINE VCL70_UP}
+ {$DEFINE VCL60_UP}
+ {$DEFINE VCL50_UP}
+ {$DEFINE VCL40_UP}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL70}
+ {$DEFINE VCL70_UP}
+ {$DEFINE VCL60_UP}
+ {$DEFINE VCL50_UP}
+ {$DEFINE VCL40_UP}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL60}
+ {$DEFINE VCL60_UP}
+ {$DEFINE VCL50_UP}
+ {$DEFINE VCL40_UP}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL50}
+ {$DEFINE VCL50_UP}
+ {$DEFINE VCL40_UP}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL40}
+ {$DEFINE VCL40_UP}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL30}
+ {$DEFINE VCL30_UP}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL20}
+ {$DEFINE VCL20_UP}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+{$IFDEF VCL10}
+ {$DEFINE VCL10_UP}
+{$ENDIF}
+
+// CLXXX_UP from CLXXX mappings
+
+{$IFDEF CLX10}
+ {$DEFINE CLX10_UP}
+{$ENDIF}
+
+//==============================================================================
+// ƽ̨ض
+//==============================================================================
+
+{$IFDEF COMPILER1}
+ {$DEFINE WIN16}
+ {$DEFINE MSWINDOWS}
+{$ENDIF}
+
+{$IFDEF BDS}
+ {$DEFINE DOTNET}
+{$ENDIF}
+
+{$IFDEF WIN32}
+ {$DEFINE MSWINDOWS}
+{$ENDIF}
+
+{$IFDEF LINUX}
+ {$DEFINE UNIX}
+ {$DEFINE COMPLIB_CLX}
+{$ENDIF}
+
+{$IFNDEF COMPLIB_CLX}
+ {$DEFINE COMPLIB_VCL}
+{$ENDIF}
+
+//==============================================================================
+// ӳ汾ϢѺõָ
+//==============================================================================
+
+{$IFDEF DELPHI}
+ {$DEFINE SUPPORT_PASCAL}
+{$ENDIF}
+
+{$IFDEF BCB}
+ {$DEFINE SUPPORT_PASCAL}
+ {$DEFINE SUPPORT_CPLUSPLUS}
+{$ENDIF}
+
+{$IFDEF DELPHI120_ATHENS_UP}
+ {$DEFINE LIST_INDEX_NATIVEINT} // Athens 12 TList use NativeInt for Index and Count instead of Integer
+ {$DEFINE IDE_HAS_TABMENU_COPY_PATH} // Athens 12 editor tab menu has item to copy path or filename
+ {$DEFINE IDE_HAS_DBCLICK_HIGHLIGHT} // Athens 12 editor double click selection highlight
+ {$DEFINE OTA_CODEEDITOR_SERVICE} // 11.3 ToolsAPI.Editor ӿڣʱ 11.0/1/2 ֻ֣ܼӵ 12
+{$ENDIF}
+
+{$IFDEF DELPHI110_ALEXANDRIA_UP}
+ {$DEFINE NO_OLDCREATEORDER} // Alexandria 11 removed OldCreateOrder
+ {$DEFINE IDE_SUPPORT_HDPI} // Alexandria 11 supports HDPI using TVirtualImageList, etc.
+ {$DEFINE IDE_HAS_AUTO_READONLY} // Alexandria 11 supports auto open VCL source readonly
+ {$DEFINE IDE_HAS_MEMORY_VISUALIZAER} // Alexandria 11 has Memory Visualizer for Debug
+ {$DEFINE TSTRINGS_SETTEXTSTR_CANNULL} // Alexandria 11 TStrings.SetTextStr Ignore #0 Terminated Char
+ {$DEFINE MEMORYSTREAM_CAPACITY_NATIVEINT} // Alexandria 11 TMemoryStream Capacity is NativeInt instead of Longint
+{$ENDIF}
+
+{$IFDEF DELPHI104_SYDNEY_UP}
+ {$DEFINE IDE_SUPPORT_LSP} // Sydney 10.4 ֧ LSP Է
+ {$DEFINE IDE_HAS_ERRORINSIGHT} // Sydney 10.4.2 ֱ֧༭ ErrorInsight
+ {$DEFINE IDE_EDITOR_CUSTOM_COLUMN} // Sydney 10.4 ϱ༭ Gutter ֧Զ壬ûӿڲݣԼ
+ {$DEFINE IDE_SWITCH_BUG} // Sydney 10.4.2 ڴļʱĪл̨ Bug
+{$ENDIF}
+
+{$IFDEF DELPHI103_RIO_UP}
+ {$DEFINE SUPPORT_MACOS64} // Rio 10.3.2 ֧ 64 λ MacOS
+{$ENDIF}
+
+{$IFDEF DELPHI102_TOKYO_UP}
+ {$DEFINE SUPPORT_LINUX64} // Tokyo 10.2 ֧ Linux 64 λ Server
+ {$DEFINE IDE_SUPPORT_THEMING} // Tokyo 10.2.2 ֧ IDE л
+{$ENDIF}
+
+{$IFDEF DELPHI101_BERLIN_UP}
+ {$DEFINE IDE_NEW_EMBEDDED_DESIGNER} // 101B Re-opens "Embedded Designer" Option and Gives a New Container.
+{$ENDIF}
+
+{$IFDEF DELPHI10_SEATTLE_UP}
+ {$DEFINE IDE_HAS_OWN_STRUCTUAL_HIGHLIGHT} // 10S has own Structual Highlight
+ {$DEFINE IDE_HAS_HIDE_NONVISUAL} // 10S has "Hide Nonvisual" Feature.
+{$ENDIF}
+
+{$IFDEF DELPHIXE8_UP}
+ {$DEFINE INIFILE_READWRITE_INTEGER} // XE8 IniFile ReadInteger WriteInteger ʼ LongInt Ϊ Integer
+ {$DEFINE IDE_INTEGRATE_CASTALIA} // XE8/10S and above integrate Castalia.
+{$ENDIF}
+
+{$IFDEF COMPILER21_UP} // COMPILER21 = XE7
+ {$DEFINE NOT_SUPPORT_BDE} // BDE
+{$ENDIF}
+
+{$IFDEF DELPHIXE7_UP}
+ {$DEFINE SUPPORT_TBYTES_OPERATION} // XE7 TBytes ʼ֧ӡȲ
+ {$DEFINE FMX_CONTROL_HAS_SIZE} // XE7 FMX Control Size
+{$ENDIF}
+
+{$IFDEF DELPHIXE6_UP}
+ {$DEFINE SUPPORT_JSON} // XE6 System.JSON ⣬ DBX/REST
+{$ENDIF}
+
+{$IFDEF DELPHIXE5_UP}
+ {$DEFINE SUPPORT_MOBILE} // XE5 ʼ֧ƶ
+ {$DEFINE IDE_HAS_INSIGHT} // XE5 has IDE Insight Bar
+{$ENDIF}
+
+{$IFDEF DELPHIXE4_UP}
+ {$IFNDEF DISABLE_FMX}
+ {$DEFINE SUPPORT_FMX_FRAME} // XE4 FMX Supports FMX Frame
+ {$ENDIF}
+{$ELSE}
+ {$DEFINE MEMO_CARETPOS_BUG} // Memo CaretPos Get Negative Error Value for Large File under XE3 or below
+{$ENDIF}
+
+{$IFDEF DELPHIXE3_UP}
+ {$DEFINE SUPPORT_ATOMIC} // XE3 has Atomic Routines
+ {$DEFINE TCONTROL_HAS_STYLEELEMENTS} // XE3 TControl has StyleElements Property
+ {$DEFINE IDE_NP_FMX_DESIGN_BUG} // XE3 FMX Designer Cut/Copy/Paste cause AV Bug for -np switch
+{$ENDIF}
+
+{$IFDEF DELPHIXE2_UP}
+ {$DEFINE SUPPORT_WIN64} // XE2 Supports Win64
+ {$DEFINE SUPPORT_MACOS32} // XE2 Supports MacOS 32
+ {$DEFINE SUPPORT_UNITNAME_DOT}
+ {$DEFINE SUPPORT_ENHANCED_INDEXEDPROPERTY} // XE2 New RTTI Supports IndexedProperty
+ {$DEFINE SUPPORT_ZLIB_WINDOWBITS} // XE2 ZLib Supports WindowBits
+ {$DEFINE SUPPORT_GDIPLUS} // XE2 Supports GDI+
+ {$DEFINE SUPPORT_INT64ARRAY} // XE2 Defined Int64Array
+ {$DEFINE SUPPORT_ALPHACOLOR} // XE2 System.UITypes Has TAlphaColors
+{$ENDIF}
+
+{$IFDEF DELPHIXE_UP}
+ {$DEFINE TSTRINGS_HAS_WRITEBOM} // XE TStrings has WriteBOM property.
+ {$DEFINE IDE_HAS_DEBUGGERVISUALIZER} // XE ToolsAPI has Debugger Visualizer Interfaces.
+ {$DEFINE IDE_HAS_STRINGS_VISUALIZAER} // XE has TStrings Visualizer for Debug
+{$ENDIF}
+
+{$IFDEF BDS2012_UP} // 2012 = XE2
+ {$DEFINE SUPPORT_32_AND_64} // XE2 Support Win32 and Win64
+ {$IFNDEF DISABLE_FMX}
+ {$DEFINE SUPPORT_FMX}
+ {$ENDIF}
+ {$DEFINE SUPPORT_CROSS_PLATFORM} // XE2 ֿ֧ƽ̨
+ {$DEFINE VERSIONINFO_PER_CONFIGURATION} // Every Configuruation can have a Version Info.
+ {$DEFINE OTA_ENVOPTIONS_PLATFORM_BUG}
+ // A Bug Can't get Correct Env Option Values for Current Platform.
+ {$DEFINE LIST_NEW_POINTER}
+{$ENDIF}
+
+{$IFDEF BDS2010_UP}
+ {$DEFINE SUPPORT_INTERFACE_AS_OBJECT}
+ {$DEFINE SUPPORT_ENHANCED_RTTI} // New enhanced RTTI.
+ {$DEFINE SUPPORT_EXTERNAL_DELAYED} // External functions can be declared as 'delayed'.
+ {$DEFINE SUPPORT_CLASS_CONSTRUCTOR} // 2010 and above Supports class constructor and destructor
+ {$DEFINE SUPPORT_CLASS_DESTRUCTOR}
+ {$DEFINE IMAGELIST_BEGINENDUPDATE} // 2010 ʼImageList й BeginUpdate EndUpdate
+ {$DEFINE OTA_DEBUG_HAS_EVENTS} // 2010 µ DebuggerService ProcessDebugEvents
+ {$DEFINE IDE_HAS_NEW_COMPONENT_PALETTE} // IDE has a new style Component Palette.
+ {$DEFINE IDE_HAS_EDITOR_SEARCHPANEL} // Editor has a Search Panel
+ {$DEFINE IDE_HAS_DATETIME_HINT} // TDate/TTime/TDateTime shows Normally in Debug Hint
+{$ENDIF}
+
+{$IFDEF BDS2010}
+ // 2010 EditView CursorPos EditPosition.InsertText ƫ
+ {$DEFINE EDITVIEW_SETCURSORPOS_BUG}
+{$ENDIF}
+
+{$IFDEF BDS2009_UP}
+ {$DEFINE UNICODE_STRING}
+ {$DEFINE SUPPORT_ATTRIBUTE} // ֧ Attribute
+ {$DEFINE SUPPORT_GENERIC} // ַ֧
+ {$DEFINE SUPPORT_ANSISTRING_CODEPAGE} // AnsiString ָ֧ҳ
+ {$DEFINE SUPPORT_ENCODING} // Unicode with TEncoding
+ {$DEFINE SUPPORT_PUINT64} // Has Pointer of UInt64
+ {$DEFINE OBJECT_HAS_TOSTRING} // TObject.ToString Function
+ {$DEFINE OBJECT_HAS_EQUAL} // TObject.Equal Function
+ {$DEFINE OBJECT_HAS_GETHASHCODE} // TObject.GetHashCode Function
+ {$DEFINE TGRAPHIC_SUPPORT_PARTIALTRANSPARENCY} // TGraphic ֧ Alpha ͨ
+ {$DEFINE SUPPORT_OTA_PROJECT_CONFIGURATION}
+
+ {$DEFINE IDE_MAINFORM_EAT_MOUSEWHEEL}
+ // MainForm of 2009 or Above will eat Message in MouseWheelHandler
+ {$DEFINE IDE_CODEINSIGHT_AUTOINVOKE}
+ // IDE Code Insight has Auto Invoke Option
+ {$DEFINE EDITVIEW_CONVERTPOS_BUG}
+ // 2009 or Above IEditView.ConvertPos Incorrect when Meeting Unicode Chars.
+
+ {$IFNDEF DELPHIXE2_UP} // 2009/2010/XE has a Project Version Number Bug.
+ {$DEFINE PROJECT_VERSION_NUMBER_BUG}
+ {$ENDIF}
+ {$DEFINE OTA_DPKOPTION_SETVALUE_CORRUPT_BUG}
+ // A OpenTools API Bug IOTAProjectOptions.SetOptionValue under 2009 or above:
+ // Set an Option Value to DPK Project Options maybe cause DPK Source Corrupt.
+{$ELSE}
+ {$DEFINE ZLIB_STREAM_NOSIZE} // 2007 µ Zlib Ľѹ֧ Size
+{$ENDIF}
+
+{$IFDEF BDS2009}
+ // 2009 CreateParams пܵѭ
+ {$DEFINE CREATE_PARAMS_BUG}
+ // 2009 EditView CursorPos EditPosition.InsertText ƫ
+ {$DEFINE EDITVIEW_SETCURSORPOS_BUG}
+{$ENDIF}
+
+{$IFDEF BDS2007_UP}
+ {$DEFINE IDE_CONF_MANAGER}
+ {$DEFINE TBYTES_DEFINED} // 2007 Defined TBytes = array of Byte;
+ {$DEFINE PROJECT_FILENAME_DPROJ} // Project File is .dproj
+{$ENDIF}
+
+{$IFDEF BDS2007}
+ // RAD Studio 2007 ¿ AutoComplete ᵼĺ˸
+ {$DEFINE COMBOBOX_CHS_BUG}
+{$ENDIF}
+
+{$IFDEF BDS2006_UP}
+ {$DEFINE SUPPORT_CLASS_VAR} // 2006 and above Supports class var
+ {$DEFINE TCONTROL_HAS_MARGINS} // 2006 and above TControl has Margins
+ {$DEFINE TCONTROL_HAS_EXPLICIT_BOUNDS} // 2006 and above TControl has Explicit Bounds
+ {$DEFINE TCONTROL_HAS_MOUSEENTERLEAVE} // 2006 and above TControl has Mouse Enter/Leave Events
+ {$DEFINE OTA_CODE_TEMPLATE_API} // 2006 and above Provides CodeTemplateAPI.
+ {$DEFINE OTA_DEBUG_HAS_ERBUSY} // 2006 µ Evaluate зֵ erBusy
+ {$DEFINE IDE_HAS_GUIDE_LINE} // 2006 and above has Designer Guide Line
+ {$DEFINE IDE_SYNC_EDIT_BLOCK} // 2006 and above Editor Supports Sync Block Edit
+ {$DEFINE EDITOR_TAB_ONLYFROM_WINCONTROL}
+ // From BDS 2006 IDEGraident Editor Tab is Only From WinControl, not TabSet/TabControl
+{$ENDIF}
+
+{$IFDEF BDS2005_UP}
+ {$DEFINE OTA_PALETTE_API} // 2005 and above Provides PaletteAPI.
+ {$DEFINE IDE_EDITOR_ELIDE} // 2005 ϱ༭֧۵
+ {$DEFINE IDE_FILE_HISTORY} // 2005 ϰ汾洢ļʷ汾
+{$ENDIF}
+
+{$IFDEF BDS2006}
+ {$DEFINE PROJECT_FILENAME_BDSPROJ} // Project File is .bdsproj
+{$ENDIF}
+
+{$IFDEF BDS2005}
+ {$DEFINE PROJECT_FILENAME_BDSPROJ} // Project File is .bdsproj
+{$ENDIF}
+
+{$IFDEF BDS} // 2005
+ {$DEFINE SUPPORT_PASCAL}
+ {$DEFINE SUPPORT_CSHARP}
+ {$DEFINE SUPPORT_INLINE}
+ {$DEFINE SUPPORT_UINT64}
+ {$DEFINE IDE_WIDECONTROL} // 2005 ϵı༭ڲǿַ UTF-8Ƿ Unicode
+ {$DEFINE IDE_EDITOR_SUPPORT_FOLDING} // 2005 ϵı༭֧۵
+ {$DEFINE OTA_NEW_BREAKPOINT_NOBUG} // 2005 ϵ NewBreakpoint ܹ
+ {$DEFINE IDE_ACTION_UPDATE_DELAY} // IDE's Action Menu Update will Delay in 2005 or Up.
+ {$DEFINE SUPPORT_WIDECHAR_IDENTIFIER}
+
+ {$IFNDEF COMPILER12_UP}
+ // 2005~2007 Compiler is Ansi but Editor String is UTF-8
+ {$DEFINE IDE_STRING_ANSI_UTF8}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF DELPHI7_UP}
+ {$DEFINE SUPPORT_FORMAT_SETTINGS} // Delphi 7 ʼ֧ FormatSettings
+ {$DEFINE IDE_MENUBAR_VERTICAL_POSITION_BUG}
+ // Delphi 7 ϵ MenuBar ֱϵĵλü׳Ͻ
+ {$DEFINE IDE_MENUBAR_VERTICAL_NOSCROLL_BUG}
+ // Delphi 7 ϵ MenuBar ֱʱ
+{$ENDIF}
+
+{$IFDEF COMPILER6_UP}
+ {$DEFINE SUPPORT_DEPRECATED}
+{$ENDIF}
+
+{$IFDEF COMPILER6_UP}
+ {$DEFINE SUPPORT_ENUMVALUES}
+ {$DEFINE SUPPORT_VARIANTS}
+ {$DEFINE SUPPORT_IFDIRECTIVE}
+{$ENDIF}
+
+{$IFDEF DELPHI5_UP}
+ {$IFNDEF BDS2005_UP}
+ {$DEFINE PROJECT_FILENAME_DPR} // Delphi 5/6/7 Project File is .dpr
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF COMPILER5}
+ {$DEFINE TSTREAM_LONGINT} // D6 ϵ TStream Int64
+{$ENDIF}
+
+{$IFDEF BCB5}
+ {$DEFINE BCB5OR6} // һ BCB5OR6 Է BCB5 BCB6 ʹ
+{$ENDIF}
+
+{$IFDEF BCB6}
+ {$DEFINE BCB5OR6}
+{$ENDIF}
+
+{$IFDEF BCB5OR6}
+ {$DEFINE NO_ZLIB}
+{$ENDIF}
+
+{$IFDEF DELPHI5}
+ {$DEFINE DELPHI5OR6} // һ DELPHI5OR6 Է DELPHI5 DELPHI6 ʹ
+{$ENDIF}
+
+{$IFDEF DELPHI6}
+ {$DEFINE DELPHI5OR6}
+{$ENDIF}
+
+{$IFDEF COMPILER4_UP}
+ {$DEFINE SUPPORT_INT64}
+ {$DEFINE SUPPORT_DYNAMICARRAYS}
+ {$DEFINE SUPPORT_DEFAULTPARAMS}
+ {$DEFINE SUPPORT_REINTRODUCE}
+ {$DEFINE SUPPORT_OVERLOAD}
+{$ENDIF}
+
+{$IFDEF COMPILER35_UP}
+ {$DEFINE SUPPORT_EXTSYM}
+ {$DEFINE SUPPORT_NODEFINE}
+{$ENDIF}
+
+{$IFDEF COMPILER3_UP}
+ {$DEFINE SUPPORT_WIDESTRING}
+ {$DEFINE SUPPORT_INTERFACE}
+{$ENDIF}
+
+{$IFDEF WIN64}
+ {$DEFINE EXTENDED_SIZE_8} // Win64 Extended ͳ 8 ֽ
+{$ENDIF}
+
+{$IFDEF CPUARM}
+ {$DEFINE EXTENDED_SIZE_8} // ARM ƽ̨ Extended ͳ 8 ֽ
+{$ENDIF}
+
+{$IFDEF WIN32}
+ {$DEFINE EXTENDED_SIZE_10} // Win32 Extended ͳ 10 ֽ
+{$ENDIF}
+
+{$IFDEF MACOS64}
+ {$DEFINE EXTENDED_SIZE_16} // MacOS64 Extended ͳ 16 ֽ
+{$ENDIF}
+
+{$IFDEF LINUX64}
+ {$DEFINE EXTENDED_SIZE_16} // Linux64 Extended ͳ 16 ֽ
+{$ENDIF}
+
+//==============================================================================
+// PascalScript ĵ
+//==============================================================================
+
+{.$DEFINE ALLDEBUG} // òƲҪȽ
+
+//==============================================================================
+// ֶ
+//==============================================================================
+
+{$DEFINE GB2312}
+{.$DEFINE BIG5}
+{.$DEFINE ENGLISH}
+
+//==============================================================================
+// ıָ
+//==============================================================================
+
+{$A+ Force alignment on word/dword boundaries}
+{$S+ stack checking}
+
+{$B- Short evaluation of boolean values}
+{$H+ Long string support}
+{$V- No var string checking}
+{$X+ Extended syntax}
+{$P+ Open string parameters}
+{$J+ Writeable typed constants}
+{$R- No Range checking}
+{$OVERFLOWCHECKS OFF}
+
+{$IFDEF COMPILER6_UP}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF COMPILER7_UP}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+{$ENDIF}
+
+{$IFDEF BCB}
+ {$OBJEXPORTALL ON}
+{$ENDIF}
+
+{$DEFINE CN_USE_MSXML}
+
+{$ENDIF FPC}
+
diff --git a/CnPack/Common/CnStrings.pas b/CnPack/Common/CnStrings.pas
new file mode 100644
index 0000000..504f43a
--- /dev/null
+++ b/CnPack/Common/CnStrings.pas
@@ -0,0 +1,2927 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnStrings;
+{* |
+================================================================================
+* ƣCnPack
+* ԪƣCnStrings ʵֵԪ AnsiStringList ԼһӴ㷨
+* ֧ Win32/64 Posix
+* ԪߣCnPack (master@cnpack.org)
+* ƽ̨PWinXPPro + Delphi 5.01
+* ݲԣPWin9X/2000/XP + Delphi 5/6/7/2005 + C++Build 5/6
+* עAnsiStringList ֲ Delphi 7 StringList
+* £2025.08.14
+* һָָȫƥʵֺ
+* 2022.10.25
+* StringBuilder ʵ֣֧ Ansi Unicode ģʽ
+* 2022.04.25
+* ַ滻֧ƥ
+* 2017.01.09
+* ֲ Forrest Smith ַģƥ㷨
+* һƥַڿ⡣
+* 2015.06.01
+* ӿӴ㷨 FastPosition
+* 2013.03.04
+* Ԫʵֹ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, {$IFDEF MSWINDOWS} Windows, {$ENDIF} CnNative;
+
+const
+ SCN_BOM_UTF8: array[0..2] of Byte = ($EF, $BB, $BF);
+
+ SCN_BOM_UTF16_LE: array[0..1] of Byte = ($FF, $FE);
+
+ SCN_BOM_UTF16_BE: array[0..1] of Byte = ($FE, $FF);
+
+type
+ TCnMatchMode = (mmStart, mmAnywhere, mmFuzzy);
+ {* ַƥģʽͷƥ䣬мƥ䣬ȫΧģƥ}
+
+ TCnAnsiStrings = class;
+
+ ICnStringsAdapter = interface
+ ['{E32A5BD7-9A80-4DDE-83D7-2EE050BF476A}']
+ procedure ReferenceStrings(S: TCnAnsiStrings);
+ procedure ReleaseStrings;
+ end;
+
+ TCnAnsiStringsDefined = set of (sdDelimiter, sdQuoteChar, sdNameValueSeparator);
+
+ TCnAnsiStrings = class(TPersistent)
+ {* Ansi TStrings Unicode ṩ Ansi TStrings }
+ private
+ FDefined: TCnAnsiStringsDefined;
+ FDelimiter: AnsiChar;
+ FQuoteChar: AnsiChar;
+ FNameValueSeparator: AnsiChar;
+ FUpdateCount: Integer;
+ FAdapter: ICnStringsAdapter;
+ FUseSingleLF: Boolean;
+ function GetCommaText: AnsiString;
+ function GetDelimitedText: AnsiString;
+ function GetName(Index: Integer): AnsiString;
+ function GetValue(const Name: AnsiString): AnsiString;
+ procedure ReadData(Reader: TReader);
+ procedure SetCommaText(const Value: AnsiString);
+ procedure SetDelimitedText(const Value: AnsiString);
+ procedure SetStringsAdapter(const Value: ICnStringsAdapter);
+ procedure SetValue(const Name, Value: AnsiString);
+ procedure WriteData(Writer: TWriter);
+ function GetDelimiter: AnsiChar;
+ procedure SetDelimiter(const Value: AnsiChar);
+ function GetQuoteChar: AnsiChar;
+ procedure SetQuoteChar(const Value: AnsiChar);
+ function GetNameValueSeparator: AnsiChar;
+ procedure SetNameValueSeparator(const Value: AnsiChar);
+ function GetValueFromIndex(Index: Integer): AnsiString;
+ procedure SetValueFromIndex(Index: Integer; const Value: AnsiString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Error(const Msg: AnsiString; Data: Integer); overload;
+ procedure Error(Msg: PResStringRec; Data: Integer); overload;
+ function ExtractName(const S: AnsiString): AnsiString;
+ function Get(Index: Integer): AnsiString; virtual; abstract;
+ function GetCapacity: Integer; virtual;
+ function GetCount: Integer; virtual; abstract;
+ function GetObject(Index: Integer): TObject; virtual;
+ function GetTextStr: AnsiString; virtual;
+ procedure Put(Index: Integer; const S: AnsiString); virtual;
+ procedure PutObject(Index: Integer; AObject: TObject); virtual;
+ procedure SetCapacity(NewCapacity: Integer); virtual;
+ procedure SetTextStr(const Value: AnsiString); virtual;
+ procedure SetUpdateState(Updating: Boolean); virtual;
+ property UpdateCount: Integer read FUpdateCount;
+ function CompareStrings(const S1, S2: AnsiString): Integer; virtual;
+ public
+ destructor Destroy; override;
+ function Add(const S: AnsiString): Integer; virtual;
+ function AddObject(const S: AnsiString; AObject: TObject): Integer; virtual;
+ procedure Append(const S: AnsiString);
+ procedure AddStrings(Strings: TCnAnsiStrings); virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginUpdate;
+ procedure Clear; virtual; abstract;
+ procedure Delete(Index: Integer); virtual; abstract;
+ procedure EndUpdate;
+ function Equals(Strings: TCnAnsiStrings): Boolean; reintroduce;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function GetText: PAnsiChar; virtual;
+ function IndexOf(const S: AnsiString): Integer; virtual;
+ function IndexOfName(const Name: AnsiString): Integer; virtual;
+ function IndexOfObject(AObject: TObject): Integer; virtual;
+ procedure Insert(Index: Integer; const S: AnsiString); virtual; abstract;
+ procedure InsertObject(Index: Integer; const S: AnsiString;
+ AObject: TObject); virtual;
+ procedure LoadFromFile(const FileName: AnsiString); virtual;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure Move(CurIndex, NewIndex: Integer); virtual;
+ procedure SaveToFile(const FileName: AnsiString); virtual;
+ procedure SaveToStream(Stream: TStream); virtual;
+ procedure SetText(Text: PAnsiChar); virtual;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property CommaText: AnsiString read GetCommaText write SetCommaText;
+ property Count: Integer read GetCount;
+ property Delimiter: AnsiChar read GetDelimiter write SetDelimiter;
+ property DelimitedText: AnsiString read GetDelimitedText write SetDelimitedText;
+ property Names[Index: Integer]: AnsiString read GetName;
+ property Objects[Index: Integer]: TObject read GetObject write PutObject;
+ property QuoteChar: AnsiChar read GetQuoteChar write SetQuoteChar;
+ property Values[const Name: AnsiString]: AnsiString read GetValue write SetValue;
+ property ValueFromIndex[Index: Integer]: AnsiString read GetValueFromIndex write SetValueFromIndex;
+ property NameValueSeparator: AnsiChar read GetNameValueSeparator write SetNameValueSeparator;
+ property Strings[Index: Integer]: AnsiString read Get write Put; default;
+ property Text: AnsiString read GetTextStr write SetTextStr;
+ property StringsAdapter: ICnStringsAdapter read FAdapter write SetStringsAdapter;
+ property UseSingleLF: Boolean read FUseSingleLF write FUseSingleLF;
+ {* ӵԣ GetTextStr ʱʹõĻǷǵ #10 dz #13#10}
+ end;
+
+ TCnAnsiStringList = class;
+
+ PCnAnsiStringItem = ^TCnAnsiStringItem;
+ TCnAnsiStringItem = record
+ FString: AnsiString;
+ FObject: TObject;
+ end;
+
+ PCnAnsiStringItemList = ^TCnAnsiStringItemList;
+ TCnAnsiStringItemList = array[0..MaxListSize div 2] of TCnAnsiStringItem;
+ TCnAnsiStringListSortCompare = function(List: TCnAnsiStringList; Index1, Index2: Integer): Integer;
+
+ TCnAnsiStringList = class(TCnAnsiStrings)
+ {* Ansi TStringList Unicode ṩ Ansi TStringList }
+ private
+ FList: PCnAnsiStringItemList;
+ FCount: Integer;
+ FCapacity: Integer;
+ FSorted: Boolean;
+ FDuplicates: TDuplicates;
+ FCaseSensitive: Boolean;
+ FOnChange: TNotifyEvent;
+ FOnChanging: TNotifyEvent;
+ procedure ExchangeItems(Index1, Index2: Integer);
+ procedure Grow;
+ procedure QuickSort(L, R: Integer; SCompare: TCnAnsiStringListSortCompare);
+ procedure SetSorted(Value: Boolean);
+ procedure SetCaseSensitive(const Value: Boolean);
+ protected
+ procedure Changed; virtual;
+ procedure Changing; virtual;
+ function Get(Index: Integer): AnsiString; override;
+ function GetCapacity: Integer; override;
+ function GetCount: Integer; override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure Put(Index: Integer; const S: AnsiString); override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetCapacity(NewCapacity: Integer); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ function CompareStrings(const S1, S2: AnsiString): Integer; override;
+ procedure InsertItem(Index: Integer; const S: AnsiString; AObject: TObject); virtual;
+ public
+ destructor Destroy; override;
+ function Add(const S: AnsiString): Integer; override;
+ function AddObject(const S: AnsiString; AObject: TObject): Integer; override;
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Exchange(Index1, Index2: Integer); override;
+ function Find(const S: AnsiString; var Index: Integer): Boolean; virtual;
+ function IndexOf(const S: AnsiString): Integer; override;
+ procedure Insert(Index: Integer; const S: AnsiString); override;
+ procedure InsertObject(Index: Integer; const S: AnsiString;
+ AObject: TObject); override;
+ procedure Sort; virtual;
+ procedure CustomSort(Compare: TCnAnsiStringListSortCompare); virtual;
+ property Duplicates: TDuplicates read FDuplicates write FDuplicates;
+ property Sorted: Boolean read FSorted write SetSorted;
+ property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
+ end;
+
+ PPCnAnsiHashItem = ^PCnAnsiHashItem;
+ PCnAnsiHashItem = ^TCnAnsiHashItem;
+ TCnAnsiHashItem = record
+ Next: PCnAnsiHashItem;
+ Key: AnsiString;
+ Value: Integer;
+ end;
+
+ TCnAnsiStringHash = class
+ private
+ Buckets: array of PCnAnsiHashItem;
+ protected
+ function Find(const Key: AnsiString): PPCnAnsiHashItem;
+ function HashOf(const Key: AnsiString): Cardinal; virtual;
+ public
+ constructor Create(Size: Cardinal = 256);
+ destructor Destroy; override;
+ procedure Add(const Key: AnsiString; Value: Integer);
+ procedure Clear;
+ procedure Remove(const Key: AnsiString);
+ function Modify(const Key: AnsiString; Value: Integer): Boolean;
+ function ValueOf(const Key: AnsiString): Integer;
+ end;
+
+ TCnHashedAnsiStringList = class(TCnAnsiStringList)
+ {* Ansi THashedStringList Unicode ṩ Ansi THashedStringList }
+ private
+ FValueHash: TCnAnsiStringHash;
+ FNameHash: TCnAnsiStringHash;
+ FValueHashValid: Boolean;
+ FNameHashValid: Boolean;
+ procedure UpdateValueHash;
+ procedure UpdateNameHash;
+ protected
+ procedure Changed; override;
+ public
+ destructor Destroy; override;
+ function IndexOf(const S: AnsiString): Integer; override;
+ function IndexOfName(const Name: AnsiString): Integer; override;
+ end;
+
+ TCnStringBuilder = class
+ {* ʽ StringBuilderʱֻ֧ӣ֧ɾ
+ Unicode 汾֧ string WideStringUnicode 汾֧ AnsiString string}
+ private
+ FModeIsFromOut: Boolean;
+ FOutMode: Boolean;
+ FAnsiMode: Boolean; // Unicode 汾Ĭ TrueUnicode 汾Ĭ Falseɴʱָ
+ FCharLength: Integer; // ַΪλij
+ FMaxCharCapacity: Integer;
+{$IFDEF UNICODE}
+ FAnsiData: AnsiString; // AnsiMode True ʱʹ
+ FData: string; // AnsiMode False ʱʹ
+{$ELSE}
+ FData: string; // AnsiMode True ʱʹ
+ FWideData: WideString; // AnsiMode False ʱʹ
+{$ENDIF}
+ function GetCharCapacity: Integer;
+ procedure SetCharCapacity(const Value: Integer);
+ procedure SetCharLength(const Value: Integer);
+ protected
+ procedure ExpandCharCapacity;
+ {* CharLength Ҫչڲ洢Ϊ CharLength * 2 CharLength ̶̫չ Capacity 0.5 }
+
+ function AppendString(const Value: string): TCnStringBuilder;
+ {* string ӵ FDataǷ Unicode ɵ߸ AnsiMode ơ
+
+
+ const Value: string - ӵַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+ public
+ constructor Create; overload;
+ {* 캯ڲʵĬ string}
+
+ constructor Create(IsAnsi: Boolean); overload;
+ {* ָڲ Ansi Wide Ĺ캯
+
+
+ IsAnsi: Boolean - ָڲǷʹ Ansi ģʽ
+
+ ֵޣ
+ }
+
+ destructor Destroy; override;
+ {* }
+
+ procedure Clear;
+ {* }
+
+{$IFDEF UNICODE}
+ function AppendAnsi(const Value: AnsiString): TCnStringBuilder;
+ {* AnsiString ӵ Unicode µ FAnsiDataɵ߸ AnsiMode ơ
+
+
+ const Value: AnsiString - ӵĵַֽ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+{$ELSE}
+ function AppendWide(const Value: WideString): TCnStringBuilder;
+ {* WideString ӵ Unicode е FWideDataɵ߸ AnsiMode ơ
+
+
+ const Value: WideString - ӵĿַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+{$ENDIF}
+
+ function Append(const Value: string): TCnStringBuilder; overload;
+ {* ַͨ Append ڣڲݵǰԼ AnsiMode úʵƴӡ
+
+
+ const Value: string - ӵַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Boolean): TCnStringBuilder; overload;
+ {* һֵ
+
+
+ Value: Boolean - ӵIJֵ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function AppendChar(Value: Char): TCnStringBuilder;
+ {* һַע Char ͵ַ String ǵͬģܺ Append overload
+
+
+ Value: Char - ӵַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function AppendAnsiChar(Value: AnsiChar): TCnStringBuilder;
+ {* һַֽ
+
+
+ Value: AnsiChar - ӵĵַֽ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function AppendWideChar(Value: WideChar): TCnStringBuilder;
+ {* һַ
+
+
+ Value: WideChar - ӵĿַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+
+ function AppendCurrency(Value: Currency): TCnStringBuilder;
+ {* һ Currency ֵע Currency ڵͰ汾 Delphi к Double ǵͬģ
+ ܺ Append overload
+
+
+ Value: Currency - ӵ Currency ֵ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+
+ function Append(Value: Single): TCnStringBuilder; overload;
+ {* һȸ
+
+
+ Value: Single - ӵĵȸ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Double): TCnStringBuilder; overload;
+ {* һ˫ȸ
+
+
+ Value: Double - ӵ˫ȸ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: ShortInt): TCnStringBuilder; overload;
+ {* һ 8 λз
+
+
+ Value: ShortInt - ӵ 8 λз
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: SmallInt): TCnStringBuilder; overload;
+ {* һ 16 λз
+
+
+ Value: SmallInt - ӵ 16 λз
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Integer): TCnStringBuilder; overload;
+ {* һ 32 λз
+
+
+ Value: Integer - ӵ 32 λз
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Int64): TCnStringBuilder; overload;
+ {* һ 64 λз
+
+
+ Value: Int64 - ӵ 64 λз
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Byte): TCnStringBuilder; overload;
+ {* һ 8 λ
+
+
+ Value: Byte - ӵ 8 λ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Word): TCnStringBuilder; overload;
+ {* һ 16 λ
+
+
+ Value: Word - ӵ 16 λ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Cardinal): TCnStringBuilder; overload;
+ {* һ 32 λ
+
+
+ Value: Cardinal - ӵ 32 λ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+{$IFDEF SUPPORT_UINT64}
+ function Append(Value: UInt64): TCnStringBuilder; overload;
+ {* һ 64 λ
+
+
+ Value: UInt64 - ӵ 64 λ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+{$ENDIF}
+
+ function Append(Value: TObject): TCnStringBuilder; overload;
+ {* һ
+
+
+ Value: TObject - ӵĶڲʹ ToStringʹöʮƵַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: PAnsiChar): TCnStringBuilder; overload;
+ {* һַֽ
+
+
+ Value: PAnsiChar - ӵĵַַֽ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(Value: Char; RepeatCount: Integer): TCnStringBuilder; overload;
+ {* һظַͬ
+
+
+ Value: Char - ӵַ
+ RepeatCount: Integer - ַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(const Value: string; StartIndex: Integer; Count: Integer): TCnStringBuilder; overload;
+ {* һַӴ
+
+
+ const Value: string - ӵַ
+ StartIndex: Integer - ʼλ
+ Count: Integer - ַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function Append(const AFormat: string; const Args: array of const): TCnStringBuilder; overload;
+ {* һʽַ
+
+
+ const AFormat: string - ʽַ
+ const Args: array of const - ʽб
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function AppendLine: TCnStringBuilder; overload;
+ {* һС
+
+
+ ޣ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function AppendLine(const Value: string): TCnStringBuilder; overload;
+ {* һַϻس
+
+
+ const Value: string - ӵַ
+
+ ֵTCnStringBuilder - رһӵ
+ }
+
+ function ToString: string; {$IFDEF OBJECT_HAS_TOSTRING} override; {$ENDIF}
+ {* ݵ string ʽǷ Unicode ֻҪ AnsiMode Unicode ֧һ¡
+ 仰˵ Unicode AnsiMode Ϊ True ʱŷ AnsiString
+ Unicode AnsiMode Ϊ False ʱŷ UnicodeStringؿա
+
+
+ ޣ
+
+ ֵstring - ݵַʽ
+ }
+
+ function ToAnsiString: AnsiString;
+ {* ǿзݵ AnsiString ʽ AnsiMode Ρ
+ Unicode ʹãڷ Unicode ʹãͬ ToString
+
+
+ ޣ
+
+ ֵAnsiString - ݵĵַֽʽ
+ }
+
+ function ToWideString: WideString;
+ {* ǿзݵ WideString ʽ AnsiMode Ρ
+ ڷ Unicode ʹã Unicode ʹãͬ ToString
+
+
+ ޣ
+
+ ֵWideString - ݵĿַʽ
+ }
+
+ property CharCapacity: Integer read GetCharCapacity write SetCharCapacity;
+ {* ַΪλڲ}
+ property CharLength: Integer read FCharLength write SetCharLength;
+ {* ַΪλڲѾƴյݳ}
+ property MaxCharCapacity: Integer read FMaxCharCapacity;
+ {* ַΪλĿõ}
+ end;
+
+ TCnReplaceFlags = set of (crfReplaceAll, crfIgnoreCase, crfWholeWord);
+ {* ַ滻}
+
+{$IFNDEF COMPILER7_UP}
+
+function PosEx(const SubStr: string; const S: string; Offset: Cardinal = 1): Integer;
+{* D5/6 BCB5/6 StrUtils ԪĴ˺ֲ PosEx ʹο PosEx
+
+
+ const SubStr: string - ҵӴ
+ const S: string - ԭַ
+ Offset: Cardinal - ҵʼƫ
+
+ ֵInteger - شʼƫһγӴλ
+}
+
+{$ENDIF}
+
+function FastPosition(const Str: PChar; const Pattern: PChar; FromIndex: Integer = 0): Integer;
+{* Ӵ Pattern Str еĵһγֵţ -1
+
+
+ const Str: PChar - ַ
+ const Pattern: PChar - ƥӴ
+ FromIndex: Integer - Ӻδʼ
+
+ ֵInteger - ƥĵһγֵţ -1
+}
+
+function FuzzyMatchStr(const Pattern: string; const Str: string; MatchedIndexes: TList = nil;
+ CaseSensitive: Boolean = False): Boolean;
+{* ģƥӴMatchedIndexes з Str ƥ±š
+
+
+ const Pattern: string - ƥӴ
+ const Str: string - ַ
+ MatchedIndexes: TList - ַиַƥ±
+ CaseSensitive: Boolean - ǷִСд
+
+ ֵBoolean - Ƿģƥ
+}
+
+function FuzzyMatchStrWithScore(const Pattern: string; const Str: string; out Score: Integer;
+ MatchedIndexes: TList = nil; CaseSensitive: Boolean = False): Boolean;
+{* ģƥӴScore ƥ̶ȣMatchedIndexes з Str ƥ±ţ
+ ע Score ıȽֻӴԼСдһʱ塣
+
+
+ const Pattern: string - ƥӴ
+ const Str: string - ַ
+ out Score: Integer - ƥ̶
+ MatchedIndexes: TList - ַиַƥ±
+ CaseSensitive: Boolean - ǷִСд
+
+ ֵBoolean - Ƿģƥ
+}
+
+function AnyWhereSepMatchStr(const Pattern: string; const Str: string; SepContainer: TStringList;
+ MatchedIndexes: TList = nil; CaseSensitive: Boolean = False; SepChar: Char = ' '): Boolean;
+{* ָӴƥӴҲǰ Pattern SepChar ֳɶַƥ䣬ȫƥŷƥ䡣
+ MatchedIndexes з Str ƥ±ţSepContainer 紫 TStringList Լٴ
+
+
+ const Pattern: string - ƥӴ
+ const Str: string - ַ
+ SepContainer: TStringList; - 紫 TStringList Լڲ
+ MatchedIndexes: TList - ַиַƥ±
+ CaseSensitive: Boolean - ǷִСд
+
+ ֵBoolean - Ƿƥɹ
+}
+
+function CnStringReplace(const S: string; const OldPattern: string;
+ const NewPattern: string; Flags: TCnReplaceFlags): string;
+{* ֧ƥַ滻 Unicode Unicode ¶Ч
+
+
+ const S: string - 滻ַ
+ const OldPattern: string - 滻ַ
+ const NewPattern: string - 滻ַ
+ Flags: TCnReplaceFlags - 滻ǣ֧ƥ
+
+ ֵstring - ַ滻
+}
+
+{$IFDEF UNICODE}
+
+function CnStringReplaceA(const S: AnsiString; const OldPattern: AnsiString;
+ const NewPattern: AnsiString; Flags: TCnReplaceFlags): AnsiString;
+{* ֧ƥ Ansi ַ滻 Unicode Ч
+
+
+ const S: AnsiString - 滻ĵַֽ
+ const OldPattern: AnsiString - 滻ĵַֽ
+ const NewPattern: AnsiString - 滻ĵַֽ
+ Flags: TCnReplaceFlags - 滻ǣ֧ƥ
+
+ ֵAnsiString - صַֽ滻
+}
+
+{$ELSE}
+
+function CnStringReplaceW(const S: WideString; const OldPattern: WideString;
+ const NewPattern: WideString; Flags: TCnReplaceFlags): WideString;
+{* ֧ƥ Wide ַ滻ڷ Unicode Ч
+
+
+ const S: WideString - 滻Ŀַ
+ const OldPattern: WideString - 滻Ŀַ
+ const NewPattern: WideString - 滻Ŀַ
+ Flags: TCnReplaceFlags - 滻ǣ֧ƥ
+
+ ֵWideString - ؿַ滻
+}
+
+{$ENDIF}
+
+function CnPosEx(const SubStr, S: string; CaseSensitive: Boolean; WholeWords:
+ Boolean; StartCount: Integer = 1): Integer;
+{* ǿַҺֲ֧ҵڼ StartCount Ϊ 1}
+
+procedure CnSplitString(const Sub: string; const Str: string; Strings: TStrings);
+{* ַַֺ}
+
+function NativeStringToUIString(const Str: string): string;
+{* Lazarus/FPC Ansi ģʽרãΪ Lazarus/FPC Ansi ģʽºͽйصַ Utf8 ʽ
+ ڲַͨ Ansi Utf16һηװת}
+
+function UIStringToNativeString(const Str: string): string;
+{* Lazarus/FPC Ansi ģʽרãΪ Lazarus/FPC Ansi ģʽºͽйصַ Utf8 ʽ
+ ڲַͨ Ansi Utf16һηװת}
+
+implementation
+
+uses
+ CnWideStrings;
+
+const
+ SLineBreak = #13#10;
+ SLineBreakLF = #10;
+ STRING_BUILDER_DEFAULT_CAPACITY = 16;
+
+resourcestring
+ SDuplicateString = 'AnsiString list does not allow duplicates';
+ SListIndexError = 'AnsiString List index out of bounds (%d)';
+ SSortedListError = 'Operation not allowed on sorted AnsiString list';
+ SListCapacityError = 'Error New Capacity or Length Value %d';
+
+function NativeStringToUIString(const Str: string): string;
+begin
+{$IFDEF FPC}
+ Result := CnAnsiToUtf82(Str);
+{$ELSE}
+ Result := Str;
+{$ENDIF}
+end;
+
+function UIStringToNativeString(const Str: string): string;
+begin
+{$IFDEF FPC}
+ Result := CnUtf8ToAnsi2(Str);
+{$ELSE}
+ Result := Str;
+{$ENDIF}
+end;
+
+{$IFNDEF COMPILER7_UP}
+
+function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
+var
+ I,X: Integer;
+ Len, LenSubStr: Integer;
+begin
+ if Offset = 1 then
+ Result := Pos(SubStr, S)
+ else
+ begin
+ I := Offset;
+ LenSubStr := Length(SubStr);
+ Len := Length(S) - LenSubStr + 1;
+ while I <= Len do
+ begin
+ if S[I] = SubStr[1] then
+ begin
+ X := 1;
+ while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
+ Inc(X);
+ if (X = LenSubStr) then
+ begin
+ Result := I;
+ exit;
+ end;
+ end;
+ Inc(I);
+ end;
+ Result := 0;
+ end;
+end;
+
+{$ENDIF}
+
+// Ӵ Pattern Str еĵһγֵţ -1
+function FastPosition(const Str, Pattern: PChar; FromIndex: Integer): Integer;
+var
+ C: Char;
+ I, L, X, Y, PLen, SLen: Integer;
+ BCS: array[0..255] of Integer;
+begin
+ Result := -1;
+ if (Str = nil) or (Pattern = nil) then
+ Exit;
+
+ PLen := StrLen(Pattern);
+ if PLen = 0 then
+ Exit;
+ SLen := StrLen(Str);
+
+ // ǵַģʽ
+ if PLen = 1 then
+ begin
+ for I := FromIndex to SLen - 1 do
+ begin
+ if Str[I] = Pattern[0] then
+ begin
+ Result := I;
+ Exit;
+ end;
+ end;
+ Exit;
+ end;
+
+ // Ծ
+ for I := Low(BCS) to High(BCS) do
+ BCS[I] := PLen;
+
+ for I := 0 to PLen - 2 do
+ begin
+ C := Pattern[I];
+ L := Ord(C) and $FF;
+ if PLen - I - 1 < BCS[L] then
+ BCS[L] := PLen - I - 1;
+ end;
+
+ // ٽ
+ I := FromIndex + PLen - 1;
+ while I < SLen do
+ begin
+ X := I;
+ Y := PLen - 1;
+ while True do
+ begin
+ if Pattern[Y] <> Str[X] then
+ begin
+ Inc(I, BCS[Ord(Str[X]) and $FF]);
+ Break;
+ end;
+
+ if Y = 0 then
+ begin
+ Result := X;
+ Exit;
+ end;
+
+ Dec(X);
+ Dec(Y);
+ end;
+ end;
+end;
+
+{$WARNINGS OFF}
+
+function LowChar(AChar: Char): Char; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ if AChar in ['A'..'Z'] then
+ Result := Chr(Ord(AChar) + 32)
+ else
+ Result := AChar;
+end;
+
+// ģƥӴ
+function FuzzyMatchStr(const Pattern: string; const Str: string;
+ MatchedIndexes: TList; CaseSensitive: Boolean): Boolean;
+var
+ PIdx, SIdx: Integer;
+begin
+ Result := False;
+ if (Pattern = '') or (Str = '') then
+ Exit;
+
+ PIdx := 1;
+ SIdx := 1;
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Clear;
+
+ if CaseSensitive then
+ begin
+ while (PIdx <= Length(Pattern)) and (SIdx <= Length(Str)) do
+ begin
+ if Pattern[PIdx] = Str[SIdx] then
+ begin
+ Inc(PIdx);
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Add(Pointer(SIdx));
+ end;
+ Inc(SIdx);
+ end;
+ end
+ else
+ begin
+ while (PIdx <= Length(Pattern)) and (SIdx <= Length(Str)) do
+ begin
+ if LowChar(Pattern[PIdx]) = LowChar(Str[SIdx]) then
+ begin
+ Inc(PIdx);
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Add(Pointer(SIdx));
+ end;
+ Inc(SIdx);
+ end;
+ end;
+ Result := PIdx > Length(Pattern);
+end;
+
+// ģƥӴScore ƥ̶ȣע Score ıȽֻӴԼСдһʱ
+function FuzzyMatchStrWithScore(const Pattern: string; const Str: string;
+ out Score: Integer; MatchedIndexes: TList; CaseSensitive: Boolean): Boolean;
+const
+ ADJACENCY_BONUS = 4; // ÿһַĽƥʱӷ
+ SEPARATOR_BONUS = 10; // ÿһַƥ䷢һָźļӷ
+ CAMEL_BONUS = 5; // ǰһƥСдǴдʱӷ
+ LEADING_LETTER_PENALTY = -3; // һƥĸԽĸԽ۷
+ MAX_LEADING_LETTER_PENALTY = -9; // һƥĸⶥֻô
+ UNMATCHED_LETTER_PENALTY = -1; // ƥĿ۷
+ START_BONUS = 6;
+var
+ PIdx, SIdx: Integer;
+ PrevMatch, PrevLow, PrevSep: Boolean;
+ BestLetterPtr: PChar;
+ BestLetterScore, NewScore, Penalty: Integer;
+ PatternLetter, StrLetter: Char; // ֱӴĸַ
+ ThisMatch, Rematch, Advanced, PatternRepeat: Boolean;
+begin
+ Score := 0;
+ Result := False;
+ if (Pattern = '') or (Str = '') then
+ Exit;
+
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Clear;
+
+ PrevMatch := False;
+ PrevLow := False;
+ PrevSep := True;
+
+ PIdx := 1;
+ SIdx := 1;
+
+ BestLetterPtr := nil;
+ BestLetterScore := 0;
+
+ while SIdx <= Length(Str) do // SIdx ĸλã1 ʼ
+ begin
+ if PIdx <= Length(Pattern) then
+ PatternLetter := Pattern[PIdx]
+ else
+ PatternLetter := #0;
+ StrLetter := Str[SIdx];
+
+ if CaseSensitive then
+ begin
+ ThisMatch := (PatternLetter <> #0) and (PatternLetter = StrLetter);
+ Rematch := (BestLetterPtr <> nil) and (BestLetterPtr^ = StrLetter);
+ Advanced := ThisMatch and (BestLetterPtr <> nil);
+ PatternRepeat := (BestLetterPtr <> nil) and (PatternLetter <> #0) and (BestLetterPtr^ = PatternLetter);
+ end
+ else
+ begin
+ ThisMatch := (PatternLetter <> #0) and (LowChar(PatternLetter) = LowChar(StrLetter));
+ Rematch := (BestLetterPtr <> nil) and (LowChar(BestLetterPtr^) = LowChar(StrLetter));
+ Advanced := ThisMatch and (BestLetterPtr <> nil);
+ PatternRepeat := (BestLetterPtr <> nil) and (PatternLetter <> #0) and (LowChar(BestLetterPtr^) = LowChar(PatternLetter));
+ end;
+
+ if ThisMatch and (MatchedIndexes <> nil) then
+ begin
+ MatchedIndexes.Add(Pointer(SIdx));
+ if SIdx <= START_BONUS then // ߿ĸǰͷƥַķ
+ Inc(Score, (START_BONUS - SIdx + 1) * 2);
+ end;
+
+ if Advanced or PatternRepeat then
+ begin
+ Inc(Score, BestLetterScore);
+ BestLetterPtr := nil;
+ BestLetterScore := 0;
+ end;
+
+ if ThisMatch or Rematch then
+ begin
+ NewScore := 0;
+ if PIdx = 1 then
+ begin
+ Penalty := LEADING_LETTER_PENALTY * (SIdx - 1); // ͷƥ䲻۷
+ if Penalty < MAX_LEADING_LETTER_PENALTY then
+ Penalty := MAX_LEADING_LETTER_PENALTY;
+
+ Inc(Score, Penalty);
+ end;
+
+ if PrevMatch then
+ Inc(NewScore, ADJACENCY_BONUS);
+ if PrevSep then
+ Inc(NewScore, SEPARATOR_BONUS);
+ if PrevLow and (strLetter in ['A'..'Z']) then
+ Inc(NewScore, CAMEL_BONUS);
+
+ if ThisMatch then
+ Inc(PIdx);
+
+ if NewScore >= BestLetterScore then
+ begin
+ if BestLetterPtr <> nil then
+ Inc(Score, UNMATCHED_LETTER_PENALTY);
+ BestLetterPtr := @(Str[SIdx]);
+ BestLetterScore := NewScore;
+ end;
+ PrevMatch := True;
+ end
+ else
+ begin
+ Inc(Score, UNMATCHED_LETTER_PENALTY);
+ PrevMatch := False;
+ end;
+
+ PrevLow := StrLetter in ['a'..'z'];
+ PrevSep := strLetter in ['_', ' ', '/', '\', '.'];
+
+ Inc(SIdx);
+ end;
+
+ if BestLetterPtr <> nil then
+ Inc(Score, BestLetterScore);
+
+ Result := PIdx > Length(Pattern);
+end;
+
+function MatchedIndexesCompare(Item1, Item2: Pointer): Integer;
+var
+ R1, R2: Integer;
+begin
+ R1 := Integer(Item1);
+ R2 := Integer(Item2);
+ Result := R1 - R2;
+end;
+
+function AnyWhereSepMatchStr(const Pattern: string; const Str: string; SepContainer: TStringList;
+ MatchedIndexes: TList; CaseSensitive: Boolean; SepChar: Char): Boolean;
+var
+ IsNil: Boolean;
+ D, I, J: Integer;
+ ToFind: string;
+ SepChars: TSysCharSet;
+begin
+ Result := False;
+
+ if Pos(SepChar, Pattern) <= 0 then
+ begin
+ // ûиַɱ Pos
+ if CaseSensitive then
+ D := Pos(Pattern, Str)
+ else
+ D := Pos(UpperCase(Pattern), UpperCase(Str));
+
+ if D > 0 then
+ begin
+ Result := True;
+ if MatchedIndexes <> nil then
+ begin
+ MatchedIndexes.Clear;
+ for I := 0 to Length(Pattern) - 1 do
+ MatchedIndexes.Add(Pointer(D + I));
+ end;
+ end;
+ end
+ else
+ begin
+ IsNil := SepContainer = nil;
+ if IsNil then
+ SepContainer := TStringList.Create
+ else
+ SepContainer.Clear;
+
+ try
+ SepChars := [];
+ Include(SepChars, AnsiChar(SepChar));
+ if CaseSensitive then
+ begin
+ ExtractStrings(SepChars, [], PChar(Pattern), SepContainer);
+ ToFind := Str;
+ end
+ else
+ begin
+ ExtractStrings(SepChars, [], PChar(UpperCase(Pattern)), SepContainer);
+ ToFind := UpperCase(Str);
+ end;
+
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Clear;
+ for I := 0 to SepContainer.Count - 1 do
+ begin
+ D := Pos(SepContainer[I], ToFind);
+ if D <= 0 then
+ begin
+ if MatchedIndexes <> nil then
+ MatchedIndexes.Clear;
+ Exit;
+ end
+ else
+ begin
+ if MatchedIndexes <> nil then
+ begin
+ for J := 0 to Length(SepContainer[I]) - 1 do
+ MatchedIndexes.Add(Pointer(D + J));
+ end;
+ end;
+ end;
+
+ if (MatchedIndexes <> nil) and (MatchedIndexes.Count > 1) then
+ MatchedIndexes.Sort(MatchedIndexesCompare);
+ Result := True;
+ finally
+ if IsNil then
+ SepContainer.Free;
+ end;
+ end;
+end;
+
+{ TCnAnsiStrings }
+
+destructor TCnAnsiStrings.Destroy;
+begin
+ StringsAdapter := nil;
+ inherited Destroy;
+end;
+
+function TCnAnsiStrings.Add(const S: AnsiString): Integer;
+begin
+ Result := GetCount;
+ Insert(Result, S);
+end;
+
+function TCnAnsiStrings.AddObject(const S: AnsiString; AObject: TObject): Integer;
+begin
+ Result := Add(S);
+ PutObject(Result, AObject);
+end;
+
+procedure TCnAnsiStrings.Append(const S: AnsiString);
+begin
+ Add(S);
+end;
+
+procedure TCnAnsiStrings.AddStrings(Strings: TCnAnsiStrings);
+var
+ I: Integer;
+begin
+ BeginUpdate;
+ try
+ for I := 0 to Strings.Count - 1 do
+ AddObject(Strings[I], Strings.Objects[I]);
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TCnAnsiStrings.Assign(Source: TPersistent);
+begin
+ if Source is TCnAnsiStrings then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ FDefined := TCnAnsiStrings(Source).FDefined;
+ FNameValueSeparator := TCnAnsiStrings(Source).FNameValueSeparator;
+ FQuoteChar := TCnAnsiStrings(Source).FQuoteChar;
+ FDelimiter := TCnAnsiStrings(Source).FDelimiter;
+ AddStrings(TCnAnsiStrings(Source));
+ finally
+ EndUpdate;
+ end;
+ Exit;
+ end;
+ inherited Assign(Source);
+end;
+
+procedure TCnAnsiStrings.BeginUpdate;
+begin
+ if FUpdateCount = 0 then SetUpdateState(True);
+ Inc(FUpdateCount);
+end;
+
+procedure TCnAnsiStrings.DefineProperties(Filer: TFiler);
+
+ function DoWrite: Boolean;
+ begin
+ if Filer.Ancestor <> nil then
+ begin
+ Result := True;
+ if Filer.Ancestor is TCnAnsiStrings then
+ Result := not Equals(TCnAnsiStrings(Filer.Ancestor))
+ end
+ else Result := Count > 0;
+ end;
+
+begin
+ Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
+end;
+
+procedure TCnAnsiStrings.EndUpdate;
+begin
+ Dec(FUpdateCount);
+ if FUpdateCount = 0 then SetUpdateState(False);
+end;
+
+function TCnAnsiStrings.Equals(Strings: TCnAnsiStrings): Boolean;
+var
+ I, Count: Integer;
+begin
+ Result := False;
+ Count := GetCount;
+ if Count <> Strings.GetCount then Exit;
+ for I := 0 to Count - 1 do if Get(I) <> Strings.Get(I) then Exit;
+ Result := True;
+end;
+
+procedure TCnAnsiStrings.Error(const Msg: AnsiString; Data: Integer);
+
+{$IFDEF MSWINDOWS}
+ function ReturnAddr: Pointer;
+ asm
+ MOV EAX,[EBP+4]
+ end;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ raise EStringListError.CreateFmt(string(Msg), [Data]) at ReturnAddr;
+{$ELSE}
+ raise EStringListError.CreateFmt(string(Msg), [Data]);
+{$ENDIF}
+end;
+
+procedure TCnAnsiStrings.Error(Msg: PResStringRec; Data: Integer);
+begin
+ Error(AnsiString(LoadResString(Msg)), Data);
+end;
+
+procedure TCnAnsiStrings.Exchange(Index1, Index2: Integer);
+var
+ TempObject: TObject;
+ TempString: AnsiString;
+begin
+ BeginUpdate;
+ try
+ TempString := Strings[Index1];
+ TempObject := Objects[Index1];
+ Strings[Index1] := Strings[Index2];
+ Objects[Index1] := Objects[Index2];
+ Strings[Index2] := TempString;
+ Objects[Index2] := TempObject;
+ finally
+ EndUpdate;
+ end;
+end;
+
+function TCnAnsiStrings.ExtractName(const S: AnsiString): AnsiString;
+var
+ P: Integer;
+begin
+ Result := S;
+ P := AnsiPos(string(NameValueSeparator), string(S));
+ if P <> 0 then
+ SetLength(Result, P-1) else
+ SetLength(Result, 0);
+end;
+
+function TCnAnsiStrings.GetCapacity: Integer;
+begin // descendents may optionally override/replace this default implementation
+ Result := Count;
+end;
+
+function TCnAnsiStrings.GetCommaText: AnsiString;
+var
+ LOldDefined: TCnAnsiStringsDefined;
+ LOldDelimiter: AnsiChar;
+ LOldQuoteChar: AnsiChar;
+begin
+ LOldDefined := FDefined;
+ LOldDelimiter := FDelimiter;
+ LOldQuoteChar := FQuoteChar;
+ Delimiter := ',';
+ QuoteChar := '"';
+ try
+ Result := GetDelimitedText;
+ finally
+ FDelimiter := LOldDelimiter;
+ FQuoteChar := LOldQuoteChar;
+ FDefined := LOldDefined;
+ end;
+end;
+
+function TCnAnsiStrings.GetDelimitedText: AnsiString;
+var
+ S: AnsiString;
+ P: PAnsiChar;
+ I, Count: Integer;
+begin
+ Count := GetCount;
+ if (Count = 1) and (Get(0) = '') then
+ Result := QuoteChar + QuoteChar
+ else
+ begin
+ Result := '';
+ for I := 0 to Count - 1 do
+ begin
+ S := Get(I);
+ P := PAnsiChar(S);
+ while not (P^ in [#0..' ', QuoteChar, Delimiter]) do
+ {$IFDEF MSWINDOWS}
+ P := CharNextA(P);
+ {$ELSE}
+ Inc(P);
+ {$ENDIF}
+ if (P^ <> #0) then S := AnsiString(AnsiQuotedStr(string(S), Char(QuoteChar)));
+ Result := Result + S + Delimiter;
+ end;
+ System.Delete(Result, Length(Result), 1);
+ end;
+end;
+
+function TCnAnsiStrings.GetName(Index: Integer): AnsiString;
+begin
+ Result := ExtractName(Get(Index));
+end;
+
+function TCnAnsiStrings.GetObject(Index: Integer): TObject;
+begin
+ Result := nil;
+end;
+
+function TCnAnsiStrings.GetText: PAnsiChar;
+begin
+ Result := StrNew(PAnsiChar(GetTextStr));
+end;
+
+function TCnAnsiStrings.GetTextStr: AnsiString;
+var
+ I, L, Size, Count: Integer;
+ P: PAnsiChar;
+ S, LB: AnsiString;
+begin
+ Count := GetCount;
+ Size := 0;
+
+ if FUseSingleLF then
+ LB := SLineBreakLF
+ else
+ LB := SLineBreak;
+
+ for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
+ SetString(Result, nil, Size);
+ P := Pointer(Result);
+ for I := 0 to Count - 1 do
+ begin
+ S := Get(I);
+ L := Length(S);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(S)^, P^, L);
+ Inc(P, L);
+ end;
+ L := Length(LB);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(LB)^, P^, L);
+ Inc(P, L);
+ end;
+ end;
+end;
+
+function TCnAnsiStrings.GetValue(const Name: AnsiString): AnsiString;
+var
+ I: Integer;
+begin
+ I := IndexOfName(Name);
+ if I >= 0 then
+ Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
+ Result := '';
+end;
+
+function TCnAnsiStrings.IndexOf(const S: AnsiString): Integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ if CompareStrings(Get(Result), S) = 0 then Exit;
+ Result := -1;
+end;
+
+function TCnAnsiStrings.IndexOfName(const Name: AnsiString): Integer;
+var
+ P: Integer;
+ S: AnsiString;
+begin
+ for Result := 0 to GetCount - 1 do
+ begin
+ S := Get(Result);
+ P := AnsiPos(string(NameValueSeparator), string(S));
+ if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
+ end;
+ Result := -1;
+end;
+
+function TCnAnsiStrings.IndexOfObject(AObject: TObject): Integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ if GetObject(Result) = AObject then Exit;
+ Result := -1;
+end;
+
+procedure TCnAnsiStrings.InsertObject(Index: Integer; const S: AnsiString;
+ AObject: TObject);
+begin
+ Insert(Index, S);
+ PutObject(Index, AObject);
+end;
+
+procedure TCnAnsiStrings.LoadFromFile(const FileName: AnsiString);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(string(FileName), fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TCnAnsiStrings.LoadFromStream(Stream: TStream);
+var
+ Size: Integer;
+ S: AnsiString;
+begin
+ BeginUpdate;
+ try
+ Size := Stream.Size - Stream.Position;
+ SetString(S, nil, Size);
+ Stream.Read(Pointer(S)^, Size);
+ SetTextStr(S);
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TCnAnsiStrings.Move(CurIndex, NewIndex: Integer);
+var
+ TempObject: TObject;
+ TempString: AnsiString;
+begin
+ if CurIndex <> NewIndex then
+ begin
+ BeginUpdate;
+ try
+ TempString := Get(CurIndex);
+ TempObject := GetObject(CurIndex);
+ Delete(CurIndex);
+ InsertObject(NewIndex, TempString, TempObject);
+ finally
+ EndUpdate;
+ end;
+ end;
+end;
+
+procedure TCnAnsiStrings.Put(Index: Integer; const S: AnsiString);
+var
+ TempObject: TObject;
+begin
+ TempObject := GetObject(Index);
+ Delete(Index);
+ InsertObject(Index, S, TempObject);
+end;
+
+procedure TCnAnsiStrings.PutObject(Index: Integer; AObject: TObject);
+begin
+end;
+
+procedure TCnAnsiStrings.ReadData(Reader: TReader);
+begin
+ Reader.ReadListBegin;
+ BeginUpdate;
+ try
+ Clear;
+ while not Reader.EndOfList do Add(AnsiString(Reader.ReadString));
+ finally
+ EndUpdate;
+ end;
+ Reader.ReadListEnd;
+end;
+
+procedure TCnAnsiStrings.SaveToFile(const FileName: AnsiString);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(string(FileName), fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TCnAnsiStrings.SaveToStream(Stream: TStream);
+var
+ S: AnsiString;
+begin
+ S := GetTextStr;
+ Stream.WriteBuffer(Pointer(S)^, Length(S));
+end;
+
+procedure TCnAnsiStrings.SetCapacity(NewCapacity: Integer);
+begin
+ // do nothing - descendents may optionally implement this method
+end;
+
+procedure TCnAnsiStrings.SetCommaText(const Value: AnsiString);
+begin
+ Delimiter := ',';
+ QuoteChar := '"';
+ SetDelimitedText(Value);
+end;
+
+procedure TCnAnsiStrings.SetStringsAdapter(const Value: ICnStringsAdapter);
+begin
+ if FAdapter <> nil then FAdapter.ReleaseStrings;
+ FAdapter := Value;
+ if FAdapter <> nil then FAdapter.ReferenceStrings(Self);
+end;
+
+procedure TCnAnsiStrings.SetText(Text: PAnsiChar);
+begin
+ SetTextStr(Text);
+end;
+
+procedure TCnAnsiStrings.SetTextStr(const Value: AnsiString);
+var
+ P, Start: PAnsiChar;
+ S: AnsiString;
+begin
+ BeginUpdate;
+ try
+ Clear;
+ P := Pointer(Value);
+ if P <> nil then
+ while P^ <> #0 do
+ begin
+ Start := P;
+ while not (P^ in [#0, #10, #13]) do Inc(P);
+ SetString(S, Start, P - Start);
+ Add(S);
+ if P^ = #13 then Inc(P);
+ if P^ = #10 then Inc(P);
+ end;
+ finally
+ EndUpdate;
+ end;
+end;
+
+procedure TCnAnsiStrings.SetUpdateState(Updating: Boolean);
+begin
+end;
+
+procedure TCnAnsiStrings.SetValue(const Name, Value: AnsiString);
+var
+ I: Integer;
+begin
+ I := IndexOfName(Name);
+ if Value <> '' then
+ begin
+ if I < 0 then I := Add('');
+ Put(I, Name + NameValueSeparator + Value);
+ end else
+ begin
+ if I >= 0 then Delete(I);
+ end;
+end;
+
+procedure TCnAnsiStrings.WriteData(Writer: TWriter);
+var
+ I: Integer;
+begin
+ Writer.WriteListBegin;
+ for I := 0 to Count - 1 do Writer.WriteString(string(Get(I)));
+ Writer.WriteListEnd;
+end;
+
+procedure TCnAnsiStrings.SetDelimitedText(const Value: AnsiString);
+var
+ P, P1: PAnsiChar;
+ S: AnsiString;
+begin
+ BeginUpdate;
+ try
+ Clear;
+ P := PAnsiChar(Value);
+ while P^ in [#1..' '] do
+ {$IFDEF MSWINDOWS}
+ P := CharNextA(P);
+ {$ELSE}
+ Inc(P);
+ {$ENDIF}
+ while P^ <> #0 do
+ begin
+ if P^ = QuoteChar then
+ S := AnsiExtractQuotedStr(P, QuoteChar)
+ else
+ begin
+ P1 := P;
+ while (P^ > ' ') and (P^ <> Delimiter) do
+ {$IFDEF MSWINDOWS}
+ P := CharNextA(P);
+ {$ELSE}
+ Inc(P);
+ {$ENDIF}
+ SetString(S, P1, P - P1);
+ end;
+ Add(S);
+ while P^ in [#1..' '] do
+ {$IFDEF MSWINDOWS}
+ P := CharNextA(P);
+ {$ELSE}
+ Inc(P);
+ {$ENDIF}
+ if P^ = Delimiter then
+ begin
+ P1 := P;
+ {$IFDEF MSWINDOWS}
+ if CharNextA(P1)^ = #0 then
+ {$ELSE}
+ Inc(P1);
+ if P1^ = #0 then
+ {$ENDIF}
+ Add('');
+ repeat
+ {$IFDEF MSWINDOWS}
+ P := CharNextA(P);
+ {$ELSE}
+ Inc(P);
+ {$ENDIF}
+ until not (P^ in [#1..' ']);
+ end;
+ end;
+ finally
+ EndUpdate;
+ end;
+end;
+
+function TCnAnsiStrings.GetDelimiter: AnsiChar;
+begin
+ if not (sdDelimiter in FDefined) then
+ Delimiter := ',';
+ Result := FDelimiter;
+end;
+
+function TCnAnsiStrings.GetQuoteChar: AnsiChar;
+begin
+ if not (sdQuoteChar in FDefined) then
+ QuoteChar := '"';
+ Result := FQuoteChar;
+end;
+
+procedure TCnAnsiStrings.SetDelimiter(const Value: AnsiChar);
+begin
+ if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
+ begin
+ Include(FDefined, sdDelimiter);
+ FDelimiter := Value;
+ end
+end;
+
+procedure TCnAnsiStrings.SetQuoteChar(const Value: AnsiChar);
+begin
+ if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
+ begin
+ Include(FDefined, sdQuoteChar);
+ FQuoteChar := Value;
+ end
+end;
+
+function TCnAnsiStrings.CompareStrings(const S1, S2: AnsiString): Integer;
+begin
+ Result := AnsiCompareText(string(S1), string(S2));
+end;
+
+function TCnAnsiStrings.GetNameValueSeparator: AnsiChar;
+begin
+ if not (sdNameValueSeparator in FDefined) then
+ NameValueSeparator := '=';
+ Result := FNameValueSeparator;
+end;
+
+procedure TCnAnsiStrings.SetNameValueSeparator(const Value: AnsiChar);
+begin
+ if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
+ begin
+ Include(FDefined, sdNameValueSeparator);
+ FNameValueSeparator := Value;
+ end
+end;
+
+function TCnAnsiStrings.GetValueFromIndex(Index: Integer): AnsiString;
+begin
+ if Index >= 0 then
+ Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
+ Result := '';
+end;
+
+procedure TCnAnsiStrings.SetValueFromIndex(Index: Integer; const Value: AnsiString);
+begin
+ if Value <> '' then
+ begin
+ if Index < 0 then Index := Add('');
+ Put(Index, Names[Index] + NameValueSeparator + Value);
+ end
+ else
+ if Index >= 0 then Delete(Index);
+end;
+
+{ TCnAnsiStringList }
+
+destructor TCnAnsiStringList.Destroy;
+begin
+ FOnChange := nil;
+ FOnChanging := nil;
+ inherited Destroy;
+ if FCount <> 0 then Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
+end;
+
+function TCnAnsiStringList.Add(const S: AnsiString): Integer;
+begin
+ Result := AddObject(S, nil);
+end;
+
+function TCnAnsiStringList.AddObject(const S: AnsiString; AObject: TObject): Integer;
+begin
+ if not Sorted then
+ Result := FCount
+ else
+ if Find(S, Result) then
+ case Duplicates of
+ dupIgnore: Exit;
+ dupError: Error(@SDuplicateString, 0);
+ end;
+ InsertItem(Result, S, AObject);
+end;
+
+procedure TCnAnsiStringList.Changed;
+begin
+ if (FUpdateCount = 0) and Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TCnAnsiStringList.Changing;
+begin
+ if (FUpdateCount = 0) and Assigned(FOnChanging) then
+ FOnChanging(Self);
+end;
+
+procedure TCnAnsiStringList.Clear;
+begin
+ if FCount <> 0 then
+ begin
+ Changing;
+ Finalize(FList^[0], FCount);
+ FCount := 0;
+ SetCapacity(0);
+ Changed;
+ end;
+end;
+
+procedure TCnAnsiStringList.Delete(Index: Integer);
+begin
+ if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
+ Changing;
+ Finalize(FList^[Index]);
+ Dec(FCount);
+ if Index < FCount then
+ System.Move(FList^[Index + 1], FList^[Index],
+ (FCount - Index) * SizeOf(TCnAnsiStringItem));
+ Changed;
+end;
+
+procedure TCnAnsiStringList.Exchange(Index1, Index2: Integer);
+begin
+ if (Index1 < 0) or (Index1 >= FCount) then Error(@SListIndexError, Index1);
+ if (Index2 < 0) or (Index2 >= FCount) then Error(@SListIndexError, Index2);
+ Changing;
+ ExchangeItems(Index1, Index2);
+ Changed;
+end;
+
+procedure TCnAnsiStringList.ExchangeItems(Index1, Index2: Integer);
+var
+ Temp: TCnNativeInt;
+ Item1, Item2: PStringItem;
+begin
+ Item1 := @FList^[Index1];
+ Item2 := @FList^[Index2];
+ Temp := TCnNativeInt(Item1^.FString);
+ TCnNativeInt(Item1^.FString) := TCnNativeInt(Item2^.FString);
+ TCnNativeInt(Item2^.FString) := Temp;
+ Temp := TCnNativeInt(Item1^.FObject);
+ TCnNativeInt(Item1^.FObject) := TCnNativeInt(Item2^.FObject);
+ TCnNativeInt(Item2^.FObject) := Temp;
+end;
+
+function TCnAnsiStringList.Find(const S: AnsiString; var Index: Integer): Boolean;
+var
+ L, H, I, C: Integer;
+begin
+ Result := False;
+ L := 0;
+ H := FCount - 1;
+ while L <= H do
+ begin
+ I := (L + H) shr 1;
+ C := CompareStrings(FList^[I].FString, S);
+ if C < 0 then L := I + 1 else
+ begin
+ H := I - 1;
+ if C = 0 then
+ begin
+ Result := True;
+ if Duplicates <> dupAccept then L := I;
+ end;
+ end;
+ end;
+ Index := L;
+end;
+
+function TCnAnsiStringList.Get(Index: Integer): AnsiString;
+begin
+ if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
+ Result := FList^[Index].FString;
+end;
+
+function TCnAnsiStringList.GetCapacity: Integer;
+begin
+ Result := FCapacity;
+end;
+
+function TCnAnsiStringList.GetCount: Integer;
+begin
+ Result := FCount;
+end;
+
+function TCnAnsiStringList.GetObject(Index: Integer): TObject;
+begin
+ if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
+ Result := FList^[Index].FObject;
+end;
+
+procedure TCnAnsiStringList.Grow;
+var
+ Delta: Integer;
+begin
+ if FCapacity > 64 then Delta := FCapacity div 4 else
+ if FCapacity > 8 then Delta := 16 else
+ Delta := 4;
+ SetCapacity(FCapacity + Delta);
+end;
+
+function TCnAnsiStringList.IndexOf(const S: AnsiString): Integer;
+begin
+ if not Sorted then Result := inherited IndexOf(S) else
+ if not Find(S, Result) then Result := -1;
+end;
+
+procedure TCnAnsiStringList.Insert(Index: Integer; const S: AnsiString);
+begin
+ InsertObject(Index, S, nil);
+end;
+
+procedure TCnAnsiStringList.InsertObject(Index: Integer; const S: AnsiString;
+ AObject: TObject);
+begin
+ if Sorted then Error(@SSortedListError, 0);
+ if (Index < 0) or (Index > FCount) then Error(@SListIndexError, Index);
+ InsertItem(Index, S, AObject);
+end;
+
+procedure TCnAnsiStringList.InsertItem(Index: Integer; const S: AnsiString; AObject: TObject);
+begin
+ Changing;
+ if FCount = FCapacity then Grow;
+ if Index < FCount then
+ System.Move(FList^[Index], FList^[Index + 1],
+ (FCount - Index) * SizeOf(TCnAnsiStringItem));
+ with FList^[Index] do
+ begin
+ Pointer(FString) := nil;
+ FObject := AObject;
+ FString := S;
+ end;
+ Inc(FCount);
+ Changed;
+end;
+
+procedure TCnAnsiStringList.Put(Index: Integer; const S: AnsiString);
+begin
+ if Sorted then Error(@SSortedListError, 0);
+ if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
+ Changing;
+ FList^[Index].FString := S;
+ Changed;
+end;
+
+procedure TCnAnsiStringList.PutObject(Index: Integer; AObject: TObject);
+begin
+ if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
+ Changing;
+ FList^[Index].FObject := AObject;
+ Changed;
+end;
+
+procedure TCnAnsiStringList.QuickSort(L, R: Integer; SCompare: TCnAnsiStringListSortCompare);
+var
+ I, J, P: Integer;
+begin
+ repeat
+ I := L;
+ J := R;
+ P := (L + R) shr 1;
+ repeat
+ while SCompare(Self, I, P) < 0 do Inc(I);
+ while SCompare(Self, J, P) > 0 do Dec(J);
+ if I <= J then
+ begin
+ ExchangeItems(I, J);
+ if P = I then
+ P := J
+ else if P = J then
+ P := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if L < J then QuickSort(L, J, SCompare);
+ L := I;
+ until I >= R;
+end;
+
+procedure TCnAnsiStringList.SetCapacity(NewCapacity: Integer);
+begin
+ ReallocMem(FList, NewCapacity * SizeOf(TCnAnsiStringItem));
+ FCapacity := NewCapacity;
+end;
+
+procedure TCnAnsiStringList.SetSorted(Value: Boolean);
+begin
+ if FSorted <> Value then
+ begin
+ if Value then Sort;
+ FSorted := Value;
+ end;
+end;
+
+procedure TCnAnsiStringList.SetUpdateState(Updating: Boolean);
+begin
+ if Updating then Changing else Changed;
+end;
+
+function StringListCompareStrings(List: TCnAnsiStringList; Index1, Index2: Integer): Integer;
+begin
+ Result := List.CompareStrings(List.FList^[Index1].FString,
+ List.FList^[Index2].FString);
+end;
+
+procedure TCnAnsiStringList.Sort;
+begin
+ CustomSort(StringListCompareStrings);
+end;
+
+procedure TCnAnsiStringList.CustomSort(Compare: TCnAnsiStringListSortCompare);
+begin
+ if not Sorted and (FCount > 1) then
+ begin
+ Changing;
+ QuickSort(0, FCount - 1, Compare);
+ Changed;
+ end;
+end;
+
+function TCnAnsiStringList.CompareStrings(const S1, S2: AnsiString): Integer;
+begin
+ if CaseSensitive then
+ Result := AnsiCompareStr(string(S1), string(S2))
+ else
+ Result := AnsiCompareText(string(S1), string(S2));
+end;
+
+procedure TCnAnsiStringList.SetCaseSensitive(const Value: Boolean);
+begin
+ if Value <> FCaseSensitive then
+ begin
+ FCaseSensitive := Value;
+ if Sorted then Sort;
+ end;
+end;
+
+{ TCnAnsiStringHash }
+
+procedure TCnAnsiStringHash.Add(const Key: AnsiString; Value: Integer);
+var
+ Hash: Integer;
+ Bucket: PCnAnsiHashItem;
+begin
+ Hash := HashOf(Key) mod Cardinal(Length(Buckets));
+ New(Bucket);
+ Bucket^.Key := Key;
+ Bucket^.Value := Value;
+ Bucket^.Next := Buckets[Hash];
+ Buckets[Hash] := Bucket;
+end;
+
+procedure TCnAnsiStringHash.Clear;
+var
+ I: Integer;
+ P, N: PCnAnsiHashItem;
+begin
+ for I := 0 to Length(Buckets) - 1 do
+ begin
+ P := Buckets[I];
+ while P <> nil do
+ begin
+ N := P^.Next;
+ Dispose(P);
+ P := N;
+ end;
+ Buckets[I] := nil;
+ end;
+end;
+
+constructor TCnAnsiStringHash.Create(Size: Cardinal);
+begin
+ inherited Create;
+ SetLength(Buckets, Size);
+end;
+
+destructor TCnAnsiStringHash.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TCnAnsiStringHash.Find(const Key: AnsiString): PPCnAnsiHashItem;
+var
+ Hash: Integer;
+begin
+ Hash := HashOf(Key) mod Cardinal(Length(Buckets));
+ Result := @Buckets[Hash];
+ while Result^ <> nil do
+ begin
+ if Result^.Key = Key then
+ Exit
+ else
+ Result := @Result^.Next;
+ end;
+end;
+
+function TCnAnsiStringHash.HashOf(const Key: AnsiString): Cardinal;
+var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 1 to Length(Key) do
+ Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
+ Ord(Key[I]);
+end;
+
+function TCnAnsiStringHash.Modify(const Key: AnsiString; Value: Integer): Boolean;
+var
+ P: PCnAnsiHashItem;
+begin
+ P := Find(Key)^;
+ if P <> nil then
+ begin
+ Result := True;
+ P^.Value := Value;
+ end
+ else
+ Result := False;
+end;
+
+procedure TCnAnsiStringHash.Remove(const Key: AnsiString);
+var
+ P: PCnAnsiHashItem;
+ Prev: PPCnAnsiHashItem;
+begin
+ Prev := Find(Key);
+ P := Prev^;
+ if P <> nil then
+ begin
+ Prev^ := P^.Next;
+ Dispose(P);
+ end;
+end;
+
+function TCnAnsiStringHash.ValueOf(const Key: AnsiString): Integer;
+var
+ P: PCnAnsiHashItem;
+begin
+ P := Find(Key)^;
+ if P <> nil then
+ Result := P^.Value
+ else
+ Result := -1;
+end;
+
+{ TCnHashedAnsiStringList }
+
+procedure TCnHashedAnsiStringList.Changed;
+begin
+ inherited Changed;
+ FValueHashValid := False;
+ FNameHashValid := False;
+end;
+
+destructor TCnHashedAnsiStringList.Destroy;
+begin
+ FValueHash.Free;
+ FNameHash.Free;
+ inherited Destroy;
+end;
+
+function TCnHashedAnsiStringList.IndexOf(const S: AnsiString): Integer;
+begin
+ UpdateValueHash;
+ if not CaseSensitive then
+ Result := FValueHash.ValueOf(AnsiString(AnsiUpperCase(string(S))))
+ else
+ Result := FValueHash.ValueOf(S);
+end;
+
+function TCnHashedAnsiStringList.IndexOfName(const Name: AnsiString): Integer;
+begin
+ UpdateNameHash;
+ if not CaseSensitive then
+ Result := FNameHash.ValueOf(AnsiString(AnsiUpperCase(string(Name))))
+ else
+ Result := FNameHash.ValueOf(Name);
+end;
+
+procedure TCnHashedAnsiStringList.UpdateNameHash;
+var
+ I: Integer;
+ P: Integer;
+ Key: AnsiString;
+begin
+ if FNameHashValid then Exit;
+
+ if FNameHash = nil then
+ FNameHash := TCnAnsiStringHash.Create
+ else
+ FNameHash.Clear;
+ for I := 0 to Count - 1 do
+ begin
+ Key := Get(I);
+ P := AnsiPos('=', string(Key));
+ if P <> 0 then
+ begin
+ if not CaseSensitive then
+ Key := AnsiString(AnsiUpperCase(string(Copy(Key, 1, P - 1))))
+ else
+ Key := Copy(Key, 1, P - 1);
+ FNameHash.Add(Key, I);
+ end;
+ end;
+ FNameHashValid := True;
+end;
+
+procedure TCnHashedAnsiStringList.UpdateValueHash;
+var
+ I: Integer;
+begin
+ if FValueHashValid then Exit;
+
+ if FValueHash = nil then
+ FValueHash := TCnAnsiStringHash.Create
+ else
+ FValueHash.Clear;
+ for I := 0 to Count - 1 do
+ if not CaseSensitive then
+ FValueHash.Add(AnsiString(AnsiUpperCase(string(Self[I]))), I)
+ else
+ FValueHash.Add(Self[I], I);
+ FValueHashValid := True;
+end;
+
+// жһַǷƥķָ
+function IsSepChar(AChar: Char): Boolean;
+begin
+{$IFDEF UNICODE}
+ Result := not CharInSet(AChar, ['0'..'9', 'A'..'Z', 'a'..'z', '_']);
+{$ELSE}
+ Result := not (AChar in ['0'..'9', 'A'..'Z', 'a'..'z', '_']);
+{$ENDIF}
+end;
+
+function IsSepCharA(AChar: AnsiChar): Boolean;
+begin
+ Result := not (AChar in ['0'..'9', 'A'..'Z', 'a'..'z', '_']);
+end;
+
+function IsSepCharW(AChar: WideChar): Boolean;
+begin
+ Result := (Ord(AChar) < 127) and not (AnsiChar(AChar) in ['0'..'9', 'A'..'Z', 'a'..'z', '_']);
+end;
+
+function CnStringReplace(const S, OldPattern, NewPattern: string;
+ Flags: TCnReplaceFlags): string;
+var
+ SearchStr, Patt, NewStr: string;
+ Offset, TailOffset: Integer;
+ IsWhole: Boolean;
+begin
+ if crfIgnoreCase in Flags then
+ begin
+{$IFDEF UNICODE}
+ SearchStr := UpperCase(S);
+ Patt := UpperCase(OldPattern);
+{$ELSE}
+ SearchStr := AnsiUpperCase(S);
+ Patt := AnsiUpperCase(OldPattern);
+{$ENDIF}
+ end
+ else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+
+ NewStr := S;
+ Result := '';
+
+ while SearchStr <> '' do
+ begin
+{$IFDEF UNICODE}
+ Offset := Pos(Patt, SearchStr);
+{$ELSE}
+ Offset := AnsiPos(Patt, SearchStr);
+{$ENDIF}
+ IsWhole := True;
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end
+ else if crfWholeWord in Flags then
+ begin
+ // ҵӴҪƥ䣬жϣ
+ // ͷͷǷָββǷָ
+ if (Offset > 1) and not IsSepChar(SearchStr[Offset - 1]) then
+ IsWhole := False
+ else
+ begin
+ TailOffset := Offset + Length(Patt); // ָƥһַ
+ if (TailOffset <= Length(SearchStr)) and not IsSepChar(SearchStr[TailOffset]) then
+ IsWhole := False;
+ end;
+
+ // õǷƥĽ
+ end;
+
+ if not (crfWholeWord in Flags) or IsWhole then // ͨƥƥ
+ begin
+ // 滻һ
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (crfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ end
+ else // ƥҪ£δƥ䣬滻
+ begin
+ Result := Result + Copy(NewStr, 1, Offset - 1) + OldPattern; // ע OldePattern滻
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+{$IFDEF UNICODE}
+
+function CnStringReplaceA(const S, OldPattern, NewPattern: AnsiString;
+ Flags: TCnReplaceFlags): AnsiString;
+var
+ SearchStr, Patt, NewStr: AnsiString;
+ Offset, TailOffset: Integer;
+ IsWhole: Boolean;
+begin
+ if crfIgnoreCase in Flags then
+ begin
+ SearchStr := AnsiUpperCase(S);
+ Patt := AnsiUpperCase(OldPattern);
+ end
+ else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+
+ NewStr := S;
+ Result := '';
+
+ while SearchStr <> '' do
+ begin
+ Offset := AnsiPos(Patt, SearchStr);
+ IsWhole := True;
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end
+ else if crfWholeWord in Flags then
+ begin
+ // ҵӴҪƥ䣬жϣ
+ // ͷͷǷָββǷָ
+ if (Offset > 1) and not IsSepCharA(SearchStr[Offset - 1]) then
+ IsWhole := False
+ else
+ begin
+ TailOffset := Offset + Length(Patt); // ָƥһַ
+ if (TailOffset <= Length(SearchStr)) and not IsSepCharA(SearchStr[TailOffset]) then
+ IsWhole := False;
+ end;
+
+ // õǷƥĽ
+ end;
+
+ if not (crfWholeWord in Flags) or IsWhole then // ͨƥƥ
+ begin
+ // 滻һ
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (crfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ end
+ else // ƥҪ£δƥ䣬滻
+ begin
+ Result := Result + Copy(NewStr, 1, Offset - 1) + OldPattern; // ע OldePattern滻
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+{$ELSE}
+
+function CnStringReplaceW(const S, OldPattern, NewPattern: WideString;
+ Flags: TCnReplaceFlags): WideString;
+var
+ SearchStr, Patt, NewStr: WideString;
+ Offset, TailOffset: Integer;
+ IsWhole: Boolean;
+begin
+ if crfIgnoreCase in Flags then
+ begin
+ SearchStr := UpperCase(S);
+ Patt := UpperCase(OldPattern);
+ end
+ else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+
+ NewStr := S;
+ Result := '';
+
+ while SearchStr <> '' do
+ begin
+ Offset := Pos(Patt, SearchStr);
+ IsWhole := True;
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end
+ else if crfWholeWord in Flags then
+ begin
+ // ҵӴҪƥ䣬жϣ
+ // ͷͷǷָββǷָ
+ if (Offset > 1) and not IsSepCharW(SearchStr[Offset - 1]) then
+ IsWhole := False
+ else
+ begin
+ TailOffset := Offset + Length(Patt); // ָƥһַ
+ if (TailOffset <= Length(SearchStr)) and not IsSepCharW(SearchStr[TailOffset]) then
+ IsWhole := False;
+ end;
+
+ // õǷƥĽ
+ end;
+
+ if not (crfWholeWord in Flags) or IsWhole then // ͨƥƥ
+ begin
+ // 滻һ
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (crfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ end
+ else // ƥҪ£δƥ䣬滻
+ begin
+ Result := Result + Copy(NewStr, 1, Offset - 1) + OldPattern; // ע OldePattern滻
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+{$ENDIF}
+
+function CnPosEx(const SubStr, S: string; CaseSensitive: Boolean; WholeWords:
+ Boolean; StartCount: Integer): Integer;
+var
+ P: PChar;
+ I, Count, Len, SubLen: Integer;
+ StrUpper, SubUpper: string;
+begin
+ Result := 0;
+ if (SubStr = '') or (S = '') or (StartCount < 1) then
+ Exit;
+
+ Len := Length(S);
+ SubLen := Length(SubStr);
+ if SubLen > Len then
+ Exit;
+
+ if not CaseSensitive then
+ begin
+ StrUpper := UpperCase(S);
+ SubUpper := UpperCase(SubStr);
+ P := PChar(StrUpper);
+ end
+ else
+ P := PChar(S);
+
+ Count := 0;
+ for I := 1 to Len - SubLen + 1 do
+ begin
+ if (CaseSensitive and (P^ = SubStr[1]) and
+ (CompareMem(P, PChar(SubStr), SubLen * SizeOf(Char))))
+ or
+ (not CaseSensitive and (P^ = SubUpper[1]) and
+ (CompareMem(P, PChar(SubUpper), SubLen * SizeOf(Char)))) then
+ begin
+ if WholeWords then
+ begin
+ // Ƿƥ
+ if ((I = 1) or IsSepChar((P - 1)^)) and
+ ((I + SubLen - 1 >= Len) or IsSepChar((P + SubLen)^)) then
+ begin
+ Inc(Count);
+ if Count = StartCount then
+ begin
+ Result := I;
+ Exit;
+ end;
+ end;
+ end
+ else
+ begin
+ Inc(Count);
+ if Count = StartCount then
+ begin
+ Result := I;
+ Exit;
+ end;
+ end;
+ end;
+ Inc(P);
+ end;
+end;
+
+procedure CnSplitString(const Sub: string; const Str: string; Strings: TStrings);
+var
+ S: string;
+ P, SubLen: Integer;
+begin
+ if Strings = nil then
+ Exit; // Կָ
+
+ Strings.Clear; // ԭ
+
+ // ָΪյַΪһĿ
+ if Sub = '' then
+ begin
+ Strings.Add(Str);
+ Exit;
+ end;
+
+ // ԴַΪյһĿ
+ if Str = '' then
+ begin
+ Strings.Add('');
+ Exit;
+ end;
+
+ SubLen := Length(Sub);
+ S := Str; // ԴַĸĴ˸
+
+ while S <> '' do
+ begin
+ P := Pos(Sub, S); // ʣַвҷָ
+
+ if P = 0 then
+ begin
+ // ûиָʣಿΪһĿ
+ Strings.Add(S);
+ Break;
+ end;
+
+ // ȡӿͷָǰݣΪգ
+ Strings.Add(Copy(S, 1, P - 1));
+
+ // ɾѴIJ֣ҵķָ
+ Delete(S, 1, P + SubLen - 1);
+
+ // ɾַΪգԭַԷָβҪһĿ
+ if S = '' then
+ Strings.Add('');
+ end;
+end;
+
+{$WARNINGS ON}
+
+{ TCnStringBuilder }
+
+constructor TCnStringBuilder.Create;
+begin
+ inherited;
+ if not FModeIsFromOut then // ⲿδָʱԶģʽ
+ begin
+{$IFDEF UNICODE}
+ FAnsiMode := False;
+{$ELSE}
+ FAnsiMode := True;
+{$ENDIF}
+ end
+ else
+ FAnsiMode := FOutMode;
+
+ if FAnsiMode then
+ FMaxCharCapacity := MaxInt
+ else
+ FMaxCharCapacity := MaxInt div 2;
+
+ CharCapacity := STRING_BUILDER_DEFAULT_CAPACITY;
+ FCharLength := 0;
+end;
+
+function TCnStringBuilder.Append(const Value: string): TCnStringBuilder;
+begin
+{$IFDEF UNICODE}
+ if FAnsiMode then
+ Result := AppendAnsi(AnsiString(Value))
+ else
+ Result := AppendString(Value);
+{$ELSE}
+ if FAnsiMode then
+ Result := AppendString(Value)
+ else
+ Result := AppendWide(WideString(Value));
+{$ENDIF}
+end;
+
+{$IFDEF UNICODE}
+
+function TCnStringBuilder.AppendAnsi(const Value: AnsiString): TCnStringBuilder;
+var
+ Delta, OL: Integer;
+begin
+ Delta := Length(Value);
+ if Delta <> 0 then
+ begin
+ OL := CharLength;
+ CharLength := CharLength + Delta;
+ if CharLength > CharCapacity then
+ ExpandCharCapacity;
+ Move(Pointer(Value)^, (PAnsiChar(Pointer(FAnsiData)) + OL)^, Delta * SizeOf(AnsiChar));
+ end;
+ Result := Self;
+end;
+
+{$ELSE}
+
+function TCnStringBuilder.AppendWide(const Value: WideString): TCnStringBuilder;
+var
+ Delta, OL: Integer;
+begin
+ Delta := Length(Value);
+ if Delta <> 0 then
+ begin
+ OL := CharLength;
+ CharLength := CharLength + Delta;
+ if CharLength > CharCapacity then
+ ExpandCharCapacity;
+ Move(Pointer(Value)^, (PWideChar(Pointer(FWideData)) + OL)^, Delta * SizeOf(WideChar));
+ end;
+ Result := Self;
+end;
+
+{$ENDIF}
+
+constructor TCnStringBuilder.Create(IsAnsi: Boolean);
+begin
+ FModeIsFromOut := True;
+ FOutMode := IsAnsi; // ⲿָ AnsiMode
+ Create;
+end;
+
+destructor TCnStringBuilder.Destroy;
+begin
+ inherited;
+
+end;
+
+procedure TCnStringBuilder.ExpandCharCapacity;
+var
+ NC: Integer;
+begin
+ NC := (CharCapacity * 3) div 2;
+ if CharLength > NC then
+ NC := CharLength * 2;
+ if NC > FMaxCharCapacity then
+ NC := FMaxCharCapacity;
+ if NC < 0 then
+ NC := CharLength;
+
+ CharCapacity := NC;
+end;
+
+function TCnStringBuilder.GetCharCapacity: Integer;
+begin
+{$IFDEF UNICODE}
+ if FAnsiMode then
+ Result := Length(FAnsiData)
+ else
+ Result := Length(FData);
+{$ELSE}
+ if FAnsiMode then
+ Result := Length(FData)
+ else
+ Result := Length(FWideData);
+{$ENDIF}
+end;
+
+procedure TCnStringBuilder.SetCharCapacity(const Value: Integer);
+begin
+ if (Value < FCharLength) or (Value > FMaxCharCapacity) then
+ raise ERangeError.CreateResFmt(@SListCapacityError, [Value]);
+
+{$IFDEF UNICODE}
+ if FAnsiMode then
+ SetLength(FAnsiData, Value) // FAnsiData
+ else
+ SetLength(FData, Value); // FData
+{$ELSE}
+ if FAnsiMode then
+ SetLength(FData, Value) // FData
+ else
+ SetLength(FWideData, Value); // FWideData
+{$ENDIF}
+end;
+
+procedure TCnStringBuilder.SetCharLength(const Value: Integer);
+var
+ OL: Integer;
+begin
+ if (Value < 0) or (Value > FMaxCharCapacity) then
+ raise ERangeError.CreateResFmt(@SListCapacityError, [Value]);
+
+ OL := FCharLength;
+ try
+ FCharLength := Value;
+ if FCharLength > CharCapacity then
+ ExpandCharCapacity;
+ except
+ on E: EOutOfMemory do
+ begin
+ FCharLength := OL;
+ raise;
+ end;
+ end;
+end;
+
+function TCnStringBuilder.AppendString(const Value: string): TCnStringBuilder;
+var
+ Delta, OL: Integer;
+begin
+ Delta := Length(Value);
+ if Delta <> 0 then
+ begin
+ OL := CharLength;
+ FCharLength := CharLength + Delta;
+ if CharLength > CharCapacity then
+ ExpandCharCapacity;
+
+ Move(Pointer(Value)^, (PChar(Pointer(FData)) + OL)^, Delta * SizeOf(Char));
+ end;
+ Result := Self;
+end;
+
+function TCnStringBuilder.ToString: string;
+begin
+ if FCharLength = CharCapacity then
+ Result := FData
+ else
+ Result := Copy(FData, 1, FCharLength);
+end;
+
+function TCnStringBuilder.ToAnsiString: AnsiString;
+begin
+{$IFDEF UNICODE}
+ if FAnsiMode then // Unicode Ansi ģʽ FAnsiDataת
+ begin
+ if FCharLength = CharCapacity then
+ Result := FAnsiData
+ else
+ Result := Copy(FAnsiData, 1, FCharLength);
+ end
+ else // Unicode Ƿ Ansi ģʽ FData AnsiString ת
+ begin
+ if FCharLength = CharCapacity then
+ Result := AnsiString(FData)
+ else
+ Result := AnsiString(Copy(FData, 1, FCharLength));
+ end;
+{$ELSE}
+ Result := ToString; // Unicode µ ToString
+{$ENDIF}
+end;
+
+function TCnStringBuilder.ToWideString: WideString;
+begin
+{$IFNDEF UNICODE}
+ if FAnsiMode then // Unicode Ansi ģʽ FData WideString ת
+ begin
+ if FCharLength = CharCapacity then
+ Result := WideString(FData)
+ else
+ Result := WideString(Copy(FData, 1, FCharLength));
+ end
+ else // Unicode Ƿ Ansi ģʽ FWideDataת
+ begin
+ if FCharLength = CharCapacity then
+ Result := FWideData
+ else
+ Result := Copy(FWideData, 1, FCharLength);
+ end;
+{$ELSE}
+ Result := ToString; // Unicode µ ToString
+{$ENDIF}
+end;
+
+function TCnStringBuilder.Append(Value: Integer): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: SmallInt): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: TObject): TCnStringBuilder;
+begin
+{$IFDEF OBJECT_HAS_TOSTRING}
+ Result := Append(Value.ToString);
+{$ELSE}
+ Result := Append(IntToHex(TCnNativeInt(Value), 2));
+{$ENDIF}
+end;
+
+function TCnStringBuilder.Append(Value: Int64): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: Double): TCnStringBuilder;
+begin
+ Result := Append(FloatToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: Byte): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: Boolean): TCnStringBuilder;
+begin
+ if Value then
+ Result := Append('True')
+ else
+ Result := Append('False');
+end;
+
+function TCnStringBuilder.AppendCurrency(Value: Currency): TCnStringBuilder;
+begin
+ Result := Append(CurrToStr(Value));
+end;
+
+function TCnStringBuilder.AppendChar(Value: Char): TCnStringBuilder;
+var
+ S: string;
+begin
+ SetLength(S, 1);
+ Move(Value, S[1], SizeOf(Char));
+ Result := Append(S);
+end;
+
+function TCnStringBuilder.Append(Value: ShortInt): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: Char;
+ RepeatCount: Integer): TCnStringBuilder;
+begin
+ Result := Append(StringOfChar(Value, RepeatCount));
+end;
+
+function TCnStringBuilder.Append(Value: PAnsiChar): TCnStringBuilder;
+begin
+ Result := Append(string(Value));
+end;
+
+function TCnStringBuilder.Append(const Value: string; StartIndex,
+ Count: Integer): TCnStringBuilder;
+begin
+ Result := Append(Copy(Value, StartIndex, Count));
+end;
+
+function TCnStringBuilder.Append(Value: Cardinal): TCnStringBuilder;
+begin
+ Result := Append(UInt32ToStr(Value));
+end;
+
+{$IFDEF SUPPORT_UINT64}
+
+function TCnStringBuilder.Append(Value: UInt64): TCnStringBuilder;
+begin
+ Result := Append(UInt64ToStr(Value));
+end;
+
+{$ENDIF}
+
+function TCnStringBuilder.Append(Value: Single): TCnStringBuilder;
+begin
+ Result := Append(FloatToStr(Value));
+end;
+
+function TCnStringBuilder.Append(Value: Word): TCnStringBuilder;
+begin
+ Result := Append(IntToStr(Value));
+end;
+
+procedure TCnStringBuilder.Clear;
+begin
+ CharLength := 0;
+ CharCapacity := STRING_BUILDER_DEFAULT_CAPACITY;
+end;
+
+function TCnStringBuilder.AppendLine: TCnStringBuilder;
+begin
+ Result := Append(SLineBreak);
+end;
+
+function TCnStringBuilder.AppendLine(const Value: string): TCnStringBuilder;
+begin
+ Result := Append(Value + SLineBreak);
+end;
+
+function TCnStringBuilder.Append(const AFormat: string;
+ const Args: array of const): TCnStringBuilder;
+begin
+ Result := Append(Format(AFormat, Args));
+end;
+
+function TCnStringBuilder.AppendAnsiChar(Value: AnsiChar): TCnStringBuilder;
+var
+ S: AnsiString;
+begin
+ SetLength(S, 1);
+ Move(Value, S[1], SizeOf(AnsiChar));
+{$IFDEF UNICODE}
+ Result := AppendAnsi(S);
+{$ELSE}
+ Result := Append(S); // Unicode S תΪ string ܻʺ
+{$ENDIF}
+end;
+
+function TCnStringBuilder.AppendWideChar(Value: WideChar): TCnStringBuilder;
+var
+ S: WideString;
+begin
+ SetLength(S, 1);
+ Move(Value, S[1], SizeOf(WideChar));
+{$IFDEF UNICODE}
+ Result := Append(S);
+{$ELSE}
+ Result := AppendWide(S);
+{$ENDIF}
+end;
+
+end.
diff --git a/CnPack/Common/CnWideStrings.pas b/CnPack/Common/CnWideStrings.pas
new file mode 100644
index 0000000..ae4115b
--- /dev/null
+++ b/CnPack/Common/CnWideStrings.pas
@@ -0,0 +1,2215 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnWideStrings;
+{* |
+================================================================================
+* ƣ
+* ԪƣWideStrings Ԫ֧ Win32/64 Posix
+* ԪߣCnPack
+* עõԪʵ˼ TCnWideStringList 벿 Unicode ַ
+* Լչ UTF-8 UTF-16 ı뺯֧ UTF-16 еַֽ UTF8-MB4
+*
+* ⣬Ԫڴ Ansi ַ Utf16 ַתʱ漰
+* һַֽռпռʾȱ
+* ͬųǰ߲ܵͬʴҪ ByteLength DisplayLength
+* ȡַֽ IDE Ϊأ ByteLength ϵк
+* ռпռʾȱҪ IDE Ϊйأ IDE 汾йأ
+* DisplayLength ϵкͬط벻ͬ Calculator м
+*
+* 䣺Lazarus IDE бʱʹ LConvEncoding תƺ
+*
+* ƽ̨WinXP SP3 + Delphi 5.0
+* ݲԣ
+* õԪеַϱػʽ
+* ļ¼2025.08.06 V1.3
+* Ansi תΪ Utf8 ֧ FPC
+* 2024.08.01 V1.3
+* ַָʾȼص㲿Զ
+* ֳ Ansi ByteLength DisplayLength ϵк
+* жʾȡеȣҪ DisplayLength ϵк
+* IDE Ҫô붨ƻ Calculator
+* 2022.11.25 V1.2
+* CnGB18030 аƹ Unicode
+* 2022.11.10 V1.1
+* UTF-8 ֧ UTF8-MB4 UTF-16 еַֽ
+* 2010.01.16 by ZhouJingyu
+* ʼύ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+// {$DEFINE UTF16_BE}
+
+// Delphi Ĭ UTF16-LEҪ UTF16-BE ַҪ UTF16_BE
+
+uses
+ {$IFDEF MSWINDOWS} Windows, {$ENDIF} SysUtils, Classes, CnNative
+ {$IFDEF LAZARUS}, LConvEncoding {$ENDIF};
+
+const
+ CN_INVALID_CODEPOINT = $FFFFFFFF;
+ {* Ƿֵ}
+
+ CN_ALTERNATIVE_CHAR = '?';
+ {* תʱĬ滻ַ}
+
+type
+ ECnWideStringException = class(Exception);
+ {* ַ쳣}
+
+{$IFDEF UNICODE}
+ TCnWideString = string;
+{$ELSE}
+ TCnWideString = WideString;
+{$ENDIF}
+
+ TCnCodePoint = type Cardinal;
+ {* ֵַ߽㣬ڱı뷽ʽ}
+
+ TCn2CharRec = packed record
+ {* ˫ַֽṹ}
+ P1: AnsiChar;
+ P2: AnsiChar;
+ end;
+ PCn2CharRec = ^TCn2CharRec;
+
+ TCn4CharRec = packed record
+ {* ַֽṹ}
+ P1: AnsiChar;
+ P2: AnsiChar;
+ P3: AnsiChar;
+ P4: AnsiChar;
+ end;
+ PCn4CharRec = ^TCn4CharRec;
+
+{ TCnWideStringList }
+
+ TCnWideListFormat = (wlfAnsi, wlfUtf8, wlfUnicode);
+ {* 뱣ʱֱֵ֧룬AnsiUtf8Utf16}
+
+ TCnWideStringList = class;
+ TCnWideStringListSortCompare = function(List: TCnWideStringList; Index1, Index2: Integer): Integer;
+
+ PCnWideStringItem = ^TCnWideStringItem;
+ TCnWideStringItem = record
+ FString: WideString;
+ FObject: TObject;
+ end;
+
+ TCnWideStringList = class(TPersistent)
+ {* WideString TStringList ʵ֣Load/Save ʱбĴ}
+ private
+ FList: TList;
+ FUseSingleLF: Boolean;
+ FLoadFormat: TCnWideListFormat;
+ FWriteBOM: Boolean;
+ function GetName(Index: Integer): WideString;
+ function GetValue(const Name: WideString): WideString;
+ procedure SetValue(const Name, Value: WideString);
+ procedure QuickSort(L, R: Integer; SCompare: TCnWideStringListSortCompare);
+ function GetObject(Index: Integer): TObject;
+ procedure PutObject(Index: Integer; const Value: TObject);
+ protected
+ function Get(Index: Integer): WideString; virtual;
+ function GetCount: Integer; virtual;
+ function GetTextStr: WideString; virtual;
+ procedure Put(Index: Integer; const S: WideString); virtual;
+ procedure SetTextStr(const Value: WideString); virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Add(const S: WideString): Integer; virtual;
+ procedure AddStrings(Strings: TCnWideStringList); virtual;
+ function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear; virtual;
+ procedure Delete(Index: Integer); virtual;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function IndexOf(const S: WideString): Integer; virtual;
+ function IndexOfName(const Name: WideString): Integer;
+ procedure Insert(Index: Integer; const S: WideString); virtual;
+ procedure LoadFromFile(const FileName: WideString); virtual;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure SaveToFile(const FileName: WideString; AFormat: TCnWideListFormat = wlfUnicode); virtual;
+ procedure SaveToStream(Stream: TStream; AFormat: TCnWideListFormat = wlfUnicode); virtual;
+ procedure CustomSort(Compare: TCnWideStringListSortCompare); virtual;
+ procedure Sort; virtual;
+ property Count: Integer read GetCount;
+ property Names[Index: Integer]: WideString read GetName;
+ property Objects[Index: Integer]: TObject read GetObject write PutObject;
+ property Values[const Name: WideString]: WideString read GetValue write SetValue;
+ property Strings[Index: Integer]: WideString read Get write Put; default;
+ property Text: WideString read GetTextStr write SetTextStr;
+
+ property UseSingleLF: Boolean read FUseSingleLF write FUseSingleLF;
+ {* GetTextStr ʱʹõĻǷǵ #10 dz #13#10}
+ property LoadFormat: TCnWideListFormat read FLoadFormat;
+ {* LoadFromStream ʱʶĸʽ}
+ property WriteBOM: Boolean read FWriteBOM write FWriteBOM;
+ {* Ƿд BOM ͷ}
+ end;
+
+ TCnWideCharDisplayWideLengthCalculator = function(AWChar: WideChar): Boolean;
+ {* Կַʾȼصͣͬ Delphi IDE ༭Ҫͬʵ}
+
+function CnUtf8EncodeWideString(const S: TCnWideString): AnsiString;
+{* WideString UTF-8 벢ݷŵ AnsiString зأ Ansi תⶪַ
+ ֽ֧ UTF-16 ַ UTF8-MB4
+
+
+ const S: WideString/UnicodeString - תĿַ
+
+ ֵAnsiString - UTF-8 ַ
+}
+
+function CnUtf8DecodeToWideString(const S: AnsiString): TCnWideString;
+{* UTF-8 AnsiString UTF-8 õ WideString Ansi תⶪַ
+ ֽ֧ UTF-16 ַ UTF8-MB4
+
+
+ const S: AnsiString - ת UTF-8 ַ
+
+ ֵWideString/UnicodeString - صĿַ
+}
+
+function GetUtf16HighByte(Rec: PCn2CharRec): Byte; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* õһ UTF-16 ˫ַֽĸλֵֽ
+
+
+ Rec: PCn2CharRec - ȡ˫ַֽṹָ
+
+ ֵByte - ظλֵֽ
+}
+
+function GetUtf16LowByte(Rec: PCn2CharRec): Byte; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* õһ UTF-16 ˫ַֽĵλֵֽ
+
+
+ Rec: PCn2CharRec - ȡ˫ַֽṹָ
+
+ ֵByte - صλֵֽ
+}
+
+procedure SetUtf16HighByte(B: Byte; Rec: PCn2CharRec); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* һ UTF-16 ˫ַֽĸλֵֽ
+
+
+ B: Byte - õĸλֵֽ
+ Rec: PCn2CharRec - õ˫ַֽṹָ
+
+ ֵޣ
+}
+
+procedure SetUtf16LowByte(B: Byte; Rec: PCn2CharRec); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* һ UTF-16 ˫ַֽĵλֵֽ
+
+
+ B: Byte - õĵλֵֽ
+ Rec: PCn2CharRec - õ˫ַֽṹָ
+
+ ֵޣ
+}
+
+function GetCharLengthFromUtf8(Utf8Str: PAnsiChar): Integer;
+{* һ UTF-8 UTF8-MB4ַַ
+
+
+ Utf8Str: PAnsiChar - UTF-8 ַַ
+
+ ֵInteger - ظַַ
+}
+
+function GetCharLengthFromUtf16(Utf16Str: PWideChar): Integer;
+{* һ UTF-16ܻ Unicode չƽַַַֽ
+
+
+ Utf16Str: PWideChar - UTF-16 ַַ
+
+ ֵInteger - ظַַ
+}
+
+function GetByteWidthFromUtf8(Utf8Str: PAnsiChar): Integer;
+{* һ UTF-8 UTF8-MB4ַĵǰַռֽڡ
+
+
+ Utf8Str: PAnsiChar - UTF-8 ַַ
+
+ ֵInteger - ظַֽ
+}
+
+function GetByteWidthFromUtf16(Utf16Str: PWideChar): Integer;
+{* һ UTF-16ܻ Unicode չƽַַֽĵǰַռֽڡ
+
+
+ Utf16Str: PWideChar - UTF-16 ַַ
+
+ ֵInteger - ظַֽ
+}
+
+function GetCodePointFromUtf16Char(Utf16Str: PWideChar): TCnCodePoint;
+{* һ UTF-16 ַıֵҲдλãע Utf16Str ָһ˫ַֽҲָһַֽ
+
+
+ Utf16Str: PWideChar - UTF-16 ַַ
+
+ ֵTCnCodePoint - ظַıֵ
+}
+
+function GetCodePointFromUtf164Char(PtrTo4Char: Pointer): TCnCodePoint;
+{* һֽ UTF-16 ַıֵҲдλã
+
+
+ PtrTo4Char: Pointer - ֽ UTF-16 ַַ
+
+ ֵTCnCodePoint - ظַıֵ
+}
+
+function GetUtf16CharFromCodePoint(CP: TCnCodePoint; PtrToChars: Pointer): Integer;
+{* һ Unicode ֵĶֽڻֽڱʾ PtrToChars ָλòΪգ
+ PtrToChars ָĶֽڻֽǷ 1 PtrToChars Ϊ #0#0
+ CP $FFFF ʱ뱣֤ PtrToChars ָֽڣֽ֮ڼɡ
+ 1 2ֱʾǶֽڻֽڡ
+
+
+ CP: TCnCodePoint - Unicode ֵ
+ PtrToChars: Pointer - nilתĽ
+
+ ֵInteger - 1 ַռֽڣ 2 ֽ
+}
+
+// =============================================================================
+//
+// º漰ַ UTF-8 תʱļ㣬ȽϹ̶
+//
+// =============================================================================
+
+function CalcUtf8LengthFromWideString(Text: PWideChar): Integer;
+{* ַ UTF-8 ȣ Utf8Encode ȡ Lengthʵת
+
+
+ Text: PWideChar - Ŀַַ
+
+ ֵInteger - UTF-8 ֽڳ
+}
+
+function CalcUtf8LengthFromWideChar(AChar: WideChar): Integer; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* һ WideChar ת UTF-8 ַȡ
+
+
+ AChar: WideChar - Ŀַ
+
+ ֵInteger - UTF-8 ֽڳ
+}
+
+function CalcUtf8LengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer): Integer;
+{* Unicode ַ 1 WideOffset Ӵ UTF-8 ȣWideOffset 1 ʼ WideOffset 0 0
+ Copy(1, WideOffset) Ӵת UTF-8 ȡ Lengthʵת
+
+
+ Text: PWideChar - Ŀַַ
+ WideOffset: Integer - ԿַΪλƫ
+
+ ֵInteger - ظÿַ 1 WideOffset Ӵ UTF-8
+}
+
+function CalcUtf8LengthFromWideStringAnsiOffset(Text: PWideChar; AnsiOffset: Integer): Integer;
+{* Unicode ַת Ansi 1 AnsiOffset Ӵ UTF-8 ȣAnsiOffset 1 ʼ AnsiOffset 0 0
+ ת Ansi Copy(1, AnsiOffset) Ӵת Unicode ַת UTF-8 ȡ Lengthʵת
+
+
+ Text: PWideChar - Ŀַַ
+ AnsiOffset: Integer - Ansi ַΪλƫ
+
+ ֵInteger - ظÿַת Ansi 1 AnsiOffset Ӵ UTF-8
+}
+
+function CalcUtf8LengthFromUtf8HeadChar(AChar: AnsiChar): Integer;
+{* һ UTF-8 ǰַַȡ
+
+
+ AChar: AnsiChar - UTF-8 ַ
+
+ ֵInteger - ַ
+}
+
+function CalcUtf8StringLengthFromWideOffset(Utf8Text: PAnsiChar; WideOffset: Integer): Integer;
+{* UTF-8 ַת WideSting ָ Wide ӴȶӦ UTF-8 ַȣWideOffset 1 ʼ
+ ת WideString Copy(1, WideOffset) ת UTF-8 ȡ Length UTF-8/WideString תԱı⡣
+
+
+ Utf8Text: PAnsiChar - UTF-8 ַַ
+ WideOffset: Integer - ԿַΪλƫ
+
+ ֵInteger - ظ UTF-8 ַת WideSting ָ 1 WideOffset ӴӦ UTF-8 ַ
+}
+
+// =============================================================================
+//
+// º漰ַ Ansi תʱֽռп/ռʾȱȵļ
+//
+// =============================================================================
+
+function WideCharIsWideLength(const AWChar: WideChar): Boolean; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* жһ Unicode ַǷռַȣĬϵļªʵ֣ IDE 汾Ϊء
+ ºе TCnWideCharDisplayWideLengthCalculator Ĭʵ֡
+
+
+ const AWChar: WideChar - жϵĿַ
+
+ ֵBoolean - Ƿռַ
+}
+
+function CalcAnsiByteLengthFromWideString(Text: PWideChar): Integer;
+{* Unicode ַ Ansi ֽڳȣת Ansi Lengthת AnsiԷֹӢƽ̨¶ַ
+ $FF UTF-16 ַ 2 ֽڣΪ 1 ֽڡ
+
+
+ Text: PWideChar - Ŀַַ
+
+ ֵInteger - ת Ansi ַ
+}
+
+function CalcAnsiDisplayLengthFromWideString(Text: PWideChar;
+ Calculator: TCnWideCharDisplayWideLengthCalculator = nil): Integer;
+{* Unicode ַ Ansi ʾȣת Ansi ʾ Lengthת AnsiԷֹӢƽ̨¶ַ
+ Դ Calculator ʾַȣʱĬжϡ
+
+
+ Text: PWideChar - Ŀַַ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵInteger - ת Ansi ַʾ
+}
+
+function CalcAnsiByteLengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer): Integer;
+{* Unicode ַ 1 WideOffset Ӵ Ansi ֽڳȣWideOffset 1 ʼ
+ Copy(1, WideOffset) Ӵת Ansi ֽȡ Lengthʵת AnsiԷֹӢƽ̨¶ַ
+ $FF UTF-16 ַ 2 ֽڣΪ 1 ֽڡ
+
+
+ Text: PWideChar - Ŀַַ
+ WideOffset: Integer - ԿַΪλƫ
+
+ ֵInteger - ظÿַ 1 WideOffset Ӵ Ansi ֽڳ
+}
+
+function CalcAnsiDisplayLengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer;
+ Calculator: TCnWideCharDisplayWideLengthCalculator = nil): Integer;
+{* Unicode ַ 1 WideOffset Ӵ Ansi ʾȣWideOffset 1 ʼ
+ Copy(1, WideOffset) Ӵת Ansi ȡ Lengthʵת AnsiԷֹӢƽ̨¶ַ
+ Դ Calculator ʾַȣʱĬжϡ
+
+
+ Text: PWideChar - Ŀַַ
+ WideOffset: Integer - ַĿȼصͬ Delphi IDE ༭вͬ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵInteger - ظÿַ 1 WideOffset Ӵ Ansi ʾ
+}
+
+function CalcWideStringByteLengthFromAnsiOffset(Text: PWideChar; AnsiOffset: Integer;
+ AllowExceedEnd: Boolean = False): Integer;
+{* Unicode ַָ Ansi ӴȶӦ Unicode ӴֽڳȣAnsiOffset 1 ʼ
+ ת Ansi Copy(1, AnsiOffset) ת Unicode ȡ Length Ansi/Unicode תԷֹӢƽ̨¶ַ
+ ע Ansi Copy ܻ˫ַֽ
+ AllowExceedEnd Ϊ False ʱ㵽 #0 ֹ #0Ϊ True ʱԲոʽ㡣
+ $FF UTF-16 ַ 2 ֽڣΪ 1 ֽڡ
+
+
+ Text: PWideChar - Ŀַַ
+ AnsiOffset: Integer - ԵַֽΪλƫ
+ AllowExceedEnd: Boolean - Ƿ #0 ʱֹ
+
+ ֵInteger - ظÿַתΪ Ansi 1 AnsiOffset ӴȶӦ Unicode ַֽڳ
+}
+
+function CalcWideStringDisplayLengthFromAnsiOffset(Text: PWideChar; AnsiOffset: Integer;
+ AllowExceedEnd: Boolean = False; Calculator: TCnWideCharDisplayWideLengthCalculator = nil): Integer;
+{* Unicode ַָ Ansi ӴȶӦ Unicode ӴȣAnsiOffset 1 ʼ
+ ʾת Ansi Copy(1, AnsiOffset) ת Unicode ȡ Length Ansi/Unicode תԷֹӢƽ̨¶ַ
+ ע Ansi Copy ܻ˫ַֽ
+ AllowExceedEnd Ϊ False ʱ㵽 #0 ֹ #0Ϊ True ʱԲոʽ
+ Դ Calculator ʾַȣʱĬжϡ
+
+
+ Text: PWideChar - Ŀַַ
+ AnsiOffset: Integer - ԵַֽΪλƫ
+ AllowExceedEnd: Boolean - Ƿ #0 ʱֹ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵInteger - ظÿַתΪ Ansi 1 AnsiOffset ӴȶӦ Unicode ַʾ
+}
+
+function CalcUtf8LengthFromWideStringAnsiDisplayOffset(Text: PWideChar; AnsiDisplayOffset: Integer;
+ Calculator: TCnWideCharDisplayWideLengthCalculator = nil): Integer;
+{* Unicode ַתʾص Ansi 1 AnsiOffset Ӵ UTF-8 ȣAnsiDisplayOffset 1 ʼ AnsiDisplayOffset 0 0
+ תʾص Ansi Copy(1, AnsiDisplayOffset) Ӵת Unicode ַת UTF-8 ȡ Lengthʵת
+
+
+ Text: PWideChar - Ŀַַ
+ AnsiDisplayOffset: Integer - ʾص Ansi ַΪλƫ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵInteger - ظÿַתʾص Ansi 1 AnsiDisplayOffset Ӵ UTF-8
+}
+
+function ConvertUtf16ToAlterDisplayAnsi(WideText: PWideChar; AlterChar: AnsiChar = ' ';
+ Calculator: TCnWideCharDisplayWideLengthCalculator = nil): AnsiString;
+{* ֶַתʾõ AnsiеĿַ Calculator ж滻һ AlterChar
+ ʱĬжϡڴӢĻµַʾȼ㣬ַֽ֧
+
+
+ WideText: PWideChar - תĿַַ
+ AlterChar: AnsiChar - 滻ַ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵAnsiString - תַ
+}
+
+function ConvertUtf8ToAlterDisplayAnsi(Utf8Text: PAnsiChar; AlterChar: AnsiChar = ' ';
+ Calculator: TCnWideCharDisplayWideLengthCalculator = nil): AnsiString;
+{* ֶ UTF-8 ַתʾõ AnsiеĿַ Calculator ж滻һ AlterChar
+ ʱĬжϡڴӢĻµַʾȼ㣬ַֽ֧
+
+
+ Utf8Text: PAnsiChar - ת UTF-8 ַַ
+ AlterChar: AnsiChar - 滻ַ
+ Calculator: TCnWideCharDisplayWideLengthCalculator - Կַʾȼصͬ Delphi IDE ༭вͬ
+
+ ֵAnsiString - תַ
+}
+
+function CnUtf8ToAnsi(const Text: AnsiString): AnsiString;
+{* Ansi ת UTF-8 Ansi ַԽ Unicode 汾 Utf8ToAnsi UnicodeString ⡣
+
+
+ const Text: AnsiString - ת UTF-8 ַ
+
+ ֵAnsiString - תַ
+}
+
+function CnUtf8ToAnsi2(const Text: string): string;
+{* Ansi ת UTF-8 stringԽ Unicode 汾 Utf8ToAnsi UnicodeString ⡣
+
+
+ const Text: string - ת UTF-8 ַ
+
+ ֵstring - תַ
+}
+
+function CnAnsiToUtf8(const Text: AnsiString): AnsiString;
+{* Ansi ת Ansi ַ UTF-8 ַԽ Unicode 汾 AnsiToUtf8 UnicodeString ⡣
+
+
+ const Text: AnsiString - ת Ansi ַ
+
+ ֵAnsiString - ת UTF-8 ַ
+}
+
+function CnAnsiToUtf82(const Text: string): string;
+{* Ansi ת Ansi ַ UTF-8 ַԽ Unicode 汾 AnsiToUtf8 UnicodeString ⡣
+
+
+ const Text: string - ת Ansi ַ
+
+ ֵstring - ת UTF-8 ַ
+}
+
+{$IFDEF COMPILER5}
+
+function WideCompareText(const S1, S2: WideString): Integer;
+{* Delphi 5 ûпַȽϺ˴ʵһ
+
+
+ const S1: WideString - ȽϵĿַһ
+ const S2: WideString - ȽϵĿַ
+
+ ֵInteger - رȽϽ
+
+}
+
+{$ENDIF}
+
+// =============================================================================
+//
+// ļ
+//
+// =============================================================================
+
+type
+ TCnFileEncoding = (cfeUnknown, cfeUtf8, cfeUtf8Bom, cfeUtf16LE, cfeUtf16BE, cfeAnsi);
+ {* ļ͡
+
+ cfeUnknown - δ֪
+ cfeUtf8 - UTF-8 BOM
+ cfeUtf8Bom - UTF-8 with BOM
+ cfeUtf16LE - UTF-16 Little Endian
+ cfeUtf16BE - UTF-16 Big Endian
+ cfeAnsi - ϵͳҳ루 Unicode
+ }
+
+function CnDetectFileEncoding(const Bytes: TBytes): TCnFileEncoding;
+{* ֽļ롣ȼBOM UTF-8 ʽ Ansi
+ ǰ 4 ֽڵ BOM ǣ BOM ʱ UTF-8 ϷԼ顣
+
+
+ const Bytes: TBytes - ļݵֽ
+
+ ֵTCnFileEncoding - ı
+}
+
+function CnIsValidUtf8(const Bytes: TBytes): Boolean;
+{* ʽжֽǷΪϷ UTF-8 Сÿֽڼ UTF-8 淶
+ - ֽڣ0xxxxxxx
+ - ˫ֽڣ110xxxxx 10xxxxxx
+ - ֽڣ1110xxxx 10xxxxxx 10xxxxxx
+ - ֽڣ11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
+
+
+ const Bytes: TBytes - ֽ
+
+ ֵBoolean - True ʾϷ UTF-8
+}
+
+function CnStripBomBytes(const Bytes: TBytes): TBytes;
+{* Ƴֽ鿪ͷ BOM ǰUTF-8 BOM #EF#BB#BF / UTF-16 LE BOM #FF#FE / UTF-16 BE BOM #FE#FF
+ BOM ʱԭʼ鸱
+
+
+ const Bytes: TBytes - ԭʼֽ
+
+ ֵTBytes - ȥ BOM ֽ
+}
+
+// =============================================================================
+//
+// TBytes string ת Delphi 汾ȫ UTF-8 ߣ
+//
+// =============================================================================
+
+function CnUtf8BytesToString(const Bytes: TBytes): string;
+{* UTF-8 ֽתΪ string֧ Unicode ͷ Unicode
+ ע Delphi 2007 °汾ת AnsiString ʱַܶ
+
+
+ const Bytes: TBytes - UTF-8 ֽ
+
+ ֵstring - תַ
+}
+
+function CnStringToUtf8Bytes(const S: string): TBytes;
+{* string תΪ UTF-8 ֽ飬֧ Unicode ͷ Unicode
+
+
+ const S: string - תַ
+
+ ֵTBytes - UTF-8 ֽ
+}
+
+implementation
+
+const
+ SLineBreak = #13#10;
+ SLineBreakLF = #10;
+
+ CN_UTF16_4CHAR_PREFIX1_LOW = $D8;
+ CN_UTF16_4CHAR_PREFIX1_HIGH = $DC;
+ CN_UTF16_4CHAR_PREFIX2_LOW = $DC;
+ CN_UTF16_4CHAR_PREFIX2_HIGH = $E0;
+
+ CN_UTF16_4CHAR_HIGH_MASK = $3;
+ CN_UTF16_4CHAR_SPLIT_MASK = $3FF;
+
+ CN_UTF16_EXT_BASE = $10000;
+
+resourcestring
+ SCnErrorInvalidUtf8CharLength = 'More than UTF8-MB4 NOT Support.';
+ SCnErrorInvalidModeLength = 'More than UTF32 NOT Support.';
+
+{ TCnWideStringList }
+
+function WideCompareText(const S1, S2: WideString): Integer;
+begin
+{$IFDEF MSWINDOWS}
+ Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PWideChar(S1),
+ Length(S1), PWideChar(S2), Length(S2)) - 2;
+{$ELSE}
+ Result := WideCompareStr(S1, S2);
+{$ENDIF}
+end;
+
+function TCnWideStringList.Add(const S: WideString): Integer;
+begin
+ Result := Count;
+ Insert(Count, S);
+end;
+
+function TCnWideStringList.AddObject(const S: WideString;
+ AObject: TObject): Integer;
+begin
+ Result := Add(S);
+ PutObject(Result, AObject);
+end;
+
+procedure TCnWideStringList.AddStrings(Strings: TCnWideStringList);
+var
+ I: Integer;
+begin
+ for I := 0 to Strings.Count - 1 do
+ Add(Strings[I]);
+end;
+
+procedure TCnWideStringList.Assign(Source: TPersistent);
+begin
+ if Source is TCnWideStringList then
+ begin
+ Clear;
+ AddStrings(TCnWideStringList(Source));
+ FLoadFormat := TCnWideStringList(Source).LoadFormat;
+ FUseSingleLF := TCnWideStringList(Source).UseSingleLF;
+ FWriteBOM := TCnWideStringList(Source).WriteBOM;
+ Exit;
+ end;
+ inherited Assign(Source);
+end;
+
+procedure TCnWideStringList.Clear;
+var
+ I: Integer;
+ P: PCnWideStringItem;
+begin
+ for I := 0 to Count - 1 do
+ begin
+ P := PCnWideStringItem(FList[I]);
+ Dispose(P);
+ end;
+ FList.Clear;
+end;
+
+constructor TCnWideStringList.Create;
+begin
+ inherited;
+ FList := TList.Create;
+ FLoadFormat := wlfUnicode;
+ FWriteBOM := True;
+end;
+
+procedure TCnWideStringList.CustomSort(Compare: TCnWideStringListSortCompare);
+begin
+ if Count > 1 then
+ QuickSort(0, Count - 1, Compare);
+end;
+
+procedure TCnWideStringList.Delete(Index: Integer);
+var
+ P: PCnWideStringItem;
+begin
+ P := PCnWideStringItem(FList[Index]);
+ FList.Delete(Index);
+ Dispose(P);
+end;
+
+destructor TCnWideStringList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited;
+end;
+
+procedure TCnWideStringList.Exchange(Index1, Index2: Integer);
+begin
+ FList.Exchange(Index1, Index2);
+end;
+
+function TCnWideStringList.Get(Index: Integer): WideString;
+begin
+ Result := PCnWideStringItem(FList[Index])^.FString;
+end;
+
+function TCnWideStringList.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+function TCnWideStringList.GetName(Index: Integer): WideString;
+var
+ P: Integer;
+begin
+ Result := Get(Index);
+ P := Pos('=', Result);
+ if P <> 0 then
+ SetLength(Result, P - 1) else
+ SetLength(Result, 0);
+end;
+
+function TCnWideStringList.GetObject(Index: Integer): TObject;
+begin
+ Result := PCnWideStringItem(FList[Index])^.FObject;
+end;
+
+function TCnWideStringList.GetTextStr: WideString;
+var
+ I, L, Size, C: Integer;
+ P: PwideChar;
+ S, LB: WideString;
+begin
+ C := GetCount;
+ Size := 0;
+
+ if FUseSingleLF then
+ LB := SLineBreakLF
+ else
+ LB := SLineBreak;
+
+ for I := 0 to C - 1 do Inc(Size, Length(Get(I)) + Length(LB));
+ SetString(Result, nil, Size);
+ P := Pointer(Result);
+ for I := 0 to C - 1 do
+ begin
+ S := Get(I);
+ L := Length(S);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
+ end;
+ L := Length(LB);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
+ end;
+ end;
+end;
+
+function TCnWideStringList.GetValue(const Name: WideString): WideString;
+var
+ I: Integer;
+begin
+ I := IndexOfName(Name);
+ if I >= 0 then
+ Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
+ Result := '';
+end;
+
+function TCnWideStringList.IndexOf(const S: WideString): Integer;
+begin
+ for Result := 0 to GetCount - 1 do
+ begin
+ if WideCompareText(Get(Result), S) = 0 then
+ Exit;
+ end;
+ Result := -1;
+end;
+
+function TCnWideStringList.IndexOfName(const Name: WideString): Integer;
+var
+ P: Integer;
+ S: string;
+begin
+ for Result := 0 to GetCount - 1 do
+ begin
+ S := Get(Result);
+ P := Pos('=', S);
+ if (P <> 0) and (WideCompareText(Copy(S, 1, P - 1), Name) = 0) then
+ Exit;
+ end;
+ Result := -1;
+end;
+
+procedure TCnWideStringList.Insert(Index: Integer; const S: WideString);
+var
+ P: PCnWideStringItem;
+begin
+ New(P);
+ P^.FString := S;
+ FList.Insert(Index, P);
+end;
+
+procedure TCnWideStringList.LoadFromFile(const FileName: WideString);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TCnWideStringList.LoadFromStream(Stream: TStream);
+var
+ Size, Len: Integer;
+ S: WideString;
+ HeaderStr, SA: AnsiString;
+begin
+ Size := Stream.Size - Stream.Position;
+ if Size >= 3 then
+ begin
+ SetLength(HeaderStr, 3);
+ Stream.Read(Pointer(HeaderStr)^, 3);
+ if HeaderStr = #$EF#$BB#$BF then // UTF-8 BOM
+ begin
+ SetLength(SA, Size - 3);
+ Stream.Read(Pointer(SA)^, Size - 3);
+{$IFDEF MSWINDOWS}
+ Len := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(SA), -1, nil, 0);
+ SetLength(S, Len);
+ MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(SA), -1, PWideChar(S), Len);
+{$ELSE}
+ {$IFDEF FPC}
+ S := CnUtf8DecodeToWideString(SA);
+ {$ELSE}
+ S := UTF8ToWideString(SA);
+ {$ENDIF}
+{$ENDIF}
+ SetTextStr(S);
+
+ FLoadFormat := wlfUtf8;
+ Exit;
+ end;
+ Stream.Position := Stream.Position - 3;
+ end;
+
+ if Size >= 2 then
+ begin
+ SetLength(HeaderStr, 2);
+ Stream.Read(Pointer(HeaderStr)^, 2);
+ if HeaderStr = #$FF#$FE then // UTF-16 BOM
+ begin
+ SetLength(S, (Size - 2) div SizeOf(WideChar));
+ Stream.Read(Pointer(S)^, (Size - 2) div SizeOf(WideChar) * SizeOf(WideChar));
+ SetTextStr(S);
+
+ FLoadFormat := wlfUnicode;
+ Exit;
+ end;
+ Stream.Position := Stream.Position - 2;
+ end;
+
+ SetString(SA, nil, Size);
+ Stream.Read(Pointer(SA)^, Size);
+ SetTextStr({$IFDEF UNICODE}string{$ENDIF}(SA));
+ FLoadFormat := wlfAnsi;
+end;
+
+procedure TCnWideStringList.Put(Index: Integer; const S: WideString);
+var
+ P: PCnWideStringItem;
+begin
+ P := PCnWideStringItem(FList[Index]);
+ P^.FString := S;
+end;
+
+procedure TCnWideStringList.PutObject(Index: Integer; const Value: TObject);
+begin
+ PCnWideStringItem(FList[Index])^.FObject := Value;
+end;
+
+procedure TCnWideStringList.QuickSort(L, R: Integer;
+ SCompare: TCnWideStringListSortCompare);
+var
+ I, J, P: Integer;
+begin
+ repeat
+ I := L;
+ J := R;
+ P := (L + R) shr 1;
+ repeat
+ while SCompare(Self, I, P) < 0 do Inc(I);
+ while SCompare(Self, J, P) > 0 do Dec(J);
+ if I <= J then
+ begin
+ Exchange(I, J);
+ if P = I then
+ P := J
+ else if P = J then
+ P := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if L < J then QuickSort(L, J, SCompare);
+ L := I;
+ until I >= R;
+end;
+
+procedure TCnWideStringList.SaveToFile(const FileName: WideString; AFormat: TCnWideListFormat);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream, AFormat);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TCnWideStringList.SaveToStream(Stream: TStream; AFormat: TCnWideListFormat);
+var
+ S: WideString;
+ HeaderStr, SA: AnsiString;
+ Len: Integer;
+begin
+ S := GetTextStr;
+ if AFormat = wlfAnsi then
+ begin
+ SA := AnsiString(S);
+ Stream.WriteBuffer(Pointer(SA)^, Length(SA) * SizeOf(AnsiChar));
+ end
+ else if AFormat = wlfUtf8 then
+ begin
+ if FWriteBOM then
+ begin
+ HeaderStr := #$EF#$BB#$BF;
+ Stream.WriteBuffer(Pointer(HeaderStr)^, Length(HeaderStr) * SizeOf(AnsiChar));
+ end;
+{$IFDEF MSWINDOWS}
+ Len := WideCharToMultiByte(CP_UTF8, 0, PWideChar(S), -1, nil, 0, nil, nil);
+ SetLength(SA, Len);
+ WideCharToMultiByte(CP_UTF8, 0, PWideChar(S), -1, PAnsiChar(SA), Len, nil, nil);
+{$ELSE}
+ SA := UTF8Encode(S);
+{$ENDIF}
+ Stream.WriteBuffer(Pointer(SA)^, Length(SA) * SizeOf(AnsiChar) - 1);
+ end
+ else if AFormat = wlfUnicode then
+ begin
+ if FWriteBOM then
+ begin
+ HeaderStr := #$FF#$FE;
+ Stream.WriteBuffer(Pointer(HeaderStr)^, Length(HeaderStr) * SizeOf(AnsiChar));
+ end;
+ Stream.WriteBuffer(Pointer(S)^, Length(S) * SizeOf(WideChar));
+ end;
+end;
+
+procedure TCnWideStringList.SetTextStr(const Value: WideString);
+var
+ P, Start: PWideChar;
+ S: WideString;
+begin
+ Clear;
+ P := Pointer(Value);
+ if P <> nil then
+ begin
+ while P^ <> #0 do
+ begin
+ Start := P;
+ while not (Ord(P^) in [0, 10, 13]) do Inc(P);
+ SetString(S, Start, P - Start);
+ Add(S);
+ if P^ = #13 then Inc(P);
+ if P^ = #10 then Inc(P);
+ end;
+ end;
+end;
+
+procedure TCnWideStringList.SetValue(const Name, Value: WideString);
+var
+ I: Integer;
+begin
+ I := IndexOfName(Name);
+ if Value <> '' then
+ begin
+ if I < 0 then I := Add('');
+ Put(I, Name + '=' + Value);
+ end
+ else
+ begin
+ if I >= 0 then Delete(I);
+ end;
+end;
+
+function StringListCompareStrings(List: TCnWideStringList; Index1, Index2: Integer): Integer;
+begin
+ Result := WideCompareText(PCnWideStringItem(List.FList[Index1])^.FString,
+ PCnWideStringItem(List.FList[Index2])^.FString);
+end;
+
+procedure TCnWideStringList.Sort;
+begin
+ CustomSort(StringListCompareStrings);
+end;
+
+// D5 û UTF-8/Ansi תҵͰ汾ʹҲ֧ UTF8-MB4дƷ
+// ΪSourceChars ˫ֽڿַ
+function InternalUnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal;
+ Source: PWideChar; SourceChars: Cardinal): Cardinal;
+var
+ I, Cnt: Cardinal;
+ C: Cardinal;
+begin
+ Result := 0;
+ if Source = nil then
+ Exit;
+
+ Cnt := 0;
+ I := 0;
+ if Dest <> nil then
+ begin
+ while (I < SourceChars) and (Cnt < MaxDestBytes) do
+ begin
+ if (SourceChars - I >= 2) and (GetByteWidthFromUtf16(@(Source[I])) = 4) then
+ begin
+ // ַֽڣҪ
+ C := GetCodePointFromUtf164Char(PAnsiChar(@(Source[I])));
+ Inc(I, 2); // WideChar
+ end
+ else
+ begin
+ C := Cardinal(Source[I]);
+ Inc(I); // һ WideChar
+ end;
+
+ if C <= $7F then
+ begin
+ Dest[Cnt] := AnsiChar(C);
+ Inc(Cnt);
+ end
+ else if C > $FFFF then
+ begin
+ if Cnt + 4 > MaxDestBytes then
+ Break;
+
+ Dest[Cnt] := AnsiChar($F0 or (C shr 18));
+ Dest[Cnt + 1] := AnsiChar($80 or ((C shr 12) and $3F));
+ Dest[Cnt + 2] := AnsiChar($80 or ((C shr 6) and $3F));
+ Dest[Cnt + 3] := AnsiChar($80 or (C and $3F));
+ Inc(Cnt, 4);
+ end
+ else if C > $7FF then
+ begin
+ if Cnt + 3 > MaxDestBytes then
+ Break;
+ Dest[Cnt] := AnsiChar($E0 or (C shr 12));
+ Dest[Cnt + 1] := AnsiChar($80 or ((C shr 6) and $3F));
+ Dest[Cnt + 2] := AnsiChar($80 or (C and $3F));
+ Inc(Cnt, 3);
+ end
+ else // $7F < Source[i] <= $7FF
+ begin
+ if Cnt + 2 > MaxDestBytes then
+ Break;
+ Dest[Cnt] := AnsiChar($C0 or (C shr 6));
+ Dest[Cnt + 1] := AnsiChar($80 or (C and $3F));
+ Inc(Cnt, 2);
+ end;
+ end;
+
+ if Cnt >= MaxDestBytes then
+ Cnt := MaxDestBytes - 1;
+ Dest[Cnt] := #0;
+ end
+ else
+ begin
+ while I < SourceChars do
+ begin
+ if (SourceChars - I >= 2) and (GetByteWidthFromUtf16(@(Source[I])) = 4) then
+ begin
+ // ַֽڣҪ
+ C := GetCodePointFromUtf164Char(PAnsiChar(@(Source[I])));
+ Inc(I, 2); // WideChar
+ end
+ else
+ begin
+ C := Cardinal(Source[I]);
+ Inc(I);
+ end;
+
+ if C > $7F then
+ begin
+ if C > $7FF then
+ begin
+ if C > $FFFF then
+ Inc(Cnt);
+ Inc(Cnt);
+ end;
+ Inc(Cnt);
+ end;
+ Inc(Cnt);
+ end;
+ end;
+ Result := Cnt + 1;
+end;
+
+function InternalUtf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal;
+ Source: PAnsiChar; SourceBytes: Cardinal): Cardinal;
+var
+ K: Integer;
+ I, Cnt: Cardinal;
+ C: Byte;
+ WC: Cardinal;
+begin
+ if Source = nil then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ Result := Cardinal(-1);
+ Cnt := 0;
+ I := 0;
+ if Dest <> nil then
+ begin
+ while (I < SourceBytes) and (Cnt < MaxDestChars) do
+ begin
+ WC := Cardinal(Source[I]);
+ Inc(I);
+
+ if (WC and $80) <> 0 then
+ begin
+ if I >= SourceBytes then //
+ Exit;
+
+ if (WC and $F0) = $F0 then // ֽڣδλ 0ٲַƴֵַֽڵ UTF-16
+ begin
+ if SourceBytes - I < 3 then // ֽ˳
+ Exit;
+
+ // WC ǵһֽڣȡλδλ 0ֽڸȡλõ
+ WC := ((WC and $7) shl 18) + ((Cardinal(Source[I]) and $3F) shl 12)
+ + ((Cardinal(Source[I + 1]) and $3F) shl 6) + (Cardinal(Source[I + 2]) and $3F);
+
+ // UTF-16 ַ Cnt
+ K := GetUtf16CharFromCodePoint(WC, @(Dest[Cnt]));
+ if K = 2 then // ַֽȲһ WideCharһ if
+ Inc(Cnt);
+ Inc(I, 3);
+ end
+ else
+ begin
+ WC := WC and $3F;
+ if (WC and $20) <> 0 then
+ begin
+ C := Byte(Source[I]);
+ Inc(I);
+ if (C and $C0) <> $80 then // malformed trail byte or out of range char
+ Exit;
+ if I >= SourceBytes then // incomplete multibyte char
+ Exit;
+ WC := (WC shl 6) or (C and $3F);
+ end;
+ C := Byte(Source[I]);
+ Inc(I);
+ if (C and $C0) <> $80 then // malformed trail byte
+ Exit;
+
+ Dest[Cnt] := WideChar((WC shl 6) or (C and $3F));
+ end;
+ end
+ else
+ Dest[Cnt] := WideChar(WC);
+ Inc(Cnt);
+ end;
+ if Cnt >= MaxDestChars then Cnt := MaxDestChars - 1;
+ Dest[Cnt] := #0;
+ end
+ else
+ begin
+ while (I < SourceBytes) do
+ begin
+ C := Byte(Source[I]);
+ Inc(I);
+
+ if (C and $80) <> 0 then // λΪ 1ٶֽ
+ begin
+ if I >= SourceBytes then // incomplete multibyte char
+ Exit;
+
+ C := C and $3F; // µһֽڵĵλǰλѾ 11
+ if (C and $20) <> 0 then // 1110ʾֽ
+ begin
+ if (C and $10) <> 0 then // 11110ʾֽ
+ begin
+ C := Byte(Source[I]); // ĸеĵڶֽ
+ Inc(I);
+ if (C and $C0) <> $80 then // ֽλ 10
+ Exit; // malformed trail byte or out of range char
+ if I >= SourceBytes then
+ Exit; // incomplete multibyte char
+
+ Inc(Cnt); // ֽڵ UTF8ӦӦ UTF-16 е WideCharһ
+ end;
+
+ C := Byte(Source[I]); // ĸеĵֽڣеĵڶֽ
+ Inc(I);
+ if (C and $C0) <> $80 then // ֽλ 10˳
+ Exit;
+ if I >= SourceBytes then
+ Exit; // incomplete multibyte char
+ end;
+
+ C := Byte(Source[I]); // ĸеĵĸֽڣеĵֽڣеĵڶֽ
+ Inc(I);
+ if (C and $C0) <> $80 then // ֽλ 10˳
+ Exit; // malformed trail byte
+ end;
+
+ Inc(Cnt);
+ end;
+ end;
+ Result := Cnt + 1;
+end;
+
+// WideString UTF-8 õ AnsiString Ansi תⶪַ
+function CnUtf8EncodeWideString(const S: TCnWideString): AnsiString;
+var
+ L: Integer;
+ Temp: AnsiString;
+begin
+ Result := '';
+ if S = '' then
+ Exit;
+ SetLength(Temp, Length(S) * 4); // һ˫ַֽ 4 UTF-8 ַ
+
+ L := InternalUnicodeToUtf8(PAnsiChar(Temp), Length(Temp) + 1, PWideChar(S), Length(S));
+ if L > 0 then
+ SetLength(Temp, L - 1)
+ else
+ Temp := '';
+ Result := Temp;
+end;
+
+// AnsiString UTF-8 õ WideString Ansi תⶪַ
+function CnUtf8DecodeToWideString(const S: AnsiString): TCnWideString;
+var
+ L: Integer;
+begin
+ Result := '';
+ if S = '' then
+ Exit;
+ SetLength(Result, Length(S));
+
+ L := InternalUtf8ToUnicode(PWideChar(Result), Length(Result) + 1, PAnsiChar(S), Length(S));
+ if L > 0 then
+ SetLength(Result, L - 1)
+ else
+ Result := '';
+end;
+
+function GetUtf16HighByte(Rec: PCn2CharRec): Byte;
+begin
+{$IFDEF UTF16_BE}
+ Result := Byte(Rec^.P1);
+{$ELSE}
+ Result := Byte(Rec^.P2); // UTF16-LE ĸߵλû
+{$ENDIF}
+end;
+
+function GetUtf16LowByte(Rec: PCn2CharRec): Byte;
+begin
+{$IFDEF UTF16_BE}
+ Result := Byte(Rec^.P2);
+{$ELSE}
+ Result := Byte(Rec^.P1); // UTF16-LE ĸߵλû
+{$ENDIF}
+end;
+
+procedure SetUtf16HighByte(B: Byte; Rec: PCn2CharRec);
+begin
+{$IFDEF UTF16_BE}
+ Rec^.P1 := AnsiChar(B);
+{$ELSE}
+ Rec^.P2 := AnsiChar(B); // UTF16-LE ĸߵλû
+{$ENDIF}
+end;
+
+procedure SetUtf16LowByte(B: Byte; Rec: PCn2CharRec);
+begin
+{$IFDEF UTF16_BE}
+ Rec^.P2 := AnsiChar(B);
+{$ELSE}
+ Rec^.P1 := AnsiChar(B); // UTF16-LE ĸߵλû
+{$ENDIF}
+end;
+
+function GetCharLengthFromUtf8(Utf8Str: PAnsiChar): Integer;
+var
+ L: Integer;
+begin
+ Result := 0;
+ while Utf8Str^ <> #0 do
+ begin
+ L := GetByteWidthFromUtf8(Utf8Str);
+ Inc(Utf8Str, L);
+ Inc(Result);
+ end;
+end;
+
+function GetCharLengthFromUtf16(Utf16Str: PWideChar): Integer;
+var
+ L: Integer;
+begin
+ Result := 0;
+ while Utf16Str^ <> #0 do
+ begin
+ L := GetByteWidthFromUtf16(Utf16Str);
+ Utf16Str := PWideChar(TCnIntAddress(Utf16Str) + L);
+ Inc(Result);
+ end;
+end;
+
+function GetByteWidthFromUtf8(Utf8Str: PAnsiChar): Integer;
+var
+ B: Byte;
+begin
+ B := Byte(Utf8Str^);
+ if B >= $FC then // 6 11 0Ȳ 1
+ Result := 6
+ else if B >= $F8 then // 5 11 0
+ Result := 5
+ else if B >= $F0 then // 4 11 0
+ Result := 4
+ else if B >= $E0 then // 3 11 0
+ Result := 3
+ else if B >= $B0 then // 2 11 0
+ Result := 2
+ else //
+ Result := 1;
+end;
+
+function GetByteWidthFromUtf16(Utf16Str: PWideChar): Integer;
+var
+ P: PCn2CharRec;
+ B1, B2: Byte;
+begin
+ Result := 2;
+
+ P := PCn2CharRec(Utf16Str);
+ B1 := GetUtf16HighByte(P);
+
+ if (B1 >= CN_UTF16_4CHAR_PREFIX1_LOW) and (B1 < CN_UTF16_4CHAR_PREFIX1_HIGH) then
+ begin
+ // ַֽƴһ飬ֵ $D800 $DBFF ֮䣬ҲǸ˫ֽڵĸλֽ [$D8, $DC)
+ Inc(P);
+ B2 := GetUtf16HighByte(P);
+
+ // ôںַֽӦ $DC00 $DFFF ֮䣬
+ if (B2 >= CN_UTF16_4CHAR_PREFIX2_LOW) and (B2 < CN_UTF16_4CHAR_PREFIX2_HIGH) then
+ Result := 4;
+
+ // ĸֽһֽ Unicode ַǸֵıֵ
+ end;
+end;
+
+function GetCodePointFromUtf16Char(Utf16Str: PWideChar): TCnCodePoint;
+var
+ R: Word;
+ C2: PCn2CharRec;
+begin
+ if GetByteWidthFromUtf16(Utf16Str) = 4 then // ַֽ
+ Result := GetCodePointFromUtf164Char(PAnsiChar(Utf16Str))
+ else // ͨ˫ַֽ
+ begin
+ C2 := PCn2CharRec(Utf16Str);
+ R := Byte(C2^.P1) shl 8 + Byte(C2^.P2); // ˫ֵַֽDZֵ
+
+{$IFDEF UTF16_BE}
+ Result := TCnCodePoint(R);
+{$ELSE}
+ Result := TCnCodePoint(UInt16ToBigEndian(R)); // UTF16-LE Ҫֵ
+{$ENDIF}
+ end;
+end;
+
+function GetCodePointFromUtf164Char(PtrTo4Char: Pointer): TCnCodePoint;
+var
+ TH, TL: Word;
+ C2: PCn2CharRec;
+begin
+ C2 := PCn2CharRec(PtrTo4Char);
+
+ // һֽڣȥλ 110110ڶֽţ 2 + 8 = 10 λ
+ TH := (GetUtf16HighByte(C2) and CN_UTF16_4CHAR_HIGH_MASK) shl 8 + GetUtf16LowByte(C2);
+ Inc(C2);
+
+ // ֽڣȥλ 110111ĸֽţ 2 + 8 = 10 λ
+ TL := (GetUtf16HighByte(C2) and CN_UTF16_4CHAR_HIGH_MASK) shl 8 + GetUtf16LowByte(C2);
+
+ // 10 λƴ 10 λ
+ Result := TH shl 10 + TL + CN_UTF16_EXT_BASE;
+ // ȥ $10000 ֵǰ 10 λӳ䵽 $D800 $DBFF ֮䣬 10 λӳ䵽 $DC00 $DFFF ֮
+end;
+
+function GetUtf16CharFromCodePoint(CP: TCnCodePoint; PtrToChars: Pointer): Integer;
+var
+ C2: PCn2CharRec;
+ L, H: Byte;
+ LW, HW: Word;
+begin
+ if CP = CN_INVALID_CODEPOINT then
+ begin
+ if PtrToChars <> nil then
+ begin
+ C2 := PCn2CharRec(PtrToChars);
+ SetUtf16LowByte(0, C2);
+ SetUtf16HighByte(0, C2);
+ end;
+ Result := 1;
+ Exit;
+ end;
+
+ if CP >= CN_UTF16_EXT_BASE then
+ begin
+ if PtrToChars <> nil then
+ begin
+ CP := CP - CN_UTF16_EXT_BASE;
+ // 10 λǰֽڣ 10 λźֽ
+
+ LW := CP and CN_UTF16_4CHAR_SPLIT_MASK; // 10 λֽ
+ HW := (CP shr 10) and CN_UTF16_4CHAR_SPLIT_MASK; // 10 λһֽ
+
+ L := HW and $FF;
+ H := (HW shr 8) and CN_UTF16_4CHAR_HIGH_MASK;
+ H := H or CN_UTF16_4CHAR_PREFIX1_LOW; // 1101 1000
+ C2 := PCn2CharRec(PtrToChars);
+
+ SetUtf16LowByte(L, C2);
+ SetUtf16HighByte(H, C2);
+
+ L := LW and $FF;
+ H := (LW shr 8) and CN_UTF16_4CHAR_HIGH_MASK;
+ H := H or CN_UTF16_4CHAR_PREFIX1_HIGH; // 1101 1100
+ Inc(C2);
+
+ SetUtf16LowByte(L, C2);
+ SetUtf16HighByte(H, C2);
+ end;
+ Result := 2;
+ end
+ else
+ begin
+ if PtrToChars <> nil then
+ begin
+ C2 := PCn2CharRec(PtrToChars);
+ SetUtf16LowByte(Byte(CP and $00FF), C2);
+ SetUtf16HighByte(Byte(CP shr 8), C2);
+ end;
+ Result := 1;
+ end;
+end;
+
+// ַ UTF-8 ȣ Utf8Encode ȡ Lengthʵת
+function CalcUtf8LengthFromWideString(Text: PWideChar): Integer;
+begin
+ Result := 0;
+ if Text = nil then
+ Exit;
+
+ while Text^ <> #0 do
+ begin
+ Inc(Result, CalcUtf8LengthFromWideChar(Text^));
+ Inc(Text);
+ end;
+end;
+
+// һ WideChar ת UTF-8 ַ
+function CalcUtf8LengthFromWideChar(AChar: WideChar): Integer;
+var
+ V: Cardinal;
+begin
+ V := Ord(AChar);
+ if V <= $7F then
+ Result := 1
+ else if V <= $7FF then
+ Result := 2
+ else if V <= $FFFF then
+ Result := 3
+ else if V <= $10FFFF then
+ Result := 4
+ else
+ Result := 0;
+end;
+
+// Unicode ַ 1 WideOffset Ӵ UTF-8 ȣWideOffset 1 ʼ
+function CalcUtf8LengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text <> nil) and (WideOffset > 0) then
+ begin
+ Idx := 0;
+ while (Text^ <> #0) and (Idx < WideOffset) do // Idx 0 ʼWideOffset 1 ʼ <
+ begin
+ Inc(Result, CalcUtf8LengthFromWideChar(Text^));
+ Inc(Text);
+ Inc(Idx);
+ end;
+ end;
+end;
+
+// Unicode ַת Ansi 1 AnsiOffset Ӵ UTF-8 ȣAnsiOffset 1 ʼ
+function CalcUtf8LengthFromWideStringAnsiOffset(Text: PWideChar; AnsiOffset: Integer): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text <> nil) and (AnsiOffset > 0) then
+ begin
+ Idx := 0;
+ while (Text^ <> #0) and (Idx < AnsiOffset) do // Idx 0 ʼAnsiOffset 1 ʼ <
+ begin
+ Inc(Result, CalcUtf8LengthFromWideChar(Text^));
+ Inc(Text);
+ if Ord(Text^) > $FF then // $FF ת Ansi Ȼռֽ
+ Inc(Idx, 2)
+ else
+ Inc(Idx);
+ end;
+ end;
+end;
+
+// һ UTF-8 ǰַַ
+function CalcUtf8LengthFromUtf8HeadChar(AChar: AnsiChar): Integer;
+var
+ B: Byte;
+begin
+ B := Ord(AChar);
+ if B and $80 = 0 then // 0xxx xxxx
+ Result := 1
+ else if B and $E0 = $C0 then // 110x xxxx 10xxxxxx
+ Result := 2
+ else if B and $F0 = $E0 then // 1110 xxxx 10xxxxxx 10xxxxxx
+ Result := 3
+ else if B and $F8 = $F0 then // 1111 0xxx 10xxxxxx 10xxxxxx 10xxxxxx
+ Result := 4
+ else
+ raise ECnWideStringException.Create(SCnErrorInvalidUtf8CharLength);
+end;
+
+// UTF-8 ַת WideSting ָ Wide ӴȶӦ UTF-8 ַȣWideOffset 1 ʼ
+// ת WideString Copy(1, WideOffset) ת UTF-8 ȡ Length UTF-8/WideString תԱı
+function CalcUtf8StringLengthFromWideOffset(Utf8Text: PAnsiChar;
+ WideOffset: Integer): Integer;
+var
+ Utf8Len, WideIdx: Integer;
+begin
+ Result := 0;
+ if (Utf8Text = nil) or (WideOffset <= 0) then
+ Exit;
+
+ WideIdx := 0;
+ while (Utf8Text^ <> #0) and (WideIdx < WideOffset) do
+ begin
+ Utf8Len := CalcUtf8LengthFromUtf8HeadChar(Utf8Text^);
+ Inc(Result, Utf8Len);
+
+ case Utf8Len of
+ 1:
+ begin
+ Inc(WideIdx);
+ Inc(Utf8Text);
+ end;
+ 2:
+ begin
+ Inc(WideIdx);
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ end;
+ 3:
+ begin
+ Inc(WideIdx);
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ end;
+ 4: // UTF8-MB4
+ begin
+ Inc(WideIdx);
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ if Utf8Text^ = #0 then
+ Exit;
+ Inc(Utf8Text);
+ end;
+ else
+ Exit;
+ end;
+ end;
+end;
+
+// жһ Unicode ַǷռַȣĬϵļªʵ
+function WideCharIsWideLength(const AWChar: WideChar): Boolean; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+const
+ CN_UTF16_ANSI_WIDE_CHAR_SEP = $1100;
+var
+ C: Integer;
+begin
+ C := Ord(AWChar);
+ Result := C > CN_UTF16_ANSI_WIDE_CHAR_SEP; // Ϊ $1100 Utf16 ַƿȲռֽ
+end;
+
+function CalcAnsiByteLengthFromWideString(Text: PWideChar): Integer;
+begin
+ Result := 0;
+ if Text = nil then
+ Exit;
+
+ while Text^ <> #0 do
+ begin
+ if Ord(Text^) > $FF then
+ Inc(Result, SizeOf(WideChar))
+ else
+ Inc(Result, SizeOf(AnsiChar));
+ Inc(Text);
+ end;
+end;
+
+// Unicode ַ Ansi ȣת Ansi Lengthת AnsiԷֹӢƽ̨¶ַ
+function CalcAnsiDisplayLengthFromWideString(Text: PWideChar;
+ Calculator: TCnWideCharDisplayWideLengthCalculator): Integer;
+begin
+ Result := 0;
+ if Text = nil then
+ Exit;
+
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ while Text^ <> #0 do
+ begin
+ if Calculator(Text^) then
+ Inc(Result, SizeOf(WideChar))
+ else
+ Inc(Result, SizeOf(AnsiChar));
+ Inc(Text);
+ end;
+end;
+
+function CalcAnsiByteLengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text = nil) or (WideOffset <= 0) then
+ Exit;
+
+ Idx := 0;
+ while (Text^ <> #0) and (Idx < WideOffset) do // Idx 0 ʼWideOffset 1 ʼ <
+ begin
+ if Ord(Text^) > $FF then
+ Inc(Result, SizeOf(WideChar))
+ else
+ Inc(Result, SizeOf(AnsiChar));
+ Inc(Text);
+ Inc(Idx);
+ end;
+end;
+
+// Unicode ַ 1 WideOffset Ӵ Ansi ȣWideOffset 1 ʼ
+function CalcAnsiDisplayLengthFromWideStringOffset(Text: PWideChar; WideOffset: Integer;
+ Calculator: TCnWideCharDisplayWideLengthCalculator): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text = nil) or (WideOffset <= 0) then
+ Exit;
+
+ Idx := 0;
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ while (Text^ <> #0) and (Idx < WideOffset) do // Idx 0 ʼWideOffset 1 ʼ <
+ begin
+ if Calculator(Text^) then
+ Inc(Result, SizeOf(WideChar))
+ else
+ Inc(Result, SizeOf(AnsiChar));
+ Inc(Text);
+ Inc(Idx);
+ end;
+end;
+
+function CalcWideStringByteLengthFromAnsiOffset(Text: PWideChar;
+ AnsiOffset: Integer; AllowExceedEnd: Boolean): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text <> nil) and (AnsiOffset > 0) then
+ begin
+ Idx := 0;
+ while (Text^ <> #0) and (Idx < AnsiOffset) do
+ begin
+ if Ord(Text^) > $FF then
+ Inc(Idx, SizeOf(WideChar))
+ else
+ Inc(Idx, SizeOf(AnsiChar));
+ Inc(Text);
+ Inc(Result);
+ end;
+
+ if AllowExceedEnd and (Text^ = #0) and (Idx < AnsiOffset) then
+ Inc(Result, AnsiOffset - Idx);
+ end;
+end;
+
+function CalcWideStringDisplayLengthFromAnsiOffset(Text: PWideChar; AnsiOffset: Integer;
+ AllowExceedEnd: Boolean; Calculator: TCnWideCharDisplayWideLengthCalculator): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text <> nil) and (AnsiOffset > 0) then
+ begin
+ Idx := 0;
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ while (Text^ <> #0) and (Idx < AnsiOffset) do
+ begin
+ if Calculator(Text^) then
+ Inc(Idx, SizeOf(WideChar))
+ else
+ Inc(Idx, SizeOf(AnsiChar));
+ Inc(Text);
+ Inc(Result);
+ end;
+
+ if AllowExceedEnd and (Text^ = #0) and (Idx < AnsiOffset) then
+ Inc(Result, AnsiOffset - Idx);
+ end;
+end;
+
+// Unicode ַתʾص Ansi 1 AnsiOffset Ӵ UTF-8 ȣAnsiDisplayOffset 1 ʼ
+function CalcUtf8LengthFromWideStringAnsiDisplayOffset(Text: PWideChar;
+ AnsiDisplayOffset: Integer; Calculator: TCnWideCharDisplayWideLengthCalculator): Integer;
+var
+ Idx: Integer;
+begin
+ Result := 0;
+ if (Text <> nil) and (AnsiDisplayOffset > 0) then
+ begin
+ Idx := 0;
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ while (Text^ <> #0) and (Idx < AnsiDisplayOffset) do // Idx 0 ʼAnsiDisplayOffset 1 ʼ <
+ begin
+ Inc(Result, CalcUtf8LengthFromWideChar(Text^));
+ Inc(Text);
+ if Calculator(Text^) then
+ Inc(Idx, SizeOf(WideChar))
+ else
+ Inc(Idx, SizeOf(AnsiChar));
+ end;
+ end;
+end;
+
+// ֶַת AnsiеĿַ滻 AlterCharڴӢĻµַȼ
+function ConvertUtf16ToAlterDisplayAnsi(WideText: PWideChar; AlterChar: AnsiChar;
+ Calculator: TCnWideCharDisplayWideLengthCalculator): AnsiString;
+var
+ Len: Integer;
+begin
+ if WideText = nil then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+{$IFDEF UNICODE}
+ Len := StrLen(WideText);
+{$ELSE}
+ Len := Length(WideString(WideText));
+{$ENDIF}
+
+ if Len = 0 then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ SetLength(Result, Len * SizeOf(WideChar));
+
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ Len := 0;
+ while WideText^ <> #0 do
+ begin
+ if Calculator(WideText^) then
+ begin
+ Inc(Len);
+ Result[Len] := AlterChar;
+ Inc(Len);
+ Result[Len] := AlterChar;
+ end
+ else
+ begin
+ Inc(Len);
+ if Ord(WideText^) <= $FF then // Absolutely 'Single' Char
+ Result[Len] := AnsiChar(WideText^)
+ else // Extended 'Single' Char, Replace
+ Result[Len] := AlterChar;
+ end;
+ Inc(WideText);
+ end;
+ SetLength(Result, Len);
+end;
+
+// ֶ UTF-8 ַת AnsiеĿַ滻 AlterCharڴӢĻµַȼ
+function ConvertUtf8ToAlterDisplayAnsi(Utf8Text: PAnsiChar; AlterChar: AnsiChar;
+ Calculator: TCnWideCharDisplayWideLengthCalculator): AnsiString;
+var
+ I, J, Len, ByteCount: Integer;
+ C: AnsiChar;
+ W: Word;
+ B, B1, B2: Byte;
+begin
+ Result := '';
+ if Utf8Text = nil then
+ Exit;
+
+ Len := StrLen(Utf8Text);
+ if Len = 0 then
+ Exit;
+
+ SetLength(Result, Len); // ԭijϳ
+ I := 0;
+ J := 1;
+
+ if not Assigned(Calculator) then
+ Calculator := @WideCharIsWideLength;
+
+ while I < Len do
+ begin
+ C := Utf8Text[I];
+ B := Ord(C);
+ W := 0;
+
+ // B ֵóַռλ
+ if B and $80 = 0 then // 0xxx xxxx
+ ByteCount := 1
+ else if B and $E0 = $C0 then // 110x xxxx 10xxxxxx
+ ByteCount := 2
+ else if B and $F0 = $E0 then // 1110 xxxx 10xxxxxx 10xxxxxx
+ ByteCount := 3
+ else if B and $F8 = $F0 then // 1111 0xxx 10xxxxxx 10xxxxxx 10xxxxxx
+ ByteCount := 4
+ else
+ raise ECnWideStringException.Create(SCnErrorInvalidModeLength);
+
+ // ټӦĿַֽ
+ case ByteCount of
+ 1:
+ begin
+ W := B and $7F;
+ end;
+ 2:
+ begin
+ B1 := Ord(Utf8Text[I + 1]);
+ W := ((B and $1F) shl 6) or (B1 and $3F);
+ end;
+ 3:
+ begin
+ B1 := Ord(Utf8Text[I + 1]);
+ B2 := Ord(Utf8Text[I + 2]);
+ W := ((B and $0F) shl 12) or ((B1 and $3F) shl 6) or (B2 and $3F);
+ end;
+ end;
+
+ if ByteCount = 4 then
+ begin
+ // ֽ UTF8תΪ WideCharҲĸַ
+ // TODO: ʾδأܿƧַ
+ Result[J] := AlterChar;
+ Inc(J);
+ Result[J] := AlterChar;
+ Inc(J);
+ Result[J] := AlterChar;
+ Inc(J);
+ Result[J] := AlterChar;
+ Inc(J);
+ end
+ else if Calculator(WideChar(W)) then // 3 ֽ UTF8жʵʿ
+ begin
+ Result[J] := AlterChar;
+ Inc(J);
+ Result[J] := AlterChar;
+ Inc(J);
+ end
+ else
+ begin
+ if W <= 255 then
+ Result[J] := AnsiChar(W)
+ else
+ Result[J] := AlterChar;
+ Inc(J);
+ end;
+
+ Inc(I, ByteCount);
+ end;
+
+ SetLength(Result, J - 1); // Inc J һַģû˾ͼһ
+end;
+
+function CnUtf8ToAnsi(const Text: AnsiString): AnsiString;
+begin
+{$IFDEF FPC}
+ {$IFDEF LAZARUS}
+ Result := ConvertEncoding(Text, EncodingUTF8, EncodingAnsi);
+ {$ELSE}
+ Result := Utf8ToAnsi(Text);
+ {$ENDIF}
+{$ELSE}
+{$IFDEF UNICODE}
+ Result := AnsiString(UTF8ToUnicodeString(PAnsiChar(Text)));
+{$ELSE}
+ {$IFDEF COMPILER6_UP}
+ Result := Utf8ToAnsi(Text);
+ {$ELSE}
+ Result := AnsiString(CnUtf8DecodeToWideString(Text));
+ {$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function CnUtf8ToAnsi2(const Text: string): string;
+begin
+{$IFDEF FPC}
+ {$IFDEF LAZARUS}
+ Result := ConvertEncoding(Text, EncodingUTF8, EncodingAnsi);
+ {$ELSE}
+ Result := Utf8ToAnsi(Text);
+ {$ENDIF}
+{$ELSE}
+{$IFDEF UNICODE}
+ Result := UTF8ToUnicodeString(PAnsiChar(AnsiString(Text)));
+{$ELSE}
+ {$IFDEF COMPILER6_UP}
+ Result := Utf8ToAnsi(Text);
+ {$ELSE}
+ Result := AnsiString(CnUtf8DecodeToWideString(Text));
+ {$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function CnAnsiToUtf8(const Text: AnsiString): AnsiString;
+begin
+{$IFDEF FPC}
+ {$IFDEF LAZARUS}
+ Result := ConvertEncoding(Text, EncodingAnsi, EncodingUTF8);
+ {$ELSE}
+ Result := AnsiToUtf8(Text);
+ {$ENDIF}
+{$ELSE}
+{$IFDEF UNICODE}
+ Result := AnsiString(Utf8Encode(Text)); // ֵɸΪ UTF8String ͣ˴תЧ
+{$ELSE}
+ {$IFDEF COMPILER6_UP}
+ Result := AnsiToUtf8(Text);
+ {$ELSE}
+ Result := CnUtf8EncodeWideString(WideString(Text));
+ {$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function CnAnsiToUtf82(const Text: string): string;
+begin
+{$IFDEF FPC}
+ {$IFDEF LAZARUS}
+ Result := ConvertEncoding(Text, EncodingAnsi, EncodingUTF8);
+ {$ELSE}
+ Result := AnsiToUtf8(Text);
+ {$ENDIF}
+{$ELSE}
+{$IFDEF UNICODE}
+ Result := string(Utf8Encode(Text));
+{$ELSE}
+ {$IFDEF COMPILER6_UP}
+ Result := AnsiToUtf8(Text);
+ {$ELSE}
+ Result := CnUtf8EncodeWideString(WideString(Text));
+ {$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+// ===================== TCnFileEncoding ʵ ==============================
+
+function CnDetectFileEncoding(const Bytes: TBytes): TCnFileEncoding;
+begin
+ Result := cfeUnknown;
+ if Length(Bytes) = 0 then Exit;
+
+ // BOM
+ if Length(Bytes) >= 3 then
+ begin
+ if (Bytes[0] = $EF) and (Bytes[1] = $BB) and (Bytes[2] = $BF) then
+ begin
+ Result := cfeUtf8Bom;
+ Exit;
+ end;
+ end;
+
+ if Length(Bytes) >= 2 then
+ begin
+ if (Bytes[0] = $FF) and (Bytes[1] = $FE) then
+ begin
+ Result := cfeUtf16LE;
+ Exit;
+ end;
+ if (Bytes[0] = $FE) and (Bytes[1] = $FF) then
+ begin
+ Result := cfeUtf16BE;
+ Exit;
+ end;
+ end;
+
+ // BOMʽ UTF-8
+ if CnIsValidUtf8(Bytes) then
+ Result := cfeUtf8
+ else
+ Result := cfeAnsi;
+end;
+
+function CnIsValidUtf8(const Bytes: TBytes): Boolean;
+var
+ I, Len, Remain: Integer;
+ B: Byte;
+begin
+ Result := True;
+ Len := Length(Bytes);
+ I := 0;
+ while I < Len do
+ begin
+ B := Bytes[I];
+ if B and $80 = 0 then
+ // ֽ: 0xxxxxxx
+ Inc(I)
+ else if B and $E0 = $C0 then
+ begin
+ // ˫ֽ: 110xxxxx 10xxxxxx
+ Inc(I);
+ Remain := 1;
+ end
+ else if B and $F0 = $E0 then
+ begin
+ // ֽ: 1110xxxx 10xxxxxx 10xxxxxx
+ Inc(I);
+ Remain := 2;
+ end
+ else if B and $F8 = $F0 then
+ begin
+ // ֽ: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
+ Inc(I);
+ Remain := 3;
+ end
+ else
+ begin
+ // Чǰ
+ Result := False;
+ Exit;
+ end;
+
+ // ֽǷ 10xxxxxx
+ while (Remain > 0) and (I < Len) do
+ begin
+ if Bytes[I] and $C0 <> $80 then
+ begin
+ Result := False;
+ Exit;
+ end;
+ Inc(I);
+ Dec(Remain);
+ end;
+
+ // ֽڲ
+ if Remain > 0 then
+ begin
+ Result := False;
+ Exit;
+ end;
+ end;
+end;
+
+function CnStripBomBytes(const Bytes: TBytes): TBytes;
+var
+ Offset: Integer;
+begin
+ Offset := 0;
+ if Length(Bytes) >= 3 then
+ begin
+ if (Bytes[0] = $EF) and (Bytes[1] = $BB) and (Bytes[2] = $BF) then
+ Offset := 3;
+ end;
+ if (Offset = 0) and (Length(Bytes) >= 2) then
+ begin
+ if ((Bytes[0] = $FF) and (Bytes[1] = $FE))
+ or ((Bytes[0] = $FE) and (Bytes[1] = $FF)) then
+ Offset := 2;
+ end;
+
+ if Offset > 0 then
+ begin
+ SetLength(Result, Length(Bytes) - Offset);
+ if Length(Result) > 0 then
+ Move(Bytes[Offset], Result[0], Length(Result));
+ end
+ else
+ Result := Copy(Bytes);
+end;
+
+// ================= TBytes string ֮תʵ ===========================
+
+function CnUtf8BytesToString(const Bytes: TBytes): string;
+var
+ Utf8Str: AnsiString;
+begin
+ SetLength(Utf8Str, Length(Bytes));
+ if Length(Bytes) > 0 then
+ Move(Bytes[0], Utf8Str[1], Length(Bytes));
+ Result := string(CnUtf8DecodeToWideString(Utf8Str));
+end;
+
+function CnStringToUtf8Bytes(const S: string): TBytes;
+var
+ Utf8Str: AnsiString;
+begin
+ Utf8Str := CnUtf8EncodeWideString(TCnWideString(S));
+ SetLength(Result, Length(Utf8Str));
+ if Length(Utf8Str) > 0 then
+ Move(Utf8Str[1], Result[0], Length(Utf8Str));
+end;
+
+end.
diff --git a/CnPack/Crypto/CnAES.pas b/CnPack/Crypto/CnAES.pas
new file mode 100644
index 0000000..098c34e
--- /dev/null
+++ b/CnPack/Crypto/CnAES.pas
@@ -0,0 +1,7763 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+(******************************************************************************)
+(* *)
+(* Advanced Encryption Standard (AES) *)
+(* *)
+(* Copyright (c) 1998-2001 *)
+(* EldoS, Alexander Ionov *)
+(* *)
+(******************************************************************************)
+
+unit CnAES;
+{* |
+================================================================================
+* ƣ
+* ԪƣAES ԳƼӽ㷨ʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* EldoS, Alexander Ionov ĵԪֲ书ܣԭаȨϢ
+* עԪʵ AES 128/192/256 ԳƼӽ㷨ֿС̶ 16 ֽڣģʽ
+* Ķ뷽ʽĩβ 0Ԫڲ֧ PKCS ȿ뷽ʽҪⲿ
+* CnPemUtils.pas Ԫе PKCS ϵкԼӽݽж
+*
+* ߰汾 Delphi 뾡ʹ AnsiString 汾ĺʮƳ⣩
+* ⲻַӰӽܽ
+*
+* 䣺Java Ĭϵ AES Ӧ˴ AES256
+*
+* ⣬C++Builder 5/6 ¶ overload ĺʴжϴӶ
+* ҵΣʱԪ˴ overload Delphi ´ڣ
+* ٷװ˲ֲͬĺ֧ C++Builder 5/6 ±С
+*
+* ECB/CBC ǿģʽҪ롣CFB/OFB/CTR ĵģʽ뵽顣
+*
+* ⣬CTR ģʽ RFC 3686 淶紫ݵ 4 ֽ Nonce8 ֽ
+* ʼ4 ֽֽļƴ 16 ֽڵijʼ
+* AES 㣬ӽܾΪĶ
+*
+* ƽ̨Delphi5 + Win 7
+* ļ¼2024.07.25 V1.3
+* CTR ģʽ֧֣ѭ RFC 3686 淶
+* 2024.05.26 V1.2
+* 䲿֧ C++Builder ĺ
+* 2022.06.21 V1.1
+* 뼸ֽ鵽ʮַ֮ļӽܺ
+* 2021.12.11 V1.2
+* CFB/OFB ģʽ֧
+* 2019.04.15 V1.1
+* ֧ Win32/Win64/MacOS
+* 2015.01.21 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, CnNative;
+
+const
+ CN_AES_BLOCKSIZE = 16;
+ {* AES ķܿСλ٣Ϊ 16 ֽ}
+
+type
+ TCnKeyBitType = (kbt128, kbt192, kbt256);
+ {* AES λ16 ֽڡ24 ֽں 32 ֽ}
+
+ ECnAESException = class(Exception);
+ {* AES 쳣}
+
+ TCnAESBuffer = array [0..15] of Byte;
+ {* AES ӽܿ 16 ֽ}
+
+ TCnAESKey128 = array [0..15] of Byte;
+ {* AES128 Կṹ16 ֽ}
+
+ TCnAESKey192 = array [0..23] of Byte;
+ {* AES192 Կṹ24 ֽ}
+
+ TCnAESKey256 = array [0..31] of Byte;
+ {* AES256 Կṹ32 ֽ}
+
+ TCnAESExpandedKey128 = array [0..43] of Cardinal;
+ {* AES128 չԿṹ}
+
+ TCnAESExpandedKey192 = array [0..53] of Cardinal;
+ {* AES192 չԿṹ}
+
+ TCnAESExpandedKey256 = array [0..63] of Cardinal;
+ {* AES256 չԿṹ}
+
+ PCnAESBuffer = ^TCnAESBuffer;
+ {* AES ӽָܿ}
+
+ PCnAESKey128 = ^TCnAESKey128;
+ {* AES128 Կṹָ}
+
+ PCnAESKey192 = ^TCnAESKey192;
+ {* AES192 Կṹָ}
+
+ PCnAESKey256 = ^TCnAESKey256;
+ {* AES256 Կṹָ}
+
+ PCnAESExpandedKey128 = ^TCnAESExpandedKey128;
+ {* AES128 չԿṹָ}
+
+ PCnAESExpandedKey192 = ^TCnAESExpandedKey192;
+ {* AES192 չԿṹָ}
+
+ PCnAESExpandedKey256 = ^TCnAESExpandedKey256;
+ {* AES256 չԿṹָ}
+
+ TCnAESCTRNonce = array[0..3] of Byte;
+ {* CTR ģʽµ Nonce ṹ4 ֽ}
+
+ TCnAESCTRIv = array[0..7] of Byte;
+ {* CTR ģʽµijʼṹ8 ֽ}
+
+// Key Expansion Routines for Encryption
+
+procedure ExpandAESKeyForEncryption128(const Key: TCnAESKey128;
+ var ExpandedKey: TCnAESExpandedKey128);
+{* ڼܳչ AES128 Կ
+
+
+ const Key: TCnAESKey128 - չ AES128 Կ
+ var ExpandedKey: TCnAESExpandedKey128 - չ AES128 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForEncryption192(const Key: TCnAESKey192;
+ var ExpandedKey: TCnAESExpandedKey192);
+{* ڼܳչ AES192 Կ
+
+
+ const Key: TCnAESKey192 - չ AES192 Կ
+ var ExpandedKey: TCnAESExpandedKey192 - չ AES192 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForEncryption256(const Key: TCnAESKey256;
+ var ExpandedKey: TCnAESExpandedKey256);
+{* ڼܳչ AES256 Կ
+
+
+ const Key: TCnAESKey256 - չ AES256 Կ
+ var ExpandedKey: TCnAESExpandedKey256 - չ AES256 չԿ
+
+ ֵޣ
+}
+
+// Block Encryption Routines ܣInBuf OutBuf ͬһ
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES128 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey128 - չ AES128 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES192 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey192 - չ AES192 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES256 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey256 - չ AES256 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+{* AES128 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey128 - չ AES128 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure EncryptAES192(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+{* AES192 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey192 - չ AES192 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure EncryptAES256(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+{* AES256 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey256 - չ AES256 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+// Stream Encryption Routines (ECB mode) ECB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream); overload;
+{* AES128 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream); overload;
+{* AES128 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream); overload;
+{* AES256 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream); overload;
+{* AES192 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream); overload;
+{* AES256 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream); overload;
+{* AES256 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+{* AES128 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES128StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+{* AES128 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES192StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+{* AES192 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+{* AES192 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES256StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+{* AES256 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+{* AES256 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Encryption Routines (CBC mode) CBC
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES128StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES192StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES256StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Encryption Routines (CFB mode) CFB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES128StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Encryption Routines (OFB mode) OFB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES128StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES192StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream - ??
+
+ ֵޣ
+}
+procedure EncryptAES192StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure EncryptAES256StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Encryption Routines (CTR mode) CTR
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES128 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES128 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES192 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES192 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES256 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES256 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure EncryptAES128StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES128 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES128StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES128 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES192 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES192StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES192 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES256 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure EncryptAES256StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES256 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Key Transformation Routines for Decryption
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey128); overload;
+{* ڽܳչ AES128 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey128 - չ AES128 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey128;
+ var ExpandedKey: TCnAESExpandedKey128); overload;
+{* ڽܳչ AES128 Կ
+
+
+ const Key: TCnAESKey128 - չ AES128 Կ
+ var ExpandedKey: TCnAESExpandedKey128 - չ AES128 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey192); overload;
+{* ڽܳչ AES192 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey192 - չ AES192 չԿ
+
+ ֵޣ
+}
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey192;
+ var ExpandedKey: TCnAESExpandedKey192); overload;
+{* ڽܳչ AES192 Կ
+
+
+ const Key: TCnAESKey192 - չ AES192 Կ
+ var ExpandedKey: TCnAESExpandedKey192 - չ AES192 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey256); overload;
+{* ڽܳչ AES256 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey256 - չ AES256 չԿ
+
+ ֵޣ
+}
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey256;
+ var ExpandedKey: TCnAESExpandedKey256); overload;
+{* ڽܳչ AES256 Կ
+
+
+ const Key: TCnAESKey256 - չ AES256 Կ
+ var ExpandedKey: TCnAESExpandedKey256 - չ AES256 չԿ
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure ExpandAESKeyForDecryption128(var ExpandedKey: TCnAESExpandedKey128);
+{* ڽܳչ AES128 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey128 - չ AES128 չԿ
+
+ ֵޣ
+}
+procedure ExpandAESKeyForDecryption128Expanded(const Key: TCnAESKey128;
+ var ExpandedKey: TCnAESExpandedKey128);
+{* ڽܳչ AES128 Կ
+
+
+ const Key: TCnAESKey128 - չ AES128 Կ
+ var ExpandedKey: TCnAESExpandedKey128 - չ AES128 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForDecryption192(var ExpandedKey: TCnAESExpandedKey192);
+{* ڽܳչ AES192 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey192 - չ AES192 չԿ
+
+ ֵޣ
+}
+procedure ExpandAESKeyForDecryption192Expanded(const Key: TCnAESKey192;
+ var ExpandedKey: TCnAESExpandedKey192);
+{* ڽܳչ AES192 Կ
+
+
+ const Key: TCnAESKey192 - չ AES192 Կ
+ var ExpandedKey: TCnAESExpandedKey192 - չ AES192 չԿ
+
+ ֵޣ
+}
+
+procedure ExpandAESKeyForDecryption256(var ExpandedKey: TCnAESExpandedKey256);
+{* ڽܳչ AES256 Կ
+
+
+ var ExpandedKey: TCnAESExpandedKey256 - չ AES256 չԿ
+
+ ֵޣ
+}
+procedure ExpandAESKeyForDecryption256Expanded(const Key: TCnAESKey256;
+ var ExpandedKey: TCnAESExpandedKey256);
+{* ڽܳչ AES256 Կ
+
+
+ const Key: TCnAESKey256 - չ AES256 Կ
+ var ExpandedKey: TCnAESExpandedKey256 - չ AES256 չԿ
+
+ ֵޣ
+}
+
+// Block Decryption Routines
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES128 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey128 - չ AES128 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES192 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey192 - չ AES192 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer); overload;
+{* AES256 ܿ飬 Delphi ¿á
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey256 - չ AES256 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+{* AES128 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey128 - չ AES128 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure DecryptAES192(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+{* AES192 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey192 - չ AES192 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+procedure DecryptAES256(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+{* AES256 ܿ飬InBuf OutBuf ͬһ
+
+
+ const InBuf: TCnAESBuffer - ܵݿ
+ const Key: TCnAESExpandedKey256 - չ AES256 Կ
+ var OutBuf: TCnAESBuffer - ĵݿ
+
+ ֵޣ
+}
+
+// Stream Decryption Routines (ECB mode) ECB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream); overload;
+{* AES128 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream); overload;
+{* AES128 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream); overload;
+{* AES192 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream); overload;
+{* AES192 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream); overload;
+{* AES256 ECB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream); overload;
+{* AES256 ECB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+{* AES128 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES128StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+{* AES128 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAES192StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+{* AES192 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+{* AES192 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAES256StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+{* AES256 ECB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+{* AES156 ECB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Decryption Routines (CBC mode) CBC
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 CBC ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 CBC ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES128StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 CBC ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 CBC ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Decryption Routines (CFB mode) CFB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 CFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 CFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES128StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 CFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 CFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Decryption Routines (OFB mode) OFB
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES128 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES128 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES192 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES192 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream); overload;
+{* AES256 OFB ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream); overload;
+{* AES256 OFB ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES128 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES128StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES128 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES192 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES192 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+{* AES256 OFB ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+{* AES256 OFB ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const InitVector: TCnAESBuffer - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Stream Decryption Routines (CTR mode) CTR
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES128 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES128 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES192 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES192 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES256 CTR ģʽ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream); overload;
+{* AES256 CTR ģʽʹչԿ Delphi ¿á
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+// Delphi C++Builder ¾
+procedure DecryptAES128StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES128 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey128 - 16 ֽ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES128StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES128 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey128 - չ AES128 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES192 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey192 - 24 ֽ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES192StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES192 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey192 - չ AES192 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES256 CTR ģʽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnAESKey256 - 32 ֽ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+procedure DecryptAES256StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+{* AES256 CTR ģʽʹչԿ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const ExpandedKey: TCnAESExpandedKey256 - չ AES256 Կ
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const InitVector: TCnAESCTRIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// ============== ַʮַ֮ļӽ ===================
+
+function AESEncryptEcbStrToHex(Value: AnsiString; Key: AnsiString;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES ECB ģʽַתʮơ
+
+
+ Value: AnsiString - ַܵ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptEcbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES ECB ʮַ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ַ
+}
+
+function AESEncryptCbcStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CBC ģʽַתʮơ
+
+
+ Value: AnsiString - ַܵ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCbcStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CBC ʮַ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ַ
+}
+
+function AESEncryptCfbStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CFB ģʽַתʮơ
+
+
+ Value: AnsiString - ַܵ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCfbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CFB ʮַ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ַ
+}
+
+function AESEncryptOfbStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES OFB ģʽַתʮơ
+
+
+ Value: AnsiString - ַܵ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptOfbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES OFB ʮַ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Iv: TCnAESBuffer - 16 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ַ
+}
+
+function AESEncryptCtrStrToHex(Value: AnsiString; Key: AnsiString;
+ const Nonce: TCnAESCTRNonce; const Iv: TCnAESCTRIv; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CTR ģʽַתʮơ
+
+
+ Value: AnsiString - ַܵ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const Iv: TCnAESCTRIv - 8 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCtrStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Nonce: TCnAESCTRNonce; const Iv: TCnAESCTRIv; KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CTR ʮַ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: AnsiString - AES ԿַȸݼȷΪ 162432 ֽڣ̫ضϣ #0
+ const Nonce: TCnAESCTRNonce - 4 ֽ Nonce
+ const Iv: TCnAESCTRIv - 8 ֽڳʼ
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ַ
+}
+
+// ================= ֽֽ֮ļӽ ====================
+
+function AESEncryptEcbBytes(Value: TBytes; Key: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES ECB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESDecryptEcbBytes(Value: TBytes; Key: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES ECB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCbcBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CBC ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESDecryptCbcBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CBC ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCfbBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CFB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESDecryptCfbBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CFB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptOfbBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES OFB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESDecryptOfbBytes(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES OFB ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCtrBytes(Value: TBytes; Key: TBytes; Nonce: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CTR ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Nonce: TBytes - 4 ֽ Nonce 飬̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESDecryptCtrBytes(Value: TBytes; Key: TBytes; Nonce: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CTR ģʽֽ顣
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Nonce: TBytes - 4 ֽ Nonce 飬̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+// ============== ֽʮַ֮ļӽ =================
+
+function AESEncryptEcbBytesToHex(Value: TBytes; Key: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES ECB ģʽֽ鲢תʮơ
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptEcbBytesFromHex(const HexStr: AnsiString; Key: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES ECB ʮַֽ顣
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCbcBytesToHex(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CBC ģʽֽ鲢תʮơ
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCbcBytesFromHex(const HexStr: AnsiString; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CBC ʮַֽ顣
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCfbBytesToHex(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CFB ģʽֽ鲢תʮơ
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCfbBytesFromHex(const HexStr: AnsiString; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CFB ʮַֽ顣
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptOfbBytesToHex(Value: TBytes; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES OFB ģʽֽ鲢תʮơ
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptOfbBytesFromHex(const HexStr: AnsiString; Key: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES OFB ʮַֽ顣
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+function AESEncryptCtrBytesToHex(Value: TBytes; Key: TBytes; Nonce: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): AnsiString;
+{* AES CTR ģʽֽ鲢תʮơ
+
+
+ Value: TBytes - ֽܵ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Nonce: TBytes - 4 ֽ Nonce ֽ飬̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵAnsiString - ʮַ
+}
+
+function AESDecryptCtrBytesFromHex(const HexStr: AnsiString; Key: TBytes; Nonce: TBytes; Iv: TBytes;
+ KeyBit: TCnKeyBitType = kbt128): TBytes;
+{* AES CTR ʮַֽ顣
+
+
+ const HexStr: AnsiString - ܵʮַ
+ Key: TBytes - AES Կֽ飬ȸݼȷΪ 162432 ֽڣ̫ضϣ 0
+ Nonce: TBytes - 4 ֽ Nonce ֽ飬̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼֽ飬̫ضϣ 0
+ KeyBit: TCnKeyBitType - AES
+
+ ֵTBytes - ֽ
+}
+
+implementation
+
+resourcestring
+ SCnErrorAESInvalidInBufSize = 'Invalid Buffer Size for Decryption';
+ SCnErrorAESReadError = 'Stream Read Error';
+ SCnErrorAESWriteError = 'Stream Write Error';
+
+function Min(A, B: Integer): Integer; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+const
+ Rcon: array [1..30] of Cardinal = (
+ $00000001, $00000002, $00000004, $00000008, $00000010, $00000020,
+ $00000040, $00000080, $0000001B, $00000036, $0000006C, $000000D8,
+ $000000AB, $0000004D, $0000009A, $0000002F, $0000005E, $000000BC,
+ $00000063, $000000C6, $00000097, $00000035, $0000006A, $000000D4,
+ $000000B3, $0000007D, $000000FA, $000000EF, $000000C5, $00000091
+ );
+
+ ForwardTable: array [0..255] of Cardinal = (
+ $A56363C6, $847C7CF8, $997777EE, $8D7B7BF6, $0DF2F2FF, $BD6B6BD6, $B16F6FDE, $54C5C591,
+ $50303060, $03010102, $A96767CE, $7D2B2B56, $19FEFEE7, $62D7D7B5, $E6ABAB4D, $9A7676EC,
+ $45CACA8F, $9D82821F, $40C9C989, $877D7DFA, $15FAFAEF, $EB5959B2, $C947478E, $0BF0F0FB,
+ $ECADAD41, $67D4D4B3, $FDA2A25F, $EAAFAF45, $BF9C9C23, $F7A4A453, $967272E4, $5BC0C09B,
+ $C2B7B775, $1CFDFDE1, $AE93933D, $6A26264C, $5A36366C, $413F3F7E, $02F7F7F5, $4FCCCC83,
+ $5C343468, $F4A5A551, $34E5E5D1, $08F1F1F9, $937171E2, $73D8D8AB, $53313162, $3F15152A,
+ $0C040408, $52C7C795, $65232346, $5EC3C39D, $28181830, $A1969637, $0F05050A, $B59A9A2F,
+ $0907070E, $36121224, $9B80801B, $3DE2E2DF, $26EBEBCD, $6927274E, $CDB2B27F, $9F7575EA,
+ $1B090912, $9E83831D, $742C2C58, $2E1A1A34, $2D1B1B36, $B26E6EDC, $EE5A5AB4, $FBA0A05B,
+ $F65252A4, $4D3B3B76, $61D6D6B7, $CEB3B37D, $7B292952, $3EE3E3DD, $712F2F5E, $97848413,
+ $F55353A6, $68D1D1B9, $00000000, $2CEDEDC1, $60202040, $1FFCFCE3, $C8B1B179, $ED5B5BB6,
+ $BE6A6AD4, $46CBCB8D, $D9BEBE67, $4B393972, $DE4A4A94, $D44C4C98, $E85858B0, $4ACFCF85,
+ $6BD0D0BB, $2AEFEFC5, $E5AAAA4F, $16FBFBED, $C5434386, $D74D4D9A, $55333366, $94858511,
+ $CF45458A, $10F9F9E9, $06020204, $817F7FFE, $F05050A0, $443C3C78, $BA9F9F25, $E3A8A84B,
+ $F35151A2, $FEA3A35D, $C0404080, $8A8F8F05, $AD92923F, $BC9D9D21, $48383870, $04F5F5F1,
+ $DFBCBC63, $C1B6B677, $75DADAAF, $63212142, $30101020, $1AFFFFE5, $0EF3F3FD, $6DD2D2BF,
+ $4CCDCD81, $140C0C18, $35131326, $2FECECC3, $E15F5FBE, $A2979735, $CC444488, $3917172E,
+ $57C4C493, $F2A7A755, $827E7EFC, $473D3D7A, $AC6464C8, $E75D5DBA, $2B191932, $957373E6,
+ $A06060C0, $98818119, $D14F4F9E, $7FDCDCA3, $66222244, $7E2A2A54, $AB90903B, $8388880B,
+ $CA46468C, $29EEEEC7, $D3B8B86B, $3C141428, $79DEDEA7, $E25E5EBC, $1D0B0B16, $76DBDBAD,
+ $3BE0E0DB, $56323264, $4E3A3A74, $1E0A0A14, $DB494992, $0A06060C, $6C242448, $E45C5CB8,
+ $5DC2C29F, $6ED3D3BD, $EFACAC43, $A66262C4, $A8919139, $A4959531, $37E4E4D3, $8B7979F2,
+ $32E7E7D5, $43C8C88B, $5937376E, $B76D6DDA, $8C8D8D01, $64D5D5B1, $D24E4E9C, $E0A9A949,
+ $B46C6CD8, $FA5656AC, $07F4F4F3, $25EAEACF, $AF6565CA, $8E7A7AF4, $E9AEAE47, $18080810,
+ $D5BABA6F, $887878F0, $6F25254A, $722E2E5C, $241C1C38, $F1A6A657, $C7B4B473, $51C6C697,
+ $23E8E8CB, $7CDDDDA1, $9C7474E8, $211F1F3E, $DD4B4B96, $DCBDBD61, $868B8B0D, $858A8A0F,
+ $907070E0, $423E3E7C, $C4B5B571, $AA6666CC, $D8484890, $05030306, $01F6F6F7, $120E0E1C,
+ $A36161C2, $5F35356A, $F95757AE, $D0B9B969, $91868617, $58C1C199, $271D1D3A, $B99E9E27,
+ $38E1E1D9, $13F8F8EB, $B398982B, $33111122, $BB6969D2, $70D9D9A9, $898E8E07, $A7949433,
+ $B69B9B2D, $221E1E3C, $92878715, $20E9E9C9, $49CECE87, $FF5555AA, $78282850, $7ADFDFA5,
+ $8F8C8C03, $F8A1A159, $80898909, $170D0D1A, $DABFBF65, $31E6E6D7, $C6424284, $B86868D0,
+ $C3414182, $B0999929, $772D2D5A, $110F0F1E, $CBB0B07B, $FC5454A8, $D6BBBB6D, $3A16162C
+ );
+
+ LastForwardTable: array [0..255] of Cardinal = (
+ $00000063, $0000007C, $00000077, $0000007B, $000000F2, $0000006B, $0000006F, $000000C5,
+ $00000030, $00000001, $00000067, $0000002B, $000000FE, $000000D7, $000000AB, $00000076,
+ $000000CA, $00000082, $000000C9, $0000007D, $000000FA, $00000059, $00000047, $000000F0,
+ $000000AD, $000000D4, $000000A2, $000000AF, $0000009C, $000000A4, $00000072, $000000C0,
+ $000000B7, $000000FD, $00000093, $00000026, $00000036, $0000003F, $000000F7, $000000CC,
+ $00000034, $000000A5, $000000E5, $000000F1, $00000071, $000000D8, $00000031, $00000015,
+ $00000004, $000000C7, $00000023, $000000C3, $00000018, $00000096, $00000005, $0000009A,
+ $00000007, $00000012, $00000080, $000000E2, $000000EB, $00000027, $000000B2, $00000075,
+ $00000009, $00000083, $0000002C, $0000001A, $0000001B, $0000006E, $0000005A, $000000A0,
+ $00000052, $0000003B, $000000D6, $000000B3, $00000029, $000000E3, $0000002F, $00000084,
+ $00000053, $000000D1, $00000000, $000000ED, $00000020, $000000FC, $000000B1, $0000005B,
+ $0000006A, $000000CB, $000000BE, $00000039, $0000004A, $0000004C, $00000058, $000000CF,
+ $000000D0, $000000EF, $000000AA, $000000FB, $00000043, $0000004D, $00000033, $00000085,
+ $00000045, $000000F9, $00000002, $0000007F, $00000050, $0000003C, $0000009F, $000000A8,
+ $00000051, $000000A3, $00000040, $0000008F, $00000092, $0000009D, $00000038, $000000F5,
+ $000000BC, $000000B6, $000000DA, $00000021, $00000010, $000000FF, $000000F3, $000000D2,
+ $000000CD, $0000000C, $00000013, $000000EC, $0000005F, $00000097, $00000044, $00000017,
+ $000000C4, $000000A7, $0000007E, $0000003D, $00000064, $0000005D, $00000019, $00000073,
+ $00000060, $00000081, $0000004F, $000000DC, $00000022, $0000002A, $00000090, $00000088,
+ $00000046, $000000EE, $000000B8, $00000014, $000000DE, $0000005E, $0000000B, $000000DB,
+ $000000E0, $00000032, $0000003A, $0000000A, $00000049, $00000006, $00000024, $0000005C,
+ $000000C2, $000000D3, $000000AC, $00000062, $00000091, $00000095, $000000E4, $00000079,
+ $000000E7, $000000C8, $00000037, $0000006D, $0000008D, $000000D5, $0000004E, $000000A9,
+ $0000006C, $00000056, $000000F4, $000000EA, $00000065, $0000007A, $000000AE, $00000008,
+ $000000BA, $00000078, $00000025, $0000002E, $0000001C, $000000A6, $000000B4, $000000C6,
+ $000000E8, $000000DD, $00000074, $0000001F, $0000004B, $000000BD, $0000008B, $0000008A,
+ $00000070, $0000003E, $000000B5, $00000066, $00000048, $00000003, $000000F6, $0000000E,
+ $00000061, $00000035, $00000057, $000000B9, $00000086, $000000C1, $0000001D, $0000009E,
+ $000000E1, $000000F8, $00000098, $00000011, $00000069, $000000D9, $0000008E, $00000094,
+ $0000009B, $0000001E, $00000087, $000000E9, $000000CE, $00000055, $00000028, $000000DF,
+ $0000008C, $000000A1, $00000089, $0000000D, $000000BF, $000000E6, $00000042, $00000068,
+ $00000041, $00000099, $0000002D, $0000000F, $000000B0, $00000054, $000000BB, $00000016
+ );
+
+ InverseTable: array [0..255] of Cardinal = (
+ $50A7F451, $5365417E, $C3A4171A, $965E273A, $CB6BAB3B, $F1459D1F, $AB58FAAC, $9303E34B,
+ $55FA3020, $F66D76AD, $9176CC88, $254C02F5, $FCD7E54F, $D7CB2AC5, $80443526, $8FA362B5,
+ $495AB1DE, $671BBA25, $980EEA45, $E1C0FE5D, $02752FC3, $12F04C81, $A397468D, $C6F9D36B,
+ $E75F8F03, $959C9215, $EB7A6DBF, $DA595295, $2D83BED4, $D3217458, $2969E049, $44C8C98E,
+ $6A89C275, $78798EF4, $6B3E5899, $DD71B927, $B64FE1BE, $17AD88F0, $66AC20C9, $B43ACE7D,
+ $184ADF63, $82311AE5, $60335197, $457F5362, $E07764B1, $84AE6BBB, $1CA081FE, $942B08F9,
+ $58684870, $19FD458F, $876CDE94, $B7F87B52, $23D373AB, $E2024B72, $578F1FE3, $2AAB5566,
+ $0728EBB2, $03C2B52F, $9A7BC586, $A50837D3, $F2872830, $B2A5BF23, $BA6A0302, $5C8216ED,
+ $2B1CCF8A, $92B479A7, $F0F207F3, $A1E2694E, $CDF4DA65, $D5BE0506, $1F6234D1, $8AFEA6C4,
+ $9D532E34, $A055F3A2, $32E18A05, $75EBF6A4, $39EC830B, $AAEF6040, $069F715E, $51106EBD,
+ $F98A213E, $3D06DD96, $AE053EDD, $46BDE64D, $B58D5491, $055DC471, $6FD40604, $FF155060,
+ $24FB9819, $97E9BDD6, $CC434089, $779ED967, $BD42E8B0, $888B8907, $385B19E7, $DBEEC879,
+ $470A7CA1, $E90F427C, $C91E84F8, $00000000, $83868009, $48ED2B32, $AC70111E, $4E725A6C,
+ $FBFF0EFD, $5638850F, $1ED5AE3D, $27392D36, $64D90F0A, $21A65C68, $D1545B9B, $3A2E3624,
+ $B1670A0C, $0FE75793, $D296EEB4, $9E919B1B, $4FC5C080, $A220DC61, $694B775A, $161A121C,
+ $0ABA93E2, $E52AA0C0, $43E0223C, $1D171B12, $0B0D090E, $ADC78BF2, $B9A8B62D, $C8A91E14,
+ $8519F157, $4C0775AF, $BBDD99EE, $FD607FA3, $9F2601F7, $BCF5725C, $C53B6644, $347EFB5B,
+ $7629438B, $DCC623CB, $68FCEDB6, $63F1E4B8, $CADC31D7, $10856342, $40229713, $2011C684,
+ $7D244A85, $F83DBBD2, $1132F9AE, $6DA129C7, $4B2F9E1D, $F330B2DC, $EC52860D, $D0E3C177,
+ $6C16B32B, $99B970A9, $FA489411, $2264E947, $C48CFCA8, $1A3FF0A0, $D82C7D56, $EF903322,
+ $C74E4987, $C1D138D9, $FEA2CA8C, $360BD498, $CF81F5A6, $28DE7AA5, $268EB7DA, $A4BFAD3F,
+ $E49D3A2C, $0D927850, $9BCC5F6A, $62467E54, $C2138DF6, $E8B8D890, $5EF7392E, $F5AFC382,
+ $BE805D9F, $7C93D069, $A92DD56F, $B31225CF, $3B99ACC8, $A77D1810, $6E639CE8, $7BBB3BDB,
+ $097826CD, $F418596E, $01B79AEC, $A89A4F83, $656E95E6, $7EE6FFAA, $08CFBC21, $E6E815EF,
+ $D99BE7BA, $CE366F4A, $D4099FEA, $D67CB029, $AFB2A431, $31233F2A, $3094A5C6, $C066A235,
+ $37BC4E74, $A6CA82FC, $B0D090E0, $15D8A733, $4A9804F1, $F7DAEC41, $0E50CD7F, $2FF69117,
+ $8DD64D76, $4DB0EF43, $544DAACC, $DF0496E4, $E3B5D19E, $1B886A4C, $B81F2CC1, $7F516546,
+ $04EA5E9D, $5D358C01, $737487FA, $2E410BFB, $5A1D67B3, $52D2DB92, $335610E9, $1347D66D,
+ $8C61D79A, $7A0CA137, $8E14F859, $893C13EB, $EE27A9CE, $35C961B7, $EDE51CE1, $3CB1477A,
+ $59DFD29C, $3F73F255, $79CE1418, $BF37C773, $EACDF753, $5BAAFD5F, $146F3DDF, $86DB4478,
+ $81F3AFCA, $3EC468B9, $2C342438, $5F40A3C2, $72C31D16, $0C25E2BC, $8B493C28, $41950DFF,
+ $7101A839, $DEB30C08, $9CE4B4D8, $90C15664, $6184CB7B, $70B632D5, $745C6C48, $4257B8D0
+ );
+
+ LastInverseTable: array [0..255] of Cardinal = (
+ $00000052, $00000009, $0000006A, $000000D5, $00000030, $00000036, $000000A5, $00000038,
+ $000000BF, $00000040, $000000A3, $0000009E, $00000081, $000000F3, $000000D7, $000000FB,
+ $0000007C, $000000E3, $00000039, $00000082, $0000009B, $0000002F, $000000FF, $00000087,
+ $00000034, $0000008E, $00000043, $00000044, $000000C4, $000000DE, $000000E9, $000000CB,
+ $00000054, $0000007B, $00000094, $00000032, $000000A6, $000000C2, $00000023, $0000003D,
+ $000000EE, $0000004C, $00000095, $0000000B, $00000042, $000000FA, $000000C3, $0000004E,
+ $00000008, $0000002E, $000000A1, $00000066, $00000028, $000000D9, $00000024, $000000B2,
+ $00000076, $0000005B, $000000A2, $00000049, $0000006D, $0000008B, $000000D1, $00000025,
+ $00000072, $000000F8, $000000F6, $00000064, $00000086, $00000068, $00000098, $00000016,
+ $000000D4, $000000A4, $0000005C, $000000CC, $0000005D, $00000065, $000000B6, $00000092,
+ $0000006C, $00000070, $00000048, $00000050, $000000FD, $000000ED, $000000B9, $000000DA,
+ $0000005E, $00000015, $00000046, $00000057, $000000A7, $0000008D, $0000009D, $00000084,
+ $00000090, $000000D8, $000000AB, $00000000, $0000008C, $000000BC, $000000D3, $0000000A,
+ $000000F7, $000000E4, $00000058, $00000005, $000000B8, $000000B3, $00000045, $00000006,
+ $000000D0, $0000002C, $0000001E, $0000008F, $000000CA, $0000003F, $0000000F, $00000002,
+ $000000C1, $000000AF, $000000BD, $00000003, $00000001, $00000013, $0000008A, $0000006B,
+ $0000003A, $00000091, $00000011, $00000041, $0000004F, $00000067, $000000DC, $000000EA,
+ $00000097, $000000F2, $000000CF, $000000CE, $000000F0, $000000B4, $000000E6, $00000073,
+ $00000096, $000000AC, $00000074, $00000022, $000000E7, $000000AD, $00000035, $00000085,
+ $000000E2, $000000F9, $00000037, $000000E8, $0000001C, $00000075, $000000DF, $0000006E,
+ $00000047, $000000F1, $0000001A, $00000071, $0000001D, $00000029, $000000C5, $00000089,
+ $0000006F, $000000B7, $00000062, $0000000E, $000000AA, $00000018, $000000BE, $0000001B,
+ $000000FC, $00000056, $0000003E, $0000004B, $000000C6, $000000D2, $00000079, $00000020,
+ $0000009A, $000000DB, $000000C0, $000000FE, $00000078, $000000CD, $0000005A, $000000F4,
+ $0000001F, $000000DD, $000000A8, $00000033, $00000088, $00000007, $000000C7, $00000031,
+ $000000B1, $00000012, $00000010, $00000059, $00000027, $00000080, $000000EC, $0000005F,
+ $00000060, $00000051, $0000007F, $000000A9, $00000019, $000000B5, $0000004A, $0000000D,
+ $0000002D, $000000E5, $0000007A, $0000009F, $00000093, $000000C9, $0000009C, $000000EF,
+ $000000A0, $000000E0, $0000003B, $0000004D, $000000AE, $0000002A, $000000F5, $000000B0,
+ $000000C8, $000000EB, $000000BB, $0000003C, $00000083, $00000053, $00000099, $00000061,
+ $00000017, $0000002B, $00000004, $0000007E, $000000BA, $00000077, $000000D6, $00000026,
+ $000000E1, $00000069, $00000014, $00000063, $00000055, $00000021, $0000000C, $0000007D
+ );
+
+procedure ExpandAESKeyForEncryption128(const Key: TCnAESKey128; var ExpandedKey:
+ TCnAESExpandedKey128);
+var
+ I, J: Integer;
+ T: Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ ExpandedKey[0] := PCardinal(@Key[0])^;
+ ExpandedKey[1] := PCardinal(@Key[4])^;
+ ExpandedKey[2] := PCardinal(@Key[8])^;
+ ExpandedKey[3] := PCardinal(@Key[12])^;
+ I := 0; J := 1;
+ repeat
+ T := (ExpandedKey[I + 3] shl 24) or (ExpandedKey[I + 3] shr 8);
+ W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)];
+ W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)];
+ ExpandedKey[I + 4] := ExpandedKey[I] xor
+ (W0 xor ((W1 shl 8) or (W1 shr 24)) xor
+ ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J];
+ Inc(J);
+ ExpandedKey[I + 5] := ExpandedKey[I + 1] xor ExpandedKey[I + 4];
+ ExpandedKey[I + 6] := ExpandedKey[I + 2] xor ExpandedKey[I + 5];
+ ExpandedKey[I + 7] := ExpandedKey[I + 3] xor ExpandedKey[I + 6];
+ Inc(I, 4);
+ until I >= 40;
+end;
+
+procedure ExpandAESKeyForEncryption192(const Key: TCnAESKey192; var ExpandedKey:
+ TCnAESExpandedKey192);
+var
+ I, J: Integer;
+ T: Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ ExpandedKey[0] := PCardinal(@Key[0])^;
+ ExpandedKey[1] := PCardinal(@Key[4])^;
+ ExpandedKey[2] := PCardinal(@Key[8])^;
+ ExpandedKey[3] := PCardinal(@Key[12])^;
+ ExpandedKey[4] := PCardinal(@Key[16])^;
+ ExpandedKey[5] := PCardinal(@Key[20])^;
+ I := 0; J := 1;
+ repeat
+ T := (ExpandedKey[I + 5] shl 24) or (ExpandedKey[I + 5] shr 8);
+ W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)];
+ W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)];
+ ExpandedKey[I + 6] := ExpandedKey[I] xor
+ (W0 xor ((W1 shl 8) or (W1 shr 24)) xor
+ ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J];
+ Inc(J);
+ ExpandedKey[I + 7] := ExpandedKey[I + 1] xor ExpandedKey[I + 6];
+ ExpandedKey[I + 8] := ExpandedKey[I + 2] xor ExpandedKey[I + 7];
+ ExpandedKey[I + 9] := ExpandedKey[I + 3] xor ExpandedKey[I + 8];
+ ExpandedKey[I + 10] := ExpandedKey[I + 4] xor ExpandedKey[I + 9];
+ ExpandedKey[I + 11] := ExpandedKey[I + 5] xor ExpandedKey[I + 10];
+ Inc(I, 6);
+ until I >= 46;
+end;
+
+procedure ExpandAESKeyForEncryption256(const Key: TCnAESKey256; var ExpandedKey:
+ TCnAESExpandedKey256);
+var
+ I, J: Integer;
+ T: Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ ExpandedKey[0] := PCardinal(@Key[0])^;
+ ExpandedKey[1] := PCardinal(@Key[4])^;
+ ExpandedKey[2] := PCardinal(@Key[8])^;
+ ExpandedKey[3] := PCardinal(@Key[12])^;
+ ExpandedKey[4] := PCardinal(@Key[16])^;
+ ExpandedKey[5] := PCardinal(@Key[20])^;
+ ExpandedKey[6] := PCardinal(@Key[24])^;
+ ExpandedKey[7] := PCardinal(@Key[28])^;
+ I := 0; J := 1;
+ repeat
+ T := (ExpandedKey[I + 7] shl 24) or (ExpandedKey[I + 7] shr 8);
+ W0 := LastForwardTable[Byte(T)]; W1 := LastForwardTable[Byte(T shr 8)];
+ W2 := LastForwardTable[Byte(T shr 16)]; W3 := LastForwardTable[Byte(T shr 24)];
+ ExpandedKey[I + 8] := ExpandedKey[I] xor
+ (W0 xor ((W1 shl 8) or (W1 shr 24)) xor
+ ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8))) xor Rcon[J];
+ Inc(J);
+ ExpandedKey[I + 9] := ExpandedKey[I + 1] xor ExpandedKey[I + 8];
+ ExpandedKey[I + 10] := ExpandedKey[I + 2] xor ExpandedKey[I + 9];
+ ExpandedKey[I + 11] := ExpandedKey[I + 3] xor ExpandedKey[I + 10];
+ W0 := LastForwardTable[Byte(ExpandedKey[I + 11])];
+ W1 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 8)];
+ W2 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 16)];
+ W3 := LastForwardTable[Byte(ExpandedKey[I + 11] shr 24)];
+ ExpandedKey[I + 12] := ExpandedKey[I + 4] xor
+ (W0 xor ((W1 shl 8) or (W1 shr 24)) xor
+ ((W2 shl 16) or (W2 shr 16)) xor ((W3 shl 24) or (W3 shr 8)));
+ ExpandedKey[I + 13] := ExpandedKey[I + 5] xor ExpandedKey[I + 12];
+ ExpandedKey[I + 14] := ExpandedKey[I + 6] xor ExpandedKey[I + 13];
+ ExpandedKey[I + 15] := ExpandedKey[I + 7] xor ExpandedKey[I + 14];
+ Inc(I, 8);
+ until I >= 52;
+end;
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+begin
+ EncryptAES128(InBuf, Key, OutBuf);
+end;
+
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+begin
+ EncryptAES192(InBuf, Key, OutBuf);
+end;
+
+procedure EncryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+begin
+ EncryptAES256(InBuf, Key, OutBuf);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[0];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[1];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[2];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[3];
+
+ // performing transformation 9 times
+ // round 1
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // round 2
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 3
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 4
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 5
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 6
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 7
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 8
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 9
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // last round of transformations
+ W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)];
+ W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[40];
+ W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)];
+ W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[41];
+ W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)];
+ W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[42];
+ W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)];
+ W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[43];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+procedure EncryptAES192(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[0];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[1];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[2];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[3];
+
+ // performing transformation 11 times
+ // round 1
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // round 2
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 3
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 4
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 5
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 6
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 7
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 8
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 9
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // round 10
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[40];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[41];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[42];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[43];
+ // round 11
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[44];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[45];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[46];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[47];
+ // last round of transformations
+ W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)];
+ W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[48];
+ W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)];
+ W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[49];
+ W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)];
+ W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[50];
+ W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)];
+ W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[51];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+procedure EncryptAES256(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[0];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[1];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[2];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[3];
+
+ // performing transformation 13 times
+ // round 1
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // round 2
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 3
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 4
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 5
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 6
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 7
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 8
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 9
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // round 10
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[40];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[41];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[42];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[43];
+ // round 11
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[44];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[45];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[46];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[47];
+ // round 12
+ W0 := ForwardTable[Byte(T1[0])]; W1 := ForwardTable[Byte(T1[1] shr 8)];
+ W2 := ForwardTable[Byte(T1[2] shr 16)]; W3 := ForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[48];
+ W0 := ForwardTable[Byte(T1[1])]; W1 := ForwardTable[Byte(T1[2] shr 8)];
+ W2 := ForwardTable[Byte(T1[3] shr 16)]; W3 := ForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[49];
+ W0 := ForwardTable[Byte(T1[2])]; W1 := ForwardTable[Byte(T1[3] shr 8)];
+ W2 := ForwardTable[Byte(T1[0] shr 16)]; W3 := ForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[50];
+ W0 := ForwardTable[Byte(T1[3])]; W1 := ForwardTable[Byte(T1[0] shr 8)];
+ W2 := ForwardTable[Byte(T1[1] shr 16)]; W3 := ForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[51];
+ // round 13
+ W0 := ForwardTable[Byte(T0[0])]; W1 := ForwardTable[Byte(T0[1] shr 8)];
+ W2 := ForwardTable[Byte(T0[2] shr 16)]; W3 := ForwardTable[Byte(T0[3] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[52];
+ W0 := ForwardTable[Byte(T0[1])]; W1 := ForwardTable[Byte(T0[2] shr 8)];
+ W2 := ForwardTable[Byte(T0[3] shr 16)]; W3 := ForwardTable[Byte(T0[0] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[53];
+ W0 := ForwardTable[Byte(T0[2])]; W1 := ForwardTable[Byte(T0[3] shr 8)];
+ W2 := ForwardTable[Byte(T0[0] shr 16)]; W3 := ForwardTable[Byte(T0[1] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[54];
+ W0 := ForwardTable[Byte(T0[3])]; W1 := ForwardTable[Byte(T0[0] shr 8)];
+ W2 := ForwardTable[Byte(T0[1] shr 16)]; W3 := ForwardTable[Byte(T0[2] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[55];
+ // last round of transformations
+ W0 := LastForwardTable[Byte(T1[0])]; W1 := LastForwardTable[Byte(T1[1] shr 8)];
+ W2 := LastForwardTable[Byte(T1[2] shr 16)]; W3 := LastForwardTable[Byte(T1[3] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[56];
+ W0 := LastForwardTable[Byte(T1[1])]; W1 := LastForwardTable[Byte(T1[2] shr 8)];
+ W2 := LastForwardTable[Byte(T1[3] shr 16)]; W3 := LastForwardTable[Byte(T1[0] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[57];
+ W0 := LastForwardTable[Byte(T1[2])]; W1 := LastForwardTable[Byte(T1[3] shr 8)];
+ W2 := LastForwardTable[Byte(T1[0] shr 16)]; W3 := LastForwardTable[Byte(T1[1] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[58];
+ W0 := LastForwardTable[Byte(T1[3])]; W1 := LastForwardTable[Byte(T1[0] shr 8)];
+ W2 := LastForwardTable[Byte(T1[1] shr 16)]; W3 := LastForwardTable[Byte(T1[2] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[59];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey128);
+begin
+ ExpandAESKeyForDecryption128(ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey128;
+ var ExpandedKey: TCnAESExpandedKey128);
+begin
+ ExpandAESKeyForDecryption128Expanded(Key, ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey192);
+begin
+ ExpandAESKeyForDecryption192(ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey192;
+ var ExpandedKey: TCnAESExpandedKey192);
+begin
+ ExpandAESKeyForDecryption192Expanded(Key, ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption(var ExpandedKey: TCnAESExpandedKey256);
+begin
+ ExpandAESKeyForDecryption256(ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption(const Key: TCnAESKey256;
+ var ExpandedKey: TCnAESExpandedKey256);
+begin
+ ExpandAESKeyForDecryption256Expanded(Key, ExpandedKey);
+end;
+
+{$ENDIF}
+
+procedure ExpandAESKeyForDecryption128(var ExpandedKey: TCnAESExpandedKey128);
+var
+ I: Integer;
+ U, F2, F4, F8, F9: Cardinal;
+begin
+ for I := 1 to 9 do
+ begin
+ F9 := ExpandedKey[I * 4];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 1];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 2];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 3];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ end;
+end;
+
+procedure ExpandAESKeyForDecryption128Expanded(const Key: TCnAESKey128; var ExpandedKey:
+ TCnAESExpandedKey128);
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ ExpandAESKeyForDecryption128(ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption192(var ExpandedKey: TCnAESExpandedKey192);
+var
+ I: Integer;
+ U, F2, F4, F8, F9: Cardinal;
+begin
+ for I := 1 to 11 do
+ begin
+ F9 := ExpandedKey[I * 4];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 1];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 2];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 3];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ end;
+end;
+
+procedure ExpandAESKeyForDecryption192Expanded(const Key: TCnAESKey192; var ExpandedKey:
+ TCnAESExpandedKey192);
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ ExpandAESKeyForDecryption192(ExpandedKey);
+end;
+
+procedure ExpandAESKeyForDecryption256(var ExpandedKey: TCnAESExpandedKey256);
+var
+ I: Integer;
+ U, F2, F4, F8, F9: Cardinal;
+begin
+ for I := 1 to 13 do
+ begin
+ F9 := ExpandedKey[I * 4];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 1];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 1] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 2];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 2] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ F9 := ExpandedKey[I * 4 + 3];
+ U := F9 and $80808080;
+ F2 := ((F9 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F2 and $80808080;
+ F4 := ((F2 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ U := F4 and $80808080;
+ F8 := ((F4 and $7F7F7F7F) shl 1) xor ((U - (U shr 7)) and $1B1B1B1B);
+ F9 := F9 xor F8;
+ ExpandedKey[I * 4 + 3] := F2 xor F4 xor F8 xor
+ (((F2 xor F9) shl 24) or ((F2 xor F9) shr 8)) xor
+ (((F4 xor F9) shl 16) or ((F4 xor F9) shr 16)) xor ((F9 shl 8) or (F9 shr 24));
+ end;
+end;
+
+procedure ExpandAESKeyForDecryption256Expanded(const Key: TCnAESKey256; var ExpandedKey:
+ TCnAESExpandedKey256);
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ ExpandAESKeyForDecryption256(ExpandedKey);
+end;
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+begin
+ DecryptAES128(InBuf, Key, OutBuf);
+end;
+
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+begin
+ DecryptAES192(InBuf, Key, OutBuf);
+end;
+
+procedure DecryptAES(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+begin
+ DecryptAES256(InBuf, Key, OutBuf);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey128;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[40];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[41];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[42];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[43];
+
+ // performing transformations 9 times
+ // round 1
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // round 2
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 3
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 4
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 5
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 6
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 7
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 8
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 9
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // last round of transformations
+ W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)];
+ W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[0];
+ W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)];
+ W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[1];
+ W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)];
+ W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[2];
+ W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)];
+ W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[3];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+procedure DecryptAES192(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey192;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[48];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[49];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[50];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[51];
+
+ // performing transformations 11 times
+ // round 1
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[44];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[45];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[46];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[47];
+ // round 2
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[40];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[41];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[42];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[43];
+ // round 3
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // round 4
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 5
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 6
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 7
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 8
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 9
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 10
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 11
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // last round of transformations
+ W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)];
+ W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[0];
+ W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)];
+ W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[1];
+ W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)];
+ W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[2];
+ W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)];
+ W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[3];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+procedure DecryptAES256(const InBuf: TCnAESBuffer; const Key: TCnAESExpandedKey256;
+ var OutBuf: TCnAESBuffer);
+var
+ T0, T1: array [0..3] of Cardinal;
+ W0, W1, W2, W3: Cardinal;
+begin
+ // initializing
+ T0[0] := PCardinal(@InBuf[0])^ xor Key[56];
+ T0[1] := PCardinal(@InBuf[4])^ xor Key[57];
+ T0[2] := PCardinal(@InBuf[8])^ xor Key[58];
+ T0[3] := PCardinal(@InBuf[12])^ xor Key[59];
+
+ // performing transformations 13 times
+ // round 1
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[52];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[53];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[54];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[55];
+ // round 2
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[48];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[49];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[50];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[51];
+ // round 3
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[44];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[45];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[46];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[47];
+ // round 4
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[40];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[41];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[42];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[43];
+ // round 5
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[36];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[37];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[38];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[39];
+ // round 6
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[32];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[33];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[34];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[35];
+ // round 7
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[28];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[29];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[30];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[31];
+ // round 8
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[24];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[25];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[26];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[27];
+ // round 9
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[20];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[21];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[22];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[23];
+ // round 10
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[16];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[17];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[18];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[19];
+ // round 11
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[12];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[13];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[14];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[15];
+ // round 12
+ W0 := InverseTable[Byte(T1[0])]; W1 := InverseTable[Byte(T1[3] shr 8)];
+ W2 := InverseTable[Byte(T1[2] shr 16)]; W3 := InverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[8];
+ W0 := InverseTable[Byte(T1[1])]; W1 := InverseTable[Byte(T1[0] shr 8)];
+ W2 := InverseTable[Byte(T1[3] shr 16)]; W3 := InverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[9];
+ W0 := InverseTable[Byte(T1[2])]; W1 := InverseTable[Byte(T1[1] shr 8)];
+ W2 := InverseTable[Byte(T1[0] shr 16)]; W3 := InverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[10];
+ W0 := InverseTable[Byte(T1[3])]; W1 := InverseTable[Byte(T1[2] shr 8)];
+ W2 := InverseTable[Byte(T1[1] shr 16)]; W3 := InverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[11];
+ // round 13
+ W0 := InverseTable[Byte(T0[0])]; W1 := InverseTable[Byte(T0[3] shr 8)];
+ W2 := InverseTable[Byte(T0[2] shr 16)]; W3 := InverseTable[Byte(T0[1] shr 24)];
+ T1[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[4];
+ W0 := InverseTable[Byte(T0[1])]; W1 := InverseTable[Byte(T0[0] shr 8)];
+ W2 := InverseTable[Byte(T0[3] shr 16)]; W3 := InverseTable[Byte(T0[2] shr 24)];
+ T1[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[5];
+ W0 := InverseTable[Byte(T0[2])]; W1 := InverseTable[Byte(T0[1] shr 8)];
+ W2 := InverseTable[Byte(T0[0] shr 16)]; W3 := InverseTable[Byte(T0[3] shr 24)];
+ T1[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[6];
+ W0 := InverseTable[Byte(T0[3])]; W1 := InverseTable[Byte(T0[2] shr 8)];
+ W2 := InverseTable[Byte(T0[1] shr 16)]; W3 := InverseTable[Byte(T0[0] shr 24)];
+ T1[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[7];
+ // last round of transformations
+ W0 := LastInverseTable[Byte(T1[0])]; W1 := LastInverseTable[Byte(T1[3] shr 8)];
+ W2 := LastInverseTable[Byte(T1[2] shr 16)]; W3 := LastInverseTable[Byte(T1[1] shr 24)];
+ T0[0] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[0];
+ W0 := LastInverseTable[Byte(T1[1])]; W1 := LastInverseTable[Byte(T1[0] shr 8)];
+ W2 := LastInverseTable[Byte(T1[3] shr 16)]; W3 := LastInverseTable[Byte(T1[2] shr 24)];
+ T0[1] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[1];
+ W0 := LastInverseTable[Byte(T1[2])]; W1 := LastInverseTable[Byte(T1[1] shr 8)];
+ W2 := LastInverseTable[Byte(T1[0] shr 16)]; W3 := LastInverseTable[Byte(T1[3] shr 24)];
+ T0[2] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[2];
+ W0 := LastInverseTable[Byte(T1[3])]; W1 := LastInverseTable[Byte(T1[2] shr 8)];
+ W2 := LastInverseTable[Byte(T1[1] shr 16)]; W3 := LastInverseTable[Byte(T1[0] shr 24)];
+ T0[3] := (W0 xor ((W1 shl 8) or (W1 shr 24)) xor ((W2 shl 16) or (W2 shr 16))
+ xor ((W3 shl 24) or (W3 shr 8))) xor Key[3];
+
+ // finalizing
+ PCardinal(@OutBuf[0])^ := T0[0];
+ PCardinal(@OutBuf[4])^ := T0[1];
+ PCardinal(@OutBuf[8])^ := T0[2];
+ PCardinal(@OutBuf[12])^ := T0[3];
+end;
+
+// Stream Encryption Routines (ECB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+begin
+ EncryptAES128StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+begin
+ EncryptAES128StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+begin
+ EncryptAES192StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+begin
+ EncryptAES192StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+begin
+ EncryptAES256StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure EncryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+begin
+ EncryptAES256StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ EncryptAES128StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure EncryptAES192StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ EncryptAES192StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure EncryptAES256StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ EncryptAES256StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure EncryptAES128StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES128(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ EncryptAES128(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES192StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES192(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ EncryptAES192(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES256StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES256(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ EncryptAES256(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Decryption Routines (ECB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+begin
+ DecryptAES128StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+begin
+ DecryptAES128StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+begin
+ DecryptAES192StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+begin
+ DecryptAES192StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+begin
+ DecryptAES256StreamECB(Source, Count, Key, Dest);
+end;
+
+procedure DecryptAESStreamECB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+begin
+ DecryptAES256StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForDecryption128Expanded(Key, ExpandedKey);
+ DecryptAES128StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure DecryptAES128StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if (Count mod SizeOf(TCnAESBuffer)) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize);
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ DecryptAES128(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+procedure DecryptAES192StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForDecryption192Expanded(Key, ExpandedKey);
+ DecryptAES192StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure DecryptAES192StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if (Count mod SizeOf(TCnAESBuffer)) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize);
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ DecryptAES192(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+procedure DecryptAES256StreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForDecryption256Expanded(Key, ExpandedKey);
+ DecryptAES256StreamECBExpanded(Source, Count, ExpandedKey, Dest);
+end;
+
+procedure DecryptAES256StreamECBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if (Count mod SizeOf(TCnAESBuffer)) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize);
+
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ DecryptAES256(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+// Stream Encryption Routines (CBC mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES128StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES128StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES192StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES192StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES256StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES256StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ EncryptAES128StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES128StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError); // Ҫÿһ鶼
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^; // ԭʼ IV
+ EncryptAES128(TempIn, ExpandedKey, TempOut); // ټ
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // д
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut; // ݴԭʼ IV һʹ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+ EncryptAES128(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES192StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ EncryptAES192StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES192StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+ EncryptAES192(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+ EncryptAES192(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES256StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ EncryptAES256StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES256StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+ EncryptAES256(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+ EncryptAES256(TempIn, ExpandedKey, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Decryption Routines (CBC mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES128StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES128StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES192StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES192StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES256StreamCBC(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCBC(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES256StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForDecryption128Expanded(Key, ExpandedKey);
+ DecryptAES128StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES128StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector1, Vector2: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if Count mod SizeOf(TCnAESBuffer) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize);
+
+ Vector1 := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ Vector2 := TempIn;
+ DecryptAES128(TempIn, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@Vector1[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@Vector1[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector1 := Vector2;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+procedure DecryptAES192StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForDecryption192Expanded(Key, ExpandedKey);
+ DecryptAES192StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES192StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector1, Vector2: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if Count mod SizeOf(TCnAESBuffer) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize);
+
+ Vector1 := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ Vector2 := TempIn;
+ DecryptAES192(TempIn, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@Vector1[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@Vector1[12])^;
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector1 := Vector2;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+procedure DecryptAES256StreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForDecryption256Expanded(Key, ExpandedKey);
+ DecryptAES256StreamCBCExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES256StreamCBCExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector1, Vector2: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ if Count mod SizeOf(TCnAESBuffer) > 0 then
+ raise ECnAESException.Create(SCnErrorAESInvalidInBufSize); // CBC Ϊ AES ֿܲģԱ
+
+ Vector1 := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ Vector2 := TempIn;
+ DecryptAES256(TempIn, ExpandedKey, TempOut); // Ƚ
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^; // ܺݺ Iv õ
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@Vector1[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@Vector1[12])^;
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // дȥ
+
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector1 := Vector2; // ȡ Iv Ϊһκͽ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+end;
+
+// Stream Encryption Routines (CFB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES128StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES128StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES192StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES192StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES256StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES256StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ EncryptAES128StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES128StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut); // Key ȼ Iv
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // ĽдĽ
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut; // Ľȡ Iv һּ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES192StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ EncryptAES192StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES192StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES256StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ EncryptAES256StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES256StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Decryption Routines (CFB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES128StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES128StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES192StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES192StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES256StreamCFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES256StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ DecryptAES128StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES128StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ // CFB Ϊ AES ֿܲĶĿɶ
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn)); //
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut); // Iv ȼܡעǼܣǽܣ
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^; // ܺݺõ
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // дȥ
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempIn; // ȡ Iv Ϊһμ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then // һ鲻Ϊ
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^; // ܺݺõ
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, Count); // дȥ
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure DecryptAES192StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ DecryptAES192StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES192StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempIn;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure DecryptAES256StreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ DecryptAES256StreamCFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES256StreamCFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempIn;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Encryption Routines (OFB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES128StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES128StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES192StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES192StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ EncryptAES256StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ EncryptAES256StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ EncryptAES128StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES128StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut); // Key ȼ Iv
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ Vector := TempOut; // ܽȡ Iv һּܣעⲻ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES192StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ EncryptAES192StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES192StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES256StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ EncryptAES256StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure EncryptAES256StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Decryption Routines (OFB mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES128StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES128StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES192StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES192StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+begin
+ DecryptAES256StreamOFB(Source, Count, Key, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamOFB(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+begin
+ DecryptAES256StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ DecryptAES128StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES128StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ // OFB Ϊ AES ֿܲĶĿɶ
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn)); //
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut); // Iv ȼܡעǼܣǽܣ
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^; // ܺݺõ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // дȥ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempOut; // ȡ Iv Ϊһǰ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then // һ鲻Ϊ
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES128(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^; // ܺݺõ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дȥ
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure DecryptAES192StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ DecryptAES192StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES192StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure DecryptAES256StreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const InitVector: TCnAESBuffer; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ DecryptAES256StreamOFBExpanded(Source, Count, ExpandedKey, InitVector, Dest);
+end;
+
+procedure DecryptAES256StreamOFBExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const InitVector: TCnAESBuffer;
+ Dest: TStream);
+var
+ TempIn, TempOut: TCnAESBuffer;
+ Vector: TCnAESBuffer;
+ Done: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorAESWriteError);
+
+ Vector := TempOut;
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESReadError);
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, Count);
+ if Done < Count then
+ raise EStreamError(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Encryption Routines (CTR mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES128StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES128StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES192StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES192StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES256StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES256StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure EncryptAES128StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ EncryptAES128StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAES128StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done, Cnt, T: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Cnt := 1;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES128(Vector, ExpandedKey, TempOut); // Key ȼƴ Iv
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Inc(Cnt); // һ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES128(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES192StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ EncryptAES192StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAES192StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done, Cnt, T: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Cnt := 1;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES192(Vector, ExpandedKey, TempOut); // Key ȼƴ Iv
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Inc(Cnt); // һ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES192(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+procedure EncryptAES256StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ EncryptAES256StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure EncryptAES256StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ TempIn, TempOut, Vector: TCnAESBuffer;
+ Done, Cnt, T: Cardinal;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+ if Count = 0 then
+ Exit;
+
+ Cnt := 1;
+ while Count >= SizeOf(TCnAESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES256(Vector, ExpandedKey, TempOut); // Key ȼƴ Iv
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+
+ Inc(Cnt); // һ
+ Dec(Count, SizeOf(TCnAESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESReadError);
+
+ Move(Nonce[0], Vector[0], SizeOf(TCnAESCTRNonce));
+ Move(InitVector[0], Vector[SizeOf(TCnAESCTRNonce)], SizeOf(TCnAESCTRIv));
+ T := UInt32HostToNetwork(Cnt);
+ Move(T, Vector[SizeOf(TCnAESCTRNonce) + SizeOf(TCnAESCTRIv)], SizeOf(Cardinal));
+
+ EncryptAES256(Vector, ExpandedKey, TempOut);
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorAESWriteError);
+ end;
+end;
+
+// Stream Decryption Routines (CTR mode)
+
+{$IFNDEF BCB5OR6}
+
+// C++Builder overload ⣬ Delphi ¿
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES128StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES128StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES192StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES192StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES256StreamCTR(Source, Count, Key, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAESStreamCTR(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ DecryptAES256StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+{$ENDIF}
+
+procedure DecryptAES128StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey128;
+begin
+ ExpandAESKeyForEncryption128(Key, ExpandedKey);
+ DecryptAES128StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAES128StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey128; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES128StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAES192StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey192;
+begin
+ ExpandAESKeyForEncryption192(Key, ExpandedKey);
+ DecryptAES192StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAES192StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey192; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES192StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAES256StreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnAESKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+var
+ ExpandedKey: TCnAESExpandedKey256;
+begin
+ ExpandAESKeyForEncryption256(Key, ExpandedKey);
+ DecryptAES256StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+procedure DecryptAES256StreamCTRExpanded(Source: TStream; Count: Cardinal;
+ const ExpandedKey: TCnAESExpandedKey256; const Nonce: TCnAESCTRNonce;
+ const InitVector: TCnAESCTRIv; Dest: TStream);
+begin
+ EncryptAES256StreamCTRExpanded(Source, Count, ExpandedKey, Nonce, InitVector, Dest);
+end;
+
+// AES ECB ַתʮ
+function AESEncryptEcbStrToHex(Value: AnsiString; Key: AnsiString;
+ KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[1])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamECB(SS, 0, AESKey128, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamECB(SS, 0, AESKey192, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamECB(SS, 0, AESKey256, DS);
+ end;
+ end;
+
+ Result := AnsiString(DataToHex(DS.Memory, DS.Size));
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES ECB ʮַ
+function AESDecryptEcbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ Tmp: TBytes;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ Tmp := HexToBytes(string(HexStr));
+ SS.Write(PAnsiChar(@Tmp[0])^, Length(Tmp));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamECB(SS, SS.Size - SS.Position, AESKey128, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamECB(SS, SS.Size - SS.Position, AESKey192, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamECB(SS, SS.Size - SS.Position, AESKey256, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ Move(PAnsiChar(DS.Memory)^, Result[1], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CBC ַתʮ
+function AESEncryptCbcStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[1])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCBC(SS, 0, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCBC(SS, 0, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCBC(SS, 0, AESKey256, Iv, DS);
+ end;
+ end;
+
+ Result := AnsiString(DataToHex(DS.Memory, DS.Size));
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CBC ʮַ
+function AESDecryptCbcStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ Tmp: TBytes;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ Tmp := HexToBytes(string(HexStr));
+ SS.Write(PAnsiChar(@Tmp[0])^, Length(Tmp));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCBC(SS, SS.Size - SS.Position, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCBC(SS, SS.Size - SS.Position, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCBC(SS, SS.Size - SS.Position, AESKey256, Iv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ Move(PAnsiChar(DS.Memory)^, Result[1], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CFB ģʽַתʮ
+function AESEncryptCfbStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[1])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCFB(SS, 0, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCFB(SS, 0, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCFB(SS, 0, AESKey256, Iv, DS);
+ end;
+ end;
+
+ Result := AnsiString(DataToHex(DS.Memory, DS.Size));
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CFB ʮַ
+function AESDecryptCfbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ Tmp: TBytes;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ Tmp := HexToBytes(string(HexStr));
+ SS.Write(PAnsiChar(@Tmp[0])^, Length(Tmp));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCFB(SS, SS.Size - SS.Position, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCFB(SS, SS.Size - SS.Position, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCFB(SS, SS.Size - SS.Position, AESKey256, Iv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ Move(PAnsiChar(DS.Memory)^, Result[1], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES OFB ģʽַתʮ
+function AESEncryptOfbStrToHex(Value: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[1])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamOFB(SS, 0, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamOFB(SS, 0, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamOFB(SS, 0, AESKey256, Iv, DS);
+ end;
+ end;
+
+ Result := AnsiString(DataToHex(DS.Memory, DS.Size));
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES OFB ʮַ
+function AESDecryptOfbStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Iv: TCnAESBuffer; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ Tmp: TBytes;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ Tmp := HexToBytes(string(HexStr));
+ SS.Write(PAnsiChar(@Tmp[0])^, Length(Tmp));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamOFB(SS, SS.Size - SS.Position, AESKey128, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamOFB(SS, SS.Size - SS.Position, AESKey192, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamOFB(SS, SS.Size - SS.Position, AESKey256, Iv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ Move(PAnsiChar(DS.Memory)^, Result[1], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CTR ģʽַתʮ
+function AESEncryptCtrStrToHex(Value: AnsiString; Key: AnsiString;
+ const Nonce: TCnAESCTRNonce; const Iv: TCnAESCTRIv; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[1])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCTR(SS, 0, AESKey128, Nonce, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCTR(SS, 0, AESKey192, Nonce, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCTR(SS, 0, AESKey256, Nonce, Iv, DS);
+ end;
+ end;
+
+ Result := AnsiString(DataToHex(DS.Memory, DS.Size));
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CTR ʮַ
+function AESDecryptCtrStrFromHex(const HexStr: AnsiString; Key: AnsiString;
+ const Nonce: TCnAESCTRNonce; const Iv: TCnAESCTRIv; KeyBit: TCnKeyBitType): AnsiString;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ Tmp: TBytes;
+begin
+ Result := '';
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ Tmp := HexToBytes(string(HexStr));
+ SS.Write(PAnsiChar(@Tmp[0])^, Length(Tmp));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCTR(SS, SS.Size - SS.Position, AESKey128, Nonce, Iv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCTR(SS, SS.Size - SS.Position, AESKey192, Nonce, Iv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCTR(SS, SS.Size - SS.Position, AESKey256, Nonce, Iv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ Move(PAnsiChar(DS.Memory)^, Result[1], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES ECB ģʽֽ
+function AESEncryptEcbBytes(Value, Key: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamECB(SS, 0, AESKey128, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamECB(SS, 0, AESKey192, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamECB(SS, 0, AESKey256, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES ECB ģʽֽ
+function AESDecryptEcbBytes(Value, Key: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamECB(SS, SS.Size - SS.Position, AESKey128, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamECB(SS, SS.Size - SS.Position, AESKey192, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamECB(SS, SS.Size - SS.Position, AESKey256, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CBC ģʽֽ
+function AESEncryptCbcBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCBC(SS, 0, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCBC(SS, 0, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCBC(SS, 0, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CBC ģʽֽ
+function AESDecryptCbcBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCBC(SS, SS.Size - SS.Position, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCBC(SS, SS.Size - SS.Position, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCBC(SS, SS.Size - SS.Position, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CFB ģʽֽ
+function AESEncryptCfbBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCFB(SS, 0, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCFB(SS, 0, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCFB(SS, 0, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CFB ģʽֽ
+function AESDecryptCfbBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCFB(SS, SS.Size - SS.Position, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCFB(SS, SS.Size - SS.Position, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCFB(SS, SS.Size - SS.Position, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES OFB ģʽֽ
+function AESEncryptOfbBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamOFB(SS, 0, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamOFB(SS, 0, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamOFB(SS, 0, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES OFB ģʽֽ
+function AESDecryptOfbBytes(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESBuffer;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamOFB(SS, SS.Size - SS.Position, AESKey128, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamOFB(SS, SS.Size - SS.Position, AESKey192, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamOFB(SS, SS.Size - SS.Position, AESKey256, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CTR ģʽֽ
+function AESEncryptCtrBytes(Value, Key, Nonce, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESCTRIv;
+ AESNonce: TCnAESCTRNonce;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+
+ FillChar(AESNonce, SizeOF(AESNonce), 0);
+ Move(PAnsiChar(Nonce)^, AESNonce, Min(SizeOf(AESNonce), Length(Nonce)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ EncryptAES128StreamCTR(SS, 0, AESKey128, AESNonce, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ EncryptAES192StreamCTR(SS, 0, AESKey192, AESNonce, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ EncryptAES256StreamCTR(SS, 0, AESKey256, AESNonce, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES CTR ģʽֽ
+function AESDecryptCtrBytes(Value, Key, Nonce, Iv: TBytes; KeyBit: TCnKeyBitType): TBytes;
+var
+ SS, DS: TMemoryStream;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AESIv: TCnAESCTRIv;
+ AESNonce: TCnAESCTRNonce;
+begin
+ if Length(Value) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ SS := nil;
+ DS := nil;
+
+ try
+ SS := TMemoryStream.Create;
+ SS.Write(PAnsiChar(@Value[0])^, Length(Value));
+ SS.Position := 0;
+
+ FillChar(AESIv, SizeOF(AESIv), 0);
+ Move(PAnsiChar(Iv)^, AESIv, Min(SizeOf(AESIv), Length(Iv)));
+
+ FillChar(AESNonce, SizeOF(AESNonce), 0);
+ Move(PAnsiChar(Nonce)^, AESNonce, Min(SizeOf(AESNonce), Length(Nonce)));
+ DS := TMemoryStream.Create;
+
+ case KeyBit of
+ kbt128:
+ begin
+ FillChar(AESKey128, SizeOf(AESKey128), 0);
+ Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
+ DecryptAES128StreamCTR(SS, SS.Size - SS.Position, AESKey128, AESNonce, AESIv, DS);
+ end;
+ kbt192:
+ begin
+ FillChar(AESKey192, SizeOf(AESKey192), 0);
+ Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
+ DecryptAES192StreamCTR(SS, SS.Size - SS.Position, AESKey192, AESNonce, AESIv, DS);
+ end;
+ kbt256:
+ begin
+ FillChar(AESKey256, SizeOf(AESKey256), 0);
+ Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
+ DecryptAES256StreamCTR(SS, SS.Size - SS.Position, AESKey256, AESNonce, AESIv, DS);
+ end;
+ end;
+
+ SetLength(Result, DS.Size);
+ DS.Position := 0;
+ DS.Read(Result[0], DS.Size);
+ finally
+ SS.Free;
+ DS.Free;
+ end;
+end;
+
+// AES ECB ģʽֽ鲢תʮ
+function AESEncryptEcbBytesToHex(Value, Key: TBytes; KeyBit: TCnKeyBitType): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(AESEncryptEcbBytes(Value, Key, KeyBit)));
+end;
+
+// AES ECB ʮַֽ
+function AESDecryptEcbBytesFromHex(const HexStr: AnsiString; Key: TBytes;
+ KeyBit: TCnKeyBitType): TBytes;
+begin
+ Result := AESDecryptEcbBytes(HexToBytes(string(HexStr)), Key, KeyBit);
+end;
+
+// AES CBC ģʽֽ鲢תʮ
+function AESEncryptCbcBytesToHex(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(AESEncryptCbcBytes(Value, Key, Iv, KeyBit)));
+end;
+
+// AES CBC ʮַֽ
+function AESDecryptCbcBytesFromHex(const HexStr: AnsiString; Key, Iv: TBytes;
+ KeyBit: TCnKeyBitType): TBytes;
+begin
+ Result := AESDecryptCbcBytes(HexToBytes(string(HexStr)), Key, Iv, KeyBit);
+end;
+
+// AES CFB ģʽֽ鲢תʮ
+function AESEncryptCfbBytesToHex(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(AESEncryptCfbBytes(Value, Key, Iv, KeyBit)));
+end;
+
+// AES CFB ʮַֽ
+function AESDecryptCfbBytesFromHex(const HexStr: AnsiString; Key, Iv: TBytes;
+ KeyBit: TCnKeyBitType): TBytes;
+begin
+ Result := AESDecryptCfbBytes(HexToBytes(string(HexStr)), Key, Iv, KeyBit);
+end;
+
+// AES OFB ģʽֽ鲢תʮ
+function AESEncryptOfbBytesToHex(Value, Key, Iv: TBytes; KeyBit: TCnKeyBitType): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(AESEncryptOfbBytes(Value, Key, Iv, KeyBit)));
+end;
+
+// AES OFB ʮַֽ
+function AESDecryptOfbBytesFromHex(const HexStr: AnsiString; Key, Iv: TBytes;
+ KeyBit: TCnKeyBitType): TBytes;
+begin
+ Result := AESDecryptOfbBytes(HexToBytes(string(HexStr)), Key, Iv, KeyBit);
+end;
+
+// AES CTR ģʽֽ鲢תʮ
+function AESEncryptCtrBytesToHex(Value, Key, Nonce, Iv: TBytes; KeyBit: TCnKeyBitType): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(AESEncryptCtrBytes(Value, Key, Nonce, Iv, KeyBit)));
+end;
+
+// AES CTR ʮַֽ
+function AESDecryptCtrBytesFromHex(const HexStr: AnsiString; Key, Nonce, Iv: TBytes;
+ KeyBit: TCnKeyBitType): TBytes;
+begin
+ Result := AESDecryptCtrBytes(HexToBytes(string(HexStr)), Key, Nonce, Iv, KeyBit);
+end;
+
+end.
+
diff --git a/CnPack/Crypto/CnBase64.pas b/CnPack/Crypto/CnBase64.pas
new file mode 100644
index 0000000..1aae0e4
--- /dev/null
+++ b/CnPack/Crypto/CnBase64.pas
@@ -0,0 +1,1070 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+{ -----------------------------------------------------------------------------}
+{ uTBase64 v1.0 - Simple Base64 encoding/decoding class }
+{ Base64 described in RFC2045, Page 24, (w) 1996 Freed & Borenstein }
+{ Delphi implementation (w) 1999 Dennis D. Spreen (dennis@spreendigital.de) }
+{ This unit is freeware. Just drop me a line if this unit is useful for you. }
+{ -----------------------------------------------------------------------------}
+
+unit CnBase64;
+{* |
+================================================================================
+* ƣ
+* ԪƣBase64/32 㷨ʵֵԪ
+* ԪߣղSolin solin@21cn.com; http://www.ilovezhuzhu.net
+* wr960204
+* CnPack (master@cnpack.org)
+* ݻ Dennis D. Spreen UTBASE64.pas дԭаȨϢ
+* עԪʵ˱ Base64 Base64URL ı빦ܣԼ RFC 4648 е
+* Base32 빦ܣBase16 д HEXʵ֣
+*
+* Base64URL ڱ Base64ѷ + / 滻 - _ URL
+* Ѻãɾβ =
+*
+* ע벿в FixZero ȥĩβ #0Ǽӽܵ
+* Base64 ܺڴ˴룬ʱ FixZero ָΪ False
+* ĩβɳ #0 ʱضӰܽ
+*
+* ƽ̨PWin2003Std + Delphi 6.0
+* ݲԣδ
+* õԪ豾ػ
+* ļ¼2026.05.11 V1.7
+* Base32 ıʵ
+* 2023.10.04 V1.6
+* ɾʵ֡Base64Encode Base64Decode ֧ Base64URL ı
+* 2019.12.12 V1.5
+* ֧ TBytes
+* 2019.04.15 V1.4
+* ֧ Win32/Win64/MacOS
+* 2018.06.22 V1.3
+* ԭʼݿܰ #0 ԭʼβ #0 Ƴ
+* 2016.05.03 V1.2
+* ַа #0 ʱܻᱻضϵ
+* 2006.10.25 V1.1
+* wr960204 Ż汾
+* 2003.10.14 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes, CnNative, CnConsts;
+
+const
+ //
+ ECN_BASE64_OK = ECN_OK;
+ {* Base64 ϵд룺ֵΪ 0}
+
+ ECN_BASE64_ERROR_BASE = ECN_CUSTOM_ERROR_BASE + $500;
+ {* Base64 ϵдĻʼֵΪ ECN_CUSTOM_ERROR_BASE $500}
+
+ ECN_BASE64_LENGTH = ECN_BASE64_ERROR_BASE + 1;
+ {* Base64 ֮ݳȷǷ}
+
+ ECN_BASE32_OK = ECN_OK;
+ {* Base32 ϵд룺ֵΪ 0}
+
+ ECN_BASE32_LENGTH = ECN_BASE64_LENGTH;
+ {* Base32 ֮ݳȷǷ}
+
+function Base64Encode(InputData: TStream; var OutputData: string;
+ URL: Boolean = False): Integer; overload;
+{* Base64 Base64URL 룬ɹ ECN_BASE64_OK
+
+
+ InputData: TStream -
+ var OutputData: string - ַ
+ URL: Boolean - URL ǡTrue ʹ Base64URL 룬False ʹñ Base64
+
+ ֵInteger - رǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Encode(const InputData: AnsiString; var OutputData: string;
+ URL: Boolean = False): Integer; overload;
+{* ַ Base64 Base64URL 룬ɹ ECN_BASE64_OK
+
+
+ const InputData: AnsiString - ַ
+ var OutputData: string - ַ
+ URL: Boolean - URL ǡTrue ʹ Base64URL 룬False ʹñ Base64
+
+ ֵInteger - رǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Encode(InputData: Pointer; DataByteLen: Integer; var OutputData: string;
+ URL: Boolean = False): Integer; overload;
+{* ݿ Base64 Base64URL 룬ɹ ECN_BASE64_OK
+
+
+ InputData: Pointer - ݿַ
+ DataByteLen: Integer - ݿֽڳ
+ var OutputData: string - ַ
+ URL: Boolean - URL ǡTrue ʹ Base64URL 룬False ʹñ Base64
+
+ ֵInteger - رǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Encode(const InputData: TBytes; var OutputData: string;
+ URL: Boolean = False): Integer; overload;
+{* ֽ Base64 Base64URL 룬ɹ ECN_BASE64_OK
+
+
+ const InputData: TBytes - ֽ
+ var OutputData: string - ַ
+ URL: Boolean - URL ǡTrue ʹ Base64URL 룬False ʹñ Base64
+
+ ֵInteger - رǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Decode(const InputData: string; OutputData: TStream;
+ FixZero: Boolean = True): Integer; overload;
+{* ַ Base64 루 Base64URL 룩дɹ ECN_BASE64_OK
+
+
+ const InputData: string - ַ
+ OutputData: TStream -
+ FixZero: Boolean - Ƿȥβ #0
+
+ ֵInteger - ؽǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Decode(const InputData: string; var OutputData: AnsiString;
+ FixZero: Boolean = True): Integer; overload;
+{* ַ Base64 루 Base64URL 룩дַɹ ECN_BASE64_OK
+
+
+ const InputData: string - ַ
+ var OutputData: AnsiString - ַ
+ FixZero: Boolean - Ƿȥβ #0
+
+ ֵInteger - ؽǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Decode(const InputData: string; OutputData: Pointer;
+ DataByteLen: Integer; FixZero: Boolean = True): Integer; overload;
+{* ַ Base64 루 Base64URL 룩дڴɹ ECN_BASE64_OK
+
+
+ const InputData: string - ַ
+ OutputData: Pointer - ڴַ
+ DataByteLen: Integer - ڴֽڳȣӦΪ 1 + (Length(InputData) * 3 / 4)
+ FixZero: Boolean - Ƿȥβ #0
+
+ ֵInteger - OutputData nilĽֽڳȡؽǷɹɹ ECN_BASE64_OK
+}
+
+function Base64Decode(const InputData: string; out OutputData: TBytes;
+ FixZero: Boolean = True): Integer; overload;
+{* ַ Base64 루 Base64URL 룩дֽ顣ɹ ECN_BASE64_OK
+
+
+ const InputData: string - ַ
+ out OutputData: TBytes - ֽ
+ FixZero: Boolean - Ƿȥβ #0
+
+ ֵInteger - ؽǷɹɹ ECN_BASE64_OK
+}
+
+function Base64IsStrictText(const InputData: string; AllowURLSafe: Boolean = False): Boolean;
+{* жַǷϸϷ Base64 ַݼ볤ȼ⡣
+
+
+ const InputData: string - жϵַ
+ AllowURLSafe: Boolean - Ƿʹ URL ȫַ
+
+ ֵBoolean - ǷϸϷ Base64 ַ
+}
+
+function Base32Encode(InputData: TStream; var OutputData: string): Integer; overload;
+{* Base32 룬ɹ ECN_BASE32_OK
+
+
+ InputData: TStream -
+ var OutputData: string - ַ
+
+ ֵInteger - رǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Encode(const InputData: AnsiString; var OutputData: string): Integer; overload;
+{* ַ Base32 룬ɹ ECN_BASE32_OK
+
+
+ const InputData: AnsiString - ַ
+ var OutputData: string - ַ
+
+ ֵInteger - رǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Encode(InputData: Pointer; DataByteLen: Integer; var OutputData: string): Integer; overload;
+{* ݿ Base32 룬ɹ ECN_BASE32_OK
+
+
+ InputData: Pointer - ݿַ
+ DataByteLen: Integer - ݿֽڳ
+ var OutputData: string - ַ
+
+ ֵInteger - رǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Encode(const InputData: TBytes; var OutputData: string): Integer; overload;
+{* ֽ Base32 룬ɹ ECN_BASE32_OK
+
+
+ const InputData: TBytes - ֽ
+ var OutputData: string - ַ
+
+ ֵInteger - رǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Decode(const InputData: string; OutputData: TStream): Integer; overload;
+{* ַ Base32 룬дɹ ECN_BASE32_OK
+
+
+ const InputData: string - ַ
+ OutputData: TStream -
+
+ ֵInteger - ؽǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Decode(const InputData: string; var OutputData: AnsiString): Integer; overload;
+{* ַ Base32 룬дַɹ ECN_BASE32_OK
+
+
+ const InputData: string - ַ
+ var OutputData: AnsiString - ַ
+
+ ֵInteger - ؽǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Decode(const InputData: string; OutputData: Pointer;
+ DataByteLen: Integer): Integer; overload;
+{* ַ Base32 룬дڴɹ ECN_BASE32_OK
+
+
+ const InputData: string - ַ
+ OutputData: Pointer - ڴַ
+ DataByteLen: Integer - ڴֽڳȣӦΪ 1 + (Length(InputData) * 5 / 8)
+
+ ֵInteger - OutputData nilĽֽڳȡؽǷɹɹ ECN_BASE32_OK
+}
+
+function Base32Decode(const InputData: string; out OutputData: TBytes): Integer; overload;
+{* ַ Base32 룬дֽ顣ɹ ECN_BASE32_OK
+
+
+ const InputData: string - ַ
+ out OutputData: TBytes - ֽ
+
+ ֵInteger - ؽǷɹɹ ECN_BASE32_OK
+}
+
+function Base32IsStrictText(const InputData: string): Boolean;
+{* жַǷϸϷ Base32 ַݼ볤ȼ⡣
+
+
+ const InputData: string - жϵַ
+
+ ֵBoolean - ǷϸϷ Base32 ַ
+}
+
+implementation
+
+var
+ FilterDecodeInput: Boolean = True;
+
+//------------------------------------------------------------------------------
+// IJο
+//------------------------------------------------------------------------------
+
+ EnCodeTab64: array[0..64] of AnsiChar =
+ (
+ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
+ 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
+ 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
+ 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
+ 'w', 'x', 'y', 'z', '0', '1', '2', '3',
+ '4', '5', '6', '7', '8', '9', '+', '/',
+ '=');
+
+ EnCodeTab64URL: array[0..64] of AnsiChar =
+ (
+ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
+ 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
+ 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
+ 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
+ 'w', 'x', 'y', 'z', '0', '1', '2', '3',
+ '4', '5', '6', '7', '8', '9', '-', '_',
+ '=');
+
+ EnCodeTab32: array[0..32] of AnsiChar =
+ (
+ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
+ 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', '2', '3', '4', '5', '6', '7',
+ '='
+ );
+
+//------------------------------------------------------------------------------
+// IJο
+//------------------------------------------------------------------------------
+
+ { Base64 ֱַӸ㣬Ҳȡ}
+ DecodeTable64: array[#0..#127] of Byte =
+ (
+ Byte('='), 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
+ 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00,
+ 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 62, 00, 62, 00, 63, // ĵһ 62 63 + / - 62
+ 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 00, 00, 00, 00, 00, 00,
+ 00, 00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 00, 00, 00, 00, 63, // _ 63
+ 00, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 00, 00, 00, 00, 00
+ );
+
+// Ϊ wr960204 ĽĿ Base64 㷨
+function Base64Encode(InputData: Pointer; DataByteLen: Integer;
+ var OutputData: string; URL: Boolean): Integer;
+var
+ Times, I: Integer;
+ X1, X2, X3, X4: AnsiChar;
+ XT: Byte;
+begin
+ if (InputData = nil) or (DataByteLen <= 0) then
+ begin
+ Result := ECN_BASE64_LENGTH;
+ Exit;
+ end;
+
+ if DataByteLen mod 3 = 0 then
+ Times := DataByteLen div 3
+ else
+ Times := DataByteLen div 3 + 1;
+ SetLength(OutputData, Times * 4); // һηڴ,һδַ,һδͷŷڴ
+ FillChar(OutputData[1], Length(OutputData) * SizeOf(Char), 0);
+
+ if URL then
+ begin
+ for I := 0 to Times - 1 do
+ begin
+ if DataByteLen >= (3 + I * 3) then
+ begin
+ X1 := EnCodeTab64URL[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ XT := XT or (Ord(PAnsiChar(InputData)[1 + I * 3]) shr 4);
+ X2 := EnCodeTab64URL[XT];
+ XT := (Ord(PAnsiChar(InputData)[1 + I * 3]) shl 2) and 60;
+ XT := XT or (Ord(PAnsiChar(InputData)[2 + I * 3]) shr 6);
+ X3 := EnCodeTab64URL[XT];
+ XT := (Ord(PAnsiChar(InputData)[2 + I * 3]) and 63);
+ X4 := EnCodeTab64URL[XT];
+ end
+ else if DataByteLen >= (2 + I * 3) then
+ begin
+ X1 := EnCodeTab64URL[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ XT := XT or (Ord(PAnsiChar(InputData)[1 + I * 3]) shr 4);
+ X2 := EnCodeTab64URL[XT];
+ XT := (Ord(PAnsiChar(InputData)[1 + I * 3]) shl 2) and 60;
+ X3 := EnCodeTab64URL[XT ];
+ X4 := '=';
+ end
+ else
+ begin
+ X1 := EnCodeTab64URL[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ X2 := EnCodeTab64URL[XT];
+ X3 := '=';
+ X4 := '=';
+ end;
+ OutputData[I shl 2 + 1] := Char(X1);
+ OutputData[I shl 2 + 2] := Char(X2);
+ OutputData[I shl 2 + 3] := Char(X3);
+ OutputData[I shl 2 + 4] := Char(X4);
+ end;
+ end
+ else
+ begin
+ for I := 0 to Times - 1 do
+ begin
+ if DataByteLen >= (3 + I * 3) then
+ begin
+ X1 := EnCodeTab64[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ XT := XT or (Ord(PAnsiChar(InputData)[1 + I * 3]) shr 4);
+ X2 := EnCodeTab64[XT];
+ XT := (Ord(PAnsiChar(InputData)[1 + I * 3]) shl 2) and 60;
+ XT := XT or (Ord(PAnsiChar(InputData)[2 + I * 3]) shr 6);
+ X3 := EnCodeTab64[XT];
+ XT := (Ord(PAnsiChar(InputData)[2 + I * 3]) and 63);
+ X4 := EnCodeTab64[XT];
+ end
+ else if DataByteLen >= (2 + I * 3) then
+ begin
+ X1 := EnCodeTab64[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ XT := XT or (Ord(PAnsiChar(InputData)[1 + I * 3]) shr 4);
+ X2 := EnCodeTab64[XT];
+ XT := (Ord(PAnsiChar(InputData)[1 + I * 3]) shl 2) and 60;
+ X3 := EnCodeTab64[XT ];
+ X4 := '=';
+ end
+ else
+ begin
+ X1 := EnCodeTab64[(Ord(PAnsiChar(InputData)[I * 3]) shr 2)];
+ XT := (Ord(PAnsiChar(InputData)[I * 3]) shl 4) and 48;
+ X2 := EnCodeTab64[XT];
+ X3 := '=';
+ X4 := '=';
+ end;
+ OutputData[I shl 2 + 1] := Char(X1);
+ OutputData[I shl 2 + 2] := Char(X2);
+ OutputData[I shl 2 + 3] := Char(X3);
+ OutputData[I shl 2 + 4] := Char(X4);
+ end;
+ end;
+
+ OutputData := Trim(OutputData);
+ if URL then
+ begin
+ // ɾ OutputData β = ַ
+ if (Length(OutputData) > 0) and (OutputData[Length(OutputData)] = '=') then
+ begin
+ Delete(OutputData, Length(OutputData), 1);
+ if (Length(OutputData) > 0) and (OutputData[Length(OutputData)] = '=') then
+ begin
+ Delete(OutputData, Length(OutputData), 1);
+ if (Length(OutputData) > 0) and (OutputData[Length(OutputData)] = '=') then
+ Delete(OutputData, Length(OutputData), 1);
+ end;
+ end;
+ end;
+ Result := ECN_BASE64_OK;
+end;
+
+function Base64Encode(InputData: TStream; var OutputData: string; URL: Boolean): Integer;
+var
+ Mem: TMemoryStream;
+begin
+ Mem := TMemoryStream.Create;
+ try
+ Mem.CopyFrom(InputData, InputData.Size);
+ Result := Base64Encode(Mem.Memory, Mem.Size, OutputData, URL);
+ finally
+ Mem.Free;
+ end;
+end;
+
+function Base64Encode(const InputData: AnsiString; var OutputData: string; URL: Boolean): Integer;
+begin
+ if InputData <> '' then
+ Result := Base64Encode(@InputData[1], Length(InputData), OutputData, URL)
+ else
+ Result := ECN_BASE64_LENGTH;
+end;
+
+function Base64Encode(const InputData: TBytes; var OutputData: string; URL: Boolean): Integer;
+begin
+ if Length(InputData) > 0 then
+ Result := Base64Encode(@InputData[0], Length(InputData), OutputData, URL)
+ else
+ Result := ECN_BASE64_LENGTH;
+end;
+
+function Base64Decode(const InputData: string; OutputData: TStream; FixZero: Boolean): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base64Decode(InputData, Data, FixZero);
+ if (Result = ECN_BASE64_OK) and (Length(Data) > 0) then
+ begin
+ OutputData.Size := Length(Data);
+ OutputData.Position := 0;
+ OutputData.Write(Data[0], Length(Data));
+ end;
+end;
+
+function Base64Decode(const InputData: string; out OutputData: TBytes;
+ FixZero: Boolean): Integer;
+var
+ SrcLen, DstLen, Times, I: Integer;
+ X1, X2, X3, X4, XT: Byte;
+ C, ToDec: Integer;
+ Data: AnsiString;
+
+ function FilterLine(const Source: AnsiString): AnsiString;
+ var
+ P, PP: PAnsiChar;
+ I, FL: Integer;
+ begin
+ FL := Length(Source);
+ if FL > 0 then
+ begin
+ GetMem(P, FL); // һηڴ,һδַ,һδͷŷڴ
+ PP := P;
+ FillChar(P^, FL, 0);
+ for I := 1 to FL do
+ begin
+ if Source[I] in ['0'..'9', 'A'..'Z', 'a'..'z', '+', '/', '=', '-', '_'] then
+ begin
+ PP^ := Source[I];
+ Inc(PP);
+ end;
+ end;
+ SetString(Result, P, PP - P); // ȡЧ
+ FreeMem(P);
+ end;
+ end;
+
+begin
+ if InputData = '' then
+ begin
+ Result := ECN_BASE64_OK;
+ Exit;
+ end;
+ OutPutData := nil;
+
+ // D5 ²֪ôIJ AnsiString(InputData)ܻڴֿ
+ if FilterDecodeInput then
+ begin
+{$IFDEF UNICODE}
+ Data := FilterLine(AnsiString(InputData));
+{$ELSE}
+ Data := FilterLine(InputData);
+{$ENDIF}
+ end
+ else
+ begin
+{$IFDEF UNICODE}
+ Data := AnsiString(InputData);
+{$ELSE}
+ Data := InputData;
+{$ENDIF}
+ end;
+
+ // Base64URL Ľȥβ =ҪݳǷ 4 ı
+ if (Length(Data) and $03) <> 0 then
+ Data := Data + StringOfChar(AnsiChar('='), 4 - (Length(Data) and $03));
+
+ SrcLen := Length(Data);
+ DstLen := SrcLen * 3 div 4;
+ ToDec := 0;
+
+ // βһȺζԭʼݲ˸ #0ȺζŲ #0ҪȥҲ̳
+ // עⲻͬԭʼݵβ #0 ȥ
+ if Data[SrcLen] = '=' then
+ begin
+ Inc(ToDec);
+ if (SrcLen > 1) and (Data[SrcLen - 1] = '=') then
+ Inc(ToDec);
+ end;
+
+ SetLength(OutputData, DstLen); // һηڴ,һδַ,һδͷŷڴ
+ Times := SrcLen div 4;
+ C := 0;
+
+ for I := 0 to Times - 1 do
+ begin
+ X1 := DecodeTable64[Data[1 + I shl 2]];
+ X2 := DecodeTable64[Data[2 + I shl 2]];
+ X3 := DecodeTable64[Data[3 + I shl 2]];
+ X4 := DecodeTable64[Data[4 + I shl 2]];
+ X1 := Byte(X1 shl 2);
+ XT := Byte(X2 shr 4);
+ X1 := Byte(X1 or XT);
+ X2 := Byte(X2 shl 4);
+ OutputData[C] := X1;
+ Inc(C);
+ if X3 = 64 then
+ Break;
+ XT := Byte(X3 shr 2);
+ X2 := Byte(X2 or XT);
+ X3 := Byte(X3 shl 6);
+ OutputData[C] := X2;
+ Inc(C);
+ if X4 = 64 then
+ Break;
+ X3 := Byte(X3 or X4);
+ OutputData[C] := X3;
+ Inc(C);
+ end;
+
+ // ݲĵȺĿǷɾβ #0
+ while (ToDec > 0) and (OutputData[DstLen - 1] = 0) do
+ begin
+ Dec(ToDec);
+ Dec(DstLen);
+ end;
+ SetLength(OutputData, DstLen);
+
+ // ٸⲿҪɾβ #0ʵ̫ʵ
+ if FixZero then
+ begin
+ while (DstLen > 0) and (OutputData[DstLen - 1] = 0) do
+ Dec(DstLen);
+ SetLength(OutputData, DstLen);
+ end;
+
+ Result := ECN_BASE64_OK;
+end;
+
+function Base64Decode(const InputData: string; var OutputData: AnsiString; FixZero: Boolean): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base64Decode(InputData, Data, FixZero);
+ if (Result = ECN_BASE64_OK) and (Length(Data) > 0) then
+ begin
+ SetLength(OutputData, Length(Data));
+ Move(Data[0], OutputData[1], Length(Data));
+ end;
+end;
+
+function Base64Decode(const InputData: string; OutputData: Pointer;
+ DataByteLen: Integer; FixZero: Boolean): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base64Decode(InputData, Data, FixZero);
+ if (Result = ECN_BASE64_OK) and (Length(Data) > 0) then
+ begin
+ if OutputData = nil then
+ begin
+ Result := Length(Data);
+ Exit;
+ end;
+
+ if DataByteLen < Length(Data) then
+ begin
+ Result := ECN_BASE64_LENGTH;
+ Exit;
+ end;
+
+ Move(Data[0], OutPutData^, Length(Data));
+ end;
+end;
+
+function Base64IsStrictText(const InputData: string; AllowURLSafe: Boolean): Boolean;
+var
+ I, EqPos: Integer;
+ Ch: Char;
+begin
+ Result := False;
+ if InputData = '' then
+ Exit;
+
+ if AllowURLSafe then
+ begin
+ for I := 1 to Length(InputData) do
+ begin
+ Ch := InputData[I];
+ if not (Ch in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '=']) then
+ Exit;
+ end;
+ end
+ else
+ begin
+ for I := 1 to Length(InputData) do
+ begin
+ Ch := InputData[I];
+ if not (Ch in ['A'..'Z', 'a'..'z', '0'..'9', '+', '/', '=']) then
+ Exit;
+ end;
+ end;
+
+ if (Length(InputData) mod 4) <> 0 then
+ Exit;
+
+ EqPos := Pos('=', InputData);
+ if EqPos > 0 then
+ begin
+ for I := EqPos to Length(InputData) do
+ if InputData[I] <> '=' then
+ Exit;
+
+ if (Length(InputData) - EqPos + 1) > 2 then
+ Exit;
+ end;
+
+ Result := True;
+end;
+
+function Base32Encode(InputData: Pointer; DataByteLen: Integer;
+ var OutputData: string): Integer;
+var
+ Times, I, J, Remain, DataPos, OutPos: Integer;
+ B0, B1, B2, B3, B4: Byte;
+ Chars: array[0..7] of Byte;
+begin
+ if (InputData = nil) or (DataByteLen <= 0) then
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+
+ Times := DataByteLen div 5;
+ if (DataByteLen mod 5) <> 0 then
+ Inc(Times);
+
+ SetLength(OutputData, Times * 8);
+ FillChar(OutputData[1], Length(OutputData) * SizeOf(Char), 0);
+
+ for I := 0 to Times - 1 do
+ begin
+ DataPos := I * 5;
+ Remain := DataByteLen - DataPos;
+ if Remain > 5 then
+ Remain := 5;
+
+ B0 := 0;
+ B1 := 0;
+ B2 := 0;
+ B3 := 0;
+ B4 := 0;
+ if Remain > 0 then B0 := Byte(PAnsiChar(InputData)[DataPos]);
+ if Remain > 1 then B1 := Byte(PAnsiChar(InputData)[DataPos + 1]);
+ if Remain > 2 then B2 := Byte(PAnsiChar(InputData)[DataPos + 2]);
+ if Remain > 3 then B3 := Byte(PAnsiChar(InputData)[DataPos + 3]);
+ if Remain > 4 then B4 := Byte(PAnsiChar(InputData)[DataPos + 4]);
+
+ Chars[0] := (B0 shr 3) and $1F;
+ Chars[1] := ((B0 and $07) shl 2) or (B1 shr 6);
+ Chars[2] := (B1 shr 1) and $1F;
+ Chars[3] := ((B1 and $01) shl 4) or (B2 shr 4);
+ Chars[4] := ((B2 and $0F) shl 1) or (B3 shr 7);
+ Chars[5] := (B3 shr 2) and $1F;
+ Chars[6] := ((B3 and $03) shl 3) or (B4 shr 5);
+ Chars[7] := B4 and $1F;
+
+ OutPos := I * 8 + 1;
+ for J := 0 to 7 do
+ OutputData[OutPos + J] := Char(EnCodeTab32[Chars[J]]);
+
+ case Remain of
+ 1:
+ begin
+ OutputData[OutPos + 2] := '=';
+ OutputData[OutPos + 3] := '=';
+ OutputData[OutPos + 4] := '=';
+ OutputData[OutPos + 5] := '=';
+ OutputData[OutPos + 6] := '=';
+ OutputData[OutPos + 7] := '=';
+ end;
+ 2:
+ begin
+ OutputData[OutPos + 4] := '=';
+ OutputData[OutPos + 5] := '=';
+ OutputData[OutPos + 6] := '=';
+ OutputData[OutPos + 7] := '=';
+ end;
+ 3:
+ begin
+ OutputData[OutPos + 5] := '=';
+ OutputData[OutPos + 6] := '=';
+ OutputData[OutPos + 7] := '=';
+ end;
+ 4:
+ OutputData[OutPos + 7] := '=';
+ end;
+ end;
+
+ Result := ECN_BASE32_OK;
+end;
+
+function Base32Encode(InputData: TStream; var OutputData: string): Integer;
+var
+ Mem: TMemoryStream;
+begin
+ Mem := TMemoryStream.Create;
+ try
+ Mem.CopyFrom(InputData, InputData.Size);
+ Result := Base32Encode(Mem.Memory, Mem.Size, OutputData);
+ finally
+ Mem.Free;
+ end;
+end;
+
+function Base32Encode(const InputData: AnsiString; var OutputData: string): Integer;
+begin
+ if InputData <> '' then
+ Result := Base32Encode(@InputData[1], Length(InputData), OutputData)
+ else
+ Result := ECN_BASE32_LENGTH;
+end;
+
+function Base32Encode(const InputData: TBytes; var OutputData: string): Integer;
+begin
+ if Length(InputData) > 0 then
+ Result := Base32Encode(@InputData[0], Length(InputData), OutputData)
+ else
+ Result := ECN_BASE32_LENGTH;
+end;
+
+function Base32Decode(const InputData: string; out OutputData: TBytes): Integer;
+var
+ Data: AnsiString;
+ SrcLen, Times, I, J, C, PadCnt, DstLen, BlockPad: Integer;
+ V: array[0..7] of Byte;
+ Ch: AnsiChar;
+
+ function FilterLine(const Source: AnsiString): AnsiString;
+ var
+ P, PP: PAnsiChar;
+ I, FL: Integer;
+ C: AnsiChar;
+ begin
+ Result := '';
+ FL := Length(Source);
+ if FL > 0 then
+ begin
+ GetMem(P, FL);
+ PP := P;
+ FillChar(P^, FL, 0);
+ for I := 1 to FL do
+ begin
+ C := Source[I];
+ if C in ['a'..'z'] then
+ C := AnsiChar(Ord(C) - 32);
+ if C in ['A'..'Z', '2'..'7', '='] then
+ begin
+ PP^ := C;
+ Inc(PP);
+ end;
+ end;
+ SetString(Result, P, PP - P);
+ FreeMem(P);
+ end;
+ end;
+
+ function DecodeChar32(C: AnsiChar; out Value: Byte): Boolean;
+ begin
+ if C in ['A'..'Z'] then
+ begin
+ Value := Ord(C) - Ord('A');
+ Result := True;
+ Exit;
+ end;
+ if C in ['2'..'7'] then
+ begin
+ Value := Ord(C) - Ord('2') + 26;
+ Result := True;
+ Exit;
+ end;
+ Result := False;
+ end;
+
+begin
+ OutPutData := nil;
+ if InputData = '' then
+ begin
+ Result := ECN_BASE32_OK;
+ Exit;
+ end;
+
+{$IFDEF UNICODE}
+ Data := FilterLine(AnsiString(InputData));
+{$ELSE}
+ Data := FilterLine(InputData);
+{$ENDIF}
+
+ SrcLen := Length(Data);
+ if (SrcLen = 0) or ((SrcLen mod 8) <> 0) then
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+
+{$IFDEF UNICODE}
+ if not Base32IsStrictText(string(Data)) then
+{$ELSE}
+ if not Base32IsStrictText(Data) then
+{$ENDIF}
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+
+ PadCnt := 0;
+ while (PadCnt < SrcLen) and (Data[SrcLen - PadCnt] = '=') do
+ Inc(PadCnt);
+
+ DstLen := (SrcLen div 8) * 5;
+ case PadCnt of
+ 0: ;
+ 1: Dec(DstLen, 1);
+ 3: Dec(DstLen, 2);
+ 4: Dec(DstLen, 3);
+ 6: Dec(DstLen, 4);
+ else
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+ end;
+
+ SetLength(OutputData, DstLen);
+ Times := SrcLen div 8;
+ C := 0;
+
+ for I := 0 to Times - 1 do
+ begin
+ BlockPad := 0;
+ for J := 0 to 7 do
+ begin
+ Ch := Data[I * 8 + J + 1];
+ if Ch = '=' then
+ begin
+ V[J] := 0;
+ Inc(BlockPad);
+ end
+ else if DecodeChar32(Ch, V[J]) then
+ begin
+ // do nothing
+ end
+ else
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+ end;
+
+ OutputData[C] := Byte((V[0] shl 3) or (V[1] shr 2));
+ Inc(C);
+ if BlockPad = 6 then
+ Continue;
+
+ OutputData[C] := Byte((V[1] shl 6) or (V[2] shl 1) or (V[3] shr 4));
+ Inc(C);
+ if BlockPad = 4 then
+ Continue;
+
+ OutputData[C] := Byte((V[3] shl 4) or (V[4] shr 1));
+ Inc(C);
+ if BlockPad = 3 then
+ Continue;
+
+ OutputData[C] := Byte((V[4] shl 7) or (V[5] shl 2) or (V[6] shr 3));
+ Inc(C);
+ if BlockPad = 1 then
+ Continue;
+
+ OutputData[C] := Byte((V[6] shl 5) or V[7]);
+ Inc(C);
+ end;
+
+ Result := ECN_BASE32_OK;
+end;
+
+function Base32Decode(const InputData: string; OutputData: TStream): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base32Decode(InputData, Data);
+ if (Result = ECN_BASE32_OK) and (Length(Data) > 0) then
+ begin
+ OutputData.Size := Length(Data);
+ OutputData.Position := 0;
+ OutputData.Write(Data[0], Length(Data));
+ end;
+end;
+
+function Base32Decode(const InputData: string; var OutputData: AnsiString): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base32Decode(InputData, Data);
+ if (Result = ECN_BASE32_OK) and (Length(Data) > 0) then
+ begin
+ SetLength(OutputData, Length(Data));
+ Move(Data[0], OutputData[1], Length(Data));
+ end;
+end;
+
+function Base32Decode(const InputData: string; OutputData: Pointer;
+ DataByteLen: Integer): Integer;
+var
+ Data: TBytes;
+begin
+ Result := Base32Decode(InputData, Data);
+ if (Result = ECN_BASE32_OK) and (Length(Data) > 0) then
+ begin
+ if OutputData = nil then
+ begin
+ Result := Length(Data);
+ Exit;
+ end;
+
+ if DataByteLen < Length(Data) then
+ begin
+ Result := ECN_BASE32_LENGTH;
+ Exit;
+ end;
+
+ Move(Data[0], OutPutData^, Length(Data));
+ end;
+end;
+
+function Base32IsStrictText(const InputData: string): Boolean;
+var
+ I, EqPos, EC: Integer;
+ Ch: Char;
+begin
+ Result := False;
+ if InputData = '' then
+ Exit;
+
+ for I := 1 to Length(InputData) do
+ begin
+ Ch := InputData[I];
+ if not (Ch in ['A'..'Z', '2'..'7', '=']) then
+ Exit;
+ end;
+
+ if (Length(InputData) mod 8) <> 0 then
+ Exit;
+
+ EqPos := Pos('=', InputData);
+ if EqPos > 0 then
+ begin
+ for I := EqPos to Length(InputData) do
+ begin
+ if InputData[I] <> '=' then
+ Exit;
+ end;
+
+ EC := Length(InputData) - EqPos + 1;
+ if (EC = 2) or (EC = 5) or (EC > 6) then
+ Exit;
+ end;
+
+ Result := True;
+end;
+
+end.
diff --git a/CnPack/Crypto/CnDES.pas b/CnPack/Crypto/CnDES.pas
new file mode 100644
index 0000000..7acfcb4
--- /dev/null
+++ b/CnPack/Crypto/CnDES.pas
@@ -0,0 +1,1973 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnDES;
+{* |
+================================================================================
+* ƣ
+* ԪƣDES ԳƼӽ㷨ʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* /ֲ䲿ֹܡ
+* עԪʵ DES/3DES ԳƼӽ㷨ֿС 8 ֽڣʵ
+* ECB/CBC ģʽ֧ģʽ
+*
+* ƽ̨PWin2000Pro + Delphi 5.0
+* ݲԣPWin9X/2000/XP + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2024.11.30 V1.7
+* ɾ淶 DESEncryptStrToHex DESDecryptStrToHex
+* ɾ淶 TripleDESEncryptStrToHex TripleDESDecryptStrToHex
+* ECB 汾
+* Ż PAnsiChar ʽ Iv Ĵ
+* 2024.10.12 V1.6
+* 3DES ²Խ⣬Ż Key Iv Ķ봦
+* 2022.08.13 V1.5
+* Կݼܷؿ
+* 2021.02.07 V1.4
+* Ӷ TBytes ֧
+* 2020.03.25 V1.3
+* 3DES ֧
+* 2020.03.24 V1.2
+* ECB/CBC ַӽܺɾԭеַܺ
+* 2019.04.15 V1.1
+* ֧ Win32/Win64/MacOS
+* 2008.05.30 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes, CnNative;
+
+const
+ CN_DES_KEYSIZE = 8;
+ {* DES Կȣ8 ֽ}
+
+ CN_DES_BLOCKSIZE = 8;
+ {* DES ļܿ鳤ȣ8 ֽ}
+
+ CN_TRIPLE_DES_KEYSIZE = CN_DES_KEYSIZE * 3;
+ {* 3DES Կȣ DES 24 ֽ}
+
+ CN_TRIPLE_DES_BLOCKSIZE = CN_DES_BLOCKSIZE;
+ {* 3DES ļܿ鳤ȣ 8 ֽ}
+
+type
+ ECnDESException = class(Exception);
+ {* DES 쳣}
+
+ TCnDESKey = array[0..CN_DES_KEYSIZE - 1] of Byte;
+ {* DES ļ Key8 ֽ}
+
+ TCnDESBuffer = array[0..CN_DES_BLOCKSIZE - 1] of Byte;
+ {* DES ļܿ飬8 ֽ}
+
+ TCnDESIv = array[0..CN_DES_BLOCKSIZE - 1] of Byte;
+ {* DES CBC ijʼ8 ֽ}
+
+ TCn3DESKey = array[0..CN_TRIPLE_DES_KEYSIZE - 1] of Byte;
+ {* 3DES Կȣ DES 24 ֽ}
+
+ TCn3DESBuffer = TCnDESBuffer;
+ {* 3DES ļܿ飬 DES ļܿ飬8 ֽ}
+
+ TCn3DESIv = TCnDESIv;
+ {* 3DES CBC ijʼ DES CBC ijʼ8 ֽ}
+
+// ================================= DES =======================================
+
+function DESGetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+{* ֽڳȼ DES ȡǿ
+
+
+ InputByteLength: Integer - ֽڳ
+
+ ֵInteger - DES ij
+}
+
+procedure DESEncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString DES ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure DESDecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString DES ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure DESEncryptCbcStr(Key: AnsiString; Iv: PAnsiChar; const Input: AnsiString;
+ Output: PAnsiChar);
+{* AnsiString DES ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ Iv: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure DESDecryptCbcStr(Key: AnsiString; Iv: PAnsiChar; const Input: AnsiString;
+ Output: PAnsiChar);
+{* AnsiString DES ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ Iv: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+function DESEncryptEcbStrToHex(const Str: AnsiString; const Key: AnsiString): AnsiString;
+{* KeyDES ܷתʮƵģʹ ECB ģʽĩβܲ #0
+
+
+ const Str: AnsiString - ַܵ
+ const Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function DESDecryptEcbStrFromHex(const HexStr: AnsiString; const Key: AnsiString): AnsiString;
+{* ʮƵ KeyDES ܷģʹ ECB ģʽ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ const Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+
+ ֵAnsiString - ؽַܺ
+}
+
+function DESEncryptCbcStrToHex(const Str: AnsiString; const Key: AnsiString; const Iv: AnsiString): AnsiString;
+{* Key IvDES ܷתʮƵģʹ CBC ģʽĩβܲ #0
+
+
+ const Str: AnsiString - ַܵ
+ const Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ const Iv: AnsiString - 8 ֽڳʼ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function DESDecryptCbcStrFromHex(const HexStr: AnsiString; const Key: AnsiString;
+ const Iv: AnsiString): AnsiString;
+{* ʮƵ Key IvDES ܷģʹ ECB ģʽ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ const Key: AnsiString - 8 ֽ DES Կ̫ضϣ #0
+ const Iv: AnsiString - 8 ֽڳʼ
+
+ ֵAnsiString - ؽַܺ
+}
+
+function DESEncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ DES ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 8 ֽ DES Կ̫ضϣ 0
+ Input: TBytes - ֽܵ飬䳤粻 8 ʱᱻ 0 ȴﵽ 8 ı
+
+ ֵTBytes - ؼֽܺ
+}
+
+function DESDecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ DES ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 8 ֽ DES Կ̫ضϣ 0
+ Input: TBytes - ֽܵ飬䳤粻 8 ʱᱻ 0 ȴﵽ 8 ı
+
+ ֵTBytes - ؽֽܺ
+}
+
+function DESEncryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ DES ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 8 ֽ DES Կ̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function DESDecryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ DES ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 8 ֽ DES Կ̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+procedure DESEncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; Dest: TStream); overload;
+{* DES ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 8 ֽ DES Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DESDecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; Dest: TStream); overload;
+{* DES ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 8 ֽ DES Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DESEncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+{* DES ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 8 ֽ DES Կ
+ const InitVector: TCnDESIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure DESDecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+{* DES ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 8 ֽ DES Կ
+ const InitVector: TCnDESIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// =========================== 3-DES (Triple DES) ==============================
+
+function TripleDESGetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+{* ֽڳȼȡǿ
+
+
+ InputByteLength: Integer - ֽڳ
+
+ ֵInteger - 3DES ֽڳ
+}
+
+procedure TripleDESEncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString 3DES ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 24ֽ 3DES Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure TripleDESDecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString 3DES ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure TripleDESEncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString 3DES ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+ Iv: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+procedure TripleDESDecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString 3DES ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+ Iv: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ䳤粻 8 ʱᱻ #0 ȴﵽ 8 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 8) + 1) * 8
+
+ ֵޣ
+}
+
+function TripleDESEncryptEcbStrToHex(const Str: AnsiString; const Key: AnsiString): AnsiString;
+{* Key3DES ܷתʮƵģʹ ECB ģʽĩβܲ #0
+
+
+ const Str: AnsiString - ַܵ
+ const Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function TripleDESDecryptEcbStrFromHex(const HexStr: AnsiString; const Key: AnsiString): AnsiString;
+{* ʮƵ Key3DES ܷģʹ ECB ģʽ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ const Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+
+ ֵAnsiString - ؽַܺ
+}
+
+function TripleDESEncryptCbcStrToHex(const Str: AnsiString; const Key: AnsiString;
+ const Iv: AnsiString): AnsiString;
+{* Key Iv3DES ܷתʮƵģʹ CBC ģʽĩβܲ #0
+
+
+ const Str: AnsiString - ַܵ
+ const Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+ const Iv: AnsiString - 8 ֽڳʼ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function TripleDESDecryptCbcStrFromHex(const HexStr: AnsiString;
+ const Key: AnsiString; const Iv: AnsiString): AnsiString;
+{* ʮƵ Key Iv3DES ܷģʹ CBC ģʽ
+
+
+ const HexStr: AnsiString - ܵʮַ
+ const Key: AnsiString - 24 ֽ 3DES Կ̫ضϣ #0
+ const Iv: AnsiString - 8 ֽڳʼ
+
+ ֵAnsiString - ؽַܺ
+}
+
+function TripleDESEncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ 3DES ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 24 ֽ 3DES Կ̫ضϣ 0
+ Input: TBytes - ֽܵ飬䳤粻 8 ʱᱻ 0 ȴﵽ 8 ı
+
+ ֵTBytes - ؼֽܺ
+}
+
+function TripleDESDecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ 3DES ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 24 ֽ 3DES Կ̫ضϣ 0
+ Input: TBytes - ֽܵ飬䳤粻 8 ʱᱻ 0 ȴﵽ 8 ı
+
+ ֵTBytes - ؽֽܺ
+}
+
+function TripleDESEncryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ 3DES ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 24 ֽ 3DES Կ̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function TripleDESDecryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ 3DES ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 24 ֽ 3DES Կ̫ضϣ 0
+ Iv: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+procedure TripleDESEncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; Dest: TStream); overload;
+{* 3DES ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 24 ֽ 3DES Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure TripleDESDecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; Dest: TStream); overload;
+{* 3DES ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnDESKey - 24 ֽ 3DES Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure TripleDESEncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+{* 3DES ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCn3DESKey - 24 ֽ 3DES Կ
+ const InitVector: TCnDESIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure TripleDESDecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+{* 3DES ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCn3DESKey - 24 ֽ 3DES Կ
+ const InitVector: TCnDESIv - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+implementation
+
+resourcestring
+ SCnErrorDESInvalidInBufSize = 'Invalid Buffer Size for Decryption';
+ SCnErrorDESReadError = 'Stream Read Error';
+ SCnErrorDESWriteError = 'Stream Write Error';
+
+type
+ TKeyByte = array[0..5] of Byte;
+ TDesMode = (dmEncry, dmDecry);
+ TSubKey = array[0..15] of TKeyByte;
+
+const
+ BitIP: array[0..63] of Byte =
+ (57, 49, 41, 33, 25, 17, 9, 1,
+ 59, 51, 43, 35, 27, 19, 11, 3,
+ 61, 53, 45, 37, 29, 21, 13, 5,
+ 63, 55, 47, 39, 31, 23, 15, 7,
+ 56, 48, 40, 32, 24, 16, 8, 0,
+ 58, 50, 42, 34, 26, 18, 10, 2,
+ 60, 52, 44, 36, 28, 20, 12, 4,
+ 62, 54, 46, 38, 30, 22, 14, 6);
+
+ BitCP: array[0..63] of Byte =
+ (39, 7, 47, 15, 55, 23, 63, 31,
+ 38, 6, 46, 14, 54, 22, 62, 30,
+ 37, 5, 45, 13, 53, 21, 61, 29,
+ 36, 4, 44, 12, 52, 20, 60, 28,
+ 35, 3, 43, 11, 51, 19, 59, 27,
+ 34, 2, 42, 10, 50, 18, 58, 26,
+ 33, 1, 41, 9, 49, 17, 57, 25,
+ 32, 0, 40, 8, 48, 16, 56, 24);
+
+ BitExp: array[0..47] of Integer =
+ (31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9, 10,
+ 11, 12, 11, 12, 13, 14, 15, 16, 15, 16, 17, 18, 19, 20, 19, 20,
+ 21, 22, 23, 24, 23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0);
+
+ BitPM: array[0..31] of Byte =
+ (15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9,
+ 1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24);
+
+ sBox: array[0..7] of array[0..63] of Byte =
+ ((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7,
+ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8,
+ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0,
+ 15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13),
+
+ (15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10,
+ 3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5,
+ 0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15,
+ 13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9),
+
+ (10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8,
+ 13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1,
+ 13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7,
+ 1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12),
+
+ (7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15,
+ 13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9,
+ 10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4,
+ 3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14),
+
+ (2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9,
+ 14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6,
+ 4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14,
+ 11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3),
+
+ (12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11,
+ 10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8,
+ 9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6,
+ 4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13),
+
+ (4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1,
+ 13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6,
+ 1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2,
+ 6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12),
+
+ (13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7,
+ 1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2,
+ 7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8,
+ 2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11));
+
+ BitPMC1: array[0..55] of Byte =
+ (56, 48, 40, 32, 24, 16, 8,
+ 0, 57, 49, 41, 33, 25, 17,
+ 9, 1, 58, 50, 42, 34, 26,
+ 18, 10, 2, 59, 51, 43, 35,
+ 62, 54, 46, 38, 30, 22, 14,
+ 6, 61, 53, 45, 37, 29, 21,
+ 13, 5, 60, 52, 44, 36, 28,
+ 20, 12, 4, 27, 19, 11, 3);
+
+ BitPMC2: array[0..47] of Byte =
+ (13, 16, 10, 23, 0, 4,
+ 2, 27, 14, 5, 20, 9,
+ 22, 18, 11, 3, 25, 7,
+ 15, 6, 26, 19, 12, 1,
+ 40, 51, 30, 36, 46, 54,
+ 29, 39, 50, 44, 32, 47,
+ 43, 48, 38, 55, 33, 52,
+ 45, 41, 49, 35, 28, 31);
+
+function Min(A, B: Integer): Integer; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+procedure InitPermutation(var InData: array of Byte);
+var
+ NewData: array[0..7] of Byte;
+ I: Integer;
+begin
+ FillChar(NewData, 8, 0);
+ for I := 0 to 63 do
+ if (InData[BitIP[I] shr 3] and (1 shl (7 - (BitIP[I] and $07)))) <> 0 then
+ NewData[I shr 3] := NewData[I shr 3] or (1 shl (7 - (I and $07)));
+ for I := 0 to 7 do InData[I] := NewData[I];
+end;
+
+procedure ConversePermutation(var InData: array of Byte);
+var
+ NewData: array[0..7] of Byte;
+ I: Integer;
+begin
+ FillChar(NewData, 8, 0);
+ for I := 0 to 63 do
+ if (InData[BitCP[I] shr 3] and (1 shl (7 - (BitCP[I] and $07)))) <> 0 then
+ NewData[I shr 3] := NewData[I shr 3] or (1 shl (7 - (I and $07)));
+ for I := 0 to 7 do InData[I] := NewData[I];
+end;
+
+procedure Expand(const InData: array of Byte; var OutData: array of Byte);
+var
+ I: Integer;
+begin
+ FillChar(OutData, 6, 0);
+ for I := 0 to 47 do
+ if (InData[BitExp[I] shr 3] and (1 shl (7 - (BitExp[I] and $07)))) <> 0 then
+ OutData[I shr 3] := OutData[I shr 3] or (1 shl (7 - (I and $07)));
+end;
+
+procedure Permutation(var InData: array of Byte);
+var
+ NewData: array[0..3] of Byte;
+ I: Integer;
+begin
+ FillChar(NewData, 4, 0);
+ for I := 0 to 31 do
+ if (InData[BitPM[I] shr 3] and (1 shl (7 - (BitPM[I] and $07)))) <> 0 then
+ NewData[I shr 3] := NewData[I shr 3] or (1 shl (7 - (I and $07)));
+ for I := 0 to 3 do InData[I] := NewData[I];
+end;
+
+function Si(S, InByte: Byte): Byte;
+var
+ c: Byte;
+begin
+ c := (InByte and $20) or ((InByte and $1E) shr 1) or
+ ((InByte and $01) shl 4);
+ Result := (sBox[S][c] and $0F);
+end;
+
+procedure PermutationChoose1(const InData: array of Byte; var OutData: array of Byte);
+var
+ I: Integer;
+begin
+ FillChar(OutData, 7, 0);
+ for I := 0 to 55 do
+ if (InData[BitPMC1[I] shr 3] and (1 shl (7 - (BitPMC1[I] and $07)))) <> 0 then
+ OutData[I shr 3] := OutData[I shr 3] or (1 shl (7 - (I and $07)));
+end;
+
+procedure PermutationChoose2(const InData: array of Byte; var OutData: array of Byte);
+var
+ I: Integer;
+begin
+ FillChar(OutData, 6, 0);
+ for I := 0 to 47 do
+ if (InData[BitPMC2[I] shr 3] and (1 shl (7 - (BitPMC2[I] and $07)))) <> 0 then
+ OutData[I shr 3] := OutData[I shr 3] or (1 shl (7 - (I and $07)));
+end;
+
+procedure CycleMove(var InData: array of Byte; BitMove: Byte);
+var
+ I: Integer;
+begin
+ for I := 0 to BitMove - 1 do
+ begin
+ InData[0] := Byte((InData[0] shl 1) or (InData[1] shr 7));
+ InData[1] := Byte((InData[1] shl 1) or (InData[2] shr 7));
+ InData[2] := Byte((InData[2] shl 1) or (InData[3] shr 7));
+ InData[3] := Byte((InData[3] shl 1) or ((InData[0] and $10) shr 4));
+ InData[0] := Byte((InData[0] and $0F));
+ end;
+end;
+
+procedure MakeKey(const InKey: array of Byte; var OutKey: array of TKeyByte);
+const
+ bitDisplace: array[0..15] of Byte =
+ (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
+var
+ OutData56: array[0..6] of Byte;
+ Key28l: array[0..3] of Byte;
+ Key28r: array[0..3] of Byte;
+ Key56o: array[0..6] of Byte;
+ I: Integer;
+begin
+ PermutationChoose1(InKey, OutData56);
+ Key28l[0] := Byte(OutData56[0] shr 4);
+ Key28l[1] := Byte((OutData56[0] shl 4) or (OutData56[1] shr 4));
+ Key28l[2] := Byte((OutData56[1] shl 4) or (OutData56[2] shr 4));
+ Key28l[3] := Byte((OutData56[2] shl 4) or (OutData56[3] shr 4));
+ Key28r[0] := Byte(OutData56[3] and $0F);
+ Key28r[1] := Byte(OutData56[4]);
+ Key28r[2] := Byte(OutData56[5]);
+ Key28r[3] := Byte(OutData56[6]);
+ for I := 0 to 15 do
+ begin
+ CycleMove(Key28l, bitDisplace[I]);
+ CycleMove(Key28r, bitDisplace[I]);
+ Key56o[0] := Byte((Key28l[0] shl 4) or (Key28l[1] shr 4));
+ Key56o[1] := Byte((Key28l[1] shl 4) or (Key28l[2] shr 4));
+ Key56o[2] := Byte((Key28l[2] shl 4) or (Key28l[3] shr 4));
+ Key56o[3] := Byte((Key28l[3] shl 4) or (Key28r[0]));
+ Key56o[4] := Byte(Key28r[1]);
+ Key56o[5] := Byte(Key28r[2]);
+ Key56o[6] := Byte(Key28r[3]);
+ PermutationChoose2(Key56o, OutKey[I]);
+ end;
+end;
+
+procedure Encry(const InData, ASubKey: array of Byte; var OutData: array of Byte);
+var
+ OutBuf: array[0..5] of Byte;
+ Buf: array[0..7] of Byte;
+ I: Integer;
+begin
+ Expand(InData, OutBuf);
+ for I := 0 to 5 do OutBuf[I] := OutBuf[I] xor ASubKey[I];
+ Buf[0] := OutBuf[0] shr 2;
+ Buf[1] := ((OutBuf[0] and $03) shl 4) or (OutBuf[1] shr 4);
+ Buf[2] := ((OutBuf[1] and $0F) shl 2) or (OutBuf[2] shr 6);
+ Buf[3] := OutBuf[2] and $3F;
+ Buf[4] := OutBuf[3] shr 2;
+ Buf[5] := ((OutBuf[3] and $03) shl 4) or (OutBuf[4] shr 4);
+ Buf[6] := ((OutBuf[4] and $0F) shl 2) or (OutBuf[5] shr 6);
+ Buf[7] := OutBuf[5] and $3F;
+ for I := 0 to 7 do Buf[I] := si(I, Buf[I]);
+ for I := 0 to 3 do OutBuf[I] := (Buf[I * 2] shl 4) or Buf[I * 2 + 1];
+ Permutation(OutBuf);
+ for I := 0 to 3 do OutData[I] := OutBuf[I];
+end;
+
+// InData OutData Ҫ 8 ֽ
+procedure DesData(DesMode: TDesMode; SubKey: TSubKey; const InData: array of Byte;
+ var OutData: array of Byte);
+var
+ I, J: Integer;
+ Temp, Buf: array[0..3] of Byte;
+begin
+ for I := 0 to 7 do OutData[I] := InData[I];
+ InitPermutation(OutData);
+ if DesMode = dmEncry then
+ begin
+ for I := 0 to 15 do
+ begin
+ for J := 0 to 3 do Temp[J] := OutData[J];
+ for J := 0 to 3 do OutData[J] := OutData[J + 4];
+ Encry(OutData, SubKey[I], Buf);
+ for J := 0 to 3 do OutData[J + 4] := Temp[J] xor Buf[J];
+ end;
+ for J := 0 to 3 do Temp[J] := OutData[J + 4];
+ for J := 0 to 3 do OutData[J + 4] := OutData[J];
+ for J := 0 to 3 do OutData[J] := Temp[J];
+ end
+ else if DesMode = dmDecry then
+ begin
+ for I := 15 downto 0 do
+ begin
+ for J := 0 to 3 do Temp[J] := OutData[J];
+ for J := 0 to 3 do OutData[J] := OutData[J + 4];
+ Encry(OutData, SubKey[I], Buf);
+ for J := 0 to 3 do OutData[J + 4] := Temp[J] xor Buf[J];
+ end;
+ for J := 0 to 3 do Temp[J] := OutData[J + 4];
+ for J := 0 to 3 do OutData[J + 4] := OutData[J];
+ for J := 0 to 3 do OutData[J] := Temp[J];
+ end;
+ ConversePermutation(OutData);
+end;
+
+// Key #0 ճ 8 ֽ
+procedure MakeKeyAlign(var Key: AnsiString);
+begin
+ if Length(Key) < CN_DES_KEYSIZE then
+ while Length(Key) < CN_DES_KEYSIZE do
+ Key := Key + Chr(0);
+end;
+
+// ַ #0 ճ 8 ıעմ
+procedure MakeInputAlign(var Str: AnsiString);
+begin
+ while Length(Str) mod CN_DES_KEYSIZE <> 0 do
+ Str := Str + Chr(0);
+end;
+
+// ֽ鲹 0 ճ 8 ıע鲻
+procedure MakeInputBytesAlign(var Input: TBytes);
+var
+ I, Len, NL: Integer;
+begin
+ Len := Length(Input);
+ if Len mod CN_DES_BLOCKSIZE <> 0 then
+ begin
+ NL := ((Len div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE;
+ SetLength(Input, NL);
+ for I := Len to NL - 1 do
+ Input[I] := 0;
+ end;
+end;
+
+function DESGetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+begin
+ Result := (((InputByteLength - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE;
+end;
+
+procedure DESEncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ Str: AnsiString;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ MakeKeyAlign(Key);
+
+ Str := Input;
+ MakeInputAlign(Str); // Str 8 ı
+
+ if Str = '' then // մֱӷؿ
+ begin
+ if Output <> nil then
+ Output[0] := #0;
+ Exit;
+ end;
+
+ Move(Key[1], KeyByte[0], SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ for I := 0 to Length(Str) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Str[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+ DesData(dmEncry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+procedure DESDecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ MakeKeyAlign(Key);
+ Move(Key[1], KeyByte[0], SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+ DesData(dmDecry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+
+ // ĩβ 0 ⲿжɾ
+end;
+
+procedure DESEncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ Vector: TCnDESIv;
+ Str: AnsiString;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ MakeKeyAlign(Key);
+
+ Str := Input;
+ MakeInputAlign(Str);
+
+ if Str = '' then // մֱӷؿ
+ begin
+ if Output <> nil then
+ Output[0] := #0;
+ Exit;
+ end;
+
+ Move(Key[1], KeyByte[0], SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+ Move(Iv^, Vector[0], SizeOf(TCnDESIv));
+
+ for I := 0 to Length(Str) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Str[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+
+ // CBC ݿֵȸ Iv
+ PCardinal(@StrByte[0])^ := PCardinal(@StrByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@StrByte[4])^ := PCardinal(@StrByte[4])^ xor PCardinal(@Vector[4])^;
+
+ // ټ
+ DesData(dmEncry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ܽµ Iv
+ Move(OutByte[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+procedure DESDecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ Vector, TV: TCnDESIv;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ MakeKeyAlign(Key);
+ Move(Key[1], KeyByte[0], SizeOf(TCnDESKey));
+
+ MakeKey(KeyByte, SubKey);
+ Move(Iv^, Vector[0], SizeOf(TCnDESIv));
+
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+ Move(StrByte[0], TV[0], SizeOf(TCnDESIv)); // ȴһ
+
+ // Ƚ
+ DesData(dmDecry, SubKey, StrByte, OutByte);
+
+ // CBC ݿֵܺٸ Iv
+ PCardinal(@OutByte[0])^ := PCardinal(@OutByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@OutByte[4])^ := PCardinal(@OutByte[4])^ xor PCardinal(@Vector[4])^;
+
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ĸµ Iv
+ Move(TV[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+
+ // ĩβ 0 ⲿжɾ
+end;
+
+procedure SetResultLengthUsingInput(const Str: AnsiString; var Res: AnsiString);
+var
+ Len: Integer;
+begin
+ Len := Length(Str);
+ if Len < CN_DES_BLOCKSIZE then
+ Len := CN_DES_BLOCKSIZE
+ else
+ Len := (((Len - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE;
+ SetLength(Res, Len);
+end;
+
+function DESEncryptEcbStrToHex(const Str, Key: AnsiString): AnsiString;
+var
+ TempResult: AnsiString;
+begin
+ Result := '';
+ if Str = '' then
+ Exit;
+
+ SetResultLengthUsingInput(Str, TempResult);
+ DESEncryptEcbStr(Key, Str, @TempResult[1]);
+ Result := AnsiStrToHex(TempResult);
+end;
+
+function DESDecryptEcbStrFromHex(const HexStr, Key: AnsiString): AnsiString;
+var
+ Str: AnsiString;
+begin
+ Str := HexToAnsiStr(HexStr);
+ SetResultLengthUsingInput(Str, Result);
+ DESDecryptEcbStr(Key, Str, @(Result[1]));
+end;
+
+function DESEncryptCbcStrToHex(const Str, Key, Iv: AnsiString): AnsiString;
+var
+ TempResult: AnsiString;
+begin
+ Result := '';
+ if Str = '' then
+ Exit;
+
+ SetResultLengthUsingInput(Str, TempResult);
+ DESEncryptCbcStr(Key, PAnsiChar(Iv), Str, @TempResult[1]);
+ Result := AnsiStrToHex(TempResult);
+end;
+
+function DESDecryptCbcStrFromHex(const HexStr, Key, Iv: AnsiString): AnsiString;
+var
+ Str: AnsiString;
+begin
+ Str := HexToAnsiStr(HexStr);
+ SetResultLengthUsingInput(Str, Result);
+ DESDecryptCbcStr(Key, PAnsiChar(Iv), Str, @(Result[1]));
+end;
+
+function DESEncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ MakeInputBytesAlign(Input);
+
+ FillChar(KeyByte[0], SizeOf(TCnDESKey), 0);
+ MoveMost(Key[0], KeyByte[0], Length(Key), SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+ DesData(dmEncry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+function DESDecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ FillChar(KeyByte[0], SizeOf(TCnDESKey), 0);
+ MoveMost(Key[0], KeyByte[0], Length(Key), SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+ DesData(dmDecry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+function DESEncryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ Vector: TCnDESIv;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ MakeInputBytesAlign(Input);
+
+ FillChar(KeyByte[0], SizeOf(TCnDESKey), 0);
+ MoveMost(Key[0], KeyByte[0], Length(Key), SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ FillChar(Vector[0], SizeOf(TCnDESIv), 0);
+ MoveMost(Iv[0], Vector[0], Length(Iv), SizeOf(TCnDESIv));
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+
+ // CBC ݿֵȸ Iv
+ PCardinal(@StrByte[0])^ := PCardinal(@StrByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@StrByte[4])^ := PCardinal(@StrByte[4])^ xor PCardinal(@Vector[4])^;
+
+ // ټ
+ DesData(dmEncry, SubKey, StrByte, OutByte);
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ܽµ Iv
+ Move(OutByte[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+function DESDecryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ KeyByte: TCnDESKey;
+ Vector, TV: TCnDESIv;
+ I: Integer;
+ SubKey: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ FillChar(KeyByte[0], SizeOf(TCnDESKey), 0);
+ MoveMost(Key[0], KeyByte[0], Length(Key), SizeOf(TCnDESKey));
+ MakeKey(KeyByte, SubKey);
+
+ FillChar(Vector[0], SizeOf(TCnDESIv), 0);
+ MoveMost(Iv[0], Vector[0], Length(Iv), SizeOf(TCnDESIv));
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+ Move(StrByte[0], TV[0], SizeOf(TCnDESIv)); // ȴһ
+
+ // Ƚ
+ DesData(dmDecry, SubKey, StrByte, OutByte);
+
+ // CBC ݿֵܺٸ Iv
+ PCardinal(@OutByte[0])^ := PCardinal(@OutByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@OutByte[4])^ := PCardinal(@OutByte[4])^ xor PCardinal(@Vector[4])^;
+
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ĸµ Iv
+ Move(TV[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+procedure DESEncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; Dest: TStream); overload;
+var
+ TempIn, TempOut: TCnDESBuffer;
+ Done: Cardinal;
+ SubKey: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ MakeKey(Key, SubKey);
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ DesData(dmEncry, SubKey, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+
+ if Count > 0 then // β 0
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorDESReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ DesData(dmEncry, SubKey, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+ end;
+end;
+
+procedure DESDecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; Dest: TStream); overload;
+var
+ TempIn, TempOut: TCnDESBuffer;
+ Done: Cardinal;
+ SubKey: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnDESBuffer)) > 0 then
+ raise ECnDESException.Create(SCnErrorDESInvalidInBufSize);
+
+ MakeKey(Key, SubKey);
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ DesData(dmDecry, SubKey, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+end;
+
+procedure DESEncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+var
+ TempIn, TempOut: TCnDESBuffer;
+ Vector: TCnDESIv;
+ Done: Cardinal;
+ SubKey: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ MakeKey(Key, SubKey);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+
+ DesData(dmEncry, SubKey, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Move(TempOut[0], Vector[0], SizeOf(TCnDESIv));
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorDESReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+
+ DesData(dmEncry, SubKey, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+ end;
+end;
+
+procedure DESDecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnDESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+var
+ TempIn, TempOut: TCnDESBuffer;
+ Vector1, Vector2: TCnDESIv;
+ Done: Cardinal;
+ SubKey: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnDESBuffer)) > 0 then
+ raise ECnDESException.Create(SCnErrorDESInvalidInBufSize);
+
+ Vector1 := InitVector;
+ MakeKey(Key, SubKey);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorDESReadError);
+
+ Move(TempIn[0], Vector2[0], SizeOf(TCnDESIv));
+ DesData(dmDecry, SubKey, TempIn, TempOut);
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorDESWriteError);
+
+ Vector1 := Vector2;
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+end;
+
+procedure Make3DESKeys(Keys: AnsiString; var K1, K2, K3: TCnDESKey); overload;
+var
+ I: Integer;
+begin
+ if Length(Keys) < CN_TRIPLE_DES_KEYSIZE then
+ while Length(Keys) < CN_TRIPLE_DES_KEYSIZE do
+ Keys := Keys + Chr(0);
+
+ for I := 0 to CN_DES_KEYSIZE - 1 do
+ begin
+ K1[I] := Ord(Keys[I + 1]);
+ K2[I] := Ord(Keys[I + 1 + CN_DES_KEYSIZE]);
+ K3[I] := Ord(Keys[I + 1 + CN_DES_KEYSIZE * 2]);
+ end;
+end;
+
+procedure Make3DESKeys(Keys: TCn3DESKey; var K1, K2, K3: TCnDESKey); overload;
+var
+ I: Integer;
+begin
+ for I := 0 to CN_DES_KEYSIZE - 1 do
+ begin
+ K1[I] := Keys[I];
+ K2[I] := Keys[I + CN_DES_KEYSIZE];
+ K3[I] := Keys[I + CN_DES_KEYSIZE * 2];
+ end;
+end;
+
+procedure Make3DESKeys(Keys: TBytes; var K1, K2, K3: TCnDESKey); overload;
+var
+ I, Len: Integer;
+begin
+ Len := Length(Keys);
+ if Len < CN_TRIPLE_DES_KEYSIZE then
+ begin
+ SetLength(Keys, CN_TRIPLE_DES_KEYSIZE);
+ for I := Len to CN_TRIPLE_DES_KEYSIZE - 1 do
+ Keys[I] := 0;
+ end;
+
+ for I := 0 to CN_DES_KEYSIZE - 1 do
+ begin
+ K1[I] := Ord(Keys[I]);
+ K2[I] := Ord(Keys[I + CN_DES_KEYSIZE]);
+ K3[I] := Ord(Keys[I + CN_DES_KEYSIZE * 2]);
+ end;
+end;
+
+function TripleDESGetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+begin
+ Result := (((InputByteLength - 1) div CN_TRIPLE_DES_BLOCKSIZE) + 1) * CN_TRIPLE_DES_BLOCKSIZE;
+end;
+
+procedure TripleDESEncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ Str: AnsiString;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ Str := Input;
+ MakeInputAlign(Str);
+
+ if Str = '' then // մֱӷؿ
+ begin
+ if Output <> nil then
+ Output[0] := #0;
+ Exit;
+ end;
+
+ for I := 0 to Length(Str) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Str[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+
+ DesData(dmEncry, SubKey1, StrByte, OutByte);
+ DesData(dmDecry, SubKey2, OutByte, StrByte);
+ DesData(dmEncry, SubKey3, StrByte, OutByte);
+
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+procedure TripleDESDecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+
+ DesData(dmDecry, SubKey3, StrByte, OutByte);
+ DesData(dmEncry, SubKey2, OutByte, StrByte);
+ DesData(dmDecry, SubKey1, StrByte, OutByte);
+
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+
+ // ĩβ 0 ⲿжɾ
+end;
+
+procedure TripleDESEncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ Vector: TCnDESIv;
+ Str: AnsiString;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ Str := Input;
+ MakeInputAlign(Str);
+
+ if Str = '' then // մֱӷؿ
+ begin
+ if Output <> nil then
+ Output[0] := #0;
+ Exit;
+ end;
+
+ Move(Iv^, Vector[0], SizeOf(TCnDESIv));
+
+ for I := 0 to Length(Str) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Str[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+
+ // CBC ݿֵȸ Iv
+ PCardinal(@StrByte[0])^ := PCardinal(@StrByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@StrByte[4])^ := PCardinal(@StrByte[4])^ xor PCardinal(@Vector[4])^;
+
+ // ټ
+ DesData(dmEncry, SubKey1, StrByte, OutByte);
+ DesData(dmDecry, SubKey2, OutByte, StrByte);
+ DesData(dmEncry, SubKey3, StrByte, OutByte);
+
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ܽµ Iv
+ Move(OutByte[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+procedure TripleDESDecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ Vector, TV: TCnDESIv;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ Move(Iv^, Vector[0], SizeOf(TCnDESIv));
+
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE + 1], StrByte[0], SizeOf(TCnDESBuffer));
+ Move(StrByte[0], TV[0], SizeOf(TCnDESIv)); // ȴһ
+
+ // Ƚ
+ DesData(dmDecry, SubKey3, StrByte, OutByte);
+ DesData(dmEncry, SubKey2, OutByte, StrByte);
+ DesData(dmDecry, SubKey1, StrByte, OutByte);
+
+ // CBC ݿֵܺٸ Iv
+ PCardinal(@OutByte[0])^ := PCardinal(@OutByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@OutByte[4])^ := PCardinal(@OutByte[4])^ xor PCardinal(@Vector[4])^;
+
+ Move(OutByte[0], Output[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ĸµ Iv
+ Move(TV[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+
+ // ĩβ 0 ⲿжɾ
+end;
+
+function TripleDESEncryptEcbStrToHex(const Str, Key: AnsiString): AnsiString;
+var
+ TempResult, Temp: AnsiString;
+ I: Integer;
+begin
+ SetResultLengthUsingInput(Str, TempResult);
+ TripleDESEncryptEcbStr(Key, Str, @TempResult[1]);
+
+ Result := '';
+ for I := 0 to Length(TempResult) - 1 do
+ begin
+ Temp := AnsiString(Format('%x', [Ord(TempResult[I + 1])]));
+ if Length(Temp) = 1 then
+ Temp := '0' + Temp;
+ Result := Result + Temp;
+ end;
+end;
+
+function TripleDESDecryptEcbStrFromHex(const HexStr, Key: AnsiString): AnsiString;
+var
+ Str: AnsiString;
+begin
+ Str := HexToAnsiStr(HexStr);
+ SetResultLengthUsingInput(Str, Result);
+ TripleDESDecryptEcbStr(Key, Str, @(Result[1]));
+end;
+
+function TripleDESEncryptCbcStrToHex(const Str, Key, Iv: AnsiString): AnsiString;
+var
+ TempResult, Temp: AnsiString;
+ I: Integer;
+begin
+ SetResultLengthUsingInput(Str, TempResult);
+ TripleDESEncryptCbcStr(Key, PAnsiChar(Iv), Str, @TempResult[1]);
+
+ Result := '';
+ for I := 0 to Length(TempResult) - 1 do
+ begin
+ Temp := AnsiString(Format('%x', [Ord(TempResult[I + 1])]));
+ if Length(Temp) = 1 then
+ Temp := '0' + Temp;
+ Result := Result + Temp;
+ end;
+end;
+
+function TripleDESDecryptCbcStrFromHex(const HexStr, Key, Iv: AnsiString): AnsiString;
+var
+ Str: AnsiString;
+begin
+ Str := HexToAnsiStr(HexStr);
+ SetResultLengthUsingInput(Str, Result);
+ TripleDESDecryptCbcStr(Key, PAnsiChar(Iv), Str, @(Result[1]));
+end;
+
+function TripleDESEncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ MakeInputBytesAlign(Input);
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+
+ DesData(dmEncry, SubKey1, StrByte, OutByte);
+ DesData(dmDecry, SubKey2, OutByte, StrByte);
+ DesData(dmEncry, SubKey3, StrByte, OutByte);
+
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+function TripleDESDecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+
+ DesData(dmDecry, SubKey3, StrByte, OutByte);
+ DesData(dmEncry, SubKey2, OutByte, StrByte);
+ DesData(dmDecry, SubKey1, StrByte, OutByte);
+
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+ end;
+end;
+
+function TripleDESEncryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ Vector: TCnDESIv;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ MakeInputBytesAlign(Input);
+ FillChar(Vector[0], SizeOf(TCnDESIv), 0);
+ MoveMost(Iv[0], Vector[0], Length(Iv), SizeOf(TCnDESIv));
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+
+ // CBC ݿֵȸ Iv
+ PCardinal(@StrByte[0])^ := PCardinal(@StrByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@StrByte[4])^ := PCardinal(@StrByte[4])^ xor PCardinal(@Vector[4])^;
+
+ // ټ
+ DesData(dmEncry, SubKey1, StrByte, OutByte);
+ DesData(dmDecry, SubKey2, OutByte, StrByte);
+ DesData(dmEncry, SubKey3, StrByte, OutByte);
+
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ܽµ Iv
+ Move(OutByte[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+function TripleDESDecryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+var
+ StrByte, OutByte: TCnDESBuffer;
+ K1, K2, K3: TCnDESKey;
+ Vector, TV: TCnDESIv;
+ I: Integer;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Length(Input) <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ FillChar(Vector[0], SizeOf(TCnDESIv), 0);
+ MoveMost(Iv[0], Vector[0], Length(Iv), SizeOf(TCnDESIv));
+
+ SetLength(Result, (((Length(Input) - 1) div CN_DES_BLOCKSIZE) + 1) * CN_DES_BLOCKSIZE);
+ for I := 0 to Length(Input) div CN_DES_BLOCKSIZE - 1 do
+ begin
+ Move(Input[I * CN_DES_BLOCKSIZE], StrByte[0], SizeOf(TCnDESBuffer));
+ Move(StrByte[0], TV[0], SizeOf(TCnDESIv)); // ȴһ
+
+ // Ƚ
+ DesData(dmDecry, SubKey3, StrByte, OutByte);
+ DesData(dmEncry, SubKey2, OutByte, StrByte);
+ DesData(dmDecry, SubKey1, StrByte, OutByte);
+
+ // CBC ݿֵܺٸ Iv
+ PCardinal(@OutByte[0])^ := PCardinal(@OutByte[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@OutByte[4])^ := PCardinal(@OutByte[4])^ xor PCardinal(@Vector[4])^;
+
+ Move(OutByte[0], Result[I * CN_DES_BLOCKSIZE], SizeOf(TCnDESBuffer));
+
+ // ĸµ Iv
+ Move(TV[0], Vector[0], SizeOf(TCnDESIv));
+ end;
+end;
+
+procedure TripleDESEncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; Dest: TStream); overload;
+var
+ K1, K2, K3: TCnDESKey;
+ TempIn, TempOut: TCnDESBuffer;
+ Done: Cardinal;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ DesData(dmEncry, SubKey1, TempIn, TempOut);
+ DesData(dmDecry, SubKey2, TempOut, TempIn);
+ DesData(dmEncry, SubKey3, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+
+ if Count > 0 then // β 0
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorDESReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ DesData(dmEncry, SubKey1, TempIn, TempOut);
+ DesData(dmDecry, SubKey2, TempOut, TempIn);
+ DesData(dmEncry, SubKey3, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+ end;
+end;
+
+procedure TripleDESDecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; Dest: TStream); overload;
+var
+ K1, K2, K3: TCnDESKey;
+ TempIn, TempOut: TCnDESBuffer;
+ Done: Cardinal;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnDESBuffer)) > 0 then
+ raise ECnDESException.Create(SCnErrorDESInvalidInBufSize);
+
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ DesData(dmDecry, SubKey3, TempIn, TempOut);
+ DesData(dmEncry, SubKey2, TempOut, TempIn);
+ DesData(dmDecry, SubKey1, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+end;
+
+procedure TripleDESEncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+var
+ K1, K2, K3: TCnDESKey;
+ TempIn, TempOut: TCnDESBuffer;
+ Vector: TCnDESIv;
+ Done: Cardinal;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorDESReadError);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+
+ DesData(dmEncry, SubKey1, TempIn, TempOut);
+ DesData(dmDecry, SubKey2, TempOut, TempIn);
+ DesData(dmEncry, SubKey3, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+
+ Move(TempOut[0], Vector[0], SizeOf(TCnDESIv));
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorDESReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+
+ DesData(dmEncry, SubKey1, TempIn, TempOut);
+ DesData(dmDecry, SubKey2, TempOut, TempIn);
+ DesData(dmEncry, SubKey3, TempIn, TempOut);
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorDESWriteError);
+ end;
+end;
+
+procedure TripleDESDecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCn3DESKey; const InitVector: TCnDESIv; Dest: TStream); overload;
+var
+ K1, K2, K3: TCnDESKey;
+ TempIn, TempOut: TCnDESBuffer;
+ Vector1, Vector2: TCnDESIv;
+ Done: Cardinal;
+ SubKey1, SubKey2, SubKey3: TSubKey;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnDESBuffer)) > 0 then
+ raise ECnDESException.Create(SCnErrorDESInvalidInBufSize);
+
+ Vector1 := InitVector;
+ Make3DESKeys(Key, K1, K2, K3);
+ MakeKey(K1, SubKey1);
+ MakeKey(K2, SubKey2);
+ MakeKey(K3, SubKey3);
+
+ while Count >= SizeOf(TCnDESBuffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorDESReadError);
+
+ Move(TempIn[0], Vector2[0], SizeOf(TCnDESIv));
+
+ DesData(dmDecry, SubKey3, TempIn, TempOut);
+ DesData(dmEncry, SubKey2, TempOut, TempIn);
+ DesData(dmDecry, SubKey1, TempIn, TempOut);
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorDESWriteError);
+
+ Vector1 := Vector2;
+ Dec(Count, SizeOf(TCnDESBuffer));
+ end;
+end;
+
+end.
diff --git a/CnPack/Crypto/CnKDF.pas b/CnPack/Crypto/CnKDF.pas
new file mode 100644
index 0000000..b361ec5
--- /dev/null
+++ b/CnPack/Crypto/CnKDF.pas
@@ -0,0 +1,804 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnKDF;
+{* |
+================================================================================
+* ƣ
+* ԪƣԿ㷨KDFԪ
+* ԪߣCnPack (master@cnpack.org)
+* עԪʵ˻ RFC2898 PBKDF1 PBKDF2 Կ㷨 PBKDF1 ֧ MD2 㷨
+* ͬʱҲʵ˻ RFC5869 HKDF HMac Կ㷨
+* SM2/SM9 㷨й涨㷨
+* ƽ̨WinXP + Delphi 5.0
+* ݲԣδ
+* õԪ豾ػ
+* ļ¼2025.01.09 V1.5
+* HKDF ʵֺ
+* 2022.06.21 V1.4
+* ϲһֽ CnSM2SM9KDF AnsiString ڸ߰汾 Delphi ¿
+* 2022.04.26 V1.3
+* LongWord Integer ַת֧ MacOS64
+* 2022.01.02 V1.2
+* CnPBKDF2 һԼ Unicode µļ
+* 2021.11.25 V1.1
+* CnSM2KDF Unicode µļ
+* 2020.03.30 V1.0
+* Ԫ CnPemUtils ж
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes, CnNative, CnMD5, CnSHA1, CnSHA2, CnSHA3, CnSM3;
+
+type
+ TCnKeyDeriveHash = (ckdMd5, ckdSha256, ckdSha1);
+ {* CnGetDeriveKey ʹõӴշ}
+
+ TCnPBKDF1KeyHash = (cpdfMd2, cpdfMd5, cpdfSha1);
+ {* PBKDF1 涨Ӵշ MD2 Dz֧}
+
+ TCnPBKDF2KeyHash = (cpdfSha1Hmac, cpdfSha256Hmac);
+ {* PBKDF2 涨Ӵշ}
+
+ TCnHKDFHash = (chkMd5, chkSha1, chkSha256, chkSha3_256, chkSm3);
+ {* HKDFHMAC-based Key Derivation Functionֵ֧Ӵ}
+
+ ECnKDFException = class(Exception);
+ {* KDF 쳣}
+
+function CnGetDeriveKey(const Password: AnsiString; const Salt: AnsiString;
+ OutKey: PAnsiChar; KeyLength: Cardinal; KeyHash: TCnKeyDeriveHash = ckdMd5): Boolean;
+{* Openssl е BytesToKeyָӴ㷨ɼ Key
+ Ŀǰ KeyLength ֧ HashҲ MD5 32 ֽڣSHA256 64 ֽڡ
+
+
+ const Password: AnsiString -
+ const Salt: AnsiString - ֵ
+ OutKey: PAnsiChar - Կݿַ
+ KeyLength: Cardinal - Կݿֽڳ
+ KeyHash: TCnKeyDeriveHash - Ӵ㷨
+
+ ֵBoolean - Ƿɳɹ
+}
+
+function CnPBKDF1(const Password: AnsiString; const Salt: AnsiString; Count: Integer;
+ DerivedKeyByteLength: Integer; KeyHash: TCnPBKDF1KeyHash = cpdfMd5): AnsiString;
+{* Password Based KDF 1 ʵ֣Ĺ̶Ӵյֻ֧ MD5 SHA1뷵ֵΪ AnsiString
+ DerivedKeyByteLength Կֽȹ̶
+
+
+ const Password: AnsiString -
+ const Salt: AnsiString - ֵ
+ Count: Integer -
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+ KeyHash: TCnPBKDF1KeyHash - Ӵ㷨
+
+ ֵAnsiString - ɵԿ
+}
+
+function CnPBKDF2(const Password: AnsiString; const Salt: AnsiString; Count: Integer;
+ DerivedKeyByteLength: Integer; KeyHash: TCnPBKDF2KeyHash = cpdfSha1Hmac): AnsiString;
+{* Password Based KDF 2 ʵ֣ HMAC-SHA1 HMAC-SHA256뷵ֵΪ AnsiString
+ DerivedKeyByteLength Կֽȿɱ䣬
+
+
+ const Password: AnsiString -
+ const Salt: AnsiString - ֵ
+ Count: Integer -
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+ KeyHash: TCnPBKDF2KeyHash - Ӵ㷨
+
+ ֵAnsiString - ɵԿ
+}
+
+function CnPBKDF1Bytes(const Password: TBytes; const Salt: TBytes; Count: Integer;
+ DerivedKeyByteLength: Integer; KeyHash: TCnPBKDF1KeyHash = cpdfMd5): TBytes;
+{* Password Based KDF 1 ʵ֣Ĺ̶Ӵյֻ֧ MD5 SHA1뷵ֵΪֽ顣
+ DerivedKeyByteLength Կֽȹ̶
+
+
+ const Password: TBytes -
+ const Salt: TBytes - ֵ
+ Count: Integer -
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+ KeyHash: TCnPBKDF1KeyHash - Ӵ㷨
+
+ ֵTBytes - ɵԿ
+}
+
+function CnPBKDF2Bytes(const Password: TBytes; const Salt: TBytes; Count: Integer;
+ DerivedKeyByteLength: Integer; KeyHash: TCnPBKDF2KeyHash = cpdfSha1Hmac): TBytes;
+{* Password Based KDF 2 ʵ֣ HMAC-SHA1 HMAC-SHA256뷵ֵΪֽ顣
+ DerivedKeyByteLength Կֽȿɱ䣬
+
+
+ const Password: TBytes -
+ const Salt: TBytes - ֵ
+ Count: Integer -
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+ KeyHash: TCnPBKDF2KeyHash - Ӵ㷨
+
+ ֵTBytes - ɵԿ
+}
+
+// ============ SM2/SM9 й涨ͬһԿַװʵ ===============
+
+function CnSM2KDF(const Data: AnsiString; DerivedKeyByteLength: Integer): AnsiString;
+{* SM2 Բ߹Կ㷨й涨ԿDerivedKeyLength Կֽ
+ AnsiStringͬʱƺҲû SharedInfo ANSI-X9.63-KDF
+
+
+ const Data: AnsiString - Կԭʼݣ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵAnsiString - ɵԿ
+}
+
+function CnSM9KDF(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): AnsiString;
+{* SM9 ʶ㷨й涨ԿDerivedKeyLength Կֽ
+ AnsiStringͬʱƺҲû SharedInfo ANSI-X9.63-KDF
+
+
+ Data: Pointer - Կԭʼݿַ
+ DataByteLen: Integer - Կԭʼݵֽڳ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵAnsiString - ɵԿ
+}
+
+function CnSM2KDFBytes(const Data: TBytes; DerivedKeyByteLength: Integer): TBytes;
+{* Ϊֽʽ SM2 Բ߹Կ㷨й涨Կ
+ DerivedKeyLength Կֽɵֽ顣
+
+
+ const Data: TBytes - Կԭʼݵֽ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+function CnSM9KDFBytes(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): TBytes;
+{* Ϊڴʽ SM9 ʶ㷨й涨Կ
+ DerivedKeyLength Կֽɵֽ顣
+
+
+ Data: Pointer - Կԭʼݿַ
+ DataByteLen: Integer - Կԭʼݵֽڳ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+function CnSM2SM9KDF(Data: TBytes; DerivedKeyByteLength: Integer): TBytes; overload;
+{* Ϊֽʽ SM2 Բ߹Կ㷨 SM9 ʶ㷨й涨Կ
+ DerivedKeyLength ԿֽɵԿֽ顣
+
+
+ Data: TBytes - Կԭʼݵֽ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+function CnSM2SM9KDF(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): TBytes; overload;
+{* Ϊڴʽ SM2 Բ߹Կ㷨 SM9 ʶ㷨й涨Կ
+ DerivedKeyLength ԿֽԿֽ顣
+
+
+ Data: Pointer - Կԭʼݿַ
+ DataByteLen: Integer - Կԭʼݵֽڳ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+function CnHKDF(HKDF: TCnHKDFHash; IKM: Pointer; IKMByteLen: Integer;
+ Salt: Pointer; SaltByteLen: Integer; Info: Pointer; InfoByteLen: Integer;
+ DerivedKeyByteLength: Integer): TBytes; overload;
+{* HMAC KDF Կ IKMSalt InfoָȵԿ
+ Salt Ϊգڲʹù̶Ӵսȵȫ 0Info ΪաɵԿ
+
+
+ HKDF: TCnHKDFHash - Ӵ㷨
+ IKM: Pointer - ԿݣInput Keying Materialַ
+ IKMByteLen: Integer - Կݵֽڳ
+ Salt: Pointer - Կֵݿַ
+ SaltByteLen: Integer - Կֵݵֽڳ
+ Info: Pointer - ԿĿѡϢݿַ
+ InfoByteLen: Integer - ԿĿѡϢݵֽڳ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+function CnHKDFBytes(HKDF: TCnHKDFHash; IKM: TBytes; Salt: TBytes; Info: TBytes;
+ DerivedKeyByteLength: Integer): TBytes; overload;
+{* HMAC KDF Կ IKMSalt Info ֽ飬ָȵԿ
+ Salt Ϊգڲʹù̶Ӵսȵȫ 0Info ΪաɵԿ
+
+ HKDF: TCnHKDFHash - Ӵ㷨
+ IKM: TBytes - Կ
+ Salt: TBytes - Կֵ
+ Info: TBytes - ԿĿѡϢ
+ DerivedKeyByteLength: Integer - ɵԿֽڳ
+
+ ֵTBytes - ɵԿ
+}
+
+implementation
+
+resourcestring
+ SCnErrorKDFKeyTooLong = 'Derived Key Too Long.';
+ SCnErrorKDFParam = 'Invalid Parameters.';
+ SCnErrorKDFHashNOTSupport = 'Hash Method NOT Support.';
+
+function Min(A, B: Integer): Integer; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+function CnGetDeriveKey(const Password, Salt: AnsiString; OutKey: PAnsiChar; KeyLength: Cardinal;
+ KeyHash: TCnKeyDeriveHash): Boolean;
+var
+ Md5Dig, Md5Dig2: TCnMD5Digest;
+ Sha256Dig, Sha256Dig2: TCnSHA256Digest;
+ SaltBuf, PS, PSMD5, PSSHA256: AnsiString;
+begin
+ Result := False;
+
+ if (Password = '') or (OutKey = nil) or (KeyLength < 8) then
+ Exit;
+
+ SetLength(SaltBuf, 8);
+ FillChar(SaltBuf[1], Length(SaltBuf), 0);
+ if Salt <> '' then
+ Move(Salt[1], SaltBuf[1], Min(Length(Salt), 8));
+
+ if not (KeyHash in [ckdMd5, ckdSha256]) then
+ raise ECnKDFException.Create(SCnErrorKDFHashNOTSupport);
+
+ PS := AnsiString(Password) + SaltBuf; // 涨ǰ 8 ֽΪ Salt
+ if KeyHash = ckdMd5 then
+ begin
+ SetLength(PSMD5, SizeOf(TCnMD5Digest) + Length(PS));
+ Move(PS[1], PSMD5[SizeOf(TCnMD5Digest) + 1], Length(PS));
+ Md5Dig := MD5StringA(PS);
+ // Salt ƴ MD5 16 ByteΪһ
+
+ Move(Md5Dig[0], OutKey^, Min(KeyLength, SizeOf(TCnMD5Digest)));
+ if KeyLength <= SizeOf(TCnMD5Digest) then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ KeyLength := KeyLength - SizeOf(TCnMD5Digest);
+ OutKey := PAnsiChar(TCnNativeUInt(OutKey) + SizeOf(TCnMD5Digest));
+
+ Move(Md5Dig[0], PSMD5[1], SizeOf(TCnMD5Digest));
+ Md5Dig2 := MD5StringA(PSMD5);
+ Move(Md5Dig2[0], OutKey^, Min(KeyLength, SizeOf(TCnMD5Digest)));
+ if KeyLength <= SizeOf(TCnMD5Digest) then
+ Result := True;
+
+ // KeyLength ̫㲻
+ end
+ else if KeyHash = ckdSha256 then
+ begin
+ SetLength(PSSHA256, SizeOf(TCnSHA256Digest) + Length(PS));
+ Move(PS[1], PSSHA256[SizeOf(TCnSHA256Digest) + 1], Length(PS));
+ Sha256Dig := SHA256StringA(PS);
+ // Salt ƴ SHA256 32 ByteΪһ
+
+ Move(Sha256Dig[0], OutKey^, Min(KeyLength, SizeOf(TCnSHA256Digest)));
+ if KeyLength <= SizeOf(TCnSHA256Digest) then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ KeyLength := KeyLength - SizeOf(TCnSHA256Digest);
+ OutKey := PAnsiChar(TCnNativeUInt(OutKey) + SizeOf(TCnSHA256Digest));
+
+ Move(Sha256Dig[0], PSSHA256[1], SizeOf(TCnSHA256Digest));
+ Sha256Dig2 := SHA256StringA(PSSHA256);
+ Move(Sha256Dig2[0], OutKey^, Min(KeyLength, SizeOf(TCnSHA256Digest)));
+ if KeyLength <= SizeOf(TCnSHA256Digest) then
+ Result := True;
+
+ // KeyLength ̫㲻
+ end;
+end;
+
+(*
+ T_1 = Hash (P || S) ,
+ T_2 = Hash (T_1) ,
+ ...
+ T_c = Hash (T_{c-1}) ,
+ DK = Tc<0..dkLen-1>
+*)
+function CnPBKDF1(const Password, Salt: AnsiString; Count, DerivedKeyByteLength: Integer;
+ KeyHash: TCnPBKDF1KeyHash): AnsiString;
+var
+ P, S, Res: TBytes;
+begin
+ P := AnsiToBytes(Password);
+ S := AnsiToBytes(Salt);
+ Res := CnPBKDF1Bytes(P, S, Count, DerivedKeyByteLength, KeyHash);
+ Result := BytesToAnsi(Res);
+end;
+
+{
+ DK = T1 + T2 + ... + Tdklen/hlen
+ Ti = F(Password, Salt, c, i)
+
+ F(Password, Salt, c, i) = U1 ^ U2 ^ ... ^ Uc
+
+ U1 = PRF(Password, Salt + INT_32_BE(i))
+ U2 = PRF(Password, U1)
+ ...
+ Uc = PRF(Password, Uc-1)
+}
+function CnPBKDF2(const Password, Salt: AnsiString; Count, DerivedKeyByteLength: Integer;
+ KeyHash: TCnPBKDF2KeyHash): AnsiString;
+var
+ P, S, Res: TBytes;
+begin
+ P := AnsiToBytes(Password);
+ S := AnsiToBytes(Salt);
+ Res := CnPBKDF2Bytes(P, S, Count, DerivedKeyByteLength, KeyHash);
+ Result := BytesToAnsi(Res);
+end;
+
+function CnPBKDF1Bytes(const Password, Salt: TBytes; Count, DerivedKeyByteLength: Integer;
+ KeyHash: TCnPBKDF1KeyHash = cpdfMd5): TBytes;
+var
+ I: Integer;
+ Md5Dig, TM: TCnMD5Digest;
+ Sha1Dig, TS: TCnSHA1Digest;
+begin
+ Result := nil;
+ if (Password = nil) or (Count <= 0) or (DerivedKeyByteLength <= 0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ case KeyHash of
+ cpdfMd5:
+ begin
+ if DerivedKeyByteLength > SizeOf(TCnMD5Digest) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ SetLength(Result, DerivedKeyByteLength);
+ Md5Dig := MD5Bytes(ConcatBytes(Password, Salt)); // Got T1
+ if Count > 1 then
+ begin
+ for I := 2 to Count do
+ begin
+ TM := Md5Dig;
+ Md5Dig := MD5Buffer(TM[0], SizeOf(TCnMD5Digest)); // Got T_c
+ end;
+ end;
+
+ Move(Md5Dig[0], Result[0], DerivedKeyByteLength);
+ end;
+ cpdfSha1:
+ begin
+ if DerivedKeyByteLength > SizeOf(TCnSHA1Digest) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ SetLength(Result, DerivedKeyByteLength);
+ Sha1Dig := SHA1Bytes(ConcatBytes(Password, Salt)); // Got T1
+ if Count > 1 then
+ begin
+ for I := 2 to Count do
+ begin
+ TS := Sha1Dig;
+ Sha1Dig := SHA1Buffer(TS[0], SizeOf(TCnSHA1Digest)); // Got T_c
+ end;
+ end;
+
+ Move(Sha1Dig[0], Result[0], DerivedKeyByteLength);
+ end;
+ else
+ raise ECnKDFException.Create(SCnErrorKDFHashNOTSupport);
+ end;
+end;
+
+function CnPBKDF2Bytes(const Password, Salt: TBytes; Count, DerivedKeyByteLength: Integer;
+ KeyHash: TCnPBKDF2KeyHash = cpdfSha1Hmac): TBytes;
+var
+ HLen, D, I, J, K: Integer;
+ Sha1Dig1, Sha1Dig, T1: TCnSHA1Digest;
+ Sha256Dig1, Sha256Dig, T256: TCnSHA256Digest;
+ S, S1, S256, Pad: TBytes;
+ PAddr: Pointer;
+begin
+ Result := nil;
+ if (Salt = nil) or (Count <= 0) or (DerivedKeyByteLength <=0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ if (Password = nil) or (Length(Password) = 0) then
+ PAddr := nil
+ else
+ PAddr := @Password[0];
+
+ case KeyHash of
+ cpdfSha1Hmac:
+ HLen := 20;
+ cpdfSha256Hmac:
+ HLen := 32;
+ else
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+ end;
+
+ D := (DerivedKeyByteLength div HLen) + 1;
+ SetLength(S1, SizeOf(TCnSHA1Digest));
+ SetLength(S256, SizeOf(TCnSHA256Digest));
+
+ SetLength(Pad, 4);
+ if KeyHash = cpdfSha1Hmac then
+ begin
+ for I := 1 to D do
+ begin
+ Pad[0] := I shr 24;
+ Pad[1] := I shr 16;
+ Pad[2] := I shr 8;
+ Pad[3] := I;
+ S := ConcatBytes(Salt, Pad);
+
+ SHA1Hmac(PAddr, Length(Password), PAnsiChar(@S[0]), Length(S), Sha1Dig1);
+ T1 := Sha1Dig1;
+
+ for J := 2 to Count do
+ begin
+ SHA1Hmac(PAddr, Length(Password), PAnsiChar(@T1[0]), SizeOf(TCnSHA1Digest), Sha1Dig);
+ T1 := Sha1Dig;
+ for K := Low(TCnSHA1Digest) to High(TCnSHA1Digest) do
+ Sha1Dig1[K] := Sha1Dig1[K] xor T1[K];
+ end;
+
+ Move(Sha1Dig1[0], S1[0], Length(S1));
+ Result := ConcatBytes(Result, S1);
+ end;
+ Result := Copy(Result, 0, DerivedKeyByteLength);
+ end
+ else if KeyHash = cpdfSha256Hmac then
+ begin
+ for I := 1 to D do
+ begin
+ Pad[0] := I shr 24;
+ Pad[1] := I shr 16;
+ Pad[2] := I shr 8;
+ Pad[3] := I;
+ S := ConcatBytes(Salt, Pad);
+
+ SHA256Hmac(PAddr, Length(Password), PAnsiChar(@S[0]), Length(S), Sha256Dig1);
+ T256 := Sha256Dig1;
+
+ for J := 2 to Count do
+ begin
+ SHA256Hmac(PAddr, Length(Password), PAnsiChar(@T256[0]), SizeOf(TCnSHA256Digest), Sha256Dig);
+ T256 := Sha256Dig;
+ for K := Low(TCnSHA256Digest) to High(TCnSHA256Digest) do
+ Sha256Dig1[K] := Sha256Dig1[K] xor T256[K];
+ end;
+
+ Move(Sha256Dig1[0], S256[0], SizeOf(TCnSHA256Digest));
+ Result := ConcatBytes(Result, S256);
+ end;
+ Result := Copy(Result, 0, DerivedKeyByteLength);
+ end;
+end;
+
+function CnSM2KDF(const Data: AnsiString; DerivedKeyByteLength: Integer): AnsiString;
+var
+ Res: TBytes;
+begin
+ if (Data = '') or (DerivedKeyByteLength <= 0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ Res := CnSM2SM9KDF(@Data[1], Length(Data), DerivedKeyByteLength);
+ Result := BytesToAnsi(Res);
+end;
+
+function CnSM9KDF(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): AnsiString;
+var
+ Res: TBytes;
+begin
+ Res := CnSM2SM9KDF(Data, DataByteLen, DerivedKeyByteLength);
+ Result := BytesToAnsi(Res);
+end;
+
+function CnSM2KDFBytes(const Data: TBytes; DerivedKeyByteLength: Integer): TBytes;
+begin
+ Result := CnSM2SM9KDF(Data, DerivedKeyByteLength);
+end;
+
+function CnSM9KDFBytes(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): TBytes;
+begin
+ Result := CnSM2SM9KDF(Data, DataByteLen, DerivedKeyByteLength);
+end;
+
+function CnSM2SM9KDF(Data: TBytes; DerivedKeyByteLength: Integer): TBytes;
+begin
+ if (Data = nil) or (Length(Data) <= 0) or (DerivedKeyByteLength <= 0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ Result := CnSM2SM9KDF(@Data[0], Length(Data), DerivedKeyByteLength);
+end;
+
+function CnSM2SM9KDF(Data: Pointer; DataByteLen: Integer; DerivedKeyByteLength: Integer): TBytes; overload;
+var
+ DArr: TBytes;
+ CT, SCT: Cardinal;
+ I, CeilLen: Integer;
+ IsInt: Boolean;
+ SM3D: TCnSM3Digest;
+begin
+ Result := nil;
+ if (Data = nil) or (DataByteLen <= 0) or (DerivedKeyByteLength <= 0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ DArr := nil;
+ CT := 1;
+
+ try
+ SetLength(DArr, DataByteLen + SizeOf(Cardinal));
+ Move(Data^, DArr[0], DataByteLen);
+
+ IsInt := DerivedKeyByteLength mod SizeOf(TCnSM3Digest) = 0;
+ CeilLen := (DerivedKeyByteLength + SizeOf(TCnSM3Digest) - 1) div SizeOf(TCnSM3Digest);
+
+ SetLength(Result, DerivedKeyByteLength);
+ for I := 1 to CeilLen do
+ begin
+ SCT := UInt32HostToNetwork(CT); // Ȼĵû˵Ҫһ
+ Move(SCT, DArr[DataByteLen], SizeOf(Cardinal));
+ SM3D := SM3(@DArr[0], Length(DArr));
+
+ if (I = CeilLen) and not IsInt then
+ begin
+ // һ 32 ʱֻƶһ
+ Move(SM3D[0], Result[(I - 1) * SizeOf(TCnSM3Digest)], (DerivedKeyByteLength mod SizeOf(TCnSM3Digest)));
+ end
+ else
+ Move(SM3D[0], Result[(I - 1) * SizeOf(TCnSM3Digest)], SizeOf(TCnSM3Digest));
+
+ Inc(CT);
+ end;
+ finally
+ SetLength(DArr, 0);
+ end;
+end;
+
+function CnHKDF(HKDF: TCnHKDFHash; IKM: Pointer; IKMByteLen: Integer;
+ Salt: Pointer; SaltByteLen: Integer; Info: Pointer; InfoByteLen: Integer;
+ DerivedKeyByteLength: Integer): TBytes;
+const
+ MAX_BYTE = 255;
+var
+ PRKMd5, Md5T: TCnMD5Digest;
+ PRKSha1, Sha1T: TCnSHA1Digest;
+ PRKSha256, Sha256T: TCnSHA256Digest;
+ PRKSha3256, Sha3256T: TCnSHA3_256Digest;
+ PRKSm3, Sm3T: TCnSM3Digest;
+ T0, T: TBytes;
+ N, I, Start, HashLen: Integer;
+begin
+ if IKM = nil then
+ IKMByteLen := 0;
+
+ if Salt = nil then
+ SaltByteLen := 0;
+
+ if Info = nil then
+ InfoByteLen := 0;
+
+ if (IKMByteLen < 0) or (SaltByteLen < 0) or (InfoByteLen < 0) then
+ raise ECnKDFException.Create(SCnErrorKDFParam);
+
+ // Extract HMac(Salt, IKM)ע IKM ݣ HMac Key
+ case HKDF of
+ chkMd5:
+ begin
+ if (DerivedKeyByteLength <= 0) or (DerivedKeyByteLength > MAX_BYTE * SizeOf(TCnMD5Digest)) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ HashLen := SizeOf(TCnMD5Digest);
+ if (Salt = nil) or (SaltByteLen <= 0) then
+ begin
+ FillChar(PRKMd5[0], HashLen, 0);
+ MD5Hmac(@PRKMd5[0], HashLen, IKM, IKMByteLen, PRKMd5);
+ end
+ else
+ MD5Hmac(Salt, SaltByteLen, IKM, IKMByteLen, PRKMd5);
+ end;
+ chkSha1:
+ begin
+ if (DerivedKeyByteLength <= 0) or (DerivedKeyByteLength > MAX_BYTE * SizeOf(TCnSHA1Digest)) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ HashLen := SizeOf(TCnSHA1Digest);
+ if (Salt = nil) or (SaltByteLen <= 0) then
+ begin
+ FillChar(PRKSha1[0], HashLen, 0);
+ SHA1Hmac(@PRKSha1[0], HashLen, IKM, IKMByteLen, PRKSha1);
+ end
+ else
+ SHA1Hmac(Salt, SaltByteLen, IKM, IKMByteLen, PRKSha1);
+ end;
+ chkSha256:
+ begin
+ if (DerivedKeyByteLength <= 0) or (DerivedKeyByteLength > MAX_BYTE * SizeOf(TCnSHA256Digest)) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ HashLen := SizeOf(TCnSHA256Digest);
+ if (Salt = nil) or (SaltByteLen <= 0) then
+ begin
+ FillChar(PRKSha256[0], HashLen, 0);
+ SHA256Hmac(@PRKSha256[0], HashLen, IKM, IKMByteLen, PRKSha256);
+ end
+ else
+ SHA256Hmac(Salt, SaltByteLen, IKM, IKMByteLen, PRKSha256);
+ end;
+ chkSha3_256:
+ begin
+ if (DerivedKeyByteLength <= 0) or (DerivedKeyByteLength > MAX_BYTE * SizeOf(TCnSHA3_256Digest)) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ HashLen := SizeOf(TCnSHA3_256Digest);
+ if (Salt = nil) or (SaltByteLen <= 0) then
+ begin
+ FillChar(PRKSha3256[0], HashLen, 0);
+ SHA3_256Hmac(@PRKSha3256[0], HashLen, IKM, IKMByteLen, PRKSha3256);
+ end
+ else
+ SHA3_256Hmac(Salt, SaltByteLen, IKM, IKMByteLen, PRKSha3256);
+ end;
+ chkSm3:
+ begin
+ if (DerivedKeyByteLength <= 0) or (DerivedKeyByteLength > MAX_BYTE * SizeOf(TCnSM3Digest)) then
+ raise ECnKDFException.Create(SCnErrorKDFKeyTooLong);
+
+ HashLen := SizeOf(TCnSM3Digest);
+ if (Salt = nil) or (SaltByteLen <= 0) then
+ begin
+ FillChar(PRKSm3[0], HashLen, 0);
+ SM3Hmac(@PRKSm3[0], HashLen, IKM, IKMByteLen, PRKSm3);
+ end
+ else
+ SM3Hmac(Salt, SaltByteLen, IKM, IKMByteLen, PRKSm3);
+ end;
+ else
+ raise ECnKDFException.Create(SCnErrorKDFHashNOTSupport);
+ end;
+
+ // ʼ Expand
+ SetLength(T0, InfoByteLen + 1);
+ if InfoByteLen > 0 then
+ Move(Info^, T0[0], InfoByteLen);
+ T0[InfoByteLen] := 1; // ƴװ T0
+
+ // ʼÿֵļ
+ SetLength(T, HashLen + InfoByteLen + 1);
+
+ // ýȲ
+ N := (DerivedKeyByteLength + HashLen - 1) div HashLen;
+ SetLength(Result, DerivedKeyByteLength);
+
+ // T0 һ T1
+ case HKDF of
+ chkMd5: MD5Hmac(@PRKMd5[0], HashLen, @T0[0], Length(T0), Md5T);
+ chkSha1: SHA1Hmac(@PRKSha1[0], HashLen, @T0[0], Length(T0), Sha1T);
+ chkSha256: SHA256Hmac(@PRKSha256[0], HashLen, @T0[0], Length(T0), Sha256T);
+ chkSha3_256: SHA3_256Hmac(@PRKSha3256[0], HashLen, @T0[0], Length(T0), Sha3256T);
+ chkSm3: SM3Hmac(@PRKSm3[0], HashLen, @T0[0], Length(T0), Sm3T);
+ end;
+
+ Start := 0;
+ for I := 1 to N do
+ begin
+ // T1 ƴڽ
+ if DerivedKeyByteLength > HashLen then
+ begin
+ case HKDF of
+ chkMd5: Move(Md5T[0], Result[Start], HashLen);
+ chkSha1: Move(Sha1T[0], Result[Start], HashLen);
+ chkSha256: Move(Sha256T[0], Result[Start], HashLen);
+ chkSha3_256: Move(Sha3256T[0], Result[Start], HashLen);
+ chkSm3: Move(Sm3T[0], Result[Start], HashLen);
+ end;
+ Inc(Start, HashLen);
+ Dec(DerivedKeyByteLength, HashLen);
+ end
+ else
+ begin
+ case HKDF of
+ chkMd5: Move(Md5T[0], Result[Start], DerivedKeyByteLength);
+ chkSha1: Move(Sha1T[0], Result[Start], DerivedKeyByteLength);
+ chkSha256: Move(Sha256T[0], Result[Start], DerivedKeyByteLength);
+ chkSha3_256: Move(Sha3256T[0], Result[Start], DerivedKeyByteLength);
+ chkSm3: Move(Sm3T[0], Result[Start], DerivedKeyByteLength);
+ end;
+ Break;
+ end;
+
+ // T1 Info ƴһһ
+ case HKDF of
+ chkMd5: Move(Md5T[0], T[0], HashLen);
+ chkSha1: Move(Sha1T[0], T[0], HashLen);
+ chkSha256: Move(Sha256T[0], T[0], HashLen);
+ chkSha3_256: Move(Sha3256T[0], T[0], HashLen);
+ chkSm3: Move(Sm3T[0], T[0], HashLen);
+ end;
+ Move(Info^, T[HashLen], InfoByteLen);
+ T[HashLen + InfoByteLen] := I + 1;
+
+ // Ӵ T2 T1
+ case HKDF of
+ chkMd5: MD5Hmac(@PRKMd5[0], HashLen, @T[0], Length(T), Md5T);
+ chkSha1: SHA1Hmac(@PRKSha1[0], HashLen, @T[0], Length(T), Sha1T);
+ chkSha256: SHA256Hmac(@PRKSha256[0], HashLen, @T[0], Length(T), Sha256T);
+ chkSha3_256: SHA3_256Hmac(@PRKSha3256[0], HashLen, @T[0], Length(T), Sha3256T);
+ chkSm3: SM3Hmac(@PRKSm3[0], HashLen, @T[0], Length(T), Sm3T);
+ end;
+ end;
+end;
+
+function CnHKDFBytes(HKDF: TCnHKDFHash; IKM: TBytes; Salt: TBytes; Info: TBytes;
+ DerivedKeyByteLength: Integer): TBytes;
+var
+ IKMP, SaltP, InfoP: Pointer;
+ IKML, SaltL, InfoL: Integer;
+begin
+ IKMP := nil;
+ SaltP := nil;
+ InfoP := nil;
+ IKML := 0;
+ SaltL := 0;
+ InfoL := 0;
+
+ if Length(IKM) > 0 then
+ begin
+ IKMP := @IKM[0];
+ IKML := Length(IKM);
+ end;
+ if Length(Salt) > 0 then
+ begin
+ SaltP := @Salt[0];
+ SaltL := Length(Salt);
+ end;
+ if Length(Info) > 0 then
+ begin
+ InfoP := @Info[0];
+ InfoL := Length(Info);
+ end;
+
+ Result := CnHKDF(HKDF, IKMP, IKML, SaltP, SaltL, InfoP, InfoL, DerivedKeyByteLength);
+end;
+
+end.
diff --git a/CnPack/Crypto/CnMD5.pas b/CnPack/Crypto/CnMD5.pas
new file mode 100644
index 0000000..be31d9d
--- /dev/null
+++ b/CnPack/Crypto/CnMD5.pas
@@ -0,0 +1,908 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+{******************************************************************************}
+{ }
+{ MD5 Message-Digest for Delphi 4 }
+{ }
+{ Delphi 4 Unit implementing the }
+{ RSA Data Security, Inc. MD5 Message-Digest Algorithm }
+{ }
+{ Implementation of Ronald L. Rivest's RFC 1321 }
+{ }
+{ Copyright ?1997-1999 Medienagentur Fichtner & Meyer }
+{ Written by Matthias Fichtner }
+{ }
+{ -----------------------------------------------------------------------------}
+{ See RFC 1321 for RSA Data Security's copyright and license notice! }
+{ -----------------------------------------------------------------------------}
+{ The latest release of md5.pas will always be available from }
+{ the distribution site at: http://www.fichtner.net/delphi/md5/ }
+{ -----------------------------------------------------------------------------}
+{ Please send questions, bug reports and suggestions }
+{ regarding this code to: mfichtner@fichtner-meyer.com }
+{ -----------------------------------------------------------------------------}
+{ This code is provided "as is" without express or }
+{ implied warranty of any kind. Use it at your own risk. }
+{******************************************************************************}
+
+unit CnMD5;
+{* |
+================================================================================
+* ƣ
+* ԪƣMD5 Ӵ㷨ʵֵԪ
+* Ԫߣ壨QSoft hq.com@263.net; http://qsoft.51.net
+* Ronald L. Rivest MD5.pas дԭʼ
+* עԪʵ MD5 Ӵ㷨Ӧ HMAC 㷨
+* ƽ̨PWin2000Pro + Delphi 5.0
+* ݲԣPWin9X/2000/XP + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2019.12.12 V1.4
+* ֧ TBytes
+* 2019.04.15 V1.3
+* ֧ Win32/Win64/MacOS
+* 2014.11.14 V1.2
+* л Pascal ֿ֧ƽ̨
+* 2003.09.18 V1.1
+* òҵ˸õԪԭߵİȨ
+* 2003.09.18 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, CnConsts, CnNative {$IFDEF MSWINDOWS}, Windows {$ENDIF};
+
+type
+ PMD5Digest = ^TCnMD5Digest;
+ {* MD5 Ӵսָ}
+ TCnMD5Digest = array[0..15] of Byte;
+ {* MD5 Ӵս16 ֽ}
+
+ TCnMD5Count = array[0..1] of Cardinal;
+ {* MD5 ڲṹ}
+ TCnMD5State = array[0..3] of Cardinal;
+ {* MD5 ڲ״̬ṹ}
+ TCnMD5Block = array[0..15] of Cardinal;
+ {* MD5 ڲṹ}
+
+ TCnMD5Buffer = array[0..63] of Byte;
+ {* MD5 ڲṹ}
+
+ TCnMD5Context = packed record
+ {* MD5 Ľṹ}
+ State : TCnMD5State;
+ Count : TCnMD5Count;
+ Buffer : TCnMD5Buffer;
+ Ipad : array[0..63] of Byte; {!< HMAC: inner padding }
+ Opad : array[0..63] of Byte; {!< HMAC: outer padding }
+ end;
+
+ TCnMD5CalcProgressFunc = procedure (ATotal, AProgress: Int64;
+ var Cancel: Boolean) of object;
+ {* Ȼص¼}
+
+//----------------------------------------------------------------
+// û API
+//----------------------------------------------------------------
+
+function MD5(Input: PAnsiChar; ByteLength: Cardinal): TCnMD5Digest;
+{* ݿ MD5 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5Buffer(const Buffer; Count: Cardinal): TCnMD5Digest;
+{* ݿ MD5 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5Bytes(const Data: TBytes): TCnMD5Digest;
+{* ֽ MD5 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5String(const Str: string): TCnMD5Digest;
+{* String ݽ MD5 㡣ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+
+ const Str: string - ַ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5StringA(const Str: AnsiString): TCnMD5Digest;
+{* AnsiString ݽ MD5 㣬ֱӼڲݣޱ봦
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5StringW(const Str: WideString): TCnMD5Digest;
+{* WideString ַת MD5 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+{$IFDEF UNICODE}
+
+function MD5UnicodeString(const Str: string): TCnMD5Digest;
+{* UnicodeString ݽֱӵ MD5 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+{$ELSE}
+
+function MD5UnicodeString(const Str: WideString): TCnMD5Digest;
+{* UnicodeString ݽֱӵ MD5 㣬ֱӼڲ UTF16 ݣת
+
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+{$ENDIF}
+
+function MD5File(const FileName: string;
+ CallBack: TCnMD5CalcProgressFunc = nil): TCnMD5Digest;
+{* ָļݽ MD5 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnMD5CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+function MD5Stream(Stream: TStream;
+ CallBack: TCnMD5CalcProgressFunc = nil): TCnMD5Digest;
+{* ָݽ MD5 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnMD5CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+// ⲿݽɢ MD5 㣬MD5Update ɶα
+
+procedure MD5Init(var Context: TCnMD5Context);
+{* ʼһ MD5 ģ MD5
+
+
+ var Context: TCnMD5Context - ʼ MD5
+
+ ֵޣ
+}
+
+procedure MD5Update(var Context: TCnMD5Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ MD5 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnMD5Context - MD5
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure MD5Final(var Context: TCnMD5Context; var Digest: TCnMD5Digest);
+{* ּ㣬 MD5 Digest С
+
+
+ var Context: TCnMD5Context - MD5
+ var Digest: TCnMD5Digest - ص MD5 Ӵֵ
+
+ ֵޣ
+}
+
+function MD5Print(const Digest: TCnMD5Digest): string;
+{* ʮƸʽ MD5 Ӵֵ
+
+
+ const Digest: TCnMD5Digest - ָ MD5 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function MD5Match(const D1: TCnMD5Digest; const D2: TCnMD5Digest): Boolean;
+{* Ƚ MD5 ӴֵǷȡ
+
+
+ const D1: TCnMD5Digest - Ƚϵ MD5 Ӵֵһ
+ const D2: TCnMD5Digest - Ƚϵ MD5 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function MD5DigestToStr(const Digest: TCnMD5Digest): string;
+{* MD5 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnMD5Digest - ת MD5 Ӵֵ
+
+ ֵstring - صַ
+}
+
+procedure MD5Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnMD5Digest);
+{* MD5 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - MD5 Կݿַ
+ KeyByteLength: Integer - MD5 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnMD5Digest - ص MD5 Ӵֵ
+
+ ֵޣ
+}
+
+function MD5HmacBytes(const Key: TBytes; const Data: TBytes): TCnMD5Digest;
+{* ֽл MD5 HMAC 㡣
+
+
+ const Key: TBytes - MD5 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnMD5Digest - ص MD5 Ӵֵ
+}
+
+implementation
+
+const
+ MAX_FILE_SIZE = 512 * 1024 * 1024;
+ // If file size <= this size (bytes), using Mapping, else stream
+
+ HMAC_MD5_BLOCK_SIZE_BYTE = 64;
+ HMAC_MD5_OUTPUT_LENGTH_BYTE = 16;
+
+type
+ TMD5CBits = array[0..7] of Byte;
+
+var
+ PADDING: TCnMD5Buffer = (
+ $80, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00,
+ $00, $00, $00, $00, $00, $00, $00, $00
+ );
+
+function F(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) or ((not X) and Z);
+end;
+
+function G(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Z) or (Y and (not Z));
+end;
+
+function H(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor Y xor Z;
+end;
+
+function I(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := Y xor (X or (not Z));
+end;
+
+procedure ROT(var X: Cardinal; N: BYTE); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ X := (X shl N) or (X shr (32 - N));
+end;
+
+procedure FF(var A: Cardinal; B, C, D, X: Cardinal; S: BYTE; AC: Cardinal); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Inc(A, F(B, C, D) + X + AC);
+ ROT(A, S);
+ Inc(A, B);
+end;
+
+procedure GG(var A: Cardinal; B, C, D, X: Cardinal; S: BYTE; AC: Cardinal); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Inc(A, G(B, C, D) + X + AC);
+ ROT(A, S);
+ Inc(A, B);
+end;
+
+procedure HH(var A: Cardinal; B, C, D, X: Cardinal; S: BYTE; AC: Cardinal); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Inc(A, H(B, C, D) + X + AC);
+ ROT(A, S);
+ Inc(A, B);
+end;
+
+procedure II(var A: Cardinal; B, C, D, X: Cardinal; S: BYTE; AC: Cardinal); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Inc(A, I(B, C, D) + X + AC);
+ ROT(A, S);
+ Inc(A, B);
+end;
+
+// Encode Count bytes at Source into (Count / 4) DWORDs at Target
+procedure Encode(Source, Target: Pointer; Count: Cardinal);
+var
+ S: PByte;
+ T: PCardinal;
+ I: Cardinal;
+begin
+ S := Source;
+ T := Target;
+ for I := 1 to Count div 4 do
+ begin
+ T^ := S^;
+ Inc(S);
+ T^ := T^ or (S^ shl 8);
+ Inc(S);
+ T^ := T^ or (S^ shl 16);
+ Inc(S);
+ T^ := T^ or (S^ shl 24);
+ Inc(S);
+ Inc(T);
+ end;
+end;
+
+// Decode Count DWORDs at Source into (Count * 4) Bytes at Target
+procedure Decode(Source, Target: Pointer; Count: Cardinal);
+var
+ S: PCardinal;
+ T: PByte;
+ I: Cardinal;
+begin
+ S := Source;
+ T := Target;
+ for I := 1 to Count do
+ begin
+ T^ := S^ and $ff;
+ Inc(T);
+ T^ := (S^ shr 8) and $ff;
+ Inc(T);
+ T^ := (S^ shr 16) and $ff;
+ Inc(T);
+ T^ := (S^ shr 24) and $ff;
+ Inc(T);
+ Inc(S);
+ end;
+end;
+
+// Transform State according to first 64 bytes at Buffer
+procedure Transform(Buffer: Pointer; var State: TCnMD5State);
+var
+ A, B, C, D: Cardinal;
+ Block: TCnMD5Block;
+begin
+ Encode(Buffer, @Block, 64);
+ A := State[0];
+ B := State[1];
+ C := State[2];
+ D := State[3];
+ FF (A, B, C, D, Block[ 0], 7, $d76aa478);
+ FF (D, A, B, C, Block[ 1], 12, $e8c7b756);
+ FF (C, D, A, B, Block[ 2], 17, $242070db);
+ FF (B, C, D, A, Block[ 3], 22, $c1bdceee);
+ FF (A, B, C, D, Block[ 4], 7, $f57c0faf);
+ FF (D, A, B, C, Block[ 5], 12, $4787c62a);
+ FF (C, D, A, B, Block[ 6], 17, $a8304613);
+ FF (B, C, D, A, Block[ 7], 22, $fd469501);
+ FF (A, B, C, D, Block[ 8], 7, $698098d8);
+ FF (D, A, B, C, Block[ 9], 12, $8b44f7af);
+ FF (C, D, A, B, Block[10], 17, $ffff5bb1);
+ FF (B, C, D, A, Block[11], 22, $895cd7be);
+ FF (A, B, C, D, Block[12], 7, $6b901122);
+ FF (D, A, B, C, Block[13], 12, $fd987193);
+ FF (C, D, A, B, Block[14], 17, $a679438e);
+ FF (B, C, D, A, Block[15], 22, $49b40821);
+ GG (A, B, C, D, Block[ 1], 5, $f61e2562);
+ GG (D, A, B, C, Block[ 6], 9, $c040b340);
+ GG (C, D, A, B, Block[11], 14, $265e5a51);
+ GG (B, C, D, A, Block[ 0], 20, $e9b6c7aa);
+ GG (A, B, C, D, Block[ 5], 5, $d62f105d);
+ GG (D, A, B, C, Block[10], 9, $2441453);
+ GG (C, D, A, B, Block[15], 14, $d8a1e681);
+ GG (B, C, D, A, Block[ 4], 20, $e7d3fbc8);
+ GG (A, B, C, D, Block[ 9], 5, $21e1cde6);
+ GG (D, A, B, C, Block[14], 9, $c33707d6);
+ GG (C, D, A, B, Block[ 3], 14, $f4d50d87);
+ GG (B, C, D, A, Block[ 8], 20, $455a14ed);
+ GG (A, B, C, D, Block[13], 5, $a9e3e905);
+ GG (D, A, B, C, Block[ 2], 9, $fcefa3f8);
+ GG (C, D, A, B, Block[ 7], 14, $676f02d9);
+ GG (B, C, D, A, Block[12], 20, $8d2a4c8a);
+ HH (A, B, C, D, Block[ 5], 4, $fffa3942);
+ HH (D, A, B, C, Block[ 8], 11, $8771f681);
+ HH (C, D, A, B, Block[11], 16, $6d9d6122);
+ HH (B, C, D, A, Block[14], 23, $fde5380c);
+ HH (A, B, C, D, Block[ 1], 4, $a4beea44);
+ HH (D, A, B, C, Block[ 4], 11, $4bdecfa9);
+ HH (C, D, A, B, Block[ 7], 16, $f6bb4b60);
+ HH (B, C, D, A, Block[10], 23, $bebfbc70);
+ HH (A, B, C, D, Block[13], 4, $289b7ec6);
+ HH (D, A, B, C, Block[ 0], 11, $eaa127fa);
+ HH (C, D, A, B, Block[ 3], 16, $d4ef3085);
+ HH (B, C, D, A, Block[ 6], 23, $4881d05);
+ HH (A, B, C, D, Block[ 9], 4, $d9d4d039);
+ HH (D, A, B, C, Block[12], 11, $e6db99e5);
+ HH (C, D, A, B, Block[15], 16, $1fa27cf8);
+ HH (B, C, D, A, Block[ 2], 23, $c4ac5665);
+ II (A, B, C, D, Block[ 0], 6, $f4292244);
+ II (D, A, B, C, Block[ 7], 10, $432aff97);
+ II (C, D, A, B, Block[14], 15, $ab9423a7);
+ II (B, C, D, A, Block[ 5], 21, $fc93a039);
+ II (A, B, C, D, Block[12], 6, $655b59c3);
+ II (D, A, B, C, Block[ 3], 10, $8f0ccc92);
+ II (C, D, A, B, Block[10], 15, $ffeff47d);
+ II (B, C, D, A, Block[ 1], 21, $85845dd1);
+ II (A, B, C, D, Block[ 8], 6, $6fa87e4f);
+ II (D, A, B, C, Block[15], 10, $fe2ce6e0);
+ II (C, D, A, B, Block[ 6], 15, $a3014314);
+ II (B, C, D, A, Block[13], 21, $4e0811a1);
+ II (A, B, C, D, Block[ 4], 6, $f7537e82);
+ II (D, A, B, C, Block[11], 10, $bd3af235);
+ II (C, D, A, B, Block[ 2], 15, $2ad7d2bb);
+ II (B, C, D, A, Block[ 9], 21, $eb86d391);
+ Inc(State[0], A);
+ Inc(State[1], B);
+ Inc(State[2], C);
+ Inc(State[3], D);
+end;
+
+// Initialize given Context
+procedure MD5Init(var Context: TCnMD5Context);
+begin
+ with Context do
+ begin
+ State[0] := $67452301;
+ State[1] := $EFCDAB89;
+ State[2] := $98BADCFE;
+ State[3] := $10325476;
+ Count[0] := 0;
+ Count[1] := 0;
+ // ZeroMemory(@Buffer, SizeOf(TMD5Buffer));
+ FillChar(Buffer, SizeOf(TCnMD5Buffer), 0);
+ end;
+end;
+
+// Update given Context to include Length bytes of Input
+procedure MD5Update(var Context: TCnMD5Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ Index: Cardinal;
+ PartLen: Cardinal;
+ I: Cardinal;
+begin
+ with Context do
+ begin
+ Index := (Count[0] shr 3) and $3F;
+ Inc(Count[0], ByteLength shl 3);
+ if Count[0] < (ByteLength shl 3) then Inc(Count[1]);
+ Inc(Count[1], ByteLength shr 29);
+ end;
+
+ PartLen := 64 - Index;
+ if ByteLength >= PartLen then
+ begin
+ Move(Input^, Context.Buffer[Index], PartLen);
+ Transform(@Context.Buffer, Context.State);
+ I := PartLen;
+ while I + 63 < ByteLength do
+ begin
+ Transform(@Input[I], Context.State);
+ Inc(I, 64);
+ end;
+ Index := 0;
+ end
+ else
+ I := 0;
+
+ Move(Input[I], Context.Buffer[Index], ByteLength - I);
+end;
+
+procedure MD5UpdateW(var Context: TCnMD5Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ pContent: PAnsiChar;
+ iLen: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(pContent, CharLength * SizeOf(WideChar));
+ try
+ iLen := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(pContent), CharLength * SizeOf(WideChar), nil, nil);
+ MD5Update(Context, pContent, iLen);
+ finally
+ FreeMem(pContent);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ MD5Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+// Finalize given Context, create Digest
+procedure MD5Final(var Context: TCnMD5Context; var Digest: TCnMD5Digest);
+var
+ Bits: TMD5CBits;
+ Index: Cardinal;
+ PadLen: Cardinal;
+begin
+ Decode(@Context.Count, @Bits, 2);
+ Index := (Context.Count[0] shr 3) and $3f;
+ if Index < 56 then
+ PadLen := 56 - Index
+ else
+ PadLen := 120 - Index;
+ MD5Update(Context, @PADDING, PadLen);
+ MD5Update(Context, @Bits, 8);
+ Decode(@Context.State, @Digest, 4);
+end;
+
+function InternalMD5Stream(Stream: TStream; const BufSize: Cardinal; var D:
+ TCnMD5Digest; CallBack: TCnMD5CalcProgressFunc): Boolean;
+var
+ Context: TCnMD5Context;
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+begin
+ Result := False;
+ Size := Stream.Size;
+ if Size = 0 then
+ Exit;
+
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+
+ if Size < BufSize then
+ BufLen := Size
+ else
+ BufLen := BufSize;
+
+ CancelCalc := False;
+ MD5Init(Context);
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ MD5Update(Context, Buf, ReadBytes);
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ MD5Final(Context, D);
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+// ݿ MD5
+function MD5(Input: PAnsiChar; ByteLength: Cardinal): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5Update(Context, Input, ByteLength);
+ MD5Final(Context, Result);
+end;
+
+// ݿ MD5
+function MD5Buffer(const Buffer; Count: Cardinal): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5Update(Context, PAnsiChar(@Buffer), Count);
+ MD5Final(Context, Result);
+end;
+
+function MD5Bytes(const Data: TBytes): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ MD5Final(Context, Result);
+end;
+
+// String ݽ MD5
+function MD5String(const Str: string): TCnMD5Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := MD5StringA(AStr);
+end;
+
+// AnsiString ݽ MD5
+function MD5StringA(const Str: AnsiString): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5Update(Context, PAnsiChar(Str), Length(Str));
+ MD5Final(Context, Result);
+end;
+
+// WideString ݽ MD5
+function MD5StringW(const Str: WideString): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5UpdateW(Context, PWideChar(Str), Length(Str));
+ MD5Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ MD5 㣬ת
+{$IFDEF UNICODE}
+function MD5UnicodeString(const Str: string): TCnMD5Digest;
+{$ELSE}
+function MD5UnicodeString(const Str: WideString): TCnMD5Digest;
+{$ENDIF}
+var
+ Context: TCnMD5Context;
+begin
+ MD5Init(Context);
+ MD5Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ MD5Final(Context, Result);
+end;
+
+// ָļݽ MD5
+function MD5File(const FileName: string;
+ CallBack: TCnMD5CalcProgressFunc): TCnMD5Digest;
+var
+{$IFDEF MSWINDOWS}
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+ Context: TCnMD5Context;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+
+ function FileSizeIsLargeThanMaxOrCanNotMap(const AFileName: string; out IsEmpty: Boolean): Boolean;
+{$IFDEF MSWINDOWS}
+ var
+ H: THandle;
+ Info: BY_HANDLE_FILE_INFORMATION;
+ Rec : Int64Rec;
+{$ENDIF}
+ begin
+{$IFDEF MSWINDOWS}
+ Result := False;
+ IsEmpty := False;
+ H := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
+ if H = INVALID_HANDLE_VALUE then Exit;
+ try
+ if not GetFileInformationByHandle(H, Info) then Exit;
+ finally
+ CloseHandle(H);
+ end;
+ Rec.Lo := Info.nFileSizeLow;
+ Rec.Hi := Info.nFileSizeHigh;
+ Result := (Rec.Hi > 0) or (Rec.Lo > MAX_FILE_SIZE);
+ IsEmpty := (Rec.Hi = 0) and (Rec.Lo = 0);
+{$ELSE}
+ Result := True; // Windows ƽ̨ Trueʾ Mapping
+{$ENDIF}
+ end;
+
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣ Windows ƽ̨ʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalMD5Stream(Stream, 4096 * 1024, Result, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ MD5Init(Context);
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ MD5Final(Context, Result);
+{$ENDIF}
+ end;
+end;
+
+// ָ MD5
+function MD5Stream(Stream: TStream;
+ CallBack: TCnMD5CalcProgressFunc): TCnMD5Digest;
+begin
+ InternalMD5Stream(Stream, 4096 * 1024, Result, CallBack);
+end;
+
+// ʮƸʽ MD5 Ӵֵ
+function MD5Print(const Digest: TCnMD5Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnMD5Digest));
+end;
+
+// Ƚ MD5 ӴֵǷ
+function MD5Match(const D1, D2: TCnMD5Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnMD5Digest));
+end;
+
+// MD5 Ӵֵת string
+function MD5DigestToStr(const Digest: TCnMD5Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnMD5Digest));
+end;
+
+procedure MD5HmacInit(var Context: TCnMD5Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnMD5Digest;
+begin
+ if KeyLength > HMAC_MD5_BLOCK_SIZE_BYTE then
+ begin
+ Sum := MD5Buffer(Key^, KeyLength);
+ KeyLength := HMAC_MD5_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_MD5_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_MD5_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ MD5Init(Context);
+ MD5Update(Context, @(Context.Ipad[0]), HMAC_MD5_BLOCK_SIZE_BYTE);
+end;
+
+procedure MD5HmacUpdate(var Context: TCnMD5Context; Input: PAnsiChar; Length: Cardinal);
+begin
+ MD5Update(Context, Input, Length);
+end;
+
+procedure MD5HmacFinal(var Context: TCnMD5Context; var Output: TCnMD5Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnMD5Digest;
+begin
+ Len := HMAC_MD5_OUTPUT_LENGTH_BYTE;
+ MD5Final(Context, TmpBuf);
+ MD5Init(Context);
+ MD5Update(Context, @(Context.Opad[0]), HMAC_MD5_BLOCK_SIZE_BYTE);
+ MD5Update(Context, @(TmpBuf[0]), Len);
+ MD5Final(Context, Output);
+end;
+
+procedure MD5Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnMD5Digest);
+var
+ Context: TCnMD5Context;
+begin
+ MD5HmacInit(Context, Key, KeyByteLength);
+ MD5HmacUpdate(Context, Input, ByteLength);
+ MD5HmacFinal(Context, Output);
+end;
+
+function MD5HmacBytes(const Key: TBytes; const Data: TBytes): TCnMD5Digest;
+var
+ Context: TCnMD5Context;
+begin
+ MD5HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ MD5HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ MD5HmacFinal(Context, Result);
+end;
+
+end.
diff --git a/CnPack/Crypto/CnNative.pas b/CnPack/Crypto/CnNative.pas
new file mode 100644
index 0000000..6895190
--- /dev/null
+++ b/CnPack/Crypto/CnNative.pas
@@ -0,0 +1,5498 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnNative;
+{* |
+================================================================================
+* ƣCnPack
+* Ԫƣ32 λ 64 λƽ̨һЩͳһԼһʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* עԪһ 32 λ 64 λƽ̨һЩͳһʵ֡
+* Delphi XE 2 ֧ 32 64 ų NativeInt NativeUInt
+* ǰ 32 λ 64 ̬仯Ӱ쵽 PointerReferenceȶ
+* ǵԣ̶ȵ 32 λ Cardinal/Integer Ⱥ Pointer Щ
+* ͨˣʹ 32 λҲֹ˱Ԫ˼ͣ
+* ͬʱڵͰ汾߰汾 Delphi ʹá
+*
+* ԪҲڲ֧ UInt64 ı Delphi 5/6/7 Int64 ģ UInt64
+* ĸ㣬ӼȻ֧֣˳Ҫģ div mod
+* ַ Integer(APtr) 64 λ MacOS ׳ֽضϣҪ NativeInt
+*
+* ʵ˴Сءֽת̶ʱȷĴײ㺯빤ࡣ
+*
+* ƽ̨PWin2000 + Delphi 5.0
+* ݲԣPWin9X/2000/XP + Delphi 5/6/7 XE 2
+* õԪеַϱػʽ
+* ļ¼2023.08.14 V2.4
+* ϼʱ̶ĺ
+* 2022.11.11 V2.3
+* ϼֽ˳
+* 2022.07.23 V2.2
+* Ӽڴλ㺯תַΪ CnNative
+* 2022.06.08 V2.1
+* ĸʱ̶ĽԼڴ浹ź
+* 2022.03.14 V2.0
+* Ӽʮת
+* 2022.02.17 V1.9
+* FPC ı֧
+* 2022.02.09 V1.8
+* ڵĴСжϺ
+* 2021.09.05 V1.7
+* Int64/UInt64 㺯
+* 2020.10.28 V1.6
+* UInt64 صж㺯
+* 2020.09.06 V1.5
+* UInt64 ƽĺ
+* 2020.07.01 V1.5
+* ж 32 λ 64 λǷĺ
+* 2020.06.20 V1.4
+* 32 λ 64 λȡ͵ 1 λλõĺ
+* 2020.01.01 V1.3
+* 32 λ͵ mul 㣬ڲ֧ UInt64 ϵͳ Int64 Ա
+* 2018.06.05 V1.2
+* 64 λ͵ div/mod 㣬ڲ֧ UInt64 ϵͳ Int64
+* 2016.09.27 V1.1
+* 64 λ͵һЩ
+* 2011.07.06 V1.0
+* Ԫʵֹ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, SysConst, Math {$IFDEF COMPILER5}, Windows {$ENDIF};
+ // D5 Ҫ Windows е PByte
+type
+ ECnNativeException = class(Exception);
+ {* Native 쳣}
+
+{$IFDEF COMPILER5}
+ PByte = Windows.PByte;
+ {* D5 PByte Windows У汾 System У
+ ͳһһ¹ʹ PByte ʱ uses Windowsڿƽ̨ͬ}
+ PWord = Windows.PWord;
+ {* D5 PWord Windows }
+ PShortInt = Windows.PShortInt;
+ {* D5 PShortInt Windows }
+ PSmallInt = Windows.PSmallInt;
+ {* D5 PSmallInt Windows }
+ PInteger = Windows.PInteger;
+ {* D5 PInteger Windows }
+ PSingle = Windows.PSingle;
+ {* D5 PSingle Windows }
+ PDouble = Windows.PDouble;
+ {* D5 PDouble Windows }
+
+ PCardinal = ^Cardinal;
+ {* D5 System Ԫδ Cardinal ָͣ}
+ PBoolean = ^Boolean;
+ {* D5 System Ԫδ Boolean ָͣ}
+{$ENDIF}
+
+{$IFDEF BCB5OR6}
+ PInt64 = ^Int64;
+ {* C++Builder 5/6 sysmac.h û PInt64 Ķ壨е PUINT64 Сдͬ㣩}
+{$ENDIF}
+
+{$IFDEF SUPPORT_32_AND_64}
+ TCnNativeInt = NativeInt;
+ {* ͳһ 32 λ 64 λͨõз}
+ TCnNativeUInt = NativeUInt;
+ {* ͳһ 32 λ 64 λͨõ}
+ TCnNativePointer = NativeInt;
+ {* ͳһ 32 λ 64 λͨõָ}
+ TCnNativeIntPtr = PNativeInt;
+ {* ͳһ 32 λ 64 λͨõָзָ}
+ TCnNativeUIntPtr = PNativeUInt;
+ {* ͳһ 32 λ 64 λͨõָָ}
+{$ELSE}
+ TCnNativeInt = Integer;
+ {* ͳһ 32 λ 64 λͨõз}
+ TCnNativeUInt = Cardinal;
+ {* ͳһ 32 λ 64 λͨõ}
+ TCnNativePointer = Integer;
+ {* ͳһ 32 λ 64 λͨõָ}
+ TCnNativeIntPtr = PInteger;
+ {* ͳһ 32 λ 64 λͨõָзָ}
+ TCnNativeUIntPtr = PCardinal;
+ {* ͳһ 32 λ 64 λͨõָָ}
+{$ENDIF}
+ PCnNativeInt = ^TCnNativeInt;
+ {* ָͳһ 32 λ 64 λͨõз͵ָ}
+ PCnNativeUInt = ^TCnNativeUInt;
+ {* ָͳһ 32 λ 64 λͨõ͵ָ}
+{$IFDEF FPC}
+ TCnHashCode = PtrInt;
+ {* ͳһ Delphi FPC µ HashCode }
+{$ELSE}
+ TCnHashCode = Integer;
+ {* ͳһ Delphi FPC µ HashCode }
+{$ENDIF}
+
+ // еַӼͣ FPC Delphi ¶ԷŵҪ
+{$IFDEF FPC}
+ TCnIntAddress = NativeUInt;
+ {* ͳһ Delphi FPC µĹеַӼ}
+{$ELSE}
+ {$IFDEF SUPPORT_32_AND_64}
+ TCnIntAddress = NativeInt;
+ {* ͳһ Delphi FPC µĹеַӼ}
+ {$ELSE}
+ TCnIntAddress = Integer;
+ {* ͳһ Delphi FPC µĹеַӼ}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF CPU64BITS}
+ TCnUInt64 = NativeUInt;
+ {* ͳһ 64 λ}
+ TCnInt64 = NativeInt;
+ {* ͳһ 64 λз}
+{$ELSE}
+ {$IFDEF SUPPORT_UINT64}
+ TCnUInt64 = UInt64;
+ {* ͳһ 64 λ}
+ {$ELSE}
+ TCnUInt64 = packed record
+ {* ڲ֧ UInt64 32 λ£ 64 λṹ}
+ case Boolean of
+ True: (Value: Int64);
+ False: (Lo32, Hi32: Cardinal);
+ end;
+ {$ENDIF}
+ TCnInt64 = Int64;
+ {* ͳһ 64 λ}
+{$ENDIF}
+
+// TUInt64 cnvcl в֧ UInt64 div mod
+{$IFDEF SUPPORT_UINT64}
+ TUInt64 = UInt64;
+ {* ͳһ 64 λ}
+ {$IFNDEF SUPPORT_PUINT64}
+ PUInt64 = ^UInt64;
+ {* ͳһָ 64 λָ}
+ {$ENDIF}
+{$ELSE}
+ TUInt64 = Int64;
+ {* ͳһ 64 λͣ cnvcl в֧ UInt64 }
+ PUInt64 = ^TUInt64;
+ {* ͳһָ 64 λָͣ cnvcl в֧ UInt64 }
+{$ENDIF}
+
+{$IFNDEF SUPPORT_INT64ARRAY}
+ Int64Array = array[0..$0FFFFFFE] of Int64;
+ {* ϵͳûж Int64Array 64 λз}
+ PInt64Array = ^Int64Array;
+ {* ϵͳûж PInt64Array 64 λзָ}
+{$ENDIF}
+
+ TUInt64Array = array of TUInt64;
+ {* ͳһ 64 λ̬飬ע̬ƺ;̬гͻ}
+ ExtendedArray = array[0..65537] of Extended;
+ {* չȸ}
+ PExtendedArray = ^ExtendedArray;
+ {* չȸָ}
+
+ PCnWord16Array = ^TCnWord16Array;
+ {* 16 λָ}
+ TCnWord16Array = array [0..0] of Word;
+ {* 16 λ}
+
+{$IFDEF POSIX64}
+ TCnLongWord32 = Cardinal;
+ {* ͳһ 32 λ LongWordΪ Linux64/MacOS64 POSIX64 LongWord Ȼ 64 λ}
+{$ELSE}
+ TCnLongWord32 = LongWord;
+ {* ͳһ 32 λ LongWord}
+{$ENDIF}
+ PCnLongWord32 = ^TCnLongWord32;
+ {* ͳһָ 32 λ LongWord ָ}
+
+ TCnLongWord32Array = array [0..MaxInt div SizeOf(Integer) - 1] of TCnLongWord32;
+ {* ͳһ 32 λ LongWord }
+
+ PCnLongWord32Array = ^TCnLongWord32Array;
+ {* ͳһ 32 λ LongWord ָ}
+
+{$IFNDEF TBYTES_DEFINED}
+ TBytes = array of Byte;
+ {* ֽڶ̬飬δʱ}
+{$ENDIF}
+
+ TShortInts = array of ShortInt;
+ {* зֽڶ̬}
+
+ TSmallInts = array of SmallInt;
+ {* з˫ֽڶ̬}
+
+ TWords = array of Word;
+ {* ˫ֽڶ̬}
+
+ TIntegers = array of Integer;
+ {* зֽڶ̬}
+
+ TCardinals = array of Cardinal;
+ {* ֽڶ̬}
+
+ TBooleans = array of Boolean;
+ {* ̬}
+
+ PCnByte = ^Byte;
+ {* ָ 8 λָ}
+ PCnWord = ^Word;
+ {* ָ 16 λָ}
+
+ TCnBitOperation = (boAnd, boOr, boXor, boNot);
+ {* λ}
+
+ // ʹõľ̬з
+ PCnInt8Array = ^TCnInt8Array;
+ {* ̬ 8 λзָ}
+ TCnInt8Array = array[0..(MaxInt div SizeOf(ShortInt) - 1)] of ShortInt;
+ {* ̬ 8 λз}
+
+ PCnUInt8Array = ^TCnUInt8Array;
+ {* ̬ 8 λָ}
+ TCnUInt8Array = array[0..(MaxInt div SizeOf(Byte) - 1)] of Byte;
+ {* ̬ 8 λ}
+
+ PCnInt16Array = ^TCnInt16Array;
+ {* ̬ 16 λзָ}
+ TCnInt16Array = array[0..(MaxInt div SizeOf(SmallInt) - 1)] of SmallInt;
+ {* ̬ 16 λз}
+
+ PCnUInt16Array = ^TCnUInt16Array;
+ {* ̬ 16 λָ}
+ TCnUInt16Array = array[0..(MaxInt div SizeOf(Word) - 1)] of Word;
+ {* ̬ 16 λ}
+
+ PCnInt32Array = ^TCnInt32Array;
+ {* ̬ 32 λзָ}
+ TCnInt32Array = array[0..(MaxInt div SizeOf(Integer) - 1)] of Integer;
+ {* ̬ 32 λз}
+
+ PCnUInt32Array = ^TCnUInt32Array;
+ {* ̬ 32 λָ}
+ TCnUInt32Array = array[0..(MaxInt div SizeOf(Cardinal) - 1)] of Cardinal;
+ {* ̬ 32 λ}
+
+ PCnInt64Array = ^TCnInt64Array;
+ {* ̬ 64 λзָ}
+ TCnInt64Array = array[0..(MaxInt div SizeOf(Int64) - 1)] of Int64;
+ {* ̬ 64 λз}
+
+ PCnUInt64Array = ^TCnUInt64Array;
+ {* ̬ 64 λָ}
+ TCnUInt64Array = array[0..(MaxInt div SizeOf(TUInt64) - 1)] of TUInt64;
+ {* ̬ 64 λ}
+
+type
+ TCnMemSortCompareProc = function (P1, P2: Pointer; ElementByteSize: Integer): Integer;
+ {* ڴ̶ߴȽϺԭ}
+
+const
+ CN_MAX_SQRT_INT64: Cardinal = 3037000499;
+ {* 64 λзΧƽ}
+ CN_MAX_INT8: ShortInt = $7F;
+ {* 8 λз}
+ CN_MIN_INT8: ShortInt = -128;
+ {* С 8 λз}
+ CN_MAX_INT16: SmallInt = $7FFF;
+ {* 16 λз}
+ CN_MIN_INT16: SmallInt = -32768;
+ {* С 16 λз}
+ CN_MAX_INT32: Integer = $7FFFFFFF;
+ {* 32 λз}
+{$WARNINGS OFF}
+ CN_MIN_INT32: Integer = $80000000;
+ {* С 32 λз -2147483648}
+ // 뾯棬д -2147483648
+{$WARNINGS ON}
+ CN_MIN_INT32_IN_INT64: Int64 = $0000000080000000;
+ {* 64 λзΧС 32 λз -2147483648}
+ CN_MAX_INT64: Int64 = $7FFFFFFFFFFFFFFF;
+ {* 64 λз}
+ CN_MIN_INT64: Int64 = $8000000000000000;
+ {* С 64 λз}
+ CN_MAX_UINT8: Byte = $FF;
+ {* 8 λ}
+ CN_MAX_UINT16: Word = $FFFF;
+ {* 16 λ}
+ CN_MAX_UINT32: Cardinal = $FFFFFFFF;
+ {* 32 λ}
+ CN_MAX_TUINT64: TUInt64 = $FFFFFFFFFFFFFFFF;
+ {* 64 λ}
+ CN_MAX_SIGNED_INT64_IN_TUINT64: TUInt64 = $7FFFFFFFFFFFFFFF;
+ {* 64 λΧ 64 λз}
+
+{*
+ D567 Ȳ֧ UInt64 ıȻ Int64 UInt64 мӼ洢
+ ˳ֱɣװ System е _lludiv _llumod
+ ʵ Int64 ʾ UInt64 ݵ div mod ܡ
+}
+function UInt64Mod(A: TUInt64; B: TUInt64): TUInt64;
+{* 64 λࡣ
+
+
+ A: TUInt64 -
+ B: TUInt64 -
+
+ ֵTUInt64 -
+}
+
+function UInt64Div(A: TUInt64; B: TUInt64): TUInt64;
+{* 64 λ
+
+
+ A: TUInt64 -
+ B: TUInt64 -
+
+ ֵTUInt64 -
+}
+
+function UInt64Mul(A: Cardinal; B: Cardinal): TUInt64;
+{* 32 λˡڲ֧ UInt64 ƽ̨ϣ UInt64 ʽ Int64
+ ֱʹ Int64 п
+
+
+ A: Cardinal - һ
+ B: Cardinal -
+
+ ֵTUInt64 -
+}
+
+procedure UInt64AddUInt64(A: TUInt64; B: TUInt64; var ResLo: TUInt64; var ResHi: TUInt64);
+{* 64 λӣ ResLo ResHi С
+ עڲʵְ㷨ΪӣʵResHi Ȼ 1ֱж 1
+
+
+ A: TUInt64 - һ
+ B: TUInt64 -
+ var ResLo: TUInt64 - ͵λ
+ var ResHi: TUInt64 - λ
+
+ ֵޣ
+}
+
+procedure UInt64MulUInt64(A: TUInt64; B: TUInt64; var ResLo: TUInt64; var ResHi: TUInt64);
+{* 64 λˣ ResLo ResHi СWin 64 λûʵ֣Լһϡ
+
+
+ A: TUInt64 - һ
+ B: TUInt64 -
+ var ResLo: TUInt64 - λ
+ var ResHi: TUInt64 - λ
+
+ ֵޣ
+}
+
+function UInt64ToHex(N: TUInt64; RemoveZeroPrefix: Boolean = False): string;
+{* 64 λתΪʮַ
+
+
+ N: TUInt64 - תֵ
+ RemoveZeroPrefix: Boolean - Ƿȥתλ 0Ĭϲȥ
+
+ ֵstring - ʮַ
+}
+
+function UInt64ToStr(N: TUInt64): string;
+{* 64 λתΪʮַ
+
+
+ N: TUInt64 - תֵ
+
+ ֵstring - ʮַ
+}
+
+function StrToUInt64(const S: string): TUInt64;
+{* ַתΪ 64 λ
+
+
+ const S: string - תַ
+
+ ֵTUInt64 - ת
+}
+
+function UInt64Compare(A: TUInt64; B: TUInt64): Integer;
+{* Ƚ 64 λֱֵݱȽϵĽǴڡڻС 10-1
+
+
+ A: TUInt64 - Ƚϵһ
+ B: TUInt64 - Ƚϵ
+
+ ֵInteger - رȽϽ
+}
+
+function UInt64Sqrt(N: TUInt64): TUInt64;
+{* 64 λƽ֡
+
+
+ N: TUInt64 - ƽ
+
+ ֵTUInt64 - ƽ
+}
+
+function UInt32IsNegative(N: Cardinal): Boolean;
+{* ж 32 λ 32 λзʱǷС 0
+
+
+ N: Cardinal - жϵֵ
+
+ ֵBoolean - ǷС 0
+}
+
+function UInt64IsNegative(N: TUInt64): Boolean;
+{* ж 64 λ 64 λзʱǷС 0
+
+
+ N: TUInt64 - жϵֵ
+
+ ֵBoolean - ǷС 0
+}
+
+procedure UInt64SetBit(var B: TUInt64; Index: Integer);
+{* 64 λijһλ 1λ Index 0 ʼ 63
+
+
+ var B: TUInt64 - λֵ
+ Index: Integer - 1 λ
+
+ ֵޣ
+}
+
+procedure UInt64ClearBit(var B: TUInt64; Index: Integer);
+{* 64 λijһλ 0λ Index 0 ʼ 63
+
+
+ var B: TUInt64 - λֵ
+ Index: Integer - 0 λ
+
+ ֵޣ
+}
+
+function GetUInt64BitSet(B: TUInt64; Index: Integer): Boolean;
+{* 64 λijһλǷ 1λ Index 0 ʼ 63
+
+
+ B: TUInt64 - жϵֵ
+ Index: Integer - жϵλ
+
+ ֵBoolean - ظλǷ 1
+}
+
+function GetUInt64HighBits(B: TUInt64): Integer;
+{* 64 λ 1 ߶λǵڼλλ 0û 1 -1
+
+
+ B: TUInt64 - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt32HighBits(B: Cardinal): Integer;
+{* 32 λ 1 ߶λǵڼλλ 0û 1 -1
+
+
+ B: Cardinal - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt16HighBits(B: Word): Integer;
+{* 16 λ 1 ߶λǵڼλλ 0û 1 -1
+
+
+ B: Word - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt8HighBits(B: Byte): Integer;
+{* 8 λ 1 ߶λǵڼλλ 0û 1 -1
+
+
+ B: Byte - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt64BitLength(B: TUInt64): Integer;
+{* 64 λȥλ 0 ʣµλȣû 1 0
+
+
+ B: TUInt64 - жϵֵ
+
+ ֵInteger - Чλ
+}
+
+function GetUInt32BitLength(B: Cardinal): Integer;
+{* 32 λȥλ 0 ʣµλȣû 1 0
+
+
+ B: Cardinal - жϵֵ
+
+ ֵInteger - Чλ
+}
+
+function GetUInt16BitLength(B: Word): Integer;
+{* 16 λȥλ 0 ʣµλȣû 1 0
+
+
+ B: Word - жϵֵ
+
+ ֵInteger - Чλ
+}
+
+function GetUInt8BitLength(B: Byte): Integer;
+{* 8 λȥλ 0 ʣµλȣû 1 0
+
+
+ B: Byte - жϵֵ
+
+ ֵInteger - Чλ
+}
+
+function GetUInt64LowBits(B: TUInt64): Integer;
+{* 64 λ 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+
+
+ B: TUInt64 - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt32LowBits(B: Cardinal): Integer;
+{* 32 λ 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+
+
+ B: Cardinal - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt16LowBits(B: Word): Integer;
+{* 16 λ 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+
+
+ B: Word - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function GetUInt8LowBits(B: Byte): Integer;
+{* 8 λ 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+
+
+ B: Byte - жϵֵ
+
+ ֵInteger - 1 λ
+}
+
+function Int64Mod(M: Int64; N: Int64): Int64;
+{* װ Int64 ModM ֵʱȡģģ N Ҫס
+
+
+ M: Int64 -
+ N: Int64 -
+
+ ֵInt64 -
+}
+
+function Int64CenterMod(A: Int64; N: Int64): Int64;
+{* A mod N Ļ (-(N - 1)/2 ½磨, (N - 1)/ 2 ½磨 0]
+ Ҫ N ע⣬Ļǽ A mod N ֵƣdzһֱӼ N
+ һľȷǣ N/2 ִģֱӼ N N ż
+ ڱ߽磺һ仰ԳżϿ
+ N 7 [-3, 3] 3 Ķ 7ע 3
+ N 6 [-2, 3] 3 Ķ 6ע 3 Ҳ
+ N Ϊʱ(N - 1)żԶ 0 һ N 0 N - 1ӳ䵽 [-(N - 1)/2, (N - 1)/2]
+ N ΪżʱN/2 ż߽ -N/2 + 1ұ߽ N/20 N - 1ӳ䵽 [-N/2 + 1, N/2]
+
+
+ A: Int64 - Ļֵ
+ N: Int64 - ģ
+
+ ֵInt64 - Ļ
+}
+
+function IsUInt32PowerOf2(N: Cardinal): Boolean;
+{* жһ 32 λǷ 2 ݡ
+
+
+ N: Cardinal - жϵֵ
+
+ ֵBoolean - Ƿ 2
+}
+
+function IsUInt64PowerOf2(N: TUInt64): Boolean;
+{* жһ 64 λǷ 2 ݡ
+
+
+ N: TUInt64 - жϵֵ
+
+ ֵBoolean - Ƿ 2
+}
+
+function GetUInt32PowerOf2GreaterEqual(N: Cardinal): Cardinal;
+{* õһָ 32 λȵ 2 ݣ 0
+
+
+ N: Cardinal - ֵ
+
+ ֵCardinal - ط 2 ݻ 0
+}
+
+function GetUInt64PowerOf2GreaterEqual(N: TUInt64): TUInt64;
+{* õһָ 64 λȵ 2 ݣ 0
+
+
+ N: TUInt64 - ֵ
+
+ ֵTUInt64 - ط 2 ݻ 0
+}
+
+function IsInt32AddOverflow(A: Integer; B: Integer): Boolean;
+{* ж 32 λзǷ 32 λзޡ
+
+
+ A: Integer - һ
+ B: Integer -
+
+ ֵBoolean - Ƿ
+}
+
+function IsUInt32AddOverflow(A: Cardinal; B: Cardinal): Boolean;
+{* ж 32 λǷ 32 λޡ
+
+
+ A: Cardinal - һ
+ B: Cardinal -
+
+ ֵBoolean - Ƿ
+}
+
+function IsInt64AddOverflow(A: Int64; B: Int64): Boolean;
+{* ж 64 λзǷ 64 λзޡ
+
+
+ A: Int64 - һ
+ B: Int64 -
+
+ ֵBoolean - Ƿ
+}
+
+function IsUInt64AddOverflow(A: TUInt64; B: TUInt64): Boolean;
+{* ж 64 λǷ 64 λޡ
+
+
+ A: TUInt64 - һ
+ B: TUInt64 -
+
+ ֵBoolean - Ƿ
+}
+
+function IsUInt64SubOverflowInt32(A: TUInt64; B: TUInt64): Boolean;
+{* жһ 64 λȥһ 64 λĽǷ 32 λзΧ
+ 64 λе JMP תжϡ
+
+
+ A: TUInt64 -
+ B: TUInt64 -
+
+ ֵBoolean - Ƿ 32 λзΧ
+}
+
+procedure UInt64Add(var R: TUInt64; A: TUInt64; B: TUInt64; out Carry: Integer);
+{* 64 λӣA + B => R 1 ýλλ㡣
+
+
+ var R: TUInt64 -
+ A: TUInt64 - һ
+ B: TUInt64 -
+ out Carry: Integer - λ
+
+ ֵޣ
+}
+
+procedure UInt64Sub(var R: TUInt64; A: TUInt64; B: TUInt64; out Carry: Integer);
+{* 64 λA - B => Rнλ 1 ýλλ㡣
+
+
+ var R: TUInt64 -
+ A: TUInt64 -
+ B: TUInt64 -
+ out Carry: Integer - λ
+
+ ֵޣ
+}
+
+function IsInt32MulOverflow(A: Integer; B: Integer): Boolean;
+{* ж 32 λзǷ 32 λзޡ
+
+
+ A: Integer - һ
+ B: Integer -
+
+ ֵBoolean - Ƿ
+}
+
+function IsUInt32MulOverflow(A: Cardinal; B: Cardinal): Boolean;
+{* ж 32 λǷ 32 λ
+
+
+ A: Cardinal - һ
+ B: Cardinal -
+
+ ֵBoolean - Ƿ
+}
+
+function IsUInt32MulOverflowInt64(A: Cardinal; B: Cardinal; out R: TUInt64): Boolean;
+{* ж 32 λǷ 64 λзޣδҲ False ʱR ֱӷؽ
+ Ҳ TrueҪµ UInt64Mul ʵʩˡ
+
+
+ A: Cardinal - һ
+ B: Cardinal -
+ out R: TUInt64 - δʱػ
+
+ ֵBoolean - Ƿ
+}
+
+function IsInt64MulOverflow(A: Int64; B: Int64): Boolean;
+{* ж 64 λзǷ 64 λзޡ
+
+
+ A: Int64 - һ
+ B: Int64 -
+
+ ֵBoolean - Ƿ
+}
+
+function PointerToInteger(P: Pointer): Integer;
+{* ָת֧ͣ 32/64 λע 64 λ¿ܻᶪ 32 λݡ
+
+
+ P: Pointer - תָ
+
+ ֵInteger - ת
+}
+
+function IntegerToPointer(I: Integer): Pointer;
+{* תָ֧ͣ 32/64 λ
+
+
+ I: Integer - ת
+
+ ֵPointer - תָ
+}
+
+function Int64NonNegativeAddMod(A: Int64; B: Int64; N: Int64): Int64;
+{* 64 λзΧĺ࣬Ҫ N 0
+
+
+ A: Int64 - һ
+ B: Int64 - һ
+ N: Int64 - ģ
+
+ ֵInt64 - Ľ
+}
+
+function UInt64NonNegativeAddMod(A: TUInt64; B: TUInt64; N: TUInt64): TUInt64;
+{* 64 λΧĺ࣬Ҫ N 0
+
+
+ A: TUInt64 - һ
+ B: TUInt64 -
+ N: TUInt64 - ģ
+
+ ֵTUInt64 - Ľ
+}
+
+function Int64NonNegativeMulMod(A: Int64; B: Int64; N: Int64): Int64;
+{* 64 λзΧڵֱ࣬Ӽ㣬Ҫ N 0
+
+
+ A: Int64 - һ
+ B: Int64 -
+ N: Int64 - ģ
+
+ ֵInt64 - Ľ
+}
+
+function UInt64NonNegativeMulMod(A: TUInt64; B: TUInt64; N: TUInt64): TUInt64;
+{* 64 λΧڵֱ࣬Ӽ㣬
+
+
+ A: TUInt64 - һ
+ B: TUInt64 -
+ N: TUInt64 - ģ
+
+ ֵTUInt64 - Ľ
+}
+
+function Int64NonNegativeMod(N: Int64; P: Int64): Int64;
+{* װ 64 λзķǸຯҲΪʱӸ豣֤ P 0
+
+
+ N: Int64 -
+ P: Int64 -
+
+ ֵInt64 - طǸĽ
+}
+
+function Int64NonNegativPower(N: Int64; Exp: Integer): Int64;
+{* 64 λзķǸָݣ
+
+
+ N: Int64 -
+ Exp: Integer - ָҪ 0
+
+ ֵInt64 - ݵĽ
+}
+
+function Int64NonNegativeRoot(N: Int64; Exp: Integer): Int64;
+{* 64 λзķǸη֣
+
+
+ N: Int64 -
+ Exp: Integer -
+
+ ֵInt64 - ؿֽ
+}
+
+function UInt64NonNegativPower(N: TUInt64; Exp: Integer): TUInt64;
+{* 64 λķǸָݣ
+
+
+ N: TUInt64 -
+ Exp: Integer - ָҪ 0
+
+ ֵTUInt64 - ݵĽ
+}
+
+function UInt64NonNegativeRoot(N: TUInt64; Exp: Integer): TUInt64;
+{* 64 λķǸη֣
+
+
+ N: TUInt64 -
+ Exp: Integer -
+
+ ֵTUInt64 - ؿֽ
+}
+
+function CurrentByteOrderIsBigEndian: Boolean;
+{* صǰڻǷǴˣҲǷеĸֽڴ洢ڽϵ͵ʼַ
+ ϴҵĶϰߣ粿ָ ARM MIPS
+
+
+ ޣ
+
+ ֵBoolean - صǰڻǷǴ
+}
+
+function CurrentByteOrderIsLittleEndian: Boolean;
+{* صǰڻǷСˣҲǷеĸֽڴ洢ڽϸߵʼַ x86 벿Ĭ ARM
+
+
+ ޣ
+
+ ֵBoolean - صǰڻǷС
+}
+
+function Int64ToBigEndian(Value: Int64): Int64;
+{* ȷ 64 λзֵΪˣС˻лת
+
+
+ Value: Int64 - ת 64 λз
+
+ ֵInt64 - شֵ
+}
+
+function Int32ToBigEndian(Value: Integer): Integer;
+{* ȷ 32 λзֵΪˣС˻лת
+
+
+ Value: Integer - ת 32 λз
+
+ ֵInteger - شֵ
+}
+
+function Int16ToBigEndian(Value: SmallInt): SmallInt;
+{* ȷ 16 λзֵΪˣС˻лת
+
+
+ Value: SmallInt - ת 16 λз
+
+ ֵSmallInt - شֵ
+}
+
+function Int64ToLittleEndian(Value: Int64): Int64;
+{* ȷ 64 λзֵΪСˣڴ˻лת
+
+
+ Value: Int64 - ת 64 λз
+
+ ֵInt64 - شֵ
+}
+
+function Int32ToLittleEndian(Value: Integer): Integer;
+{* ȷ 32 λзֵΪСˣڴ˻лת
+
+
+ Value: Integer - ת 32 λз
+
+ ֵInteger - Сֵ
+}
+
+function Int16ToLittleEndian(Value: SmallInt): SmallInt;
+{* ȷ 16 λзֵΪСˣڴ˻лת
+
+
+ Value: SmallInt - ת 16 λз
+
+ ֵSmallInt - Сֵ
+}
+
+function UInt64ToBigEndian(Value: TUInt64): TUInt64;
+{* ȷ 64 λֵΪˣС˻лת
+
+
+ Value: TUInt64 - ת 64 λ
+
+ ֵTUInt64 - شֵ
+}
+
+function UInt32ToBigEndian(Value: Cardinal): Cardinal;
+{* ȷ 32 λֵΪˣС˻лת
+
+
+ Value: Cardinal - ת 32 λ
+
+ ֵCardinal - شֵ
+}
+
+function UInt16ToBigEndian(Value: Word): Word;
+{* ȷ 16 λֵΪˣС˻лת
+
+
+ Value: Word - ת 16 λ
+
+ ֵWord - شֵ
+}
+
+function UInt64ToLittleEndian(Value: TUInt64): TUInt64;
+{* ȷ 64 λֵΪСˣڴ˻лת
+
+
+ Value: TUInt64 - ת 64 λ
+
+ ֵTUInt64 - شֵ
+}
+
+function UInt32ToLittleEndian(Value: Cardinal): Cardinal;
+{* ȷ 32 λֵΪСˣڴ˻лת
+
+
+ Value: Cardinal - ת 32 λ
+
+ ֵCardinal - Сֵ
+}
+
+function UInt16ToLittleEndian(Value: Word): Word;
+{* ȷ 16 λֵΪСˣڴ˻лת
+
+
+ Value: Word - ת 16 λ
+
+ ֵWord - Сֵ
+}
+
+function Int64HostToNetwork(Value: Int64): Int64;
+{* 64 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Int64 - ת 64 λз
+
+ ֵInt64 - ֽ˳ֵ
+}
+
+function Int32HostToNetwork(Value: Integer): Integer;
+{* 32 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Integer - ת 32 λз
+
+ ֵInteger - ֽ˳ֵ
+}
+
+function Int16HostToNetwork(Value: SmallInt): SmallInt;
+{* 16 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: SmallInt - ת 16 λз
+
+ ֵSmallInt - ֽ˳ֵ
+}
+
+function Int64NetworkToHost(Value: Int64): Int64;
+{* 64 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Int64 - ת 64 λз
+
+ ֵInt64 - ֽ˳ֵ
+}
+
+function Int32NetworkToHost(Value: Integer): Integer;
+{* 32 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Integer - ת 32 λз
+
+ ֵInteger - ֽ˳ֵ
+}
+
+function Int16NetworkToHost(Value: SmallInt): SmallInt;
+{* 16 λзֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: SmallInt - ת 16 λз
+
+ ֵSmallInt - ֽ˳ֵ
+}
+
+function UInt64HostToNetwork(Value: TUInt64): TUInt64;
+{* 64 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: TUInt64 - ת 64 λ
+
+ ֵTUInt64 - ֽ˳ֵ
+}
+
+function UInt32HostToNetwork(Value: Cardinal): Cardinal;
+{* 32 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Cardinal - ת 32 λ
+
+ ֵCardinal - ֽ˳ֵ
+}
+
+function UInt16HostToNetwork(Value: Word): Word;
+{* 16 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Word - ת 16 λ
+
+ ֵWord - ֽ˳ֵ
+}
+
+function UInt64NetworkToHost(Value: TUInt64): TUInt64;
+{* 64 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: TUInt64 - ת 64 λ
+
+ ֵTUInt64 - ֽ˳ֵ
+}
+
+function UInt32NetworkToHost(Value: Cardinal): Cardinal;
+{* 32 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Cardinal - ת 32 λ
+
+ ֵCardinal - ֽ˳ֵ
+}
+
+function UInt16NetworkToHost(Value: Word): Word;
+{* 16 λֵֽ˳תΪֽ˳С˻лת
+
+
+ Value: Word - ת 16 λ
+
+ ֵWord - ֽ˳ֵ
+}
+
+procedure MemoryNetworkToHost(Mem: Pointer; MemByteLen: Integer);
+{* һƬڴֽ˳תΪֽ˳С˻лת
+ ÷ӦóϽ٣¶ġֽתѾ㹻
+
+
+ Mem: Pointer - תݿַ
+ MemByteLen: Integer - תݿֽڳ
+
+ ֵޣ
+}
+
+procedure MemoryHostToNetwork(Mem: Pointer; MemByteLen: Integer);
+{* һƬڴֽ˳תΪֽ˳С˻лת
+ ÷ӦóϽ٣¶ġֽתѾ㹻
+
+
+ Mem: Pointer - תݿַ
+ MemByteLen: Integer - תݿֽڳ
+
+ ֵޣ
+}
+
+procedure ReverseMemory(Mem: Pointer; MemByteLen: Integer);
+{* ֽ˳һڴ飬ֽڲ䡣
+
+
+ Mem: Pointer - õݿַ
+ MemByteLen: Integer - õݿֽڳ
+
+ ֵޣ
+}
+
+function ReverseBitsInInt8(V: Byte): Byte;
+{* һֽڲλݡ
+
+
+ V: Byte - õһֽ
+
+ ֵByte - صֵ
+}
+
+function ReverseBitsInInt16(V: Word): Word;
+{* öֽڼڲλݡ
+
+
+ V: Word - õĶֽ
+
+ ֵWord - صֵ
+}
+
+function ReverseBitsInInt32(V: Cardinal): Cardinal;
+{* ֽڼڲλݡ
+
+
+ V: Cardinal - õֽ
+
+ ֵCardinal - صֵ
+}
+
+function ReverseBitsInInt64(V: Int64): Int64;
+{* ðֽڼڲλݡ
+
+
+ V: Int64 - õİֽ
+
+ ֵInt64 - صֵ
+}
+
+procedure ReverseMemoryWithBits(Mem: Pointer; MemByteLen: Integer);
+{* ֽ˳һڴ飬ÿֽҲ
+
+
+ Mem: Pointer - õݿַ
+ MemByteLen: Integer - õݿֽڳ
+
+ ֵޣ
+}
+
+procedure MemoryAnd(AMem: Pointer; BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+{* 鳤ͬڴ AMem BMem λ룬 ResMem У߿ͬ
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ ResMem: Pointer - ݿַ
+
+ ֵޣ
+}
+
+procedure MemoryOr(AMem: Pointer; BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+{* 鳤ͬڴ AMem BMem λ ResMem У߿ͬ
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ ResMem: Pointer - ݿַ
+
+ ֵޣ
+}
+
+procedure MemoryXor(AMem: Pointer; BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+{* 鳤ͬڴ AMem BMem λ ResMem У߿ͬ
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ ResMem: Pointer - ݿַ
+
+ ֵޣ
+}
+
+procedure MemoryNot(Mem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+{* һڴ AMem ȡ ResMem У߿ͬ
+
+
+ Mem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ ResMem: Pointer - ݿַ
+
+ ֵޣ
+}
+
+procedure MemoryShiftLeft(AMem: Pointer; BMem: Pointer; MemByteLen: Integer; BitCount: Integer);
+{* AMem ڴ BitCount λ BMemڴַλƣλ 0߿ȡ
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ BitCount: Integer - Ƶλ
+
+ ֵޣ
+}
+
+procedure MemoryShiftRight(AMem: Pointer; BMem: Pointer; MemByteLen: Integer; BitCount: Integer);
+{* AMem ڴ BitCount λ BMemڴַλƣλ 0߿ȡ
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ BitCount: Integer - Ƶλ
+
+ ֵޣ
+}
+
+function MemoryIsBitSet(Mem: Pointer; N: Integer): Boolean;
+{* ڴij Bit λǷ 1ڴַλ 0ֽڻұΪ 0
+
+
+ Mem: Pointer - ݿַ
+ N: Integer - λ
+
+ ֵBoolean - Ƿ 1
+}
+
+procedure MemorySetBit(Mem: Pointer; N: Integer);
+{* ڴij Bit λ 1ڴַλ 0ֽڻұΪ 0
+
+
+ Mem: Pointer - ݿַ
+ N: Integer - λ
+
+ ֵޣ
+}
+
+procedure MemoryClearBit(Mem: Pointer; N: Integer);
+{* ڴij Bit λ 0ڴַλ 0ֽڻұΪ 0
+
+
+ Mem: Pointer - ݿַ
+ N: Integer - λ
+
+ ֵޣ
+}
+
+function MemoryGetHighBits(Mem: Pointer; MemByteLen: Integer): Integer;
+{* ڴ 1 ߶λǵڼλߡָ͵ַû 1 -1
+ ڴӵַ͵߱Ϊ 8 * MemByteLen - 1 0 ôλĩֽڵλ 0 λ
+
+
+ Mem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+
+ ֵInteger - 1 λ
+}
+
+function MemoryGetLowBits(Mem: Pointer; MemByteLen: Integer): Integer;
+{* ڴ 1 Ͷλǵڼλָ͡ߵַû 1 -1
+ ڴӵַ͵߱Ϊ 8 * MemByteLen - 1 0 ôλĩֽڵλ 0 λ
+
+
+ Mem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+
+ ֵInteger - 1 λ
+}
+
+function MemoryToBinStr(Mem: Pointer; MemByteLen: Integer; Sep: Boolean = False): string;
+{* һڴݴӵ͵ֽ˳ΪַSep ʾֽ֮Ƿոָ
+
+
+ Mem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+ Sep: Boolean - ֽ֮Ƿÿոָ
+
+ ֵstring - ضַ
+}
+
+procedure MemorySwap(AMem: Pointer; BMem: Pointer; MemByteLen: Integer);
+{* ͬȵڴݣͬڴʲô
+
+
+ AMem: Pointer - ݿַһ
+ BMem: Pointer - ݿַ
+ MemByteLen: Integer - ݿֽڳ
+
+ ֵޣ
+}
+
+function MemoryCompare(AMem: Pointer; BMem: Pointer; MemByteLen: Integer): Integer;
+{* ķʽȽڴ棬 10-1ͬڴֱӷ 0
+
+
+ AMem: Pointer - Ƚϵݿַһ
+ BMem: Pointer - Ƚϵݿַ
+ MemByteLen: Integer - Ƚϵݿֽڳ
+
+ ֵInteger - رȽϵĽ
+}
+
+procedure MemoryQuickSort(Mem: Pointer; ElementByteSize: Integer;
+ ElementCount: Integer; CompareProc: TCnMemSortCompareProc = nil);
+{* Թ̶СԪص
+
+
+ Mem: Pointer - ݿַ
+ ElementByteSize: Integer - Ԫֽڳ
+ ElementCount: Integer - ݿԪصĸ
+ CompareProc: TCnMemSortCompareProc - ԪرȽϵĻص
+
+ ֵޣ
+}
+
+function UInt8ToBinStr(V: Byte): string;
+{* һ 8 λתΪַ
+
+
+ V: Byte - ת 8 λ
+
+ ֵstring - ضַ
+}
+
+function UInt16ToBinStr(V: Word): string;
+{* һ 16 λתΪַ
+
+
+ V: Word - ת 16 λ
+
+ ֵstring - ضַ
+}
+
+function UInt32ToBinStr(V: Cardinal): string;
+{* һ 32 λתΪַ
+
+
+ V: Cardinal - ת 32 λ
+
+ ֵstring - ضַ
+}
+
+function UInt32ToStr(V: Cardinal): string;
+{* һ 32 λתΪʮַ
+
+
+ V: Cardinal - ת 32 λ
+
+ ֵstring - ʮַ
+}
+
+function UInt64ToBinStr(V: TUInt64): string;
+{* һ 64 λתΪַ
+
+
+ V: TUInt64 - ת 64 λ
+
+ ֵstring - ضַ
+}
+
+function StrToUInt(const S: string): Cardinal;
+{* ַתΪ 32 λ
+
+
+ const S: string - תַ
+
+ ֵCardinal - ת
+}
+
+function HexToInt(const Hex: string): Integer; overload;
+{* һʮַתΪͣʺϽ϶ 2 ַַ
+
+
+ const Hex: string - תʮַ
+
+ ֵInteger -
+}
+
+function HexToInt(Hex: PChar; CharLen: Integer): Integer; overload;
+{* һʮַָָתΪͣʺϽ϶ 2 ַַ
+
+
+ Hex: PChar - תʮַַ
+ CharLen: Integer - ַ
+
+ ֵInteger -
+}
+
+function IsHexString(const Hex: string): Boolean;
+{* жһַǷϷʮִַСд
+
+
+ const Hex: string - жϵʮַ
+
+ ֵBoolean - ǷǺϷʮַ
+}
+
+function DataToHex(InData: Pointer; ByteLength: Integer; UseUpperCase: Boolean = True): string;
+{* ڴתΪʮַڴλݳַ൱ֽ˳
+ UseUpperCase ݵĴСд
+
+
+ InData: Pointer - תݿַ
+ ByteLength: Integer - תݿֽڳ
+ UseUpperCase: Boolean - ʮַڲǷд
+
+ ֵstring - ʮַ
+}
+
+function HexToData(const Hex: string; OutData: Pointer = nil): Integer;
+{* ʮַתΪڴ飬ַݳڴλ൱ֽ˳
+ ʮַΪתʧʱ׳쳣תɹֽ
+ ע OutData Ӧָ㹻תݵֽڳΪ Length(Hex) div 2
+ nilֻֽڳȣʽת
+
+
+ const Hex: string - תʮַ
+ OutData: Pointer - ֽڳӦΪ Length(Hex) div 2
+
+ ֵInteger - תֽڳ
+}
+
+function StringToHex(const Data: string; UseUpperCase: Boolean = True): string;
+{* ַתΪʮַUseUpperCase ݵĴСд
+
+
+ const Data: string - תַ
+ UseUpperCase: Boolean - ʮַڲǷд
+
+ ֵstring - תʮַ
+}
+
+function HexToString(const Hex: string): string;
+{* ʮַתΪַʮַΪתʧʱ׳쳣
+
+
+ const Hex: string - תʮַ
+
+ ֵstring - תַ
+}
+
+function HexToAnsiStr(const Hex: AnsiString): AnsiString;
+{* ʮַתΪַʮַΪתʧʱ׳쳣
+
+
+ const Hex: AnsiString - תʮַ
+
+ ֵAnsiString - תַ
+}
+
+function AnsiStrToHex(const Data: AnsiString; UseUpperCase: Boolean = True): AnsiString;
+{* AnsiString תΪʮַUseUpperCase ݵĴСд
+
+
+ const Data: AnsiString - תַ
+ UseUpperCase: Boolean - ʮַڲǷд
+
+ ֵAnsiString - ʮַ
+}
+
+function BytesToHex(const Data: TBytes; UseUpperCase: Boolean = True): string;
+{* ֽתΪʮַ±λݳַ൱ֽ˳
+ UseUpperCase ݵĴСд
+
+
+ const Data: TBytes - תֽ
+ UseUpperCase: Boolean - ʮַڲǷд
+
+ ֵstring - ʮַ
+}
+
+function HexToBytes(const Hex: string): TBytes;
+{* ʮַתΪֽ飬ַߵݳ±λ൱ֽ˳
+ ַΪתʧʱ׳쳣
+
+
+ const Hex: string - תʮַ
+
+ ֵTBytes - ½ֽ
+}
+
+function StreamToHex(Stream: TStream; UseUpperCase: Boolean = True): string;
+{* еȫݴͷתΪʮַ
+
+
+ Stream: TStream -
+ UseUpperCase: Boolean - ʮַڲǷд
+
+ ֵstring - ʮַ
+}
+
+function HexToStream(const Hex: string; Stream: TStream): Integer;
+{* ʮַתдУдֽ
+
+
+ const Hex: string - תʮַ
+ Stream: TStream - д
+
+ ֵInteger - дֽ
+}
+
+function WriteBytesToStream(const Data: TBytes; Stream: TStream): Integer;
+{* ֽдУдֽ
+
+
+ const Data: TBytes - дֽ
+ Stream: TStream - д
+
+ ֵInteger - дֽ
+}
+
+procedure ReverseBytes(Data: TBytes);
+{* ֽ˳һֽݡ
+
+
+ Data: TBytes - õֽ
+
+ ֵޣ
+}
+
+function CloneBytes(const Data: TBytes): TBytes;
+{* һµֽ
+
+
+ const Data: TBytes - Ƶֽ
+
+ ֵTBytes - ½ֽ
+}
+
+function StreamToBytes(Stream: TStream): TBytes;
+{* ͷȫֽ飬½ֽ顣
+
+
+ Stream: TStream -
+
+ ֵTBytes - ½ֽ
+}
+
+function BytesToStream(const Data: TBytes; OutStream: TStream): Integer;
+{* ֽдԭʼдֽ
+
+
+ const Data: TBytes - дֽ
+ OutStream: TStream - д
+
+ ֵInteger - дֽ
+}
+
+function AnsiToBytes(const Str: AnsiString): TBytes;
+{* AnsiString ֱתΪֽ飬롣
+
+
+ const Str: AnsiString - תַ
+
+ ֵTBytes - תֽ
+}
+
+function BytesToAnsi(const Data: TBytes): AnsiString;
+{* ֱֽתΪ AnsiString롣
+
+
+ const Data: TBytes - תֽ
+
+ ֵAnsiString - תַ
+}
+
+function BytesToString(const Data: TBytes): string;
+{* ֽתΪ stringڲ Byte ֵΪ Char롣
+
+
+ const Data: TBytes - תֽ
+
+ ֵstring - תַ
+}
+
+function MemoryToString(Mem: Pointer; MemByteLen: Integer): string;
+{* ڴתΪ stringڲֽڸֵ롣
+
+
+ Mem: Pointer - תݿַ
+ MemByteLen: Integer - תݿֽڳ
+
+ ֵstring - תַ
+}
+
+function BitsToString(Bits: TBits): string;
+{* λתΪ 0 1 ַ
+
+
+ Bits: TBits - תλ
+
+ ֵstring - תַ
+}
+
+function ConcatBytes(const A: TBytes; const B: TBytes): TBytes; overload;
+{* A B ֽ˳ƴ÷һֽ飬A B ֲ䡣
+
+
+ const A: TBytes - ƴӵֽһ
+ const B: TBytes - ƴӵֽ
+
+ ֵTBytes - ƴӵֽ
+}
+
+function ConcatBytes(const A: TBytes; const B: TBytes; const C: TBytes): TBytes; overload;
+{* A B C ֽ˳ƴ÷һֽ飬A B C ֲ䡣
+
+
+ const A: TBytes - ƴӵֽһ
+ const B: TBytes - ƴӵֽ
+ const C: TBytes - ƴӵֽ
+
+ ֵTBytes - ƴӵֽ
+}
+
+function ConcatBytes(const A: TBytes; const B: TBytes; const C: TBytes; const D: TBytes): TBytes; overload;
+{* A B C D ĸֽ˳ƴ÷һֽ飬A B C D ֲ䡣
+
+
+ const A: TBytes - ƴӵֽһ
+ const B: TBytes - ƴӵֽ
+ const C: TBytes - ƴӵֽ
+ const D: TBytes - ƴӵֽ
+
+ ֵTBytes - ƴӵֽ
+}
+
+function NewZeroBytes(ByteLen: Integer): TBytes;
+{* ByteLen ֽڳȵֽ顣
+
+
+ ByteLen: Integer - ֽֽڳ
+
+ ֵTBytes - ȫֽ
+}
+
+function ConcatBytesMemory(const A: TBytes; Data: Pointer; DataByteLen: Integer): TBytes;
+{* һֽһƬڴƴ÷һ飬ԭֽڴ䡣
+
+
+ const A: TBytes - ƴӵֽ
+ Data: Pointer - ƴӵݿַ
+ DataByteLen: Integer - ƴӵݿֽڳ
+
+ ֵTBytes - ƴӵֽ
+}
+
+function NewBytesFromMemory(Data: Pointer; DataByteLen: Integer): TBytes;
+{* ½һֽ飬һƬڴݹ
+
+
+ Data: Pointer - ݿַ
+ DataByteLen: Integer - ݿֽڳ
+
+ ֵTBytes - ½ֽ
+}
+
+procedure PutBytesToMemory(const Data: TBytes; Mem: Pointer; MaxByteSize: Integer = 0);
+{* һֽдָڴд
+
+
+ const Data: TBytes - ֽ
+ Mem: Pointer - дݿַ
+ MaxByteSize: Integer - дֽ0 ʾ
+
+ ֵޣ
+}
+
+function CompareBytes(const A: TBytes; const B: TBytes): Boolean; overload;
+{* ȽֽǷͬ
+
+
+ const A: TBytes - Ƚϵֽһ
+ const B: TBytes - Ƚϵֽ
+
+ ֵBoolean - رȽϽǷͬ
+}
+
+function CompareBytes(const A: TBytes; const B: TBytes; MaxLength: Integer): Boolean; overload;
+{* Ƚֽǰ MaxLength ֽڵǷͬ
+
+
+ const A: TBytes - Ƚϵֽһ
+ const B: TBytes - Ƚϵֽ
+ MaxLength: Integer - Ƚϵֽ
+
+ ֵBoolean - رȽϽǷͬ
+}
+
+function CompareBytesWithDiffIndex(const A, B: TBytes; out DiffIndex: Integer): Boolean;
+{* ȽֽǷͬ
+ ݲͬʱDiffIndex صһȵֽ -1
+
+
+ const A: TBytes - Ƚϵֽһ
+ const B: TBytes - Ƚϵֽ
+ out DiffIndex: Integer - صһȵֽ
+
+ ֵBoolean - رȽϽǷͬ
+}
+
+function MoveMost(const Source; var Dest; ByteLen: Integer; MostLen: Integer): Integer;
+{* Source ƶ ByteLen Ҳ MostLen ֽڵ Dest Уʵƶֽ
+ ByteLen С MostLen Dest 0Ҫ Dest MostLen
+
+
+ const Source - ƶԴλáַ
+ var Dest - ƶĿλáַҪ MostLen ֽ
+ ByteLen: Integer - ƶֽ
+ MostLen: Integer - ƶֽ
+
+ ֵInteger - ʵƶֽ
+}
+
+// =============================== ===================================
+
+function SarInt8(V: ShortInt; ShiftCount: Integer): ShortInt;
+{* һ 8 λзƣҲ÷λλơ
+
+
+ V: ShortInt - Ƶ 8 λз
+ ShiftCount: Integer - Ƶλ
+
+ ֵShortInt - λֵ
+}
+
+function SarInt16(V: SmallInt; ShiftCount: Integer): SmallInt;
+{* һ 16 λзƣҲ÷λλơ
+
+
+ V: SmallInt - Ƶ 16 λз
+ ShiftCount: Integer - Ƶλ
+
+ ֵSmallInt - λֵ
+}
+
+function SarInt32(V: Integer; ShiftCount: Integer): Integer;
+{* һ 32 λзƣҲ÷λλơ
+
+
+ V: Integer - Ƶ 32 λз
+ ShiftCount: Integer - Ƶλ
+
+ ֵInteger - λֵ
+}
+
+function SarInt64(V: Int64; ShiftCount: Integer): Int64;
+{* һ 64 λзƣҲ÷λλơ
+
+
+ V: Int64 - Ƶ 64 λз
+ ShiftCount: Integer - Ƶλ
+
+ ֵInt64 - λֵ
+}
+
+// ================ ִʱ̶ if жϵIJ ===============
+
+procedure ConstTimeConditionalSwap8(CanSwap: Boolean; var A: Byte; var B: Byte);
+{* 8 λͱִʱ̶CanSwap Ϊ True ʱʵʩ A B
+
+
+ CanSwap: Boolean - Ƿ
+ var A: Byte - 8 λͱһ
+ var B: Byte - 8 λͱ
+
+ ֵޣ
+}
+
+procedure ConstTimeConditionalSwap16(CanSwap: Boolean; var A: Word; var B: Word);
+{* 16 λͱִʱ̶CanSwap Ϊ True ʱʵʩ A B
+
+
+ CanSwap: Boolean - Ƿ
+ var A: Word - 16 λͱһ
+ var B: Word - 16 λͱ
+
+ ֵޣ
+}
+
+procedure ConstTimeConditionalSwap32(CanSwap: Boolean; var A: Cardinal; var B: Cardinal);
+{* 32 λͱִʱ̶CanSwap Ϊ True ʱʵʩ A B
+
+
+ CanSwap: Boolean - Ƿ
+ var A: Cardinal - 32 λͱһ
+ var B: Cardinal - 32 λͱ
+
+ ֵޣ
+}
+
+procedure ConstTimeConditionalSwap64(CanSwap: Boolean; var A: TUInt64; var B: TUInt64);
+{* 64 λͱִʱ̶CanSwap Ϊ True ʱʵʩ A B
+
+
+ CanSwap: Boolean - Ƿ
+ var A: TUInt64 - 64 λͱһ
+ var B: TUInt64 - 64 λͱ
+
+ ֵޣ
+}
+
+function ConstTimeEqual8(A: Byte; B: Byte): Boolean;
+{* ֽڵִʱ̶ıȽϣ CPU ָתԤµִʱ죬ͬʱ True
+
+
+ A: Byte - Ƚϵ 8 λͱһ
+ B: Byte - Ƚϵ 8 λͱ
+
+ ֵBoolean - Ƿ
+}
+
+function ConstTimeEqual16(A: Word; B: Word): Boolean;
+{* ˫ֽڵִʱ̶ıȽϣ CPU ָתԤµִʱ죬ͬʱ True
+
+
+ A: Word - Ƚϵ 16 λͱһ
+ B: Word - Ƚϵ 16 λͱ
+
+ ֵBoolean - Ƿ
+}
+
+function ConstTimeEqual32(A: Cardinal; B: Cardinal): Boolean;
+{* ֽڵִʱ̶ıȽϣ CPU ָתԤµִʱ죬ͬʱ True
+
+
+ A: Cardinal - Ƚϵ 32 λͱһ
+ B: Cardinal - Ƚϵ 32 λͱ
+
+ ֵBoolean - Ƿ
+}
+
+function ConstTimeEqual64(A: TUInt64; B: TUInt64): Boolean;
+{* ֽڵִʱ̶ıȽϣ CPU ָתԤµִʱ죬ͬʱ True
+
+
+ A: TUInt64 - Ƚϵ 64 λͱһ
+ B: TUInt64 - Ƚϵ 64 λͱ
+
+ ֵBoolean - Ƿ
+}
+
+function ConstTimeCompareMem(P1, P2: Pointer; ByteLength: Integer): Boolean;
+{* ͬȵڴִʱ̶ıȽϣͬʱ True
+
+
+ P1: Pointer - Ƚϵĵһڴַ
+ P2: Pointer - Ƚϵĵڶڴַ
+ ByteLength: Integer - Ƚϵֽڳ
+
+ ֵBoolean - Ƿ
+}
+
+function ConstTimeCompareBytes(const A, B: TBytes): Boolean;
+{* ִгͬʱֽĺ㶨ʱıȽϣ糤Ȳֱͬӷ Falseݾͬ True
+
+
+ const A: TBytes - Ƚϵֽһ
+ const B: TBytes - Ƚϵֽ
+
+ ֵBoolean - Ƿͬ
+}
+
+function ConstTimeExpandBoolean8(V: Boolean): Byte;
+{* V ֵ 8 λȫ 1 ȫ 0
+
+
+ V: Boolean - Ƿȫ 1
+
+ ֵByte - $FF 0
+}
+
+function ConstTimeExpandBoolean16(V: Boolean): Word;
+{* V ֵ 16 λȫ 1 ȫ 0
+
+
+ V: Boolean - Ƿȫ 1
+
+ ֵWord - $FFFF 0
+}
+
+function ConstTimeExpandBoolean32(V: Boolean): Cardinal;
+{* V ֵ 32 λȫ 1 ȫ 0
+
+
+ V: Boolean - Ƿȫ 1
+
+ ֵCardinal - $FFFFFFFF 0
+}
+
+function ConstTimeExpandBoolean64(V: Boolean): TUInt64;
+{* V ֵ 64 λȫ 1 ȫ 0
+
+
+ V: Boolean - Ƿȫ 1
+
+ ֵTUInt64 - $FFFFFFFFFFFFFFFF 0
+}
+
+function ConstTimeConditionalSelect8(Condition: Boolean; A: Byte; B: Byte): Byte;
+{* ֽڱִʱ̶жѡCondtion Ϊ True ʱ A B
+
+
+ Condition: Boolean - Ƿѡ A ҲDzһ
+ A: Byte - ѡ 8 λһ
+ B: Byte - ѡ 8 λ
+
+ ֵByte - ѡ 8 λ
+}
+
+function ConstTimeConditionalSelect16(Condition: Boolean; A: Word; B: Word): Word;
+{* ˫ֽڱִʱ̶жѡCondtion Ϊ True ʱ A B
+
+
+ Condition: Boolean - Ƿѡ A ҲDzһ
+ A: Word - ѡ 16 λһ
+ B: Word - ѡ 16 λ
+
+ ֵWord - ѡ 16 λ
+}
+
+function ConstTimeConditionalSelect32(Condition: Boolean; A: Cardinal; B: Cardinal): Cardinal;
+{* ֽڱִʱ̶жѡCondtion Ϊ True ʱ A B
+
+
+ Condition: Boolean - Ƿѡ A ҲDzһ
+ A: Cardinal - ѡ 32 λһ
+ B: Cardinal - ѡ 32 λ
+
+ ֵCardinal - ѡ 32 λ
+}
+
+function ConstTimeConditionalSelect64(Condition: Boolean; A: TUInt64; B: TUInt64): TUInt64;
+{* ֽڱִʱ̶жѡCondtion Ϊ True ʱ A B
+
+
+ Condition: Boolean - Ƿѡ A ҲDzһ
+ A: TUInt64 - ѡ 64 λһ
+ B: TUInt64 - ѡ 64 λ
+
+ ֵTUInt64 - ѡ 64 λ
+}
+
+// ================ ִʱ̶ if жϵIJ ===============
+
+{$IFDEF MSWINDOWS}
+
+// ĸΪ Intel ֻ֧࣬ 32 λ 64 λ Intel CPUӦCPUX86 CPUX64
+
+procedure Int64DivInt32Mod(A: Int64; B: Integer;
+ var DivRes: Integer; var ModRes: Integer);
+{* 64 λз 32 λз̷ DivRes ModRes
+ б֤ 32 λΧڣ쳣
+
+
+ A: Int64 -
+ B: Integer -
+ var DivRes: Integer -
+ var ModRes: Integer -
+
+ ֵޣ
+}
+
+procedure UInt64DivUInt32Mod(A: TUInt64; B: Cardinal;
+ var DivRes: Cardinal; var ModRes: Cardinal);
+{* 64 λ 32 λ̷ DivRes ModRes
+ б֤ 32 λΧڣ쳣
+
+
+ A: TUInt64 -
+ B: Cardinal -
+ var DivRes: Cardinal -
+ var ModRes: Cardinal -
+
+ ֵޣ
+}
+
+procedure Int128DivInt64Mod(ALo: Int64; AHi: Int64; B: Int64;
+ var DivRes: Int64; var ModRes: Int64);
+{* 128 λз 64 λз̷ DivRes ModRes
+ б֤ 64 λΧڣ쳣
+
+
+ ALo: Int64 - 64 λ
+ AHi: Int64 - 64 λ
+ B: Int64 -
+ var DivRes: Int64 -
+ var ModRes: Int64 -
+
+ ֵޣ
+}
+
+procedure UInt128DivUInt64Mod(ALo: TUInt64; AHi: TUInt64; B: TUInt64;
+ var DivRes: TUInt64; var ModRes: TUInt64);
+{* 128 λ 64 λ̷ DivRes ModRes
+ б֤ 64 λΧڣ쳣
+
+
+ ALo: TUInt64 - 64 λ
+ AHi: TUInt64 - 64 λ
+ B: TUInt64 -
+ var DivRes: TUInt64 -
+ var ModRes: TUInt64 -
+
+ ֵޣ
+}
+
+{$ENDIF}
+
+function IsUInt128BitSet(Lo: TUInt64; Hi: TUInt64; N: Integer): Boolean;
+{* Int64 ƴɵ 128 λ֣ص N λǷΪ 1N 0 127
+
+
+ Lo: TUInt64 - жϵĵ 64 λ
+ Hi: TUInt64 - жϵĸ 64 λ
+ N: Integer - жϵλ
+
+ ֵBoolean - ǷΪ 1
+}
+
+procedure SetUInt128Bit(var Lo: TUInt64; var Hi: TUInt64; N: Integer);
+{* Int64 ƴɵ 128 λ֣õ N λΪ 1N 0 127
+
+
+ var Lo: TUInt64 - õĵ 64 λ
+ var Hi: TUInt64 - õĸ 64 λ
+ N: Integer - õλ
+
+ ֵޣ
+}
+
+procedure ClearUInt128Bit(var Lo: TUInt64; var Hi: TUInt64; N: Integer);
+{* Int64 ƴɵ 128 λ֣ N λN 0 127
+
+
+ var Lo: TUInt64 - õĵ 64 λ
+ var Hi: TUInt64 - õĸ 64 λ
+ N: Integer - õλ
+
+ ֵޣ
+}
+
+function UnsignedAddWithLimitRadix(A: Cardinal; B: Cardinal; C: Cardinal;
+ var R: Cardinal; L: Cardinal; H: Cardinal): Cardinal;
+{* ƵżӷA + B + C R Уؽλֵ
+ ȷ L H ıڣûȷ H LΡ
+ úַӳ䣬 C һǽλ
+
+
+ A: Cardinal - һ
+ B: Cardinal -
+ C: Cardinal - һǽλ
+ var R: Cardinal -
+ L: Cardinal - ͵
+ H: Cardinal - ͵
+
+ ֵCardinal - Ƿнλ
+}
+
+// =========================== ѭλ ====================================
+
+// ע N Ӧ (0, A λ) ڣ N Ϊ 0 A λʱֵӦΪ A
+// N ʱࣨΪͲȲͬ 32 λ AN Ϊ 33 ʱֵ N Ϊ 1 ʱķֵ
+
+function RotateLeft16(A: Word; N: Integer): Word; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 16 λѭ N λ
+
+
+ A: Word - ѭƵ 16 λ
+ N: Integer - ѭƵλ
+
+ ֵWord - λֵ
+}
+
+function RotateRight16(A: Word; N: Integer): Word; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 16 λѭ N λ
+
+
+ A: Word - ѭƵ 16 λ
+ N: Integer - ѭƵλ
+
+ ֵWord - λֵ
+}
+
+function RotateLeft32(A: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 32 λѭ N λ
+
+
+ A: Cardinal - ѭƵ 32 λ
+ N: Integer - ѭƵλ
+
+ ֵCardinal - λֵ
+}
+
+function RotateRight32(A: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 32 λѭ N λ
+
+
+ A: Cardinal - ѭƵ 32 λ
+ N: Integer - ѭƵλ
+
+ ֵCardinal - λֵ
+}
+
+function RotateLeft64(A: TUInt64; N: Integer): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 64 λѭ N λ
+
+
+ A: TUInt64 - ѭƵ 64 λ
+ N: Integer - ѭƵλ
+
+ ֵTUInt64 - λֵ
+}
+
+function RotateRight64(A: TUInt64; N: Integer): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+{* 64 λѭ N λ
+
+
+ A: TUInt64 - ѭƵ 64 λ
+ N: Integer - ѭƵλ
+
+ ֵTUInt64 - λֵ
+}
+
+{$IFDEF COMPILER5}
+
+function BoolToStr(Value: Boolean; UseBoolStrs: Boolean = False): string;
+{* תΪַDelphi 5 ûи BoolToStr ϡ
+
+
+ Value: Boolean - תIJֵ
+ UseBoolStrs: Boolean - ǷӢĵ
+
+ ֵstring - UseBoolStrs Ϊ False ʱ -1 0 True False
+}
+
+{$ENDIF}
+
+implementation
+
+resourcestring
+ SCnErrorNotAHexPChar = 'Error: NOT a Hex Char: #%d';
+ SCnErrorLengthNotHex = 'Error Length %d: NOT a Hex String';
+ SCnErrorLengthNotHexAnsi = 'Error Length %d: NOT a Hex AnsiString';
+
+var
+ FByteOrderIsBigEndian: Boolean = False;
+
+function CurrentByteOrderIsBigEndian: Boolean;
+type
+ TByteOrder = packed record
+ case Boolean of
+ False: (C: array[0..1] of Byte);
+ True: (W: Word);
+ end;
+var
+ T: TByteOrder;
+begin
+ T.W := $00CC;
+ Result := T.C[1] = $CC;
+end;
+
+function CurrentByteOrderIsLittleEndian: Boolean;
+begin
+ Result := not CurrentByteOrderIsBigEndian;
+end;
+
+function ReverseInt64(Value: Int64): Int64;
+var
+ Lo, Hi: Cardinal;
+ Rec: Int64Rec;
+begin
+ Lo := Int64Rec(Value).Lo;
+ Hi := Int64Rec(Value).Hi;
+ Lo := ((Lo and $000000FF) shl 24) or ((Lo and $0000FF00) shl 8)
+ or ((Lo and $00FF0000) shr 8) or ((Lo and $FF000000) shr 24);
+ Hi := ((Hi and $000000FF) shl 24) or ((Hi and $0000FF00) shl 8)
+ or ((Hi and $00FF0000) shr 8) or ((Hi and $FF000000) shr 24);
+ Rec.Lo := Hi;
+ Rec.Hi := Lo;
+ Result := Int64(Rec);
+end;
+
+function ReverseUInt64(Value: TUInt64): TUInt64;
+var
+ Lo, Hi: Cardinal;
+ Rec: Int64Rec;
+begin
+ Lo := Int64Rec(Value).Lo;
+ Hi := Int64Rec(Value).Hi;
+ Lo := ((Lo and $000000FF) shl 24) or ((Lo and $0000FF00) shl 8)
+ or ((Lo and $00FF0000) shr 8) or ((Lo and $FF000000) shr 24);
+ Hi := ((Hi and $000000FF) shl 24) or ((Hi and $0000FF00) shl 8)
+ or ((Hi and $00FF0000) shr 8) or ((Hi and $FF000000) shr 24);
+ Rec.Lo := Hi;
+ Rec.Hi := Lo;
+ Result := TUInt64(Rec);
+end;
+
+function Int64ToBigEndian(Value: Int64): Int64;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseInt64(Value);
+end;
+
+function Int32ToBigEndian(Value: Integer): Integer;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Integer((Value and $000000FF) shl 24) or Integer((Value and $0000FF00) shl 8)
+ or Integer((Value and $00FF0000) shr 8) or Integer((Value and $FF000000) shr 24);
+end;
+
+function Int16ToBigEndian(Value: SmallInt): SmallInt;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := SmallInt((Value and $00FF) shl 8) or SmallInt((Value and $FF00) shr 8);
+end;
+
+function Int64ToLittleEndian(Value: Int64): Int64;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseInt64(Value);
+end;
+
+function Int32ToLittleEndian(Value: Integer): Integer;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Integer((Value and $000000FF) shl 24) or Integer((Value and $0000FF00) shl 8)
+ or Integer((Value and $00FF0000) shr 8) or Integer((Value and $FF000000) shr 24);
+end;
+
+function Int16ToLittleEndian(Value: SmallInt): SmallInt;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := SmallInt((Value and $00FF) shl 8) or SmallInt((Value and $FF00) shr 8);
+end;
+
+function UInt64ToBigEndian(Value: TUInt64): TUInt64;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseUInt64(Value);
+end;
+
+function UInt32ToBigEndian(Value: Cardinal): Cardinal;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Cardinal((Value and $000000FF) shl 24) or Cardinal((Value and $0000FF00) shl 8)
+ or Cardinal((Value and $00FF0000) shr 8) or Cardinal((Value and $FF000000) shr 24);
+end;
+
+function UInt16ToBigEndian(Value: Word): Word;
+begin
+ if FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Word((Value and $00FF) shl 8) or Word((Value and $FF00) shr 8);
+end;
+
+function UInt64ToLittleEndian(Value: TUInt64): TUInt64;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseUInt64(Value);
+end;
+
+function UInt32ToLittleEndian(Value: Cardinal): Cardinal;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Cardinal((Value and $000000FF) shl 24) or Cardinal((Value and $0000FF00) shl 8)
+ or Cardinal((Value and $00FF0000) shr 8) or Cardinal((Value and $FF000000) shr 24);
+end;
+
+function UInt16ToLittleEndian(Value: Word): Word;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := Word((Value and $00FF) shl 8) or Word((Value and $FF00) shr 8);
+end;
+
+function Int64HostToNetwork(Value: Int64): Int64;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := ReverseInt64(Value)
+ else
+ Result := Value;
+end;
+
+function Int32HostToNetwork(Value: Integer): Integer;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Integer((Value and $000000FF) shl 24) or Integer((Value and $0000FF00) shl 8)
+ or Integer((Value and $00FF0000) shr 8) or Integer((Value and $FF000000) shr 24)
+ else
+ Result := Value;
+end;
+
+function Int16HostToNetwork(Value: SmallInt): SmallInt;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := SmallInt((Value and $00FF) shl 8) or SmallInt((Value and $FF00) shr 8)
+ else
+ Result := Value;
+end;
+
+function Int64NetworkToHost(Value: Int64): Int64;
+begin
+ if not FByteOrderIsBigEndian then
+ REsult := ReverseInt64(Value)
+ else
+ Result := Value;
+end;
+
+function Int32NetworkToHost(Value: Integer): Integer;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Integer((Value and $000000FF) shl 24) or Integer((Value and $0000FF00) shl 8)
+ or Integer((Value and $00FF0000) shr 8) or Integer((Value and $FF000000) shr 24)
+ else
+ Result := Value;
+end;
+
+function Int16NetworkToHost(Value: SmallInt): SmallInt;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := SmallInt((Value and $00FF) shl 8) or SmallInt((Value and $FF00) shr 8)
+ else
+ Result := Value;
+end;
+
+function UInt64HostToNetwork(Value: TUInt64): TUInt64;
+begin
+ if CurrentByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseUInt64(Value);
+end;
+
+function UInt32HostToNetwork(Value: Cardinal): Cardinal;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Cardinal((Value and $000000FF) shl 24) or Cardinal((Value and $0000FF00) shl 8)
+ or Cardinal((Value and $00FF0000) shr 8) or Cardinal((Value and $FF000000) shr 24)
+ else
+ Result := Value;
+end;
+
+function UInt16HostToNetwork(Value: Word): Word;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := ((Value and $00FF) shl 8) or ((Value and $FF00) shr 8)
+ else
+ Result := Value;
+end;
+
+function UInt64NetworkToHost(Value: TUInt64): TUInt64;
+begin
+ if CurrentByteOrderIsBigEndian then
+ Result := Value
+ else
+ Result := ReverseUInt64(Value);
+end;
+
+function UInt32NetworkToHost(Value: Cardinal): Cardinal;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := Cardinal((Value and $000000FF) shl 24) or Cardinal((Value and $0000FF00) shl 8)
+ or Cardinal((Value and $00FF0000) shr 8) or Cardinal((Value and $FF000000) shr 24)
+ else
+ Result := Value;
+end;
+
+function UInt16NetworkToHost(Value: Word): Word;
+begin
+ if not FByteOrderIsBigEndian then
+ Result := ((Value and $00FF) shl 8) or ((Value and $FF00) shr 8)
+ else
+ Result := Value;
+end;
+
+function ReverseBitsInInt8(V: Byte): Byte;
+begin
+ // 0 1 2 3 4 5 6 7
+ V := ((V and $AA) shr 1) or ((V and $55) shl 1);
+ // 01 23 45 67
+ V := ((V and $CC) shr 2) or ((V and $33) shl 2);
+ // 0123 4567
+ V := (V shr 4) or (V shl 4);
+ Result := V;
+end;
+
+function ReverseBitsInInt16(V: Word): Word;
+begin
+ Result := (ReverseBitsInInt8(V and $00FF) shl 8)
+ or ReverseBitsInInt8((V and $FF00) shr 8);
+end;
+
+function ReverseBitsInInt32(V: Cardinal): Cardinal;
+begin
+ Result := (ReverseBitsInInt16(V and $0000FFFF) shl 16)
+ or ReverseBitsInInt16((V and $FFFF0000) shr 16);
+end;
+
+function ReverseBitsInInt64(V: Int64): Int64;
+begin
+ Result := (Int64(ReverseBitsInInt32(V and $00000000FFFFFFFF)) shl 32)
+ or ReverseBitsInInt32((V and $FFFFFFFF00000000) shr 32);
+end;
+
+procedure ReverseMemory(Mem: Pointer; MemByteLen: Integer);
+var
+ I, L: Integer;
+ P: PByteArray;
+ T: Byte;
+begin
+ if (Mem = nil) or (MemByteLen < 2) then
+ Exit;
+
+ L := MemByteLen div 2;
+ P := PByteArray(Mem);
+ for I := 0 to L - 1 do
+ begin
+ // I ͵ MemLen - I - 1
+ T := P^[I];
+ P^[I] := P^[MemByteLen - I - 1];
+ P^[MemByteLen - I - 1] := T;
+ end;
+end;
+
+procedure ReverseMemoryWithBits(Mem: Pointer; MemByteLen: Integer);
+var
+ I: Integer;
+ P: PByteArray;
+begin
+ if (Mem = nil) or (MemByteLen <= 0) then
+ Exit;
+
+ ReverseMemory(Mem, MemByteLen);
+ P := PByteArray(Mem);
+
+ for I := 0 to MemByteLen - 1 do
+ P^[I] := ReverseBitsInInt8(P^[I]);
+end;
+
+procedure MemoryNetworkToHost(Mem: Pointer; MemByteLen: Integer);
+begin
+ if not FByteOrderIsBigEndian then
+ ReverseMemory(Mem, MemByteLen);
+end;
+
+procedure MemoryHostToNetwork(Mem: Pointer; MemByteLen: Integer);
+begin
+ if not FByteOrderIsBigEndian then
+ ReverseMemory(Mem, MemByteLen);
+end;
+
+// N ֽڳȵڴλ
+procedure MemoryBitOperation(AMem, BMem, RMem: Pointer; N: Integer; Op: TCnBitOperation);
+var
+ A, B, R: PCnLongWord32Array;
+ BA, BB, BR: PByteArray;
+begin
+ if N <= 0 then
+ Exit;
+
+ if (AMem = nil) or ((BMem = nil) and (Op <> boNot)) or (RMem = nil) then
+ Exit;
+
+ A := PCnLongWord32Array(AMem);
+ B := PCnLongWord32Array(BMem);
+ R := PCnLongWord32Array(RMem);
+
+ while (N and (not 3)) <> 0 do
+ begin
+ case Op of
+ boAnd:
+ R^[0] := A^[0] and B^[0];
+ boOr:
+ R^[0] := A^[0] or B^[0];
+ boXor:
+ R^[0] := A^[0] xor B^[0];
+ boNot: // ʱ B
+ R^[0] := not A^[0];
+ end;
+
+ A := PCnLongWord32Array(TCnIntAddress(A) + SizeOf(Cardinal));
+ B := PCnLongWord32Array(TCnIntAddress(B) + SizeOf(Cardinal));
+ R := PCnLongWord32Array(TCnIntAddress(R) + SizeOf(Cardinal));
+
+ Dec(N, SizeOf(Cardinal));
+ end;
+
+ if N > 0 then
+ begin
+ BA := PByteArray(A);
+ BB := PByteArray(B);
+ BR := PByteArray(R);
+
+ while N <> 0 do
+ begin
+ case Op of
+ boAnd:
+ BR^[0] := BA^[0] and BB^[0];
+ boOr:
+ BR^[0] := BA^[0] or BB^[0];
+ boXor:
+ BR^[0] := BA^[0] xor BB^[0];
+ boNot:
+ BR^[0] := not BA^[0];
+ end;
+
+ BA := PByteArray(TCnIntAddress(BA) + SizeOf(Byte));
+ BB := PByteArray(TCnIntAddress(BB) + SizeOf(Byte));
+ BR := PByteArray(TCnIntAddress(BR) + SizeOf(Byte));
+ Dec(N);
+ end;
+ end;
+end;
+
+procedure MemoryAnd(AMem, BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+begin
+ MemoryBitOperation(AMem, BMem, ResMem, MemByteLen, boAnd);
+end;
+
+procedure MemoryOr(AMem, BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+begin
+ MemoryBitOperation(AMem, BMem, ResMem, MemByteLen, boOr);
+end;
+
+procedure MemoryXor(AMem, BMem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+begin
+ MemoryBitOperation(AMem, BMem, ResMem, MemByteLen, boXor);
+end;
+
+procedure MemoryNot(Mem: Pointer; MemByteLen: Integer; ResMem: Pointer);
+begin
+ MemoryBitOperation(Mem, nil, ResMem, MemByteLen, boNot);
+end;
+
+procedure MemoryShiftLeft(AMem, BMem: Pointer; MemByteLen: Integer; BitCount: Integer);
+var
+ I, L, N, LB, RB: Integer;
+ PF, PT: PByteArray;
+begin
+ if (AMem = nil) or (MemByteLen <= 0) or (BitCount = 0) then
+ Exit;
+
+ if BitCount < 0 then
+ begin
+ MemoryShiftRight(AMem, BMem, MemByteLen, -BitCount);
+ Exit;
+ end;
+
+ if BMem = nil then
+ BMem := AMem;
+
+ if (MemByteLen * 8) <= BitCount then // ̫ȫ 0
+ begin
+ FillChar(BMem^, MemByteLen, 0);
+ Exit;
+ end;
+
+ N := BitCount div 8; // λֽ
+ RB := BitCount mod 8; // ȥֽںʣµλ
+ LB := 8 - RB; // ʣµλһֽʣµλ
+
+ PF := PByteArray(AMem);
+ PT := PByteArray(BMem);
+
+ if RB = 0 then // 飬ð죬Ҫλֽ MemLen - NW
+ begin
+ Move(PF^[N], PT^[0], MemByteLen - N);
+ FillChar(PT^[MemByteLen - N], N, 0);
+ end
+ else
+ begin
+ // PF^[N] PT^[0] MemLen - N ֽڣֽڼн
+ L := MemByteLen - N;
+ PF := PByteArray(TCnIntAddress(PF) + N);
+
+ for I := 1 to L do // ӵλƶȴ͵
+ begin
+ PT^[0] := Byte(PF^[0] shl RB);
+ if I < L then // һֽ PF^[1] ᳬ
+ PT^[0] := (PF^[1] shr LB) or PT^[0];
+
+ PF := PByteArray(TCnIntAddress(PF) + 1);
+ PT := PByteArray(TCnIntAddress(PT) + 1);
+ end;
+
+ // ʣµҪ 0
+ if N > 0 then
+ FillChar(PT^[0], N, 0);
+ end;
+end;
+
+procedure MemoryShiftRight(AMem, BMem: Pointer; MemByteLen: Integer; BitCount: Integer);
+var
+ I, L, N, LB, RB: Integer;
+ PF, PT: PByteArray;
+begin
+ if (AMem = nil) or (MemByteLen <= 0) or (BitCount = 0) then
+ Exit;
+
+ if BitCount < 0 then
+ begin
+ MemoryShiftLeft(AMem, BMem, MemByteLen, -BitCount);
+ Exit;
+ end;
+
+ if BMem = nil then
+ BMem := AMem;
+
+ if (MemByteLen * 8) <= BitCount then // ̫ȫ 0
+ begin
+ FillChar(BMem^, MemByteLen, 0);
+ Exit;
+ end;
+
+ N := BitCount div 8; // λֽ
+ RB := BitCount mod 8; // ȥֽںʣµλ
+ LB := 8 - RB; // ʣµλһֽʣµλ
+
+ if RB = 0 then // 飬ð죬Ҫλֽ MemLen - N
+ begin
+ PF := PByteArray(AMem);
+ PT := PByteArray(BMem);
+
+ Move(PF^[0], PT^[N], MemByteLen - N);
+ FillChar(PT^[0], N, 0);
+ end
+ else
+ begin
+ // PF^[0] PT^[N] MemLen - N ֽڣôӸߴʼֽڼн
+ L := MemByteLen - N;
+
+ PF := PByteArray(TCnIntAddress(AMem) + L - 1);
+ PT := PByteArray(TCnIntAddress(BMem) + MemByteLen - 1);
+
+ for I := L downto 1 do // Ӹλλƶȴ
+ begin
+ PT^[0] := Byte(PF^[0] shr RB);
+ if I > 1 then // һֽ PF^[-1] ᳬ
+ begin
+ PF := PByteArray(TCnIntAddress(PF) - 1);
+ PT^[0] := Byte((PF^[0] shl LB) or PT^[0]);
+ end
+ else
+ PF := PByteArray(TCnIntAddress(PF) - 1);
+
+ PT := PByteArray(TCnIntAddress(PT) - 1);
+ end;
+
+ // ʣµǰҪ 0
+ if N > 0 then
+ FillChar(BMem^, N, 0);
+ end;
+end;
+
+function MemoryIsBitSet(Mem: Pointer; N: Integer): Boolean;
+var
+ P: PByte;
+ A, B: Integer;
+ V: Byte;
+begin
+ if (Mem = nil) or (N < 0) then
+ raise ERangeError.Create(SRangeError);
+
+ A := N div 8;
+ B := N mod 8;
+ P := PByte(TCnIntAddress(Mem) + A);
+
+ V := Byte(1 shl B);
+ Result := (P^ and V) <> 0;
+end;
+
+procedure MemorySetBit(Mem: Pointer; N: Integer);
+var
+ P: PByte;
+ A, B: Integer;
+ V: Byte;
+begin
+ if (Mem = nil) or (N < 0) then
+ raise ERangeError.Create(SRangeError);
+
+ A := N div 8;
+ B := N mod 8;
+ P := PByte(TCnIntAddress(Mem) + A);
+
+ V := Byte(1 shl B);
+ P^ := P^ or V;
+end;
+
+procedure MemoryClearBit(Mem: Pointer; N: Integer);
+var
+ P: PByte;
+ A, B: Integer;
+ V: Byte;
+begin
+ if (Mem = nil) or (N < 0) then
+ raise ERangeError.Create(SRangeError);
+
+ A := N div 8;
+ B := N mod 8;
+ P := PByte(TCnIntAddress(Mem) + A);
+
+ V := not Byte(1 shl B);
+ P^ := P^ and V;
+end;
+
+function MemoryGetHighBits(Mem: Pointer; MemByteLen: Integer): Integer;
+var
+ I, R, ZO: Integer;
+ P: PByteArray;
+begin
+ Result := -1;
+ if (Mem = nil) or (MemByteLen <= 0) then
+ Exit;
+
+ P := PByteArray(Mem);
+ ZO := 0;
+ for I := 0 to MemByteLen - 1 do // ӵ͵ַߵַ
+ begin
+ R := GetUInt8HighBits(P^[I]);
+ if R = -1 then // ֽȫ 0
+ begin
+ ZO := ZO + 8;
+ end
+ else // ֽ 1ֹ
+ begin
+ ZO := ZO + 8 - R + 1;
+ Break;
+ end;
+ end;
+
+ if ZO = MemByteLen * 8 then // ȫ㣬û 1
+ Result := -1
+ else
+ Result := MemByteLen * 8 - ZO; // 1λȥ 0 ĸ
+end;
+
+function MemoryGetLowBits(Mem: Pointer; MemByteLen: Integer): Integer;
+var
+ I, R, ZC: Integer;
+ P: PByteArray;
+begin
+ Result := -1;
+ if (Mem = nil) or (MemByteLen <= 0) then
+ Exit;
+
+ P := PByteArray(Mem);
+ ZC := 0;
+ for I := MemByteLen - 1 downto 0 do // Ӹߵַ͵ַ
+ begin
+ R := GetUInt8LowBits(P^[I]);
+ if R = -1 then // ֽȫ 0
+ begin
+ ZC := ZC + 8;
+ end
+ else // ֽ 1ֹ
+ begin
+ ZC := ZC + R;
+ Break;
+ end;
+ end;
+
+ if ZC = MemByteLen * 8 then // ȫ㣬û 1
+ Result := -1
+ else
+ Result := MemByteLen * 8 - ZC; // 1λȥ 0 ĸ
+end;
+
+function MemoryToBinStr(Mem: Pointer; MemByteLen: Integer; Sep: Boolean): string;
+var
+ J, L: Integer;
+ P: PByteArray;
+ B: PChar;
+
+ procedure FillAByteToBuf(V: Byte; Buf: PChar);
+ const
+ M = $80;
+ var
+ I: Integer;
+ begin
+ for I := 0 to 7 do
+ begin
+ if (V and M) <> 0 then
+ Buf[I] := '1'
+ else
+ Buf[I] := '0';
+ V := V shl 1;
+ end;
+ end;
+
+begin
+ Result := '';
+ if (Mem = nil) or (MemByteLen <= 0) then
+ Exit;
+
+ L := MemByteLen * 8;
+ if Sep then
+ L := L + MemByteLen - 1; // мÿոָ
+
+ SetLength(Result, L);
+ B := PChar(@Result[1]);
+ P := PByteArray(Mem);
+
+ for J := 0 to MemByteLen - 1 do
+ begin
+ FillAByteToBuf(P^[J], B);
+ if Sep then
+ begin
+ B[8] := ' ';
+ Inc(B, 9);
+ end
+ else
+ Inc(B, 8);
+ end;
+end;
+
+procedure MemorySwap(AMem, BMem: Pointer; MemByteLen: Integer);
+var
+ A, B: PCnLongWord32Array;
+ BA, BB: PByteArray;
+ TC: Cardinal;
+ TB: Byte;
+begin
+ if (AMem = nil) or (BMem = nil) or (MemByteLen <= 0) then
+ Exit;
+
+ A := PCnLongWord32Array(AMem);
+ B := PCnLongWord32Array(BMem);
+
+ if A = B then
+ Exit;
+
+ while (MemByteLen and (not 3)) <> 0 do
+ begin
+ TC := A^[0];
+ A^[0] := B^[0];
+ B^[0] := TC;
+
+ A := PCnLongWord32Array(TCnIntAddress(A) + SizeOf(Cardinal));
+ B := PCnLongWord32Array(TCnIntAddress(B) + SizeOf(Cardinal));
+
+ Dec(MemByteLen, SizeOf(Cardinal));
+ end;
+
+ if MemByteLen > 0 then
+ begin
+ BA := PByteArray(A);
+ BB := PByteArray(B);
+
+ while MemByteLen <> 0 do
+ begin
+ TB := BA^[0];
+ BA^[0] := BB^[0];
+ BB^[0] :=TB;
+
+ BA := PByteArray(TCnIntAddress(BA) + SizeOf(Byte));
+ BB := PByteArray(TCnIntAddress(BB) + SizeOf(Byte));
+
+ Dec(MemByteLen);
+ end;
+ end;
+end;
+
+function MemoryCompare(AMem, BMem: Pointer; MemByteLen: Integer): Integer;
+var
+ A, B: PCnLongWord32Array;
+ BA, BB: PByteArray;
+begin
+ Result := 0;
+ if ((AMem = nil) and (BMem = nil)) or (AMem = BMem) then // ͬһ
+ Exit;
+
+ if MemByteLen <= 0 then
+ Exit;
+
+ if AMem = nil then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ if BMem = nil then
+ begin
+ Result := 1;
+ Exit;
+ end;
+
+ A := PCnLongWord32Array(AMem);
+ B := PCnLongWord32Array(BMem);
+
+ while (MemByteLen and (not 3)) <> 0 do
+ begin
+ if A^[0] > B^[0] then
+ begin
+ Result := 1;
+ Exit;
+ end
+ else if A^[0] < B^[0] then
+ begin
+ Result := -1;
+ Exit;
+ end;
+
+ A := PCnLongWord32Array(TCnIntAddress(A) + SizeOf(Cardinal));
+ B := PCnLongWord32Array(TCnIntAddress(B) + SizeOf(Cardinal));
+
+ Dec(MemByteLen, SizeOf(Cardinal));
+ end;
+
+ if MemByteLen > 0 then
+ begin
+ BA := PByteArray(A);
+ BB := PByteArray(B);
+
+ while MemByteLen <> 0 do
+ begin
+ if BA^[0] > BB^[0] then
+ begin
+ Result := 1;
+ Exit;
+ end
+ else if BA^[0] < BB^[0] then
+ begin
+ Result := -1;
+ Exit;
+ end;
+
+ BA := PByteArray(TCnIntAddress(BA) + SizeOf(Byte));
+ BB := PByteArray(TCnIntAddress(BB) + SizeOf(Byte));
+
+ Dec(MemByteLen);
+ end;
+ end;
+end;
+
+function UInt8ToBinStr(V: Byte): string;
+const
+ M = $80;
+var
+ I: Integer;
+begin
+ SetLength(Result, 8 * SizeOf(V));
+ for I := 1 to 8 * SizeOf(V) do
+ begin
+ if (V and M) <> 0 then
+ Result[I] := '1'
+ else
+ Result[I] := '0';
+ V := V shl 1;
+ end;
+end;
+
+function UInt16ToBinStr(V: Word): string;
+const
+ M = $8000;
+var
+ I: Integer;
+begin
+ SetLength(Result, 8 * SizeOf(V));
+ for I := 1 to 8 * SizeOf(V) do
+ begin
+ if (V and M) <> 0 then
+ Result[I] := '1'
+ else
+ Result[I] := '0';
+ V := V shl 1;
+ end;
+end;
+
+function UInt32ToBinStr(V: Cardinal): string;
+const
+ M = $80000000;
+var
+ I: Integer;
+begin
+ SetLength(Result, 8 * SizeOf(V));
+ for I := 1 to 8 * SizeOf(V) do
+ begin
+ if (V and M) <> 0 then
+ Result[I] := '1'
+ else
+ Result[I] := '0';
+ V := V shl 1;
+ end;
+end;
+
+function UInt32ToStr(V: Cardinal): string;
+begin
+ Result := Format('%u', [V]);
+end;
+
+function UInt64ToBinStr(V: TUInt64): string;
+const
+ M = $8000000000000000;
+var
+ I: Integer;
+begin
+ SetLength(Result, 8 * SizeOf(V));
+
+ for I := 1 to 8 * SizeOf(V) do
+ begin
+ if (V and M) <> 0 then
+ Result[I] := '1'
+ else
+ Result[I] := '0';
+ V := V shl 1;
+ end;
+end;
+
+const
+ HiDigits: array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+const
+ LoDigits: array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
+
+const
+ AnsiHiDigits: array[0..15] of AnsiChar = ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+const
+ AnsiLoDigits: array[0..15] of AnsiChar = ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
+
+function HexToInt(Hex: PChar; CharLen: Integer): Integer;
+var
+ I, Res: Integer;
+ C: Char;
+begin
+ Res := 0;
+ for I := 0 to CharLen - 1 do
+ begin
+ C := Hex[I];
+ if (C >= '0') and (C <= '9') then
+ Res := Res * 16 + Ord(C) - Ord('0')
+ else if (C >= 'A') and (C <= 'F') then
+ Res := Res * 16 + Ord(C) - Ord('A') + 10
+ else if (C >= 'a') and (C <= 'f') then
+ Res := Res * 16 + Ord(C) - Ord('a') + 10
+ else
+ raise ECnNativeException.CreateFmt(SCnErrorNotAHexPChar, [Ord(C)]);
+ end;
+ Result := Res;
+end;
+
+function HexToInt(const Hex: string): Integer;
+begin
+ Result := HexToInt(PChar(Hex), Length(Hex));
+end;
+
+{$WARNINGS OFF}
+
+function IsHexString(const Hex: string): Boolean;
+var
+ I, L: Integer;
+begin
+ Result := False;
+ L := Length(Hex);
+ if (L <= 0) or ((L and 1) <> 0) then // ջżȶ
+ Exit;
+
+ for I := 1 to L do
+ begin
+ // ע˴ Unicode Ȼ Warningǽ Hex[I] WideChar ֱӽض AnsiChar
+ // ٽжϣᵼ¡ޡ $66$66$66$66 ַУ
+ // ֱͨ WideChar ֵ ax ˫ֽڵģӼжϣ
+ if not (Hex[I] in ['0'..'9', 'A'..'F', 'a'..'f']) then
+ Exit;
+ end;
+ Result := True;
+end;
+
+{$WARNINGS ON}
+
+function DataToHex(InData: Pointer; ByteLength: Integer; UseUpperCase: Boolean = True): string;
+var
+ I: Integer;
+ B: Byte;
+begin
+ Result := '';
+ if ByteLength <= 0 then
+ Exit;
+
+ SetLength(Result, ByteLength * 2);
+ if UseUpperCase then
+ begin
+ for I := 0 to ByteLength - 1 do
+ begin
+ B := PByte(TCnIntAddress(InData) + I * SizeOf(Byte))^;
+ Result[I * 2 + 1] := HiDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := HiDigits[B and $0F];
+ end;
+ end
+ else
+ begin
+ for I := 0 to ByteLength - 1 do
+ begin
+ B := PByte(TCnIntAddress(InData) + I * SizeOf(Byte))^;
+ Result[I * 2 + 1] := LoDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := LoDigits[B and $0F];
+ end;
+ end;
+end;
+
+function HexToData(const Hex: string; OutData: Pointer): Integer;
+var
+ I, L: Integer;
+ H: PChar;
+begin
+ L := Length(Hex);
+ if (L mod 2) <> 0 then
+ raise ECnNativeException.CreateFmt(SCnErrorLengthNotHex, [L]);
+
+ if OutData = nil then
+ begin
+ Result := L div 2;
+ Exit;
+ end;
+
+ Result := 0;
+ H := PChar(Hex);
+ for I := 1 to L div 2 do
+ begin
+ PByte(TCnIntAddress(OutData) + I - 1)^ := Byte(HexToInt(@H[(I - 1) * 2], 2));
+ Inc(Result);
+ end;
+end;
+
+function StringToHex(const Data: string; UseUpperCase: Boolean): string;
+var
+ I, L: Integer;
+ B: Byte;
+ Buffer: PChar;
+begin
+ Result := '';
+ L := Length(Data);
+ if L = 0 then
+ Exit;
+
+ SetLength(Result, L * 2);
+ Buffer := @Data[1];
+
+ if UseUpperCase then
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I * SizeOf(Char))^;
+ Result[I * 2 + 1] := HiDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := HiDigits[B and $0F];
+ end;
+ end
+ else
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I * SizeOf(Char))^;
+ Result[I * 2 + 1] := LoDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := LoDigits[B and $0F];
+ end;
+ end;
+end;
+
+function HexToString(const Hex: string): string;
+var
+ I, L: Integer;
+ H: PChar;
+begin
+ L := Length(Hex);
+ if (L mod 2) <> 0 then
+ raise ECnNativeException.CreateFmt(SCnErrorLengthNotHex, [L]);
+
+ SetLength(Result, L div 2);
+ H := PChar(Hex);
+ for I := 1 to L div 2 do
+ Result[I] := Chr(HexToInt(@H[(I - 1) * 2], 2));
+end;
+
+function HexToAnsiStr(const Hex: AnsiString): AnsiString;
+var
+ I, L: Integer;
+ S: string;
+begin
+ L := Length(Hex);
+ if (L mod 2) <> 0 then
+ raise ECnNativeException.CreateFmt(SCnErrorLengthNotHexAnsi, [L]);
+
+ SetLength(Result, L div 2);
+ for I := 1 to L div 2 do
+ begin
+ S := string(Copy(Hex, I * 2 - 1, 2));
+ Result[I] := AnsiChar(Chr(HexToInt(S)));
+ end;
+end;
+
+function AnsiStrToHex(const Data: AnsiString; UseUpperCase: Boolean): AnsiString;
+var
+ I, L: Integer;
+ B: Byte;
+ Buffer: PAnsiChar;
+begin
+ Result := '';
+ L := Length(Data);
+ if L = 0 then
+ Exit;
+
+ SetLength(Result, L * 2);
+ Buffer := @Data[1];
+
+ if UseUpperCase then
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I)^;
+ Result[I * 2 + 1] := AnsiHiDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := AnsiHiDigits[B and $0F];
+ end;
+ end
+ else
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I)^;
+ Result[I * 2 + 1] := AnsiLoDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := AnsiLoDigits[B and $0F];
+ end;
+ end;
+end;
+
+function BytesToHex(const Data: TBytes; UseUpperCase: Boolean): string;
+var
+ I, L: Integer;
+ B: Byte;
+ Buffer: PAnsiChar;
+begin
+ Result := '';
+ L := Length(Data);
+ if L = 0 then
+ Exit;
+
+ SetLength(Result, L * 2);
+ Buffer := @Data[0];
+
+ if UseUpperCase then
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I)^;
+ Result[I * 2 + 1] := HiDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := HiDigits[B and $0F];
+ end;
+ end
+ else
+ begin
+ for I := 0 to L - 1 do
+ begin
+ B := PByte(TCnIntAddress(Buffer) + I)^;
+ Result[I * 2 + 1] := LoDigits[(B shr 4) and $0F];
+ Result[I * 2 + 2] := LoDigits[B and $0F];
+ end;
+ end;
+end;
+
+function HexToBytes(const Hex: string): TBytes;
+var
+ I, L: Integer;
+ H: PChar;
+begin
+ L := Length(Hex);
+ if (L mod 2) <> 0 then
+ raise ECnNativeException.CreateFmt(SCnErrorLengthNotHex, [L]);
+
+ SetLength(Result, L div 2);
+ H := PChar(Hex);
+
+ for I := 1 to L div 2 do
+ Result[I - 1] := Byte(HexToInt(@H[(I - 1) * 2], 2));
+end;
+
+function StreamToHex(Stream: TStream; UseUpperCase: Boolean): string;
+var
+ B: Byte;
+ I: Integer;
+begin
+ Result := '';
+ if Stream.Size > 0 then
+ begin
+ Stream.Position := 0;
+ SetLength(Result, Stream.Size * 2);
+ I := 1;
+ if UseUpperCase then
+ begin
+ while Stream.Read(B, 1) = 1 do
+ begin
+ Result[I] := HiDigits[(B shr 4) and $0F];
+ Inc(I);
+ Result[I] := HiDigits[B and $0F];
+ Inc(I);
+ end;
+ end
+ else
+ begin
+ while Stream.Read(B, 1) = 1 do
+ begin
+ Result[I] := LoDigits[(B shr 4) and $0F];
+ Inc(I);
+ Result[I] := LoDigits[B and $0F];
+ Inc(I);
+ end;
+ end;
+ end;
+end;
+
+function HexToStream(const Hex: string; Stream: TStream): Integer;
+var
+ I, L: Integer;
+ H: PChar;
+ B: Byte;
+begin
+ Result := 0;
+ L := Length(Hex);
+ if (L mod 2) <> 0 then
+ raise ECnNativeException.CreateFmt(SCnErrorLengthNotHex, [L]);
+
+ H := PChar(Hex);
+ for I := 1 to L div 2 do
+ begin
+ B := Byte(HexToInt(@H[(I - 1) * 2], 2));
+ Inc(Result, Stream.Write(B, 1));
+ end;
+end;
+
+function WriteBytesToStream(const Data: TBytes; Stream: TStream): Integer;
+begin
+ if Length(Data) > 0 then
+ Result := Stream.Write(Data[0], Length(Data))
+ else
+ Result := 0;
+end;
+
+procedure ReverseBytes(Data: TBytes);
+var
+ I, L, M: Integer;
+ T: Byte;
+begin
+ if (Data = nil) or (Length(Data) <= 1) then
+ Exit;
+ L := Length(Data);
+ M := L div 2;
+ for I := 0 to M - 1 do
+ begin
+ // I L - I - 1
+ T := Data[I];
+ Data[I] := Data[L - I - 1];
+ Data[L - I - 1] := T;
+ end;
+end;
+
+function CloneBytes(const Data: TBytes): TBytes;
+begin
+ if Length(Data) = 0 then
+ Result := nil
+ else
+ begin
+ SetLength(Result, Length(Data));
+ Move(Data[0], Result[0], Length(Data));
+ end;
+end;
+
+function StreamToBytes(Stream: TStream): TBytes;
+begin
+ Result := nil;
+ if (Stream <> nil) and (Stream.Size > 0) then
+ begin
+ SetLength(Result, Stream.Size);
+ Stream.Position := 0;
+ Stream.Read(Result[0], Stream.Size);
+ end;
+end;
+
+function BytesToStream(const Data: TBytes; OutStream: TStream): Integer;
+begin
+ Result := 0;
+ if (Data <> nil) and (Length(Data) > 0) and (OutStream <> nil) then
+ begin
+ OutStream.Size := 0;
+ Result := OutStream.Write(Data[0], Length(Data));
+ end;
+end;
+
+function AnsiToBytes(const Str: AnsiString): TBytes;
+begin
+ SetLength(Result, Length(Str));
+ if Length(Str) > 0 then
+ Move(Str[1], Result[0], Length(Str));
+end;
+
+function BytesToAnsi(const Data: TBytes): AnsiString;
+begin
+ SetLength(Result, Length(Data));
+ if Length(Data) > 0 then
+ Move(Data[0], Result[1], Length(Data));
+end;
+
+function BytesToString(const Data: TBytes): string;
+var
+ I: Integer;
+begin
+ SetLength(Result, Length(Data));
+ for I := 1 to Length(Data) do
+ Result[I] := Chr(Data[I - 1]);
+end;
+
+function MemoryToString(Mem: Pointer; MemByteLen: Integer): string;
+var
+ P: PByteArray;
+ I: Integer;
+begin
+ if (Mem = nil) or (MemByteLen <= 0) then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ P := PByteArray(Mem);
+ SetLength(Result, MemByteLen);
+ for I := 1 to MemByteLen do
+ Result[I] := Chr(P^[I - 1]);
+end;
+
+function BitsToString(Bits: TBits): string;
+var
+ I: Integer;
+begin
+ if (Bits = nil) or (Bits.Size = 0) then
+ Result := ''
+ else
+ begin
+ SetLength(Result, Bits.Size);
+ for I := 0 to Bits.Size - 1 do
+ begin
+ if Bits.Bits[I] then
+ Result[I + 1] := '1'
+ else
+ Result[I + 1] := '0';
+ end;
+ end;
+end;
+
+function ConcatBytes(const A, B: TBytes): TBytes;
+begin
+ // XE7 ҲֱӣΪ A B Ϊʱ᷵һֽ
+ if (A = nil) or (Length(A) = 0) then
+ begin
+ SetLength(Result, Length(B));
+ if Length(B) > 0 then
+ Move(B[0], Result[0], Length(B));
+ end
+ else if (B = nil) or (Length(B) = 0) then
+ begin
+ SetLength(Result, Length(A));
+ if Length(A) > 0 then
+ Move(A[0], Result[0], Length(A));
+ end
+ else
+ begin
+ SetLength(Result, Length(A) + Length(B));
+ Move(A[0], Result[0], Length(A));
+ Move(B[0], Result[Length(A)], Length(B));
+ end;
+end;
+
+function ConcatBytes(const A: TBytes; const B: TBytes; const C: TBytes): TBytes;
+var
+ L1, L2, L3: Integer;
+begin
+ Result := nil;
+ L1 := Length(A);
+ L2 := Length(B);
+ L3 := Length(C);
+
+ if (L1 = 0) and (L2 = 0) and (L3 = 0) then
+ Exit;
+
+ SetLength(Result, L1 + L2 + L3);
+ if L1 > 0 then
+ Move(A[0], Result[0], L1);
+ if L2 > 0 then
+ Move(B[0], Result[L1], L2);
+ if L3 > 0 then
+ Move(C[0], Result[L1 + L2], L3);
+end;
+
+function ConcatBytes(const A: TBytes; const B: TBytes; const C: TBytes; const D: TBytes): TBytes;
+var
+ L1, L2, L3, L4: Integer;
+begin
+ Result := nil;
+ L1 := Length(A);
+ L2 := Length(B);
+ L3 := Length(C);
+ L4 := Length(D);
+
+ if (L1 = 0) and (L2 = 0) and (L3 = 0) and (L4 = 0) then
+ Exit;
+
+ SetLength(Result, L1 + L2 + L3 + L4);
+ if L1 > 0 then
+ Move(A[0], Result[0], L1);
+ if L2 > 0 then
+ Move(B[0], Result[L1], L2);
+ if L3 > 0 then
+ Move(C[0], Result[L1 + L2], L3);
+ if L4 > 0 then
+ Move(D[0], Result[L1 + L2 + L3], L4);
+end;
+
+function NewZeroBytes(ByteLen: Integer): TBytes;
+begin
+ if ByteLen > 0 then
+ begin
+ SetLength(Result, ByteLen);
+ FillChar(Result[0], ByteLen, 0);
+ end
+ else
+ Result := nil;
+end;
+
+function ConcatBytesMemory(const A: TBytes; Data: Pointer; DataByteLen: Integer): TBytes;
+var
+ L: Integer;
+begin
+ L := Length(A) + DataByteLen;
+ if L > 0 then
+ begin
+ SetLength(Result, L);
+ if Length(A) > 0 then
+ Move(A[0], Result[0], Length(A));
+ if (Data <> nil) and (DataByteLen > 0) then
+ Move(Data^, Result[Length(A)], DataByteLen);
+ end
+ else
+ Result := nil;
+end;
+
+function NewBytesFromMemory(Data: Pointer; DataByteLen: Integer): TBytes;
+begin
+ if (Data = nil) or (DataByteLen <= 0) then
+ Result := nil
+ else
+ begin
+ SetLength(Result, DataByteLen);
+ Move(Data^, Result[0], DataByteLen);
+ end;
+end;
+
+procedure PutBytesToMemory(const Data: TBytes; Mem: Pointer; MaxByteSize: Integer);
+var
+ L: Integer;
+begin
+ L := Length(Data);
+ if (L > 0) and (Mem <> nil) then
+ begin
+ if (MaxByteSize > 0) and (L > MaxByteSize) then
+ L := MaxByteSize;
+
+ Move(Data[0], Mem^, L);
+ end;
+end;
+
+function CompareBytes(const A, B: TBytes): Boolean;
+var
+ L: Integer;
+begin
+ Result := False;
+
+ L := Length(A);
+ if Length(B) <> L then // Ȳ˳
+ Exit;
+
+ if L = 0 then //
+ Result := True // 綼 0
+ else
+ Result := CompareMem(@A[0], @B[0], L);
+end;
+
+function CompareBytes(const A, B: TBytes; MaxLength: Integer): Boolean;
+var
+ LA, LB: Integer;
+begin
+ Result := False;
+
+ LA := Length(A);
+ LB := Length(B);
+
+ if LA > MaxLength then
+ LA := MaxLength;
+ if LB > MaxLength then
+ LB := MaxLength;
+
+ if LA <> LB then
+ Exit;
+
+ if LA = 0 then
+ Result := True
+ else
+ Result := CompareMem(@A[0], @B[0], LA);
+end;
+
+function CompareBytesWithDiffIndex(const A, B: TBytes; out DiffIndex: Integer): Boolean;
+var
+ I: Integer;
+ L1, L2: Integer;
+begin
+ L1 := Length(A);
+ L2 := Length(B);
+ DiffIndex := -1;
+ Result := True;
+
+ if L1 <> L2 then
+ begin
+ Result := False;
+ Exit;
+ end;
+
+ if (L1 = 0) and (L2 = 0) then
+ Exit;
+
+ for I := 0 to L1 - 1 do
+ begin
+ if A[I] <> B[I] then
+ begin
+ Result := False;
+ DiffIndex := I;
+ Exit;
+ end;
+ end;
+end;
+
+function MoveMost(const Source; var Dest; ByteLen, MostLen: Integer): Integer;
+begin
+ if (MostLen <= 0) or (ByteLen <= 0) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ if ByteLen > MostLen then
+ ByteLen := MostLen
+ else if ByteLen < MostLen then
+ begin
+ FillChar(Dest, MostLen, 0);
+
+ // TODO: ҪΪ FillChar(Dest + ByteLen, MostLen - ByteLen, 0); ֻ䲻IJ
+ end;
+
+ Move(Source, Dest, ByteLen);
+ Result := ByteLen;
+end;
+
+// =============================== ===================================
+
+function SarInt8(V: ShortInt; ShiftCount: Integer): ShortInt;
+begin
+ Result := V shr ShiftCount;
+ if (V and $80) <> 0 then
+ Result := Result or ($FF shl (8 - ShiftCount));
+end;
+
+function SarInt16(V: SmallInt; ShiftCount: Integer): SmallInt;
+begin
+ Result := V shr ShiftCount;
+ if (V and $8000) <> 0 then
+ Result := Result or ($FFFF shl (16 - ShiftCount));
+end;
+
+function SarInt32(V: Integer; ShiftCount: Integer): Integer;
+begin
+ Result := V shr ShiftCount;
+ if (V and $80000000) <> 0 then
+ Result := Result or Integer($FFFFFFFF shl (32 - ShiftCount));
+end;
+
+function SarInt64(V: Int64; ShiftCount: Integer): Int64;
+begin
+ Result := V shr ShiftCount;
+ if (V and $8000000000000000) <> 0 then
+ Result := Result or ($FFFFFFFFFFFFFFFF shl (64 - ShiftCount));
+end;
+
+procedure ConstTimeConditionalSwap8(CanSwap: Boolean; var A, B: Byte);
+var
+ T, V: Byte;
+begin
+ T := ConstTimeExpandBoolean8(CanSwap);
+ V := (A xor B) and T;
+ A := A xor V;
+ B := B xor V;
+end;
+
+procedure ConstTimeConditionalSwap16(CanSwap: Boolean; var A, B: Word);
+var
+ T, V: Word;
+begin
+ T := ConstTimeExpandBoolean16(CanSwap);
+ V := (A xor B) and T;
+ A := A xor V;
+ B := B xor V;
+end;
+
+procedure ConstTimeConditionalSwap32(CanSwap: Boolean; var A, B: Cardinal);
+var
+ T, V: Cardinal;
+begin
+ T := ConstTimeExpandBoolean32(CanSwap);
+ V := (A xor B) and T;
+ A := A xor V;
+ B := B xor V;
+end;
+
+procedure ConstTimeConditionalSwap64(CanSwap: Boolean; var A, B: TUInt64);
+var
+ T, V: TUInt64;
+begin
+ T := ConstTimeExpandBoolean64(CanSwap);
+ V := (A xor B) and T;
+ A := A xor V;
+ B := B xor V;
+end;
+
+function ConstTimeEqual8(A, B: Byte): Boolean;
+var
+ R: Byte;
+begin
+ R := not (A xor B); //
+ R := R and (R shr 4); // һһ
+ R := R and (R shr 2); // һλ 0
+ R := R and (R shr 1); // 0
+ Result := Boolean(R); // ֻȫ 1 1
+end;
+
+function ConstTimeEqual16(A, B: Word): Boolean;
+begin
+ Result := ConstTimeEqual8(Byte(A shr 8), Byte(B shr 8))
+ and ConstTimeEqual8(Byte(A and $FF), Byte(B and $FF));
+end;
+
+function ConstTimeEqual32(A, B: Cardinal): Boolean;
+begin
+ Result := ConstTimeEqual16(Word(A shr 16), Word(B shr 16))
+ and ConstTimeEqual16(Word(A and $FFFF), Word(B and $FFFF));
+end;
+
+function ConstTimeEqual64(A, B: TUInt64): Boolean;
+begin
+ Result := ConstTimeEqual32(Cardinal(A shr 32), Cardinal(B shr 32))
+ and ConstTimeEqual32(Cardinal(A and $FFFFFFFF), Cardinal(B and $FFFFFFFF));
+end;
+
+function ConstTimeCompareMem(P1, P2: Pointer; ByteLength: Integer): Boolean;
+var
+ B1, B2: PByte;
+ I: Integer;
+ Diff: Byte;
+begin
+ Diff := 0;
+ B1 := PByte(P1);
+ B2 := PByte(P2);
+
+ for I := 0 to ByteLength - 1 do
+ begin
+ Diff := Diff or (B1^ xor B2^);
+ Inc(B1);
+ Inc(B2);
+ end;
+
+ Result := Diff = 0;
+end;
+
+function ConstTimeCompareBytes(const A, B: TBytes): Boolean;
+begin
+ if Length(A) <> Length(B) then
+ Result := False
+ else
+ Result := ConstTimeCompareMem(@A[0], @B[0], Length(A));
+end;
+
+function ConstTimeExpandBoolean8(V: Boolean): Byte;
+begin
+ Result := Byte(V);
+ Result := not Result; // V True 0˲ R Ǵ $FFR ͷ 0
+ Result := Result and (Result shr 4); // һһ
+ Result := Result and (Result shr 2); // һλ 0
+ Result := Result and (Result shr 1); // 00000000 00000001
+ Result := Result or (Result shl 1); // True õ 00000000False õ 00000001λ
+ Result := Result or (Result shl 2);
+ Result := Result or (Result shl 4); // ȫ 0 ȫ 1
+ Result := not Result; // ȫ 1 ȫ 0
+end;
+
+function ConstTimeExpandBoolean16(V: Boolean): Word;
+var
+ R: Byte;
+begin
+ R := ConstTimeExpandBoolean8(V);
+ Result := R;
+ Result := (Result shl 8) or R; // ֽȫ 1 ȫ 0 ˫ֽ
+end;
+
+function ConstTimeExpandBoolean32(V: Boolean): Cardinal;
+var
+ R: Word;
+begin
+ R := ConstTimeExpandBoolean16(V);
+ Result := R;
+ Result := (Result shl 16) or R; // ˫ֽȫ 1 ȫ 0 ֽ
+end;
+
+function ConstTimeExpandBoolean64(V: Boolean): TUInt64;
+var
+ R: Cardinal;
+begin
+ R := ConstTimeExpandBoolean32(V);
+ Result := R;
+ Result := (Result shl 32) or R; // ֽȫ 1 ȫ 0 ɰֽ
+end;
+
+function ConstTimeConditionalSelect8(Condition: Boolean; A, B: Byte): Byte;
+begin
+ ConstTimeConditionalSwap8(Condition, A, B);
+ Result := B;
+end;
+
+function ConstTimeConditionalSelect16(Condition: Boolean; A, B: Word): Word;
+begin
+ ConstTimeConditionalSwap16(Condition, A, B);
+ Result := B;
+end;
+
+function ConstTimeConditionalSelect32(Condition: Boolean; A, B: Cardinal): Cardinal;
+begin
+ ConstTimeConditionalSwap32(Condition, A, B);
+ Result := B;
+end;
+
+function ConstTimeConditionalSelect64(Condition: Boolean; A, B: TUInt64): TUInt64;
+begin
+ ConstTimeConditionalSwap64(Condition, A, B);
+ Result := B;
+end;
+
+{$IFDEF MSWINDOWS}
+
+{$IFDEF CPUX64}
+
+// 64 λ IDIV IDIV ָʵ֣ A RCX B EDX/RDX DivRes ַ R8 ModRes ַ R9
+procedure Int64DivInt32Mod(A: Int64; B: Integer; var DivRes, ModRes: Integer); assembler;
+asm
+ PUSH RCX // RCX A
+ MOV RCX, RDX // B RCX
+ POP RAX // A RAX
+ XOR RDX, RDX // 64 λ
+ IDIV RCX
+ MOV [R8], EAX // ̷ R8 ָ DivRes
+ MOV [R9], EDX // R9 ָ ModRes
+end;
+
+procedure UInt64DivUInt32Mod(A: TUInt64; B: Cardinal; var DivRes, ModRes: Cardinal); assembler;
+asm
+ PUSH RCX // RCX A
+ MOV RCX, RDX // B RCX
+ POP RAX // A RAX
+ XOR RDX, RDX // 64 λ
+ DIV RCX
+ MOV [R8], EAX // ̷ R8 ָ DivRes
+ MOV [R9], EDX // R9 ָ ModRes
+end;
+
+// 64 λ IDIV IDIV ָʵ֣ALo RCXAHi RDXB R8DivRes ĵַ R9
+procedure Int128DivInt64Mod(ALo, AHi: Int64; B: Int64; var DivRes, ModRes: Int64); assembler;
+asm
+ MOV RAX, RCX // ALo RAXAHi Ѿ RDX
+ MOV RCX, R8 // B RCX
+ IDIV RCX
+ MOV [R9], RAX // ̷ R9 ָ DivRes
+ MOV RAX, [RBP + $30] // ModRes ַ RAX
+ MOV [RAX], RDX // RAX ָ ModRes
+end;
+
+procedure UInt128DivUInt64Mod(ALo, AHi: UInt64; B: UInt64; var DivRes, ModRes: UInt64); assembler;
+asm
+ MOV RAX, RCX // ALo RAXAHi Ѿ RDX
+ MOV RCX, R8 // B RCX
+ DIV RCX
+ MOV [R9], RAX // ̷ R9 ָ DivRes
+ MOV RAX, [RBP + $30] // ModRes ַ RAX
+ MOV [RAX], RDX // RAX ָ ModRes
+end;
+
+{$ELSE}
+
+// 32 λ IDIV IDIV ָʵ֣ A ڶջϣB EAXDivRes ַ EDXModRes ַ ECX
+procedure Int64DivInt32Mod(A: Int64; B: Integer; var DivRes, ModRes: Integer); assembler;
+asm
+ PUSH ECX // ECX ModRes ַȱ
+ MOV ECX, B // B EAX УƵ ECX
+ PUSH EDX // DivRes ĵַ EDX УҲ
+ MOV EAX, [EBP + $8] // A Lo
+ MOV EDX, [EBP + $C] // A Hi
+ IDIV ECX
+ POP ECX // ECXõ DivRes ַ
+ MOV [ECX], EAX
+ POP ECX // ECXõ ModRes ַ
+ MOV [ECX], EDX
+end;
+
+procedure UInt64DivUInt32Mod(A: TUInt64; B: Cardinal; var DivRes, ModRes: Cardinal); assembler;
+asm
+ PUSH ECX // ECX ModRes ַȱ
+ MOV ECX, B // B EAX УƵ ECX
+ PUSH EDX // DivRes ĵַ EDX УҲ
+ MOV EAX, [EBP + $8] // A Lo
+ MOV EDX, [EBP + $C] // A Hi
+ DIV ECX
+ POP ECX // ECXõ DivRes ַ
+ MOV [ECX], EAX
+ POP ECX // ECXõ ModRes ַ
+ MOV [ECX], EDX
+end;
+
+// 32 λµʵ
+procedure Int128DivInt64Mod(ALo, AHi: Int64; B: Int64; var DivRes, ModRes: Int64);
+var
+ C: Integer;
+begin
+ if B = 0 then
+ raise EDivByZero.Create(SDivByZero);
+
+ if (AHi = 0) or (AHi = $FFFFFFFFFFFFFFFF) then // 64 λΪ 0 ֵֵ
+ begin
+ DivRes := ALo div B;
+ ModRes := ALo mod B;
+ end
+ else
+ begin
+ if B < 0 then // Ǹ
+ begin
+ Int128DivInt64Mod(ALo, AHi, -B, DivRes, ModRes);
+ DivRes := -DivRes;
+ Exit;
+ end;
+
+ if AHi < 0 then // Ǹ
+ begin
+ // AHi, ALo 1Եõֵ
+ AHi := not AHi;
+ ALo := not ALo;
+{$IFDEF SUPPORT_UINT64}
+ UInt64Add(UInt64(ALo), UInt64(ALo), 1, C);
+{$ELSE}
+ UInt64Add(ALo, ALo, 1, C);
+{$ENDIF}
+ if C > 0 then
+ AHi := AHi + C;
+
+ // ת
+ Int128DivInt64Mod(ALo, AHi, B, DivRes, ModRes);
+
+ // ٵ
+ if ModRes = 0 then
+ DivRes := -DivRes
+ else
+ begin
+ DivRes := -DivRes - 1;
+ ModRes := B - ModRes;
+ end;
+ Exit;
+ end;
+
+ // ȫ
+{$IFDEF SUPPORT_UINT64}
+ UInt128DivUInt64Mod(TUInt64(ALo), TUInt64(AHi), TUInt64(B), TUInt64(DivRes), TUInt64(ModRes));
+{$ELSE}
+ UInt128DivUInt64Mod(ALo, AHi, B, DivRes, ModRes);
+{$ENDIF}
+ end;
+end;
+
+procedure UInt128DivUInt64Mod(ALo, AHi: TUInt64; B: TUInt64; var DivRes, ModRes: TUInt64);
+var
+ I, Cnt: Integer;
+ Q, R: TUInt64;
+begin
+ if B = 0 then
+ raise EDivByZero.Create(SDivByZero);
+
+ if AHi = 0 then
+ begin
+ DivRes := UInt64Div(ALo, B);
+ ModRes := UInt64Mod(ALo, B);
+ end
+ else
+ begin
+ // иλеλզ죿жǷ AHi >= BʾҪ 64 λ
+ if UInt64Compare(AHi, B) >= 0 then
+ raise EIntOverflow.Create(SIntOverflow);
+
+ Q := 0;
+ R := 0;
+ Cnt := GetUInt64LowBits(AHi) + 64;
+ for I := Cnt downto 0 do
+ begin
+ R := R shl 1;
+ if IsUInt128BitSet(ALo, AHi, I) then // ĵ I λǷ 0
+ R := R or 1
+ else
+ R := R and TUInt64(not 1);
+
+ if UInt64Compare(R, B) >= 0 then
+ begin
+ R := R - B;
+ Q := Q or (TUInt64(1) shl I);
+ end;
+ end;
+ DivRes := Q;
+ ModRes := R;
+ end;
+end;
+
+{$ENDIF}
+
+{$ENDIF}
+
+{$IFDEF SUPPORT_UINT64}
+
+// ֻҪ֧ 64 λ 32/64 λ Intel ARM Delphi FPCʲôϵͳ
+
+function UInt64Mod(A, B: TUInt64): TUInt64;
+begin
+ Result := A mod B;
+end;
+
+function UInt64Div(A, B: TUInt64): TUInt64;
+begin
+ Result := A div B;
+end;
+
+{$ELSE}
+{
+ ֧ UInt64 ĵͰ汾 Delphi Int64 A mod/div B
+
+ õջ˳ A ĸλA ĵλB ĸλB ĵλ push ϲ뺯
+ ESP ǷصַESP+4 B ĵλESP + 8 B ĸλESP + C A ĵλESP + 10 A ĸλ
+ push esp ESP 4Ȼ mov ebp esp֮ EBP ѰַȫҪ 4
+
+ System.@_llumod ҪڸսʱEAX <- A ĵλEDX <- A ĸλSystem Դע EAX/EDX дˣ
+ [ESP + 8]Ҳ EBP + C<- B ĸλ[ESP + 4] Ҳ EBP + 8<- B ĵλ
+
+ CALL ǰľƴ롣UInt64 Div Ҳ
+}
+function UInt64Mod(A, B: TUInt64): TUInt64;
+asm
+ // PUSH ESP ESP 4Ҫ
+ MOV EAX, [EBP + $10] // A Lo
+ MOV EDX, [EBP + $14] // A Hi
+ PUSH DWORD PTR[EBP + $C] // B Hi
+ PUSH DWORD PTR[EBP + $8] // B Lo
+ CALL System.@_llumod;
+end;
+
+function UInt64Div(A, B: TUInt64): TUInt64;
+asm
+ // PUSH ESP ESP 4Ҫ
+ MOV EAX, [EBP + $10] // A Lo
+ MOV EDX, [EBP + $14] // A Hi
+ PUSH DWORD PTR[EBP + $C] // B Hi
+ PUSH DWORD PTR[EBP + $8] // B Lo
+ CALL System.@_lludiv;
+end;
+
+{$ENDIF}
+
+{$IFDEF SUPPORT_UINT64}
+
+// ֻҪ֧ 64 λ 32/64 λ Intel ARM Delphi FPCʲôϵͳ
+
+function UInt64Mul(A, B: Cardinal): TUInt64;
+begin
+ Result := TUInt64(A) * B;
+end;
+
+{$ELSE} // ֻеͰ汾 Delphi Win32 x86
+
+{
+ 32 λˣֱʹ Int64 ģ 64 λ
+
+ üĴԼ A -> EAXB -> EDXʹöջ
+ System.@_llmul ҪڸսʱEAX <- A ĵλEDX <- A ĸλ 0
+ [ESP + 8]Ҳ EBP + C<- B ĸλ 0[ESP + 4] Ҳ EBP + 8<- B ĵλ
+}
+function UInt64Mul(A, B: Cardinal): TUInt64;
+asm
+ PUSH 0 // PUSH B λ 0
+ PUSH EDX // PUSH B λ
+ // EAX A λѾ
+ XOR EDX, EDX // EDX A λ 0
+ CALL System.@_llmul; // EAX 32 λEDX 32 λ
+end;
+
+{$ENDIF}
+
+// 64 λӣ ResLo ResHi
+procedure UInt64AddUInt64(A, B: TUInt64; var ResLo, ResHi: TUInt64);
+var
+ X, Y, Z, T, R0L, R0H, R1L, R1H: Cardinal;
+ R0, R1, R01, R12: TUInt64;
+begin
+ // ˼룺2^32 ϵ M (xM+y) + (zM+t) = (x+z) M + (y+t)
+ // y+t R0 ռ 01x+z R1 ռ 12 R0, R1 ٲӳ R01, R12
+ if IsUInt64AddOverflow(A, B) then
+ begin
+ X := Int64Rec(A).Hi;
+ Y := Int64Rec(A).Lo;
+ Z := Int64Rec(B).Hi;
+ T := Int64Rec(B).Lo;
+
+ R0 := TUInt64(Y) + TUInt64(T);
+ R1 := TUInt64(X) + TUInt64(Z);
+
+ R0L := Int64Rec(R0).Lo;
+ R0H := Int64Rec(R0).Hi;
+ R1L := Int64Rec(R1).Lo;
+ R1H := Int64Rec(R1).Hi;
+
+ R01 := TUInt64(R0H) + TUInt64(R1L);
+ R12 := TUInt64(R1H) + TUInt64(Int64Rec(R01).Hi);
+
+ Int64Rec(ResLo).Lo := R0L;
+ Int64Rec(ResLo).Hi := Int64Rec(R01).Lo;
+ Int64Rec(ResHi).Lo := Int64Rec(R12).Lo;
+ Int64Rec(ResHi).Hi := Int64Rec(R12).Hi;
+ end
+ else
+ begin
+ ResLo := A + B;
+ ResHi := 0;
+ end;
+end;
+
+{$IFDEF WIN64} // ע Linux 64 ²֧ ASMֻ WIN64
+
+// 64 λ 64 λˣ ResLo ResHi Уֱûʵ֣һ
+procedure UInt64MulUInt64(A, B: UInt64; var ResLo, ResHi: UInt64); assembler;
+asm
+ PUSH RAX
+ MOV RAX, RCX
+ MUL RDX // ţзŵ IMUL
+ MOV [R8], RAX
+ MOV [R9], RDX
+ POP RAX
+end;
+
+{$ELSE}
+
+// 64 λˣ ResLo ResHi
+procedure UInt64MulUInt64(A, B: TUInt64; var ResLo, ResHi: TUInt64);
+var
+ X, Y, Z, T: Cardinal;
+ YT, XT, ZY, ZX: TUInt64;
+ P, R1Lo, R1Hi, R2Lo, R2Hi: TUInt64;
+begin
+ // ˼룺2^32 ϵ M (xM+y)*(zM+t) = xzM^2 + (xt+yz)M + yt
+ // ϵ UInt64xz ռ 234xt+yz ռ 123yt ռ 01Ȼۼ
+ X := Int64Rec(A).Hi;
+ Y := Int64Rec(A).Lo;
+ Z := Int64Rec(B).Hi;
+ T := Int64Rec(B).Lo;
+
+ YT := UInt64Mul(Y, T);
+ XT := UInt64Mul(X, T);
+ ZY := UInt64Mul(Y, Z);
+ ZX := UInt64Mul(X, Z);
+
+ Int64Rec(ResLo).Lo := Int64Rec(YT).Lo;
+
+ P := Int64Rec(YT).Hi;
+ UInt64AddUInt64(P, XT, R1Lo, R1Hi);
+ UInt64AddUInt64(ZY, R1Lo, R2Lo, R2Hi);
+
+ Int64Rec(ResLo).Hi := Int64Rec(R2Lo).Lo;
+
+ P := TUInt64(Int64Rec(R2Lo).Hi) + TUInt64(Int64Rec(ZX).Lo);
+
+ Int64Rec(ResHi).Lo := Int64Rec(P).Lo;
+ Int64Rec(ResHi).Hi := Int64Rec(R1Hi).Lo + Int64Rec(R2Hi).Lo + Int64Rec(ZX).Hi + Int64Rec(P).Hi;
+end;
+
+{$ENDIF}
+
+{$HINTS OFF}
+
+function _ValUInt64(const S: string; var Code: Integer): TUInt64;
+const
+ FirstIndex = 1;
+var
+ I: Integer;
+ Dig: Integer;
+ Sign: Boolean;
+ Empty: Boolean;
+begin
+ I := FirstIndex;
+ Dig := 0;
+ Result := 0;
+
+ if S = '' then
+ begin
+ Code := 1;
+ Exit;
+ end;
+
+ while S[I] = Char(' ') do
+ Inc(I);
+ Sign := False;
+
+ if S[I] = Char('-') then
+ begin
+ Sign := True;
+ Code := 1; // ָ֧
+ Inc(I);
+ end
+ else if S[I] = Char('+') then
+ Inc(I);
+ Empty := True;
+
+ if (S[I] = Char('$')) or (UpCase(S[I]) = Char('X'))
+ or ((S[I] = Char('0')) and (I < Length(S)) and (UpCase(S[I + 1]) = Char('X'))) then
+ begin
+ if S[I] = Char('0') then
+ Inc(I);
+ Inc(I);
+ while True do
+ begin
+ if I > Length(S) then
+ Break;
+ case Char(S[I]) of
+ Char('0').. Char('9'): Dig := Ord(S[I]) - Ord('0');
+ Char('A').. Char('F'): Dig := Ord(S[I]) - (Ord('A') - 10);
+ Char('a').. Char('f'): Dig := Ord(S[I]) - (Ord('a') - 10);
+ else
+ Break;
+ end;
+
+ if Result > (CN_MAX_TUINT64 shr 4) then
+ Break;
+ if Sign and (Dig <> 0) then
+ Break;
+
+ Result := Result shl 4 + TUInt64(Dig);
+ Inc(I);
+ Empty := False;
+ end;
+ end
+ else
+ begin
+ while True do
+ begin
+ if I > Length(S) then
+ Break;
+ case Char(S[I]) of
+ Char('0').. Char('9'): Dig := Ord(S[I]) - Ord('0');
+ else
+ Break;
+ end;
+
+ if Result > UInt64Div(CN_MAX_TUINT64, 10) then
+ Break;
+ if Sign and (Dig <> 0) then
+ Break;
+
+ Result := Result * 10 + TUInt64(Dig);
+ Inc(I);
+ Empty := False;
+ end;
+ end;
+
+ if ((I <= Length(S)) and (S[I] <> Char(#0))) or Empty then
+ Code := I + 1 - FirstIndex
+ else
+ Code := 0;
+end;
+
+function _ValUInt32(const S: string; var Code: Integer): Cardinal;
+const
+ FirstIndex = 1;
+var
+ I: Integer;
+ Dig: Integer;
+ Sign: Boolean;
+ Empty: Boolean;
+begin
+ I := FirstIndex;
+ Dig := 0;
+ Result := 0;
+
+ if S = '' then
+ begin
+ Code := 1;
+ Exit;
+ end;
+
+ while S[I] = Char(' ') do
+ Inc(I);
+ Sign := False;
+
+ if S[I] = Char('-') then
+ begin
+ Sign := True;
+ Code := 1; // ָ֧
+ Inc(I);
+ end
+ else if S[I] = Char('+') then
+ Inc(I);
+ Empty := True;
+
+ if (S[I] = Char('$')) or (UpCase(S[I]) = Char('X'))
+ or ((S[I] = Char('0')) and (I < Length(S)) and (UpCase(S[I + 1]) = Char('X'))) then
+ begin
+ if S[I] = Char('0') then
+ Inc(I);
+ Inc(I);
+ while True do
+ begin
+ if I > Length(S) then
+ Break;
+ case Char(S[I]) of
+ Char('0').. Char('9'): Dig := Ord(S[I]) - Ord('0');
+ Char('A').. Char('F'): Dig := Ord(S[I]) - (Ord('A') - 10);
+ Char('a').. Char('f'): Dig := Ord(S[I]) - (Ord('a') - 10);
+ else
+ Break;
+ end;
+
+ if Result > (CN_MAX_UINT32 shr 4) then
+ Break;
+ if Sign and (Dig <> 0) then
+ Break;
+
+ Result := Result shl 4 + Cardinal(Dig);
+ Inc(I);
+ Empty := False;
+ end;
+ end
+ else
+ begin
+ while True do
+ begin
+ if I > Length(S) then
+ Break;
+ case Char(S[I]) of
+ Char('0').. Char('9'): Dig := Ord(S[I]) - Ord('0');
+ else
+ Break;
+ end;
+
+ if Result > (CN_MAX_UINT32 div 10) then
+ Break;
+ if Sign and (Dig <> 0) then
+ Break;
+
+ Result := Result * 10 + Cardinal(Dig);
+ Inc(I);
+ Empty := False;
+ end;
+ end;
+
+ if ((I <= Length(S)) and (S[I] <> Char(#0))) or Empty then
+ Code := I + 1 - FirstIndex
+ else
+ Code := 0;
+end;
+
+{$HINTS ON}
+
+function UInt64ToHex(N: TUInt64; RemoveZeroPrefix: Boolean): string;
+const
+ Digits: array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+
+ function HC(B: Byte): string;
+ begin
+ Result := string(Digits[(B shr 4) and $0F] + Digits[B and $0F]);
+ end;
+
+begin
+ Result :=
+ HC(Byte((N and $FF00000000000000) shr 56))
+ + HC(Byte((N and $00FF000000000000) shr 48))
+ + HC(Byte((N and $0000FF0000000000) shr 40))
+ + HC(Byte((N and $000000FF00000000) shr 32))
+ + HC(Byte((N and $00000000FF000000) shr 24))
+ + HC(Byte((N and $0000000000FF0000) shr 16))
+ + HC(Byte((N and $000000000000FF00) shr 8))
+ + HC(Byte((N and $00000000000000FF)));
+
+ if RemoveZeroPrefix then
+ begin
+ while (Length(Result) > 1) and (Result[1] = '0') do
+ Delete(Result, 1, 1);
+ end;
+end;
+
+function UInt64ToStr(N: TUInt64): string;
+begin
+ Result := Format('%u', [N]);
+end;
+
+function StrToUInt64(const S: string): TUInt64;
+{$IFNDEF DELPHIXE6_UP}
+var
+ E: Integer;
+{$ENDIF}
+begin
+{$IFDEF DELPHIXE6_UP}
+ Result := SysUtils.StrToUInt64(S); // StrToUInt64 only exists under XE6 or above
+{$ELSE}
+ Result := _ValUInt64(S, E);
+ if E <> 0 then raise EConvertError.CreateResFmt(@SInvalidInteger, [S]);
+{$ENDIF}
+end;
+
+function StrToUInt(const S: string): Cardinal;
+{$IFNDEF DELPHI102_TOKYO_UP}
+var
+ E: Integer;
+{$ENDIF}
+begin
+{$IFDEF DELPHI102_TOKYO_UP}
+ Result := SysUtils.StrToUInt(S); // StrToUInt only exists under D102T or above
+{$ELSE}
+ Result := _ValUInt32(S, E);
+ if E <> 0 then raise EConvertError.CreateResFmt(@SInvalidInteger, [S]);
+{$ENDIF}
+end;
+
+function UInt64Compare(A, B: TUInt64): Integer;
+{$IFNDEF SUPPORT_UINT64}
+var
+ HiA, HiB, LoA, LoB: Cardinal;
+{$ENDIF}
+begin
+{$IFDEF SUPPORT_UINT64}
+ if A > B then
+ Result := 1
+ else if A < B then
+ Result := -1
+ else
+ Result := 0;
+{$ELSE}
+ HiA := (A and $FFFFFFFF00000000) shr 32;
+ HiB := (B and $FFFFFFFF00000000) shr 32;
+ if HiA > HiB then
+ Result := 1
+ else if HiA < HiB then
+ Result := -1
+ else
+ begin
+ LoA := Cardinal(A and $00000000FFFFFFFF);
+ LoB := Cardinal(B and $00000000FFFFFFFF);
+ if LoA > LoB then
+ Result := 1
+ else if LoA < LoB then
+ Result := -1
+ else
+ Result := 0;
+ end;
+{$ENDIF}
+end;
+
+function UInt64Sqrt(N: TUInt64): TUInt64;
+var
+ Rem, Root: TUInt64;
+ I: Integer;
+begin
+ Result := 0;
+ if N = 0 then
+ Exit;
+
+ if UInt64Compare(N, 4) < 0 then
+ begin
+ Result := 1;
+ Exit;
+ end;
+
+ Rem := 0;
+ Root := 0;
+
+ for I := 0 to 31 do
+ begin
+ Root := Root shl 1;
+ Inc(Root);
+
+ Rem := Rem shl 2;
+ Rem := Rem or (N shr 62);
+ N := N shl 2;
+
+ if UInt64Compare(Root, Rem) <= 0 then
+ begin
+ Rem := Rem - Root;
+ Inc(Root);
+ end
+ else
+ Dec(Root);
+ end;
+ Result := Root shr 1;
+end;
+
+function UInt32IsNegative(N: Cardinal): Boolean;
+begin
+ Result := (N and (1 shl 31)) <> 0;
+end;
+
+function UInt64IsNegative(N: TUInt64): Boolean;
+begin
+{$IFDEF SUPPORT_UINT64}
+ Result := (N and (UInt64(1) shl 63)) <> 0;
+{$ELSE}
+ Result := N < 0;
+{$ENDIF}
+end;
+
+// UInt64 ijһλ 1λ Index 0 ʼ
+procedure UInt64SetBit(var B: TUInt64; Index: Integer);
+begin
+ B := B or (TUInt64(1) shl Index);
+end;
+
+// UInt64 ijһλ 0λ Index 0 ʼ
+procedure UInt64ClearBit(var B: TUInt64; Index: Integer);
+begin
+ B := B and not (TUInt64(1) shl Index);
+end;
+
+// UInt64 ĵڼλǷ 10 ʼ
+function GetUInt64BitSet(B: TUInt64; Index: Integer): Boolean;
+begin
+ B := B and (TUInt64(1) shl Index);
+ Result := B <> 0;
+end;
+
+// UInt64 1 ߶λǵڼλλ 0û 1 -1
+function GetUInt64HighBits(B: TUInt64): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 63 downto 0 do
+ begin
+ if (B and (TUInt64(1) shl I)) <> 0 then // TUInt64 ǿתó 8 ߶λΪ 35 Ĵ
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Cardinal 1 ߶λǵڼλλ 0û 1 -1
+function GetUInt32HighBits(B: Cardinal): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 31 downto 0 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Word 1 ߶λǵڼλλ 0û 1 -1
+function GetUInt16HighBits(B: Word): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 15 downto 0 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Byte 1 ߶λǵڼλλ 0û 1 -1
+function GetUInt8HighBits(B: Byte): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 7 downto 0 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// 64 λȥλ 0 ʣµλȣû 1 0
+function GetUInt64BitLength(B: TUInt64): Integer;
+begin
+ Result := 1 + GetUInt64HighBits(B);
+end;
+
+// 32 λȥλ 0 ʣµλȣû 1 0
+function GetUInt32BitLength(B: Cardinal): Integer;
+begin
+ Result := 1 + GetUInt32HighBits(B);
+end;
+
+// 16 λȥλ 0 ʣµλȣû 1 0
+function GetUInt16BitLength(B: Word): Integer;
+begin
+ Result := 1 + GetUInt16HighBits(B);
+end;
+
+// 8 λȥλ 0 ʣµλȣû 1 0
+function GetUInt8BitLength(B: Byte): Integer;
+begin
+ Result := 1 + GetUInt8HighBits(B);
+end;
+
+// UInt64 1 Ͷλǵڼλλ 0û 1 -1
+function GetUInt64LowBits(B: TUInt64): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 0 to 63 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Cardinal 1 Ͷλǵڼλλ 0û 1 -1
+function GetUInt32LowBits(B: Cardinal): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 0 to 31 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Word 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+function GetUInt16LowBits(B: Word): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 0 to 15 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// Byte 1 Ͷλǵڼλλ 0ͬĩβ 0û 1 -1
+function GetUInt8LowBits(B: Byte): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if B = 0 then
+ Exit;
+
+ for I := 0 to 7 do
+ begin
+ if (B and (1 shl I)) <> 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+// װ Int64 Modֵʱȡģģ
+function Int64Mod(M, N: Int64): Int64;
+begin
+ if M > 0 then
+ Result := M mod N
+ else
+ Result := N - ((-M) mod N);
+end;
+
+function Int64CenterMod(A: Int64; N: Int64): Int64;
+begin
+ Result := Int64NonNegativeMod(A, N);
+ if Result > N div 2 then // ߰벿ֱӼ N
+ Result := Result - N;
+end;
+
+// жһ 32 λǷ 2
+function IsUInt32PowerOf2(N: Cardinal): Boolean;
+begin
+ Result := (N and (N - 1)) = 0;
+end;
+
+// жһ 64 λǷ 2
+function IsUInt64PowerOf2(N: TUInt64): Boolean;
+begin
+ Result := (N and (N - 1)) = 0;
+end;
+
+// õһָ 32 λȵ 2 ݣ 0
+function GetUInt32PowerOf2GreaterEqual(N: Cardinal): Cardinal;
+begin
+ Result := N - 1;
+ Result := Result or (Result shr 1);
+ Result := Result or (Result shr 2);
+ Result := Result or (Result shr 4);
+ Result := Result or (Result shr 8);
+ Result := Result or (Result shr 16);
+ Inc(Result);
+end;
+
+// õһָ 64 λ 2 ݣ 0
+function GetUInt64PowerOf2GreaterEqual(N: TUInt64): TUInt64;
+begin
+ Result := N - 1;
+ Result := Result or (Result shr 1);
+ Result := Result or (Result shr 2);
+ Result := Result or (Result shr 4);
+ Result := Result or (Result shr 8);
+ Result := Result or (Result shr 16);
+ Result := Result or (Result shr 32);
+ Inc(Result);
+end;
+
+// ж 32 λзǷ 32 λз
+function IsInt32AddOverflow(A, B: Integer): Boolean;
+var
+ C: Integer;
+begin
+ C := A + B;
+ Result := ((A > 0) and (B > 0) and (C < 0)) or // ͬҽ˵
+ ((A < 0) and (B < 0) and (C > 0));
+end;
+
+// ж 32 λǷ 32 λ
+function IsUInt32AddOverflow(A, B: Cardinal): Boolean;
+begin
+ Result := (A + B) < A; // ӣֻҪСһ˵
+end;
+
+// ж 64 λзǷ 64 λз
+function IsInt64AddOverflow(A, B: Int64): Boolean;
+var
+ C: Int64;
+begin
+ C := A + B;
+ Result := ((A > 0) and (B > 0) and (C < 0)) or // ͬҽ˵
+ ((A < 0) and (B < 0) and (C > 0));
+end;
+
+// ж 64 λǷ 64 λ
+function IsUInt64AddOverflow(A, B: TUInt64): Boolean;
+begin
+ Result := UInt64Compare(A + B, A) < 0; // ӣֻҪСһ˵
+end;
+
+function IsUInt64SubOverflowInt32(A: TUInt64; B: TUInt64): Boolean;
+var
+ GT: Boolean;
+ R: TUInt64;
+begin
+ GT := UInt64Compare(A, B) >= 0; // GT ʾ A >= B
+ if GT then
+ begin
+ R := A - B;
+ // ж 64 λŷΧ R Ƿ MaxInt32
+ Result := UInt64Compare(R, TUInt64(CN_MAX_INT32)) > 0;
+ end
+ else
+ begin
+ R := B - A;
+ // ж 64 λзŷΧ -R ǷС MinInt32Ҳж 64 λ R Ƿ MinInt32 ʽ
+ Result := UInt64Compare(R, CN_MIN_INT32_IN_INT64) > 0;
+ end;
+end;
+
+// 64 λӣA + B => R 1 λ
+procedure UInt64Add(var R: TUInt64; A, B: TUInt64; out Carry: Integer);
+begin
+ R := A + B;
+ if UInt64Compare(R, A) < 0 then // ӣֻҪСһ˵
+ Carry := 1
+ else
+ Carry := 0;
+end;
+
+// 64 λA - B => Rнλ 1 λ
+procedure UInt64Sub(var R: TUInt64; A, B: TUInt64; out Carry: Integer);
+begin
+ R := A - B;
+ if UInt64Compare(R, A) > 0 then // ֻҪڱ˵λ
+ Carry := 1
+ else
+ Carry := 0;
+end;
+
+// ж 32 λзǷ 32 λз
+function IsInt32MulOverflow(A, B: Integer): Boolean;
+var
+ T: Integer;
+begin
+ T := A * B;
+ Result := (B <> 0) and ((T div B) <> A);
+end;
+
+// ж 32 λǷ 32 λ
+function IsUInt32MulOverflow(A, B: Cardinal): Boolean;
+var
+ T: TUInt64;
+begin
+ T := TUInt64(A) * TUInt64(B);
+ Result := (T = Cardinal(T));
+end;
+
+// ж 32 λǷ 64 λзδҲ False ʱR ֱӷؽ
+function IsUInt32MulOverflowInt64(A, B: Cardinal; out R: TUInt64): Boolean;
+var
+ T: Int64;
+begin
+ T := Int64(A) * Int64(B);
+ Result := T < 0; // Int64 ֵ˵
+ if not Result then
+ R := TUInt64(T);
+end;
+
+// ж 64 λзǷ 64 λз
+function IsInt64MulOverflow(A, B: Int64): Boolean;
+var
+ T: Int64;
+begin
+ T := A * B;
+ Result := (B <> 0) and ((T div B) <> A);
+end;
+
+// ָת֧ͣ 32/64 λ
+function PointerToInteger(P: Pointer): Integer;
+begin
+{$IFDEF CPU64BITS}
+ // ôд Pointer ĵ 32 λ Integer
+ Result := Integer(P);
+{$ELSE}
+ Result := Integer(P);
+{$ENDIF}
+end;
+
+// תָ֧ͣ 32/64 λ
+function IntegerToPointer(I: Integer): Pointer;
+begin
+{$IFDEF CPU64BITS}
+ // ôд Pointer ĵ 32 λ Integer
+ Result := Pointer(I);
+{$ELSE}
+ Result := Pointer(I);
+{$ENDIF}
+end;
+
+// Int64 Χĺ࣬Ҫ N 0
+function Int64NonNegativeAddMod(A, B, N: Int64): Int64;
+begin
+ if IsInt64AddOverflow(A, B) then // Int64
+ begin
+ if A > 0 then
+ begin
+ // A B 0 UInt64 ȡģδ UInt64 ޣע N δ Int64 ȡģС Int64 ޣɸֵ
+ Result := UInt64NonNegativeAddMod(A, B, N);
+ end
+ else
+ begin
+ // A B С 0ȡ UInt64 ȡģĺδ UInt64 ޣģٱһ
+{$IFDEF SUPPORT_UINT64}
+ Result := UInt64(N) - UInt64NonNegativeAddMod(-A, -B, N);
+{$ELSE}
+ Result := N - UInt64NonNegativeAddMod(-A, -B, N);
+{$ENDIF}
+ end;
+ end
+ else // ֱӼ
+ Result := Int64NonNegativeMod(A + B, N);
+end;
+
+// UInt64 Χĺ࣬Ҫ N 0
+function UInt64NonNegativeAddMod(A, B, N: TUInt64): TUInt64;
+var
+ C, D: TUInt64;
+begin
+ if IsUInt64AddOverflow(A, B) then //
+ begin
+ C := UInt64Mod(A, N); // ģ
+ D := UInt64Mod(B, N);
+ if IsUInt64AddOverflow(C, D) then
+ begin
+ // ˵ģģûá
+ // һڵ 2^63N 2^63 + 1
+ // = + 2^64
+ // mod N = mod N + (2^64 - 1) mod N) + 1
+ // N 2^63 + 1 2^64 - 2ǰӲֱӺһģ
+ Result := UInt64Mod(UInt64Mod(A + B, N) + UInt64Mod(CN_MAX_TUINT64, N) + 1, N);
+ end
+ else
+ Result := UInt64Mod(C + D, N);
+ end
+ else
+ begin
+ Result := UInt64Mod(A + B, N);
+ end;
+end;
+
+function Int64NonNegativeMulMod(A, B, N: Int64): Int64;
+var
+ Neg: Boolean;
+begin
+ if N <= 0 then
+ raise EDivByZero.Create(SDivByZero);
+
+ // ΧСֱ
+ if not IsInt64MulOverflow(A, B) then
+ begin
+ Result := A * B mod N;
+ if Result < 0 then
+ Result := Result + N;
+ Exit;
+ end;
+
+ // ŵ
+ Result := 0;
+ if (A = 0) or (B = 0) then
+ Exit;
+
+ Neg := False;
+ if (A < 0) and (B > 0) then
+ begin
+ A := -A;
+ Neg := True;
+ end
+ else if (A > 0) and (B < 0) then
+ begin
+ B := -B;
+ Neg := True;
+ end
+ else if (A < 0) and (B < 0) then
+ begin
+ A := -A;
+ B := -B;
+ end;
+
+ // λѭ
+ while B <> 0 do
+ begin
+ if (B and 1) <> 0 then
+ Result := ((Result mod N) + (A mod N)) mod N;
+
+ A := A shl 1;
+ if A >= N then
+ A := A mod N;
+
+ B := B shr 1;
+ end;
+
+ if Neg then
+ Result := N - Result;
+end;
+
+function UInt64NonNegativeMulMod(A, B, N: TUInt64): TUInt64;
+begin
+ Result := 0;
+ if (UInt64Compare(A, CN_MAX_UINT32) <= 0) and (UInt64Compare(B, CN_MAX_UINT32) <= 0) then
+ begin
+ Result := UInt64Mod(A * B, N); // 㹻СĻֱӳ˺ģ
+ end
+ else
+ begin
+ while B <> 0 do
+ begin
+ if (B and 1) <> 0 then
+ Result := UInt64NonNegativeAddMod(Result, A, N);
+
+ A := UInt64NonNegativeAddMod(A, A, N);
+ // ôͳ㷨 A := A shl 1 N mod NΪ
+
+ B := B shr 1;
+ end;
+ end;
+end;
+
+// װķǸຯҲΪʱӸ豣֤ P 0
+function Int64NonNegativeMod(N: Int64; P: Int64): Int64;
+begin
+ if P <= 0 then
+ raise EDivByZero.Create(SDivByZero);
+
+ Result := N mod P;
+ if Result < 0 then
+ Inc(Result, P);
+end;
+
+// Int64 ķǸָ
+function Int64NonNegativPower(N: Int64; Exp: Integer): Int64;
+var
+ T: Int64;
+begin
+ if Exp < 0 then
+ raise ERangeError.Create(SRangeError)
+ else if Exp = 0 then
+ begin
+ if N <> 0 then
+ Result := 1
+ else
+ raise EDivByZero.Create(SDivByZero);
+ end
+ else if Exp = 1 then
+ Result := N
+ else
+ begin
+ Result := 1;
+ T := N;
+
+ while Exp > 0 do
+ begin
+ if (Exp and 1) <> 0 then
+ Result := Result * T;
+
+ Exp := Exp shr 1;
+ T := T * T;
+ end;
+ end;
+end;
+
+function Int64NonNegativeRoot(N: Int64; Exp: Integer): Int64;
+var
+ I: Integer;
+ X: Int64;
+ X0, X1: Extended;
+begin
+ if (Exp < 0) or (N < 0) then
+ raise ERangeError.Create(SRangeError)
+ else if Exp = 0 then
+ raise EDivByZero.Create(SDivByZero)
+ else if (N = 0) or (N = 1) then
+ Result := N
+ else if Exp = 2 then
+ Result := UInt64Sqrt(N)
+ else
+ begin
+ // ţٵ
+ I := GetUInt64HighBits(N) + 1; // õԼ Log2 N ֵ
+ I := (I div Exp) + 1;
+ X := 1 shl I; // õһϴ X0 ֵΪʼֵ
+
+ X0 := X;
+ X1 := X0 - (Power(X0, Exp) - N) / (Exp * Power(X0, Exp - 1));
+
+ while True do
+ begin
+ if (Trunc(X0) = Trunc(X1)) and (Abs(X0 - X1) < 0.001) then
+ begin
+ Result := Trunc(X1); // Trunc ֻ֧ Int64˻
+ Exit;
+ end;
+
+ X0 := X1;
+ X1 := X0 - (Power(X0, Exp) - N) / (Exp * Power(X0, Exp - 1));
+ end;
+ end;
+end;
+
+function UInt64NonNegativPower(N: TUInt64; Exp: Integer): TUInt64;
+var
+ T, RL, RH: TUInt64;
+begin
+ if Exp < 0 then
+ raise ERangeError.Create(SRangeError)
+ else if Exp = 0 then
+ begin
+ if N <> 0 then
+ Result := 1
+ else
+ raise EDivByZero.Create(SDivByZero);
+ end
+ else if Exp = 1 then
+ Result := N
+ else
+ begin
+ Result := 1;
+ T := N;
+
+ while Exp > 0 do
+ begin
+ if (Exp and 1) <> 0 then
+ begin
+ UInt64MulUInt64(Result, T, RL, RH);
+ Result := RL;
+ end;
+
+ Exp := Exp shr 1;
+ UInt64MulUInt64(T, T, RL, RH);
+ T := RL;
+ end;
+ end;
+end;
+
+function UInt64NonNegativeRoot(N: TUInt64; Exp: Integer): TUInt64;
+var
+ Bits: Integer;
+ L, H, M, B, P: TUInt64;
+ Cmp: Integer;
+ Overflow: Boolean;
+ E: Integer;
+begin
+ if Exp < 0 then
+ raise ERangeError.Create(SRangeError)
+ else if Exp = 0 then
+ raise EDivByZero.Create(SDivByZero)
+ else if (N = 0) or (N = 1) then
+ Result := N
+ else if Exp = 1 then
+ Result := N
+ else if Exp = 2 then
+ Result := UInt64Sqrt(N)
+ else
+ begin
+ // ֲ ֵ䣻
+ // + ǰж Ƚ M^Exp N
+ // շ floor(N^(1/Exp))
+
+ Bits := GetUInt64HighBits(N) + 1; // õԼ Log2 N ֵ
+ H := TUInt64(1) shl ((Bits + Exp - 1) div Exp);
+ if H = 0 then
+ H := N
+ else if H > N then
+ H := N;
+ L := 1;
+ Cmp := -1;
+
+ while L <= H do
+ begin
+ M := L + ((H - L) shr 1);
+ B := M;
+ P := 1;
+ E := Exp;
+ Overflow := False;
+ while E > 0 do
+ begin
+ if (E and 1) <> 0 then
+ begin
+ if (B <> 0) and (P > N div B) then
+ begin
+ Overflow := True;
+ Break;
+ end;
+ P := P * B;
+ end;
+ E := E shr 1;
+ if E > 0 then
+ begin
+ if (B <> 0) and (B > N div B) then
+ begin
+ Overflow := True;
+ Break;
+ end;
+ B := B * B;
+ end;
+ end;
+
+ if Overflow then
+ Cmp := 1
+ else if P > N then
+ Cmp := 1
+ else if P < N then
+ Cmp := -1
+ else
+ Cmp := 0;
+
+ if Cmp = 0 then
+ begin
+ Result := M;
+ Exit;
+ end
+ else if Cmp < 0 then
+ L := M + 1
+ else
+ begin
+ if M = 0 then
+ Break;
+ H := M - 1;
+ end;
+ end;
+
+ if Cmp > 0 then
+ Result := H
+ else
+ Result := L - 1;
+ end;
+end;
+
+function IsUInt128BitSet(Lo, Hi: TUInt64; N: Integer): Boolean;
+begin
+ if N < 64 then
+ Result := (Lo and (TUInt64(1) shl N)) <> 0
+ else
+ begin
+ Dec(N, 64);
+ Result := (Hi and (TUInt64(1) shl N)) <> 0;
+ end;
+end;
+
+procedure SetUInt128Bit(var Lo, Hi: TUInt64; N: Integer);
+begin
+ if N < 64 then
+ Lo := Lo or (TUInt64(1) shl N)
+ else
+ begin
+ Dec(N, 64);
+ Hi := Hi or (TUInt64(1) shl N);
+ end;
+end;
+
+procedure ClearUInt128Bit(var Lo, Hi: TUInt64; N: Integer);
+begin
+ if N < 64 then
+ Lo := Lo and not (TUInt64(1) shl N)
+ else
+ begin
+ Dec(N, 64);
+ Hi := Hi and not (TUInt64(1) shl N);
+ end;
+end;
+
+function UnsignedAddWithLimitRadix(A, B, C: Cardinal; var R: Cardinal;
+ L, H: Cardinal): Cardinal;
+begin
+ R := A + B + C;
+ if R > H then // нλ
+ begin
+ A := H - L + 1; // õ
+ B := R - L; // õ L ֵ
+
+ Result := B div A; // Ƶĵڼͽ
+ R := L + (B mod A); // ȥƺ
+ end
+ else
+ Result := 0;
+end;
+
+procedure InternalQuickSort(Mem: Pointer; L, R: Integer; ElementByteSize: Integer;
+ CompareProc: TCnMemSortCompareProc);
+var
+ I, J, P: Integer;
+begin
+ repeat
+ I := L;
+ J := R;
+ P := (L + R) shr 1;
+ repeat
+ while CompareProc(Pointer(TCnIntAddress(Mem) + I * ElementByteSize),
+ Pointer(TCnIntAddress(Mem) + P * ElementByteSize), ElementByteSize) < 0 do
+ Inc(I);
+ while CompareProc(Pointer(TCnIntAddress(Mem) + J * ElementByteSize),
+ Pointer(TCnIntAddress(Mem) + P * ElementByteSize), ElementByteSize) > 0 do
+ Dec(J);
+
+ if I <= J then
+ begin
+ MemorySwap(Pointer(TCnIntAddress(Mem) + I * ElementByteSize),
+ Pointer(TCnIntAddress(Mem) + J * ElementByteSize), ElementByteSize);
+
+ if P = I then
+ P := J
+ else if P = J then
+ P := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+
+ if L < J then
+ InternalQuickSort(Mem, L, J, ElementByteSize, CompareProc);
+ L := I;
+ until I >= R;
+end;
+
+function DefaultCompareProc(P1, P2: Pointer; ElementByteSize: Integer): Integer;
+begin
+ Result := MemoryCompare(P1, P2, ElementByteSize);
+end;
+
+procedure MemoryQuickSort(Mem: Pointer; ElementByteSize: Integer;
+ ElementCount: Integer; CompareProc: TCnMemSortCompareProc);
+begin
+ if (Mem <> nil) and (ElementCount > 0) and (ElementCount > 0) then
+ begin
+ if Assigned(CompareProc) then
+ InternalQuickSort(Mem, 0, ElementCount - 1, ElementByteSize, CompareProc)
+ else
+ InternalQuickSort(Mem, 0, ElementCount - 1, ElementByteSize, DefaultCompareProc);
+ end;
+end;
+
+{$IFDEF COMPILER5}
+
+function BoolToStr(Value: Boolean; UseBoolStrs: Boolean): string;
+begin
+ if UseBoolStrs then
+ begin
+ if Value then
+ Result := 'True'
+ else
+ Result := 'False';
+ end
+ else
+ begin
+ if Value then
+ Result := '-1'
+ else
+ Result := '0';
+ end;
+end;
+
+{$ENDIF}
+
+// =========================== ѭλ ====================================
+
+function RotateLeft16(A: Word; N: Integer): Word;
+begin
+ Result := (A shl N) or (A shr (16 - N));
+end;
+
+function RotateRight16(A: Word; N: Integer): Word;
+begin
+ Result := (A shr N) or (A shl (16 - N));
+end;
+
+function RotateLeft32(A: Cardinal; N: Integer): Cardinal;
+begin
+ Result := (A shl N) or (A shr (32 - N));
+end;
+
+function RotateRight32(A: Cardinal; N: Integer): Cardinal;
+begin
+ Result := (A shr N) or (A shl (32 - N));
+end;
+
+function RotateLeft64(A: TUInt64; N: Integer): TUInt64;
+begin
+ Result := (A shl N) or (A shr (64 - N));
+end;
+function RotateRight64(A: TUInt64; N: Integer): TUInt64;
+begin
+ Result := (A shr N) or (A shl (64 - N));
+end;
+
+initialization
+ FByteOrderIsBigEndian := CurrentByteOrderIsBigEndian;
+
+end.
diff --git a/CnPack/Crypto/CnPemUtils.pas b/CnPack/Crypto/CnPemUtils.pas
new file mode 100644
index 0000000..45d5d3c
--- /dev/null
+++ b/CnPack/Crypto/CnPemUtils.pas
@@ -0,0 +1,1332 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnPemUtils;
+{* |
+================================================================================
+* ƣ
+* ԪƣPEM ʽ뵥Ԫ
+* ԪߣCnPack
+* עԪʵ PEM ʽĶȡ뱣棬ӽܻơ
+* Ҳʵ PKCS1/PKCS5/PKCS7/ISO10126 ȶ봦ơ
+* ע֧ PKCS12 淶֤鼰Կװʽ
+* ƽ̨WinXP + Delphi 5.0
+* ݲԣδ
+* õԪ豾ػ
+* ļ¼2026.04.05 V1.8
+* ǿְȫ
+* 2026.03.24 V1.7
+* ض汾ı TStringList д Stream BOM ƣʵ
+* 2024.05.27 V1.6
+* ISO10126 Ĵ
+* 2023.12.14 V1.5
+* SaveMemoryToPemStream δ
+* 2022.03.09 V1.4
+* PKCS5 Ĵ
+* 2021.05.14 V1.3
+* ĸ PKCS7 Ĵ
+* 2020.03.27 V1.2
+* ģ Openssl ʵ PEM ļд룬ֲֻּ֧㷨
+* Ŀǰд des/3des/aes128/192/256 PKCS7 룬 Openssl 1.0.2g
+* 2020.03.23 V1.1
+* ģ Openssl ʵ PEM ļܶȡֲֻּ֧㷨
+* Ŀǰȡ des/3des/aes128/192/256 PKCS7 룬 Openssl 1.0.2g
+* 2020.03.18 V1.0
+* Ԫ CnRSA ж
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes, CnNative, CnRandom, CnKDF, CnBase64, CnAES, CnDES, CnSM4;
+
+const
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_00 = 00;
+ {* PKCS1 ʱĿֵֶһĬӦ RSA ˽Կܻǩϣ RFC2313 Ƽʹ}
+
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_FF = 01;
+ {* PKCS1 ʱĿֵֶĬӦ RSA ˽ԿܻǩϣRFC2313 Ƽʹ}
+
+ CN_PKCS1_BLOCK_TYPE_PUBLIC_RANDOM = 02;
+ {* PKCS1 ʱĿֵֶĬӦ RSA ĹԿܳ}
+
+ CN_PKCS1_PADDING_SIZE = 11;
+ {* PKCS1 ĴСֵһǰ 00һֽڡ 8 ֽ䣬һ 00 β}
+
+ CN_PKCS5_BLOCK_SIZE = 8;
+ {* PKCS5 ĬϿС}
+
+ CN_PKCS7_BLOCK_SIZE = 16;
+ {* PKCS7 СAES}
+
+type
+ TCnKeyHashMethod = (ckhMd5, ckhSha256);
+ {* PEM ʽֵ֧Ӵ}
+
+ TCnKeyEncryptMethod = (ckeNone, ckeDES, cke3DES, ckeAES128, ckeAES192, ckeAES256,
+ ckeSM4);
+ {* PEM ʽֵ֧ļ}
+
+// ======================= PEM ļдּ֧ӽ ========================
+
+function LoadPemFileToMemory(const FileName: string; const ExpectHead: string;
+ const ExpectTail: string; MemoryStream: TMemoryStream; const Password: string = '';
+ KeyHashMethod: TCnKeyHashMethod = ckhMd5): Boolean;
+{* PEM ʽļָ֤ͷβʵݲܽ Base64 롣
+
+
+ const FileName: string - ļ
+ const ExpectHead: string - ͷ
+ const ExpectTail: string - β
+ MemoryStream: TMemoryStream - ڴ
+ const Password: string - ļܣڴṩ
+ KeyHashMethod: TCnKeyHashMethod - ļʹõӴ
+
+ ֵBoolean - ضǷɹ
+}
+
+function LoadPemStreamToMemory(Stream: TStream; const ExpectHead: string;
+ const ExpectTail: string; MemoryStream: TMemoryStream; const Password: string = '';
+ KeyHashMethod: TCnKeyHashMethod = ckhMd5): Boolean;
+{* PEM ʽָ֤ͷβʵݲܽ Base64 롣
+
+
+ Stream: TStream -
+ const ExpectHead: string - ͷ
+ const ExpectTail: string - β
+ MemoryStream: TMemoryStream - ڴ
+ const Password: string - ܣڴṩ
+ KeyHashMethod: TCnKeyHashMethod - ʹõӴ
+
+ ֵBoolean - ضǷɹ
+}
+
+function SaveMemoryToPemFile(const FileName: string; const Head: string; const Tail: string;
+ MemoryStream: TMemoryStream; KeyEncryptMethod: TCnKeyEncryptMethod = ckeNone;
+ KeyHashMethod: TCnKeyHashMethod = ckhMd5; const Password: string = ''; Append: Boolean = False): Boolean;
+{* ݽ Base64 ܷвͷβдļAppend Ϊ True ʱʾӡ
+
+
+ const FileName: string - дĿļ
+ const Head: string - дͷ
+ const Tail: string - дβ
+ MemoryStream: TMemoryStream - д
+ KeyEncryptMethod: TCnKeyEncryptMethod - üͣĬϲ
+ KeyHashMethod: TCnKeyHashMethod - Ӵ
+ const Password: string - 룬
+ Append: Boolean - Ƿӵķʽд
+
+ ֵBoolean - Ƿдɹ
+}
+
+function SaveMemoryToPemStream(Stream: TStream; const Head: string; const Tail: string;
+ MemoryStream: TMemoryStream; KeyEncryptMethod: TCnKeyEncryptMethod = ckeNone;
+ KeyHashMethod: TCnKeyHashMethod = ckhMd5; const Password: string = ''; Append: Boolean = False): Boolean;
+{* ݽ Base64 ܷвͷβдAppend Ϊ True ʱʾӡ
+
+
+ Stream: TStream - дĿ
+ const Head: string - дͷ
+ const Tail: string - дβ
+ MemoryStream: TMemoryStream - д
+ KeyEncryptMethod: TCnKeyEncryptMethod - üͣĬϲ
+ KeyHashMethod: TCnKeyHashMethod - ӴͣĬϲӴ
+ const Password: string - 룬
+ Append: Boolean - Ƿӵķʽд
+
+ ֵBoolean - Ƿдɹ
+}
+
+// ===================== PKCS1 / PKCS7 Padding 봦 ====================
+
+function AddPKCS1Padding(PaddingType: Integer; BlockSize: Integer; Data: Pointer;
+ DataByteLen: Integer; OutStream: TStream): Boolean;
+{* ݿ鲹д Stream Уسɹڲô롣
+ PaddingType ȡ 012BlockLen ֽ 128 ȡʽ
+ EB = 00 || BT || PS || 00 || D
+ 00 ǰ涨ֽڣBT 1 ֽڵ PaddingType0 1 2 ֱ 00 FF
+ PS Ķֽݣ 00 ǹ涨Ľβֽڡ
+
+
+ PaddingType: Integer - ͣȡ 0 1 2
+ BlockSize: Integer - ֽڳ
+ Data: Pointer - ݿĵַ
+ DataByteLen: Integer - ݿֽڳ
+ OutStream: TStream -
+
+ ֵBoolean - ضǷӳɹ
+}
+
+function RemovePKCS1Padding(InData: Pointer; InDataByteLen: Integer; OutBuf: Pointer;
+ out OutByteLen: Integer): Boolean;
+{* ȥݿ PKCS1 PaddingسɹOutBuf ָĿóб֤
+ ɹOutLen ԭݳȡ
+
+
+ InData: Pointer - ȥݿĵַ
+ InDataByteLen: Integer - ȥݿֽڳ
+ OutBuf: Pointer - ȥݵ䳤ȱ㹻
+ out OutByteLen: Integer - ȥݳ
+
+ ֵBoolean - ضǷȥɹ
+}
+
+function GetPKCS7PaddingByteLength(OrignalByteLen: Integer; BlockSize: Integer): Integer;
+{* ԭʼ鳤ȼ PKCS7 ijȡ
+
+
+ OrignalByteLen: Integer - ԭʼֽڳ
+ BlockSize: Integer - PKCS7 ֽڳ
+
+ ֵInteger - PKCS7 ֽڳ
+}
+
+procedure AddPKCS7Padding(Stream: TMemoryStream; BlockSize: Integer);
+{* ĩβ PKCS7 涨䡰ݡ
+
+
+ Stream: TMemoryStream - ڴݣݽдβ
+ BlockSize: Integer - PKCS7 ֽڳ
+
+ ֵޣ
+}
+
+procedure RemovePKCS7Padding(Stream: TMemoryStream);
+{* ȥ PKCS7 涨ĩβ䡰ݡ
+
+
+ Stream: TMemoryStream - ȥڴ
+
+ ֵޣ}
+
+function StrAddPKCS7Padding(const Str: AnsiString; BlockSize: Integer): AnsiString;
+{* ַĩβ PKCS7 涨䡰ݡ
+
+
+ const Str: AnsiString - ַ
+ BlockSize: Integer - PKCS7 ֽڳ
+
+ ֵAnsiString - ضַ
+}
+
+function StrRemovePKCS7Padding(const Str: AnsiString): AnsiString;
+{* ȥ PKCS7 涨ַĩβ䡰ݡ
+
+
+ const Str: AnsiString - ȥַ
+
+ ֵAnsiString - ȥַ
+}
+
+procedure BytesAddPKCS7Padding(var Data: TBytes; BlockSize: Integer);
+{* ֽĩβ PKCS7 涨䡰ݡ
+
+
+ var Data: TBytes - ֽ飬ݽβ
+ BlockSize: Integer - PKCS7 ֽڳ
+
+ ֵޣ
+}
+
+procedure BytesRemovePKCS7Padding(var Data: TBytes);
+{* ȥ PKCS7 涨ֽĩβ䡰ݡ
+
+
+ var Data: TBytes - ȥֽ
+
+ ֵޣ
+}
+
+procedure AddPKCS5Padding(Stream: TMemoryStream);
+{* ĩβ PKCS5 涨䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ Stream: TMemoryStream - ڴݽβ
+
+ ֵޣ
+}
+
+procedure RemovePKCS5Padding(Stream: TMemoryStream);
+{* ȥ PKCS7 涨ĩβ䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ Stream: TMemoryStream - ȥڴ
+
+ ֵޣ
+}
+
+function StrAddPKCS5Padding(const Str: AnsiString): AnsiString;
+{* ַĩβ PKCS5 涨䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ const Str: AnsiString - ַ
+
+ ֵAnsiString - ضַ
+}
+
+function StrRemovePKCS5Padding(const Str: AnsiString): AnsiString;
+{* ȥ PKCS5 涨ַĩβ䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ const Str: AnsiString - ȥַ
+
+ ֵAnsiString - ȥַ
+}
+
+procedure BytesAddPKCS5Padding(var Data: TBytes);
+{* ֽĩβ PKCS5 涨䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ var Data: TBytes - ֽ飬ݽβ
+
+ ֵޣ
+}
+
+procedure BytesRemovePKCS5Padding(var Data: TBytes);
+{* ȥ PKCS7 涨ֽĩβ䡰ݣѭ PKCS7 淶С̶Ϊ 8 ֽڡ
+
+
+ var Data: TBytes - ȥֽ
+
+ ֵޣ
+}
+
+function GetISO10126PaddingByteLength(OrignalByteLen: Integer; BlockSize: Integer): Integer;
+{* ԭʼ鳤ȼ ISO10126Padding ijȡ
+
+
+ OrignalByteLen: Integer - ԭʼֽڳ
+ BlockSize: Integer - ISO10126 ֽڳ
+
+ ֵInteger - PKCS7 ֽڳ
+}
+
+procedure AddISO10126Padding(Stream: TMemoryStream; BlockSize: Integer);
+{* ĩβ ISO10126Padding 涨䡰ͼݡ
+
+
+ Stream: TMemoryStream - ڴݽβ
+ BlockSize: Integer - ISO10126 ֽڳ
+
+ ֵޣ
+}
+
+procedure RemoveISO10126Padding(Stream: TMemoryStream);
+{* ȥ ISO10126Padding 涨ĩβ䡰ͼݡ
+
+
+ Stream: TMemoryStream - ȥڴ
+
+ ֵޣ
+}
+
+function StrAddISO10126Padding(const Str: AnsiString; BlockSize: Integer): AnsiString;
+{* ַĩβ ISO10126Padding 涨䡰ͼݡ
+
+
+ const Str: AnsiString - ַ
+ BlockSize: Integer - ISO10126 ֽڴС
+
+ ֵAnsiString - ضַ
+}
+
+function StrRemoveISO10126Padding(const Str: AnsiString): AnsiString;
+{* ȥ ISO10126Padding 涨ַĩβ䡰ͼݡ
+
+
+ const Str: AnsiString - ȥַ
+
+ ֵAnsiString - ȥַ
+}
+
+procedure BytesAddISO10126Padding(var Data: TBytes; BlockSize: Integer);
+{* ֽĩβ ISO10126Padding 涨䡰ͼݡ
+
+
+ var Data: TBytes - ֽ飬ݽβ
+ BlockSize: Integer - ISO10126 ֽڳ
+
+ ֵޣ
+}
+
+procedure BytesRemoveISO10126Padding(var Data: TBytes);
+{* ȥ ISO10126Padding 涨ֽĩβ䡰ͼݡ
+
+
+ var Data: TBytes - ȥֽ
+
+ ֵޣ
+}
+
+implementation
+
+uses
+ CnStrings;
+
+const
+ ENC_HEAD_PROCTYPE = 'Proc-Type:';
+ ENC_HEAD_PROCTYPE_NUM = '4';
+ ENC_HEAD_ENCRYPTED = 'ENCRYPTED';
+ ENC_HEAD_DEK = 'DEK-Info:';
+
+ ENC_TYPE_AES128 = 'AES-128';
+ ENC_TYPE_AES192 = 'AES-192';
+ ENC_TYPE_AES256 = 'AES-256';
+ ENC_TYPE_DES = 'DES';
+ ENC_TYPE_3DES = 'DES-EDE3';
+ ENC_TYPE_SM4 = 'SM4';
+
+ ENC_BLOCK_CBC = 'CBC';
+
+ ENC_TYPE_STRS: array[TCnKeyEncryptMethod] of string =
+ ('', ENC_TYPE_DES, ENC_TYPE_3DES, ENC_TYPE_AES128, ENC_TYPE_AES192,
+ ENC_TYPE_AES256, ENC_TYPE_SM4);
+
+ ENC_TYPE_BLOCK_SIZE: array[TCnKeyEncryptMethod] of Byte =
+ (0, 8, 8, 16, 16, 16, 16);
+
+function Min(A, B: Integer): Integer;
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+function AddPKCS1Padding(PaddingType, BlockSize: Integer; Data: Pointer;
+ DataByteLen: Integer; OutStream: TStream): Boolean;
+var
+ I: Integer;
+ B, F: Byte;
+ RandBuf: TBytes;
+begin
+ Result := False;
+ if (Data = nil) or (DataByteLen <= 0) then
+ Exit;
+
+ //
+ if DataByteLen > BlockSize - CN_PKCS1_PADDING_SIZE then
+ Exit;
+
+ B := 0;
+ OutStream.Write(B, 1); // дǰֽ 00
+ B := PaddingType;
+ F := BlockSize - DataByteLen - 3; // 3 ʾһǰ 00һֽڡһ 00 β
+
+ OutStream.Write(B, 1);
+ case PaddingType of
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_00:
+ begin
+ B := 0;
+ for I := 1 to F do
+ OutStream.Write(B, 1);
+ end;
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_FF:
+ begin
+ B := $FF;
+ for I := 1 to F do
+ OutStream.Write(B, 1);
+ end;
+ CN_PKCS1_BLOCK_TYPE_PUBLIC_RANDOM:
+ begin
+ // ʹѧȫCSPRNGȫ Random/Randomize
+ // ԭʹ LCG α+ʱӣԤ⣬ Bleichenbacher
+ if F > 0 then
+ begin
+ SetLength(RandBuf, F);
+ CnRandomBytes(F); // CnRandomBytes ɰȫֽ
+ for I := 0 to F - 1 do
+ begin
+ if RandBuf[I] = 0 then
+ RandBuf[I] := 1; // ȷ㣬 PKCS1 淶
+ end;
+ OutStream.Write(RandBuf[0], F);
+ end;
+ end;
+ else
+ Exit;
+ end;
+
+ B := 0;
+ OutStream.Write(B, 1);
+ OutStream.Write(Data^, DataByteLen);
+ Result := True;
+end;
+
+function RemovePKCS1Padding(InData: Pointer; InDataByteLen: Integer; OutBuf: Pointer;
+ out OutByteLen: Integer): Boolean;
+var
+ P: PAnsiChar;
+ I, J, Start: Integer;
+ ValidPadding: Integer; // ʹDzֵ֧
+ LeadingZeros: Integer;
+ PaddingType: Byte;
+ SeparatorFound: Integer;
+begin
+ // ʱʵ֣ Padding ǷЧִͬIJ
+ Result := False;
+ OutByteLen := 0;
+ P := PAnsiChar(InData);
+
+ // ǰʱ䣩
+ LeadingZeros := 0;
+ for I := 0 to InDataByteLen - 1 do
+ begin
+ // ʹλ֧
+ ValidPadding := Ord(P[I] = #0) and Ord(I = LeadingZeros);
+ LeadingZeros := LeadingZeros + ValidPadding;
+ end;
+
+ // ǷЧҪһֽڣ
+ if LeadingZeros >= InDataByteLen then
+ Exit;
+
+ // ȡ Padding
+ PaddingType := Ord(P[LeadingZeros]);
+
+ // ʱҷָ00 ֽڣ
+ Start := 0;
+ SeparatorFound := 0;
+
+ for J := LeadingZeros + 1 to InDataByteLen - 1 do
+ begin
+ case PaddingType of
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_00:
+ begin
+ // ҵһֽ
+ if (P[J] <> #0) and (SeparatorFound = 0) then
+ begin
+ Start := J;
+ SeparatorFound := 1;
+ end;
+ end;
+ CN_PKCS1_BLOCK_TYPE_PRIVATE_FF,
+ CN_PKCS1_BLOCK_TYPE_PUBLIC_RANDOM:
+ begin
+ // ҵһֽ
+ if (P[J] = #0) and (SeparatorFound = 0) then
+ begin
+ Start := J + 1;
+ SeparatorFound := 1;
+ end;
+ end;
+ end;
+ end;
+
+ // ֤ Padding ͺͷָ
+ ValidPadding := Ord(
+ ((PaddingType = CN_PKCS1_BLOCK_TYPE_PRIVATE_00) or
+ (PaddingType = CN_PKCS1_BLOCK_TYPE_PRIVATE_FF) or
+ (PaddingType = CN_PKCS1_BLOCK_TYPE_PUBLIC_RANDOM)) and
+ (SeparatorFound = 1) and
+ (Start > 0) and
+ (Start < InDataByteLen)
+ );
+
+ // ʱ临
+ if ValidPadding = 1 then
+ begin
+ Move(P[Start], OutBuf^, InDataByteLen - Start);
+ OutByteLen := InDataByteLen - Start;
+ Result := True;
+ end;
+
+ // ע⣺ʹʧܣҲҪǰأֳʱ
+end;
+
+function GetPKCS7PaddingByteLength(OrignalByteLen: Integer; BlockSize: Integer): Integer;
+var
+ R: Byte;
+begin
+ R := OrignalByteLen mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+ Result := OrignalByteLen + R;
+end;
+
+procedure AddPKCS7Padding(Stream: TMemoryStream; BlockSize: Integer);
+var
+ R: Byte;
+ Buf: array[0..255] of Byte;
+begin
+ R := Stream.Size mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ FillChar(Buf[0], R, R);
+ Stream.Position := Stream.Size;
+ Stream.Write(Buf[0], R);
+end;
+
+procedure RemovePKCS7Padding(Stream: TMemoryStream);
+var
+ L, I: Byte;
+ Len: Cardinal;
+ Mem, PBuf: Pointer;
+ Valid: Boolean;
+begin
+ // ȥ Stream ĩβ 9 9 Padding
+ if Stream.Size > 1 then
+ begin
+ Stream.Position := Stream.Size - 1;
+ Stream.Read(L, 1);
+
+ // ߴ粻ף
+ if (L < 1) or (L > CN_PKCS7_BLOCK_SIZE) or (Stream.Size < L) then
+ Exit;
+
+ // ֽ֤ڶ Lֹ Padding Oracle
+ PBuf := Stream.Memory;
+ Valid := True;
+ for I := 1 to L do
+ if PByte(TCnNativeUInt(PBuf) + Stream.Size - I)^ <> L then
+ begin
+ Valid := False;
+ Break;
+ end;
+
+ if not Valid then
+ Exit;
+
+ Len := Stream.Size - L;
+ Mem := GetMemory(Len);
+ if Mem <> nil then
+ begin
+ Move(Stream.Memory^, Mem^, Len);
+ Stream.Clear;
+ Stream.Write(Mem^, Len);
+ FreeMemory(Mem);
+ end;
+ end;
+end;
+
+function StrAddPKCS7Padding(const Str: AnsiString; BlockSize: Integer): AnsiString;
+var
+ I, L: Integer;
+ R: Byte;
+begin
+ L := Length(Str);
+ R := L mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ SetLength(Result, L + R);
+ if L > 0 then
+ Move(Str[1], Result[1], L);
+
+ for I := 1 to R do
+ Result[L + I] := AnsiChar(R);
+end;
+
+function StrRemovePKCS7Padding(const Str: AnsiString): AnsiString;
+var
+ L: Integer;
+ I, V: Byte;
+ Valid: Boolean;
+begin
+ Result := Str;
+ if Result = '' then
+ Exit;
+
+ L := Length(Result);
+ V := Ord(Result[L]); // ĩǼʾ˼
+
+ // ֵ֤ϷԣPKCS7 ֵΧ 1~16С
+ if (V < 1) or (V > CN_PKCS7_BLOCK_SIZE) or (V > L) then
+ Exit;
+
+ // ֽ֤ڶ Vֹ Padding Oracle
+ // ԭֻһֽڣδ֤мֽǷһ
+ Valid := True;
+ for I := 1 to V do
+ begin
+ if Ord(Result[L - I + 1]) <> V then
+ begin
+ Valid := False;
+ Break;
+ end;
+ end;
+
+ if Valid then
+ Delete(Result, L - V + 1, V);
+end;
+
+procedure AddPKCS5Padding(Stream: TMemoryStream);
+begin
+ AddPKCS7Padding(Stream, CN_PKCS5_BLOCK_SIZE);
+end;
+
+procedure RemovePKCS5Padding(Stream: TMemoryStream);
+begin
+ RemovePKCS7Padding(Stream);
+end;
+
+function StrAddPKCS5Padding(const Str: AnsiString): AnsiString;
+begin
+ Result := StrAddPKCS7Padding(Str, CN_PKCS5_BLOCK_SIZE);
+end;
+
+function StrRemovePKCS5Padding(const Str: AnsiString): AnsiString;
+begin
+ Result := StrRemovePKCS7Padding(Str);
+end;
+
+procedure BytesAddPKCS7Padding(var Data: TBytes; BlockSize: Integer);
+var
+ R: Byte;
+ L, I: Integer;
+begin
+ L := Length(Data);
+ R := L mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ SetLength(Data, L + R);
+ for I := 0 to R - 1 do
+ Data[L + I] := R;
+end;
+
+procedure BytesRemovePKCS7Padding(var Data: TBytes);
+var
+ L, I, V: Integer;
+ Valid: Boolean;
+begin
+ L := Length(Data);
+ if L = 0 then
+ Exit;
+
+ V := Ord(Data[L - 1]); // ĩǼʾ˼ֽ
+
+ // ֵ֤ϷԣPKCS7 ֵΧ 1~16С
+ if (V < 1) or (V > CN_PKCS7_BLOCK_SIZE) or (V > L) then
+ Exit;
+
+ // ֽ֤ڶ Vֹ Padding Oracle
+ Valid := True;
+ for I := 1 to V do
+ if Data[L - I] <> V then
+ begin
+ Valid := False;
+ Break;
+ end;
+
+ if Valid then
+ SetLength(Data, L - V);
+end;
+
+procedure BytesAddPKCS5Padding(var Data: TBytes);
+begin
+ BytesAddPKCS7Padding(Data, CN_PKCS5_BLOCK_SIZE);
+end;
+
+procedure BytesRemovePKCS5Padding(var Data: TBytes);
+begin
+ BytesRemovePKCS7Padding(Data);
+end;
+
+function GetISO10126PaddingByteLength(OrignalByteLen: Integer; BlockSize: Integer): Integer;
+begin
+ Result := GetPKCS7PaddingByteLength(OrignalByteLen, BlockSize); // Ϊֱͬӵ
+end;
+
+procedure AddISO10126Padding(Stream: TMemoryStream; BlockSize: Integer);
+var
+ R: Byte;
+ RandBuf: TBytes;
+begin
+ R := Stream.Size mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ // ʹѧȫ䣬 ISO/IEC 9797-1
+ // ԭʹ FillChar ȫ 0 ʹܽȷ
+ SetLength(RandBuf, R);
+ RandBuf := CnRandomBytes(R); // ɰȫֽ
+ RandBuf[R - 1] := R; // һֽڼ¼䳤
+ Stream.Position := Stream.Size;
+ Stream.Write(RandBuf[0], R);
+end;
+
+procedure RemoveISO10126Padding(Stream: TMemoryStream);
+begin
+ RemovePKCS7Padding(Stream); // Ϊֱͬӵ
+end;
+
+function StrAddISO10126Padding(const Str: AnsiString; BlockSize: Integer): AnsiString;
+var
+ I, L: Integer;
+ R: Byte;
+begin
+ L := Length(Str);
+ R := L mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ SetLength(Result, L + R);
+ if L > 0 then
+ Move(Str[1], Result[1], L);
+
+ if R > 1 then
+ begin
+ for I := 1 to R - 1 do
+ Result[L + I] := #0;
+ end;
+ Result[L + R] := AnsiChar(R);
+end;
+
+function StrRemoveISO10126Padding(const Str: AnsiString): AnsiString;
+begin
+ Result := StrRemovePKCS7Padding(Str); // Ϊֱͬӵ
+end;
+
+procedure BytesAddISO10126Padding(var Data: TBytes; BlockSize: Integer);
+var
+ R: Byte;
+ L, I: Integer;
+begin
+ L := Length(Data);
+ R := L mod BlockSize;
+ R := BlockSize - R;
+ if R = 0 then
+ R := R + BlockSize;
+
+ SetLength(Data, L + R);
+ if R > 1 then
+ begin
+ for I := 0 to R - 2 do
+ Data[L + I] := 0;
+ end;
+ Data[L - 1 + R] := R;
+end;
+
+procedure BytesRemoveISO10126Padding(var Data: TBytes);
+begin
+ BytesRemovePKCS7Padding(Data); // Ϊֱͬӵ
+end;
+
+function EncryptPemStream(KeyHash: TCnKeyHashMethod; KeyEncrypt: TCnKeyEncryptMethod;
+ Stream: TStream; const Password: string; out EncryptedHead: string): Boolean;
+const
+ CRLF = #13#10;
+var
+ ES: TMemoryStream;
+ Keys: array[0..31] of Byte; // Key Ҳֻ 32 ֽ
+ IvStr: AnsiString;
+ HexIv: string;
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ AesIv: TCnAESBuffer;
+ DesKey: TCnDESKey;
+ Des3Key: TCn3DESKey;
+ DesIv: TCnDESIv;
+ Sm4Key: TCnSM4Key;
+ Sm4Iv: TCnSM4Iv;
+begin
+ Result := False;
+
+ //
+ if (KeyEncrypt = ckeNone) or (Password = '') then
+ Exit;
+
+ // Iv
+ SetLength(IvStr, ENC_TYPE_BLOCK_SIZE[KeyEncrypt]);
+ CnRandomFillBytes(@(IvStr[1]), ENC_TYPE_BLOCK_SIZE[KeyEncrypt]);
+ HexIv := DataToHex(@(IvStr[1]), ENC_TYPE_BLOCK_SIZE[KeyEncrypt], True); // Ҫд
+
+ EncryptedHead := ENC_HEAD_PROCTYPE + ' ' + ENC_HEAD_PROCTYPE_NUM + ',' + ENC_HEAD_ENCRYPTED + CRLF;
+ EncryptedHead := EncryptedHead + ENC_HEAD_DEK + ' ' + ENC_TYPE_STRS[KeyEncrypt]
+ + '-' + ENC_BLOCK_CBC + ',' + HexIv + CRLF;
+
+ ES := TMemoryStream.Create;
+ Stream.Position := 0;
+
+ try
+ if KeyHash = ckhMd5 then
+ begin
+ if not CnGetDeriveKey(AnsiString(Password), IvStr, @Keys[0], SizeOf(Keys)) then
+ Exit;
+ end
+ else if KeyHash = ckhSha256 then
+ begin
+ if not CnGetDeriveKey(AnsiString(Password), IvStr, @Keys[0], SizeOf(Keys), ckdSha256) then
+ Exit;
+ end
+ else
+ Exit;
+
+ case KeyEncrypt of
+ ckeDES:
+ begin
+ Move(Keys[0], DesKey[0], SizeOf(TCnDESKey));
+ Move(IvStr[1], DesIv[0], SizeOf(TCnDESIv));
+
+ DESEncryptStreamCBC(Stream, Stream.Size, DesKey, DesIv, ES);
+ Result := True;
+ end;
+ cke3DES:
+ begin
+ Move(Keys[0], Des3Key[0], SizeOf(TCn3DESKey));
+ Move(IvStr[1], DesIv[0], SizeOf(TCn3DESIv));
+
+ TripleDESEncryptStreamCBC(Stream, Stream.Size, Des3Key, DesIv, ES);
+ Result := True;
+ end;
+ ckeAES128:
+ begin
+ Move(Keys[0], AESKey128[0], SizeOf(TCnAESKey128));
+ Move(IvStr[1], AesIv[0], SizeOf(TCnAESBuffer));
+
+ EncryptAES128StreamCBC(Stream, Stream.Size, AESKey128, AesIv, ES);
+ Result := True;
+ end;
+ ckeAES192:
+ begin
+ Move(Keys[0], AESKey192[0], SizeOf(TCnAESKey192));
+ Move(IvStr[1], AesIv[0], SizeOf(TCnAESBuffer));
+
+ EncryptAES192StreamCBC(Stream, Stream.Size, AESKey192, AesIv, ES);
+ Result := True;
+ end;
+ ckeAES256:
+ begin
+ Move(Keys[0], AESKey256[0], SizeOf(TCnAESKey256));
+ Move(IvStr[1], AesIv[0], SizeOf(TCnAESBuffer));
+
+ EncryptAES256StreamCBC(Stream, Stream.Size, AESKey256, AesIv, ES);
+ Result := True;
+ end;
+ ckeSM4:
+ begin
+ Move(Keys[0], Sm4Key[0], SizeOf(TCnSM4Key));
+ Move(IvStr[1], Sm4Iv[0], SizeOf(TCnSM4Iv));
+
+ SM4EncryptStreamCBC(Stream, Stream.Size, Sm4Key, Sm4Iv, ES);
+ Result := True;
+ end;
+ end;
+ finally
+ if ES.Size > 0 then
+ begin
+ // ES д Stream
+ Stream.Size := 0;
+ Stream.Position := 0;
+ ES.SaveToStream(Stream);
+ Stream.Position := 0;
+ end;
+ ES.Free;
+ end;
+end;
+
+// ü㷨㡢ʼ Base64 Sд Stream
+function DecryptPemString(const S, M1, M2, HexIv, Password: string; Stream: TMemoryStream;
+ KeyHash: TCnKeyHashMethod): Boolean;
+var
+ DS: TMemoryStream;
+ Keys: array[0..31] of Byte; // Key Ҳֻ 32 ֽ
+ AESKey128: TCnAESKey128;
+ AESKey192: TCnAESKey192;
+ AESKey256: TCnAESKey256;
+ IvStr: AnsiString;
+ AesIv: TCnAESBuffer;
+ DesKey: TCnDESKey;
+ Des3Key: TCn3DESKey;
+ DesIv: TCnDESIv;
+ Sm4Key: TCnSM4Key;
+ Sm4Iv: TCnSM4Iv;
+begin
+ Result := False;
+ DS := nil;
+
+ if (M1 = '') or (M2 = '') or (HexIv = '') or (Password = '') then
+ Exit;
+
+ try
+ DS := TMemoryStream.Create;
+ if ECN_BASE64_OK <> Base64Decode(S, DS, False) then
+ Exit;
+
+ DS.Position := 0;
+ SetLength(IvStr, HexToData(HexIv));
+ if Length(IvStr) > 0 then
+ HexToData(HexIv, @IvStr[1]);
+
+ // Salt Լ Hash 㷨ӽܵ Key
+ FillChar(Keys[0], SizeOf(Keys), 0);
+ if KeyHash = ckhMd5 then
+ begin
+ if not CnGetDeriveKey(AnsiString(Password), IvStr, @Keys[0], SizeOf(Keys)) then
+ Exit;
+ end
+ else if KeyHash = ckhSha256 then
+ begin
+ if not CnGetDeriveKey(AnsiString(Password), IvStr, @Keys[0], SizeOf(Keys), ckdSha256) then
+ Exit;
+ end
+ else
+ Exit;
+
+ // DS ģҪ Stream
+ if (M1 = ENC_TYPE_AES256) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // AES-256-CBC ܵ
+ Move(Keys[0], AESKey256[0], SizeOf(TCnAESKey256));
+ Move(IvStr[1], AesIv[0], Min(SizeOf(TCnAESBuffer), Length(IvStr)));
+
+ DecryptAES256StreamCBC(DS, DS.Size, AESKey256, AesIv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ else if (M1 = ENC_TYPE_AES192) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // AES-192-CBC ܵ
+ Move(Keys[0], AESKey192[0], SizeOf(TCnAESKey192));
+ Move(IvStr[1], AesIv[0], Min(SizeOf(TCnAESBuffer), Length(IvStr)));
+
+ DecryptAES192StreamCBC(DS, DS.Size, AESKey192, AesIv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ else if (M1 = ENC_TYPE_AES128) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // AES-128-CBC ܵģ D5 òƿ Bug ³ AV
+ Move(Keys[0], AESKey128[0], SizeOf(TCnAESKey128));
+ Move(IvStr[1], AesIv[0], Min(SizeOf(TCnAESBuffer), Length(IvStr)));
+
+ DecryptAES128StreamCBC(DS, DS.Size, AESKey128, AesIv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ else if (M1 = ENC_TYPE_DES) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // DES-CBC ܵ
+ Move(Keys[0], DesKey[0], SizeOf(TCnDESKey));
+ Move(IvStr[1], DesIv[0], Min(SizeOf(TCnDESIv), Length(IvStr)));
+
+ DESDecryptStreamCBC(DS, DS.Size, DesKey, DesIv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ else if (M1 = ENC_TYPE_3DES) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // 3DES-CBC ܵ
+ Move(Keys[0], Des3Key[0], SizeOf(TCn3DESKey));
+ Move(IvStr[1], DesIv[0], Min(SizeOf(TCn3DESIv), Length(IvStr)));
+
+ TripleDESDecryptStreamCBC(DS, DS.Size, Des3Key, DesIv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ else if (M1 = ENC_TYPE_SM4) and (M2 = ENC_BLOCK_CBC) then
+ begin
+ // SM4-CBC ܵ
+ Move(Keys[0], Sm4Key[0], SizeOf(TCnSM4Key));
+ Move(IvStr[1], Sm4Iv[0], Min(SizeOf(TCnSM4Iv), Length(IvStr)));
+
+ SM4DecryptStreamCBC(DS, DS.Size, Sm4Key, Sm4Iv, Stream);
+ RemovePKCS7Padding(Stream);
+ Result := True;
+ end
+ finally
+ DS.Free;
+ end;
+end;
+
+function LoadPemStreamToMemory(Stream: TStream; const ExpectHead, ExpectTail: string;
+ MemoryStream: TMemoryStream; const Password: string; KeyHashMethod: TCnKeyHashMethod): Boolean;
+var
+ I, J, HeadIndex, TailIndex: Integer;
+ S, L1, L2, M1, M2, M3: string;
+ Sl: TStringList;
+begin
+ Result := False;
+
+ if (Stream <> nil) and (Stream.Size > 0) and (ExpectHead <> '') and (ExpectTail <> '') then
+ begin
+ Sl := TStringList.Create;
+ try
+ Sl.LoadFromStream(Stream);
+ if Sl.Count > 2 then
+ begin
+ HeadIndex := -1;
+ for I := 0 to Sl.Count - 1 do
+ begin
+ if Trim(Sl[I]) = ExpectHead then
+ begin
+ HeadIndex := I;
+ Break;
+ end;
+ end;
+
+ if HeadIndex < 0 then
+ Exit;
+
+ if HeadIndex > 0 then
+ for I := 0 to HeadIndex - 1 do
+ Sl.Delete(0);
+
+ // ҵͷˣβ
+
+ TailIndex := -1;
+ for I := 0 to Sl.Count - 1 do
+ begin
+ if Trim(Sl[I]) = ExpectTail then
+ begin
+ TailIndex := I;
+ Break;
+ end;
+ end;
+
+ if TailIndex > 0 then // ҵβͣɾβͺĶ
+ begin
+ if TailIndex < Sl.Count - 1 then
+ for I := Sl.Count - 1 downto TailIndex + 1 do
+ Sl.Delete(Sl.Count - 1);
+ end
+ else
+ Exit;
+
+ if Sl.Count < 2 then // ûݣ˳
+ Exit;
+
+ // ͷβ֤ͨǰжǷ
+ L1 := Sl[1];
+ if Pos(ENC_HEAD_PROCTYPE, L1) = 1 then // Ǽܵ
+ begin
+ Delete(L1, 1, Length(ENC_HEAD_PROCTYPE));
+ I := Pos(',', L1);
+ if I <= 1 then
+ Exit;
+
+ if Trim(Copy(L1, 1, I - 1)) <> ENC_HEAD_PROCTYPE_NUM then
+ Exit;
+
+ if Trim(Copy(L1, I + 1, MaxInt)) <> ENC_HEAD_ENCRYPTED then
+ Exit;
+
+ // ProcType: 4,ENCRYPTED жͨ
+
+ L2 := Sl[2];
+ if Pos(ENC_HEAD_DEK, L2) <> 1 then
+ Exit;
+
+ Delete(L2, 1, Length(ENC_HEAD_DEK));
+ I := Pos(',', L2);
+ if I <= 1 then
+ Exit;
+
+ M1 := Trim(Copy(L2, 1, I - 1)); // õ AES256-CBC
+ M3 := UpperCase(Trim(Copy(L2, I + 1, MaxInt))); // õʱʹõijʼ
+ I := Pos('-', M1);
+ if I <= 1 then
+ Exit;
+ J := Pos('-', Copy(M1, I + 1, MaxInt));
+ if J > 0 then
+ I := I + J; // AES-256-CBC
+
+ M2 := UpperCase(Trim(Copy(M1, I + 1, MaxInt))); // õģʽ ECB CBC
+ M1 := UpperCase(Trim(Copy(M1, 1, I - 1))); // õ㷨 DES AES
+
+ // ͷβȫɾ
+ Sl.Delete(Sl.Count - 1);
+ Sl.Delete(0);
+ Sl.Delete(0);
+ Sl.Delete(0);
+
+ S := '';
+ for I := 0 to Sl.Count - 1 do
+ S := S + Sl[I];
+
+ S := Trim(S);
+ if not Base64IsStrictText(S) then
+ Exit;
+
+ Result := DecryptPemString(S, M1, M2, M3, Password, MemoryStream, KeyHashMethod);
+ end
+ else // δܵģƴճ Base64
+ begin
+ Sl.Delete(Sl.Count - 1);
+ Sl.Delete(0);
+ S := '';
+ for I := 0 to Sl.Count - 1 do
+ S := S + Sl[I];
+
+ S := Trim(S);
+
+ // To De Base64 S
+ MemoryStream.Clear;
+ if not Base64IsStrictText(S) then
+ Exit;
+
+ Result := (ECN_BASE64_OK = Base64Decode(S, MemoryStream, False));
+ end;
+ end;
+ finally
+ Sl.Free;
+ end;
+ end;
+end;
+
+function LoadPemFileToMemory(const FileName, ExpectHead, ExpectTail: string;
+ MemoryStream: TMemoryStream; const Password: string; KeyHashMethod: TCnKeyHashMethod): Boolean;
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ Result := LoadPemStreamToMemory(Stream, ExpectHead, ExpectTail, MemoryStream, Password, KeyHashMethod);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure SplitStringToList(const S: string; List: TCnAnsiStrings);
+const
+ LINE_WIDTH = 64;
+var
+ C, R: AnsiString;
+begin
+ if List = nil then
+ Exit;
+
+ List.Clear;
+ if S <> '' then
+ begin
+ R := AnsiString(S);
+ while R <> '' do
+ begin
+ C := Copy(R, 1, LINE_WIDTH);
+ Delete(R, 1, LINE_WIDTH);
+ List.Add(C);
+ end;
+ end;
+end;
+
+function SaveMemoryToPemFile(const FileName, Head, Tail: string;
+ MemoryStream: TMemoryStream; KeyEncryptMethod: TCnKeyEncryptMethod;
+ KeyHashMethod: TCnKeyHashMethod; const Password: string; Append: Boolean): Boolean;
+var
+ S, EH: string;
+ List, Sl: TCnAnsiStringList;
+begin
+ Result := False;
+ if (MemoryStream <> nil) and (MemoryStream.Size <> 0) then
+ begin
+ MemoryStream.Position := 0;
+
+ if (KeyEncryptMethod <> ckeNone) and (Password <> '') then
+ begin
+ // MemoryStream
+ AddPKCS7Padding(MemoryStream, ENC_TYPE_BLOCK_SIZE[KeyEncryptMethod]);
+
+ // ټ
+ if not EncryptPemStream(KeyHashMethod, KeyEncryptMethod, MemoryStream, Password, EH) then
+ Exit;
+ end;
+
+ if ECN_BASE64_OK = Base64Encode(MemoryStream, S) then
+ begin
+ List := TCnAnsiStringList.Create;
+ try
+ SplitStringToList(S, List);
+
+ List.Insert(0, AnsiString(Head)); // ͨͷ
+ if EH <> '' then // ͷ
+ List.Insert(1, AnsiString(EH));
+ List.Add(AnsiString(Tail)); // ͨβ
+
+ if Append and FileExists(FileName) then
+ begin
+ Sl := TCnAnsiStringList.Create;
+ try
+ Sl.LoadFromFile(AnsiString(FileName));
+ Sl.AddStrings(List);
+ Sl.SaveToFile(AnsiString(FileName));
+ finally
+ Sl.Free;
+ end;
+ end
+ else
+ List.SaveToFile(AnsiString(FileName));
+
+ Result := True;
+ finally
+ List.Free;
+ end;
+ end;
+ end;
+end;
+
+function SaveMemoryToPemStream(Stream: TStream; const Head, Tail: string;
+ MemoryStream: TMemoryStream; KeyEncryptMethod: TCnKeyEncryptMethod;
+ KeyHashMethod: TCnKeyHashMethod; const Password: string; Append: Boolean): Boolean;
+var
+ S, EH: string;
+ List: TCnAnsiStringList;
+begin
+ Result := False;
+ if (MemoryStream <> nil) and (MemoryStream.Size <> 0) then
+ begin
+ MemoryStream.Position := 0;
+
+ if (KeyEncryptMethod <> ckeNone) and (Password <> '') then
+ begin
+ // MemoryStream
+ AddPKCS7Padding(MemoryStream, ENC_TYPE_BLOCK_SIZE[KeyEncryptMethod]);
+
+ // ټ
+ if not EncryptPemStream(KeyHashMethod, KeyEncryptMethod, MemoryStream, Password, EH) then
+ Exit;
+ end;
+
+ if ECN_BASE64_OK = Base64Encode(MemoryStream, S) then
+ begin
+ List := TCnAnsiStringList.Create;
+ try
+ SplitStringToList(S, List);
+
+ List.Insert(0, AnsiString(Head)); // ͨͷ
+ if EH <> '' then // ͷ
+ List.Insert(1, AnsiString(EH));
+ List.Add(AnsiString(Tail)); // ͨβ
+
+ if not Append then
+ Stream.Size := 0;
+
+ List.SaveToStream(Stream);
+
+ Result := True;
+ finally
+ List.Free;
+ end;
+ end;
+ end;
+end;
+
+end.
diff --git a/CnPack/Crypto/CnRandom.pas b/CnPack/Crypto/CnRandom.pas
new file mode 100644
index 0000000..495da09
--- /dev/null
+++ b/CnPack/Crypto/CnRandom.pas
@@ -0,0 +1,574 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnRandom;
+{* |
+================================================================================
+* ƣ
+* Ԫƣ䵥Ԫ
+* ԪߣCnPack (master@cnpack.org)
+* עԪװ Windows ƽ̨ MacOS/Linux ƽ̨µİȫ
+* ṩȫ书ܡ
+* ƽ̨Win7 + Delphi 5.0
+* ݲԣWin32/Win64/MacOS/Linux + Unicode/NonUnicode
+* õԪ豾ػ
+* ļ¼2026.03.23 V1.5
+* һײѭ⣬
+* Windows ִȽLinux Mac ҲͬŻֽ
+* 2026.01.29 V1.4
+* ܵģƫ²ֺ
+* 2023.01.15 V1.3
+* Windows ȫ urandom ֧ Linux
+* 2023.01.08 V1.2
+* Win64 API
+* 2022.08.22 V1.1
+* ʹòϵͳṩ
+* 2020.03.27 V1.0
+* Ԫ CnPrime ж
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils {$IFDEF MSWINDOWS}, Windows {$ENDIF}, Classes, CnNative;
+
+type
+ ECnRandomAPIError = class(Exception);
+ {* 쳣}
+
+function RandomUInt64: TUInt64;
+{* UInt64 Χڵڲ֧ UInt64 ƽ̨ Int64 档
+
+
+ ޣ
+
+ ֵTUInt64 - UInt64 Χڵ
+}
+
+function RandomUInt64LessThan(HighValue: TUInt64): TUInt64;
+{* شڵ 0 Сָ UInt64 ֵ
+
+
+ HighValue: TUInt64 - ָ UInt64
+
+ ֵTUInt64 - شڵ 0 Сָ HighValue
+}
+
+function RandomInt64: Int64;
+{* شڵ 0 С Int64
+
+
+ ޣ
+
+ ֵInt64 - شڵ 0 С Int64
+}
+
+function RandomInt64LessThan(HighValue: Int64): Int64;
+{* شڵ 0 Сָ Int64 ֵб֤ HighValue 0
+
+
+ HighValue: Int64 - ָ Int64
+
+ ֵInt64 - شڵ 0 Сָ HighValue
+}
+
+function RandomUInt32: Cardinal;
+{* UInt32 Χڵ
+
+
+ ޣ
+
+ ֵCardinal - UInt32 Χڵ
+}
+
+function RandomUInt32LessThan(HighValue: Cardinal): Cardinal;
+{* شڵ 0 Сָ UInt32 ֵ
+
+
+ HighValue: Cardinal - ָ UInt32
+
+ ֵCardinal - شڵ 0 Сָ HighValue
+}
+
+function RandomInt32: Integer;
+{* شڵ 0 С Int32
+
+
+ ޣ
+
+ ֵInteger - شڵ 0 С Int32
+}
+
+function RandomInt32LessThan(HighValue: Integer): Integer;
+{* شڵ 0 Сָ Int32 б֤ HighValue 0
+
+
+ HighValue: Integer - ָ Int32
+
+ ֵInteger - شڵ 0 Сָ HighValue
+}
+
+function CnKnuthShuffle(ArrayBase: Pointer; ElementByteSize: Integer;
+ ElementCount: Integer): Boolean;
+{* ߵϴ㷨 ArrayBase ָԪسߴΪ ElementSize ElementCount Ԫؾϴơ
+
+
+ ArrayBase: Pointer - ϴƵڴַ
+ ElementByteSize: Integer - ϴƵÿڴԪҲÿһƵֽڴС
+ ElementCount: Integer - ڴԪҲƵ
+
+ ֵBoolean - ϴǷɹ
+}
+
+function CnRandomFillBytes(Buf: PAnsiChar; BufByteLen: Integer): Boolean;
+{* ʹ Windows API /dev/random 豸ʵ䣬ڲγʼ沢ͷš
+
+
+ Buf: PAnsiChar - ڴַ
+ BufByteLen: Integer - ڴֽڳ
+
+ ֵBoolean - Ƿɹ
+}
+
+function CnRandomFillBytes2(Buf: PAnsiChar; BufByteLen: Integer): Boolean;
+{* ʹ Windows API /dev/urandom 豸ʵ䣬
+ Windows ʹԤȳʼõ١
+
+
+ Buf: PAnsiChar - ڴַ
+ BufByteLen: Integer - ڴֽڳ
+
+ ֵBoolean - Ƿɹ
+}
+
+function CnRandomBytes(ByteLen: Integer): TBytes;
+{* ʹ Windows API /dev/random 豸䲢ָȵֽ顣
+
+
+ ByteLen: Integer - ɵֽֽڳ
+
+ ֵTBytes - ֽ
+}
+
+function CnRandomFloat: Extended;
+{* ʹѧȫ [0, 1) ΧڵĸΪģ Delphi Random
+ ڲ 4 ֽ $1000000002^32õȷϸС 1.0
+
+
+
+
+ ֵExtended - 0 <= Result < 1
+}
+
+implementation
+
+resourcestring
+ SCnErrorNoSecureRandom = 'NO Secure Random Generator!';
+
+{$IFDEF MSWINDOWS}
+
+const
+ ADVAPI32 = 'advapi32.dll';
+
+ CRYPT_VERIFYCONTEXT = $F0000000;
+ CRYPT_NEWKEYSET = $8;
+ CRYPT_DELETEKEYSET = $10;
+
+ PROV_RSA_FULL = 1;
+ NTE_BAD_KEYSET = $80090016;
+
+ BCRYPT_USE_SYSTEM_PREFERRED_RNG = $00000002;
+ bcryptdll = 'bcrypt.dll';
+
+function CryptAcquireContext(phProv: PHandle; pszContainer: PAnsiChar;
+ pszProvider: PAnsiChar; dwProvType: LongWord; dwFlags: LongWord): BOOL;
+ stdcall; external ADVAPI32 name 'CryptAcquireContextA';
+
+function CryptReleaseContext(hProv: THandle; dwFlags: LongWord): BOOL;
+ stdcall; external ADVAPI32 name 'CryptReleaseContext';
+
+function CryptGenRandom(hProv: THandle; dwLen: LongWord; pbBuffer: PAnsiChar): BOOL;
+ stdcall; external ADVAPI32 name 'CryptGenRandom';
+
+var
+ FHProv: THandle = 0;
+ FBCryptHandle: THandle = 0;
+ FBCryptGenRandom: function(hAlgorithm: THandle; pbBuffer: Pointer; cbBuffer: ULONG; dwFlags: ULONG): LongInt; stdcall = nil;
+ FBCryptInitAttempted: Boolean = False;
+
+{$ELSE}
+
+const
+ DEV_FILE = '/dev/urandom';
+
+{$IFDEF LINUX}
+const
+ libc = 'libc.so.6';
+function getrandom(buf: Pointer; buflen: NativeUInt; flags: Cardinal): Integer; cdecl; external libc name 'getrandom';
+{$ENDIF}
+
+{$IFDEF MACOS}
+function CCRandomGenerateBytes(bytes: Pointer; count: NativeUInt): Integer; cdecl; external '/usr/lib/system/libcommonCrypto.dylib' name 'CCRandomGenerateBytes';
+{$ENDIF}
+
+{$ENDIF}
+
+function CnRandomFillBytes(Buf: PAnsiChar; BufByteLen: Integer): Boolean;
+var
+{$IFDEF MSWINDOWS}
+ HProv: THandle;
+ Res: DWORD;
+ B: Boolean;
+{$ELSE}
+ F: TFileStream;
+{$IFDEF LINUX}
+ R: Integer;
+{$ENDIF}
+{$ENDIF}
+begin
+ Result := False;
+{$IFDEF MSWINDOWS}
+ // ʹ Windows API ʵ
+ if not FBCryptInitAttempted then
+ begin
+ FBCryptHandle := LoadLibrary(bcryptdll);
+ if FBCryptHandle <> 0 then
+ @FBCryptGenRandom := GetProcAddress(FBCryptHandle, 'BCryptGenRandom');
+ FBCryptInitAttempted := True;
+ end;
+
+ if Assigned(FBCryptGenRandom) then
+ begin
+ Result := FBCryptGenRandom(0, Buf, BufByteLen, BCRYPT_USE_SYSTEM_PREFERRED_RNG) = 0;
+ if Result then
+ Exit;
+ end;
+
+ //
+ HProv := 0;
+ B := CryptAcquireContext(@HProv, nil, nil, PROV_RSA_FULL, 0);
+ if not B then
+ B := CryptAcquireContext(@HProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
+
+ if not B then
+ begin
+ Res := GetLastError;
+ if Res = NTE_BAD_KEYSET then // KeyContainer ڣ½ķʽ
+ begin
+ if not CryptAcquireContext(@HProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET) then
+ raise ECnRandomAPIError.CreateFmt('Error CryptAcquireContext NewKeySet $%8.8x', [GetLastError]);
+ end
+ else
+ raise ECnRandomAPIError.CreateFmt('Error CryptAcquireContext $%8.8x', [Res]);
+ end;
+
+ if HProv <> 0 then
+ begin
+ try
+ Result := CryptGenRandom(HProv, BufByteLen, Buf);
+ if not Result then
+ raise ECnRandomAPIError.CreateFmt('Error CryptGenRandom $%8.8x', [GetLastError]);
+ finally
+ CryptReleaseContext(HProv, 0);
+ end;
+ end;
+{$ELSE}
+{$IFDEF MACOS}
+ Result := CCRandomGenerateBytes(Buf, BufByteLen) = 0;
+ if Result then
+ Exit;
+{$ENDIF}
+{$IFDEF LINUX}
+ try
+ R := getrandom(Buf, BufByteLen, 0);
+ Result := (R = BufByteLen);
+ if Result then
+ Exit;
+ except
+ // ignore missing symbol or error
+ end;
+{$ENDIF}
+
+ // MacOS/Linux ½ʵ֣öȡ /dev/urandom ݵķʽ
+ F := nil;
+ try
+ F := TFileStream.Create(DEV_FILE, fmOpenRead);
+ Result := F.Read(Buf^, BufByteLen) = BufByteLen;
+ finally
+ F.Free;
+ end;
+{$ENDIF}
+end;
+
+function CnRandomFillBytes2(Buf: PAnsiChar; BufByteLen: Integer): Boolean;
+{$IFNDEF MSWINDOWS}
+var
+ F: TFileStream;
+{$IFDEF LINUX}
+ R: Integer;
+{$ENDIF}
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ if not FBCryptInitAttempted then
+ begin
+ FBCryptHandle := LoadLibrary(bcryptdll);
+ if FBCryptHandle <> 0 then
+ @FBCryptGenRandom := GetProcAddress(FBCryptHandle, 'BCryptGenRandom');
+ FBCryptInitAttempted := True;
+ end;
+
+ if Assigned(FBCryptGenRandom) then
+ begin
+ Result := FBCryptGenRandom(0, Buf, BufByteLen, BCRYPT_USE_SYSTEM_PREFERRED_RNG) = 0;
+ if Result then
+ Exit;
+ end;
+
+ Result := CryptGenRandom(FHProv, BufByteLen, Buf);
+{$ELSE}
+{$IFDEF MACOS}
+ Result := CCRandomGenerateBytes(Buf, BufByteLen) = 0;
+ if Result then
+ Exit;
+{$ENDIF}
+{$IFDEF LINUX}
+ try
+ R := getrandom(Buf, BufByteLen, 0);
+ Result := (R = BufByteLen);
+ if Result then
+ Exit;
+ except
+ // ignore missing symbol or error
+ end;
+{$ENDIF}
+
+ // MacOS/Linux ½ʵ֣öȡ /dev/urandom ݵķʽ
+ F := nil;
+ try
+ F := TFileStream.Create(DEV_FILE, fmOpenRead);
+ Result := F.Read(Buf^, BufByteLen) = BufByteLen;
+ finally
+ F.Free;
+ end;
+{$ENDIF}
+end;
+
+function CnRandomBytes(ByteLen: Integer): TBytes;
+begin
+ if ByteLen > 0 then
+ begin
+ SetLength(Result, ByteLen);
+ CnRandomFillBytes2(PAnsiChar(@Result[0]), ByteLen);
+ end;
+end;
+
+function CnRandomFloat: Extended;
+var
+ D: Cardinal;
+begin
+ if not CnRandomFillBytes2(PAnsiChar(@D), SizeOf(Cardinal)) then
+ raise ECnRandomAPIError.Create(SCnErrorNoSecureRandom);
+
+ // 2^32$100000000 $FFFFFFFFȷϸС 1.0
+ // D = $FFFFFFFF ʱResult = $FFFFFFFF / $100000000 0.99999999976716...
+ Result := D;
+ Result := Result / $100000000;
+end;
+
+function RandomUInt64: TUInt64;
+var
+ HL: array[0..1] of Cardinal;
+begin
+ // ϵͳòȫ
+ if not CnRandomFillBytes2(PAnsiChar(@HL[0]), SizeOf(TUInt64)) then
+ raise ECnRandomAPIError.Create(SCnErrorNoSecureRandom);
+
+ Result := (TUInt64(HL[0]) shl 32) + HL[1];
+end;
+
+function RandomUInt64LessThan(HighValue: TUInt64): TUInt64;
+var
+ Threshold, R: TUInt64;
+ RetryCount: Integer;
+begin
+ if HighValue = 0 then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ // Discard numbers less than remainder of 2^64 / HighValue to avoid modulo bias
+ Threshold := (UInt64Mod(High(TUInt64), HighValue) + 1);
+ if Threshold = HighValue then
+ Threshold := 0;
+
+ RetryCount := 0;
+ repeat
+ R := RandomUInt64;
+ Inc(RetryCount);
+ if RetryCount > 100 then
+ raise ECnRandomAPIError.Create(SCnErrorNoSecureRandom); // 'RNG stuck in rejection loop. Hardware/OS RNG failure.'
+ until R >= Threshold;
+
+ Result := UInt64Mod(R, HighValue);
+end;
+
+function RandomInt64LessThan(HighValue: Int64): Int64;
+begin
+ if HighValue <= 0 then
+ Result := 0
+ else
+ Result := Int64(RandomUInt64LessThan(TUInt64(HighValue)));
+end;
+
+function RandomInt64: Int64;
+begin
+ Result := RandomInt64LessThan(High(Int64));
+end;
+
+function RandomUInt32: Cardinal;
+var
+ D: Cardinal;
+begin
+ // ϵͳòȫ
+ if not CnRandomFillBytes2(PAnsiChar(@D), SizeOf(Cardinal)) then
+ raise ECnRandomAPIError.Create(SCnErrorNoSecureRandom);
+
+ Result := D;
+end;
+
+function RandomUInt32LessThan(HighValue: Cardinal): Cardinal;
+var
+ Threshold, R: Cardinal;
+ RetryCount: Integer;
+begin
+ if HighValue = 0 then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ // Discard numbers less than remainder of 2^32 / HighValue to avoid modulo bias
+ Threshold := (High(Cardinal) mod HighValue + 1);
+ if Threshold = HighValue then
+ Threshold := 0;
+
+ RetryCount := 0;
+ repeat
+ R := RandomUInt32;
+ Inc(RetryCount);
+ if RetryCount > 100 then
+ raise ECnRandomAPIError.Create(SCnErrorNoSecureRandom);
+ until R >= Threshold;
+
+ Result := R mod HighValue;
+end;
+
+function RandomInt32: Integer;
+begin
+ Result := RandomInt32LessThan(High(Integer));
+end;
+
+function RandomInt32LessThan(HighValue: Integer): Integer;
+begin
+ if HighValue <= 0 then
+ Result := 0
+ else
+ Result := Integer(RandomUInt32LessThan(Cardinal(HighValue)));
+end;
+
+function CnKnuthShuffle(ArrayBase: Pointer; ElementByteSize: Integer;
+ ElementCount: Integer): Boolean;
+var
+ I, R: Integer;
+ B1, B2: Pointer;
+begin
+ Result := False;
+ if (ArrayBase = nil) or (ElementByteSize <= 0) or (ElementCount < 0) then // Ȳ
+ Exit;
+
+ Result := True;
+ if ElementCount <= 1 then // ûԪػֻһԪʱϴ
+ Exit;
+
+ for I := ElementCount - 1 downto 0 do
+ begin
+ R := RandomInt32LessThan(I + 1); // 0 I ڵҪ 1
+ B1 := Pointer(TCnNativeUInt(ArrayBase) + TCnNativeUInt(I * ElementByteSize));
+ B2 := Pointer(TCnNativeUInt(ArrayBase) + TCnNativeUInt(R * ElementByteSize));
+ MemorySwap(B1, B2, ElementByteSize);
+ end;
+ Result := True;
+end;
+
+{$IFDEF MSWINDOWS}
+
+procedure StartRandom;
+var
+ Res: DWORD;
+ B: Boolean;
+begin
+ FHProv := 0;
+ B := CryptAcquireContext(@FHProv, nil, nil, PROV_RSA_FULL, 0);
+ if not B then
+ B := CryptAcquireContext(@FHProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
+
+ if not B then
+ begin
+ Res := GetLastError;
+ if Res = NTE_BAD_KEYSET then // KeyContainer ڣ½ķʽ
+ begin
+ if not CryptAcquireContext(@FHProv, nil, nil, PROV_RSA_FULL, CRYPT_NEWKEYSET) then
+ raise ECnRandomAPIError.CreateFmt('Error CryptAcquireContext NewKeySet $%8.8x', [GetLastError]);
+ end
+ else
+ raise ECnRandomAPIError.CreateFmt('Error CryptAcquireContext $%8.8x', [Res]);
+ end;
+end;
+
+procedure StopRandom;
+begin
+ if FHProv <> 0 then
+ begin
+ CryptReleaseContext(FHProv, 0);
+ FHProv := 0;
+ end;
+
+ if FBCryptHandle <> 0 then
+ begin
+ FreeLibrary(FBCryptHandle);
+ FBCryptHandle := 0;
+ @FBCryptGenRandom := nil;
+ end;
+end;
+
+initialization
+ StartRandom;
+
+finalization
+ StopRandom;
+
+{$ENDIF}
+
+end.
diff --git a/CnPack/Crypto/CnSHA1.pas b/CnPack/Crypto/CnSHA1.pas
new file mode 100644
index 0000000..d93d428
--- /dev/null
+++ b/CnPack/Crypto/CnSHA1.pas
@@ -0,0 +1,757 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnSHA1;
+{* |
+================================================================================
+* ƣ
+* ԪƣSHA1 Ӵ㷨ʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* /ֲ䲿ֹܡ
+* עԪʵ SHA1 Ӵ㷨Ӧ HMAC 㷨
+* ƽ̨PWin2000Pro + Delphi 5.0
+* ݲԣPWin9X/2000/XP + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2022.04.26 V1.5
+* LongWord Integer ַת֧ MacOS64
+* 2019.12.12 V1.4
+* ֧ TBytes
+* 2019.04.15 V1.3
+* ֧ Win32/Win64/MacOS32
+* 2015.08.14 V1.2
+* л Pascal ֿ֧ƽ̨
+* 2014.10.22 V1.1
+* HMAC
+* 2010.07.14 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes {$IFDEF MSWINDOWS}, Windows {$ENDIF}, CnNative, CnConsts;
+
+type
+ PCnSHA1Digest = ^TCnSHA1Digest;
+ {* SHA1 Ӵսָ}
+ TCnSHA1Digest = array[0..19] of Byte;
+ {* SHA1 Ӵս20 ֽ}
+
+ TCnSHA1Context = packed record
+ {* SHA1 Ľṹ}
+ Hash: array[0..4] of Cardinal;
+ Hi, Lo: Cardinal;
+ Buffer: array[0..63] of Byte;
+ Index: Integer;
+ Ipad: array[0..63] of Byte; {!< HMAC: inner padding }
+ Opad: array[0..63] of Byte; {!< HMAC: outer padding }
+ end;
+
+ TCnSHA1CalcProgressFunc = procedure (ATotal, AProgress: Int64;
+ var Cancel: Boolean) of object;
+ {* SHA1 ӴսȻص¼}
+
+function SHA1(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA1Digest;
+{* ݿ SHA1 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1Buffer(const Buffer; Count: Cardinal): TCnSHA1Digest;
+{* ݿ SHA1 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1Bytes(const Data: TBytes): TCnSHA1Digest;
+{* ֽ SHA1 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1String(const Str: string): TCnSHA1Digest;
+{* String ݽ SHA1 㡣ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1StringA(const Str: AnsiString): TCnSHA1Digest;
+{* AnsiString ַ SHA1 㣬ֱӼڲݣޱ봦
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1StringW(const Str: WideString): TCnSHA1Digest;
+{* WideString ַת SHA1 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+{$IFDEF UNICODE}
+
+function SHA1UnicodeString(const Str: string): TCnSHA1Digest;
+{* UnicodeString ݽֱӵ SHA1 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+{$ELSE}
+
+function SHA1UnicodeString(const Str: WideString): TCnSHA1Digest;
+{* UnicodeString ݽֱӵ SHA1 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+{$ENDIF}
+
+function SHA1File(const FileName: string;
+ CallBack: TCnSHA1CalcProgressFunc = nil): TCnSHA1Digest;
+{* ָļݽ SHA1 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHA1CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+function SHA1Stream(Stream: TStream;
+ CallBack: TCnSHA1CalcProgressFunc = nil): TCnSHA1Digest;
+{* ָݽ SHA1 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHA1CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+// ⲿݽɢ SHA1 㣬SHA1Update ɶα
+
+procedure SHA1Init(var Context: TCnSHA1Context);
+{* ʼһ SHA1 ģ SHA1
+
+
+ var Context: TCnSHA1Context - ʼ SHA1
+
+ ֵޣ
+}
+
+procedure SHA1Update(var Context: TCnSHA1Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA1 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA1Context - SHA1
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA1Final(var Context: TCnSHA1Context; var Digest: TCnSHA1Digest);
+{* ּ㣬 SHA1 Digest С
+
+
+ var Context: TCnSHA1Context - SHA1
+ var Digest: TCnSHA1Digest - ص SHA1 Ӵֵ
+
+ ֵޣ
+}
+
+function SHA1Print(const Digest: TCnSHA1Digest): string;
+{* ʮƸʽ SHA1 Ӵֵ
+
+
+ const Digest: TCnSHA1Digest - ָ SHA1 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA1Match(const D1: TCnSHA1Digest; const D2: TCnSHA1Digest): Boolean;
+{* Ƚ SHA1 ӴֵǷȡ
+
+
+ const D1: TCnSHA1Digest - Ƚϵ SHA1 Ӵֵһ
+ const D2: TCnSHA1Digest - Ƚϵ SHA1 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA1DigestToStr(const Digest: TCnSHA1Digest): string;
+{* SHA1 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA1Digest - ת SHA1 Ӵֵ
+
+ ֵstring - صַ
+}
+
+procedure SHA1Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA1Digest);
+{* SHA1 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA1 Կݿַ
+ KeyByteLength: Integer - SHA1 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA1Digest - ص SHA1 Ӵֵ
+
+ ֵޣ
+}
+
+function SHA1HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA1Digest;
+{* ֽл SHA1 HMAC 㡣
+
+
+ const Key: TBytes - SHA1 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA1Digest - ص SHA1 Ӵֵ
+}
+
+implementation
+
+const
+ MAX_FILE_SIZE = 512 * 1024 * 1024;
+ // If file size <= this size (bytes), using Mapping, else stream
+
+ HMAC_SHA1_BLOCK_SIZE_BYTE = 64;
+ HMAC_SHA1_OUTPUT_LENGTH_BYTE = 20;
+
+function LRot32(X: Cardinal; C: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X shl (C and 31) + X shr (32 - C and 31);
+end;
+
+function F1(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := Z xor (X and (Y xor Z));
+end;
+
+function F2(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor Y xor Z;
+end;
+
+function F3(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) or (Z and (X or Y));
+end;
+
+function RB(A: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
+end;
+
+procedure SHA1Compress(var Data: TCnSHA1Context);
+var
+ A, B, C, D, E, T: Cardinal;
+ W: array[0..79] of Cardinal;
+ I: Integer;
+begin
+ Move(Data.Buffer, W, Sizeof(Data.Buffer));
+ for I := 0 to 15 do
+ W[I] := RB(W[I]);
+ for I := 16 to 79 do
+ W[I] := LRot32(W[I - 3] xor W[I - 8] xor W[I - 14] xor W[I - 16], 1);
+ A := Data.Hash[0];
+ B := Data.Hash[1];
+ C := Data.Hash[2];
+ D := Data.Hash[3];
+ E := Data.Hash[4];
+ for I := 0 to 19 do
+ begin
+ T := LRot32(A, 5) + F1(B, C, D) + E + W[I] + $5A827999;
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for I := 20 to 39 do
+ begin
+ T := LRot32(A, 5) + F2(B, C, D) + E + W[I] + $6ED9EBA1;
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for I := 40 to 59 do
+ begin
+ T := LRot32(A, 5) + F3(B, C, D) + E + W[I] + $8F1BBCDC;
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ for I := 60 to 79 do
+ begin
+ T := LRot32(A, 5) + F2(B, C, D) + E + W[I] + $CA62C1D6;
+ E := D;
+ D := C;
+ C := LRot32(B, 30);
+ B := A;
+ A := T;
+ end;
+ Data.Hash[0] := Data.Hash[0] + A;
+ Data.Hash[1] := Data.Hash[1] + B;
+ Data.Hash[2] := Data.Hash[2] + C;
+ Data.Hash[3] := Data.Hash[3] + D;
+ Data.Hash[4] := Data.Hash[4] + E;
+ FillChar(W, Sizeof(W), 0);
+ FillChar(Data.Buffer, Sizeof(Data.Buffer), 0);
+end;
+
+procedure SHA1Init(var Context: TCnSHA1Context);
+begin
+ Context.Hi := 0;
+ Context.Lo := 0;
+ Context.Index := 0;
+ FillChar(Context.Buffer, Sizeof(Context.Buffer), 0);
+ Context.Hash[0] := $67452301;
+ Context.Hash[1] := $EFCDAB89;
+ Context.Hash[2] := $98BADCFE;
+ Context.Hash[3] := $10325476;
+ Context.Hash[4] := $C3D2E1F0;
+end;
+
+procedure SHA1UpdateLen(var Context: TCnSHA1Context; Len: Integer);
+var
+ I: Cardinal;
+ K: Integer;
+begin
+ for K := 0 to 7 do
+ begin
+ I := Context.Lo;
+ Inc(Context.Lo, Len);
+ if Context.Lo < I then
+ Inc(Context.Hi);
+ end;
+end;
+
+procedure SHA1Update(var Context: TCnSHA1Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ B: Integer;
+begin
+ SHA1UpdateLen(Context, ByteLength);
+ while ByteLength > 0 do
+ begin
+ if Cardinal(64 - Context.Index) > ByteLength then
+ B := ByteLength
+ else
+ B := 64 - Context.Index;
+
+ Move(Input^, Context.Buffer[Context.Index], B);
+ Inc(PByte(Input), B);
+ Inc(Context.Index, B);
+ Dec(ByteLength, B);
+
+ if Context.Index = 64 then
+ begin
+ Context.Index := 0;
+ SHA1Compress(Context);
+ end;
+ end;
+end;
+
+procedure SHA1UpdateW(var Context: TCnSHA1Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ pContent: PAnsiChar;
+ iLen: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(pContent, CharLength * SizeOf(WideChar));
+ try
+ iLen := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(pContent), CharLength * SizeOf(WideChar), nil, nil);
+ SHA1Update(Context, pContent, iLen);
+ finally
+ FreeMem(pContent);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ SHA1Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+procedure SHA1Final(var Context: TCnSHA1Context; var Digest: TCnSHA1Digest);
+type
+ PDWord = ^Cardinal;
+begin
+ Context.Buffer[Context.Index] := $80;
+ if Context.Index >= 56 then
+ SHA1Compress(Context);
+ PDWord(@Context.Buffer[56])^ := RB(Context.Hi);
+ PDWord(@Context.Buffer[60])^ := RB(Context.Lo);
+ SHA1Compress(Context);
+ Context.Hash[0] := RB(Context.Hash[0]);
+ Context.Hash[1] := RB(Context.Hash[1]);
+ Context.Hash[2] := RB(Context.Hash[2]);
+ Context.Hash[3] := RB(Context.Hash[3]);
+ Context.Hash[4] := RB(Context.Hash[4]);
+ Move(Context.Hash, Digest, Sizeof(Digest));
+end;
+
+// ݿ SHA1
+function SHA1(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1Update(Context, Input, ByteLength);
+ SHA1Final(Context, Result);
+end;
+
+// ݿ SHA1
+function SHA1Buffer(const Buffer; Count: Cardinal): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1Update(Context, PAnsiChar(@Buffer), Count);
+ SHA1Final(Context, Result);
+end;
+
+function SHA1Bytes(const Data: TBytes): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA1Final(Context, Result);
+end;
+
+// String ݽ SHA1
+function SHA1String(const Str: string): TCnSHA1Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA1StringA(AStr);
+end;
+
+// AnsiString ݽ SHA1
+function SHA1StringA(const Str: AnsiString): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1Update(Context, PAnsiChar(Str), Length(Str));
+ SHA1Final(Context, Result);
+end;
+
+// WideString ݽ SHA1
+function SHA1StringW(const Str: WideString): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA1Final(Context, Result);
+end;
+
+{$IFDEF UNICODE}
+function SHA1UnicodeString(const Str: string): TCnSHA1Digest;
+{$ELSE}
+function SHA1UnicodeString(const Str: WideString): TCnSHA1Digest;
+{$ENDIF}
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1Init(Context);
+ SHA1Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA1Final(Context, Result);
+end;
+
+function InternalSHA1Stream(Stream: TStream; const BufSize: Cardinal; var D:
+ TCnSHA1Digest; CallBack: TCnSHA1CalcProgressFunc): Boolean;
+var
+ Context: TCnSHA1Context;
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+begin
+ Result := False;
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ if Size = 0 then Exit;
+ if Size < BufSize then BufLen := Size
+ else BufLen := BufSize;
+
+ CancelCalc := False;
+ SHA1Init(Context);
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ SHA1Update(Context, Buf, ReadBytes);
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ SHA1Final(Context, D);
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+// ָ SHA1
+function SHA1Stream(Stream: TStream;
+ CallBack: TCnSHA1CalcProgressFunc): TCnSHA1Digest;
+begin
+ InternalSHA1Stream(Stream, 4096 * 1024, Result, CallBack);
+end;
+
+// ָļݽ SHA1
+function SHA1File(const FileName: string;
+ CallBack: TCnSHA1CalcProgressFunc): TCnSHA1Digest;
+var
+{$IFDEF MSWINDOWS}
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+ Context: TCnSHA1Context;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+
+ function FileSizeIsLargeThanMaxOrCanNotMap(const AFileName: string; out IsEmpty: Boolean): Boolean;
+{$IFDEF MSWINDOWS}
+ var
+ H: THandle;
+ Info: BY_HANDLE_FILE_INFORMATION;
+ Rec : Int64Rec;
+{$ENDIF}
+ begin
+{$IFDEF MSWINDOWS}
+ Result := False;
+ IsEmpty := False;
+ H := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
+ if H = INVALID_HANDLE_VALUE then Exit;
+ try
+ if not GetFileInformationByHandle(H, Info) then Exit;
+ finally
+ CloseHandle(H);
+ end;
+ Rec.Lo := Info.nFileSizeLow;
+ Rec.Hi := Info.nFileSizeHigh;
+ Result := (Rec.Hi > 0) or (Rec.Lo > MAX_FILE_SIZE);
+ IsEmpty := (Rec.Hi = 0) and (Rec.Lo = 0);
+{$ELSE}
+ Result := True; // Windows ƽ̨ Trueʾ Mapping
+{$ENDIF}
+ end;
+
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣ Windows ƽ̨ʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalSHA1Stream(Stream, 4096 * 1024, Result, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ SHA1Init(Context);
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ SHA1Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ SHA1Final(Context, Result);
+{$ENDIF}
+ end;
+end;
+
+// ʮƸʽ SHA1 Ӵֵ
+function SHA1Print(const Digest: TCnSHA1Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA1Digest));
+end;
+
+// Ƚ SHA1 ӴֵǷ
+function SHA1Match(const D1, D2: TCnSHA1Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSHA1Digest));
+end;
+
+// SHA1 Ӵֵת string
+function SHA1DigestToStr(const Digest: TCnSHA1Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA1Digest));
+end;
+
+procedure SHA1HmacInit(var Context: TCnSHA1Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA1Digest;
+begin
+ if KeyLength > HMAC_SHA1_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA1Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA1_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA1_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA1_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA1Init(Context);
+ SHA1Update(Context, @(Context.Ipad[0]), HMAC_SHA1_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA1HmacUpdate(var Context: TCnSHA1Context; Input: PAnsiChar; Length: Cardinal);
+begin
+ SHA1Update(Context, Input, Length);
+end;
+
+procedure SHA1HmacFinal(var Context: TCnSHA1Context; var Output: TCnSHA1Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA1Digest;
+begin
+ Len := HMAC_SHA1_OUTPUT_LENGTH_BYTE;
+ SHA1Final(Context, TmpBuf);
+ SHA1Init(Context);
+ SHA1Update(Context, @(Context.Opad[0]), HMAC_SHA1_BLOCK_SIZE_BYTE);
+ SHA1Update(Context, @(TmpBuf[0]), Len);
+ SHA1Final(Context, Output);
+end;
+
+procedure SHA1Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA1Digest);
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1HmacInit(Context, Key, KeyByteLength);
+ SHA1HmacUpdate(Context, Input, ByteLength);
+ SHA1HmacFinal(Context, Output);
+end;
+
+function SHA1HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA1Digest;
+var
+ Context: TCnSHA1Context;
+begin
+ SHA1HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA1HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA1HmacFinal(Context, Result);
+end;
+
+end.
diff --git a/CnPack/Crypto/CnSHA2.pas b/CnPack/Crypto/CnSHA2.pas
new file mode 100644
index 0000000..3a32bc7
--- /dev/null
+++ b/CnPack/Crypto/CnSHA2.pas
@@ -0,0 +1,3294 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnSHA2;
+{* |
+================================================================================
+* ƣ
+* ԪƣSHA2 Ӵ㷨ʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* / C Pascal ֲ䲿ֹܡ
+* עԪʵ SHA2 ϵӴ㷨Ӧ HMAC 㷨
+* SHA224/256/384/512/512-224/512-256
+* ƽ̨PWinXP + Delphi 5.0
+* ݲԣPWinXP/7 + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2025.11.20 V1.5
+* ʵ SHA512-224 SHA512-256 㷨
+* 2022.04.26 V1.4
+* LongWord Integer ַת֧ MacOS64
+* 2019.04.15 V1.3
+* ֧ Win32/Win64/MacOS32
+* 2017.10.31 V1.2
+* SHA512/384 HMAC
+* 2016.09.30 V1.1
+* ʵ SHA512/384D567з Int64 UInt64
+* 2016.09.27 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes {$IFDEF MSWINDOWS}, Windows {$ENDIF}, CnNative, CnConsts;
+
+type
+ PCnSHA2GeneralDigest = ^TCnSHA2GeneralDigest;
+ {* SHA2 ϵͨõӴսָ}
+ TCnSHA2GeneralDigest = array[0..63] of Byte;
+ {* SHA2 ϵͨõӴս 64 ֽΪ}
+
+ PCnSHA224Digest = ^TCnSHA224Digest;
+ {* SHA224 Ӵսָ}
+ TCnSHA224Digest = array[0..27] of Byte;
+ {* SHA224 Ӵս28 ֽ}
+
+ PCnSHA256Digest = ^TCnSHA256Digest;
+ {* SHA256 Ӵսָ}
+ TCnSHA256Digest = array[0..31] of Byte;
+ {* SHA256 Ӵս32 ֽ}
+
+ PCnSHA384Digest = ^TCnSHA384Digest;
+ {* SHA384 Ӵսָ}
+ TCnSHA384Digest = array[0..47] of Byte;
+ {* SHA384 Ӵս48 ֽ}
+
+ PCnSHA512Digest = ^TCnSHA512Digest;
+ {* SHA512 Ӵսָ}
+ TCnSHA512Digest = array[0..63] of Byte;
+ {* SHA512 Ӵս64 ֽ}
+
+ PCnSHA512_224Digest = ^TCnSHA512_224Digest;
+ {* SHA512_224 Ӵսָ}
+ TCnSHA512_224Digest = array[0..27] of Byte;
+ {* SHA512_224 Ӵս28 ֽ}
+
+ PCnSHA512_256Digest = ^TCnSHA512_256Digest;
+ {* SHA512_256 Ӵսָ}
+ TCnSHA512_256Digest = array[0..31] of Byte;
+ {* SHA512_256 Ӵս32 ֽ}
+
+ TCnSHA256Context = packed record
+ {* SHA256 Ľṹ}
+ DataLen: Cardinal;
+ Data: array[0..63] of Byte;
+ BitLen: Int64;
+ State: array[0..7] of Cardinal;
+ Ipad: array[0..63] of Byte; {!< HMAC: inner padding }
+ Opad: array[0..63] of Byte; {!< HMAC: outer padding }
+ end;
+
+ TCnSHA224Context = TCnSHA256Context;
+ {* SHA224 Ľṹ}
+
+ TCnSHA512Context = packed record
+ {* SHA512 Ľṹ}
+ DataLen: Cardinal;
+ Data: array[0..255] of Byte; // Final ʱ
+ TotalLen: Int64;
+ State: array[0..7] of Int64;
+ Ipad: array[0..127] of Byte; {!< HMAC: inner padding }
+ Opad: array[0..127] of Byte; {!< HMAC: outer padding }
+ end;
+
+ TCnSHA384Context = TCnSHA512Context;
+ {* SHA512 Ľṹ}
+
+ TCnSHA512_224Context = TCnSHA512Context;
+ {* SHA512_224 Ľṹ}
+
+ TCnSHA512_256Context = TCnSHA512Context;
+ {* SHA512_256 Ľṹ}
+
+ TCnSHACalcProgressFunc = procedure(ATotal, AProgress: Int64; var Cancel:
+ Boolean) of object;
+ {* SHA2 ϵӴսȻص¼}
+
+function SHA224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA224Digest;
+{* ݿ SHA224 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA256Digest;
+{* ݿ SHA256 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA384Digest;
+{* ݿ SHA384 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512Digest;
+{* ݿ SHA512 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512_224Digest;
+{* ݿ SHA512_224 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512_256Digest;
+{* ݿ SHA512_256 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA224Buffer(const Buffer; Count: Cardinal): TCnSHA224Digest;
+{* ݿ SHA224 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256Buffer(const Buffer; Count: Cardinal): TCnSHA256Digest;
+{* ݿ SHA256 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384Buffer(const Buffer; Count: Cardinal): TCnSHA384Digest;
+{* ݿ SHA384 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512Buffer(const Buffer; Count: Cardinal): TCnSHA512Digest;
+{* ݿ SHA512 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224Buffer(const Buffer; Count: Cardinal): TCnSHA512_224Digest;
+{* ݿ SHA512_224 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256Buffer(const Buffer; Count: Cardinal): TCnSHA512_256Digest;
+{* ݿ SHA512_256 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA224Bytes(const Data: TBytes): TCnSHA224Digest;
+{* ֽ SHA224 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256Bytes(const Data: TBytes): TCnSHA256Digest;
+{* ֽ SHA256 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384Bytes(const Data: TBytes): TCnSHA384Digest;
+{* ֽ SHA384 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512Bytes(const Data: TBytes): TCnSHA512Digest;
+{* ֽ SHA512 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224Bytes(const Data: TBytes): TCnSHA512_224Digest;
+{* ֽ SHA512_224 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256Bytes(const Data: TBytes): TCnSHA512_256Digest;
+{* ֽ SHA512_256 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA224String(const Str: string): TCnSHA224Digest;
+{* String ݽ SHA224 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256String(const Str: string): TCnSHA256Digest;
+{* String ݽ SHA256 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384String(const Str: string): TCnSHA384Digest;
+{* String ݽ SHA384 㣬ע D2009ϰ汾string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512String(const Str: string): TCnSHA512Digest;
+{* String ݽ SHA512 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224String(const Str: string): TCnSHA512_224Digest;
+{* String ݽ SHA512_224 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256String(const Str: string): TCnSHA512_256Digest;
+{* String ݽ SHA512_256 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA224StringA(const Str: AnsiString): TCnSHA224Digest;
+{* AnsiString ݽ SHA224 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA224StringW(const Str: WideString): TCnSHA224Digest;
+{* WideString ݽ SHA224 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256StringA(const Str: AnsiString): TCnSHA256Digest;
+{* AnsiString ݽ SHA256 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA256StringW(const Str: WideString): TCnSHA256Digest;
+{* WideString ݽ SHA256 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384StringA(const Str: AnsiString): TCnSHA384Digest;
+{* AnsiString ݽ SHA384 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA384StringW(const Str: WideString): TCnSHA384Digest;
+{* WideString ݽ SHA384 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512StringA(const Str: AnsiString): TCnSHA512Digest;
+{* AnsiString ݽ SHA512 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512StringW(const Str: WideString): TCnSHA512Digest;
+{* WideString ݽ SHA512 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224StringA(const Str: AnsiString): TCnSHA512_224Digest;
+{* AnsiString ݽ SHA512_224 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_224StringW(const Str: WideString): TCnSHA512_224Digest;
+{* WideString ݽ SHA512_224 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256StringA(const Str: AnsiString): TCnSHA512_256Digest;
+{* AnsiString ݽ SHA512_256 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA512_256StringW(const Str: WideString): TCnSHA512_256Digest;
+{* WideString ݽ SHA512_256 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+{$IFDEF UNICODE}
+
+function SHA224UnicodeString(const Str: string): TCnSHA224Digest;
+{* UnicodeString ݽֱӵ SHA224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256UnicodeString(const Str: string): TCnSHA256Digest;
+{* UnicodeString ݽֱӵ SHA256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384UnicodeString(const Str: string): TCnSHA384Digest;
+{* UnicodeString ݽֱӵ SHA384 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512UnicodeString(const Str: string): TCnSHA512Digest;
+{* UnicodeString ݽֱӵ SHA512 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224UnicodeString(const Str: string): TCnSHA512_224Digest;
+{* UnicodeString ݽֱӵ SHA512_224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256UnicodeString(const Str: string): TCnSHA512_256Digest;
+{* UnicodeString ݽֱӵ SHA512_256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+{$ELSE}
+
+function SHA224UnicodeString(const Str: WideString): TCnSHA224Digest;
+{* UnicodeString ݽֱӵ SHA224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256UnicodeString(const Str: WideString): TCnSHA256Digest;
+{* UnicodeString ݽֱӵ SHA256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384UnicodeString(const Str: WideString): TCnSHA384Digest;
+{* UnicodeString ݽֱӵ SHA384 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512UnicodeString(const Str: WideString): TCnSHA512Digest;
+{* UnicodeString ݽֱӵ SHA512 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224UnicodeString(const Str: WideString): TCnSHA512_224Digest;
+{* UnicodeString ݽֱӵ SHA512_224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256UnicodeString(const Str: WideString): TCnSHA512_256Digest;
+{* UnicodeString ݽֱӵ SHA512_256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+{$ENDIF}
+
+function SHA224File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA224Digest;
+{* ָļݽ SHA224 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA224Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA224Digest;
+{* ָݽ SHA224 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA256Digest;
+{* ָļݽ SHA256 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA256Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA256Digest;
+{* ָݽ SHA256 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA384Digest;
+{* ָļݽ SHA384 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA384Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA384Digest;
+{* ָݽ SHA384 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA384Digest - ص SHA384Ӵֵ
+}
+
+function SHA512File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA512Digest;
+{* ָļݽ SHA512 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA512Digest;
+{* ָݽ SHA512 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA512_224Digest;
+{* ָļݽ SHA512_224 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_224Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA512_224Digest;
+{* ָݽ SHA512_224 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256File(const FileName: string; CallBack: TCnSHACalcProgressFunc =
+ nil): TCnSHA512_256Digest;
+{* ָļݽ SHA512_256 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+function SHA512_256Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc = nil):
+ TCnSHA512_256Digest;
+{* ָݽ SHA512_256 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHACalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+// ⲿݽɢ SHA224 㣬SHA224Update ɶα
+
+procedure SHA224Init(var Context: TCnSHA224Context);
+{* ʼһ SHA224 ģ SHA224
+
+
+ var Context: TCnSHA224Context - ʼ SHA224
+
+ ֵޣ
+}
+
+procedure SHA224Update(var Context: TCnSHA224Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA224 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA224Context - SHA224
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA224Final(var Context: TCnSHA224Context; var Digest: TCnSHA224Digest);
+{* ּ㣬 SHA224 Digest С
+
+
+ var Context: TCnSHA224Context - SHA224
+ var Digest: TCnSHA224Digest - ص SHA224 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA256 㣬SHA256Update ɶα
+
+procedure SHA256Init(var Context: TCnSHA256Context);
+{* ʼһ SHA256 ģ SHA256
+
+
+ var Context: TCnSHA256Context - ʼ SHA256
+
+ ֵޣ
+}
+
+procedure SHA256Update(var Context: TCnSHA256Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA256 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA256Context - SHA256
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA256Final(var Context: TCnSHA256Context; var Digest: TCnSHA256Digest);
+{* ּ㣬 SHA256 Digest С
+
+
+ var Context: TCnSHA256Context - SHA256
+ var Digest: TCnSHA256Digest - ص SHA256 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA384 㣬SHA384Update ɶα
+
+procedure SHA384Init(var Context: TCnSHA384Context);
+{* ʼһ SHA384 ģ SHA384
+
+
+ var Context: TCnSHA384Context - ʼ SHA384
+
+ ֵޣ
+}
+
+procedure SHA384Update(var Context: TCnSHA384Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA384 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA384Context - SHA384
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA384Final(var Context: TCnSHA384Context; var Digest: TCnSHA384Digest);
+{* ּ㣬 SHA384 Digest С
+
+
+ var Context: TCnSHA384Context - SHA384
+ var Digest: TCnSHA384Digest - ص SHA384 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA512 㣬SHA512Update ɶα
+
+procedure SHA512Init(var Context: TCnSHA512Context);
+{* ʼһ SHA512 ģ SHA512
+
+
+ var Context: TCnSHA512Context - ʼ SHA512
+
+ ֵޣ
+}
+
+procedure SHA512Update(var Context: TCnSHA512Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA512 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA512Context - SHA512
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA512Final(var Context: TCnSHA512Context; var Digest: TCnSHA512Digest);
+{* ּ㣬 SHA512 Digest С
+
+
+ var Context: TCnSHA512Context - SHA512
+ var Digest: TCnSHA512Digest - ص SHA512 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA512_224 㣬SHA512_224Update ɶα
+
+procedure SHA512_224Init(var Context: TCnSHA512_224Context);
+{* ʼһ SHA512_224 ģ SHA512_224
+
+
+ var Context: TCnSHA512_224Context - ʼ SHA512_224
+
+ ֵޣ
+}
+
+procedure SHA512_224Update(var Context: TCnSHA512_224Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA512_224 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA512_224Context - SHA512_224
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA512_224Final(var Context: TCnSHA512_224Context; var Digest: TCnSHA512_224Digest);
+{* ּ㣬 SHA512_224 Digest С
+
+
+ var Context: TCnSHA512_224Context - SHA512_224
+ var Digest: TCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA512_256 㣬SHA512_256Update ɶα
+
+procedure SHA512_256Init(var Context: TCnSHA512_256Context);
+{* ʼһ SHA512_256 ģ SHA512_256
+
+
+ var Context: TCnSHA512_256Context - ʼ SHA512_256
+
+ ֵޣ
+}
+
+procedure SHA512_256Update(var Context: TCnSHA512_256Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA512_256 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA512_256Context - SHA512_256
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA512_256Final(var Context: TCnSHA512_256Context; var Digest: TCnSHA512_256Digest);
+{* ּ㣬 SHA512_256 Digest С
+
+
+ var Context: TCnSHA512_256Context - SHA512_256
+ var Digest: TCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+
+ ֵޣ
+}
+
+function SHA224Print(const Digest: TCnSHA224Digest): string;
+{* ʮƸʽ SHA224 Ӵֵ
+
+
+ const Digest: TCnSHA224Digest - ָ SHA224 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA256Print(const Digest: TCnSHA256Digest): string;
+{* ʮƸʽ SHA256 Ӵֵ
+
+
+ const Digest: TCnSHA256Digest - ָ SHA256 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA384Print(const Digest: TCnSHA384Digest): string;
+{* ʮƸʽ SHA384 Ӵֵ
+
+
+ const Digest: TCnSHA384Digest - ָ SHA384 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA512Print(const Digest: TCnSHA512Digest): string;
+{* ʮƸʽ SHA512 Ӵֵ
+
+
+ const Digest: TCnSHA512Digest - ָ SHA512 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA512_224Print(const Digest: TCnSHA512_224Digest): string;
+{* ʮƸʽ SHA512_224 Ӵֵ
+
+
+ const Digest: TCnSHA512_224Digest - ָ SHA512_224 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA512_256Print(const Digest: TCnSHA512_256Digest): string;
+{* ʮƸʽ SHA512_256 Ӵֵ
+
+
+ const Digest: TCnSHA512_256Digest - ָ SHA512_256 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA224Match(const D1: TCnSHA224Digest; const D2: TCnSHA224Digest): Boolean;
+{* Ƚ SHA224 ӴֵǷȡ
+
+
+ const D1: TCnSHA224Digest - Ƚϵ SHA224 Ӵֵһ
+ const D2: TCnSHA224Digest - Ƚϵ SHA224 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA256Match(const D1: TCnSHA256Digest; const D2: TCnSHA256Digest): Boolean;
+{* Ƚ SHA256 ӴֵǷȡ
+
+
+ const D1: TCnSHA256Digest - Ƚϵ SHA256 Ӵֵһ
+ const D2: TCnSHA256Digest - Ƚϵ SHA256 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA384Match(const D1: TCnSHA384Digest; const D2: TCnSHA384Digest): Boolean;
+{* Ƚ SHA384 ӴֵǷȡ
+
+
+ const D1: TCnSHA384Digest - Ƚϵ SHA384 Ӵֵһ
+ const D2: TCnSHA384Digest - Ƚϵ SHA384 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA512Match(const D1: TCnSHA512Digest; const D2: TCnSHA512Digest): Boolean;
+{* Ƚ SHA512 ӴֵǷȡ
+
+
+ const D1: TCnSHA512Digest - Ƚϵ SHA512 Ӵֵһ
+ const D2: TCnSHA512Digest - Ƚϵ SHA512 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA512_224Match(const D1: TCnSHA512_224Digest; const D2: TCnSHA512_224Digest): Boolean;
+{* Ƚ SHA512_224 ӴֵǷȡ
+
+
+ const D1: TCnSHA512_224Digest - Ƚϵ SHA512_224 Ӵֵһ
+ const D2: TCnSHA512_224Digest - Ƚϵ SHA512_224 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA512_256Match(const D1: TCnSHA512_256Digest; const D2: TCnSHA512_256Digest): Boolean;
+{* Ƚ SHA512_256 ӴֵǷȡ
+
+
+ const D1: TCnSHA512_256Digest - Ƚϵ SHA512_256 Ӵֵһ
+ const D2: TCnSHA512_256Digest - Ƚϵ SHA512_256 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA224DigestToStr(const Digest: TCnSHA224Digest): string;
+{* SHA224 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA224Digest - ת SHA224 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA256DigestToStr(const Digest: TCnSHA256Digest): string;
+{* SHA256 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA256Digest - ת SHA256 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA384DigestToStr(const Digest: TCnSHA384Digest): string;
+{* SHA384 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA384Digest - ת SHA384 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA512DigestToStr(const Digest: TCnSHA512Digest): string;
+{* SHA512 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA512Digest - ת SHA512 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA512_224DigestToStr(const Digest: TCnSHA512_224Digest): string;
+{* SHA512_224 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA512_224Digest - ת SHA512_224 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA512_256DigestToStr(const Digest: TCnSHA512_256Digest): string;
+{* SHA512_256 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA512_256Digest - ת SHA512_256 Ӵֵ
+
+ ֵstring - صַ
+}
+
+procedure SHA224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA224Digest);
+{* SHA224 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA224 Կݿַ
+ KeyByteLength: Integer - SHA224 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA224Digest - ص SHA224 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA256Digest);
+{* SHA256 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA256 Կݿַ
+ KeyByteLength: Integer - SHA256 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA256Digest - ص SHA256 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA384Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA384Digest);
+{* SHA384 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA384 Կݿַ
+ KeyByteLength: Integer - SHA384 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA384Digest - ص SHA384 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA512Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512Digest);
+{* SHA512 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA512 Կݿַ
+ KeyByteLength: Integer - SHA512 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA512Digest - ص SHA512 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA512_224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512_224Digest);
+{* SHA512_224 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA512_224 Կݿַ
+ KeyByteLength: Integer - SHA512_224 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA512_256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512_256Digest);
+{* SHA512_256 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA512_256 Կݿַ
+ KeyByteLength: Integer - SHA512_256 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+
+ ֵޣ
+}
+
+function SHA224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA224Digest;
+{* ֽл SHA224 HMAC 㡣
+
+
+ const Key: TBytes - SHA224 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA224Digest - ص SHA224 Ӵֵ
+}
+
+function SHA256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA256Digest;
+{* ֽл SHA256 HMAC 㡣
+
+
+ const Key: TBytes - SHA256 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA256Digest - ص SHA256 Ӵֵ
+}
+
+function SHA384HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA384Digest;
+{* ֽл SHA384 HMAC 㡣
+
+
+ const Key: TBytes - SHA384 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA384Digest - ص SHA384 Ӵֵ
+}
+
+function SHA512HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512Digest;
+{* ֽл SHA512 HMAC 㡣
+
+
+ const Key: TBytes - SHA512 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512Digest - ص SHA512 Ӵֵ
+}
+
+function SHA512_224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512_224Digest;
+{* ֽл SHA512_224 HMAC 㡣
+
+
+ const Key: TBytes - SHA512_224 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512_224Digest - ص SHA512_224 Ӵֵ
+}
+
+function SHA512_256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512_256Digest;
+{* ֽл SHA512_256 HMAC 㡣
+
+
+ const Key: TBytes - SHA512_256 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA512_256Digest - ص SHA512_256 Ӵֵ
+}
+
+implementation
+
+const
+ HMAC_SHA2_224_256_BLOCK_SIZE_BYTE = 64;
+ HMAC_SHA2_384_512_BLOCK_SIZE_BYTE = 128;
+
+ HMAC_SHA2_224_OUTPUT_LENGTH_BYTE = 28;
+ HMAC_SHA2_256_OUTPUT_LENGTH_BYTE = 32;
+ HMAC_SHA2_384_OUTPUT_LENGTH_BYTE = 48;
+ HMAC_SHA2_512_OUTPUT_LENGTH_BYTE = 64;
+
+ HMAC_SHA2_512_224_OUTPUT_LENGTH_BYTE = 28;
+ HMAC_SHA2_512_256_OUTPUT_LENGTH_BYTE = 32;
+
+type
+ TSHA2Type = (stSHA2_224, stSHA2_256, stSHA2_384, stSHA2_512, stSHA2_512_224, stSHA2_512_256);
+
+const
+ MAX_FILE_SIZE = 512 * 1024 * 1024;
+ // If file size <= this size (bytes), using Mapping, else stream
+
+ KEYS256: array[0..63] of Cardinal = ($428A2F98, $71374491, $B5C0FBCF, $E9B5DBA5,
+ $3956C25B, $59F111F1, $923F82A4, $AB1C5ED5, $D807AA98, $12835B01, $243185BE,
+ $550C7DC3, $72BE5D74, $80DEB1FE, $9BDC06A7, $C19BF174, $E49B69C1, $EFBE4786,
+ $0FC19DC6, $240CA1CC, $2DE92C6F, $4A7484AA, $5CB0A9DC, $76F988DA, $983E5152,
+ $A831C66D, $B00327C8, $BF597FC7, $C6E00BF3, $D5A79147, $06CA6351, $14292967,
+ $27B70A85, $2E1B2138, $4D2C6DFC, $53380D13, $650A7354, $766A0ABB, $81C2C92E,
+ $92722C85, $A2BFE8A1, $A81A664B, $C24B8B70, $C76C51A3, $D192E819, $D6990624,
+ $F40E3585, $106AA070, $19A4C116, $1E376C08, $2748774C, $34B0BCB5, $391C0CB3,
+ $4ED8AA4A, $5B9CCA4F, $682E6FF3, $748F82EE, $78A5636F, $84C87814, $8CC70208,
+ $90BEFFFA, $A4506CEB, $BEF9A3F7, $C67178F2);
+
+ KEYS512: array[0..79] of TUInt64 = ($428A2F98D728AE22, $7137449123EF65CD,
+ $B5C0FBCFEC4D3B2F, $E9B5DBA58189DBBC, $3956C25BF348B538, $59F111F1B605D019,
+ $923F82A4AF194F9B, $AB1C5ED5DA6D8118, $D807AA98A3030242, $12835B0145706FBE,
+ $243185BE4EE4B28C, $550C7DC3D5FFB4E2, $72BE5D74F27B896F, $80DEB1FE3B1696B1,
+ $9BDC06A725C71235, $C19BF174CF692694, $E49B69C19EF14AD2, $EFBE4786384F25E3,
+ $0FC19DC68B8CD5B5, $240CA1CC77AC9C65, $2DE92C6F592B0275, $4A7484AA6EA6E483,
+ $5CB0A9DCBD41FBD4, $76F988DA831153B5, $983E5152EE66DFAB, $A831C66D2DB43210,
+ $B00327C898FB213F, $BF597FC7BEEF0EE4, $C6E00BF33DA88FC2, $D5A79147930AA725,
+ $06CA6351E003826F, $142929670A0E6E70, $27B70A8546D22FFC, $2E1B21385C26C926,
+ $4D2C6DFC5AC42AED, $53380D139D95B3DF, $650A73548BAF63DE, $766A0ABB3C77B2A8,
+ $81C2C92E47EDAEE6, $92722C851482353B, $A2BFE8A14CF10364, $A81A664BBC423001,
+ $C24B8B70D0F89791, $C76C51A30654BE30, $D192E819D6EF5218, $D69906245565A910,
+ $F40E35855771202A, $106AA07032BBD1B8, $19A4C116B8D2D0C8, $1E376C085141AB53,
+ $2748774CDF8EEB99, $34B0BCB5E19B48A8, $391C0CB3C5C95A63, $4ED8AA4AE3418ACB,
+ $5B9CCA4F7763E373, $682E6FF3D6B2B8A3, $748F82EE5DEFB2FC, $78A5636F43172F60,
+ $84C87814A1F0AB72, $8CC702081A6439EC, $90BEFFFA23631E28, $A4506CEBDE82BDE9,
+ $BEF9A3F7B2C67915, $C67178F2E372532B, $CA273ECEEA26619C, $D186B8C721C0C207,
+ $EADA7DD6CDE0EB1E, $F57D4F7FEE6ED178, $06F067AA72176FBA, $0A637DC5A2C898A6,
+ $113F9804BEF90DAE, $1B710B35131C471B, $28DB77F523047D84, $32CAAB7B40C72493,
+ $3C9EBE0A15C9BEBC, $431D67C49C100D4C, $4CC5D4BECB3E42B6, $597F299CFC657E2A,
+ $5FCB6FAB3AD6FAEC, $6C44198C4A475817);
+
+function ROTRight256(A, B: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (A shr B) or (A shl (32 - B));
+end;
+
+function ROTRight512(X: TUInt64; Y: Integer): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X shr Y) or (X shl (64 - Y));
+end;
+
+function SHR512(X: TUInt64; Y: Integer): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and $FFFFFFFFFFFFFFFF) shr Y;
+end;
+
+function CH256(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) xor ((not X) and Z);
+end;
+
+function CH512(X, Y, Z: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (((Y xor Z) and X) xor Z);
+end;
+
+function MAJ256(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) xor (X and Z) xor (Y and Z);
+end;
+
+function MAJ512(X, Y, Z: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ((X or Y) and Z) or (X and Y);
+end;
+
+function EP0256(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight256(X, 2) xor ROTRight256(X, 13) xor ROTRight256(X, 22);
+end;
+
+function EP1256(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight256(X, 6) xor ROTRight256(X, 11) xor ROTRight256(X, 25);
+end;
+
+function SIG0256(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight256(X, 7) xor ROTRight256(X, 18) xor (X shr 3);
+end;
+
+function SIG1256(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight256(X, 17) xor ROTRight256(X, 19) xor (X shr 10);
+end;
+
+function SIG0512(X: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight512(X, 28) xor ROTRight512(X, 34) xor ROTRight512(X, 39);
+end;
+
+function SIG1512(X: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight512(X, 14) xor ROTRight512(X, 18) xor ROTRight512(X, 41);
+end;
+
+function Gamma0512(X: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight512(X, 1) xor ROTRight512(X, 8) xor SHR512(X, 7);
+end;
+
+function Gamma1512(X: TUInt64): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := ROTRight512(X, 19) xor ROTRight512(X, 61) xor SHR512(X, 6);
+end;
+
+procedure SHA256Transform(var Context: TCnSHA256Context; Data: PAnsiChar);
+var
+ A, B, C, D, E, F, G, H, T1, T2: Cardinal;
+ M: array[0..63] of Cardinal;
+ I, J: Integer;
+begin
+ I := 0;
+ J := 0;
+ while I < 16 do
+ begin
+ M[I] := (Cardinal(Data[J]) shl 24) or (Cardinal(Data[J + 1]) shl 16) or (Cardinal(Data
+ [J + 2]) shl 8) or Cardinal(Data[J + 3]);
+ Inc(I);
+ Inc(J, 4);
+ end;
+
+ while I < 64 do
+ begin
+ M[I] := SIG1256(M[I - 2]) + M[I - 7] + SIG0256(M[I - 15]) + M[I - 16];
+ Inc(I);
+ end;
+
+ A := Context.State[0];
+ B := Context.State[1];
+ C := Context.State[2];
+ D := Context.State[3];
+ E := Context.State[4];
+ F := Context.State[5];
+ G := Context.State[6];
+ H := Context.State[7];
+
+ I := 0;
+ while I < 64 do
+ begin
+ T1 := H + EP1256(E) + CH256(E, F, G) + KEYS256[I] + M[I];
+ T2 := EP0256(A) + MAJ256(A, B, C);
+ H := G;
+ G := F;
+ F := E;
+ E := D + T1;
+ D := C;
+ C := B;
+ B := A;
+ A := T1 + T2;
+ Inc(I);
+ end;
+
+ Context.State[0] := Context.State[0] + A;
+ Context.State[1] := Context.State[1] + B;
+ Context.State[2] := Context.State[2] + C;
+ Context.State[3] := Context.State[3] + D;
+ Context.State[4] := Context.State[4] + E;
+ Context.State[5] := Context.State[5] + F;
+ Context.State[6] := Context.State[6] + G;
+ Context.State[7] := Context.State[7] + H;
+end;
+
+{$WARNINGS OFF}
+
+procedure SHA512Transform(var Context: TCnSHA512Context; Data: PAnsiChar; BlockCount: Integer);
+var
+ A, B, C, D, E, F, G, H, T1, T2: TUInt64;
+ M: array[0..79] of TUInt64;
+ I, J, K: Integer;
+ OrigData: PAnsiChar;
+begin
+ OrigData := Data;
+ for K := 0 to BlockCount - 1 do
+ begin
+ Data := PAnsiChar(TCnNativeInt(OrigData) + (K shl 7));
+
+ I := 0;
+ J := 0;
+ while I < 16 do
+ begin
+ // ע Delphi 5 6 7 ´˴ Int64 ƣ Range Check شʱ
+ // ΪȻһÿرصܵõȷ
+ M[I] := (TUInt64(Data[J]) shl 56) or (TUInt64(Data[J + 1]) shl 48) or
+ (TUInt64(Data[J + 2]) shl 40) or (TUInt64(Data[J + 3]) shl 32) or
+ (TUInt64(Data[J + 4]) shl 24) or (TUInt64(Data[J + 5]) shl 16) or
+ (TUInt64(Data[J + 6]) shl 8) or TUInt64(Data[J + 7]);
+ Inc(I);
+ Inc(J, 8);
+ end;
+
+ while I < 80 do
+ begin
+ M[I] := Gamma1512(M[I - 2]) + M[I - 7] + Gamma0512(M[I - 15]) + M[I - 16];
+ Inc(I);
+ end;
+
+ A := Context.State[0];
+ B := Context.State[1];
+ C := Context.State[2];
+ D := Context.State[3];
+ E := Context.State[4];
+ F := Context.State[5];
+ G := Context.State[6];
+ H := Context.State[7];
+
+ I := 0;
+ while I < 80 do
+ begin
+ T1 := H + SIG1512(E) + CH512(E, F, G) + KEYS512[I] + M[I];
+ T2 := SIG0512(A) + MAJ512(A, B, C);
+ H := G;
+ G := F;
+ F := E;
+ E := D + T1;
+ D := C;
+ C := B;
+ B := A;
+ A := T1 + T2;
+ Inc(I);
+ end;
+
+ // з WarningӰ
+ Context.State[0] := Context.State[0] + A;
+ Context.State[1] := Context.State[1] + B;
+ Context.State[2] := Context.State[2] + C;
+ Context.State[3] := Context.State[3] + D;
+ Context.State[4] := Context.State[4] + E;
+ Context.State[5] := Context.State[5] + F;
+ Context.State[6] := Context.State[6] + G;
+ Context.State[7] := Context.State[7] + H;
+ end;
+end;
+
+{$WARNINGS ON}
+
+procedure SHA224Init(var Context: TCnSHA224Context);
+begin
+ Context.DataLen := 0;
+ Context.BitLen := 0;
+ Context.State[0] := $C1059ED8;
+ Context.State[1] := $367CD507;
+ Context.State[2] := $3070DD17;
+ Context.State[3] := $F70E5939;
+ Context.State[4] := $FFC00B31;
+ Context.State[5] := $68581511;
+ Context.State[6] := $64F98FA7;
+ Context.State[7] := $BEFA4FA4;
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+procedure SHA224Update(var Context: TCnSHA224Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA256Update(Context, Input, ByteLength);
+end;
+
+procedure SHA256UpdateW(var Context: TCnSHA256Context; Input: PWideChar; CharLength: Cardinal); forward;
+
+procedure SHA224UpdateW(var Context: TCnSHA224Context; Input: PWideChar; CharLength: Cardinal);
+begin
+ SHA256UpdateW(Context, Input, CharLength);
+end;
+
+procedure SHA224Final(var Context: TCnSHA224Context; var Digest: TCnSHA224Digest);
+var
+ Dig: TCnSHA256Digest;
+begin
+ SHA256Final(Context, Dig);
+ Move(Dig[0], Digest[0], SizeOf(TCnSHA224Digest));
+end;
+
+procedure SHA256Init(var Context: TCnSHA256Context);
+begin
+ Context.DataLen := 0;
+ Context.BitLen := 0;
+ Context.State[0] := $6A09E667;
+ Context.State[1] := $BB67AE85;
+ Context.State[2] := $3C6EF372;
+ Context.State[3] := $A54FF53A;
+ Context.State[4] := $510E527F;
+ Context.State[5] := $9B05688C;
+ Context.State[6] := $1F83D9AB;
+ Context.State[7] := $5BE0CD19;
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+procedure SHA256Update(var Context: TCnSHA256Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ B: Cardinal;
+begin
+ while ByteLength > 0 do
+ begin
+ if 64 - Context.DataLen > ByteLength then
+ B := ByteLength
+ else
+ B := 64 - Context.DataLen;
+
+ Move(Input^, Context.Data[Context.DataLen], B);
+ Inc(Context.DataLen, B);
+ Dec(ByteLength, B);
+ Inc(Input, B);
+
+ if Context.DataLen = 64 then
+ begin
+ SHA256Transform(Context, @Context.Data[0]);
+ Context.BitLen := Context.BitLen + 512;
+ Context.DataLen := 0;
+ end;
+ end;
+end;
+
+procedure SHA256UpdateW(var Context: TCnSHA256Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ Content: PAnsiChar;
+ iLen: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(Content, CharLength * SizeOf(WideChar));
+ try
+ iLen := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(Content), CharLength * SizeOf(WideChar), nil, nil);
+ SHA256Update(Context, Content, iLen);
+ finally
+ FreeMem(Content);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ SHA256Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+procedure SHA256Final(var Context: TCnSHA256Context; var Digest: TCnSHA256Digest);
+var
+ I: Integer;
+begin
+ I := Context.DataLen;
+ Context.Data[I] := $80;
+ Inc(I);
+
+ if Context.Datalen < 56 then
+ begin
+ while I < 56 do
+ begin
+ Context.Data[I] := 0;
+ Inc(I);
+ end;
+ end
+ else
+ begin
+ while I < 64 do
+ begin
+ Context.Data[I] := 0;
+ Inc(I);
+ end;
+
+ SHA256Transform(Context, @(Context.Data[0]));
+ FillChar(Context.Data, 56, 0);
+ end;
+
+ Context.BitLen := Context.BitLen + Context.DataLen * 8;
+ Context.Data[63] := Byte(Context.Bitlen);
+ Context.Data[62] := Byte(Context.Bitlen shr 8);
+ Context.Data[61] := Byte(Context.Bitlen shr 16);
+ Context.Data[60] := Byte(Context.Bitlen shr 24);
+ Context.Data[59] := Byte(Context.Bitlen shr 32);
+ Context.Data[58] := Byte(Context.Bitlen shr 40);
+ Context.Data[57] := Byte(Context.Bitlen shr 48);
+ Context.Data[56] := Byte(Context.Bitlen shr 56);
+ SHA256Transform(Context, @(Context.Data[0]));
+
+ for I := 0 to 3 do
+ begin
+ Digest[I] := (Context.State[0] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 4] := (Context.State[1] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 8] := (Context.State[2] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 12] := (Context.State[3] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 16] := (Context.State[4] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 20] := (Context.State[5] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 24] := (Context.State[6] shr (24 - I * 8)) and $000000FF;
+ Digest[I + 28] := (Context.State[7] shr (24 - I * 8)) and $000000FF;
+ end;
+end;
+
+{$WARNINGS OFF}
+
+procedure SHA384Init(var Context: TCnSHA384Context);
+begin
+ Context.DataLen := 0;
+ Context.TotalLen := 0;
+ Context.State[0] := $CBBB9D5DC1059ED8;
+ Context.State[1] := $629A292A367CD507;
+ Context.State[2] := $9159015A3070DD17;
+ Context.State[3] := $152FECD8F70E5939;
+ Context.State[4] := $67332667FFC00B31;
+ Context.State[5] := $8EB44A8768581511;
+ Context.State[6] := $DB0C2E0D64F98FA7;
+ Context.State[7] := $47B5481DBEFA4FA4;
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+{$WARNINGS ON}
+
+procedure SHA384Update(var Context: TCnSHA384Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA512Update(Context, Input, ByteLength);
+end;
+
+procedure SHA512UpdateW(var Context: TCnSHA512Context; Input: PWideChar; CharLength: Cardinal); forward;
+
+procedure SHA384UpdateW(var Context: TCnSHA384Context; Input: PWideChar; CharLength: Cardinal);
+begin
+ SHA512UpdateW(Context, Input, CharLength);
+end;
+
+procedure SHA384Final(var Context: TCnSHA384Context; var Digest: TCnSHA384Digest);
+var
+ Dig: TCnSHA512Digest;
+begin
+ SHA512Final(Context, Dig);
+ Move(Dig[0], Digest[0], SizeOf(TCnSHA384Digest));
+end;
+
+{$WARNINGS OFF}
+
+procedure SHA512Init(var Context: TCnSHA512Context);
+begin
+ Context.DataLen := 0;
+ Context.TotalLen := 0;
+ Context.State[0] := $6A09E667F3BCC908;
+ Context.State[1] := $BB67AE8584CAA73B;
+ Context.State[2] := $3C6EF372FE94F82B;
+ Context.State[3] := $A54FF53A5F1D36F1;
+ Context.State[4] := $510E527FADE682D1;
+ Context.State[5] := $9B05688C2B3E6C1F;
+ Context.State[6] := $1F83D9ABFB41BD6B;
+ Context.State[7] := $5BE0CD19137E2179;
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+{$WARNINGS ON}
+
+procedure SHA512Update(var Context: TCnSHA512Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ TempLength, RemainLength, NewLength, BlockCount: Cardinal;
+begin
+ TempLength := 128 - Context.DataLen;
+ if ByteLength < TempLength then
+ RemainLength := ByteLength
+ else
+ RemainLength := TempLength;
+
+ Move(Input^, Context.Data[Context.DataLen], RemainLength);
+ if Context.DataLen + ByteLength < 128 then
+ begin
+ Inc(Context.DataLen, ByteLength);
+ Exit;
+ end;
+
+ NewLength := Cardinal(ByteLength) - RemainLength;
+ BlockCount := NewLength div 128;
+ Input := PAnsiChar(TCnNativeUInt(Input) + RemainLength);
+
+ SHA512Transform(Context, @Context.Data[0], 1);
+ SHA512Transform(Context, Input, BlockCount);
+
+ RemainLength := NewLength mod 128;
+ Input := PAnsiChar(TCnNativeUInt(Input) + (BlockCount shl 7));
+ Move(Input^, Context.Data[Context.DataLen], RemainLength);
+
+ Context.DataLen := RemainLength;
+ Inc(Context.TotalLen, (BlockCount + 1) shl 7);
+end;
+
+procedure SHA512UpdateW(var Context: TCnSHA512Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ Content: PAnsiChar;
+ iLen: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(Content, CharLength * SizeOf(WideChar));
+ try
+ iLen := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(Content), CharLength * SizeOf(WideChar), nil, nil);
+ SHA512Update(Context, Content, iLen);
+ finally
+ FreeMem(Content);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ SHA512Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+procedure SHA512Final(var Context: TCnSHA512Context; var Digest: TCnSHA512Digest);
+var
+ I: Integer;
+ BlockCount, PmLength: Cardinal;
+ BitLength: TUInt64;
+begin
+ if (Context.DataLen mod 128) > 111 then
+ BlockCount := 2
+ else
+ BlockCount := 1;
+
+ BitLength := (Context.TotalLen + Context.DataLen) shl 3;
+ PmLength := BlockCount shl 7;
+ FillChar(Context.Data[Context.DataLen], PmLength - Context.DataLen, 0);
+ Context.Data[Context.DataLen] := $80;
+
+ Context.Data[PmLength - 1] := Byte(BitLength);
+ Context.Data[PmLength - 2] := Byte(BitLength shr 8);
+ Context.Data[PmLength - 3] := Byte(BitLength shr 16);
+ Context.Data[PmLength - 4] := Byte(BitLength shr 24);
+ Context.Data[PmLength - 5] := Byte(BitLength shr 32);
+ Context.Data[PmLength - 6] := Byte(BitLength shr 40);
+ Context.Data[PmLength - 7] := Byte(BitLength shr 48);
+ Context.Data[PmLength - 8] := Byte(BitLength shr 56);
+
+ // ٴΰ淶е 128 λȸֵΪ FillChar 0
+ SHA512Transform(Context, @(Context.Data[0]), BlockCount);
+
+ for I := 0 to 7 do
+ begin
+ Digest[I] := (Context.State[0] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 8] := (Context.State[1] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 16] := (Context.State[2] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 24] := (Context.State[3] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 32] := (Context.State[4] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 40] := (Context.State[5] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 48] := (Context.State[6] shr (56 - I * 8)) and $000000FF;
+ Digest[I + 56] := (Context.State[7] shr (56 - I * 8)) and $000000FF;
+ end;
+end;
+
+procedure SHA512_224Init(var Context: TCnSHA512_224Context);
+begin
+ Context.DataLen := 0;
+ Context.TotalLen := 0;
+ Context.State[0] := Int64($8C3D37C819544DA2);
+ Context.State[1] := Int64($73E1996689DCD4D6);
+ Context.State[2] := Int64($1DFAB7AE32FF9C82);
+ Context.State[3] := Int64($679DD514582F9FCF);
+ Context.State[4] := Int64($0F6D2B697BD44DA8);
+ Context.State[5] := Int64($77E36F7304C48942);
+ Context.State[6] := Int64($3F9D85A86A1D36C8);
+ Context.State[7] := Int64($1112E6AD91D692A1);
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+procedure SHA512_224Update(var Context: TCnSHA512_224Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA512Update(Context, Input, ByteLength);
+end;
+
+procedure SHA512_224UpdateW(var Context: TCnSHA512_224Context; Input: PWideChar; CharLength: Cardinal);
+begin
+ SHA512UpdateW(Context, Input, CharLength);
+end;
+
+procedure SHA512_224Final(var Context: TCnSHA512_224Context; var Digest: TCnSHA512_224Digest);
+var
+ Dig: TCnSHA512Digest;
+begin
+ SHA512Final(Context, Dig);
+ Move(Dig[0], Digest[0], SizeOf(TCnSHA512_224Digest));
+end;
+
+procedure SHA512_256Init(var Context: TCnSHA512_256Context);
+begin
+ Context.DataLen := 0;
+ Context.TotalLen := 0;
+ Context.State[0] := Int64($22312194FC2BF72C);
+ Context.State[1] := Int64($9F555FA3C84C64C2);
+ Context.State[2] := Int64($2393B86B6F53B151);
+ Context.State[3] := Int64($963877195940EABD);
+ Context.State[4] := Int64($96283EE2A88EFFE3);
+ Context.State[5] := Int64($BE5E1E2553863992);
+ Context.State[6] := Int64($2B0199FC2C85B8AA);
+ Context.State[7] := Int64($0EB72DDC81C52CA2);
+ FillChar(Context.Data, SizeOf(Context.Data), 0);
+end;
+
+procedure SHA512_256Update(var Context: TCnSHA512_256Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA512Update(Context, Input, ByteLength);
+end;
+
+procedure SHA512_256UpdateW(var Context: TCnSHA512_256Context; Input: PWideChar; CharLength: Cardinal);
+begin
+ SHA512UpdateW(Context, Input, CharLength);
+end;
+
+procedure SHA512_256Final(var Context: TCnSHA512_256Context; var Digest: TCnSHA512_256Digest);
+var
+ Dig: TCnSHA512Digest;
+begin
+ SHA512Final(Context, Dig);
+ Move(Dig[0], Digest[0], SizeOf(TCnSHA512_256Digest));
+end;
+
+// ݿ SHA224
+function SHA224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224Update(Context, Input, ByteLength);
+ SHA224Final(Context, Result);
+end;
+
+// ݿ SHA256
+function SHA256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256Update(Context, Input, ByteLength);
+ SHA256Final(Context, Result);
+end;
+
+// ݿ SHA384
+function SHA384(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384Update(Context, Input, ByteLength);
+ SHA384Final(Context, Result);
+end;
+
+// ݿ SHA512
+function SHA512(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512Update(Context, Input, ByteLength);
+ SHA512Final(Context, Result);
+end;
+
+// ݿ SHA512_224
+function SHA512_224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, Input, ByteLength);
+ SHA512_224Final(Context, Result);
+end;
+
+// ݿ SHA512_256
+function SHA512_256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, Input, ByteLength);
+ SHA512_256Final(Context, Result);
+end;
+
+// ݿ SHA224
+function SHA224Buffer(const Buffer; Count: Cardinal): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224Update(Context, PAnsiChar(@Buffer), Count);
+ SHA224Final(Context, Result);
+end;
+
+// ݿ SHA256
+function SHA256Buffer(const Buffer; Count: Cardinal): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256Update(Context, PAnsiChar(@Buffer), Count);
+ SHA256Final(Context, Result);
+end;
+
+// ݿ SHA384
+function SHA384Buffer(const Buffer; Count: Cardinal): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384Update(Context, PAnsiChar(@Buffer), Count);
+ SHA384Final(Context, Result);
+end;
+
+// ݿ SHA512
+function SHA512Buffer(const Buffer; Count: Cardinal): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512Update(Context, PAnsiChar(@Buffer), Count);
+ SHA512Final(Context, Result);
+end;
+
+// ݿ SHA512_224
+function SHA512_224Buffer(const Buffer; Count: Cardinal): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, PAnsiChar(@Buffer), Count);
+ SHA512_224Final(Context, Result);
+end;
+
+// ݿ SHA512_256
+function SHA512_256Buffer(const Buffer; Count: Cardinal): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, PAnsiChar(@Buffer), Count);
+ SHA512_256Final(Context, Result);
+end;
+
+// ֽ SHA224
+function SHA224Bytes(const Data: TBytes): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA224Final(Context, Result);
+end;
+
+// ֽ SHA256
+function SHA256Bytes(const Data: TBytes): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA256Final(Context, Result);
+end;
+
+// ֽ SHA384
+function SHA384Bytes(const Data: TBytes): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA384Final(Context, Result);
+end;
+
+// ֽ SHA512
+function SHA512Bytes(const Data: TBytes): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512Final(Context, Result);
+end;
+
+// ֽ SHA512_224
+function SHA512_224Bytes(const Data: TBytes): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512_224Final(Context, Result);
+end;
+
+// ֽ SHA512_256
+function SHA512_256Bytes(const Data: TBytes): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512_256Final(Context, Result);
+end;
+
+// String ݽ SHA224
+function SHA224String(const Str: string): TCnSHA224Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA224StringA(AStr);
+end;
+
+// String ݽ SHA256
+function SHA256String(const Str: string): TCnSHA256Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA256StringA(AStr);
+end;
+
+// String ݽ SHA384
+function SHA384String(const Str: string): TCnSHA384Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA384StringA(AStr);
+end;
+
+// String ݽ SHA512
+function SHA512String(const Str: string): TCnSHA512Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA512StringA(AStr);
+end;
+
+// String ݽ SHA512_224
+function SHA512_224String(const Str: string): TCnSHA512_224Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA512_224StringA(AStr);
+end;
+
+// String ݽ SHA512_256
+function SHA512_256String(const Str: string): TCnSHA512_256Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA512_256StringA(AStr);
+end;
+
+// UnicodeString ݽֱӵ SHA224 㣬ת
+{$IFDEF UNICODE}
+function SHA224UnicodeString(const Str: string): TCnSHA224Digest;
+{$ELSE}
+function SHA224UnicodeString(const Str: WideString): TCnSHA224Digest;
+{$ENDIF}
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA224Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHA256 㣬ת
+{$IFDEF UNICODE}
+function SHA256UnicodeString(const Str: string): TCnSHA256Digest;
+{$ELSE}
+function SHA256UnicodeString(const Str: WideString): TCnSHA256Digest;
+{$ENDIF}
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA256Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHA384 㣬ת
+{$IFDEF UNICODE}
+function SHA384UnicodeString(const Str: string): TCnSHA384Digest;
+{$ELSE}
+function SHA384UnicodeString(const Str: WideString): TCnSHA384Digest;
+{$ENDIF}
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA384Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHA512 㣬ת
+{$IFDEF UNICODE}
+function SHA512UnicodeString(const Str: string): TCnSHA512Digest;
+{$ELSE}
+function SHA512UnicodeString(const Str: WideString): TCnSHA512Digest;
+{$ENDIF}
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA512Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHA512_224 㣬ת
+{$IFDEF UNICODE}
+function SHA512_224UnicodeString(const Str: string): TCnSHA512_224Digest;
+{$ELSE}
+function SHA512_224UnicodeString(const Str: WideString): TCnSHA512_224Digest;
+{$ENDIF}
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA512_224Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHA512_256 㣬ת
+{$IFDEF UNICODE}
+function SHA512_256UnicodeString(const Str: string): TCnSHA512_256Digest;
+{$ELSE}
+function SHA512_256UnicodeString(const Str: WideString): TCnSHA512_256Digest;
+{$ENDIF}
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA512_256Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA224
+function SHA224StringA(const Str: AnsiString): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224Update(Context, PAnsiChar(Str), Length(Str));
+ SHA224Final(Context, Result);
+end;
+
+// WideString ݽ SHA224
+function SHA224StringW(const Str: WideString): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224Init(Context);
+ SHA224UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA224Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA256
+function SHA256StringA(const Str: AnsiString): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256Update(Context, PAnsiChar(Str), Length(Str));
+ SHA256Final(Context, Result);
+end;
+
+// WideString ݽ SHA256
+function SHA256StringW(const Str: WideString): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256Init(Context);
+ SHA256UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA256Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA384
+function SHA384StringA(const Str: AnsiString): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384Update(Context, PAnsiChar(Str), Length(Str));
+ SHA384Final(Context, Result);
+end;
+
+// WideString ݽ SHA384
+function SHA384StringW(const Str: WideString): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384Init(Context);
+ SHA384UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA384Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA512
+function SHA512StringA(const Str: AnsiString): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512Update(Context, PAnsiChar(Str), Length(Str));
+ SHA512Final(Context, Result);
+end;
+
+// WideString ݽ SHA512
+function SHA512StringW(const Str: WideString): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512Init(Context);
+ SHA512UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA512Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA512_224
+function SHA512_224StringA(const Str: AnsiString): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, PAnsiChar(Str), Length(Str));
+ SHA512_224Final(Context, Result);
+end;
+
+// WideString ݽ SHA512_224
+function SHA512_224StringW(const Str: WideString): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224Init(Context);
+ SHA512_224UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA512_224Final(Context, Result);
+end;
+
+// AnsiString ݽ SHA512_256
+function SHA512_256StringA(const Str: AnsiString): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, PAnsiChar(Str), Length(Str));
+ SHA512_256Final(Context, Result);
+end;
+
+// WideString ݽ SHA512_256
+function SHA512_256StringW(const Str: WideString): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256Init(Context);
+ SHA512_256UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA512_256Final(Context, Result);
+end;
+
+function InternalSHAStream(Stream: TStream; const BufSize: Cardinal; var D:
+ TCnSHA2GeneralDigest; SHA2Type: TSHA2Type; CallBack: TCnSHACalcProgressFunc): Boolean;
+var
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+
+ Context224: TCnSHA224Context;
+ Context256: TCnSHA256Context;
+ Context384: TCnSHA384Context;
+ Context512: TCnSHA512Context;
+ Context512_224: TCnSHA512_224Context;
+ Context512_256: TCnSHA512_256Context;
+ Dig224: TCnSHA224Digest;
+ Dig256: TCnSHA256Digest;
+ Dig384: TCnSHA384Digest;
+ Dig512: TCnSHA512Digest;
+ Dig512_224: TCnSHA512_224Digest;
+ Dig512_256: TCnSHA512_256Digest;
+
+ procedure _SHAInit;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Init(Context224);
+ stSHA2_256:
+ SHA256Init(Context256);
+ stSHA2_384:
+ SHA384Init(Context384);
+ stSHA2_512:
+ SHA512Init(Context512);
+ stSHA2_512_224:
+ SHA512_224Init(Context512_224);
+ stSHA2_512_256:
+ SHA512_256Init(Context512_256);
+ end;
+ end;
+
+ procedure _SHAUpdate;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Update(Context224, Buf, ReadBytes);
+ stSHA2_256:
+ SHA256Update(Context256, Buf, ReadBytes);
+ stSHA2_384:
+ SHA384Update(Context384, Buf, ReadBytes);
+ stSHA2_512:
+ SHA512Update(Context512, Buf, ReadBytes);
+ stSHA2_512_224:
+ SHA512_224Update(Context512_224, Buf, ReadBytes);
+ stSHA2_512_256:
+ SHA512_256Update(Context512_256, Buf, ReadBytes);
+ end;
+ end;
+
+ procedure _SHAFinal;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Final(Context224, Dig224);
+ stSHA2_256:
+ SHA256Final(Context256, Dig256);
+ stSHA2_384:
+ SHA384Final(Context384, Dig384);
+ stSHA2_512:
+ SHA512Final(Context512, Dig512);
+ stSHA2_512_224:
+ SHA512_224Final(Context512_224, Dig512_224);
+ stSHA2_512_256:
+ SHA512_256Final(Context512_256, Dig512_256);
+ end;
+ end;
+
+ procedure _CopyResult;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ Move(Dig224[0], D[0], SizeOf(TCnSHA224Digest));
+ stSHA2_256:
+ Move(Dig256[0], D[0], SizeOf(TCnSHA256Digest));
+ stSHA2_384:
+ Move(Dig384[0], D[0], SizeOf(TCnSHA384Digest));
+ stSHA2_512:
+ Move(Dig512[0], D[0], SizeOf(TCnSHA512Digest));
+ stSHA2_512_224:
+ Move(Dig512_224[0], D[0], SizeOf(TCnSHA512_224Digest));
+ stSHA2_512_256:
+ Move(Dig512_256[0], D[0], SizeOf(TCnSHA512_256Digest));
+ end;
+ end;
+
+begin
+ Result := False;
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ if Size = 0 then
+ Exit;
+ if Size < BufSize then
+ BufLen := Size
+ else
+ BufLen := BufSize;
+
+ CancelCalc := False;
+ _SHAInit;
+
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ _SHAUpdate;
+
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then
+ Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ _SHAFinal;
+ _CopyResult;
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+// ָ SHA224
+function SHA224Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA224Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA224Digest));
+end;
+
+// ָ SHA256
+function SHA256Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA256Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA256Digest));
+end;
+
+// ָ SHA384
+function SHA384Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA384Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_384, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA384Digest));
+end;
+
+// ָ SHA512
+function SHA512Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_512, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512Digest));
+end;
+
+// ָ SHA512_224
+function SHA512_224Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512_224Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_512_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512_224Digest));
+end;
+
+// ָ SHA512_256
+function SHA512_256Stream(Stream: TStream; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512_256Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ InternalSHAStream(Stream, 4096 * 1024, Dig, stSHA2_512_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512_256Digest));
+end;
+
+function FileSizeIsLargeThanMaxOrCanNotMap(const AFileName: string; out IsEmpty: Boolean): Boolean;
+{$IFDEF MSWINDOWS}
+var
+ H: THandle;
+ Info: BY_HANDLE_FILE_INFORMATION;
+ Rec: Int64Rec;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ Result := False;
+ IsEmpty := False;
+ H := CreateFile(PChar(AFileName), GENERIC_READ, FILE_SHARE_READ, nil,
+ OPEN_EXISTING, 0, 0);
+ if H = INVALID_HANDLE_VALUE then
+ Exit;
+ try
+ if not GetFileInformationByHandle(H, Info) then
+ Exit;
+ finally
+ CloseHandle(H);
+ end;
+ Rec.Lo := Info.nFileSizeLow;
+ Rec.Hi := Info.nFileSizeHigh;
+ Result := (Rec.Hi > 0) or (Rec.Lo > MAX_FILE_SIZE);
+ IsEmpty := (Rec.Hi = 0) and (Rec.Lo = 0);
+{$ELSE}
+ Result := True; // Windows ƽ̨ Trueʾ Mapping
+{$ENDIF}
+end;
+
+function InternalSHAFile(const FileName: string; SHA2Type: TSHA2Type;
+ CallBack: TCnSHACalcProgressFunc): TCnSHA2GeneralDigest;
+var
+ Context224: TCnSHA224Context;
+ Context256: TCnSHA256Context;
+ Context384: TCnSHA384Context;
+ Context512: TCnSHA512Context;
+ Context512_224: TCnSHA512_224Context;
+ Context512_256: TCnSHA512_256Context;
+ Dig224: TCnSHA224Digest;
+ Dig256: TCnSHA256Digest;
+ Dig384: TCnSHA384Digest;
+ Dig512: TCnSHA512Digest;
+ Dig512_224: TCnSHA512_224Digest;
+ Dig512_256: TCnSHA512_256Digest;
+
+{$IFDEF MSWINDOWS}
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+
+ procedure _SHAInit;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Init(Context224);
+ stSHA2_256:
+ SHA256Init(Context256);
+ stSHA2_384:
+ SHA384Init(Context384);
+ stSHA2_512:
+ SHA512Init(Context512);
+ stSHA2_512_224:
+ SHA512_224Init(Context512_224);
+ stSHA2_512_256:
+ SHA512_256Init(Context512_256);
+ end;
+ end;
+
+{$IFDEF MSWINDOWS}
+ procedure _SHAUpdate;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Update(Context224, ViewPointer, GetFileSize(FileHandle, nil));
+ stSHA2_256:
+ SHA256Update(Context256, ViewPointer, GetFileSize(FileHandle, nil));
+ stSHA2_384:
+ SHA384Update(Context384, ViewPointer, GetFileSize(FileHandle, nil));
+ stSHA2_512:
+ SHA512Update(Context512, ViewPointer, GetFileSize(FileHandle, nil));
+ stSHA2_512_224:
+ SHA512_224Update(Context512_224, ViewPointer, GetFileSize(FileHandle, nil));
+ stSHA2_512_256:
+ SHA512_256Update(Context512_256, ViewPointer, GetFileSize(FileHandle, nil));
+ end;
+ end;
+{$ENDIF}
+
+ procedure _SHAFinal;
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ SHA224Final(Context224, Dig224);
+ stSHA2_256:
+ SHA256Final(Context256, Dig256);
+ stSHA2_384:
+ SHA384Final(Context384, Dig384);
+ stSHA2_512:
+ SHA512Final(Context512, Dig512);
+ stSHA2_512_224:
+ SHA512_224Final(Context512_224, Dig512_224);
+ stSHA2_512_256:
+ SHA512_256Final(Context512_256, Dig512_256);
+ end;
+ end;
+
+ procedure _CopyResult(var D: TCnSHA2GeneralDigest);
+ begin
+ case SHA2Type of
+ stSHA2_224:
+ Move(Dig224[0], D[0], SizeOf(TCnSHA224Digest));
+ stSHA2_256:
+ Move(Dig256[0], D[0], SizeOf(TCnSHA256Digest));
+ stSHA2_384:
+ Move(Dig384[0], D[0], SizeOf(TCnSHA384Digest));
+ stSHA2_512:
+ Move(Dig512[0], D[0], SizeOf(TCnSHA512Digest));
+ stSHA2_512_224:
+ Move(Dig512_224[0], D[0], SizeOf(TCnSHA512_224Digest));
+ stSHA2_512_256:
+ Move(Dig512_256[0], D[0], SizeOf(TCnSHA512_256Digest));
+ end;
+ end;
+
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣ Windows ƽ̨ʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalSHAStream(Stream, 4096 * 1024, Result, SHA2Type, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ _SHAInit;
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ _SHAUpdate;
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ _SHAFinal;
+ _CopyResult(Result);
+{$ENDIF}
+ end;
+end;
+
+// ָļݽ SHA224
+function SHA224File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA224Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA224Digest));
+end;
+
+// ָļݽ SHA256
+function SHA256File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA256Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA256Digest));
+end;
+
+// ָļݽ SHA384
+function SHA384File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA384Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_384, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA384Digest));
+end;
+
+// ָļݽ SHA512
+function SHA512File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_512, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512Digest));
+end;
+
+// ָļݽ SHA512_224
+function SHA512_224File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512_224Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_512_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512_224Digest));
+end;
+
+// ָļݽ SHA512_256
+function SHA512_256File(const FileName: string; CallBack: TCnSHACalcProgressFunc):
+ TCnSHA512_256Digest;
+var
+ Dig: TCnSHA2GeneralDigest;
+begin
+ Dig := InternalSHAFile(FileName, stSHA2_512_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA512_256Digest));
+end;
+
+// ʮƸʽ SHA224 Ӵֵ
+function SHA224Print(const Digest: TCnSHA224Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA224Digest));
+end;
+
+// ʮƸʽ SHA256 Ӵֵ
+function SHA256Print(const Digest: TCnSHA256Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA256Digest));
+end;
+
+// ʮƸʽ SHA384 Ӵֵ
+function SHA384Print(const Digest: TCnSHA384Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA384Digest));
+end;
+
+// ʮƸʽ SHA512 Ӵֵ
+function SHA512Print(const Digest: TCnSHA512Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA512Digest));
+end;
+
+// ʮƸʽ SHA512_224 Ӵֵ
+function SHA512_224Print(const Digest: TCnSHA512_224Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA512_224Digest));
+end;
+
+// ʮƸʽ SHA512_256 Ӵֵ
+function SHA512_256Print(const Digest: TCnSHA512_256Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA512_256Digest));
+end;
+
+// Ƚ SHA224 ӴֵǷ
+function SHA224Match(const D1, D2: TCnSHA224Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 28) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// Ƚ SHA256 ӴֵǷ
+function SHA256Match(const D1, D2: TCnSHA256Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 32) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// Ƚ SHA384 ӴֵǷ
+function SHA384Match(const D1, D2: TCnSHA384Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 48) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// Ƚ SHA512 ӴֵǷ
+function SHA512Match(const D1, D2: TCnSHA512Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 64) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// Ƚ SHA512_224 ӴֵǷ
+function SHA512_224Match(const D1, D2: TCnSHA512_224Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 28) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// Ƚ SHA512_256 ӴֵǷ
+function SHA512_256Match(const D1, D2: TCnSHA512_256Digest): Boolean;
+var
+ I: Integer;
+begin
+ I := 0;
+ Result := True;
+ while Result and (I < 32) do
+ begin
+ Result := D1[I] = D2[I];
+ Inc(I);
+ end;
+end;
+
+// SHA224 Ӵֵת string
+function SHA224DigestToStr(const Digest: TCnSHA224Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA224Digest));
+end;
+
+// SHA256 Ӵֵת string
+function SHA256DigestToStr(const Digest: TCnSHA256Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA256Digest));
+end;
+
+// SHA384 Ӵֵת string
+function SHA384DigestToStr(const Digest: TCnSHA384Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA384Digest));
+end;
+
+// SHA512 Ӵֵת string
+function SHA512DigestToStr(const Digest: TCnSHA512Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA512Digest));
+end;
+
+// SHA512_224 Ӵֵת string
+function SHA512_224DigestToStr(const Digest: TCnSHA512_224Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA512_224Digest));
+end;
+
+// SHA512_256 Ӵֵת string
+function SHA512_256DigestToStr(const Digest: TCnSHA512_256Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA512_256Digest));
+end;
+
+procedure SHA224HmacInit(var Context: TCnSHA224Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA224Digest;
+begin
+ if KeyLength > HMAC_SHA2_224_256_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA224Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_224_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_224_256_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_224_256_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA224Init(Context);
+ SHA224Update(Context, @(Context.Ipad[0]), HMAC_SHA2_224_256_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA224HmacUpdate(var Context: TCnSHA224Context; Input: PAnsiChar; Length:
+ Cardinal);
+begin
+ SHA224Update(Context, Input, Length);
+end;
+
+procedure SHA224HmacFinal(var Context: TCnSHA224Context; var Output: TCnSHA224Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA224Digest;
+begin
+ Len := HMAC_SHA2_224_OUTPUT_LENGTH_BYTE;
+ SHA224Final(Context, TmpBuf);
+ SHA224Init(Context);
+ SHA224Update(Context, @(Context.Opad[0]), HMAC_SHA2_224_256_BLOCK_SIZE_BYTE);
+ SHA224Update(Context, @(TmpBuf[0]), Len);
+ SHA224Final(Context, Output);
+end;
+
+procedure SHA256HmacInit(var Context: TCnSHA256Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA256Digest;
+begin
+ if KeyLength > HMAC_SHA2_224_256_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA256Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_256_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_224_256_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_224_256_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA256Init(Context);
+ SHA256Update(Context, @(Context.Ipad[0]), HMAC_SHA2_224_256_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA256HmacUpdate(var Context: TCnSHA256Context; Input: PAnsiChar; Length:
+ Cardinal);
+begin
+ SHA256Update(Context, Input, Length);
+end;
+
+procedure SHA256HmacFinal(var Context: TCnSHA256Context; var Output: TCnSHA256Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA256Digest;
+begin
+ Len := HMAC_SHA2_256_OUTPUT_LENGTH_BYTE;
+ SHA256Final(Context, TmpBuf);
+ SHA256Init(Context);
+ SHA256Update(Context, @(Context.Opad[0]), HMAC_SHA2_224_256_BLOCK_SIZE_BYTE);
+ SHA256Update(Context, @(TmpBuf[0]), Len);
+ SHA256Final(Context, Output);
+end;
+
+procedure SHA224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA224Digest);
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224HmacInit(Context, Key, KeyByteLength);
+ SHA224HmacUpdate(Context, Input, ByteLength);
+ SHA224HmacFinal(Context, Output);
+end;
+
+function SHA224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA224Digest;
+var
+ Context: TCnSHA224Context;
+begin
+ SHA224HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA224HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA224HmacFinal(Context, Result);
+end;
+
+procedure SHA256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA256Digest);
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256HmacInit(Context, Key, KeyByteLength);
+ SHA256HmacUpdate(Context, Input, ByteLength);
+ SHA256HmacFinal(Context, Output);
+end;
+
+function SHA256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA256Digest;
+var
+ Context: TCnSHA256Context;
+begin
+ SHA256HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA256HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA256HmacFinal(Context, Result);
+end;
+
+procedure SHA384HmacInit(var Context: TCnSHA384Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA384Digest;
+begin
+ if KeyLength > HMAC_SHA2_384_512_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA384Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_384_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA384Init(Context);
+ SHA384Update(Context, @(Context.Ipad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA384HmacUpdate(var Context: TCnSHA384Context; Input: PAnsiChar;
+ Length: Cardinal);
+begin
+ SHA384Update(Context, Input, Length);
+end;
+
+procedure SHA384HmacFinal(var Context: TCnSHA384Context; var Output: TCnSHA384Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA384Digest;
+begin
+ Len := HMAC_SHA2_384_OUTPUT_LENGTH_BYTE;
+ SHA384Final(Context, TmpBuf);
+ SHA384Init(Context);
+ SHA384Update(Context, @(Context.Opad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+ SHA384Update(Context, @(TmpBuf[0]), Len);
+ SHA384Final(Context, Output);
+end;
+
+procedure SHA384Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA384Digest);
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384HmacInit(Context, Key, KeyByteLength);
+ SHA384HmacUpdate(Context, Input, ByteLength);
+ SHA384HmacFinal(Context, Output);
+end;
+
+function SHA384HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA384Digest;
+var
+ Context: TCnSHA384Context;
+begin
+ SHA384HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA384HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA384HmacFinal(Context, Result);
+end;
+
+procedure SHA512HmacInit(var Context: TCnSHA512Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA512Digest;
+begin
+ if KeyLength > HMAC_SHA2_384_512_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA512Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_512_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA512Init(Context);
+ SHA512Update(Context, @(Context.Ipad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA512HmacUpdate(var Context: TCnSHA512Context; Input: PAnsiChar;
+ Length: Cardinal);
+begin
+ SHA512Update(Context, Input, Length);
+end;
+
+procedure SHA512HmacFinal(var Context: TCnSHA512Context; var Output: TCnSHA512Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA512Digest;
+begin
+ Len := HMAC_SHA2_512_OUTPUT_LENGTH_BYTE;
+ SHA512Final(Context, TmpBuf);
+ SHA512Init(Context);
+ SHA512Update(Context, @(Context.Opad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+ SHA512Update(Context, @(TmpBuf[0]), Len);
+ SHA512Final(Context, Output);
+end;
+
+procedure SHA512Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512Digest);
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512HmacInit(Context, Key, KeyByteLength);
+ SHA512HmacUpdate(Context, Input, ByteLength);
+ SHA512HmacFinal(Context, Output);
+end;
+
+function SHA512HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512Digest;
+var
+ Context: TCnSHA512Context;
+begin
+ SHA512HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA512HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512HmacFinal(Context, Result);
+end;
+
+procedure SHA512_224HmacInit(var Context: TCnSHA512_224Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA512_224Digest;
+begin
+ if KeyLength > HMAC_SHA2_384_512_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA512_224Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_512_224_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, @(Context.Ipad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA512_224HmacUpdate(var Context: TCnSHA512_224Context; Input: PAnsiChar;
+ Length: Cardinal);
+begin
+ SHA512_224Update(Context, Input, Length);
+end;
+
+procedure SHA512_224HmacFinal(var Context: TCnSHA512_224Context; var Output: TCnSHA512_224Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA512_224Digest;
+begin
+ Len := HMAC_SHA2_512_224_OUTPUT_LENGTH_BYTE;
+ SHA512_224Final(Context, TmpBuf);
+ SHA512_224Init(Context);
+ SHA512_224Update(Context, @(Context.Opad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+ SHA512_224Update(Context, @(TmpBuf[0]), Len);
+ SHA512_224Final(Context, Output);
+end;
+
+procedure SHA512_224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512_224Digest);
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224HmacInit(Context, Key, KeyByteLength);
+ SHA512_224HmacUpdate(Context, Input, ByteLength);
+ SHA512_224HmacFinal(Context, Output);
+end;
+
+function SHA512_224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512_224Digest;
+var
+ Context: TCnSHA512_224Context;
+begin
+ SHA512_224HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA512_224HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512_224HmacFinal(Context, Result);
+end;
+
+procedure SHA512_256HmacInit(var Context: TCnSHA512_256Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA512_256Digest;
+begin
+ if KeyLength > HMAC_SHA2_384_512_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA512_256Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA2_512_256_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA2_384_512_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, @(Context.Ipad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA512_256HmacUpdate(var Context: TCnSHA512_256Context; Input: PAnsiChar;
+ Length: Cardinal);
+begin
+ SHA512_256Update(Context, Input, Length);
+end;
+
+procedure SHA512_256HmacFinal(var Context: TCnSHA512_256Context; var Output: TCnSHA512_256Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA512_256Digest;
+begin
+ Len := HMAC_SHA2_512_256_OUTPUT_LENGTH_BYTE;
+ SHA512_256Final(Context, TmpBuf);
+ SHA512_256Init(Context);
+ SHA512_256Update(Context, @(Context.Opad[0]), HMAC_SHA2_384_512_BLOCK_SIZE_BYTE);
+ SHA512_256Update(Context, @(TmpBuf[0]), Len);
+ SHA512_256Final(Context, Output);
+end;
+
+procedure SHA512_256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA512_256Digest);
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256HmacInit(Context, Key, KeyByteLength);
+ SHA512_256HmacUpdate(Context, Input, ByteLength);
+ SHA512_256HmacFinal(Context, Output);
+end;
+
+function SHA512_256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA512_256Digest;
+var
+ Context: TCnSHA512_256Context;
+begin
+ SHA512_256HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA512_256HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA512_256HmacFinal(Context, Result);
+end;
+
+end.
diff --git a/CnPack/Crypto/CnSHA3.pas b/CnPack/Crypto/CnSHA3.pas
new file mode 100644
index 0000000..1f8500d
--- /dev/null
+++ b/CnPack/Crypto/CnSHA3.pas
@@ -0,0 +1,2917 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnSHA3;
+{* |
+================================================================================
+* ƣ
+* ԪƣSHA3 Ӵ㷨ʵֵԪ
+* ԪߣCnPack (master@cnpack.org)
+* / Keccak C Pascal ֲ䲿ֹܡ
+* עԪʵ SHA3 ϵӴ㷨Ӧ HMAC 㷨 SHA3-224/256/384/512
+* ɱ䳤ժҪ SHAKE128/SHAKE256ȡ
+*
+* SHA3 淶 NIST.FIPS.202
+* SHA-3 Standard: Permutation-Based Hash and Extendable-Output Functions
+* жⶨ Bit Byte ת
+* ֮ Bit ܹ 8 ʱÿ 8 Bit λþһֽڣֽڼ˳ֲ䡣
+*
+* ƽ̨PWinXP + Delphi 5.0
+* ݲԣPWinXP/7 + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2025.11.06 V1.5
+* SHAKE128/SHAKE256 Absorb/Squeeze ƣժҪ
+* 2023.08.02 V1.4
+* SHAKE128/SHAKE256 Ŀɱ䳤ժҪļ
+* 2022.04.26 V1.3
+* LongWord Integer ַת֧ MacOS64
+* 2019.12.12 V1.2
+* ֧ TBytes
+* 2019.04.15 V1.1
+* ֧ Win32/Win64/MacOS
+* 2017.11.10 V1.0
+* Ԫ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ SysUtils, Classes {$IFDEF MSWINDOWS}, Windows {$ENDIF}, CnNative, CnConsts;
+
+const
+ CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH = 32;
+ {* SHAKE128 ĬӴսֽڳ}
+
+ CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH = 64;
+ {* SHAKE256 ĬӴսֽڳ}
+
+type
+ PCnSHA3GeneralDigest = ^TCnSHA3GeneralDigest;
+ {* SHA3 ϵͨõӴսָ}
+ TCnSHA3GeneralDigest = array[0..63] of Byte;
+ {* SHA3 ϵͨõӴս 64 ֽΪ}
+
+ PCnSHA3_224Digest = ^TCnSHA3_224Digest;
+ {* SHA3_224 Ӵսָ}
+ TCnSHA3_224Digest = array[0..27] of Byte;
+ {* SHA3_224 Ӵս28 ֽ}
+
+ PCnSHA3_256Digest = ^TCnSHA3_256Digest;
+ {* SHA3_256 Ӵսָ}
+ TCnSHA3_256Digest = array[0..31] of Byte;
+ {* SHA3_256 Ӵս32 ֽ}
+
+ PCnSHA3_384Digest = ^TCnSHA3_384Digest;
+ {* SHA3_384 Ӵսָ}
+ TCnSHA3_384Digest = array[0..47] of Byte;
+ {* SHA3_384 Ӵս48 ֽ}
+
+ PCnSHA3_512Digest = ^TCnSHA3_512Digest;
+ {* SHA3_512 Ӵսָ}
+ TCnSHA3_512Digest = array[0..63] of Byte;
+ {* SHA3_512 Ӵս64 ֽ}
+
+ TCnSHA3Context = packed record
+ {* SHA3 ϵͨõĽṹ}
+ State: array[0..24] of Int64;
+ Index: Cardinal;
+ DigestLen: Cardinal;
+ Round: Cardinal;
+ BlockLen: Cardinal;
+ Squeezed: Cardinal;
+ SqueezeCount: Cardinal;
+ Block: array[0..255] of Byte;
+ Ipad: array[0..143] of Byte; {!< HMAC: inner padding }
+ Opad: array[0..143] of Byte; {!< HMAC: outer padding }
+ end;
+
+ TCnSHA3CalcProgressFunc = procedure(ATotal, AProgress: Int64; var Cancel:
+ Boolean) of object;
+ {* SHA3 ϵͨõļȻص¼}
+
+function SHA3_224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_224Digest;
+{* ݿ SHA3_224 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_256Digest;
+{* ݿ SHA3_256 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_384Digest;
+{* ݿ SHA3_384 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_512Digest;
+{* ݿ SHA3_512 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHA3_224Buffer(const Buffer; Count: Cardinal): TCnSHA3_224Digest;
+{* ݿ SHA3_224 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256Buffer(const Buffer; Count: Cardinal): TCnSHA3_256Digest;
+{* ݿ SHA3_256 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384Buffer(const Buffer; Count: Cardinal): TCnSHA3_384Digest;
+{* ݿ SHA3_384 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512Buffer(const Buffer; Count: Cardinal): TCnSHA3_512Digest;
+{* ݿ SHA3_512 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128Buffer(const Buffer; Count: Cardinal;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* ݿӴճȿɱ SHAKE128 㣬سΪ DigestByteLength ֽΪӴս
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256Buffer(const Buffer; Count: Cardinal;
+ DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* ݿӴճȿɱ SHAKE128 㣬سΪ DigestByteLength ֽΪӴս
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+function SHA3_224Bytes(const Data: TBytes): TCnSHA3_224Digest;
+{* ֽ SHA3_224 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256Bytes(const Data: TBytes): TCnSHA3_256Digest;
+{* ֽ SHA3_256 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384Bytes(const Data: TBytes): TCnSHA3_384Digest;
+{* ֽ SHA3_384 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512Bytes(const Data: TBytes): TCnSHA3_512Digest;
+{* ֽ SHA3_512 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128Bytes(const Data: TBytes; DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* ֽӴճȿɱ SHAKE128 㣬سΪ DigestByteLength ֽΪӴս
+
+
+ const Data: TBytes - ֽ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256Bytes(const Data: TBytes; DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* ֽӴճȿɱ SHAKE256 㣬سΪ DigestByteLength ֽΪӴս
+
+
+ const Data: TBytes - ֽ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+function SHA3_224String(const Str: string): TCnSHA3_224Digest;
+{* String ݽ SHA3_224 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256String(const Str: string): TCnSHA3_256Digest;
+{* String ݽ SHA3_256 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384String(const Str: string): TCnSHA3_384Digest;
+{* String ݽ SHA3_384 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512String(const Str: string): TCnSHA3_512Digest;
+{* String ݽ SHA3_512 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128String(const Str: string; DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* String ݽӴճȿɱ SHAKE128 㣬سΪ DigestByteLength ֽΪӴս
+ ע D2009 ϰ汾 string Ϊ UnicodeStringлὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256String(const Str: string; DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* String ݽӴճȿɱ SHAKE256 㣬سΪ DigestByteLength ֽΪӴս
+ ע D2009 ϰ汾 string Ϊ UnicodeStringлὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+function SHA3_224StringA(const Str: AnsiString): TCnSHA3_224Digest;
+{* AnsiString ݽ SHA3_224 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_224StringW(const Str: WideString): TCnSHA3_224Digest;
+{* WideString ݽ SHA3_224 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256StringA(const Str: AnsiString): TCnSHA3_256Digest;
+{* AnsiString ݽ SHA3_256 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_256StringW(const Str: WideString): TCnSHA3_256Digest;
+{* WideStringݽ SHA3_256 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384StringA(const Str: AnsiString): TCnSHA3_384Digest;
+{* AnsiString ݽ SHA3_384 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_384StringW(const Str: WideString): TCnSHA3_384Digest;
+{* WideString ݽ SHA3_384 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512StringA(const Str: AnsiString): TCnSHA3_512Digest;
+{* AnsiString ݽ SHA3_512 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHA3_512StringW(const Str: WideString): TCnSHA3_512Digest;
+{* WideString ݽ SHA512 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128StringA(const Str: AnsiString;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* AnsiString ݽӴճȿɱֱ SHAKE128 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: AnsiString - ַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE128StringW(const Str: WideString;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* WideString ݽӴճȿɱֱ SHAKE128 㣬
+ سΪ DigestByteLength ֽΪӴս
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256StringA(const Str: AnsiString; DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* AnsiString ݽӴճȿɱֱ SHAKE128 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: AnsiString - ַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+function SHAKE256StringW(const Str: WideString; DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* WideString ݽӴճȿɱֱ SHAKE256 㣬
+ سΪ DigestByteLength ֽΪӴս
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+{$IFDEF UNICODE}
+
+function SHA3_224UnicodeString(const Str: string): TCnSHA3_224Digest;
+{* UnicodeString ݽֱӵ SHA3_224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256UnicodeString(const Str: string): TCnSHA3_256Digest;
+{* UnicodeString ݽֱӵ SHA3_256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384UnicodeString(const Str: string): TCnSHA3_384Digest;
+{* UnicodeString ݽֱӵ SHA3_384 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512UnicodeString(const Str: string): TCnSHA3_512Digest;
+{* UnicodeString ݽֱӵ SHA3_512 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128UnicodeString(const Str: string;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* UnicodeString ݽӴճȿɱֱ SHAKE128 㣬ֱӼڲ UTF16 ݣת
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: string - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256UnicodeString(const Str: string;
+ DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* UnicodeString ݽӴճȿɱֱ SHAKE256 㣬ֱӼڲ UTF16 ݣת
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: string - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+{$ELSE}
+
+function SHA3_224UnicodeString(const Str: WideString): TCnSHA3_224Digest;
+{* UnicodeString ݽֱӵ SHA3_224 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256UnicodeString(const Str: WideString): TCnSHA3_256Digest;
+{* UnicodeString ݽֱӵ SHA3_256 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384UnicodeString(const Str: WideString): TCnSHA3_384Digest;
+{* UnicodeString ݽֱӵ SHA3_384 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512UnicodeString(const Str: WideString): TCnSHA3_512Digest;
+{* UnicodeString ݽֱӵ SHA3_512 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128UnicodeString(const Str: WideString;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* UnicodeString ݽӴճȿɱֱ SHAKE128 㣬ֱӼڲ UTF16 ݣת
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: WideString - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256UnicodeString(const Str: WideString;
+ DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH): TBytes;
+{* UnicodeString ݽӴճȿɱֱ SHAKE256 㣬ֱӼڲ UTF16 ݣת
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const Str: WideString - Ŀַ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+{$ENDIF}
+
+function SHA3_224File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc =
+ nil): TCnSHA3_224Digest;
+{* ָļݽ SHA3_224 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_224Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc = nil):
+ TCnSHA3_224Digest;
+{* ָݽ SHA3_224 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc =
+ nil): TCnSHA3_256Digest;
+{* ָļݽ SHA3_256 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_256Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc = nil):
+ TCnSHA3_256Digest;
+{* ָݽ SHA3_256 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc =
+ nil): TCnSHA3_384Digest;
+{* ָļݽ SHA3_384 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_384Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc = nil):
+ TCnSHA3_384Digest;
+{* ָݽ SHA3_384 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc =
+ nil): TCnSHA3_512Digest;
+{* ָļݽ SHA3_512 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHA3_512Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc = nil):
+ TCnSHA3_512Digest;
+{* ָݽ SHA3_512 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+function SHAKE128File(const FileName: string;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH;
+ CallBack: TCnSHA3CalcProgressFunc = nil): TBytes;
+{* ָļݽӴճȿɱ SHAKE128 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const FileName: string - ļ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTBytes - SHAKE128Ӵֵ
+}
+
+function SHAKE128Stream(Stream: TStream;
+ DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH;
+ CallBack: TCnSHA3CalcProgressFunc = nil): TBytes;
+{* ָӴճȿɱ SHAKE128 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ Stream: TStream -
+ DigestByteLength: Cardinal - Ӵսֽڳ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTBytes - SHAKE128 Ӵֵ
+}
+
+function SHAKE256File(const FileName: string;
+ DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH;
+ CallBack: TCnSHA3CalcProgressFunc = nil): TBytes;
+{* ָļݽӴճȿɱ SHAKE256 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ const FileName: string - ļ
+ DigestByteLength: Cardinal - Ӵսֽڳ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+function SHAKE256Stream(Stream: TStream;
+ DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH;
+ CallBack: TCnSHA3CalcProgressFunc = nil): TBytes;
+{* ָӴճȿɱ SHAKE256 㣬
+ سΪ DigestByteLength ֽΪӴս
+
+
+ Stream: TStream -
+ DigestByteLength: Cardinal - Ӵսֽڳ
+ CallBack: TCnSHA3CalcProgressFunc - ȻصĬΪ
+
+ ֵTBytes - SHAKE256 Ӵֵ
+}
+
+// ⲿݽɢ SHA3_224 㣬SHA3_224Update ɶα
+
+procedure SHA3_224Init(var Context: TCnSHA3Context);
+{* ʼһ SHA3_224 ģ SHA3_224
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+
+ ֵޣ
+}
+
+procedure SHA3_224Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA3_224 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA3_224Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_224Digest);
+{* ּ㣬 SHA3_224 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ var Digest: TCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA3_256 㣬SHA3_256Update ɶα
+
+procedure SHA3_256Init(var Context: TCnSHA3Context);
+{* ʼһ SHA3_256 ģ SHA3_256
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+
+ ֵޣ
+}
+
+procedure SHA3_256Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA3_256 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA3_256Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_256Digest);
+{* ּ㣬 SHA3_256 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ var Digest: TCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA3_384 㣬SHA3_384Update ɶα
+
+procedure SHA3_384Init(var Context: TCnSHA3Context);
+{* ʼһ SHA3_384 ģ SHA3_384
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+
+ ֵޣ
+}
+
+procedure SHA3_384Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA3_384 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA3_384Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_384Digest);
+{* ּ㣬 SHA3_384 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ var Digest: TCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+
+ ֵޣ
+}
+
+// ⲿݽɢ SHA3_512 㣬SHA3_512Update ɶα
+
+procedure SHA3_512Init(var Context: TCnSHA3Context);
+{* ʼһ SHA3_512 ģ SHA3_512
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+
+ ֵޣ
+}
+
+procedure SHA3_512Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHA3_512 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHA3_512Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_512Digest);
+{* ּ㣬 SHA3_512 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ var Digest: TCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+
+ ֵޣ
+}
+
+// ¼ⲿݽɢ SHAKE128 㣬SHAKE128Update ɶα
+
+procedure SHAKE128Init(var Context: TCnSHA3Context; DigestByteLength: Cardinal = CN_SHAKE128_DEF_DIGEST_BYTE_LENGTH);
+{* ʼһ SHAKE128 ģ SHAKE128
+ DigestByteLength ΪӴյֽڳȡ
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE128Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHAKE128 㣬ͬ SHAKE128Absorb
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE128Absorb(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHAKE128 㣬ͬ SHAKE128Update
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE128Final(var Context: TCnSHA3Context; out Digest: TBytes);
+{* ּ㣬 SHAKE128 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ out Digest: TBytes - ص SHAKE128 Ӵֵ
+
+ ֵޣ
+}
+
+function SHAKE128Squeeze(var Context: TCnSHA3Context; DigestByteLength: Integer): TBytes;
+{* ּ㣬 SHAKE128 DigestByteLength ֽڳݣ
+ ɼ Squeeze Absorb ˡ
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ DigestByteLength: Integer - Ҫص SHAKE128 Ӵֽڳ
+
+ ֵTBytes - ص SHAKE128 Ӵֵ
+}
+
+// ¼ⲿݽɢ SHAKE128 㣬SHAKE128Update ɶα
+
+procedure SHAKE256Init(var Context: TCnSHA3Context; DigestByteLength: Cardinal = CN_SHAKE256_DEF_DIGEST_BYTE_LENGTH);
+{* ʼһ SHAKE256 ģ SHAKE256
+ DigestByteLength ΪӴյֽڳȡ
+
+
+ var Context: TCnSHA3Context - ʼͨ SHA3
+ DigestByteLength: Cardinal - Ӵսֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE256Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHAKE256 㣬ͬ SHAKE256Absorb
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE256Absorb(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SHAKE256 㣬ͬ SHAKE256Update
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SHAKE256Final(var Context: TCnSHA3Context; out Digest: TBytes);
+{* ּ㣬 SHAKE256 Digest С
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ out Digest: TBytes - ص SHAKE256 Ӵֵ
+
+ ֵޣ
+}
+
+function SHAKE256Squeeze(var Context: TCnSHA3Context; DigestByteLength: Integer): TBytes;
+{* ּ㣬 SHAKE256 DigestByteLength ֽڳݣ
+ ɼ Squeeze Absorb ˡ
+
+
+ var Context: TCnSHA3Context - ͨ SHA3
+ DigestByteLength: Integer - Ҫص SHAKE256 Ӵֽڳ
+
+ ֵTBytes - ص SHAKE256 Ӵֵ
+}
+
+function SHA3_224Print(const Digest: TCnSHA3_224Digest): string;
+{* ʮƸʽ SHA3_224 Ӵֵ
+
+
+ const Digest: TCnSHA3_224Digest - ָ SHA3_224 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA3_256Print(const Digest: TCnSHA3_256Digest): string;
+{* ʮƸʽ SHA3_256 Ӵֵ
+
+
+ const Digest: TCnSHA3_256Digest - ָ SHA3_256 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA3_384Print(const Digest: TCnSHA3_384Digest): string;
+{* ʮƸʽ SHA3_384 Ӵֵ
+
+ const Digest: TCnSHA3_384Digest - ָ SHA3_384 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA3_512Print(const Digest: TCnSHA3_512Digest): string;
+{* ʮƸʽ SHA3_512 Ӵֵ
+
+
+ const Digest: TCnSHA3_512Digest - ָ SHA3_512 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHAKE128Print(const Digest: TBytes): string;
+{* ʮƸʽ SHAKE128 Ӵֵ
+
+
+ const Digest: TBytes - ָ SHAKE128 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHAKE256Print(const Digest: TBytes): string;
+{* ʮƸʽ SHAKE256 Ӵֵ
+
+
+ const Digest: TBytes - ָ SHAKE128 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SHA3_224Match(const D1: TCnSHA3_224Digest; const D2: TCnSHA3_224Digest): Boolean;
+{* Ƚ SHA3_224 ӴֵǷȡ
+
+
+ const D1: TCnSHA3_224Digest - Ƚϵ SHA3_224 Ӵֵһ
+ const D2: TCnSHA3_224Digest - Ƚϵ SHA3_224 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA3_256Match(const D1: TCnSHA3_256Digest; const D2: TCnSHA3_256Digest): Boolean;
+{* Ƚ SHA3_256 ӴֵǷȡ
+
+
+ const D1: TCnSHA3_256Digest - Ƚϵ SHA3_256 Ӵֵһ
+ const D2: TCnSHA3_256Digest - Ƚϵ SHA3_256 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA3_384Match(const D1: TCnSHA3_384Digest; const D2: TCnSHA3_384Digest): Boolean;
+{* Ƚ SHA3_384 ӴֵǷȡ
+
+
+ const D1: TCnSHA3_384Digest - Ƚϵ SHA3_384 Ӵֵһ
+ const D2: TCnSHA3_384Digest - Ƚϵ SHA3_384 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA3_512Match(const D1: TCnSHA3_512Digest; const D2: TCnSHA3_512Digest): Boolean;
+{* Ƚ SHA3_512 ӴֵǷȡ
+
+
+ const D1: TCnSHA3_512Digest - Ƚϵ SHA3_512 Ӵֵһ
+ const D2: TCnSHA3_512Digest - Ƚϵ SHA3_512 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHAKE128Match(const D1: TBytes; const D2: TBytes): Boolean;
+{* Ƚ SHAKE128 ӴֵǷȡ
+
+
+ const D1: TBytes - Ƚϵ SHAKE128 Ӵֵһ
+ const D2: TBytes - Ƚϵ SHAKE128 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHAKE256Match(const D1: TBytes; const D2: TBytes): Boolean;
+{* Ƚ SHAKE256 ӴֵǷȡ
+
+
+ const D1: TBytes - Ƚϵ SHAKE256 Ӵֵһ
+ const D2: TBytes - Ƚϵ SHAKE256 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SHA3_224DigestToStr(const Digest: TCnSHA3_224Digest): string;
+{* SHA3_224 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA3_224Digest - ת SHA3_224 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA3_256DigestToStr(const Digest: TCnSHA3_256Digest): string;
+{* SHA3_256 Ӵֱֵת stringÿֽڶӦһַ
+ |
+ Digest: TSHA3_256Digest - Ҫ
+ |
+
+
+ const Digest: TCnSHA3_256Digest - ת SHA3_256 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA3_384DigestToStr(const Digest: TCnSHA3_384Digest): string;
+{* SHA3_384 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA3_384Digest - ת SHA3_384 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHA3_512DigestToStr(const Digest: TCnSHA3_512Digest): string;
+{* SHA3_512 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSHA3_512Digest - ת SHA3_512 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHAKE128DigestToStr(const Digest: TBytes): string;
+{* SHAKE128 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TBytes - ת SHAKE128 Ӵֵ
+
+ ֵstring - صַ
+}
+
+function SHAKE256DigestToStr(const Digest: TBytes): string;
+{* SHAKE256 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TBytes - ת SHAKE256 Ӵֵ
+
+ ֵstring - صַ
+}
+
+procedure SHA3_224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_224Digest);
+{* SHA3_224 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA3_224 Կݿַ
+ KeyByteLength: Integer - SHA3_224 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA3_256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_256Digest);
+{* SHA3_256 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA3_256 Կݿַ
+ KeyByteLength: Integer - SHA3_256 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA3_384Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_384Digest);
+{* SHA3_384 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA3_384 Կݿַ
+ KeyByteLength: Integer - SHA3_384 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+
+ ֵޣ
+}
+
+procedure SHA3_512Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_512Digest);
+{* SHA3_512 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SHA3_512 Կݿַ
+ KeyByteLength: Integer - SHA3_512 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+
+ ֵޣ
+}
+
+function SHA3_224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_224Digest;
+{* ֽл SHA3_224 HMAC 㡣
+
+
+ const Key: TBytes - SHA3_224 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_224Digest - ص SHA3_224 Ӵֵ
+}
+
+function SHA3_256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_256Digest;
+{* ֽл SHA3_256 HMAC 㡣
+
+
+ const Key: TBytes - SHA3_256 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_256Digest - ص SHA3_256 Ӵֵ
+}
+
+function SHA3_384HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_384Digest;
+{* ֽл SHA3_384 HMAC 㡣
+
+
+ const Key: TBytes - SHA3_384 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_384Digest - ص SHA3_384 Ӵֵ
+}
+
+function SHA3_512HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_512Digest;
+{* ֽл SHA3_512 HMAC 㡣
+
+
+ const Key: TBytes - SHA3_512 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnSHA3_512Digest - ص SHA3_512 Ӵֵ
+}
+
+implementation
+
+type
+ TSHA3Type = (stSHA3_224, stSHA3_256, stSHA3_384, stSHA3_512, stSHAKE128, stSHAKE256);
+
+const
+ MAX_FILE_SIZE = 512 * 1024 * 1024;
+ STREAM_BUF_SIZE = 4096 * 1024;
+ // If file size <= this size (bytes), using Mapping, else stream
+
+ SHA3_ROUNDS = 24;
+ SHA3_STATE_LEN = 25;
+
+ SHA3_224_OUTPUT_LENGTH_BYTE = 28;
+ SHA3_256_OUTPUT_LENGTH_BYTE = 32;
+ SHA3_384_OUTPUT_LENGTH_BYTE = 48;
+ SHA3_512_OUTPUT_LENGTH_BYTE = 64;
+
+ SHA3_224_BLOCK_SIZE_BYTE = 144;
+ SHA3_256_BLOCK_SIZE_BYTE = 136;
+ SHA3_384_BLOCK_SIZE_BYTE = 104;
+ SHA3_512_BLOCK_SIZE_BYTE = 72;
+
+ SHAKE128_BLOCK_SIZE_BYTE = 168;
+ SHAKE256_BLOCK_SIZE_BYTE = 136;
+
+ HMAC_SHA3_224_BLOCK_SIZE_BYTE = SHA3_224_BLOCK_SIZE_BYTE;
+ HMAC_SHA3_256_BLOCK_SIZE_BYTE = SHA3_256_BLOCK_SIZE_BYTE;
+ HMAC_SHA3_384_BLOCK_SIZE_BYTE = SHA3_384_BLOCK_SIZE_BYTE;
+ HMAC_SHA3_512_BLOCK_SIZE_BYTE = SHA3_512_BLOCK_SIZE_BYTE;
+
+ HMAC_SHA3_224_OUTPUT_LENGTH_BYTE = SHA3_224_OUTPUT_LENGTH_BYTE;
+ HMAC_SHA3_256_OUTPUT_LENGTH_BYTE = SHA3_256_OUTPUT_LENGTH_BYTE;
+ HMAC_SHA3_384_OUTPUT_LENGTH_BYTE = SHA3_384_OUTPUT_LENGTH_BYTE;
+ HMAC_SHA3_512_OUTPUT_LENGTH_BYTE = SHA3_512_OUTPUT_LENGTH_BYTE;
+
+ KECCAKF_ROUND_CONSTS: array[0..23] of TUInt64 = (
+ $0000000000000001, $0000000000008082, $800000000000808A,
+ $8000000080008000, $000000000000808B, $0000000080000001,
+ $8000000080008081, $8000000000008009, $000000000000008A,
+ $0000000000000088, $0000000080008009, $000000008000000A,
+ $000000008000808B, $800000000000008B, $8000000000008089,
+ $8000000000008003, $8000000000008002, $8000000000000080,
+ $000000000000800A, $800000008000000A, $8000000080008081,
+ $8000000000008080, $0000000080000001, $8000000080008008
+ );
+
+ KECCAKF_ROT_CONSTS: array[0..23] of Integer = (
+ 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 2, 14,
+ 27, 41, 56, 8, 25, 43, 62, 18, 39, 61, 20, 44
+ );
+
+ KECCAKF_PILN: array[0..23] of Integer = (
+ 10, 7, 11, 17, 18, 3, 5, 16, 8, 21, 24, 4,
+ 15, 23, 19, 13, 12, 2, 20, 14, 22, 9, 6, 1
+ );
+
+function ROTL64(Q: TUInt64; N: Integer): TUInt64; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (Q shl N) xor (Q shr (64 - N));
+end;
+
+// һ SHA3 㣬 Block ݣ State
+procedure SHA3_Transform(var Context: TCnSHA3Context);
+type
+ PUInt64Array = ^TUInt64Array;
+ TUInt64Array = array[0..4095] of TUInt64;
+var
+ I, J, R, L: Integer;
+ P: PUInt64Array;
+ T: TUInt64;
+ BC: array[0..4] of TUInt64;
+begin
+ P := PUInt64Array(@(Context.Block[0]));
+ I := 0;
+ L := Integer(Context.BlockLen div 8);
+ while I < L do
+ begin
+ Context.State[I] := Context.State[I] xor P^[I];
+ Inc(I);
+ end;
+
+ for R := 0 to Context.Round - 1 do
+ begin
+ // Theta
+ for I := 0 to 4 do
+ begin
+ BC[I] := Context.State[I] xor Context.State[I + 5] xor Context.State[I + 10]
+ xor Context.State[I + 15] xor Context.State[I + 20];
+ end;
+ for I := 0 to 4 do
+ begin
+ T := BC[(I + 4) mod 5] xor ROTL64(BC[(I + 1) mod 5], 1);
+ for J := 0 to 4 do
+ Context.State[5 * J + I] := Context.State[5 * J + I] xor T;
+ end;
+
+ // Rho Pi
+ T := Context.State[1];
+ for I := 0 to 23 do
+ begin
+ J := KECCAKF_PILN[I];
+ BC[0] := Context.State[J];
+ Context.State[J] := ROTL64(T, KECCAKF_ROT_CONSTS[I]);
+ T := BC[0];
+ end;
+
+ // Chi
+ for J := 0 to 4 do
+ begin
+ for I := 0 to 4 do
+ BC[I] := Context.State[5 * J + I];
+
+ for I := 0 to 4 do
+ Context.State[5 * J + I] := Context.State[5 * J + I] xor
+ ((not BC[(I + 1) mod 5]) and BC[(I + 2) mod 5]);
+ end;
+
+ // Iota
+ Context.State[0] := Context.State[0] xor KECCAKF_ROUND_CONSTS[R];
+ end;
+end;
+
+procedure SHA3Init(var Context: TCnSHA3Context; SHA3Type: TSHA3Type;
+ DigestByteLength: Cardinal = 0);
+begin
+ FillChar(Context.State, SizeOf(Context.State), 0);
+ FillChar(Context.Block, SizeOf(Context.Block), 0);
+ Context.Index := 0;
+ Context.Squeezed := 0;
+ Context.SqueezeCount := 0;
+ Context.Round := SHA3_ROUNDS;
+
+ case SHA3Type of
+ stSHA3_224:
+ begin
+ Context.BlockLen := SHA3_224_BLOCK_SIZE_BYTE;
+ Context.DigestLen := SHA3_224_OUTPUT_LENGTH_BYTE;
+ end;
+ stSHA3_256:
+ begin
+ Context.BlockLen := SHA3_256_BLOCK_SIZE_BYTE;
+ Context.DigestLen := SHA3_256_OUTPUT_LENGTH_BYTE;
+ end;
+ stSHA3_384:
+ begin
+ Context.BlockLen := SHA3_384_BLOCK_SIZE_BYTE;
+ Context.DigestLen := SHA3_384_OUTPUT_LENGTH_BYTE;
+ end;
+ stSHA3_512:
+ begin
+ Context.BlockLen := SHA3_512_BLOCK_SIZE_BYTE;
+ Context.DigestLen := SHA3_512_OUTPUT_LENGTH_BYTE;
+ end;
+ stSHAKE128:
+ begin
+ Context.BlockLen := SHAKE128_BLOCK_SIZE_BYTE;
+ Context.DigestLen := DigestByteLength;
+ end;
+ stSHAKE256:
+ begin
+ Context.BlockLen := SHAKE256_BLOCK_SIZE_BYTE;
+ Context.DigestLen := DigestByteLength;
+ end;
+ end;
+end;
+
+procedure SHA3Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ R, Idx: Cardinal;
+begin
+ Idx := Context.Index; // Index Block еijʼλָ
+ repeat
+ if ByteLength < Context.BlockLen - Idx then
+ R := ByteLength //
+ else
+ R := Context.BlockLen - Idx; // ܻʣ
+
+ FillChar(Context.Block[Idx], SizeOf(Context.Block) - Idx, 0); // ȷβΪ 0
+ Move(Input^, Context.Block[Idx], R); // Block ǰ벿ֲ
+
+ if (Idx + R) < Context.BlockLen then // ûֲ
+ begin // ֻ Index λָ
+ Idx := Idx + R;
+ Break;
+ end;
+
+ SHA3_Transform(Context);
+ Dec(ByteLength, R);
+ Idx := 0;
+ Inc(Input, R);
+ until False;
+ Context.Index := Idx;
+end;
+
+procedure SHA3UpdateW(var Context: TCnSHA3Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ Content: PAnsiChar;
+ Len: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(Content, CharLength * SizeOf(WideChar));
+ try
+ Len := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(Content), CharLength * SizeOf(WideChar), nil, nil);
+ SHA3Update(Context, Content, Len);
+ finally
+ FreeMem(Content);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ SHA3Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+// SHA3_224/256/384/512 ר
+procedure SHA3Final(var Context: TCnSHA3Context; var Digest: TCnSHA3GeneralDigest); overload;
+begin
+ Context.Block[Context.Index] := 6;
+ Context.Block[Context.BlockLen - 1] := Context.Block[Context.BlockLen - 1] or $80;
+ SHA3_Transform(Context);
+ Move(Context.State[0], Digest[0], Context.DigestLen);
+end;
+
+// SHAKE128 SHAKE256 ר
+procedure SHA3Final(var Context: TCnSHA3Context; out Digest: TBytes); overload;
+var
+ Idx, DL: Cardinal;
+begin
+ Context.Block[Context.Index] := $1F;
+ Context.Block[Context.BlockLen - 1] := Context.Block[Context.BlockLen - 1] or $80;
+ SHA3_Transform(Context);
+
+ SetLength(Digest, Context.DigestLen);
+ if Context.DigestLen <= Context.BlockLen then
+ Move(Context.State[0], Digest[0], Context.DigestLen)
+ else
+ begin
+ DL := Context.DigestLen;
+ Idx := 0;
+
+ while DL >= Context.BlockLen do
+ begin
+ Move(Context.State[0], Digest[Idx], Context.BlockLen);
+ Inc(Idx, Context.BlockLen);
+ Dec(DL, Context.BlockLen);
+
+ if DL > 0 then
+ begin
+ FillChar(Context.Block[0], SizeOf(Context.Block), 0);
+ SHA3_Transform(Context);
+ end;
+ end;
+
+ if DL > 0 then
+ Move(Context.State[0], Digest[Idx], DL);
+ end;
+end;
+
+function SHAKE3Squeeze(var Context: TCnSHA3Context; DigestByteLength: Integer): TBytes;
+var
+ Idx, DL: Cardinal;
+ BlockLen: Cardinal;
+ BytesToCopy: Cardinal;
+begin
+ if DigestByteLength <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ BlockLen := Context.BlockLen;
+
+ // ǵһν룬 Absorb
+ if Context.Squeezed = 0 then
+ begin
+ Context.Block[Context.Index] := $1F;
+ Context.Block[Context.BlockLen - 1] := Context.Block[Context.BlockLen - 1] or $80;
+ SHA3_Transform(Context);
+ Context.Squeezed := 1; // Ѿս
+ Context.SqueezeCount := 0; // üѹ
+ end;
+
+ // ʼ
+ SetLength(Result, DigestByteLength);
+ DL := DigestByteLength;
+ Idx := 0;
+
+ // ӵǰ״̬ȡ
+ while DL > 0 do
+ begin
+ // 㵱ǰʣȡֽ
+ BytesToCopy := BlockLen - Context.SqueezeCount;
+ if BytesToCopy > DL then
+ BytesToCopy := DL;
+
+ // ״̬ȡ
+ Move(PByteArray(@Context.State[0])[Context.SqueezeCount], Result[Idx], BytesToCopy);
+
+ // ¼ָ
+ Inc(Context.SqueezeCount, BytesToCopy);
+ Inc(Idx, BytesToCopy);
+ Dec(DL, BytesToCopy);
+
+ // ǰ꣬Ҫ任״̬ȡһ
+ if (DL > 0) and (Context.SqueezeCount >= BlockLen) then
+ begin
+ FillChar(Context.Block[0], SizeOf(Context.Block), 0);
+ SHA3_Transform(Context);
+ Context.SqueezeCount := 0; // Ϊµ״̬Ŀʼ
+ end;
+ end;
+end;
+
+procedure SHA3_224Init(var Context: TCnSHA3Context);
+begin
+ SHA3Init(Context, stSHA3_224);
+end;
+
+procedure SHA3_224Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_224Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_224Digest);
+var
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Final(Context, Res);
+ Move(Res[0], Digest[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+procedure SHA3_256Init(var Context: TCnSHA3Context);
+begin
+ SHA3Init(Context, stSHA3_256);
+end;
+
+procedure SHA3_256Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_256Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_256Digest);
+var
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Final(Context, Res);
+ Move(Res[0], Digest[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+procedure SHA3_384Init(var Context: TCnSHA3Context);
+begin
+ SHA3Init(Context, stSHA3_384);
+end;
+
+procedure SHA3_384Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_384Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_384Digest);
+var
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Final(Context, Res);
+ Move(Res[0], Digest[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+procedure SHA3_512Init(var Context: TCnSHA3Context);
+begin
+ SHA3Init(Context, stSHA3_512);
+end;
+
+procedure SHA3_512Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_512Final(var Context: TCnSHA3Context; var Digest: TCnSHA3_512Digest);
+var
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Final(Context, Res);
+ Move(Res[0], Digest[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+procedure SHAKE128Init(var Context: TCnSHA3Context; DigestByteLength: Cardinal);
+begin
+ SHA3Init(Context, stSHAKE128, DigestByteLength);
+end;
+
+procedure SHAKE128Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHAKE128Absorb(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHAKE128Final(var Context: TCnSHA3Context; out Digest: TBytes);
+begin
+ SHA3Final(Context, Digest);
+end;
+
+function SHAKE128Squeeze(var Context: TCnSHA3Context; DigestByteLength: Integer): TBytes;
+begin
+ Result := SHAKE3Squeeze(Context, DigestByteLength);
+end;
+
+procedure SHAKE256Init(var Context: TCnSHA3Context; DigestByteLength: Cardinal);
+begin
+ SHA3Init(Context, stSHAKE256, DigestByteLength);
+end;
+
+procedure SHAKE256Update(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHAKE256Absorb(var Context: TCnSHA3Context; Input: PAnsiChar; ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHAKE256Final(var Context: TCnSHA3Context; out Digest: TBytes);
+begin
+ SHA3Final(Context, Digest);
+end;
+
+function SHAKE256Squeeze(var Context: TCnSHA3Context; DigestByteLength: Integer): TBytes;
+begin
+ Result := SHAKE3Squeeze(Context, DigestByteLength);
+end;
+
+// ݿ SHA3_224λ
+function SHA3_224(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, Input, ByteLength);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_256λ
+function SHA3_256(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, Input, ByteLength);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_384λ
+function SHA3_384(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, Input, ByteLength);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_512λ
+function SHA3_512(Input: PAnsiChar; ByteLength: Cardinal): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, Input, ByteLength);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_224
+function SHA3_224Buffer(const Buffer; Count: Cardinal): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, PAnsiChar(@Buffer), Count);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_256
+function SHA3_256Buffer(const Buffer; Count: Cardinal): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, PAnsiChar(@Buffer), Count);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_384
+function SHA3_384Buffer(const Buffer; Count: Cardinal): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, PAnsiChar(@Buffer), Count);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHA3_512
+function SHA3_512Buffer(const Buffer; Count: Cardinal): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, PAnsiChar(@Buffer), Count);
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// ݿ SHAKE128
+function SHAKE128Buffer(const Buffer; Count: Cardinal; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE128Init(Context, DigestByteLength);
+ SHAKE128Update(Context, PAnsiChar(@Buffer), Count);
+ SHAKE128Final(Context, Result);
+end;
+
+// ݿ SHAKE256
+function SHAKE256Buffer(const Buffer; Count: Cardinal; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE256Init(Context, DigestByteLength);
+ SHAKE256Update(Context, PAnsiChar(@Buffer), Count);
+ SHAKE256Final(Context, Result);
+end;
+
+// ֽ SHA3_224
+function SHA3_224Bytes(const Data: TBytes): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// ֽ SHA3_256
+function SHA3_256Bytes(const Data: TBytes): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// ֽ SHA3_384
+function SHA3_384Bytes(const Data: TBytes): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// ֽ SHA3_512
+function SHA3_512Bytes(const Data: TBytes): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// ֽ SHAKE128
+function SHAKE128Bytes(const Data: TBytes; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE128Init(Context, DigestByteLength);
+ SHAKE128Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHAKE128Final(Context, Result);
+end;
+
+// ֽ SHAKE256
+function SHAKE256Bytes(const Data: TBytes; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE256Init(Context, DigestByteLength);
+ SHAKE256Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHAKE256Final(Context, Result);
+end;
+
+// String ݽ SHA3_224
+function SHA3_224String(const Str: string): TCnSHA3_224Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA3_224StringA(AStr);
+end;
+
+// String ݽ SHA3_256
+function SHA3_256String(const Str: string): TCnSHA3_256Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA3_256StringA(AStr);
+end;
+
+// String ݽ SHA3_384
+function SHA3_384String(const Str: string): TCnSHA3_384Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA3_384StringA(AStr);
+end;
+
+// String ݽ SHA3_512
+function SHA3_512String(const Str: string): TCnSHA3_512Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHA3_512StringA(AStr);
+end;
+
+// String ݽ SHAKE128
+function SHAKE128String(const Str: string; DigestByteLength: Cardinal): TBytes;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHAKE128StringA(AStr, DigestByteLength);
+end;
+
+// String ݽ SHAKE256
+function SHAKE256String(const Str: string; DigestByteLength: Cardinal): TBytes;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SHAKE256StringA(AStr, DigestByteLength);
+end;
+
+// UnicodeString ݽֱӵ SHA3_224 㣬ת
+{$IFDEF UNICODE}
+function SHA3_224UnicodeString(const Str: string): TCnSHA3_224Digest;
+{$ELSE}
+function SHA3_224UnicodeString(const Str: WideString): TCnSHA3_224Digest;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// UnicodeString ݽֱӵ SHA3_256 㣬ת
+{$IFDEF UNICODE}
+function SHA3_256UnicodeString(const Str: string): TCnSHA3_256Digest;
+{$ELSE}
+function SHA3_256UnicodeString(const Str: WideString): TCnSHA3_256Digest;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// UnicodeString ݽֱӵ SHA3_384 㣬ת
+{$IFDEF UNICODE}
+function SHA3_384UnicodeString(const Str: string): TCnSHA3_384Digest;
+{$ELSE}
+function SHA3_384UnicodeString(const Str: WideString): TCnSHA3_384Digest;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// UnicodeString ݽֱӵ SHA3_512 㣬ת
+{$IFDEF UNICODE}
+function SHA3_512UnicodeString(const Str: string): TCnSHA3_512Digest;
+{$ELSE}
+function SHA3_512UnicodeString(const Str: WideString): TCnSHA3_512Digest;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// UnicodeString ݽֱӵ SHAKE128 㣬ת
+{$IFDEF UNICODE}
+function SHAKE128UnicodeString(const Str: string; DigestByteLength: Cardinal): TBytes;
+{$ELSE}
+function SHAKE128UnicodeString(const Str: WideString; DigestByteLength: Cardinal): TBytes;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE128Init(Context, DigestByteLength);
+ SHAKE128Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHAKE128Final(Context, Result);
+end;
+
+// UnicodeString ݽֱӵ SHAKE256 㣬ת
+{$IFDEF UNICODE}
+function SHAKE256UnicodeString(const Str: string; DigestByteLength: Cardinal): TBytes;
+{$ELSE}
+function SHAKE256UnicodeString(const Str: WideString; DigestByteLength: Cardinal): TBytes;
+{$ENDIF}
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE256Init(Context, DigestByteLength);
+ SHAKE256Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SHAKE256Final(Context, Result);
+end;
+
+// AnsiString ݽSHA224
+function SHA3_224StringA(const Str: AnsiString): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, PAnsiChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// WideString ݽ SHA3_224
+function SHA3_224StringW(const Str: WideString): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_224);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_224_OUTPUT_LENGTH_BYTE);
+end;
+
+// AnsiString ݽ SHA3_256
+function SHA3_256StringA(const Str: AnsiString): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, PAnsiChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// WideString ݽ SHA3_256
+function SHA3_256StringW(const Str: WideString): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_256);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_256_OUTPUT_LENGTH_BYTE);
+end;
+
+// AnsiString ݽ SHA3_384
+function SHA3_384StringA(const Str: AnsiString): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, PAnsiChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// WideString ݽ SHA3_384
+function SHA3_384StringW(const Str: WideString): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_384);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_384_OUTPUT_LENGTH_BYTE);
+end;
+
+// AnsiString ݽ SHA3_512
+function SHA3_512StringA(const Str: AnsiString): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, PAnsiChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// WideString ݽ SHA3_512
+function SHA3_512StringW(const Str: WideString): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Res: TCnSHA3GeneralDigest;
+begin
+ SHA3Init(Context, stSHA3_512);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str));
+ SHA3Final(Context, Res);
+ Move(Res[0], Result[0], SHA3_512_OUTPUT_LENGTH_BYTE);
+end;
+
+// AnsiString ݽ SHAKE128
+function SHAKE128StringA(const Str: AnsiString; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE128Init(Context, DigestByteLength);
+ SHAKE128Update(Context, PAnsiChar(Str), Length(Str));
+ SHAKE128Final(Context, Result);
+end;
+
+// WideString ݽ SHAKE128
+function SHAKE128StringW(const Str: WideString; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE128Init(Context, DigestByteLength);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str)); // SHAKE128UpdateW = SHA3UpdateW
+ SHAKE128Final(Context, Result);
+end;
+
+// AnsiString ݽ SHAKE256
+function SHAKE256StringA(const Str: AnsiString; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE256Init(Context, DigestByteLength);
+ SHAKE256Update(Context, PAnsiChar(Str), Length(Str));
+ SHAKE256Final(Context, Result);
+end;
+
+// WideString ݽ SHAKE256
+function SHAKE256StringW(const Str: WideString; DigestByteLength: Cardinal): TBytes;
+var
+ Context: TCnSHA3Context;
+begin
+ SHAKE256Init(Context, DigestByteLength);
+ SHA3UpdateW(Context, PWideChar(Str), Length(Str)); // SHAKE256UpdateW = SHA3UpdateW
+ SHAKE256Final(Context, Result);
+end;
+
+// SHA3Type ֻ stSHA3_224, stSHA3_256, stSHA3_384, stSHA3_512
+function InternalSHA3Stream(Stream: TStream; const BufSize: Cardinal; var D:
+ TCnSHA3GeneralDigest; SHA3Type: TSHA3Type; CallBack: TCnSHA3CalcProgressFunc): Boolean; overload;
+var
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+ Context: TCnSHA3Context;
+begin
+ Result := False;
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ if Size = 0 then
+ Exit;
+ if Size < BufSize then
+ BufLen := Size
+ else
+ BufLen := BufSize;
+
+ CancelCalc := False;
+ SHA3Init(Context, SHA3Type);
+
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ SHA3Update(Context, Buf, ReadBytes);
+
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then
+ Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ SHA3Final(Context, D);
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+// SHA3Type ֻ stSHAKE128 stSHAKE256
+function InternalSHA3Stream(Stream: TStream; const BufSize: Cardinal;
+ SHA3Type: TSHA3Type; DigestByteLength: Cardinal; out D: TBytes;
+ CallBack: TCnSHA3CalcProgressFunc): Boolean; overload;
+var
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+ Context: TCnSHA3Context;
+begin
+ Result := False;
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ if Size = 0 then
+ Exit;
+ if Size < BufSize then
+ BufLen := Size
+ else
+ BufLen := BufSize;
+
+ CancelCalc := False;
+ SHA3Init(Context, SHA3Type, DigestByteLength);
+
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ SHA3Update(Context, Buf, ReadBytes);
+
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then
+ Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ SHA3Final(Context, D);
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+// ָ SHA3_224
+function SHA3_224Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_224Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, Dig, stSHA3_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_224Digest));
+end;
+
+// ָ SHA3_256
+function SHA3_256Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_256Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, Dig, stSHA3_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_256Digest));
+end;
+
+// ָ SHA3_384
+function SHA3_384Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_384Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, Dig, stSHA3_384, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_384Digest));
+end;
+
+// ָ SHA3_512
+function SHA3_512Stream(Stream: TStream; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_512Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, Dig, stSHA3_512, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_512Digest));
+end;
+
+// ָӴճȿɱ SHAKE128
+function SHAKE128Stream(Stream: TStream; DigestByteLength: Cardinal;
+ CallBack: TCnSHA3CalcProgressFunc): TBytes;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, stSHAKE128, DigestByteLength, Result, CallBack);
+end;
+
+// ָӴճȿɱ SHAKE256
+function SHAKE256Stream(Stream: TStream; DigestByteLength: Cardinal;
+ CallBack: TCnSHA3CalcProgressFunc): TBytes;
+begin
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, stSHAKE256, DigestByteLength, Result, CallBack);
+end;
+
+function FileSizeIsLargeThanMaxOrCanNotMap(const AFileName: string; out IsEmpty: Boolean): Boolean;
+{$IFDEF MSWINDOWS}
+var
+ H: THandle;
+ Info: BY_HANDLE_FILE_INFORMATION;
+ Rec: Int64Rec;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ Result := False;
+ IsEmpty := False;
+ H := CreateFile(PChar(AFileName), GENERIC_READ, FILE_SHARE_READ, nil,
+ OPEN_EXISTING, 0, 0);
+ if H = INVALID_HANDLE_VALUE then
+ Exit;
+ try
+ if not GetFileInformationByHandle(H, Info) then
+ Exit;
+ finally
+ CloseHandle(H);
+ end;
+ Rec.Lo := Info.nFileSizeLow;
+ Rec.Hi := Info.nFileSizeHigh;
+ Result := (Rec.Hi > 0) or (Rec.Lo > MAX_FILE_SIZE);
+ IsEmpty := (Rec.Hi = 0) and (Rec.Lo = 0);
+{$ELSE}
+ Result := True; // Windows ƽ̨ Trueʾ Mapping
+{$ENDIF}
+end;
+
+function InternalSHA3File(const FileName: string; SHA3Type: TSHA3Type;
+ CallBack: TCnSHA3CalcProgressFunc): TCnSHA3GeneralDigest; overload;
+var
+{$IFDEF MSWINDOWS}
+ Context: TCnSHA3Context;
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, Result, SHA3Type, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ SHA3Init(Context, SHA3Type);
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ SHA3Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ SHA3Final(Context, Result);
+{$ENDIF}
+ end;
+end;
+
+function InternalSHA3File(const FileName: string; SHA3Type: TSHA3Type;
+ DigestByteLength: Cardinal; CallBack: TCnSHA3CalcProgressFunc): TBytes; overload;
+var
+{$IFDEF MSWINDOWS}
+ Context: TCnSHA3Context;
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalSHA3Stream(Stream, STREAM_BUF_SIZE, SHA3Type, DigestByteLength, Result, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ SHA3Init(Context, SHA3Type, DigestByteLength);
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ SHA3Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ SHA3Final(Context, Result);
+{$ENDIF}
+ end;
+end;
+
+// ָļݽ SHA3_224
+function SHA3_224File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_224Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ Dig := InternalSHA3File(FileName, stSHA3_224, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_224Digest));
+end;
+
+// ָļݽ SHA3_256
+function SHA3_256File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_256Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ Dig := InternalSHA3File(FileName, stSHA3_256, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_256Digest));
+end;
+
+// ָļݽ SHA3_384
+function SHA3_384File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_384Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ Dig := InternalSHA3File(FileName, stSHA3_384, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_384Digest));
+end;
+
+// ָļݽ SHA3_512
+function SHA3_512File(const FileName: string; CallBack: TCnSHA3CalcProgressFunc):
+ TCnSHA3_512Digest;
+var
+ Dig: TCnSHA3GeneralDigest;
+begin
+ Dig := InternalSHA3File(FileName, stSHA3_512, CallBack);
+ Move(Dig[0], Result[0], SizeOf(TCnSHA3_512Digest));
+end;
+
+// ָļݽӴճȿɱ SHAKE128
+function SHAKE128File(const FileName: string; DigestByteLength: Cardinal;
+ CallBack: TCnSHA3CalcProgressFunc): TBytes;
+begin
+ Result := InternalSHA3File(FileName, stSHAKE128, DigestByteLength, CallBack);
+end;
+
+// ָļݽӴճȿɱ SHAKE256
+function SHAKE256File(const FileName: string; DigestByteLength: Cardinal;
+ CallBack: TCnSHA3CalcProgressFunc): TBytes;
+begin
+ Result := InternalSHA3File(FileName, stSHAKE256, DigestByteLength, CallBack);
+end;
+
+// ʮƸʽ SHA3_224 Ӵֵ
+function SHA3_224Print(const Digest: TCnSHA3_224Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA3_224Digest));
+end;
+
+// ʮƸʽ SHA3_256 Ӵֵ
+function SHA3_256Print(const Digest: TCnSHA3_256Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA3_256Digest));
+end;
+
+// ʮƸʽ SHA3_384 Ӵֵ
+function SHA3_384Print(const Digest: TCnSHA3_384Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA3_384Digest));
+end;
+
+// ʮƸʽ SHA3_512 Ӵֵ
+function SHA3_512Print(const Digest: TCnSHA3_512Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSHA3_512Digest));
+end;
+
+// ʮƸʽ SHAKE128 Ӵֵ
+function SHAKE128Print(const Digest: TBytes): string;
+begin
+ Result := BytesToHex(Digest);
+end;
+
+// ʮƸʽ SHAKE256 Ӵֵ
+function SHAKE256Print(const Digest: TBytes): string;
+begin
+ Result := BytesToHex(Digest);
+end;
+
+// Ƚ SHA3_224 ӴֵǷ
+function SHA3_224Match(const D1, D2: TCnSHA3_224Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSHA3_224Digest));
+end;
+
+// Ƚ SHA3_256 ӴֵǷ
+function SHA3_256Match(const D1, D2: TCnSHA3_256Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSHA3_256Digest));
+end;
+
+// Ƚ SHA3_384 ӴֵǷ
+function SHA3_384Match(const D1, D2: TCnSHA3_384Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSHA3_384Digest));
+end;
+
+// Ƚ SHA3_512 ӴֵǷ
+function SHA3_512Match(const D1, D2: TCnSHA3_512Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSHA3_512Digest));
+end;
+
+// Ƚ SHAKE128 ӴֵǷ
+function SHAKE128Match(const D1, D2: TBytes): Boolean;
+begin
+ Result := ConstTimeCompareBytes(D1, D2);
+end;
+
+// Ƚ SHAKE256 ӴֵǷ
+function SHAKE256Match(const D1, D2: TBytes): Boolean;
+begin
+ Result := ConstTimeCompareBytes(D1, D2);
+end;
+
+// SHA3_224 Ӵֵת string
+function SHA3_224DigestToStr(const Digest: TCnSHA3_224Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA3_224Digest));
+end;
+
+// SHA3_256 Ӵֵת string
+function SHA3_256DigestToStr(const Digest: TCnSHA3_256Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA3_256Digest));;
+end;
+
+// SHA3_384 Ӵֵת string
+function SHA3_384DigestToStr(const Digest: TCnSHA3_384Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA3_384Digest));
+end;
+
+// SHA3_512 Ӵֵת string
+function SHA3_512DigestToStr(const Digest: TCnSHA3_512Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSHA3_512Digest));
+end;
+
+// SHAKE128 Ӵֵת string
+function SHAKE128DigestToStr(const Digest: TBytes): string;
+begin
+ Result := BytesToString(Digest);
+end;
+
+// SHAKE256 Ӵֵת string
+function SHAKE256DigestToStr(const Digest: TBytes): string;
+begin
+ Result := BytesToString(Digest);
+end;
+
+procedure SHA3_224HmacInit(var Context: TCnSHA3Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA3_224Digest;
+begin
+ if KeyLength > HMAC_SHA3_224_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA3_224Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA3_224_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA3_224_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA3_224_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, @(Context.Ipad[0]), HMAC_SHA3_224_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA3_256HmacInit(var Context: TCnSHA3Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA3_256Digest;
+begin
+ if KeyLength > HMAC_SHA3_256_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA3_256Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA3_256_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA3_256_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA3_256_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, @(Context.Ipad[0]), HMAC_SHA3_256_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA3_384HmacInit(var Context: TCnSHA3Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA3_384Digest;
+begin
+ if KeyLength > HMAC_SHA3_384_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA3_384Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA3_384_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA3_384_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA3_384_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, @(Context.Ipad[0]), HMAC_SHA3_384_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA3_512HmacInit(var Context: TCnSHA3Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSHA3_512Digest;
+begin
+ if KeyLength > HMAC_SHA3_512_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SHA3_512Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SHA3_512_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SHA3_512_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SHA3_512_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, @(Context.Ipad[0]), HMAC_SHA3_512_BLOCK_SIZE_BYTE);
+end;
+
+procedure SHA3_224HmacUpdate(var Context: TCnSHA3Context; Input: PAnsiChar;
+ ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_256HmacUpdate(var Context: TCnSHA3Context; Input: PAnsiChar;
+ ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_384HmacUpdate(var Context: TCnSHA3Context; Input: PAnsiChar;
+ ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_512HmacUpdate(var Context: TCnSHA3Context; Input: PAnsiChar;
+ ByteLength: Cardinal);
+begin
+ SHA3Update(Context, Input, ByteLength);
+end;
+
+procedure SHA3_224HmacFinal(var Context: TCnSHA3Context; var Output: TCnSHA3GeneralDigest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA3GeneralDigest;
+begin
+ Len := HMAC_SHA3_224_OUTPUT_LENGTH_BYTE;
+ SHA3Final(Context, TmpBuf);
+ SHA3Init(Context, stSHA3_224);
+ SHA3Update(Context, @(Context.Opad[0]), HMAC_SHA3_224_BLOCK_SIZE_BYTE);
+ SHA3Update(Context, @(TmpBuf[0]), Len);
+ SHA3Final(Context, Output);
+end;
+
+procedure SHA3_256HmacFinal(var Context: TCnSHA3Context; var Output: TCnSHA3GeneralDigest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA3GeneralDigest;
+begin
+ Len := HMAC_SHA3_256_OUTPUT_LENGTH_BYTE;
+ SHA3Final(Context, TmpBuf);
+ SHA3Init(Context, stSHA3_256);
+ SHA3Update(Context, @(Context.Opad[0]), HMAC_SHA3_256_BLOCK_SIZE_BYTE);
+ SHA3Update(Context, @(TmpBuf[0]), Len);
+ SHA3Final(Context, Output);
+end;
+
+procedure SHA3_384HmacFinal(var Context: TCnSHA3Context; var Output: TCnSHA3GeneralDigest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA3GeneralDigest;
+begin
+ Len := HMAC_SHA3_384_OUTPUT_LENGTH_BYTE;
+ SHA3Final(Context, TmpBuf);
+ SHA3Init(Context, stSHA3_384);
+ SHA3Update(Context, @(Context.Opad[0]), HMAC_SHA3_384_BLOCK_SIZE_BYTE);
+ SHA3Update(Context, @(TmpBuf[0]), Len);
+ SHA3Final(Context, Output);
+end;
+
+procedure SHA3_512HmacFinal(var Context: TCnSHA3Context; var Output: TCnSHA3GeneralDigest);
+var
+ Len: Integer;
+ TmpBuf: TCnSHA3GeneralDigest;
+begin
+ Len := HMAC_SHA3_512_OUTPUT_LENGTH_BYTE;
+ SHA3Final(Context, TmpBuf);
+ SHA3Init(Context, stSHA3_512);
+ SHA3Update(Context, @(Context.Opad[0]), HMAC_SHA3_512_BLOCK_SIZE_BYTE);
+ SHA3Update(Context, @(TmpBuf[0]), Len);
+ SHA3Final(Context, Output);
+end;
+
+procedure SHA3_224Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_224Digest);
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_224HmacInit(Context, Key, KeyByteLength);
+ SHA3_224HmacUpdate(Context, Input, ByteLength);
+ SHA3_224HmacFinal(Context, Dig);
+ Move(Dig[0], Output[0], Context.DigestLen);
+end;
+
+procedure SHA3_256Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_256Digest);
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_256HmacInit(Context, Key, KeyByteLength);
+ SHA3_256HmacUpdate(Context, Input, ByteLength);
+ SHA3_256HmacFinal(Context, Dig);
+ Move(Dig[0], Output[0], Context.DigestLen);
+end;
+
+procedure SHA3_384Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_384Digest);
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_384HmacInit(Context, Key, KeyByteLength);
+ SHA3_384HmacUpdate(Context, Input, ByteLength);
+ SHA3_384HmacFinal(Context, Dig);
+ Move(Dig[0], Output[0], Context.DigestLen);
+end;
+
+procedure SHA3_512Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSHA3_512Digest);
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_512HmacInit(Context, Key, KeyByteLength);
+ SHA3_512HmacUpdate(Context, Input, ByteLength);
+ SHA3_512HmacFinal(Context, Dig);
+ Move(Dig[0], Output[0], Context.DigestLen);
+end;
+
+function SHA3_224HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_224Digest;
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_224HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA3_224HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3_224HmacFinal(Context, Dig);
+ Move(Dig[0], Result[0], Context.DigestLen);
+end;
+
+function SHA3_256HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_256Digest;
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_256HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA3_256HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3_256HmacFinal(Context, Dig);
+ Move(Dig[0], Result[0], Context.DigestLen);
+end;
+
+function SHA3_384HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_384Digest;
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_384HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA3_384HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3_384HmacFinal(Context, Dig);
+ Move(Dig[0], Result[0], Context.DigestLen);
+end;
+
+function SHA3_512HmacBytes(const Key: TBytes; const Data: TBytes): TCnSHA3_512Digest;
+var
+ Context: TCnSHA3Context;
+ Dig: TCnSHA3GeneralDigest;
+begin
+ SHA3_512HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SHA3_512HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SHA3_512HmacFinal(Context, Dig);
+ Move(Dig[0], Result[0], Context.DigestLen);
+end;
+
+end.
diff --git a/CnPack/Crypto/CnSM3.pas b/CnPack/Crypto/CnSM3.pas
new file mode 100644
index 0000000..c8623de
--- /dev/null
+++ b/CnPack/Crypto/CnSM3.pas
@@ -0,0 +1,842 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnSM3;
+{* |
+================================================================================
+* ƣ
+* Ԫƣ SM3 Ӵ㷨ʵֵԪ
+* ԪߣCnPack 飨master@cnpack.org)
+* ο㷨ĵSM3 Cryptographic Hash Algorith
+* http://www.oscca.gov.cn/UpFile/20101222141857786.pdf
+* ο˲ goldboar C
+* עԪʵ˹ SM3 Ӵ㷨Ӧ HMAC 㷨
+* ʵֹ̲ο㷨ĵSM3 Cryptographic Hash Algorith
+* ƽ̨Windows 7 + Delphi 5.0
+* ݲԣPWin9X/2000/XP/7 + Delphi 5/6
+* õԪеַϱػʽ
+* ļ¼2019.12.12 V1.2
+* ֧ TBytes
+* 2019.04.15 V1.1
+* ֧ Win32/Win64/MacOS
+* 2014.09.23 V1.0
+* ֲԪ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, CnNative, CnConsts {$IFDEF MSWINDOWS}, Windows {$ENDIF};
+
+type
+ PCnSM3Digest = ^TCnSM3Digest;
+ {* SM3 Ӵսָ}
+ TCnSM3Digest = array[0..31] of Byte;
+ {* SM3 Ӵս32 ֽ}
+
+ TCnSM3Context = packed record
+ {* SM3 Ľṹ}
+ Total: array[0..1] of Cardinal; {!< number of bytes processed }
+ State: array[0..7] of Cardinal; {!< intermediate digest state }
+ Buffer: array[0..63] of Byte; {!< data block being processed }
+ Ipad: array[0..63] of Byte; {!< HMAC: inner padding }
+ Opad: array[0..63] of Byte; {!< HMAC: outer padding }
+ end;
+ PCnSM3Context = ^TCnSM3Context;
+
+ TCnSM3CalcProgressFunc = procedure (ATotal, AProgress: Int64;
+ var Cancel: Boolean) of object;
+ {* SM3 ӴսȻص¼}
+
+function SM3(Input: PAnsiChar; ByteLength: Cardinal): TCnSM3Digest;
+{* ݿ SM3 㡣
+
+
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3Buffer(const Buffer; Count: Cardinal): TCnSM3Digest;
+{* ݿ SM3 㡣
+
+
+ const Buffer - ݿ
+ Count: Cardinal - ݿֽڳ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3Bytes(const Data: TBytes): TCnSM3Digest;
+{* ֽ SM3 㡣
+
+
+ const Data: TBytes - ֽ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3String(const Str: string): TCnSM3Digest;
+{* String ݽ SM3 㣬ע D2009 ϰ汾 string Ϊ UnicodeString
+ лὫǿת AnsiString м㡣
+
+
+ const Str: string - ַ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3StringA(const Str: AnsiString): TCnSM3Digest;
+{* AnsiString ݽ SM3 㡣
+
+
+ const Str: AnsiString - ַ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3StringW(const Str: WideString): TCnSM3Digest;
+{* WideString ַת SM3 㡣
+ ǰ Windows » WideCharToMultyByte תΪ AnsiString ͣ
+ ƽֱ̨תΪ AnsiString ͣٽм㡣
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+{$IFDEF UNICODE}
+
+function SM3UnicodeString(const Str: string): TCnSM3Digest;
+{* UnicodeString ݽֱӵ SM3 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: string - Ŀַ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+{$ELSE}
+
+function SM3UnicodeString(const Str: WideString): TCnSM3Digest;
+{* UnicodeString ݽֱӵ SM3 㣬ֱӼڲ UTF16 ݣת
+
+
+ const Str: WideString - Ŀַ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+{$ENDIF}
+
+function SM3File(const FileName: string; CallBack: TCnSM3CalcProgressFunc = nil): TCnSM3Digest;
+{* ָļݽ SM3 㡣
+
+
+ const FileName: string - ļ
+ CallBack: TCnSM3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+function SM3Stream(Stream: TStream; CallBack: TCnSM3CalcProgressFunc = nil): TCnSM3Digest;
+{* ָݽ SM3 㡣
+
+
+ Stream: TStream -
+ CallBack: TCnSM3CalcProgressFunc - ȻصĬΪ
+
+ ֵTCnSM3Digest - ص SM3 Ӵֵ
+}
+
+// ⲿݽɢ SM3 㣬SM3Update ɶα
+
+procedure SM3Init(var Context: TCnSM3Context);
+{* ʼһ SM3 ģ SM3
+
+
+ var Context: TCnSM3Context - ʼ SM3
+
+ ֵޣ
+}
+
+procedure SM3Update(var Context: TCnSM3Context; Input: PAnsiChar; ByteLength: Cardinal);
+{* ԳʼĶһݽ SM3 㡣
+ ɶε㲻ͬݿ飬轫ͬݿƴڴС
+
+
+ var Context: TCnSM3Context - SM3
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+
+ ֵޣ
+}
+
+procedure SM3Final(var Context: TCnSM3Context; var Digest: TCnSM3Digest);
+{* ּ㣬 SM3 Digest
+
+
+ var Context: TCnSM3Context - SM3
+ var Digest: TCnSM3Digest - ص SM3 Ӵֵ
+
+ ֵޣ
+}
+
+function SM3Print(const Digest: TCnSM3Digest): string;
+{* ʮƸʽ SM3 Ӵֵ
+
+
+ const Digest: TCnSM3Digest - ָ SM3 Ӵֵ
+
+ ֵstring - ʮַ
+}
+
+function SM3Match(const D1: TCnSM3Digest; const D2: TCnSM3Digest): Boolean;
+{* Ƚ SM3 ӴֵǷȡ
+
+
+ const D1: TCnSM3Digest - Ƚϵ SM3 Ӵֵһ
+ const D2: TCnSM3Digest - Ƚϵ SM3 Ӵֵ
+
+ ֵBoolean - Ƿ
+}
+
+function SM3DigestToStr(const Digest: TCnSM3Digest): string;
+{* SM3 Ӵֱֵת stringÿֽڶӦһַ
+
+
+ const Digest: TCnSM3Digest - ת SM3 Ӵֵ
+
+ ֵstring - صַ
+}
+
+procedure SM3Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSM3Digest);
+{* SM3 HMACHash-based Message Authentication Code㣬
+ ͨݵļϼԿĸҲмΡ
+
+
+ Key: PAnsiChar - SM3 Կݿַ
+ KeyByteLength: Integer - SM3 Կݿֽڳ
+ Input: PAnsiChar - ݿַ
+ ByteLength: Cardinal - ݿֽڳ
+ var Output: TCnSM3Digest - ص SM3 Ӵֵ
+
+ ֵޣ
+}
+
+function SM3HmacBytes(const Key: TBytes; const Data: TBytes): TCnSM3Digest;
+{* ֽл MD5 HMAC 㡣
+
+
+ const Key: TBytes - SM3 Կֽ
+ const Data: TBytes - ֽ
+
+ ֵTCnMD5Digest - ص SM3 Ӵֵ
+}
+
+implementation
+
+const
+ SM3Padding: array[0..63] of Byte =
+ (
+ $80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+ );
+
+ SM3_T: array[0..63] of Cardinal = (
+ $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519,
+ $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519, $79CC4519,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A,
+ $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A, $7A879D8A
+ );
+
+ MAX_FILE_SIZE = 512 * 1024 * 1024;
+ // If file size <= this size (bytes), using Mapping, else stream
+
+ HMAC_SM3_BLOCK_SIZE_BYTE = 64;
+ HMAC_SM3_OUTPUT_LENGTH_BYTE = 32;
+
+type
+ TSM3ProcessData = array[0..63] of Byte;
+
+procedure GetULongBe(var N: Cardinal; B: PAnsiChar; I: Integer); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+var
+ D: Cardinal;
+begin
+ D := (Cardinal(B[I]) shl 24) or (Cardinal(B[I + 1]) shl 16) or
+ (Cardinal(B[I + 2]) shl 8) or (Cardinal(B[I + 3]));
+ N := D;
+end;
+
+procedure PutULongBe(N: Cardinal; B: PAnsiChar; I: Integer); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ B[I] := AnsiChar(N shr 24);
+ B[I + 1] := AnsiChar(N shr 16);
+ B[I + 2] := AnsiChar(N shr 8);
+ B[I + 3] := AnsiChar(N);
+end;
+
+function FF0(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor Y xor Z;
+end;
+
+function FF1(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) or (Y and Z) or (X and Z);
+end;
+
+function GG0(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor Y xor Z;
+end;
+
+function GG1(X, Y, Z: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and Y) or ((not X) and Z);
+end;
+
+function SM3Shl(X: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and $FFFFFFFF) shl N;
+end;
+
+// ѭơע N Ϊ 0 32 ʱֵΪ XN Ϊ 33 ʱֵ N Ϊ 1 ʱķֵ
+function ROTL(X: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := SM3Shl(X, N) or (X shr (32 - N));
+end;
+
+function P0(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor ROTL(X, 9) xor ROTL(X, 17);
+end;
+
+function P1(X: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X xor ROTL(X, 15) xor ROTL(X, 23);
+end;
+
+procedure SM3Init(var Context: TCnSM3Context);
+begin
+ Context.Total[0] := 0;
+ Context.Total[1] := 0;
+
+ Context.State[0] := $7380166F;
+ Context.State[1] := $4914B2B9;
+ Context.State[2] := $172442D7;
+ Context.State[3] := $DA8A0600;
+ Context.State[4] := $A96F30BC;
+ Context.State[5] := $163138AA;
+ Context.State[6] := $E38DEE4D;
+ Context.State[7] := $B0FB0E4E;
+
+ FillChar(Context.Buffer, SizeOf(Context.Buffer), 0);
+end;
+
+// һδ 64 ֽҲ 512 λݿ
+procedure SM3Process(var Context: TCnSM3Context; Data: PAnsiChar);
+var
+ SS1, SS2, TT1, TT2: Cardinal;
+ W: array[0..67] of Cardinal;
+ W1: array[0..63] of Cardinal;
+ A, B, C, D, E, F, G, H: Cardinal;
+ Temp1, Temp2: Cardinal;
+ J: Integer;
+begin
+ GetULongBe(W[ 0], Data, 0);
+ GetULongBe(W[ 1], Data, 4);
+ GetULongBe(W[ 2], Data, 8);
+ GetULongBe(W[ 3], Data, 12);
+ GetULongBe(W[ 4], Data, 16);
+ GetULongBe(W[ 5], Data, 20);
+ GetULongBe(W[ 6], Data, 24);
+ GetULongBe(W[ 7], Data, 28);
+ GetULongBe(W[ 8], Data, 32);
+ GetULongBe(W[ 9], Data, 36);
+ GetULongBe(W[10], Data, 40);
+ GetULongBe(W[11], Data, 44);
+ GetULongBe(W[12], Data, 48);
+ GetULongBe(W[13], Data, 52);
+ GetULongBe(W[14], Data, 56);
+ GetULongBe(W[15], Data, 60);
+
+ for J := 16 to 67 do
+ begin
+ Temp1 := W[J - 16] xor W[J - 9];
+ Temp2 := ROTL(W[J - 3], 15);
+ W[J] := P1(Temp1 xor Temp2) xor (ROTL(W[J - 13], 7) xor W[J - 6]);
+ end;
+
+ for J := 0 to 63 do
+ W1[J] := W[J] xor W[J + 4];
+
+ // ѾW/W1ֵ
+
+ A := Context.State[0];
+ B := Context.State[1];
+ C := Context.State[2];
+ D := Context.State[3];
+ E := Context.State[4];
+ F := Context.State[5];
+ G := Context.State[6];
+ H := Context.State[7];
+
+ for J := 0 to 15 do
+ begin
+ SS1 := ROTL((ROTL(A, 12) + E + ROTL(SM3_T[J], J)), 7);
+ SS2 := SS1 xor ROTL(A, 12);
+ TT1 := FF0(A, B, C) + D + SS2 + W1[J];
+ TT2 := GG0(E, F, G) + H + SS1 + W[J];
+ D := C;
+ C := ROTL(B, 9);
+ B := A;
+ A := TT1;
+ H := G;
+ G := ROTL(F, 19);
+ F := E;
+ E := P0(TT2);
+ end;
+
+ for J := 16 to 63 do
+ begin
+ SS1 := ROTL((ROTL(A, 12) + E + ROTL(SM3_T[J], J)), 7);
+ SS2 := SS1 xor ROTL(A, 12);
+ TT1 := FF1(A, B, C) + D + SS2 + W1[J];
+ TT2 := GG1(E, F, G) + H + SS1 + W[J];
+ D := C;
+ C := ROTL(B,9);
+ B := A;
+ A := TT1;
+ H := G;
+ G := ROTL(F,19);
+ F := E;
+ E := P0(TT2);
+ end;
+
+ Context.State[0] := Context.State[0] xor A;
+ Context.State[1] := Context.State[1] xor B;
+ Context.State[2] := Context.State[2] xor C;
+ Context.State[3] := Context.State[3] xor D;
+ Context.State[4] := Context.State[4] xor E;
+ Context.State[5] := Context.State[5] xor F;
+ Context.State[6] := Context.State[6] xor G;
+ Context.State[7] := Context.State[7] xor H;
+
+ //
+end;
+
+procedure SM3UpdateW(var Context: TCnSM3Context; Input: PWideChar; CharLength: Cardinal);
+var
+{$IFDEF MSWINDOWS}
+ pContent: PAnsiChar;
+ iLen: Cardinal;
+{$ELSE}
+ S: string; // UnicodeString
+ A: AnsiString;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(pContent, CharLength * SizeOf(WideChar));
+ try
+ iLen := WideCharToMultiByte(0, 0, Input, CharLength, // ҳĬ 0
+ PAnsiChar(pContent), CharLength * SizeOf(WideChar), nil, nil);
+ SM3Update(Context, pContent, iLen);
+ finally
+ FreeMem(pContent);
+ end;
+{$ELSE} // MacOS ֱӰ UnicodeString ת AnsiString 㣬ַ֧ Windows Unicode ƽ̨
+ S := StrNew(Input);
+ A := AnsiString(S);
+ SM3Update(Context, @A[1], Length(A));
+{$ENDIF}
+end;
+
+procedure SM3Update(var Context: TCnSM3Context; Input: PAnsiChar; ByteLength: Cardinal);
+var
+ Fill, Left: Cardinal;
+begin
+ if (Input = nil) or (ByteLength <= 0) then
+ Exit;
+
+ Left := Context.Total[0] and $3F;
+ Fill := 64 - Left;
+
+ Context.Total[0] := Context.Total[0] + ByteLength;
+ Context.Total[0] := Context.Total[0] and $FFFFFFFF;
+
+ if Context.Total[0] < ByteLength then
+ Context.Total[1] := Context.Total[1] + 1;
+
+ if (Left <> 0) and (ByteLength >= Fill) then
+ begin
+ Move(Input^, Context.Buffer[Left], Fill);
+ SM3Process(Context, @(Context.Buffer[0]));
+ Input := Input + Fill;
+ ByteLength := ByteLength - Fill;
+ Left := 0;
+ end;
+
+ while ByteLength >= 64 do
+ begin
+ SM3Process(Context, Input);
+ Input := Input + 64;
+ ByteLength := ByteLength - 64;
+ end;
+
+ if ByteLength > 0 then
+ Move(Input^, Context.Buffer[Left], ByteLength);
+end;
+
+procedure SM3Final(var Context: TCnSM3Context; var Digest: TCnSM3Digest);
+var
+ Last, Padn: Cardinal;
+ High, Low: Cardinal;
+ MsgLen: array[0..7] of Byte;
+begin
+ High := (Context.Total[0] shr 29) or (Context.Total[1] shl 3);
+ Low := Context.Total[0] shl 3;
+
+ PutULongBe(High, @(MsgLen[0]), 0);
+ PutULongBe(Low, @(MsgLen[0]), 4);
+
+ Last := Context.Total[0] and $3F;
+ if Last < 56 then
+ Padn := 56 - Last
+ else
+ Padn := 120 - Last;
+
+ SM3Update(Context, @(SM3Padding[0]), Padn);
+ SM3Update(Context, @(MsgLen[0]), 8);
+
+ PutULongBe(Context.State[0], @Digest, 0);
+ PutULongBe(Context.State[1], @Digest, 4);
+ PutULongBe(Context.State[2], @Digest, 8);
+ PutULongBe(Context.State[3], @Digest, 12);
+ PutULongBe(Context.State[4], @Digest, 16);
+ PutULongBe(Context.State[5], @Digest, 20);
+ PutULongBe(Context.State[6], @Digest, 24);
+ PutULongBe(Context.State[7], @Digest, 28);
+end;
+
+function SM3(Input: PAnsiChar; ByteLength: Cardinal): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3Update(Context, Input, ByteLength);
+ SM3Final(Context, Result);
+end;
+
+procedure SM3HmacInit(var Context: TCnSM3Context; Key: PAnsiChar; KeyLength: Integer);
+var
+ I: Integer;
+ Sum: TCnSM3Digest;
+begin
+ if KeyLength > HMAC_SM3_BLOCK_SIZE_BYTE then
+ begin
+ Sum := SM3Buffer(Key^, KeyLength);
+ KeyLength := HMAC_SM3_OUTPUT_LENGTH_BYTE;
+ Key := @(Sum[0]);
+ end;
+
+ FillChar(Context.Ipad, HMAC_SM3_BLOCK_SIZE_BYTE, $36);
+ FillChar(Context.Opad, HMAC_SM3_BLOCK_SIZE_BYTE, $5C);
+
+ for I := 0 to KeyLength - 1 do
+ begin
+ Context.Ipad[I] := Byte(Context.Ipad[I] xor Byte(Key[I]));
+ Context.Opad[I] := Byte(Context.Opad[I] xor Byte(Key[I]));
+ end;
+
+ SM3Init(Context);
+ SM3Update(Context, @(Context.Ipad[0]), HMAC_SM3_BLOCK_SIZE_BYTE);
+end;
+
+procedure SM3HmacUpdate(var Context: TCnSM3Context; Input: PAnsiChar; Length: Cardinal);
+begin
+ SM3Update(Context, Input, Length);
+end;
+
+procedure SM3HmacFinal(var Context: TCnSM3Context; var Output: TCnSM3Digest);
+var
+ Len: Integer;
+ TmpBuf: TCnSM3Digest;
+begin
+ Len := HMAC_SM3_OUTPUT_LENGTH_BYTE;
+ SM3Final(Context, TmpBuf);
+ SM3Init(Context);
+ SM3Update(Context, @(Context.Opad[0]), HMAC_SM3_BLOCK_SIZE_BYTE);
+ SM3Update(Context, @(TmpBuf[0]), Len);
+ SM3Final(Context, Output);
+end;
+
+procedure SM3Hmac(Key: PAnsiChar; KeyByteLength: Integer; Input: PAnsiChar;
+ ByteLength: Cardinal; var Output: TCnSM3Digest);
+var
+ Context: TCnSM3Context;
+begin
+ SM3HmacInit(Context, Key, KeyByteLength);
+ SM3HmacUpdate(Context, Input, ByteLength);
+ SM3HmacFinal(Context, Output);
+end;
+
+function SM3HmacBytes(const Key: TBytes; const Data: TBytes): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3HmacInit(Context, PAnsiChar(@Key[0]), Length(Key));
+ SM3HmacUpdate(Context, PAnsiChar(@Data[0]), Length(Data));
+ SM3HmacFinal(Context, Result);
+end;
+
+function SM3Buffer(const Buffer; Count: Cardinal): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3Update(Context, PAnsiChar(@Buffer), Count);
+ SM3Final(Context, Result);
+end;
+
+function SM3Bytes(const Data: TBytes): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3Update(Context, PAnsiChar(@Data[0]), Length(Data));
+ SM3Final(Context, Result);
+end;
+
+function SM3String(const Str: string): TCnSM3Digest;
+var
+ AStr: AnsiString;
+begin
+ AStr := AnsiString(Str);
+ Result := SM3StringA(AStr);
+end;
+
+function SM3StringA(const Str: AnsiString): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3Update(Context, PAnsiChar(Str), Length(Str));
+ SM3Final(Context, Result);
+end;
+
+function SM3StringW(const Str: WideString): TCnSM3Digest;
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3UpdateW(Context, PWideChar(Str), Length(Str));
+ SM3Final(Context, Result);
+end;
+
+{$IFDEF UNICODE}
+function SM3UnicodeString(const Str: string): TCnSM3Digest;
+{$ELSE}
+function SM3UnicodeString(const Str: WideString): TCnSM3Digest;
+{$ENDIF}
+var
+ Context: TCnSM3Context;
+begin
+ SM3Init(Context);
+ SM3Update(Context, PAnsiChar(@Str[1]), Length(Str) * SizeOf(WideChar));
+ SM3Final(Context, Result);
+end;
+
+function InternalSM3Stream(Stream: TStream; const BufSize: Cardinal; var D:
+ TCnSM3Digest; CallBack: TCnSM3CalcProgressFunc): Boolean;
+var
+ Context: TCnSM3Context;
+ Buf: PAnsiChar;
+ BufLen: Cardinal;
+ Size: Int64;
+ ReadBytes: Cardinal;
+ TotalBytes: Int64;
+ SavePos: Int64;
+ CancelCalc: Boolean;
+begin
+ Result := False;
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ if Size = 0 then Exit;
+ if Size < BufSize then BufLen := Size
+ else BufLen := BufSize;
+
+ CancelCalc := False;
+ SM3Init(Context);
+ GetMem(Buf, BufLen);
+ try
+ Stream.Position := 0;
+ repeat
+ ReadBytes := Stream.Read(Buf^, BufLen);
+ if ReadBytes <> 0 then
+ begin
+ Inc(TotalBytes, ReadBytes);
+ SM3Update(Context, Buf, ReadBytes);
+ if Assigned(CallBack) then
+ begin
+ CallBack(Size, TotalBytes, CancelCalc);
+ if CancelCalc then Exit;
+ end;
+ end;
+ until (ReadBytes = 0) or (TotalBytes = Size);
+ SM3Final(Context, D);
+ Result := True;
+ finally
+ FreeMem(Buf, BufLen);
+ Stream.Position := SavePos;
+ end;
+end;
+
+function SM3File(const FileName: string;
+ CallBack: TCnSM3CalcProgressFunc): TCnSM3Digest;
+var
+{$IFDEF MSWINDOWS}
+ FileHandle: THandle;
+ MapHandle: THandle;
+ ViewPointer: Pointer;
+ Context: TCnSM3Context;
+{$ENDIF}
+ Stream: TStream;
+ FileIsZeroSize: Boolean;
+
+ function FileSizeIsLargeThanMaxOrCanNotMap(const AFileName: string; out IsEmpty: Boolean): Boolean;
+{$IFDEF MSWINDOWS}
+ var
+ H: THandle;
+ Info: BY_HANDLE_FILE_INFORMATION;
+ Rec : Int64Rec;
+{$ENDIF}
+ begin
+{$IFDEF MSWINDOWS}
+ Result := False;
+ IsEmpty := False;
+ H := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
+ if H = INVALID_HANDLE_VALUE then Exit;
+ try
+ if not GetFileInformationByHandle(H, Info) then Exit;
+ finally
+ CloseHandle(H);
+ end;
+ Rec.Lo := Info.nFileSizeLow;
+ Rec.Hi := Info.nFileSizeHigh;
+ Result := (Rec.Hi > 0) or (Rec.Lo > MAX_FILE_SIZE);
+ IsEmpty := (Rec.Hi = 0) and (Rec.Lo = 0);
+{$ELSE}
+ Result := True; // Windows ƽ̨ Trueʾ Mapping
+{$ENDIF}
+ end;
+
+begin
+ FileIsZeroSize := False;
+ if FileSizeIsLargeThanMaxOrCanNotMap(FileName, FileIsZeroSize) then
+ begin
+ // 2G ļ Map ʧܣ Windows ƽ̨ʽѭ
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ InternalSM3Stream(Stream, 4096 * 1024, Result, CallBack);
+ finally
+ Stream.Free;
+ end;
+ end
+ else
+ begin
+{$IFDEF MSWINDOWS}
+ SM3Init(Context);
+ FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
+ FILE_FLAG_SEQUENTIAL_SCAN, 0);
+ if FileHandle <> INVALID_HANDLE_VALUE then
+ begin
+ try
+ MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
+ if MapHandle <> 0 then
+ begin
+ try
+ ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
+ if ViewPointer <> nil then
+ begin
+ try
+ SM3Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
+ finally
+ UnmapViewOfFile(ViewPointer);
+ end;
+ end
+ else
+ begin
+ raise ECnNativeException.Create(SCnErrorMapViewOfFile + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(MapHandle);
+ end;
+ end
+ else
+ begin
+ if not FileIsZeroSize then
+ raise ECnNativeException.Create(SCnErrorCreateFileMapping + IntToStr(GetLastError));
+ end;
+ finally
+ CloseHandle(FileHandle);
+ end;
+ end;
+ SM3Final(Context, Result);
+{$ENDIF}
+ end;
+end;
+
+function SM3Stream(Stream: TStream;
+ CallBack: TCnSM3CalcProgressFunc): TCnSM3Digest;
+begin
+ InternalSM3Stream(Stream, 4096 * 1024, Result, CallBack);
+end;
+
+function SM3Print(const Digest: TCnSM3Digest): string;
+begin
+ Result := DataToHex(@Digest[0], SizeOf(TCnSM3Digest));
+end;
+
+function SM3Match(const D1, D2: TCnSM3Digest): Boolean;
+begin
+ Result := ConstTimeCompareMem(@D1[0], @D2[0], SizeOf(TCnSM3Digest));
+end;
+
+function SM3DigestToStr(const Digest: TCnSM3Digest): string;
+begin
+ Result := MemoryToString(@Digest[0], SizeOf(TCnSM3Digest));
+end;
+
+end.
diff --git a/CnPack/Crypto/CnSM4.pas b/CnPack/Crypto/CnSM4.pas
new file mode 100644
index 0000000..8936be7
--- /dev/null
+++ b/CnPack/Crypto/CnSM4.pas
@@ -0,0 +1,2202 @@
+{******************************************************************************}
+{ CnPack For Delphi/C++Builder }
+{ йԼĿԴ }
+{ (C)Copyright 2001-2026 CnPack }
+{ ------------------------------------ }
+{ }
+{ ǿԴ CnPack ķЭ }
+{ ĺ·һ }
+{ }
+{ һĿϣãûκεû }
+{ ʺضĿĶĵϸ CnPack Э顣 }
+{ }
+{ ӦѾͿһյһ CnPack Эĸ }
+{ ûУɷǵվ }
+{ }
+{ վַhttps://www.cnpack.org }
+{ ʼmaster@cnpack.org }
+{ }
+{******************************************************************************}
+
+unit CnSM4;
+{* |
+================================================================================
+* ƣ
+* Ԫƣ SM4 ԳƼӽ㷨ʵֵԪ
+* ԪߣCnPack 飨master@cnpack.org)
+* οֲ goldboar C
+* עԪʵ˹ SM4 ԳƼӽ㷨ֿС 16 ֽڣʵ
+* Ķ뷽ʽĩβ 0Ԫڲ֧ PKCS ȿ뷽ʽҪⲿ
+* CnPemUtils.pas Ԫе PKCS ϵкԼӽݽж
+* Ԫʵֲο㷨ĵSM4 Encryption alogrithm
+*
+* ߰汾 Delphi 뾡ʹ AnsiString 汾ĺʮƳ⣩
+* ⲻַӰӽܽ
+*
+* ECB/CBC ǿģʽҪ롣CFB/OFB/CTR ĵģʽ뵽顣
+* ⣬Ԫе CTR 8 ֽ Nonce 8 ֽڼΪڲ 16 ֽڳʼģʽ
+* Щ 16 ֽ Iv ĺ 4 8 ֽIJͬʹʱע⡣
+*
+* ƽ̨Windows 7 + Delphi 5.0
+* ݲԣPWin9X/2000/XP/7 + Delphi 5/6 + MaxOS 64
+* õԪеַϱػʽ
+* ļ¼2025.01.22 V1.9
+* CFB/OFB ģʽĩβʱӽܿܳ
+* 2024.12.01 V1.8
+* ȥֲҪ const βע
+* 2022.07.21 V1.7
+* CTR ģʽ֧
+* 2022.06.21 V1.6
+* 뼸ֽ鵽ʮַ֮ļӽܺ
+* 2022.04.26 V1.5
+* LongWord Integer ַת֧ MacOS64
+* 2022.04.19 V1.4
+* ʹóʼʱڲݣĴ
+* 2021.12.12 V1.3
+* CFB/OFB ģʽ֧
+* 2020.03.24 V1.2
+* Ӳַװ
+* 2019.04.15 V1.1
+* ֧ Win32/Win64/MacOS
+* 2014.09.25 V1.0
+* ֲԪ
+================================================================================
+|
}
+
+interface
+
+{$I CnPack.inc}
+
+uses
+ Classes, SysUtils, CnNative;
+
+const
+ CN_SM4_KEYSIZE = 16;
+ {* SM4 Կ 16 ֽ}
+
+ CN_SM4_BLOCKSIZE = 16;
+ {* SM4 ķֿ鳤 16 ֽ}
+
+ CN_SM4_NONCESIZE = 8;
+ {* SM4 CTR ģʽµʼ 8 ֽ}
+
+type
+ ECnSM4Exception = class(Exception);
+ {* SM4 쳣}
+
+ TCnSM4Key = array[0..CN_SM4_KEYSIZE - 1] of Byte;
+ {* SM4 ļ Key16 ֽ}
+
+ TCnSM4Buffer = array[0..CN_SM4_BLOCKSIZE - 1] of Byte;
+ {* SM4 ļܿ飬16 ֽ}
+
+ TCnSM4Iv = array[0..CN_SM4_BLOCKSIZE - 1] of Byte;
+ {* SM4 CBC/CFB/OFB ȵijʼ16 ֽ}
+
+ TCnSM4Nonce = array[0..CN_SM4_NONCESIZE - 1] of Byte;
+ {* SM4 CTR ģʽµijʼ 8 ֽڣһ 8 ֽڼƴһΪ 16 ֽ Iv}
+
+ TCnSM4Context = packed record
+ {* SM4 Ľṹ}
+ Mode: Integer; {!< encrypt/decrypt }
+ Sk: array[0..CN_SM4_KEYSIZE * 2 - 1] of Cardinal; {!< SM4 subkeys }
+ end;
+
+function SM4GetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+{* ֽڳȼȡǿ
+
+
+ InputByteLength: Integer - ֽڳ
+
+ ֵInteger - SM4 ij
+}
+
+procedure SM4Encrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; ByteLen: Integer);
+{* ԭʼ SM4 ݿ飬ʹ ECB ģʽ Input ڵݼܷ Output У
+ б֤ Key ָ 16 ֽڣInput Output ָݳȲҶΪ ByteLen ֽ
+ ByteLen 뱻 16
+
+
+ Key: PAnsiChar - 16 ֽ SM4 Կ
+ Input: PAnsiChar - ܵݿַ
+ Output: PAnsiChar - ݿַ
+ ByteLen: Integer - ӽݿֽڳ
+
+ ֵޣ
+}
+
+procedure SM4Decrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; ByteLen: Integer);
+{* ԭʼ SM4 ݿ飬ECB ģʽ Input ڵݽܸ鵽 Output
+ б֤ Key ָ 16 ֽڣInput Output ָݳȲҶΪ ByteLen ֽ
+ ByteLen 뱻 16
+
+
+ Key: PAnsiChar - 16 ֽ SM4 Կ
+ Input: PAnsiChar - ܵݿַ
+ Output: PAnsiChar - ݿַ
+ ByteLen: Integer - ӽݿֽڳ
+
+ ֵޣ
+}
+
+// ============== ַʮַ֮ļӽ ===================
+
+procedure SM4EncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 16 ıʱᱻ #0 ȴﵽ 16 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 16) + 1) * 16
+
+ ֵޣ
+}
+
+procedure SM4DecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ ECB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ const Input: AnsiString - ַܵ䳤粻 16 ıʱᱻ #0 ȴﵽ 16 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 16) + 1) * 16
+
+ ֵޣ
+}
+
+procedure SM4EncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ䳤粻 16 ıʱᱻ #0 ȴﵽ 16 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 16) + 1) * 16
+
+ ֵޣ
+}
+
+procedure SM4DecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CBC ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ䳤粻 16 ıʱᱻ #0 ȴﵽ 16 ı
+ Output: PAnsiChar - 䳤ȱڻ (((Length(Input) - 1) div 16) + 1) * 16
+
+ ֵޣ
+}
+
+procedure SM4EncryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CFB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+procedure SM4DecryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CFB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+procedure SM4EncryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ OFB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+procedure SM4DecryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ OFB ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Iv: PAnsiChar - 16 ֽڳʼעЧݱڻ 16 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+procedure SM4EncryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CTR ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Nonce: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+procedure SM4DecryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+{* AnsiString SM4 ܣʹ CTR ģʽ
+
+
+ Key: AnsiString - 16 ֽ SM4 Կ̫ضϣ #0
+ Nonce: PAnsiChar - 8 ֽڳʼעЧݱڻ 8 ֽ
+ const Input: AnsiString - ַܵ
+ Output: PAnsiChar - 䳤ȱڻ Length(Input)
+
+ ֵޣ
+}
+
+// ================= ֽֽ֮ļӽ ====================
+
+function SM4EncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function SM4DecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ ECB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function SM4DecryptCbcBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CBC ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCfbBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function SM4DecryptCfbBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptOfbBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ OFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function SM4DecryptOfbBytes(Key: TBytes; Iv: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ OFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCtrBytes(Key: TBytes; Nonce: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CTR ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Nonce: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؼֽܺ
+}
+
+function SM4DecryptCtrBytes(Key: TBytes; Nonce: TBytes; Input: TBytes): TBytes;
+{* ֽ SM4 ܣʹ CTR ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Nonce: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵTBytes - ؽֽܺ
+}
+
+// ============== ֽʮַ֮ļӽ =================
+
+function SM4EncryptEcbBytesToHex(Key: TBytes; Input: TBytes): AnsiString;
+{* KeySM4 ܷתʮƵģʹ ECB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function SM4DecryptEcbBytesFromHex(Key: TBytes; const Input: AnsiString): TBytes;
+{* ʮƵ KeySM4 ܷģʹ ECB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ const Input: AnsiString - ܵʮַ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCbcBytesToHex(Key: TBytes; Iv: TBytes; Input: TBytes): AnsiString;
+{* Key IvSM4 ܷתʮƵģʹ CBC ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function SM4DecryptCbcBytesFromHex(Key: TBytes; Iv: TBytes; const Input: AnsiString): TBytes;
+{* ʮƵ Key IvSM4 ܷģʹ CBC ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ const Input: AnsiString - ܵʮַ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCfbBytesToHex(Key: TBytes; Iv: TBytes; Input: TBytes): AnsiString;
+{* Key IvSM4 ܷתʮƵģʹ CFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function SM4DecryptCfbBytesFromHex(Key: TBytes; Iv: TBytes; const Input: AnsiString): TBytes;
+{* ʮƵ Key IvSM4 ܷģʹ CFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ const Input: AnsiString - ܵʮַ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptOfbBytesToHex(Key: TBytes; Iv: TBytes; Input: TBytes): AnsiString;
+{* Key IvSM4 ܷתʮƵģʹ OFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function SM4DecryptOfbBytesFromHex(Key: TBytes; Iv: TBytes; const Input: AnsiString): TBytes;
+{* ʮƵ Key IvSM4 ܷģʹ OFB ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Iv: TBytes - 16 ֽڳʼ̫ضϣ 0
+ const Input: AnsiString - ܵʮַ
+
+ ֵTBytes - ؽֽܺ
+}
+
+function SM4EncryptCtrBytesToHex(Key: TBytes; Nonce: TBytes; Input: TBytes): AnsiString;
+{* Key NonceSM4 ܷתʮƵģʹ CTR ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Nonce: TBytes - 8 ֽڳʼ̫ضϣ 0
+ Input: TBytes - ֽܵ
+
+ ֵAnsiString - ؼܺʮַ
+}
+
+function SM4DecryptCtrBytesFromHex(Key: TBytes; Nonce: TBytes; const Input: AnsiString): TBytes;
+{* ʮƵ Key NonceSM4 ܷģʹ CTR ģʽ
+
+
+ Key: TBytes - 16 ֽ SM4 Կ̫ضϣ 0
+ Nonce: TBytes - 8 ֽڳʼ̫ضϣ 0
+ const Input: AnsiString - ܵʮַ
+
+ ֵTBytes - ؽֽܺ
+}
+
+// ======================= ֮ļӽ ==========================
+
+procedure SM4EncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; Dest: TStream); overload;
+{* SM4 ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4DecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; Dest: TStream); overload;
+{* SM4 ܣʹ ECB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4EncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4DecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ CBC ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4EncryptStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ CFB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4DecryptStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ CFB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4EncryptStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ OFB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4DecryptStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+{* SM4 ܣʹ OFB ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitVector: TCnSM4Iv - 16 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4EncryptStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitNonce: TCnSM4Nonce; Dest: TStream);
+{* SM4 ܣʹ CTR ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitNonce: TCnSM4Nonce - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+procedure SM4DecryptStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitNonce: TCnSM4Nonce; Dest: TStream);
+{* SM4 ܣʹ CTR ģʽ
+ Count Ϊ 0 ʾͷֻ Stream ǰλ Count ֽ
+
+
+ Source: TStream - ܵ
+ Count: Cardinal - ǰλĴֽܵڳȣΪ 0ʾͷ
+ const Key: TCnSM4Key - 16 ֽ SM4 Կ
+ const InitNonce: TCnSM4Nonce - 8 ֽڳʼ
+ Dest: TStream -
+
+ ֵޣ
+}
+
+// Ϊײܺųⲿʹ
+
+procedure SM4SetKeyEnc(var Ctx: TCnSM4Context; Key: PAnsiChar);
+{* 16 ֽ Key SM4 IJΪģʽ
+
+
+ var Ctx: TCnSM4Context - õ SM4
+ Key: PAnsiChar - 16 ֽ SM4 Կ
+
+ ֵޣ
+}
+
+procedure SM4SetKeyDec(var Ctx: TCnSM4Context; Key: PAnsiChar);
+{* 16 ֽ Key SM4 IJΪģʽ
+
+
+ var Ctx: TCnSM4Context - õ SM4
+ Key: PAnsiChar - 16 ֽ SM4 Կ
+
+ ֵޣ
+}
+
+procedure SM4OneRound(SK: PCardinal; Input: PAnsiChar; Output: PAnsiChar);
+{* ӽһ飬ݴ Input Output 16 ֽڣ߿ͬһ
+ SK TSM4Context Skܻǽ
+
+
+ SK: PCardinal - SM4 SubKey
+ Input: PAnsiChar - ݿַ 16 ֽ
+ Output: PAnsiChar - ϵݿַ 16 ֽ
+
+ ֵޣ
+}
+
+implementation
+
+resourcestring
+ SCnErrorSM4InvalidInBufSize = 'Invalid Buffer Size for Decryption';
+ SCnErrorSM4ReadError = 'Stream Read Error';
+ SCnErrorSM4WriteError = 'Stream Write Error';
+
+const
+ SM4_ENCRYPT = 1;
+ SM4_DECRYPT = 0;
+
+ SBoxTable: array[0..CN_SM4_KEYSIZE - 1] of array[0..CN_SM4_KEYSIZE - 1] of Byte = (
+ ($D6, $90, $E9, $FE, $CC, $E1, $3D, $B7, $16, $B6, $14, $C2, $28, $FB, $2C, $05),
+ ($2B, $67, $9A, $76, $2A, $BE, $04, $C3, $AA, $44, $13, $26, $49, $86, $06, $99),
+ ($9C, $42, $50, $F4, $91, $EF, $98, $7A, $33, $54, $0B, $43, $ED, $CF, $AC, $62),
+ ($E4, $B3, $1C, $A9, $C9, $08, $E8, $95, $80, $DF, $94, $FA, $75, $8F, $3F, $A6),
+ ($47, $07, $A7, $FC, $F3, $73, $17, $BA, $83, $59, $3C, $19, $E6, $85, $4F, $A8),
+ ($68, $6B, $81, $B2, $71, $64, $DA, $8B, $F8, $EB, $0F, $4B, $70, $56, $9D, $35),
+ ($1E, $24, $0E, $5E, $63, $58, $D1, $A2, $25, $22, $7C, $3B, $01, $21, $78, $87),
+ ($D4, $00, $46, $57, $9F, $D3, $27, $52, $4C, $36, $02, $E7, $A0, $C4, $C8, $9E),
+ ($EA, $BF, $8A, $D2, $40, $C7, $38, $B5, $A3, $F7, $F2, $CE, $F9, $61, $15, $A1),
+ ($E0, $AE, $5D, $A4, $9B, $34, $1A, $55, $AD, $93, $32, $30, $F5, $8C, $B1, $E3),
+ ($1D, $F6, $E2, $2E, $82, $66, $CA, $60, $C0, $29, $23, $AB, $0D, $53, $4E, $6F),
+ ($D5, $DB, $37, $45, $DE, $FD, $8E, $2F, $03, $FF, $6A, $72, $6D, $6C, $5B, $51),
+ ($8D, $1B, $AF, $92, $BB, $DD, $BC, $7F, $11, $D9, $5C, $41, $1F, $10, $5A, $D8),
+ ($0A, $C1, $31, $88, $A5, $CD, $7B, $BD, $2D, $74, $D0, $12, $B8, $E5, $B4, $B0),
+ ($89, $69, $97, $4A, $0C, $96, $77, $7E, $65, $B9, $F1, $09, $C5, $6E, $C6, $84),
+ ($18, $F0, $7D, $EC, $3A, $DC, $4D, $20, $79, $EE, $5F, $3E, $D7, $CB, $39, $48)
+ );
+
+ FK: array[0..3] of Cardinal = ($A3B1BAC6, $56AA3350, $677D9197, $B27022DC);
+
+ CK: array[0..CN_SM4_KEYSIZE * 2 - 1] of Cardinal = (
+ $00070E15, $1C232A31, $383F464D, $545B6269,
+ $70777E85, $8C939AA1, $A8AFB6BD, $C4CBD2D9,
+ $E0E7EEF5, $FC030A11, $181F262D, $343B4249,
+ $50575E65, $6C737A81, $888F969D, $A4ABB2B9,
+ $C0C7CED5, $DCE3EAF1, $F8FF060D, $141B2229,
+ $30373E45, $4C535A61, $686F767D, $848B9299,
+ $A0A7AEB5, $BCC3CAD1, $D8DFE6ED, $F4FB0209,
+ $10171E25, $2C333A41, $484F565D, $646B7279 );
+
+function Min(A, B: Integer): Integer; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+procedure GetULongBe(var N: Cardinal; B: PAnsiChar; I: Integer); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+var
+ D: Cardinal;
+begin
+ D := (Cardinal(B[I]) shl 24) or (Cardinal(B[I + 1]) shl 16) or
+ (Cardinal(B[I + 2]) shl 8) or (Cardinal(B[I + 3]));
+ N := D;
+end;
+
+procedure PutULongBe(N: Cardinal; B: PAnsiChar; I: Integer); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ B[I] := AnsiChar(N shr 24);
+ B[I + 1] := AnsiChar(N shr 16);
+ B[I + 2] := AnsiChar(N shr 8);
+ B[I + 3] := AnsiChar(N);
+end;
+
+function SM4Shl(X: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := (X and $FFFFFFFF) shl N;
+end;
+
+// ѭơע N Ϊ 0 32 ʱֵΪ XN Ϊ 33 ʱֵ N Ϊ 1 ʱķֵ
+function ROTL(X: Cardinal; N: Integer): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := SM4Shl(X, N) or (X shr (32 - N));
+end;
+
+procedure Swap(var A: Cardinal; var B: Cardinal); {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+var
+ T: Cardinal;
+begin
+ T := A;
+ A := B;
+ B := T;
+end;
+
+function SM4SBox(Inch: Byte): Byte; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+var
+ PTable: Pointer;
+begin
+ PTable := @(SboxTable[0][0]);
+ Result := PByte(TCnIntAddress(PTable) + Inch)^;
+end;
+
+function SM4Lt(Ka: Cardinal): Cardinal;
+var
+ BB: Cardinal;
+ A: array[0..3] of Byte;
+ B: array[0..3] of Byte;
+begin
+ BB := 0;
+ PutULongBe(Ka, @(A[0]), 0);
+ B[0] := SM4SBox(A[0]);
+ B[1] := SM4SBox(A[1]);
+ B[2] := SM4SBox(A[2]);
+ B[3] := SM4SBox(A[3]);
+ GetULongBe(BB, @(B[0]), 0);
+
+ Result := BB xor (ROTL(BB, 2)) xor (ROTL(BB, 10)) xor (ROTL(BB, 18))
+ xor (ROTL(BB, 24));
+end;
+
+function SM4F(X0: Cardinal; X1: Cardinal; X2: Cardinal; X3: Cardinal; RK: Cardinal): Cardinal; {$IFDEF SUPPORT_INLINE} inline; {$ENDIF}
+begin
+ Result := X0 xor SM4Lt(X1 xor X2 xor X3 xor RK);
+end;
+
+function SM4CalciRK(Ka: Cardinal): Cardinal;
+var
+ BB: Cardinal;
+ A: array[0..3] of Byte;
+ B: array[0..3] of Byte;
+begin
+ PutULongBe(Ka, @(A[0]), 0);
+ B[0] := SM4SBox(A[0]);
+ B[1] := SM4SBox(A[1]);
+ B[2] := SM4SBox(A[2]);
+ B[3] := SM4SBox(A[3]);
+ GetULongBe(BB, @(B[0]), 0);
+ Result := BB xor ROTL(BB, 13) xor ROTL(BB, 23);
+end;
+
+// SK Points to 32 DWord Array; Key Points to 16 Byte Array
+procedure SM4SetKey(SK: PCardinal; Key: PAnsiChar);
+var
+ MK: array[0..3] of Cardinal;
+ K: array[0..35] of Cardinal;
+ I: Integer;
+begin
+ GetULongBe(MK[0], Key, 0);
+ GetULongBe(MK[1], Key, 4);
+ GetULongBe(MK[2], Key, 8);
+ GetULongBe(MK[3], Key, 12);
+
+ K[0] := MK[0] xor FK[0];
+ K[1] := MK[1] xor FK[1];
+ K[2] := MK[2] xor FK[2];
+ K[3] := MK[3] xor FK[3];
+
+ for I := 0 to 31 do
+ begin
+ K[I + 4] := K[I] xor SM4CalciRK(K[I + 1] xor K[I + 2] xor K[I + 3] xor CK[I]);
+ (PCardinal(TCnIntAddress(SK) + I * SizeOf(Cardinal)))^ := K[I + 4];
+ end;
+end;
+
+// SK Points to 32 DWord Array; Input/Output Points to 16 Byte Array
+// Input Output ͬһ
+procedure SM4OneRound(SK: PCardinal; Input: PAnsiChar; Output: PAnsiChar);
+var
+ I: Integer;
+ UlBuf: array[0..35] of Cardinal;
+begin
+ FillChar(UlBuf[0], SizeOf(UlBuf), 0);
+
+ GetULongBe(UlBuf[0], Input, 0);
+ GetULongBe(UlBuf[1], Input, 4);
+ GetULongBe(UlBuf[2], Input, 8);
+ GetULongBe(UlBuf[3], Input, 12);
+
+ for I := 0 to 31 do
+ begin
+ UlBuf[I + 4] := SM4F(UlBuf[I], UlBuf[I + 1], UlBuf[I + 2], UlBuf[I + 3],
+ (PCardinal(TCnNativeInt(SK) + I * SizeOf(Cardinal)))^);
+ end;
+
+ PutULongBe(UlBuf[35], Output, 0);
+ PutULongBe(UlBuf[34], Output, 4);
+ PutULongBe(UlBuf[33], Output, 8);
+ PutULongBe(UlBuf[32], Output, 12);
+end;
+
+procedure SM4SetKeyEnc(var Ctx: TCnSM4Context; Key: PAnsiChar);
+begin
+ Ctx.Mode := SM4_ENCRYPT;
+ SM4SetKey(@(Ctx.Sk[0]), Key);
+end;
+
+procedure SM4SetKeyDec(var Ctx: TCnSM4Context; Key: PAnsiChar);
+var
+ I: Integer;
+begin
+ Ctx.Mode := SM4_DECRYPT;
+ SM4SetKey(@(Ctx.Sk[0]), Key);
+
+ for I := 0 to CN_SM4_KEYSIZE - 1 do
+ Swap(Ctx.Sk[I], Ctx.Sk[31 - I]);
+end;
+
+procedure SM4CryptEcb(var Ctx: TCnSM4Context; Mode: Integer; Length: Integer;
+ Input: PAnsiChar; Output: PAnsiChar);
+var
+ EndBuf: TCnSM4Buffer;
+begin
+ while Length > 0 do
+ begin
+ if Length >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), Input, Output);
+ end
+ else
+ begin
+ // β 16 0
+ FillChar(EndBuf[0], CN_SM4_BLOCKSIZE, 0);
+ Move(Input^, EndBuf[0], Length);
+ SM4OneRound(@(Ctx.Sk[0]), @(EndBuf[0]), Output);
+ end;
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(Length, CN_SM4_BLOCKSIZE);
+ end;
+end;
+
+procedure SM4CryptEcbStr(Mode: Integer; Key: AnsiString;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ Ctx: TCnSM4Context;
+begin
+ if Length(Key) < CN_SM4_KEYSIZE then
+ while Length(Key) < CN_SM4_KEYSIZE do Key := Key + Chr(0) // 16 bytes at least padding 0.
+ else if Length(Key) > CN_SM4_KEYSIZE then
+ Key := Copy(Key, 1, CN_SM4_KEYSIZE); // Only keep 16
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1]));
+ SM4CryptEcb(Ctx, SM4_ENCRYPT, Length(Input), @(Input[1]), @(Output[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyDec(Ctx, @(Key[1]));
+ SM4CryptEcb(Ctx, SM4_DECRYPT, Length(Input), @(Input[1]), @(Output[0]));
+ end;
+end;
+
+procedure SM4CryptCbc(var Ctx: TCnSM4Context; Mode: Integer; ByteLen: Integer;
+ Iv: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
+var
+ I: Integer;
+ EndBuf: TCnSM4Buffer;
+ LocalIv: TCnSM4Iv;
+begin
+ Move(Iv^, LocalIv[0], CN_SM4_BLOCKSIZE);
+ if Mode = SM4_ENCRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^
+ xor LocalIv[I];
+
+ SM4OneRound(@(Ctx.Sk[0]), Output, Output);
+ Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE);
+ end
+ else
+ begin
+ // β 16 0
+ FillChar(EndBuf[0], SizeOf(EndBuf), 0);
+ Move(Input^, EndBuf[0], ByteLen);
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := EndBuf[I]
+ xor LocalIv[I];
+
+ SM4OneRound(@(Ctx.Sk[0]), Output, Output);
+ Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE);
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), Input, Output);
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Output) + I))^
+ xor LocalIv[I];
+
+ Move(Input^, LocalIv[0], CN_SM4_BLOCKSIZE);
+ end
+ else
+ begin
+ // β 16 0
+ FillChar(EndBuf[0], SizeOf(EndBuf), 0);
+ Move(Input^, EndBuf[0], ByteLen);
+ SM4OneRound(@(Ctx.Sk[0]), @(EndBuf[0]), Output);
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Output) + I))^
+ xor LocalIv[I];
+
+ Move(EndBuf[0], LocalIv[0], CN_SM4_BLOCKSIZE);
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end;
+end;
+
+procedure SM4CryptCfb(var Ctx: TCnSM4Context; Mode: Integer; ByteLen: Integer;
+ Iv: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
+var
+ I: Integer;
+ LocalIv, Tail: TCnSM4Iv;
+begin
+ Move(Iv^, LocalIv[0], CN_SM4_BLOCKSIZE);
+ if Mode = SM4_ENCRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // ȼ Iv
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^
+ xor (PByte(TCnIntAddress(Output) + I))^; // ܽΪ
+
+ Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE); // ȡ Iv Աһ
+ end
+ else
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @Tail[0]);
+
+ for I := 0 to ByteLen - 1 do // ֻʣȣ账 16 ֽ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^ xor Tail[I];
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // ȼ Iv
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Output) + I))^
+ xor (PByte(TCnIntAddress(Input) + I))^; // ܽõ
+
+ Move(Input[0], LocalIv[0], CN_SM4_BLOCKSIZE); // ȡ Iv ȥһּ
+ end
+ else
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @Tail[0]);
+
+ for I := 0 to ByteLen - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := Tail[I] xor (PByte(TCnIntAddress(Input) + I))^;
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end;
+end;
+
+procedure SM4CryptOfb(var Ctx: TCnSM4Context; Mode: Integer; ByteLen: Integer;
+ Iv: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
+var
+ I: Integer;
+ LocalIv, Tail: TCnSM4Iv;
+begin
+ Move(Iv^, LocalIv[0], CN_SM4_BLOCKSIZE);
+ if Mode = SM4_ENCRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // ȼ Iv
+ Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE); // ܽһ
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do // ܽ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^
+ xor (PByte(TCnIntAddress(Output) + I))^;
+ end
+ else
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @Tail[0]); // ȼ Iv
+
+ for I := 0 to ByteLen - 1 do // 16 ֽ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^ xor Tail[I];
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // ȼ Iv
+ Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE); // ܽһ
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do // õ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Output) + I))^
+ xor (PByte(TCnIntAddress(Input) + I))^;
+ end
+ else
+ begin
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @Tail[0]); // ȼ Iv
+
+ for I := 0 to ByteLen - 1 do
+ (PByte(TCnIntAddress(Output) + I))^ := Tail[I] xor (PByte(TCnIntAddress(Input) + I))^;
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ end;
+ end;
+end;
+
+// CTR ģʽݿ顣Output ȿԺ Input һȡ
+procedure SM4CryptCtr(var Ctx: TCnSM4Context; Mode: Integer; ByteLen: Integer;
+ Nonce: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
+var
+ I: Integer;
+ LocalIv: TCnSM4Iv;
+ Cnt, T: Int64;
+begin
+ Cnt := 1;
+
+ // ּӽ
+ while ByteLen > 0 do
+ begin
+ if ByteLen >= CN_SM4_BLOCKSIZE then
+ begin
+ Move(Nonce^, LocalIv[0], SizeOf(TCnSM4Nonce));
+ T := Int64HostToNetwork(Cnt);
+ Move(T, LocalIv[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @LocalIv[0]); // ȼ Iv
+
+ for I := 0 to CN_SM4_BLOCKSIZE - 1 do // ܽ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^
+ xor LocalIv[I];
+ end
+ else
+ begin
+ Move(Nonce^, LocalIv[0], SizeOf(TCnSM4Nonce));
+ T := Int64HostToNetwork(Cnt);
+ Move(T, LocalIv[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], @LocalIv[0]); // ȼ Iv
+
+ for I := 0 to ByteLen - 1 do // 16 ֽ
+ (PByte(TCnIntAddress(Output) + I))^ := (PByte(TCnIntAddress(Input) + I))^
+ xor LocalIv[I];
+ end;
+
+ Inc(Input, CN_SM4_BLOCKSIZE);
+ Inc(Output, CN_SM4_BLOCKSIZE);
+ Dec(ByteLen, CN_SM4_BLOCKSIZE);
+ Inc(Cnt);
+ end;
+end;
+
+procedure SM4CryptCbcStr(Mode: Integer; Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ Ctx: TCnSM4Context;
+begin
+ if Length(Key) < CN_SM4_KEYSIZE then
+ while Length(Key) < CN_SM4_KEYSIZE do Key := Key + Chr(0) // 16 bytes at least padding 0.
+ else if Length(Key) > CN_SM4_KEYSIZE then
+ Key := Copy(Key, 1, CN_SM4_KEYSIZE); // Only keep 16
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1]));
+ SM4CryptCbc(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyDec(Ctx, @(Key[1]));
+ SM4CryptCbc(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end;
+end;
+
+procedure SM4CryptCfbStr(Mode: Integer; Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ Ctx: TCnSM4Context;
+begin
+ if Length(Key) < CN_SM4_KEYSIZE then
+ while Length(Key) < CN_SM4_KEYSIZE do Key := Key + Chr(0) // 16 bytes at least padding 0.
+ else if Length(Key) > CN_SM4_KEYSIZE then
+ Key := Copy(Key, 1, CN_SM4_KEYSIZE); // Only keep 16
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1]));
+ SM4CryptCfb(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1])); // ע CFB ĽҲõǼܣ
+ SM4CryptCfb(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end;
+end;
+
+procedure SM4CryptOfbStr(Mode: Integer; Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ Ctx: TCnSM4Context;
+begin
+ if Length(Key) < CN_SM4_KEYSIZE then
+ while Length(Key) < CN_SM4_KEYSIZE do Key := Key + Chr(0) // 16 bytes at least padding 0.
+ else if Length(Key) > CN_SM4_KEYSIZE then
+ Key := Copy(Key, 1, CN_SM4_KEYSIZE); // Only keep 16
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1]));
+ SM4CryptOfb(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1])); // ע OFB ĽҲõǼܣ
+ SM4CryptOfb(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[1]), @(Output[0]));
+ end;
+end;
+
+procedure SM4CryptCtrStr(Mode: Integer; Key: AnsiString; Nonce: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+var
+ Ctx: TCnSM4Context;
+begin
+ if Length(Key) < CN_SM4_KEYSIZE then
+ while Length(Key) < CN_SM4_KEYSIZE do Key := Key + Chr(0) // 16 bytes at least padding 0.
+ else if Length(Key) > CN_SM4_KEYSIZE then
+ Key := Copy(Key, 1, CN_SM4_KEYSIZE); // Only keep 16
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1]));
+ SM4CryptCtr(Ctx, SM4_ENCRYPT, Length(Input), @(Nonce[0]), @(Input[1]), @(Output[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[1])); // ע CTR ĽҲõǼܣ
+ SM4CryptCtr(Ctx, SM4_DECRYPT, Length(Input), @(Nonce[0]), @(Input[1]), @(Output[0]));
+ end;
+end;
+
+procedure SM4EncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptEcbStr(SM4_ENCRYPT, Key, Input, Output);
+end;
+
+procedure SM4DecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptEcbStr(SM4_DECRYPT, Key, Input, Output);
+end;
+
+procedure SM4EncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCbcStr(SM4_ENCRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4DecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCbcStr(SM4_DECRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4EncryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCfbStr(SM4_ENCRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4DecryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCfbStr(SM4_DECRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4EncryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptOfbStr(SM4_ENCRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4DecryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptOfbStr(SM4_DECRYPT, Key, Iv, Input, Output);
+end;
+
+procedure SM4EncryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCtrStr(SM4_ENCRYPT, Key, Nonce, Input, Output);
+end;
+
+procedure SM4DecryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
+ const Input: AnsiString; Output: PAnsiChar);
+begin
+ SM4CryptCtrStr(SM4_DECRYPT, Key, Nonce, Input, Output);
+end;
+
+function SM4CryptEcbBytes(Mode: Integer; Key: TBytes;
+ const Input: TBytes): TBytes;
+var
+ Ctx: TCnSM4Context;
+ I, Len: Integer;
+begin
+ Len := Length(Input);
+ if Len <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ SetLength(Result, (((Len - 1) div 16) + 1) * 16);
+
+ Len := Length(Key);
+ if Len < CN_SM4_KEYSIZE then // Key С 16 ֽڲ 0
+ begin
+ SetLength(Key, CN_SM4_KEYSIZE);
+ for I := Len to CN_SM4_KEYSIZE - 1 do
+ Key[I] := 0;
+ end;
+ // ȴ 16 ֽʱ SM4SetKeyEnc ԶԺIJ
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ SM4CryptEcb(Ctx, SM4_ENCRYPT, Length(Input), @(Input[0]), @(Result[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyDec(Ctx, @(Key[0]));
+ SM4CryptEcb(Ctx, SM4_DECRYPT, Length(Input), @(Input[0]), @(Result[0]));
+ end;
+end;
+
+function SM4CryptCbcBytes(Mode: Integer; Key, Iv: TBytes;
+ const Input: TBytes): TBytes;
+var
+ Ctx: TCnSM4Context;
+ LocalIv: TCnSM4Iv;
+ I, Len: Integer;
+begin
+ Len := Length(Input);
+ if Len <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ SetLength(Result, (((Len - 1) div 16) + 1) * 16);
+
+ Len := Length(Key);
+ if Len < CN_SM4_KEYSIZE then // Key С 16 ֽڲ 0
+ begin
+ SetLength(Key, CN_SM4_KEYSIZE);
+ for I := Len to CN_SM4_KEYSIZE - 1 do
+ Key[I] := 0;
+ end;
+ // ȴ 16 ֽʱ SM4SetKeyEnc ԶԺIJ
+
+ MoveMost(Iv[0], LocalIv[0], Length(Iv), SizeOf(TCnSM4Iv));
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ SM4CryptCbc(Ctx, SM4_ENCRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyDec(Ctx, @(Key[0]));
+ SM4CryptCbc(Ctx, SM4_DECRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end;
+end;
+
+function SM4CryptCfbBytes(Mode: Integer; Key, Iv: TBytes;
+ const Input: TBytes): TBytes;
+var
+ Ctx: TCnSM4Context;
+ LocalIv: TCnSM4Iv;
+ I, Len: Integer;
+begin
+ Len := Length(Input);
+ if Len <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ SetLength(Result, Len); // ע CFB ģʽ貹
+
+ Len := Length(Key);
+ if Len < CN_SM4_KEYSIZE then // Key С 16 ֽڲ 0
+ begin
+ SetLength(Key, CN_SM4_KEYSIZE);
+ for I := Len to CN_SM4_KEYSIZE - 1 do
+ Key[I] := 0;
+ end;
+ // ȴ 16 ֽʱ SM4SetKeyEnc ԶԺIJ
+
+ MoveMost(Iv[0], LocalIv[0], Length(Iv), SizeOf(TCnSM4Iv));
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ SM4CryptCfb(Ctx, SM4_ENCRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0])); // ע CFB ĽҲõǼܣ
+ SM4CryptCfb(Ctx, SM4_DECRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end;
+end;
+
+function SM4CryptOfbBytes(Mode: Integer; Key, Iv: TBytes;
+ const Input: TBytes): TBytes;
+var
+ Ctx: TCnSM4Context;
+ LocalIv: TCnSM4Iv;
+ I, Len: Integer;
+begin
+ Len := Length(Input);
+ if Len <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ SetLength(Result, Len); // ע OFB ģʽ貹
+
+ Len := Length(Key);
+ if Len < CN_SM4_KEYSIZE then // Key С 16 ֽڲ 0
+ begin
+ SetLength(Key, CN_SM4_KEYSIZE);
+ for I := Len to CN_SM4_KEYSIZE - 1 do
+ Key[I] := 0;
+ end;
+ // ȴ 16 ֽʱ SM4SetKeyEnc ԶԺIJ
+
+ MoveMost(Iv[0], LocalIv[0], Length(Iv), SizeOf(TCnSM4Iv));
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ SM4CryptOfb(Ctx, SM4_ENCRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0])); // ע OFB ĽҲõǼܣ
+ SM4CryptOfb(Ctx, SM4_DECRYPT, Length(Input), @(LocalIv[0]), @(Input[0]), @(Result[0]));
+ end;
+end;
+
+function SM4CryptCtrBytes(Mode: Integer; Key, Nonce: TBytes;
+ const Input: TBytes): TBytes;
+var
+ Ctx: TCnSM4Context;
+ LocalNonce: TCnSM4Nonce;
+ I, Len: Integer;
+begin
+ Len := Length(Input);
+ if Len <= 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ SetLength(Result, Len);
+
+ Len := Length(Key);
+ if Len < CN_SM4_KEYSIZE then // Key С 16 ֽڲ 0
+ begin
+ SetLength(Key, CN_SM4_KEYSIZE);
+ for I := Len to CN_SM4_KEYSIZE - 1 do
+ Key[I] := 0;
+ end;
+ // ȴ 16 ֽʱ SM4SetKeyEnc ԶԺIJ
+
+ MoveMost(Nonce[0], LocalNonce[0], Length(Nonce), SizeOf(TCnSM4Nonce));
+
+ if Mode = SM4_ENCRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ SM4CryptCtr(Ctx, SM4_ENCRYPT, Length(Input), @(LocalNonce[0]), @(Input[0]), @(Result[0]));
+ end
+ else if Mode = SM4_DECRYPT then
+ begin
+ SM4SetKeyEnc(Ctx, @(Key[0])); // ע CTR ĽҲõǼܣ
+ SM4CryptCtr(Ctx, SM4_DECRYPT, Length(Input), @(LocalNonce[0]), @(Input[0]), @(Result[0]));
+ end;
+end;
+
+function SM4EncryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptEcbBytes(SM4_ENCRYPT, Key, Input);
+end;
+
+function SM4DecryptEcbBytes(Key: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptEcbBytes(SM4_DECRYPT, Key, Input);
+end;
+
+function SM4EncryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCbcBytes(SM4_ENCRYPT, Key, Iv, Input);
+end;
+
+function SM4DecryptCbcBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCbcBytes(SM4_DECRYPT, Key, Iv, Input);
+end;
+
+function SM4EncryptCfbBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCfbBytes(SM4_ENCRYPT, Key, Iv, Input);
+end;
+
+function SM4DecryptCfbBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCfbBytes(SM4_DECRYPT, Key, Iv, Input);
+end;
+
+function SM4EncryptOfbBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptOfbBytes(SM4_ENCRYPT, Key, Iv, Input);
+end;
+
+function SM4DecryptOfbBytes(Key, Iv: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptOfbBytes(SM4_DECRYPT, Key, Iv, Input);
+end;
+
+function SM4EncryptCtrBytes(Key, Nonce: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCtrBytes(SM4_ENCRYPT, Key, Nonce, Input);
+end;
+
+function SM4DecryptCtrBytes(Key, Nonce: TBytes; Input: TBytes): TBytes;
+begin
+ Result := SM4CryptCtrBytes(SM4_DECRYPT, Key, Nonce, Input);
+end;
+
+function SM4EncryptEcbBytesToHex(Key: TBytes; Input: TBytes): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(SM4EncryptEcbBytes(Key, Input)));
+end;
+
+function SM4DecryptEcbBytesFromHex(Key: TBytes; const Input: AnsiString): TBytes;
+begin
+ Result := SM4DecryptEcbBytes(Key, HexToBytes(string(Input)));
+end;
+
+function SM4EncryptCbcBytesToHex(Key, Iv: TBytes; Input: TBytes): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(SM4EncryptCbcBytes(Key, Iv, Input)));
+end;
+
+function SM4DecryptCbcBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
+begin
+ Result := SM4DecryptCbcBytes(Key, Iv, HexToBytes(string(Input)));
+end;
+
+function SM4EncryptCfbBytesToHex(Key, Iv: TBytes; Input: TBytes): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(SM4EncryptCfbBytes(Key, Iv, Input)));
+end;
+
+function SM4DecryptCfbBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
+begin
+ Result := SM4DecryptCfbBytes(Key, Iv, HexToBytes(string(Input)));
+end;
+
+function SM4EncryptOfbBytesToHex(Key, Iv: TBytes; Input: TBytes): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(SM4EncryptOfbBytes(Key, Iv, Input)));
+end;
+
+function SM4DecryptOfbBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
+begin
+ Result := SM4DecryptOfbBytes(Key, Iv, HexToBytes(string(Input)));
+end;
+
+function SM4EncryptCtrBytesToHex(Key, Nonce: TBytes; Input: TBytes): AnsiString;
+begin
+ Result := AnsiString(BytesToHex(SM4EncryptCtrBytes(Key, Nonce, Input)));
+end;
+
+function SM4DecryptCtrBytesFromHex(Key, Nonce: TBytes; const Input: AnsiString): TBytes;
+begin
+ Result := SM4DecryptCtrBytes(Key, Nonce, HexToBytes(string(Input)));
+end;
+
+procedure SM4EncryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then // β 0
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4DecryptStreamECB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnSM4Buffer)) > 0 then
+ raise ECnSM4Exception.Create(SCnErrorSM4InvalidInBufSize);
+
+ SM4SetKeyDec(Ctx, @(Key[0]));
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+end;
+
+procedure SM4EncryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Move(TempOut[0], Vector[0], SizeOf(TCnSM4Iv));
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ FillChar(TempIn[Count], SizeOf(TempIn) - Count, 0);
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@Vector[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@Vector[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@Vector[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@Vector[12])^;
+
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4DecryptStreamCBC(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector1, Vector2: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+ if (Count mod SizeOf(TCnSM4Buffer)) > 0 then
+ raise ECnSM4Exception.Create(SCnErrorSM4InvalidInBufSize);
+
+ Vector1 := InitVector;
+ SM4SetKeyDec(Ctx, @(Key[0]));
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorSM4ReadError);
+
+ Move(TempIn[0], Vector2[0], SizeOf(TCnSM4Iv));
+ SM4OneRound(@(Ctx.Sk[0]), @(TempIn[0]), @(TempOut[0]));
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@Vector1[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@Vector1[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@Vector1[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@Vector1[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut));
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorSM4WriteError);
+
+ Vector1 := Vector2;
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+end;
+
+procedure SM4EncryptStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Key ȼ Iv
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // ĽдĽ
+ if Done < SizeOf(TempOut) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Move(TempOut[0], Vector[0], SizeOf(TCnSM4Iv)); // Ľȡ Iv һּ
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4DecryptStreamCFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ SM4SetKeyEnc(Ctx, @(Key[0])); // עǼܣǽܣ
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn)); // Ķ TempIn
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Iv ȼ TempOut
+
+ // ܺ TempOut TempIn õ TempOut
+ PCardinal(@TempOut[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempOut, SizeOf(TempOut)); // TempOut дȥ
+ if Done < SizeOf(TempOut) then
+ raise EStreamError(SCnErrorSM4WriteError);
+ Move(TempIn[0], Vector[0], SizeOf(TCnSM4Iv)); // TempIn ȡ Iv Ϊһμ
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempOut[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempOut[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempOut[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempOut[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempOut, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4EncryptStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Key ȼ Iv
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Move(TempOut[0], Vector[0], SizeOf(TCnSM4Iv)); // ܽȡ Iv һּܣעⲻ
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4DecryptStreamOFB(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Vector := InitVector;
+ SM4SetKeyEnc(Ctx, @(Key[0])); // עǼܣǽܣ
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn)); // Ķ TempIn
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Iv ȼ TempOut
+
+ // ܺ TempOut TempIn õ TempIn
+ PCardinal(@TempIn[0])^ := PCardinal(@TempOut[0])^ xor PCardinal(@TempIn[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempOut[4])^ xor PCardinal(@TempIn[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempOut[8])^ xor PCardinal(@TempIn[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempOut[12])^ xor PCardinal(@TempIn[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // TempIn дȥ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError(SCnErrorSM4WriteError);
+ Move(TempOut[0], Vector[0], SizeOf(TCnSM4Iv)); // ܽ TempOut ȡ Iv Ϊһμ
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4EncryptStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitNonce: TCnSM4Nonce; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+ Cnt, T: Int64;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Cnt := 1;
+ SM4SetKeyEnc(Ctx, @(Key[0]));
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ // Nonce ͼƴ Iv
+ T := Int64HostToNetwork(Cnt);
+ Move(InitNonce[0], Vector[0], SizeOf(TCnSM4Nonce));
+ Move(T, Vector[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Key ȼ Iv
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Inc(Cnt);
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ // Nonce ͼƴ Iv
+ T := Int64HostToNetwork(Cnt);
+ Move(InitNonce[0], Vector[0], SizeOf(TCnSM4Nonce));
+ Move(T, Vector[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+procedure SM4DecryptStreamCTR(Source: TStream; Count: Cardinal;
+ const Key: TCnSM4Key; const InitNonce: TCnSM4Nonce; Dest: TStream);
+var
+ TempIn, TempOut: TCnSM4Buffer;
+ Vector: TCnSM4Iv;
+ Done: Cardinal;
+ Ctx: TCnSM4Context;
+ Cnt, T: Int64;
+begin
+ if Count = 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end
+ else
+ Count := Min(Count, Source.Size - Source.Position);
+
+ if Count = 0 then
+ Exit;
+
+ Cnt := 1;
+ SM4SetKeyEnc(Ctx, @(Key[0])); // עǼܣǽܣ
+
+ while Count >= SizeOf(TCnSM4Buffer) do
+ begin
+ Done := Source.Read(TempIn, SizeOf(TempIn));
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ // Nonce ͼƴ Iv
+ T := Int64HostToNetwork(Cnt);
+ Move(InitNonce[0], Vector[0], SizeOf(TCnSM4Nonce));
+ Move(T, Vector[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0])); // Key ȼ Iv
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^; // ܽ
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, SizeOf(TempIn)); // ĽдĽ
+ if Done < SizeOf(TempIn) then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+
+ Inc(Cnt);
+ Dec(Count, SizeOf(TCnSM4Buffer));
+ end;
+
+ if Count > 0 then
+ begin
+ Done := Source.Read(TempIn, Count);
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4ReadError);
+
+ // Nonce ͼƴ Iv
+ T := Int64HostToNetwork(Cnt);
+ Move(InitNonce[0], Vector[0], SizeOf(TCnSM4Nonce));
+ Move(T, Vector[SizeOf(TCnSM4Nonce)], SizeOf(Int64));
+
+ SM4OneRound(@(Ctx.Sk[0]), @(Vector[0]), @(TempOut[0]));
+
+ PCardinal(@TempIn[0])^ := PCardinal(@TempIn[0])^ xor PCardinal(@TempOut[0])^;
+ PCardinal(@TempIn[4])^ := PCardinal(@TempIn[4])^ xor PCardinal(@TempOut[4])^;
+ PCardinal(@TempIn[8])^ := PCardinal(@TempIn[8])^ xor PCardinal(@TempOut[8])^;
+ PCardinal(@TempIn[12])^ := PCardinal(@TempIn[12])^ xor PCardinal(@TempOut[12])^;
+
+ Done := Dest.Write(TempIn, Count); // дֻijȵIJ֣
+ if Done < Count then
+ raise EStreamError.Create(SCnErrorSM4WriteError);
+ end;
+end;
+
+function SM4GetOutputLengthFromInputLength(InputByteLength: Integer): Integer;
+begin
+ Result := (((InputByteLength - 1) div CN_SM4_BLOCKSIZE) + 1) * CN_SM4_BLOCKSIZE;
+end;
+
+procedure SM4Encrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; ByteLen: Integer);
+var
+ Ctx: TCnSM4Context;
+begin
+ SM4SetKeyEnc(Ctx, Key);
+ SM4CryptEcb(Ctx, SM4_ENCRYPT, ByteLen, Input, Output);
+end;
+
+procedure SM4Decrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; ByteLen: Integer);
+var
+ Ctx: TCnSM4Context;
+begin
+ SM4SetKeyDec(Ctx, Key);
+ SM4CryptEcb(Ctx, SM4_DECRYPT, ByteLen, Input, Output);
+end;
+
+end.
diff --git a/MAINTAINING-CNPACK-SUBSET.md b/MAINTAINING-CNPACK-SUBSET.md
new file mode 100644
index 0000000..55b0e9c
--- /dev/null
+++ b/MAINTAINING-CNPACK-SUBSET.md
@@ -0,0 +1,100 @@
+# Maintaining the bundled CnPack subset (boss-installability)
+
+**Read this before touching `CnPack/`, releasing a new tag, or running the fork-sync.**
+
+## Why this fork exists
+
+`freitasjca/Delphi-Cross-Socket` is a fork of
+[`winddriver/Delphi-Cross-Socket`](https://github.com/winddriver/Delphi-Cross-Socket)
+whose **only reason to exist is to be installable with [Boss](https://github.com/HashLoad/boss)**
+(the Delphi package manager). Two upstreams block that:
+
+- **`winddriver/Delphi-Cross-Socket`** ships no `boss.json`.
+- **CnPack / [`cnpack/cnvcl`](https://github.com/cnpack/cnvcl)** — a *dependency* of
+ Delphi-Cross-Socket's SSL/crypto layer — also has no `boss.json` and is a huge repo.
+
+So this fork adds (a) a `boss.json`, (b) the **minimal CnPack subset** that
+Delphi-Cross-Socket actually needs, vendored under `CnPack/`, and (c) the mTLS additions
+(`Net/Net.CrossSslSocket.{Base,OpenSSL}.pas`). A consumer (e.g.
+[`horse-provider-crosssocket`](https://github.com/freitasjca/horse-provider-crosssocket))
+can then `boss install` this fork and compile **without ever touching cnvcl**.
+
+> The `boss.json` `description` currently says *"adds Boss package manifest only. Zero source
+> changes"* — that is **stale**: the fork also vendors the CnPack subset and the mTLS patches.
+> Update it when convenient.
+
+## The invariant — what must always hold
+
+The vendored subset **must be a complete, self-contained transitive closure** so the package
+compiles standalone:
+
+1. **`CnPack/Common/CnPack.inc` must be present.** Every Cn unit begins with `{$I CnPack.inc}`;
+ without it nothing compiles.
+2. **Every unit named in any `uses` clause of a bundled unit must also be bundled.** If you add
+ a Crypto unit that pulls in a new `Cn*` dependency, that dependency has to be copied in too.
+3. The split mirrors cnvcl's own layout: foundation units in `CnPack/Common/`, crypto in
+ `CnPack/Crypto/`.
+
+### Current inventory (18 files — keep this list and the fork-sync in step)
+
+```
+CnPack/Common/ CnPack.inc CnConsts.pas CnFloat.pas CnStrings.pas CnWideStrings.pas
+CnPack/Crypto/ CnAES.pas CnBase64.pas CnDES.pas CnKDF.pas CnMD5.pas CnNative.pas
+ CnPemUtils.pas CnRandom.pas CnSHA1.pas CnSHA2.pas CnSHA3.pas
+ CnSM3.pas CnSM4.pas
+```
+
+> History: earlier releases kept everything under `CnPack/Crypto/` (14 units). cnvcl later
+> moved the foundation units to `Source/Common/` and added `CnStrings`, `CnWideStrings`,
+> `CnSM4`; the v1.0.3 re-sync follows that — hence the `Common/` directory.
+
+## Re-syncing the subset when cnvcl updates
+
+1. Update your local cnvcl: `cd cnvcl && git pull --ff-only origin master`.
+2. Copy the units above from cnvcl into the fork:
+ - `cnvcl/Source/Common/{CnPack.inc,CnConsts,CnFloat,CnStrings,CnWideStrings}` → `CnPack/Common/`
+ - `cnvcl/Source/Crypto/{the 13 crypto units}.pas` → `CnPack/Crypto/`
+ - (verify the cnvcl source-side paths — cnvcl occasionally relocates units between
+ `Source/Common` and `Source/Crypto`.)
+3. **Re-validate the closure** — the only authoritative check (the CnPack sources are
+ **GBK/ANSI-encoded**, which defeats `grep`-based scans): `boss install` this fork into a
+ throwaway project, or build `horse-provider-crosssocket` against it, and confirm a clean
+ compile with **no missing `Cn*` unit**. If the compiler reports a missing unit, copy it in
+ and repeat.
+4. Commit the subset change on its own (`git add -A CnPack/` so renames register), separate
+ from version bumps and `.gitattributes` changes.
+
+## ⚠️ Keep the fork-sync automation in step — or it reverts the subset
+
+The fork-sync (`crosssocket-fork-sync-action/` → deployed to the fork's `master` as a daily
+GitHub Action) **resets `master` to upstream's tip and re-layers the CnPack subset from a
+hardcoded list**. If that list doesn't match the inventory above, the next nightly run
+**silently restores the wrong subset and breaks the boss build.** Two files must be updated
+together with any subset change:
+
+- `.github/workflows/sync-upstream.yml` — the `Clone CnPack (cnvcl) and copy required files`
+ step (the actual `cp` list + the `mkdir CnPack/Common CnPack/Crypto`).
+- `.sync/README.md` — the human-readable manifest table (fork path ← cnvcl source path).
+
+Optionally pin `CNVCL_REF` in `sync-upstream.yml` to a validated cnvcl tag/sha instead of
+`master`, so a surprise upstream cnvcl change can't break a nightly sync.
+
+## Consumer-side note
+
+Because the foundation units live in `CnPack/Common/`, any consuming project's search path must
+include **both** `CnPack/Common` **and** `CnPack/Crypto` (see the "Required search paths" list
+in `horse-provider-crosssocket`'s README). Adding only `Crypto/` will fail to resolve
+`CnConsts`/`CnFloat`/`CnStrings`/`CnWideStrings`.
+
+## Don't track build/IDE artifacts
+
+`.dcu`, `.res`, `.dproj.local`, `.dsv`, `__history/` must stay out of the repo (they bloat it
+and create false "modified" churn). They are covered by `.gitignore`; if any are already
+tracked, `git rm --cached` them.
+
+## Endgame
+
+The mTLS additions are pending an upstream PR. Once upstream merges them **and** a boss-friendly
+distribution of Delphi-Cross-Socket + CnPack exists, this fork (and this whole subset-maintenance
+burden) can be retired. Until then, every cnvcl bump is a re-sync chore — keep this doc, the
+inventory, and the fork-sync manifest aligned.
diff --git a/Net/Demos/Delphi/HttpClient/HttpClient.dproj b/Net/Demos/Delphi/HttpClient/HttpClient.dproj
index e13e632..2c2470e 100644
--- a/Net/Demos/Delphi/HttpClient/HttpClient.dproj
+++ b/Net/Demos/Delphi/HttpClient/HttpClient.dproj
@@ -4,7 +4,7 @@
HttpClient.dpr
True
Release
- 693379
+ 168067
Console
None
20.3
@@ -23,11 +23,6 @@
Base
true
-
- true
- Base
- true
-
true
Base
@@ -49,8 +44,8 @@
true
true
-
- true
+
+ true
Cfg_1
true
true
@@ -90,12 +85,6 @@
true
true
-
- true
- Cfg_2
- true
- true
-
true
Cfg_2
@@ -133,9 +122,10 @@
System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
$(BDS)\bin\delphi_PROJECTICON.ico
$(BDS)\bin\delphi_PROJECTICNS.icns
- bin\$(Platform)\
- ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;$(DCC_UnitSearchPath)
- .\$(Platform)\$(Config)
+ ..\..\..\..\..\..\bin\$(Platform)\$(Config)
+ ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;C:\lang\Repo\Delphi-Cross-Socket;$(DCC_UnitSearchPath)
+ ..\..\..\..\..\..\temp\$(Platform)\$(Config)
+ ..\..\..\..\..\..\temp\$(Platform)\$(Config)
package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
@@ -171,9 +161,6 @@
$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png
activity-1.1.0.dex.jar;annotation-1.2.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;asynclayoutinflater-1.0.0.dex.jar;billing-4.0.0.dex.jar;biometric-1.1.0.dex.jar;browser-1.0.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;coordinatorlayout-1.0.0.dex.jar;core-1.5.0-rc02.dex.jar;core-common-2.1.0.dex.jar;core-runtime-2.1.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;firebase-annotations-16.0.0.dex.jar;firebase-common-20.0.0.dex.jar;firebase-components-17.0.0.dex.jar;firebase-datatransport-18.0.0.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.0.0.dex.jar;firebase-installations-interop-17.0.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-22.0.0.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;legacy-support-core-ui-1.0.0.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.2.0.dex.jar;lifecycle-livedata-2.0.0.dex.jar;lifecycle-livedata-core-2.2.0.dex.jar;lifecycle-runtime-2.2.0.dex.jar;lifecycle-service-2.0.0.dex.jar;lifecycle-viewmodel-2.2.0.dex.jar;lifecycle-viewmodel-savedstate-2.2.0.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;play-services-ads-20.1.0.dex.jar;play-services-ads-base-20.1.0.dex.jar;play-services-ads-identifier-17.0.0.dex.jar;play-services-ads-lite-20.1.0.dex.jar;play-services-base-17.5.0.dex.jar;play-services-basement-17.6.0.dex.jar;play-services-cloud-messaging-16.0.0.dex.jar;play-services-drive-17.0.0.dex.jar;play-services-games-21.0.0.dex.jar;play-services-location-18.0.0.dex.jar;play-services-maps-17.0.1.dex.jar;play-services-measurement-base-18.0.0.dex.jar;play-services-measurement-sdk-api-18.0.0.dex.jar;play-services-places-placereport-17.0.0.dex.jar;play-services-stats-17.0.0.dex.jar;play-services-tasks-17.2.0.dex.jar;print-1.0.0.dex.jar;room-common-2.1.0.dex.jar;room-runtime-2.1.0.dex.jar;savedstate-1.0.0.dex.jar;slidingpanelayout-1.0.0.dex.jar;sqlite-2.0.1.dex.jar;sqlite-framework-2.0.1.dex.jar;swiperefreshlayout-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.0.0.dex.jar;transport-runtime-3.0.0.dex.jar;user-messaging-platform-1.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.1.0.dex.jar
-
- $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png
-
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
Debug
@@ -195,8 +182,10 @@
Debug
-
- Debug
+
+ /usr/bin/gnome-terminal -- "%debuggee%"
+ (None)
+ none
Debug
@@ -226,9 +215,6 @@
Debug
-
- Debug
-
Debug
@@ -286,8 +272,6 @@
False
True
- True
- True
True
True
True
diff --git a/Net/Demos/Delphi/HttpServer/HttpServer.dproj b/Net/Demos/Delphi/HttpServer/HttpServer.dproj
index 1bdc2de..247c26a 100644
--- a/Net/Demos/Delphi/HttpServer/HttpServer.dproj
+++ b/Net/Demos/Delphi/HttpServer/HttpServer.dproj
@@ -4,11 +4,12 @@
HttpServer.dpr
True
Release
- 693379
+ 168067
Console
None
- 19.5
+ 20.2
Win64
+ HttpServer
true
@@ -23,11 +24,6 @@
Base
true
-
- true
- Base
- true
-
true
Base
@@ -43,6 +39,24 @@
Base
true
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
true
Cfg_1
@@ -60,12 +74,6 @@
true
true
-
- true
- Cfg_2
- true
- true
-
true
Cfg_2
@@ -97,8 +105,10 @@
System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
$(BDS)\bin\delphi_PROJECTICON.ico
$(BDS)\bin\delphi_PROJECTICNS.icns
- bin\$(Platform)\
- ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;$(DCC_UnitSearchPath)
+ ..\..\..\..\..\..\bin\$(Platform)\$(Config)
+ ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;C:\lang\Repo\Delphi-Cross-Socket;..\..\..\..\CnPack\Common;..\..\..\..\CnPack\Crypto;$(DCC_UnitSearchPath)
+ ..\..\..\..\..\..\temp\$(Platform)\$(Config)
+ ..\..\..\..\..\..\temp\$(Platform)\$(Config)
package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
@@ -134,9 +144,6 @@
$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png
activity-1.1.0.dex.jar;annotation-1.2.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;asynclayoutinflater-1.0.0.dex.jar;billing-4.0.0.dex.jar;biometric-1.1.0.dex.jar;browser-1.0.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;coordinatorlayout-1.0.0.dex.jar;core-1.5.0-rc02.dex.jar;core-common-2.1.0.dex.jar;core-runtime-2.1.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;firebase-annotations-16.0.0.dex.jar;firebase-common-20.0.0.dex.jar;firebase-components-17.0.0.dex.jar;firebase-datatransport-18.0.0.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.0.0.dex.jar;firebase-installations-interop-17.0.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-22.0.0.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;legacy-support-core-ui-1.0.0.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.2.0.dex.jar;lifecycle-livedata-2.0.0.dex.jar;lifecycle-livedata-core-2.2.0.dex.jar;lifecycle-runtime-2.2.0.dex.jar;lifecycle-service-2.0.0.dex.jar;lifecycle-viewmodel-2.2.0.dex.jar;lifecycle-viewmodel-savedstate-2.2.0.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;play-services-ads-20.1.0.dex.jar;play-services-ads-base-20.1.0.dex.jar;play-services-ads-identifier-17.0.0.dex.jar;play-services-ads-lite-20.1.0.dex.jar;play-services-base-17.5.0.dex.jar;play-services-basement-17.6.0.dex.jar;play-services-cloud-messaging-16.0.0.dex.jar;play-services-drive-17.0.0.dex.jar;play-services-games-21.0.0.dex.jar;play-services-location-18.0.0.dex.jar;play-services-maps-17.0.1.dex.jar;play-services-measurement-base-18.0.0.dex.jar;play-services-measurement-sdk-api-18.0.0.dex.jar;play-services-places-placereport-17.0.0.dex.jar;play-services-stats-17.0.0.dex.jar;play-services-tasks-17.2.0.dex.jar;print-1.0.0.dex.jar;room-common-2.1.0.dex.jar;room-runtime-2.1.0.dex.jar;savedstate-1.0.0.dex.jar;slidingpanelayout-1.0.0.dex.jar;sqlite-2.0.1.dex.jar;sqlite-framework-2.0.1.dex.jar;swiperefreshlayout-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.0.0.dex.jar;transport-runtime-3.0.0.dex.jar;user-messaging-platform-1.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.1.0.dex.jar
-
- $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png
-
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
Debug
@@ -155,6 +162,15 @@
false
0
+
+ Debug
+
+
+ Debug
+
+
+ Debug
+
1033
CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
@@ -171,9 +187,6 @@
Debug
-
- Debug
-
Debug
@@ -211,21 +224,15 @@
HttpServer.dpr
- Embarcadero C++Builder Office 2000 Servers Package
- Embarcadero C++Builder Office XP Servers Package
- Microsoft Office 2000 Sample Automation Server Wrapper Components
- Microsoft Office XP Sample Automation Server Wrapper Components
- File C:\Users\Public\Documents\Embarcadero\Studio\22.0\Bpl\CEF4Delphi_FMX.bpl not found
- File C:\Users\Public\Documents\Embarcadero\Studio\22.0\Bpl\AutoUpgraderProXE10.bpl not found
- File C:\Users\Public\Documents\Embarcadero\Studio\22.0\Bpl\KastriFMX280.bpl not found
- File C:\Users\Public\Documents\Embarcadero\Studio\22.0\Bpl\CEF4Delphi.bpl not found
+ Embarcadero C++Builder Office 2000 Servers Package
+ Embarcadero C++Builder Office XP Servers Package
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
False
True
- True
- True
True
True
True
diff --git a/Net/Demos/Delphi/HttpServer/HttpServer.dproj.local b/Net/Demos/Delphi/HttpServer/HttpServer.dproj.local
deleted file mode 100644
index b3811b7..0000000
--- a/Net/Demos/Delphi/HttpServer/HttpServer.dproj.local
+++ /dev/null
@@ -1,2 +0,0 @@
-
-
diff --git a/Net/Demos/Delphi/HttpServer/HttpServer.res b/Net/Demos/Delphi/HttpServer/HttpServer.res
deleted file mode 100644
index f319bd8..0000000
Binary files a/Net/Demos/Delphi/HttpServer/HttpServer.res and /dev/null differ
diff --git a/Net/Demos/Delphi/WebSocketClient/WebSocketClient.dproj.local b/Net/Demos/Delphi/WebSocketClient/WebSocketClient.dproj.local
deleted file mode 100644
index b3811b7..0000000
--- a/Net/Demos/Delphi/WebSocketClient/WebSocketClient.dproj.local
+++ /dev/null
@@ -1,2 +0,0 @@
-
-
diff --git a/Net/Demos/Delphi/WebSocketClient/WebSocketClient.res b/Net/Demos/Delphi/WebSocketClient/WebSocketClient.res
deleted file mode 100644
index f319bd8..0000000
Binary files a/Net/Demos/Delphi/WebSocketClient/WebSocketClient.res and /dev/null differ
diff --git a/Net/Demos/Delphi/WebSocketServer/WebSocketServer.dproj.local b/Net/Demos/Delphi/WebSocketServer/WebSocketServer.dproj.local
deleted file mode 100644
index b3811b7..0000000
--- a/Net/Demos/Delphi/WebSocketServer/WebSocketServer.dproj.local
+++ /dev/null
@@ -1,2 +0,0 @@
-
-
diff --git a/Net/Demos/Delphi/WebSocketServer/WebSocketServer.res b/Net/Demos/Delphi/WebSocketServer/WebSocketServer.res
deleted file mode 100644
index f319bd8..0000000
Binary files a/Net/Demos/Delphi/WebSocketServer/WebSocketServer.res and /dev/null differ
diff --git a/Net/Demos/Old/CrossHttpConsole/CrossHttpConsole.res b/Net/Demos/Old/CrossHttpConsole/CrossHttpConsole.res
deleted file mode 100644
index 36f26e2..0000000
Binary files a/Net/Demos/Old/CrossHttpConsole/CrossHttpConsole.res and /dev/null differ
diff --git a/Net/Demos/Old/CrossWebSocket/CrossWebSocketServer.res b/Net/Demos/Old/CrossWebSocket/CrossWebSocketServer.res
deleted file mode 100644
index 1446e4c..0000000
Binary files a/Net/Demos/Old/CrossWebSocket/CrossWebSocketServer.res and /dev/null differ
diff --git a/Net/Demos/Old/TestCrossSocket/TestCrossSocket.res b/Net/Demos/Old/TestCrossSocket/TestCrossSocket.res
deleted file mode 100644
index f1a190a..0000000
Binary files a/Net/Demos/Old/TestCrossSocket/TestCrossSocket.res and /dev/null differ
diff --git a/Net/Linux.epoll.pas b/Net/Linux.epoll.pas
index 3dca1e7..b876503 100644
--- a/Net/Linux.epoll.pas
+++ b/Net/Linux.epoll.pas
@@ -1,79 +1,79 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Linux.epoll;
-
-{$I zLib.inc}
-
-interface
-
-uses
- {$IFDEF DELPHI}
- Posix.Base,
- Posix.StdDef,
- Posix.SysTypes,
- Posix.Signal
- {$ELSE}
- BaseUnix,
- Unix
- {$ENDIF}
- ;
-
-const
- EPOLLIN = $01; { The associated file is available for read(2) operations. }
- EPOLLPRI = $02; { There is urgent data available for read(2) operations. }
- EPOLLOUT = $04; { The associated file is available for write(2) operations. }
- EPOLLERR = $08; { Error condition happened on the associated file descriptor. }
- EPOLLHUP = $10; { Hang up happened on the associated file descriptor. }
- EPOLLONESHOT = $40000000; { Sets the One-Shot behaviour for the associated file descriptor. }
- EPOLLET = $80000000; { Sets the Edge Triggered behaviour for the associated file descriptor. }
-
- { Valid opcodes ( "op" parameter ) to issue to epoll_ctl }
- EPOLL_CTL_ADD = 1;
- EPOLL_CTL_DEL = 2;
- EPOLL_CTL_MOD = 3;
-
-type
- EPoll_Data = record
- case integer of
- 0: (ptr: pointer);
- 1: (fd: Integer);
- 2: (u32: Cardinal);
- 3: (u64: UInt64);
- end;
- TEPoll_Data = Epoll_Data;
- PEPoll_Data = ^Epoll_Data;
-
- EPoll_Event = {$IFDEF CPUX64}packed {$ENDIF}record
- Events: Cardinal;
- Data : TEpoll_Data;
- end;
-
- TEPoll_Event = Epoll_Event;
- PEpoll_Event = ^Epoll_Event;
-
-{$IF DEFINED(FPC)}
-{$LINKLIB c}
-{$ENDIF}
-
-{ open an epoll file descriptor }
-function epoll_create(size: Integer): Integer; cdecl;
- external {$IFDEF DELPHI}libc name 'epoll_create'{$ENDIF};
-
-{ control interface for an epoll descriptor }
-function epoll_ctl(epfd, op, fd: Integer; event: pepoll_event): Integer; cdecl;
- external {$IFDEF DELPHI}libc name 'epoll_ctl'{$ENDIF};
-
-{ wait for an I/O event on an epoll file descriptor }
-function epoll_wait(epfd: Integer; events: pepoll_event; maxevents, timeout: Integer): Integer; cdecl;
- external {$IFDEF DELPHI}libc name 'epoll_wait'{$ENDIF};
-
-implementation
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Linux.epoll;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ {$IFDEF DELPHI}
+ Posix.Base,
+ Posix.StdDef,
+ Posix.SysTypes,
+ Posix.Signal
+ {$ELSE}
+ BaseUnix,
+ Unix
+ {$ENDIF}
+ ;
+
+const
+ EPOLLIN = $01; { The associated file is available for read(2) operations. }
+ EPOLLPRI = $02; { There is urgent data available for read(2) operations. }
+ EPOLLOUT = $04; { The associated file is available for write(2) operations. }
+ EPOLLERR = $08; { Error condition happened on the associated file descriptor. }
+ EPOLLHUP = $10; { Hang up happened on the associated file descriptor. }
+ EPOLLONESHOT = $40000000; { Sets the One-Shot behaviour for the associated file descriptor. }
+ EPOLLET = $80000000; { Sets the Edge Triggered behaviour for the associated file descriptor. }
+
+ { Valid opcodes ( "op" parameter ) to issue to epoll_ctl }
+ EPOLL_CTL_ADD = 1;
+ EPOLL_CTL_DEL = 2;
+ EPOLL_CTL_MOD = 3;
+
+type
+ EPoll_Data = record
+ case integer of
+ 0: (ptr: pointer);
+ 1: (fd: Integer);
+ 2: (u32: Cardinal);
+ 3: (u64: UInt64);
+ end;
+ TEPoll_Data = Epoll_Data;
+ PEPoll_Data = ^Epoll_Data;
+
+ EPoll_Event = {$IFDEF CPUX64}packed {$ENDIF}record
+ Events: Cardinal;
+ Data : TEpoll_Data;
+ end;
+
+ TEPoll_Event = Epoll_Event;
+ PEpoll_Event = ^Epoll_Event;
+
+{$IF DEFINED(FPC)}
+{$LINKLIB c}
+{$ENDIF}
+
+{ open an epoll file descriptor }
+function epoll_create(size: Integer): Integer; cdecl;
+ external {$IFDEF DELPHI}libc name 'epoll_create'{$ENDIF};
+
+{ control interface for an epoll descriptor }
+function epoll_ctl(epfd, op, fd: Integer; event: pepoll_event): Integer; cdecl;
+ external {$IFDEF DELPHI}libc name 'epoll_ctl'{$ENDIF};
+
+{ wait for an I/O event on an epoll file descriptor }
+function epoll_wait(epfd: Integer; events: pepoll_event; maxevents, timeout: Integer): Integer; cdecl;
+ external {$IFDEF DELPHI}libc name 'epoll_wait'{$ENDIF};
+
+implementation
+
+end.
diff --git a/Net/Net.CrossHttpParams.pas b/Net/Net.CrossHttpParams.pas
index b181dd8..36f651e 100644
--- a/Net/Net.CrossHttpParams.pas
+++ b/Net/Net.CrossHttpParams.pas
@@ -1,3509 +1,3509 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossHttpParams;
-
-{$I zLib.inc}
-
-interface
-
-uses
- SysUtils,
- Classes,
- Generics.Collections,
- Generics.Defaults,
- DateUtils,
- Math,
-
- {$IFDEF DELPHI}
- System.Diagnostics,
- {$ELSE}
- DTF.Types,
- DTF.Diagnostics,
- DTF.Generics,
- {$ENDIF}
-
- Net.CrossHttpUtils,
-
- Utils.AnonymousThread,
- Utils.RegEx,
- Utils.IOUtils,
- Utils.DateTime,
- Utils.StrUtils,
- Utils.SyncObjs,
- Utils.ArrayUtils,
- Utils.Utils;
-
-type
- TNameValue = record
- Name, Value: string;
- constructor Create(const AName, AValue: string);
- end;
-
- INameValueComparer = IComparer;
- TNameValueComparison = {$IFDEF DELPHI}TComparison{$ELSE}TComparisonAnonymousFunc{$ENDIF};
- TNameValueComparer = {$IFDEF DELPHI}TDelegatedComparer{$ELSE}TDelegatedComparerAnonymousFunc{$ENDIF};
-
- ///
- /// 参数基础类
- ///
- TBaseParams = class
- private type
- TEnumerator = class
- private
- FIndex: Integer;
- FParams: TBaseParams;
- public
- constructor Create(const AParams: TBaseParams);
- function GetCurrent: TNameValue; inline;
- function MoveNext: Boolean; inline;
- property Current: TNameValue read GetCurrent;
- end;
- private
- FParams: TList;
-
- function GetParamIndex(const AName: string): Integer;
- function GetParam(const AName: string): string;
- procedure SetParam(const AName, AValue: string);
- function GetCount: Integer;
- function GetItem(AIndex: Integer): TNameValue;
- procedure SetItem(AIndex: Integer; const AValue: TNameValue);
- public
- constructor Create; overload; virtual;
- constructor Create(const AEncodedParams: string); overload; virtual;
- destructor Destroy; override;
-
- ///
- /// 枚举器
- ///
- function GetEnumerator: TEnumerator; inline;
-
- ///
- /// 从源对象设置数据
- ///
- procedure Assign(const ASource: TBaseParams);
-
- ///
- /// 添加参数
- ///
- procedure Add(const AParamValue: TNameValue); overload;
-
- ///
- /// 添加参数
- ///
- ///
- /// 参数名
- ///
- ///
- /// 参数值
- ///
- ///
- /// 是否允许重名参数
- ///
- procedure Add(const AName, AValue: string; ADupAllowed: Boolean = False); overload;
-
- ///
- /// 添加已编码参数
- ///
- ///
- /// 已编码参数字符串
- ///
- procedure Add(const AEncodedParams: string); overload;
-
- ///
- /// 根据名称删除指定参数
- ///
- ///
- /// 参数名称
- ///
- procedure Remove(const AName: string); overload;
-
- ///
- /// 根据序号删除指定参数
- ///
- ///
- /// 参数序号
- ///
- procedure Remove(AIndex: Integer); overload;
-
- ///
- /// 清除所有参数
- ///
- procedure Clear;
-
- ///
- /// 对参数排序
- ///
- ///
- /// 自定义比较函数，为nil时按参数名排序
- ///
- procedure Sort(const AComparison: TNameValueComparison = nil);
-
- ///
- /// 从已编码的字符串中解码
- ///
- ///
- /// 已编码字符串
- ///
- ///
- /// 是否清除现有数据
- ///
- ///
- /// 解码是否成功
- ///
- function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; virtual; abstract;
-
- ///
- /// 编码为字符串
- ///
- ///
- /// 编码后的字符串
- ///
- function Encode: string; virtual; abstract;
-
- ///
- /// 获取参数值
- ///
- ///
- /// 参数名称
- ///
- ///
- /// 返回的参数值
- ///
- ///
- /// 如果找到参数返回True，否则返回False
- ///
- function GetParamValue(const AName: string; out AValue: string): Boolean;
-
- ///
- /// 获取指定名称的所有参数值
- ///
- ///
- /// 参数名称
- ///
- ///
- /// 返回的参数值数组
- ///
- ///
- /// 如果找到参数返回True，否则返回False
- ///
- function GetHeaderValues(const AName: string; out AValues: TArray): Boolean;
-
- ///
- /// 是否存在参数
- ///
- ///
- /// 参数名称
- ///
- ///
- /// 如果存在参数返回True，否则返回False
- ///
- function ExistsParam(const AName: string): Boolean;
-
- ///
- /// 按名称访问参数
- ///
- ///
- /// 参数名称
- ///
- ///
- /// 参数值，如果不存在返回空字符串
- ///
- property Params[const AName: string]: string read GetParam write SetParam; default;
-
- ///
- /// 按序号访问参数
- ///
- ///
- /// 参数序号
- ///
- ///
- /// 参数名值对
- ///
- property Items[AIndex: Integer]: TNameValue read GetItem write SetItem;
-
- ///
- /// 参数个数
- ///
- property Count: Integer read GetCount;
- end;
-
- ///
- /// Url参数类
- ///
- THttpUrlParams = class(TBaseParams)
- private
- FEncodeName: Boolean;
- FEncodeValue: Boolean;
- public
- constructor Create; override;
-
- ///
- /// 从已编码的字符串中解码
- ///
- ///
- /// 已编码字符串
- ///
- ///
- /// 是否清除现有数据
- ///
- function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
-
- ///
- /// 编码为字符串
- ///
- function Encode: string; override;
-
- ///
- /// 是否对名称做编码
- ///
- property EncodeName: Boolean read FEncodeName write FEncodeName;
-
- ///
- /// 是否对名称做编码
- ///
- property EncodeValue: Boolean read FEncodeValue write FEncodeValue;
- end;
-
- ///
- /// HTTP头类
- ///
- THttpHeader = class(TBaseParams)
- public
- ///
- /// 从已编码的字符串中解码
- ///
- ///
- /// 已编码字符串
- ///
- ///
- /// 是否清除现有数据
- ///
- function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
-
- ///
- /// 编码为字符串
- ///
- function Encode: string; override;
- end;
-
- {$REGION 'Documentation'}
- ///
- /// x-www-form-urlencoded 格式参数
- ///
- {$ENDREGION}
- TFormUrlEncoded = class(THttpUrlParams);
-
- ///
- /// 带分隔符的参数
- ///
- TDelimitParams = class(TBaseParams)
- private
- FDelimiter: Char;
- FUrlEncode: Boolean;
- public
- constructor Create(const ADelimiter: Char; const AUrlEncode: Boolean = False); reintroduce; overload; virtual;
- constructor Create(const AEncodedParams: string; const ADelimiter: Char; const AUrlEncode: Boolean = False); reintroduce; overload; virtual;
-
- ///
- /// 从已编码的字符串中解码
- ///
- ///
- /// 已编码字符串
- ///
- ///
- /// 是否清除现有数据
- ///
- function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
-
- ///
- /// 编码为字符串
- ///
- function Encode: string; override;
-
- ///
- /// 分隔字符
- ///
- property Delimiter: Char read FDelimiter write FDelimiter;
-
- ///
- /// 是否进行URL编解码
- ///
- property UrlEncode: Boolean read FUrlEncode write FUrlEncode;
- end;
-
- {$REGION 'Documentation'}
- ///
- /// 客户端请求头中的Cookies
- ///
- ///
- ///
- /// 格式如下
- ///
- ///
- /// Cookie: name1=value1; name2=value2; ...
- ///
- ///
- {$ENDREGION}
- TRequestCookies = class(TBaseParams)
- public
- ///
- /// 从已编码的字符串中解码
- ///
- ///
- /// 已编码字符串
- ///
- ///
- /// 是否清除现有数据
- ///
- function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
-
- ///
- /// 编码为字符串
- ///
- function Encode: string; override;
- end;
-
- {$REGION 'Documentation'}
- ///
- /// 响应头中的Cookie
- ///
- ///
- ///
- /// 格式如下
- ///
- ///
- /// Set-Cookie: name=value; [expires=date;] [path=path;]
- /// [domain=domain;] [secure;] [HttpOnly;]
- ///
- ///
- {$ENDREGION}
- TResponseCookie = record
- ///
- /// Cookie名称
- ///
- Name: string;
-
- ///
- /// Cookie数据
- ///
- Value: string;
-
- ///
- /// Cookie有效期秒数, 如果设置为0则浏览器关闭后该Cookie即失效
- ///
- MaxAge: Integer;
-
- ///
- /// 域名作用域
- ///
- ///
- /// 定义Cookie的生效作用域, 只有当域名和路径同时满足的时候, 浏览器才会将Cookie发送给Server.
- /// 如果没有设置Domain和Path的话, 他们会被默认为当前请求页面对应值
- ///
- Domain: string;
-
- ///
- /// 路径作用域
- ///
- ///
- /// 定义Cookie的生效作用域, 只有当域名和路径同时满足的时候, 浏览器才会将Cookie发送给Server.
- /// 如果没有设置Domain和Path的话, 他们会被默认为当前请求页面对应值
- ///
- Path: string;
-
- ///
- /// 是否启用 HttpOnly
- ///
- ///
- /// HttpOnly字段告诉浏览器, 只有在HTTP协议下使用, 对浏览器的脚本不可见, 所以跨站脚本攻击时也不会被窃取
- ///
- HttpOnly: Boolean;
-
- ///
- /// 是否启用Secure
- ///
- ///
- /// Secure字段告诉浏览器在https通道时, 对Cookie进行安全加密, 这样即时有黑客监听也无法获取cookie内容
- ///
- Secure: Boolean;
-
- constructor Create(const AName, AValue: string; AMaxAge: Integer;
- const APath: string = ''; const ADomain: string = '';
- AHttpOnly: Boolean = False; ASecure: Boolean = False); overload;
-
- constructor Create(const ACookieData: string; const ADomain: string = ''); overload;
-
- function Encode: string;
- end;
-
- ///
- /// Cookie类
- ///
- TResponseCookies = class(TList)
- private
- function GetCookieIndex(const AName: string): Integer;
- function GetCookie(const AName: string): TResponseCookie;
- procedure SetCookie(const AName: string; const Value: TResponseCookie);
- public
- procedure AddOrSet(const AName, AValue: string; AMaxAge: Integer;
- const APath: string = ''; const ADomain: string = '';
- AHttpOnly: Boolean = False; ASecure: Boolean = False);
- procedure Remove(const AName: string);
-
- property Cookies[const AName: string]: TResponseCookie read GetCookie write SetCookie;
- end;
-
- TFormField = class
- private
- FName: string;
- FValue: TStream;
- FFileName: string;
- FFilePath: string;
- FContentType: string;
- FContentTransferEncoding: string;
- FValueOwned, FIsTempFile: Boolean;
- public
- constructor Create; overload;
- destructor Destroy; override;
-
- ///
- /// 从源对象设置数据
- ///
- procedure Assign(const ASource: TFormField);
-
- ///
- /// 将数据转为字节
- ///
- function AsBytes: TBytes;
-
- ///
- /// 将数据转为字符串
- ///
- ///
- /// 字符串编码
- ///
- function AsString(AEncoding: TEncoding = nil): string;
-
- ///
- /// 释放流数据
- ///
- procedure FreeValue;
-
- ///
- /// 名称
- ///
- property Name: string read FName;
-
- ///
- /// 原始流数据
- ///
- property Value: TStream read FValue;
-
- ///
- /// 文件名（只有文件才有该属性）
- ///
- property FileName: string read FFileName;
-
- ///
- /// 文件保存路径（只有文件才有该属性）
- ///
- property FilePath: string read FFilePath;
-
- ///
- /// 内容类型（只有文件才有该属性）
- ///
- property ContentType: string read FContentType;
- property ContentTransferEncoding: string read FContentTransferEncoding;
- end;
-
- ///
- /// FormData解码结果
- ///
- TFormDataDecodeResult = (frContinue, frComplete, frFailed);
-
- ///
- /// MultiPartFormData类
- ///
- THttpMultiPartFormData = class
- private type
- TEnumerator = class
- private
- FList: TList;
- FIndex: Integer;
- public
- constructor Create(const AList: TList);
- function GetCurrent: TFormField; inline;
- function MoveNext: Boolean; inline;
- property Current: TFormField read GetCurrent;
- end;
- public type
- TDecodeState = (dsBoundary, dsDetect, dsPartHeader, dsPartData);
-
- ///
- /// 头部结束标记检测状态机, 严格匹配 #13#10#13#10 序列
- ///
- TLineEndState = (lesCR1, lesLF1, lesCR2, lesLF2);
-
- ///
- /// dsDetect 状态: Boundary 标记之后判断是 Header 数据还是结束标记
- ///
- TPostBoundaryState = (pbsDetect, pbsHeader1, pbsEnd1, pbsEnd2, pbsEnd3);
- private const
- MAX_PART_HEADER: Integer = 64 * 1024;
- private
- FBoundary, FStoragePath: string;
- FFirstBoundaryBytes, FBoundaryBytes, FLookbehind: TBytes;
- FBoundaryIndex, FPartDataBegin: Integer;
- FPostBoundaryState: TPostBoundaryState;
- FPrevBoundaryIndex: Integer;
- FDecodeState: TDecodeState;
- FLineEndState: TLineEndState;
- FPartFields: TObjectList;
- FCurrentPartHeader: TBytes;
- FCurrentPartHeaderLen: Integer;
- FCurrentPartField: TFormField;
- FAutoDeleteFiles: Boolean;
- FMaxPartDataSize: Integer;
- FCurrentPartDataSize: Int64;
-
- function GetItemIndex(const AName: string): Integer;
- function GetItem(AIndex: Integer): TFormField;
- function GetCount: Integer;
- function GetDataSize: Integer;
- function GetField(const AName: string): TFormField;
- procedure SetBoundary(const AValue: string);
- public
- constructor Create; virtual;
- destructor Destroy; override;
-
- {$REGION 'Documentation'}
- ///
- /// 枚举器
- ///
- {$ENDREGION}
- function GetEnumerator: TEnumerator; inline;
-
- {$REGION 'Documentation'}
- ///
- /// 从源对象设置数据
- ///
- {$ENDREGION}
- procedure Assign(const ASource: THttpMultiPartFormData);
-
- {$REGION 'Documentation'}
- ///
- /// 初始化Boundary(Decode之前调用)
- ///
- {$ENDREGION}
- procedure InitWithBoundary(const ABoundary: string);
-
- {$REGION 'Documentation'}
- ///
- /// 从内存中解码(必须先调用InitWithBoundary)
- ///
- ///
- /// 待解码数据
- ///
- ///
- /// 数据长度
- ///
- ///
- /// 已知限制: 仅支持 multipart/form-data; 不支持 RFC 2046 preamble/epilogue 文本;
- /// 不支持 multipart/mixed 嵌套; Content-Transfer-Encoding 仅存储不解码.
- ///
- {$ENDREGION}
- function Decode(const ABuf: Pointer; ALen: Integer): TFormDataDecodeResult; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 从内存中解码并返回实际消费的字节数(必须先调用InitWithBoundary)
- ///
- ///
- /// 待解码数据
- ///
- ///
- /// 数据长度
- ///
- ///
- /// 出参: 实际消费的字节数. frComplete 时可能小于 ALen, 调用方需要用剩余字节继续后续解析.
- ///
- {$ENDREGION}
- function Decode(const ABuf: Pointer; ALen: Integer; out AConsumed: Integer): TFormDataDecodeResult; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 从数据流解码(必须先调用InitWithBoundary)
- ///
- ///
- /// 待解码数据流
- ///
- {$ENDREGION}
- function Decode(const AStream: TStream): TFormDataDecodeResult; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 清除所有Items
- ///
- {$ENDREGION}
- procedure Clear;
-
- {$REGION 'Documentation'}
- ///
- /// 添加字段
- ///
- ///
- /// 字段对象
- ///
- {$ENDREGION}
- function AddField(const AField: TFormField): TFormField; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 添加字段
- ///
- ///
- /// 字段名
- ///
- ///
- /// 字段值
- ///
- {$ENDREGION}
- function AddField(const AFieldName: string; const AValue: TBytes): TFormField; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 添加字段
- ///
- ///
- /// 字段名
- ///
- ///
- /// 字段值
- ///
- {$ENDREGION}
- function AddField(const AFieldName, AValue: string): TFormField; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 添加文件字段
- ///
- ///
- /// 字段名
- ///
- ///
- /// 文件名
- ///
- ///
- /// 文件流
- ///
- ///
- /// 是否自动释放
- ///
- {$ENDREGION}
- function AddFile(const AFieldName, AFileName: string;
- const AStream: TStream; const AOwned: Boolean = False): TFormField; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 添加文件字段
- ///
- ///
- /// 字段名
- ///
- ///
- /// 文件名
- ///
- {$ENDREGION}
- function AddFile(const AFieldName, AFileName: string): TFormField; overload;
-
- {$REGION 'Documentation'}
- ///
- /// 根据名称删除指定字段
- ///
- ///
- /// 字段名
- ///
- {$ENDREGION}
- procedure Remove(const AFieldName: string); overload;
-
- {$REGION 'Documentation'}
- ///
- /// 根据序号删除指定字段
- ///
- ///
- /// 字段序号
- ///
- {$ENDREGION}
- procedure Remove(AIndex: Integer); overload;
-
- {$REGION 'Documentation'}
- ///
- /// 查找参数
- ///
- {$ENDREGION}
- function FindField(const AFieldName: string; out AField: TFormField): Boolean;
-
- function AsBytes(const AFieldName: string; out AValue: TBytes): Boolean; overload;
- function AsBytes(const AFieldName: string): TBytes; overload;
-
- function AsStream(const AFieldName: string; out AValue: TStream): Boolean; overload;
- function AsStream(const AFieldName: string): TStream; overload;
-
- function AsString(const AFieldName: string; const AEncoding: TEncoding; out AValue: string): Boolean; overload;
- function AsString(const AFieldName: string; out AValue: string): Boolean; overload;
- function AsString(const AFieldName: string; const AEncoding: TEncoding = nil): string; overload;
-
- {$REGION 'Documentation'}
- ///
- /// Boundary特征字符串
- ///
- {$ENDREGION}
- property Boundary: string read FBoundary write SetBoundary;
-
- {$REGION 'Documentation'}
- ///
- /// 上传文件保存的路径
- ///
- {$ENDREGION}
- property StoragePath: string read FStoragePath write FStoragePath;
-
- {$REGION 'Documentation'}
- ///
- /// 按序号访问参数
- ///
- {$ENDREGION}
- property Items[AIndex: Integer]: TFormField read GetItem;
-
- {$REGION 'Documentation'}
- ///
- /// 按名称访问参数
- ///
- {$ENDREGION}
- property Fields[const AName: string]: TFormField read GetField;
-
- {$REGION 'Documentation'}
- ///
- /// Items个数(只读)
- ///
- {$ENDREGION}
- property Count: Integer read GetCount;
-
- {$REGION 'Documentation'}
- ///
- /// 所有Items数据的总尺寸(字节数)
- ///
- {$ENDREGION}
- property DataSize: Integer read GetDataSize;
-
- {$REGION 'Documentation'}
- ///
- /// 对象释放时自动删除上传的文件
- ///
- {$ENDREGION}
- property AutoDeleteFiles: Boolean read FAutoDeleteFiles write FAutoDeleteFiles;
-
- {$REGION 'Documentation'}
- ///
- /// 单个 Part Body 最大字节数, 0 表示不限制. 超过限制时 Decode 返回 frFailed.
- ///
- {$ENDREGION}
- property MaxPartDataSize: Integer read FMaxPartDataSize write FMaxPartDataSize;
- end;
-
- {$REGION 'Documentation'}
- ///
- /// MultiPartFormData流
- ///
- ///
- /// 动态从 MultiPartFormData 对象中读取数据, 而不是打包到内存中, 所以支持从磁盘加载超大文件
- ///
- {$ENDREGION}
- THttpMultiPartFormStream = class(TStream)
- private type
- TFormFieldEx = record
- Header: TBytes;
- Field: TFormField;
- Offset: Int64;
-
- function HeaderSize: Integer;
- function DataSize: Int64;
- function TotalSize: Int64;
- end;
-
- TFormFieldExArray = TArray;
- private
- FMultiPartFormData: THttpMultiPartFormData;
- FOwned: Boolean;
- FFormFieldExArray: TFormFieldExArray;
- FMultiPartEnd: TBytes;
- FSize, FPosition, FEndPos: Int64;
-
- procedure _Init;
- function _GetFiledIndexByOffset(const AOffset: Int64): Integer;
- public
- constructor Create(const AMultiPartFormData: THttpMultiPartFormData;
- const AOwned: Boolean = False); reintroduce;
- destructor Destroy; override;
-
- function Read(var ABuffer; ACount: Longint): Longint; override;
- function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
-
- property MultiPartFormData: THttpMultiPartFormData read FMultiPartFormData;
- end;
-
- TSessionsBase = class;
- ISessions = interface;
-
- ///
- /// Session成员接口
- ///
- ISession = interface
- ['{A3D525A1-C534-4CE6-969B-53C5B8CB77C3}']
- function GetOwner: ISessions;
-
- function GetSessionID: string;
- function GetCreateTime: TDateTime;
- function GetLastAccessTime: TDateTime;
- function GetExpiryTime: Integer;
- function GetValue(const AName: string): string;
- procedure SetSessionID(const ASessionID: string);
- procedure SetCreateTime(const ACreateTime: TDateTime);
- procedure SetLastAccessTime(const ALastAccessTime: TDateTime);
- procedure SetExpiryTime(const Value: Integer);
- procedure SetValue(const AName, AValue: string);
-
- ///
- /// 更新最后访问时间
- ///
- procedure Touch;
-
- ///
- /// 是否已过期
- ///
- function Expired: Boolean;
-
- ///
- /// 父容器
- ///
- property Owner: ISessions read GetOwner;
-
- ///
- /// Session ID
- ///
- property SessionID: string read GetSessionID write SetSessionID;
-
- ///
- /// 创建时间
- ///
- property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
-
- ///
- /// 最后访问时间
- ///
- property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
-
- ///
- /// Session过期时间(秒)
- ///
- ///
- ///
- /// -
- /// 值大于0时, 当Session超过设定值秒数没有使用就会被释放;
- ///
- /// -
- /// 值等于0时, 使用父容器的超时设置
- ///
- /// -
- /// 值小于0时, Session生成后一直有效
- ///
- ///
- ///
- property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
-
- ///
- /// Session是一个KEY-VALUE结构的数据, 该属性用于访问其中的成员值
- ///
- property Values[const AName: string]: string read GetValue write SetValue; default;
- end;
-
- TSessionBase = class abstract(TInterfacedObject, ISession)
- private
- FOwner: TSessionsBase;
- protected
- function GetOwner: ISessions;
- function GetSessionID: string; virtual; abstract;
- function GetCreateTime: TDateTime; virtual; abstract;
- function GetLastAccessTime: TDateTime; virtual; abstract;
- function GetExpiryTime: Integer; virtual; abstract;
- function GetValue(const AName: string): string; virtual; abstract;
- procedure SetSessionID(const ASessionID: string); virtual; abstract;
- procedure SetCreateTime(const ACreateTime: TDateTime); virtual; abstract;
- procedure SetLastAccessTime(const ALastAccessTime: TDateTime); virtual; abstract;
- procedure SetExpiryTime(const Value: Integer); virtual; abstract;
- procedure SetValue(const AName, AValue: string); virtual; abstract;
- public
- constructor Create(const AOwner: TSessionsBase; const ASessionID: string); virtual;
-
- procedure Touch; virtual;
- function Expired: Boolean; virtual;
-
- property Owner: ISessions read GetOwner;
-
- property SessionID: string read GetSessionID write SetSessionID;
- property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
- property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
- property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
- property Values[const AName: string]: string read GetValue write SetValue; default;
- end;
-
- TSession = class(TSessionBase)
- protected
- FSessionID: string;
- FCreateTime: TDateTime;
- FLastAccessTime: TDateTime;
- FExpire: Integer;
- FValues: TDictionary;
-
- function GetSessionID: string; override;
- function GetCreateTime: TDateTime; override;
- function GetLastAccessTime: TDateTime; override;
- function GetExpiryTime: Integer; override;
- function GetValue(const AName: string): string; override;
- procedure SetSessionID(const ASessionID: string); override;
- procedure SetCreateTime(const ACreateTime: TDateTime); override;
- procedure SetLastAccessTime(const ALastAccessTime: TDateTime); override;
- procedure SetExpiryTime(const AValue: Integer); override;
- procedure SetValue(const AName, AValue: string); override;
- public
- constructor Create(const AOwner: TSessionsBase; const ASessionID: string); override;
- destructor Destroy; override;
-
- property SessionID: string read GetSessionID write SetSessionID;
- property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
- property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
- property Values[const AName: string]: string read GetValue write SetValue; default;
- end;
-
- TSessionClass = class of TSessionBase;
-
- ///
- /// Session管理接口
- ///
- ISessions = interface
- ['{5187CA76-4CC4-4986-B67B-BC3E76D6CD74}']
- function GetEnumerator: TEnumerator;
-
- function GetSessionClass: TSessionClass;
- function GetCount: Integer;
- function GetItem(const AIndex: Integer): ISession;
- function GetSession(const ASessionID: string): ISession;
- function GetExpiryTime: Integer;
- procedure SetSessionClass(const Value: TSessionClass);
- procedure SetExpiryTime(const Value: Integer);
-
- ///
- /// 开始写(用于线程同步)
- ///
- procedure BeginWrite;
-
- ///
- /// 结束写(用于线程同步)
- ///
- procedure EndWrite;
-
- ///
- /// 开始读(用于线程同步)
- ///
- procedure BeginRead;
-
- ///
- /// 结束读(用于线程同步)
- ///
- procedure EndRead;
-
- ///
- /// 生成新Session ID
- ///
- function NewSessionID: string;
-
- ///
- /// 检查是否存在指定ID的Session
- ///
- ///
- /// Session ID
- ///
- ///
- /// 如果存在指定的Session， 则将实例保存到该参数中
- ///
- function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; overload;
-
- ///
- /// 检查是否存在指定ID的Session
- ///
- ///
- /// Session ID
- ///
- function ExistsSession(const ASessionID: string): Boolean; overload;
-
- ///
- /// 新增Session
- ///
- ///
- /// Session ID
- ///
- ///
- /// Session实例
- ///
- function AddSession(const ASessionID: string): ISession; overload;
-
- ///
- /// 新增Session
- ///
- ///
- /// Session实例
- ///
- function AddSession: ISession; overload;
-
- ///
- /// 新增Session
- ///
- ///
- /// Session ID
- ///
- ///
- /// Session实例
- ///
- procedure AddSession(const ASessionID: string; ASession: ISession); overload;
-
- ///
- /// 删除Session
- ///
- ///
- /// Session对象
- ///
- procedure RemoveSession(const ASession: ISession); overload;
-
- ///
- /// 删除Session
- ///
- ///
- /// Session ID
- ///
- procedure RemoveSession(const ASessionID: string); overload;
-
- ///
- /// 批量删除Session
- ///
- ///
- /// Session对象数据
- ///
- procedure RemoveSessions(const ASessions: TArray);
-
- ///
- /// 清除所有Session
- ///
- procedure Clear;
-
- ///
- /// Session类
- ///
- property SessionClass: TSessionClass read GetSessionClass write SetSessionClass;
-
- ///
- /// Session个数
- ///
- property Count: Integer read GetCount;
-
- ///
- /// 获取指定序号的Session, 如果不存在则返回nil
- ///
- property Items[const AIndex: Integer]: ISession read GetItem;
-
- ///
- /// 获取指定ID的Session, 如果不存在则会新建一个
- ///
- ///
- /// Session ID
- ///
- property Sessions[const ASessionID: string]: ISession read GetSession; default;
-
- ///
- /// Session过期时间(秒)
- ///
- ///
- ///
- /// -
- /// 值大于0时, 当Session超过设定值秒数没有使用就会被释放;
- ///
- /// -
- /// 值小于等于0时, Session生成后一直有效
- ///
- ///
- ///
- property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
- end;
-
- TSessionsBase = class abstract(TInterfacedObject, ISessions)
- protected
- function GetSessionClass: TSessionClass; virtual; abstract;
- function GetCount: Integer; virtual; abstract;
- function GetItem(const AIndex: Integer): ISession; virtual; abstract;
- function GetSession(const ASessionID: string): ISession; virtual; abstract;
- function GetExpiryTime: Integer; virtual; abstract;
- procedure SetSessionClass(const Value: TSessionClass); virtual; abstract;
- procedure SetExpiryTime(const Value: Integer); virtual; abstract;
- public
- function GetEnumerator: TEnumerator; virtual; abstract;
-
- procedure BeginWrite; virtual; abstract;
- procedure EndWrite; virtual; abstract;
-
- procedure BeginRead; virtual; abstract;
- procedure EndRead; virtual; abstract;
-
- function NewSessionID: string; virtual; abstract;
- function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; overload; virtual; abstract;
- function ExistsSession(const ASessionID: string): Boolean; overload; virtual;
- function AddSession(const ASessionID: string): ISession; overload; virtual;
- function AddSession: ISession; overload;
- procedure AddSession(const ASessionID: string; ASession: ISession); overload; virtual; abstract;
-
- procedure RemoveSessions(const ASessions: TArray); virtual; abstract;
- procedure RemoveSession(const ASession: ISession); overload; virtual;
- procedure RemoveSession(const ASessionID: string); overload; virtual;
-
- procedure Clear; virtual; abstract;
-
- property SessionClass: TSessionClass read GetSessionClass write SetSessionClass;
- property Count: Integer read GetCount;
- property Items[const AIndex: Integer]: ISession read GetItem;
- property Sessions[const ASessionID: string]: ISession read GetSession; default;
- property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
- end;
-
- TSessions = class(TSessionsBase)
- private
- FNewGUIDFunc: TFunc;
- FLocker: IReadWriteLock;
- FSessionClass: TSessionClass;
- FExpire: Integer;
- FShutdown, FExpiredProcRunning: Boolean;
-
- procedure _ClearExpiredSessions;
- protected
- FSessions: TDictionary;
-
- function GetSessionClass: TSessionClass; override;
- function GetCount: Integer; override;
- function GetItem(const AIndex: Integer): ISession; override;
- function GetSession(const ASessionID: string): ISession; override;
- function GetExpiryTime: Integer; override;
- procedure SetSessionClass(const Value: TSessionClass); override;
- procedure SetExpiryTime(const Value: Integer); override;
-
- procedure BeforeClearExpiredSessions; virtual;
- function OnCheckExpiredSession(const ASession: ISession): Boolean; virtual;
- procedure AfterClearExpiredSessions; virtual;
- procedure CreateExpiredProcThread;
- public
- constructor Create(ANewGUIDFunc: TFunc); overload; virtual;
- constructor Create; overload; virtual;
- destructor Destroy; override;
-
- function GetEnumerator: TEnumerator; override;
-
- procedure BeginWrite; override;
- procedure EndWrite; override;
-
- procedure BeginRead; override;
- procedure EndRead; override;
-
- function NewSessionID: string; override;
- function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; override;
- procedure AddSession(const ASessionID: string; ASession: ISession); override;
-
- procedure RemoveSessions(const ASessions: TArray); override;
-
- procedure Clear; override;
-
- property NewGUIDFunc: TFunc read FNewGUIDFunc write FNewGUIDFunc;
- end;
-
-implementation
-
-function _IsHttpToken(const AValue: string): Boolean;
-var
- I: Integer;
-begin
- if (AValue = '') then Exit(False);
-
- for I := 1 to Length(AValue) do
- begin
- case AValue[I] of
- 'A'..'Z', 'a'..'z', '0'..'9',
- '!', '#', '$', '%', '&', '''', '*', '+', '-', '.', '^', '_', '`', '|', '~': ;
- else
- Exit(False);
- end;
- end;
-
- Result := True;
-end;
-
-function _IsCookieOctets(const AValue: string): Boolean;
-var
- I, LCode: Integer;
-begin
- for I := 1 to Length(AValue) do
- begin
- LCode := Ord(AValue[I]);
- case LCode of
- $21, // '!'
- $23..$2B, // '#' to '+'
- $2D..$3A, // '-' to ':'
- $3C..$5B, // '<' to '['
- $5D..$7E: ; // ']' to '~'
- else
- Exit(False);
- end;
- end;
-
- Result := True;
-end;
-
-function _IsCookieAvValue(const AValue: string): Boolean;
-var
- I, LCode: Integer;
-begin
- for I := 1 to Length(AValue) do
- begin
- LCode := Ord(AValue[I]);
- if (LCode < $20) or (LCode >= $7F) or (AValue[I] = ';') then
- Exit(False);
- end;
-
- Result := True;
-end;
-
-function _TryNormalizeCookieValue(const AValue: string; out ANormalizedValue: string): Boolean;
-begin
- ANormalizedValue := AValue;
- if (Length(ANormalizedValue) >= 2) then
- if (ANormalizedValue[1] = '"')
- and (ANormalizedValue[High(ANormalizedValue)] = '"') then
- ANormalizedValue := Copy(ANormalizedValue, 2, Length(ANormalizedValue) - 2);
-
- Result := _IsCookieOctets(ANormalizedValue);
-end;
-
-function _NormalizeCookieDomain(const AValue: string): string;
-begin
- if not _IsCookieAvValue(AValue) then Exit('');
-
- Result := AValue.Trim.ToLower;
- if (Result <> '') then
- if (Result[1] = '.') then
- Delete(Result, 1, 1);
-end;
-
-function _TryParseCookieMaxAge(const AValue: string; out AMaxAge: Integer): Boolean;
-var
- I: Integer;
-begin
- AMaxAge := 0;
- Result := False;
- if (AValue = '') then Exit;
-
- if (AValue[1] = '-') then
- begin
- if (Length(AValue) = 1) then Exit;
- for I := 2 to Length(AValue) do
- if not CharInSet(AValue[I], ['0'..'9']) then Exit;
- end else
- begin
- for I := 1 to Length(AValue) do
- if not CharInSet(AValue[I], ['0'..'9']) then Exit;
- end;
-
- Result := TryStrToInt(AValue, AMaxAge);
-end;
-
-{ TNameValue }
-
-constructor TNameValue.Create(const AName,
- AValue: string);
-begin
- Name := AName;
- Value := AValue;
-end;
-
-{ TBaseParams.TEnumerator }
-
-constructor TBaseParams.TEnumerator.Create(const AParams: TBaseParams);
-begin
- FParams := AParams;
- FIndex := -1;
-end;
-
-function TBaseParams.TEnumerator.GetCurrent: TNameValue;
-begin
- Result := FParams.Items[FIndex];
-end;
-
-function TBaseParams.TEnumerator.MoveNext: Boolean;
-begin
- Inc(FIndex);
- Result := (FIndex < FParams.Count);
-end;
-
-{ TBaseParams }
-
-constructor TBaseParams.Create;
-begin
- FParams := TList.Create(TComparer.Construct(
- function(const Left, Right: TNameValue): Integer
- begin
- Result := CompareText(Left.Name, Right.Name, TLocaleOptions.loUserLocale);
- end));
-end;
-
-constructor TBaseParams.Create(const AEncodedParams: string);
-begin
- Create;
- Decode(AEncodedParams, True);
-end;
-
-destructor TBaseParams.Destroy;
-begin
- FreeAndNil(FParams);
- inherited;
-end;
-
-procedure TBaseParams.Add(const AName, AValue: string; ADupAllowed: Boolean);
-begin
- if ADupAllowed then
- FParams.Add(TNameValue.Create(AName, AValue))
- else
- SetParam(AName, AValue);
-end;
-
-procedure TBaseParams.Add(const AEncodedParams: string);
-begin
- Decode(AEncodedParams, False);
-end;
-
-procedure TBaseParams.Assign(const ASource: TBaseParams);
-var
- LParamItem: TNameValue;
-begin
- Clear;
-
- if (ASource = nil) or (ASource.Count <= 0) then Exit;
-
- for LParamItem in ASource do
- Add(LParamItem);
-end;
-
-procedure TBaseParams.Add(const AParamValue: TNameValue);
-begin
- FParams.Add(AParamValue);
-end;
-
-procedure TBaseParams.Clear;
-begin
- FParams.Clear;
-end;
-
-function TBaseParams.GetParamIndex(const AName: string): Integer;
-var
- I: Integer;
-begin
- for I := 0 to FParams.Count - 1 do
- if TStrUtils.SameText(FParams[I].Name, AName) then Exit(I);
- Result := -1;
-end;
-
-function TBaseParams.GetParamValue(const AName: string;
- out AValue: string): Boolean;
-var
- I: Integer;
-begin
- I := GetParamIndex(AName);
- if (I >= 0) then
- begin
- AValue := FParams[I].Value;
- Exit(True);
- end;
-
- AValue := '';
- Result := False;
-end;
-
-function TBaseParams.GetHeaderValues(const AName: string;
- out AValues: TArray): Boolean;
-var
- I, LCount: Integer;
-begin
- SetLength(AValues, FParams.Count);
- LCount := 0;
- Result := False;
- for I := 0 to FParams.Count - 1 do
- begin
- if not TStrUtils.SameText(FParams[I].Name, AName) then Continue;
- AValues[LCount] := FParams[I].Value;
- Inc(LCount);
- Result := True;
- end;
- SetLength(AValues, LCount);
-end;
-
-procedure TBaseParams.Remove(const AName: string);
-var
- I: Integer;
-begin
- I := GetParamIndex(AName);
- if (I >= 0) then
- FParams.Delete(I);
-end;
-
-procedure TBaseParams.Remove(AIndex: Integer);
-begin
- FParams.Delete(AIndex);
-end;
-
-function TBaseParams.GetCount: Integer;
-begin
- Result := FParams.Count;
-end;
-
-function TBaseParams.GetEnumerator: TEnumerator;
-begin
- Result := TEnumerator.Create(Self);
-end;
-
-function TBaseParams.GetItem(AIndex: Integer): TNameValue;
-begin
- Result := FParams.Items[AIndex];
-end;
-
-function TBaseParams.ExistsParam(const AName: string): Boolean;
-begin
- Result := (GetParamIndex(AName) >= 0);
-end;
-
-function TBaseParams.GetParam(const AName: string): string;
-var
- I: Integer;
-begin
- I := GetParamIndex(AName);
- if (I >= 0) then
- Exit(FParams[I].Value);
- Result := '';
-end;
-
-procedure TBaseParams.SetItem(AIndex: Integer; const AValue: TNameValue);
-begin
- FParams[AIndex] := AValue;
-end;
-
-procedure TBaseParams.SetParam(const AName, AValue: string);
-var
- I: Integer;
- LItem: TNameValue;
-begin
- I := GetParamIndex(AName);
- if (I >= 0) then
- begin
- LItem := FParams[I];
- LItem.Value := AValue;
- FParams[I] := LItem;
- end else
- FParams.Add(TNameValue.Create(AName, AValue));
-end;
-
-procedure TBaseParams.Sort(const AComparison: TNameValueComparison);
-var
- LComparer: INameValueComparer;
-begin
- if Assigned(AComparison) then
- LComparer := TNameValueComparer.Create(AComparison)
- else
- LComparer := TNameValueComparer.Create(
- function(const Left, Right: TNameValue): Integer
- begin
- Result := CompareStr(Left.Name, Right.Name, TLocaleOptions.loInvariantLocale);
- end);
-
- FParams.Sort(LComparer);
-end;
-
-{ THttpUrlParams }
-
-constructor THttpUrlParams.Create;
-begin
- inherited Create;
-
- // RFC 3986 / WHATWG application/x-www-form-urlencoded:
- // key 与 value 内含的 reserved/非 unreserved 字符都必须 percent-encode,
- // 否则 key 中的 '&'/'='/'#' 等会被服务端误解析 (参数注入风险).
- // 与 Go url.Values.Encode / Python urlencode / Java URLEncoder 等主流库默认行为一致.
- FEncodeName := True;
- FEncodeValue := True;
-end;
-
-function THttpUrlParams.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
-var
- p, pEnd, q: PChar;
- LName, LValue: string;
- LSize, LDecodedCount: Integer;
-begin
- if AClear then
- FParams.Clear;
-
- LDecodedCount := 0;
- p := PChar(AEncodedParams);
- pEnd := p + Length(AEncodedParams);
- while (p < pEnd) do
- begin
- // WHATWG application/x-www-form-urlencoded parser: 按 '&' 拆分并忽略空片段.
- while (p < pEnd) and (p^ = '&') do
- Inc(p);
- if (p >= pEnd) then Break;
-
- q := p;
- LSize := 0;
- while (p < pEnd) and (p^ <> '=') and (p^ <> '&') do
- begin
- Inc(LSize);
- Inc(p);
- end;
- SetString(LName, q, LSize);
- LName := TCrossHttpUtils.UrlDecode(LName);
-
- if (p < pEnd) and (p^ = '=') then
- begin
- Inc(p);
-
- q := p;
- LSize := 0;
- while (p < pEnd) and (p^ <> '&') do
- begin
- Inc(LSize);
- Inc(p);
- end;
- SetString(LValue, q, LSize);
- LValue := TCrossHttpUtils.UrlDecode(LValue);
- end else
- begin
- LValue := '';
- end;
-
- Add(LName, LValue, True);
- Inc(LDecodedCount);
- end;
-
- Result := (LDecodedCount > 0);
-end;
-
-function THttpUrlParams.Encode: string;
-var
- I: Integer;
- LName, LValue: string;
-begin
- Result := '';
- for I := 0 to FParams.Count - 1 do
- begin
- if (I > 0) then
- Result := Result + '&';
-
- if FEncodeName then
- LName := TCrossHttpUtils.UrlEncode(FParams[I].Name)
- else
- LName := FParams[I].Name;
- Result := Result + LName;
-
- if FEncodeValue then
- LValue := TCrossHttpUtils.UrlEncode(FParams[I].Value)
- else
- LValue := FParams[I].Value;
- if (LValue <> '') then
- Result := Result + '=' + LValue;
- end;
-end;
-
-{ THttpHeader }
-
-function THttpHeader.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
-const
- CR = #13;
- LF = #10;
-var
- P, PEnd, LLineStart, LColonPos, LValueStart, LValueEnd: PChar;
- LCh: Char;
- LName, LValue: string;
- LLineValid, LInName: Boolean;
- LDecodedCount: Integer;
-begin
- if AClear then
- FParams.Clear;
-
- LDecodedCount := 0;
- P := PChar(AEncodedParams);
- PEnd := P + Length(AEncodedParams);
-
- // 单趟状态机解析 (RFC 7230 §3): 每行字符仅访问 1 次, 同时完成
- // 1) CRLF 边界检测: bare-CR / bare-LF 立即拒绝 (Exit(False)),
- // 防御 \r\r\n\n 等走私序列及上下游切分不一致
- // 2) ':' 定位 (切 name / value)
- // 3) value 前后 OWS 跳过 + 尾随 OWS 自动 trim
- // 4) name 每字节 token 校验 + value 每字节 CTL 校验
- // 非法行整行跳过 (仅限 name/value 校验失败, 不含 bare-CR/LF),
- // 与 THttpHeader.Encode 过滤策略对称, 作为深度防御.
- while (P < PEnd) do
- begin
- LLineStart := P;
- LColonPos := nil;
- LValueStart := nil;
- LValueEnd := nil;
- LLineValid := True;
- LInName := True;
-
- // 内层: 逐字节扫描本行, 直到 CRLF 或 PEnd
- while (P < PEnd) do
- begin
- LCh := P^;
-
- if (LCh = CR) then
- begin
- if (P + 1 < PEnd) and ((P + 1)^ = LF) then
- Break; // 完整 CRLF: 退出内层, P 仍指向 CR
- // bare-CR: 立即拒绝, 防御 \r\r\n\n 等走私序列
- if AClear then FParams.Clear;
- Exit(False);
- end;
-
- if (LCh = LF) then
- begin
- // bare-LF: 立即拒绝
- if AClear then FParams.Clear;
- Exit(False);
- end;
-
- if LInName then
- begin
- if (LCh = ':') then
- begin
- LColonPos := P;
- LInName := False;
- end else
- if not TCrossHttpUtils.IsTokenChar(LCh) then
- // name 段非 token 字符 (含 OWS / CTL / 非 ASCII 等) → 非法
- LLineValid := False;
- end else
- begin
- // value 段: 前导 OWS 跳过, 记录首/末非 OWS 位置, 同时校验 CTL
- if (LCh <> ' ') and (LCh <> #9) then
- begin
- if (LValueStart = nil) then
- LValueStart := P;
- LValueEnd := P + 1; // exclusive: 最后非 OWS 字符之后位置
- if not TCrossHttpUtils.IsHeaderValueChar(LCh) then
- LLineValid := False;
- end;
- end;
-
- Inc(P);
- end;
-
- // 退出内层: P 指向 CR (CRLF 完整) 或 P >= PEnd (末尾无 CRLF).
- // 末尾无 CRLF 的残行也按相同规则尝试入库, 兼容 multipart part header
- // 等调用方剥掉块终止符 \r\n\r\n 后再喂入的字符串. 主路径 HTTP
- // request/response header 末尾必带空行 \r\n, 始终走 CRLF 完整分支,
- // 严格性不变.
- if (P < PEnd) then
- Inc(P, 2); // 跳过 CRLF; PEnd 路径 P 已等于 PEnd, 外层 while 自然退出
-
- if not LLineValid then Continue;
-
- // 空行: header 块结束标记, 跳过.
- // CRLF 完整路径: LLineStart 指向被消费 CRLF 的位置 (即 P - 2)
- // PEnd 路径 : LLineStart 等于 P (本行 0 字节)
- if (LLineStart = P) or (LLineStart = P - 2) then Continue;
-
- // 必须出现过 ':'
- if (LColonPos = nil) then Continue;
-
- // name 不能为空
- if (LColonPos = LLineStart) then Continue;
-
- SetString(LName, LLineStart, LColonPos - LLineStart);
-
- if (LValueStart = nil) then
- LValue := ''
- else
- SetString(LValue, LValueStart, LValueEnd - LValueStart);
-
- Add(LName, LValue, True);
- Inc(LDecodedCount);
- end;
-
- Result := (LDecodedCount > 0);
-end;
-
-function THttpHeader.Encode: string;
-var
- I: Integer;
- LName, LValue: string;
-begin
- // 防御 HTTP 响应拆分 (Response Splitting):
- // Header name 必须是 RFC 7230 token, value 不允许 CR/LF/CTL.
- // 非法 entry 直接跳过 (业务方应在写入前自行 sanitize), 避免拼到 wire 上注入伪造响应.
- Result := '';
- for I := 0 to FParams.Count - 1 do
- begin
- LName := FParams[I].Name;
- LValue := FParams[I].Value;
-
- if not TCrossHttpUtils.IsValidHeaderName(LName) then Continue;
- if not TCrossHttpUtils.IsValidHeaderValue(LValue) then Continue;
-
- Result := Result + LName + ': ' + LValue + #13#10;
- end;
- Result := Result + #13#10;
-end;
-
-{ TDelimitParams }
-
-constructor TDelimitParams.Create(const ADelimiter: Char; const AUrlEncode: Boolean);
-begin
- FDelimiter := ADelimiter;
- FUrlEncode := AUrlEncode;
-
- inherited Create;
-end;
-
-constructor TDelimitParams.Create(const AEncodedParams: string;
- const ADelimiter: Char; const AUrlEncode: Boolean);
-begin
- FDelimiter := ADelimiter;
- FUrlEncode := AUrlEncode;
-
- inherited Create(AEncodedParams);
-end;
-
-function TDelimitParams.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
-var
- p, pEnd, q: PChar;
- LName, LValue: string;
- LSize, LDecodedCount: Integer;
-begin
- if AClear then
- FParams.Clear;
-
- LDecodedCount := 0;
- p := PChar(AEncodedParams);
- pEnd := p + Length(AEncodedParams);
- while (p < pEnd) do
- begin
- q := p;
- LSize := 0;
- while (p < pEnd) and (p^ <> '=') do
- begin
- Inc(LSize);
- Inc(p);
- end;
- SetString(LName, q, LSize);
- // 跳过多余的'='
- while (p < pEnd) and (p^ = '=') do
- Inc(p);
-
- q := p;
- LSize := 0;
- while (p < pEnd) and (p^ <> FDelimiter) do
- begin
- Inc(LSize);
- Inc(p);
- end;
- SetString(LValue, q, LSize);
- if FUrlEncode then
- LValue := TCrossHttpUtils.UrlDecode(LValue);
- // 跳过多余的';'
- while (p < pEnd) and ((p^ = FDelimiter) or (p^ = ' ')) do
- Inc(p);
-
- Add(LName, LValue);
- Inc(LDecodedCount);
- end;
-
- Result := (LDecodedCount > 0);
-end;
-
-function TDelimitParams.Encode: string;
-var
- I: Integer;
- LValue: string;
-begin
- Result := '';
- for I := 0 to FParams.Count - 1 do
- begin
- if (I > 0) then
- Result := Result + FDelimiter + ' ';
- LValue := FParams[I].Value;
- if FUrlEncode then
- LValue := TCrossHttpUtils.UrlEncode(LValue);
- Result := Result + FParams[I].Name + '=' + LValue;
- end;
-end;
-
-{ TRequestCookies }
-
-function TRequestCookies.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
-var
- LParsedParams: TList;
- LItem: TNameValue;
- LPos, LLen, LPairEnd, LEqualsPos, LDecodedCount: Integer;
- LPair: string;
- LName, LValue: string;
- LNormalizedValue: string;
-begin
- LDecodedCount := 0;
- Result := False;
- // 先解析到临时列表，确保整行 Cookie 全部合法后再提交，避免失败时留下半解析数据。
- LParsedParams := TList.Create;
- try
- LLen := Length(AEncodedParams);
- LPos := 1;
- while (LPos <= LLen) do
- begin
- // 跳过空白字符(空格和制表符)
- while (LPos <= LLen) and CharInSet(AEncodedParams[LPos], [' ', #9]) do
- Inc(LPos);
- if (LPos > LLen) then Break;
-
- LPairEnd := LPos;
- // 查找分号分隔符, 确定当前 cookie-pair 的结束位置
- while (LPairEnd <= LLen) and (AEncodedParams[LPairEnd] <> ';') do
- Inc(LPairEnd);
-
- // 提取当前 cookie-pair 字符串
- LPair := Copy(AEncodedParams, LPos, LPairEnd - LPos);
- // 查找等号位置, 用于分割 name 和 value
- LEqualsPos := Pos('=', LPair);
- // 如果没有等号或等号在第一个位置(name 为空), 则认为格式非法
- if (LEqualsPos <= 1) then
- begin
- if AClear then FParams.Clear;
- Exit;
- end;
-
- // 提取 name 部分（等号之前的内容）
- LName := Copy(LPair, 1, LEqualsPos - 1);
- // 提取 value 部分（等号之后的所有内容）
- LValue := Copy(LPair, LEqualsPos + 1, MaxInt);
- // 校验 name 是否为合法的 HTTP token, 以及 value 是否为合法的 cookie 值
- if not _IsHttpToken(LName)
- or not _TryNormalizeCookieValue(LValue, LNormalizedValue) then
- begin
- if AClear then FParams.Clear;
- Exit;
- end;
-
- LParsedParams.Add(TNameValue.Create(LName, LNormalizedValue));
- LPos := LPairEnd + 1;
- Inc(LDecodedCount);
- end;
-
- // 所有 cookie-pair 均校验通过后，才按 AClear 语义提交到 FParams。
- if AClear then
- FParams.Clear;
- for LItem in LParsedParams do
- Add(LItem.Name, LItem.Value);
- Result := (LDecodedCount > 0);
- finally
- FreeAndNil(LParsedParams);
- end;
-end;
-
-function TRequestCookies.Encode: string;
-var
- I: Integer;
- LName, LValue: string;
-begin
- Result := '';
- for I := 0 to FParams.Count - 1 do
- begin
- if (I > 0) then
- Result := Result + '; ';
- LName := FParams[I].Name;
- LValue := FParams[I].Value;
- if not _IsHttpToken(LName) then
- raise Exception.CreateFmt('Invalid cookie name: %s', [LName]);
- if not _IsCookieOctets(LValue) then
- raise Exception.CreateFmt('Invalid cookie value: %s', [LName]);
- Result := Result + LName + '=' + LValue;
- end;
-end;
-
-{ TResponseCookie }
-
-constructor TResponseCookie.Create(const AName, AValue: string;
- AMaxAge: Integer; const APath, ADomain: string; AHttpOnly, ASecure: Boolean);
-begin
- Self.Name := AName;
- Self.Value := AValue;
- Self.MaxAge := AMaxAge;
- Self.Path := APath;
- Self.Domain := _NormalizeCookieDomain(ADomain);
- Self.HttpOnly := AHttpOnly;
- Self.Secure := ASecure;
-end;
-
-constructor TResponseCookie.Create(const ACookieData, ADomain: string);
-
- procedure SetExpires(const AValue: string);
- var
- LMaxAge: Integer;
- begin
- if (Self.MaxAge = 0) then
- begin
- LMaxAge := TCrossHttpUtils.RFC1123_StrToDate(AValue).SecondsDiffer(Now);
- if (LMaxAge > 0) then
- Self.MaxAge := LMaxAge;
- end;
- end;
-
- procedure SetMaxAge(const AValue: string);
- var
- LMaxAge: Integer;
- begin
- if _TryParseCookieMaxAge(AValue, LMaxAge) then
- Self.MaxAge := LMaxAge;
- end;
-
- procedure SetPath(const AValue: string);
- begin
- if (AValue <> '') and (AValue[1] = '/') and _IsCookieAvValue(AValue) then
- Self.Path := AValue;
- end;
-
- procedure SetDomain(const AValue: string);
- var
- LDomain: string;
- begin
- LDomain := _NormalizeCookieDomain(AValue);
- if (LDomain <> '') then
- Self.Domain := LDomain;
- end;
-
-var
- LValues: TArray;
- I: Integer;
- LPos: Integer;
- LName: string;
- LValue: string;
-begin
- Self.Name := '';
- Self.Value := '';
- Self.MaxAge := 0;
- Self.Path := '/';
- Self.Domain := _NormalizeCookieDomain(ADomain);
- Self.HttpOnly := False;
- Self.Secure := False;
-
- LValues := ACookieData.Split([Char(';')], Char('"'));
- if Length(LValues) = 0 then Exit;
-
- LPos := LValues[0].IndexOf(Char('='));
- if (LPos <= 0) then Exit;
-
- Self.Name := LValues[0].Substring(0, LPos).Trim;
- if not _IsHttpToken(Self.Name)
- or not _TryNormalizeCookieValue(LValues[0].Substring(LPos + 1).Trim, Self.Value) then
- begin
- Self.Name := '';
- Self.Value := '';
- Exit;
- end;
-
- for I := 1 to High(LValues) do
- begin
- LPos := LValues[I].IndexOf(Char('='));
- if LPos > 0 then
- begin
- LName := LValues[I].Substring(0, LPos).Trim;
- LValue := LValues[I].Substring(LPos + 1).Trim;
- if (LValue.Length > 1) and (LValue.Chars[0] = '"') and (LValue[High(LValue)] = '"') then
- LValue := LValue.Substring(1, LValue.Length - 2);
- end
- else
- begin
- LName := LValues[I].Trim;
- LValue := '';
- end;
-
- if TStrUtils.SameText(LName, 'Max-Age') then
- SetMaxAge(LValue)
- else if TStrUtils.SameText(LName, 'Expires') then
- SetExpires(LValue)
- else if TStrUtils.SameText(LName, 'Path') then
- SetPath(LValue)
- else if TStrUtils.SameText(LName, 'Domain') then
- SetDomain(LValue)
- else if TStrUtils.SameText(LName, 'HttpOnly') then
- Self.HttpOnly := True
- else if TStrUtils.SameText(LName, 'Secure') then
- Self.Secure := True;
- end;
-end;
-
-function TResponseCookie.Encode: string;
-begin
- if not _IsHttpToken(Self.Name) then
- raise Exception.CreateFmt('Invalid cookie name: %s', [Self.Name]);
- if not _IsCookieOctets(Self.Value) then
- raise Exception.CreateFmt('Invalid cookie value: %s', [Self.Value]);
- if not _IsCookieAvValue(Self.Path) then
- raise Exception.CreateFmt('Invalid cookie path: %s', [Self.Name]);
- if (Self.Path <> '') and (Self.Path[1] <> '/') then
- raise Exception.CreateFmt('Invalid cookie path: %s', [Self.Name]);
- if not _IsCookieAvValue(Self.Domain) then
- raise Exception.CreateFmt('Invalid cookie domain: %s', [Self.Name]);
-
- Result := Self.Name + '=' + Self.Value;
-
- if (Self.MaxAge > 0) then
- Result := Result + '; Max-Age=' + Self.MaxAge.ToString;
- if (Self.Path <> '') then
- Result := Result + '; Path=' + Self.Path;
- if (Self.Domain <> '') then
- Result := Result + '; Domain=' + Self.Domain;
- if Self.HttpOnly then
- Result := Result + '; HttpOnly';
- if Self.Secure then
- Result := Result + '; Secure';
-end;
-
-{ TFormField }
-
-constructor TFormField.Create;
-begin
- FValueOwned := True;
-end;
-
-destructor TFormField.Destroy;
-begin
- FreeValue;
-
- inherited;
-end;
-
-procedure TFormField.FreeValue;
-begin
- if FValueOwned and Assigned(FValue) then
- FreeAndNil(FValue);
-end;
-
-function TFormField.AsBytes: TBytes;
-var
- LBufSize: Integer;
-begin
- if (FValue = nil) or (FValue.Size <= 0) then Exit(nil);
-
- if (FValue is TBytesStream) then
- begin
- Result := TBytesStream(FValue).Bytes;
- SetLength(Result, FValue.Size);
- end else
- begin
- FValue.Position := 0;
- LBufSize := FValue.Size;
- SetLength(Result, LBufSize);
- FValue.ReadBuffer(Result, LBufSize);
- end;
-end;
-
-procedure TFormField.Assign(const ASource: TFormField);
-begin
- FreeValue;
-
- if (ASource = nil) then Exit;
-
- FName := ASource.FName;
- FValueOwned := ASource.FValueOwned;
- FIsTempFile := ASource.FIsTempFile;
- FFileName := ASource.FFileName;
- FFilePath := ASource.FFilePath;
- FContentType := ASource.FContentType;
- FContentTransferEncoding := ASource.FContentTransferEncoding;
-
- if ASource.FValueOwned then
- begin
- if (FFilePath <> '') then
- FValue := TFileUtils.OpenRead(FFilePath, fmShareDenyNone)
- else
- begin
- FValue := TBytesStream.Create;
- FValue.CopyFrom(ASource.FValue, 0);
- end;
- end else
- begin
- FValue := ASource.FValue;
- end;
-end;
-
-function TFormField.AsString(AEncoding: TEncoding): string;
-begin
- Result := TUtils.GetString(FValue, AEncoding);
-end;
-
-{ THttpMultiPartFormData.TEnumerator }
-
-constructor THttpMultiPartFormData.TEnumerator.Create(
- const AList: TList);
-begin
- inherited Create;
- FList := AList;
- FIndex := -1;
-end;
-
-function THttpMultiPartFormData.TEnumerator.GetCurrent: TFormField;
-begin
- Result := FList[FIndex];
-end;
-
-function THttpMultiPartFormData.TEnumerator.MoveNext: Boolean;
-begin
- Inc(FIndex);
- Result := (FIndex < FList.Count);
-end;
-
-{ THttpMultiPartFormData }
-
-constructor THttpMultiPartFormData.Create;
-begin
- FDecodeState := dsBoundary;
- SetLength(FCurrentPartHeader, MAX_PART_HEADER);
- FCurrentPartHeaderLen := 0;
- FPartFields := TObjectList.Create(True);
- FAutoDeleteFiles := True;
- FMaxPartDataSize := 0;
- FCurrentPartDataSize := 0;
-end;
-
-function THttpMultiPartFormData.Decode(
- const AStream: TStream): TFormDataDecodeResult;
-const
- BUF_SIZE = 1024 * 32;
-var
- LBuffer: array [0..BUF_SIZE - 1] of Byte;
- N: Integer;
-begin
- while True do
- begin
- N := AStream.Read(LBuffer[0], BUF_SIZE);
- Result := Decode(@LBuffer[0], N);
-
- if (Result in [frComplete, frFailed])
- or (N < BUF_SIZE) then Exit;
- end;
-end;
-
-destructor THttpMultiPartFormData.Destroy;
-begin
- Clear;
- FCurrentPartHeader := nil;
- FCurrentPartField := nil;
- FreeAndNil(FPartFields);
- inherited;
-end;
-
-function THttpMultiPartFormData.AddField(const AField: TFormField): TFormField;
-begin
- FPartFields.Add(AField);
- Result := AField;
-end;
-
-function THttpMultiPartFormData.AddField(const AFieldName: string;
- const AValue: TBytes): TFormField;
-begin
- Result := TFormField.Create;
- Result.FName := AFieldName;
- Result.FValueOwned := True;
- Result.FValue := TBytesStream.Create(AValue);
- Result.FContentType := TMediaType.APPLICATION_OCTET_STREAM;
-
- FPartFields.Add(Result);
-end;
-
-function THttpMultiPartFormData.AddField(const AFieldName, AValue: string): TFormField;
-begin
- Result := TFormField.Create;
- Result.FName := AFieldName;
- Result.FValueOwned := True;
- Result.FValue := TBytesStream.Create(TEncoding.UTF8.GetBytes(AValue));
-
- FPartFields.Add(Result);
-end;
-
-function THttpMultiPartFormData.AddFile(const AFieldName, AFileName: string;
- const AStream: TStream; const AOwned: Boolean): TFormField;
-begin
- Result := TFormField.Create;
- Result.FName := AFieldName;
- Result.FFileName := AFileName;
- Result.FValueOwned := AOwned;
- Result.FValue := AStream;
- Result.FContentType := TCrossHttpUtils.GetFileMIMEType(AFileName);
-
- FPartFields.Add(Result);
-end;
-
-function THttpMultiPartFormData.AddFile(const AFieldName, AFileName: string): TFormField;
-begin
- Result := AddFile(AFieldName,
- ExtractFileName(AFileName),
- TFileUtils.OpenRead(AFileName, fmShareDenyNone),
- True);
- Result.FFilePath := AFileName;
-end;
-
-procedure THttpMultiPartFormData.Assign(const ASource: THttpMultiPartFormData);
-var
- LSrcField, LNewField: TFormField;
-begin
- Clear;
-
- Boundary := ASource.Boundary;
-
- for LSrcField in ASource do
- begin
- LNewField := TFormField.Create;
- LNewField.Assign(LSrcField);
-
- AddField(LNewField);
- end;
-end;
-
-function THttpMultiPartFormData.AsBytes(const AFieldName: string;
- out AValue: TBytes): Boolean;
-var
- LField: TFormField;
-begin
- Result := FindField(AFieldName, LField);
- if Result then
- AValue := LField.AsBytes
- else
- AValue := nil;
-end;
-
-function THttpMultiPartFormData.AsBytes(const AFieldName: string): TBytes;
-begin
- AsBytes(AFieldName, Result);
-end;
-
-function THttpMultiPartFormData.AsStream(const AFieldName: string;
- out AValue: TStream): Boolean;
-var
- LField: TFormField;
-begin
- Result := FindField(AFieldName, LField);
- if Result then
- begin
- AValue := LField.Value;
- if (AValue.Size > 0) then
- AValue.Position := 0;
- end else
- AValue := nil;
-end;
-
-function THttpMultiPartFormData.AsStream(const AFieldName: string): TStream;
-begin
- AsStream(AFieldName, Result);
-end;
-
-function THttpMultiPartFormData.AsString(const AFieldName: string;
- const AEncoding: TEncoding; out AValue: string): Boolean;
-var
- LField: TFormField;
-begin
- Result := FindField(AFieldName, LField);
- if Result then
- AValue := LField.AsString(AEncoding)
- else
- AValue := '';
-end;
-
-function THttpMultiPartFormData.AsString(const AFieldName: string;
- out AValue: string): Boolean;
-begin
- Result := AsString(AFieldName, nil, AValue);
-end;
-
-function THttpMultiPartFormData.AsString(const AFieldName: string;
- const AEncoding: TEncoding): string;
-begin
- AsString(AFieldName, AEncoding, Result);
-end;
-
-procedure THttpMultiPartFormData.Clear;
-var
- LField: TFormField;
-begin
- for LField in FPartFields do
- begin
- if FAutoDeleteFiles and (LField.FilePath <> '')
- and FileExists(LField.FilePath) then
- begin
- LField.FreeValue;
-
- if LField.FIsTempFile then
- DeleteFile(LField.FilePath);
- end;
- end;
-
- FPartFields.Clear;
-end;
-
-function THttpMultiPartFormData.FindField(const AFieldName: string;
- out AField: TFormField): Boolean;
-var
- I: Integer;
-begin
- I := GetItemIndex(AFieldName);
- if (I >= 0) then
- begin
- AField := FPartFields[I];
- Exit(True);
- end;
-
- AField := nil;
- Result := False;
-end;
-
-function THttpMultiPartFormData.GetItem(AIndex: Integer): TFormField;
-begin
- Result := FPartFields.Items[AIndex];
-end;
-
-function THttpMultiPartFormData.GetItemIndex(const AName: string): Integer;
-var
- I: Integer;
-begin
- for I := 0 to FPartFields.Count - 1 do
- if TStrUtils.SameText(FPartFields[I].Name, AName) then Exit(I);
- Result := -1;
-end;
-
-function THttpMultiPartFormData.GetCount: Integer;
-begin
- Result := FPartFields.Count;
-end;
-
-function THttpMultiPartFormData.GetDataSize: Integer;
-var
- LPartField: TFormField;
-begin
- Result := 0;
- for LPartField in FPartFields do
- Inc(Result, LPartField.FValue.Size);
-end;
-
-function THttpMultiPartFormData.GetEnumerator: TEnumerator;
-begin
- Result := TEnumerator.Create(FPartFields);
-end;
-
-function THttpMultiPartFormData.GetField(const AName: string): TFormField;
-var
- I: Integer;
-begin
- I := GetItemIndex(AName);
- if (I >= 0) then
- Exit(FPartFields[I]);
- Result := nil;
-end;
-
-procedure THttpMultiPartFormData.InitWithBoundary(const ABoundary: string);
-begin
- // Decode 返回 frFailed 后, 调用方应调用 InitWithBoundary 重用实例;
- // Clear 会根据 AutoDeleteFiles 清理半解析的临时文件.
- Clear;
-
- SetBoundary(ABoundary);
-
- FDecodeState := dsBoundary;
- FBoundaryIndex := 0;
- FPrevBoundaryIndex := 0;
- FCurrentPartDataSize := 0;
- FCurrentPartHeaderLen := 0;
- FCurrentPartField := nil;
- SetLength(FLookbehind, Length(FBoundaryBytes) + 8);
-end;
-
-procedure THttpMultiPartFormData.Remove(AIndex: Integer);
-begin
- FPartFields.Delete(AIndex);
-end;
-
-procedure THttpMultiPartFormData.Remove(const AFieldName: string);
-var
- I: Integer;
-begin
- I := GetItemIndex(AFieldName);
- if (I >= 0) then
- FPartFields.Delete(I);
-end;
-
-procedure THttpMultiPartFormData.SetBoundary(const AValue: string);
-begin
- if (FBoundary <> AValue) then
- begin
- FBoundary := AValue;
- FBoundary := FBoundary.Trim(['"']);
-
- // 第一块数据是紧跟着 HTTP HEADER 的, 前面没有多余的 #13#10
- FFirstBoundaryBytes := TEncoding.ASCII.GetBytes('--' + FBoundary);
-
- // 第二块及以后的数据 Boundary 前面都会有 #13#10
- FBoundaryBytes := TArrayUtils.Concat([13, 10], FFirstBoundaryBytes);
- end;
-end;
-
-function THttpMultiPartFormData.Decode(const ABuf: Pointer; ALen: Integer; out AConsumed: Integer): TFormDataDecodeResult;
- function __NewFileID: string;
- begin
- Result := TUtils.GetGUID.ToLower;
- end;
-
- function __InitFormFieldByHeader(AFormField: TFormField; const AHeader: string): Boolean;
- var
- LFieldHeader: THttpHeader;
- LContentDisposition: string;
- LMatch: TMatch;
- begin
- Result := False;
-
- LFieldHeader := THttpHeader.Create;
- try
- LFieldHeader.Decode(AHeader);
- LContentDisposition := LFieldHeader['Content-Disposition'];
- if (LContentDisposition = '') then Exit;
-
- AFormField.FContentType := LFieldHeader['Content-Type'];
-
- LMatch := TRegEx.Match(LContentDisposition, '\bname="(.*?)"(?=;|$)', [TRegExOption.roIgnoreCase]);
- if LMatch.Success then
- AFormField.FName := LMatch.Groups[1].Value;
-
- // 使用 Content-Type 来判断是否需要按文件保存更为准确
- // 前端通过流的方式提交, 可能不会传递 filename 属性,
- // 这种情况收到的 AHeader 是这样的:
- // Content-Disposition: form-data; name="test_content"
- // Content-Type: application/octet-stream
- // 这种数据也可以当成文件来储存, 随机给它分配一个文件名即可
- // 而普通的文本数据是不会有 Content-Type 的：
- // Content-Disposition: form-data; name="test_text"
- if (AFormField.FContentType <> '') then
- begin
- LMatch := TRegEx.Match(LContentDisposition, '\bfilename="(.*?)"(?=;|$)', [TRegExOption.roIgnoreCase]);
- // 带 filename 属性的头:
- // Content-Disposition: form-data; name="content"; filename="test.json"
- // Content-Type: application/json
- if LMatch.Success then
- begin
- AFormField.FFileName := TPathUtils.GetFileName(LMatch.Groups[1].Value);
- AFormField.FFilePath := TPathUtils.Combine(FStoragePath,
- __NewFileID + TPathUtils.GetExtension(AFormField.FFileName));
- end else
- begin
- AFormField.FFileName := __NewFileID + '.bin';
- AFormField.FFilePath := TPathUtils.Combine(FStoragePath,
- AFormField.FFileName);
- end;
-
- AFormField.FIsTempFile := True;
- AFormField.FValue := TFileUtils.OpenCreate(AFormField.FFilePath);
- end else
- AFormField.FValue := TBytesStream.Create(nil);
-
- AFormField.FValueOwned := True;
- // 注意: Content-Transfer-Encoding (base64/quoted-printable) 仅存储不解码,
- // dsPartData 阶段总是按原始字节写入, 如需支持非二进制传输编码需在此增加解码层.
- AFormField.FContentTransferEncoding := LFieldHeader['Content-Transfer-Encoding'];
- finally
- FreeAndNil(LFieldHeader);
- end;
-
- Result := True;
- end;
-var
- C: Byte;
- I, LSize: Integer;
- P: PByte;
- LPartHeader: string;
-begin
- AConsumed := 0;
- if (FBoundaryBytes = nil) then Exit(frFailed);
-
- (*
- ***************************************
- ***** multipart/form-data数据格式 *****
- ***************************************
-
- # 请求头, 这个是必须的, 需要指定Content-Type为multipart/form-data, 指定唯一边界值
- Content-Type: multipart/form-data; boundary=${Boundary}
-
- # 请求体
- --${Boundary}
- Content-Disposition: form-data; name="name of file"
- Content-Type: application/octet-stream
-
- bytes of file
- --${Boundary}
- Content-Disposition: form-data; name="name of pdf"; filename="pdf-file.pdf"
- Content-Type: application/octet-stream
-
- bytes of pdf file
- --${Boundary}
- Content-Disposition: form-data; name="key"
- Content-Type: text/plain;charset=UTF-8
-
- text encoded in UTF-8
- --${Boundary}--
- *)
-
- P := ABuf;
- I := 0;
- while (I < ALen) do
- begin
- C := P[I];
- case FDecodeState of
- // 检测Boundary, 以确定第一块数据
- dsBoundary:
- begin
- // 第一块数据是紧跟着 HTTP HEADER 的, 前面没有多余的 #13#10
- // 所以这里检测时要跳过 2 个字节
- if (C = FFirstBoundaryBytes[FBoundaryIndex]) then
- Inc(FBoundaryIndex)
- else
- FBoundaryIndex := 0;
- // --Boundary
- if (FBoundaryIndex >= Length(FFirstBoundaryBytes)) then
- begin
- FDecodeState := dsDetect;
- FLineEndState := lesCR1;
- FBoundaryIndex := 0;
- FPostBoundaryState := pbsDetect;
- end;
- end;
-
- // 已通过Boundary检测, 继续检测以确定后面有数据还是已到结束
- dsDetect:
- begin
- // 严格匹配 #13#10 (Header) 或 --#13#10 (End), 拒绝其他任何字节
- case FPostBoundaryState of
- pbsDetect:
- if (C = 45) then // '-'
- FPostBoundaryState := pbsEnd1
- else if (C = 13) then // '\r'
- FPostBoundaryState := pbsHeader1
- else if (C = 32) or (C = 9) then // RFC 2046 LWSP
- { stay in pbsDetect }
- else
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- pbsEnd1:
- if (C = 45) then // '-'
- FPostBoundaryState := pbsEnd2
- else
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- pbsEnd2:
- if (C = 13) then // '\r'
- FPostBoundaryState := pbsEnd3
- else
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- pbsEnd3:
- if (C = 10) then // '\n' → --Boundary--#13#10
- begin
- FDecodeState := dsBoundary;
- FLineEndState := lesCR1;
- FBoundaryIndex := 0;
- FPostBoundaryState := pbsDetect;
- AConsumed := I + 1;
- Exit(frComplete);
- end else
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- pbsHeader1:
- if (C = 10) then // '\n' → --Boundary#13#10
- begin
- FCurrentPartHeaderLen := 0;
- FDecodeState := dsPartHeader;
- FLineEndState := lesCR1;
- FBoundaryIndex := 0;
- FPostBoundaryState := pbsDetect;
- end else
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- end;
- end;
-
- dsPartHeader:
- begin
- FCurrentPartHeader[FCurrentPartHeaderLen] := C;
- Inc(FCurrentPartHeaderLen);
-
- // 状态机严格匹配 #13#10#13#10 序列
- case FLineEndState of
- lesCR1: if (C = 13) then FLineEndState := lesLF1;
- lesLF1:
- if (C = 10) then FLineEndState := lesCR2
- else if (C <> 13) then FLineEndState := lesCR1;
- lesCR2:
- if (C = 13) then FLineEndState := lesLF2
- else FLineEndState := lesCR1;
- lesLF2:
- if (C = 10) then
- begin
- FLineEndState := lesCR1;
- // 块头部结束 #13#10#13#10
- // 块头部通常采用UTF8编码
- LPartHeader := TUtils.GetString(@FCurrentPartHeader[0], FCurrentPartHeaderLen - 4{#13#10#13#10});
- FCurrentPartHeaderLen := 0;
- FCurrentPartField := TFormField.Create;
- if not __InitFormFieldByHeader(FCurrentPartField, LPartHeader) then
- begin
- FreeAndNil(FCurrentPartField);
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- FPartFields.Add(FCurrentPartField);
-
- FDecodeState := dsPartData;
- FPartDataBegin := -1;
- FBoundaryIndex := 0;
- FPrevBoundaryIndex := 0;
- FCurrentPartDataSize := 0;
- end else
- if (C = 13) then FLineEndState := lesLF1
- else FLineEndState := lesCR1;
- end;
-
- // 块头部过大, 视为非法数据
- if (FCurrentPartHeaderLen > MAX_PART_HEADER) then
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- end;
-
- dsPartData:
- begin
- // 如果这是一个新的数据块, 需要保存数据块起始位置
- if (FPartDataBegin < 0) then
- FPartDataBegin := I;
-
- // 检测Boundary
- if (C = FBoundaryBytes[FBoundaryIndex]) then
- begin
- Inc(FBoundaryIndex);
-
- if (FPrevBoundaryIndex > 0) then
- begin
- FLookbehind[FPrevBoundaryIndex] := C;
- Inc(FPrevBoundaryIndex);
- end;
- end else
- begin
- // 上一个内存块结尾有部分有点像Boundary的数据,
- // 进一步判断之后确定不是Boundary, 需要把这部分数据写入Field中
- if (FPrevBoundaryIndex > 0) then
- begin
- FCurrentPartField.FValue.Write(FLookbehind[0], FPrevBoundaryIndex);
- Inc(FCurrentPartDataSize, FPrevBoundaryIndex);
- // 检查单 Part Body 大小是否超限 (与块结尾检查对称)
- if (FMaxPartDataSize > 0) and (FCurrentPartDataSize > FMaxPartDataSize) then
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
- FPrevBoundaryIndex := 0;
- FPartDataBegin := I;
- end;
-
- if (FBoundaryIndex > 0) then
- begin
- // 之前检测到有一部分数据跟Boundary有点像, 但是到这个字节可以确定之前
- // 这部分数据并不是Boundary, 需要把这部分数据写入Field中
- FCurrentPartField.FValue.Write(P[FPartDataBegin], I - FPartDataBegin);
- Inc(FCurrentPartDataSize, I - FPartDataBegin);
- FPartDataBegin := I;
-
- FBoundaryIndex := 0;
-
- // 再次检测Boundary
- if (C = FBoundaryBytes[FBoundaryIndex]) then
- Inc(FBoundaryIndex);
- end;
- end;
-
- // 如果已到内存块结束或者已经解析出一个完整的数据块
- if (I >= ALen - 1) or (FBoundaryIndex >= Length(FBoundaryBytes)) then
- begin
- // 将内存块数据存入Field中
- if (FPartDataBegin >= 0) then
- begin
- LSize := I - FPartDataBegin - FBoundaryIndex + 1;
- if (LSize > 0) then
- begin
- FCurrentPartField.FValue.Write(P[FPartDataBegin], LSize);
- Inc(FCurrentPartDataSize, LSize);
- end;
- end;
-
- // 检查单 Part Body 大小是否超限 (必须在状态切换前检查)
- if (FMaxPartDataSize > 0) and (FCurrentPartDataSize > FMaxPartDataSize) then
- begin
- AConsumed := I + 1;
- Exit(frFailed);
- end;
-
- // 已解析出一个完整的数据块
- if (FBoundaryIndex >= Length(FBoundaryBytes)) then
- begin
- FCurrentPartField.FValue.Position := 0;
- FDecodeState := dsDetect;
- FBoundaryIndex := 0;
- FPrevBoundaryIndex := 0;
- FCurrentPartDataSize := 0;
- end else
- // 已解析到本内存块结尾, 但是发现了部分有点像Boundary的数据
- // 将其保存起来
- if (FPrevBoundaryIndex = 0) and (FBoundaryIndex > 0) then
- begin
- FPrevBoundaryIndex := FBoundaryIndex;
- Move(P[I - FBoundaryIndex + 1], FLookbehind[0], FBoundaryIndex);
- end;
-
- // 数据块起始位置需要在之后决定
- FPartDataBegin := -1;
- end;
- end;
- end;
-
- Inc(I);
- end;
-
- AConsumed := ALen;
- Result := frContinue;
-end;
-
-function THttpMultiPartFormData.Decode(const ABuf: Pointer; ALen: Integer): TFormDataDecodeResult;
-var
- LDummy: Integer;
-begin
- // 兼容旧调用方: 丢弃 consumed; 仅在调用方明确知道 multipart 数据帧严格对齐时使用.
- Result := Decode(ABuf, ALen, LDummy);
-end;
-
-{ THttpMultiPartFormStream.TFormFieldEx }
-
-function THttpMultiPartFormStream.TFormFieldEx.DataSize: Int64;
-begin
- if (Field <> nil) and (Field.Value <> nil) then
- Result := Field.Value.Size
- else
- Result := 0;
-end;
-
-function THttpMultiPartFormStream.TFormFieldEx.HeaderSize: Integer;
-begin
- Result := Length(Header);
-end;
-
-function THttpMultiPartFormStream.TFormFieldEx.TotalSize: Int64;
-begin
- Result := HeaderSize + DataSize;
-end;
-
-{ THttpMultiPartFormStream }
-
-constructor THttpMultiPartFormStream.Create(
- const AMultiPartFormData: THttpMultiPartFormData; const AOwned: Boolean);
-begin
- FMultiPartFormData := AMultiPartFormData;
- FOwned := AOwned;
-
- _Init;
-end;
-
-destructor THttpMultiPartFormStream.Destroy;
-begin
- if FOwned and (FMultiPartFormData <> nil) then
- FreeAndNil(FMultiPartFormData);
-
- inherited;
-end;
-
-function THttpMultiPartFormStream.Read(var ABuffer; ACount: Longint): Longint;
-var
- LReadCount, LPos, LHeaderPos, LDataPos, LCount, LHeaderCount, LDataCount, LEndPos, LEndCount: Int64;
- LFieldIndex: Integer;
- LFieldEx: TFormFieldEx;
- P: PByte;
-begin
- Result := 0;
- if (FPosition < 0) or (FPosition >= FSize) or (ACount <= 0) then Exit;
-
- // 计算实际还能读取多少字节数据
- if (ACount + FPosition <= FSize) then
- LReadCount := ACount
- else
- LReadCount := FSize - FPosition;
-
- Result := LReadCount;
-
- P := @ABuffer;
-
- {$region '从 Field 中读取数据'}
- while (LReadCount > 0) do
- begin
- LFieldIndex := _GetFiledIndexByOffset(FPosition);
- if (LFieldIndex < 0) then Break;
-
- LFieldEx := FFormFieldExArray[LFieldIndex];
-
- // 计算要读取的数据位于这个 Field 的偏移
- LPos := FPosition - LFieldEx.Offset;
-
- // 计算需要从这个 Field 中读取多少字节
- LCount := Min(LFieldEx.TotalSize - LPos, LReadCount);
-
- // 计算分别需要从 Header 和 Data 中读取多少字节
- if (LPos < LFieldEx.HeaderSize) then
- begin
- LHeaderPos := LPos;
- LDataPos := 0;
-
- LHeaderCount := Min(LFieldEx.HeaderSize - LHeaderPos, LCount);
- LDataCount := LCount - LHeaderCount;
- end else
- begin
- LHeaderPos := -1;
- LDataPos := LPos - LFieldEx.HeaderSize;
-
- LHeaderCount := 0;
- LDataCount := LCount - LHeaderCount;
- end;
-
- // 读取 Header
- if (LHeaderCount > 0) then
- begin
- Move(LFieldEx.Header[LHeaderPos], P^, LHeaderCount);
- Inc(P, LHeaderCount);
- Dec(LReadCount, LHeaderCount);
-
- Seek(LHeaderCount, soCurrent);
- end;
-
- // 读取 Data
- if (LDataCount > 0) then
- begin
- LFieldEx.Field.Value.Position := LDataPos;
- LFieldEx.Field.Value.Read(P^, LDataCount);
- Inc(P, LDataCount);
- Dec(LReadCount, LDataCount);
-
- Seek(LDataCount, soCurrent);
- end;
- end;
- {$endregion}
-
- // 从尾巴读取数据
- if (LReadCount > 0) then
- begin
- LEndPos := FPosition - FEndPos;
- LEndCount := Min(Length(FMultiPartEnd) - LEndPos, LReadCount);
-
- if (LEndCount > 0) then
- begin
- Move(FMultiPartEnd[LEndPos], P^, LEndCount);
-// Inc(P, LEndCount);
-// Dec(LReadCount, LEndCount);
-
- Seek(LEndCount, soCurrent);
- end;
- end;
-end;
-
-function THttpMultiPartFormStream.Seek(const AOffset: Int64;
- AOrigin: TSeekOrigin): Int64;
-begin
- case AOrigin of
- soBeginning: FPosition := AOffset;
- soCurrent: Inc(FPosition, AOffset);
- soEnd: FPosition := FSize + AOffset;
- end;
-
- if (FPosition < 0) then
- FPosition := -1;
-
- if (FPosition > FSize) then
- FPosition := FSize;
-
- Result := FPosition;
-end;
-
-function THttpMultiPartFormStream._GetFiledIndexByOffset(
- const AOffset: Int64): Integer;
-var
- LOffset: Int64;
- I: Integer;
-begin
- Result := -1;
- if (AOffset < 0) or (AOffset >= FSize) then Exit;
-
- LOffset := 0;
-
- for I := 0 to High(FFormFieldExArray) do
- begin
- Inc(LOffset, FFormFieldExArray[I].TotalSize);
- if (AOffset < LOffset) then Exit(I);
- end;
-end;
-
-procedure THttpMultiPartFormStream._Init;
-var
- I: Integer;
- LFormFieldEx: TFormFieldEx;
- LContentType, LPartHeaderStr: string;
- LPartHeaderBytes, LBoundary: TBytes;
- LOffset: Int64;
-begin
- {
- --boundary_value
- Content-Disposition: form-data; name="text_field"
-
- This is a simple text field.
-
- --boundary_value
- Content-Disposition: form-data; name="binary_data"
- Content-Type: application/octet-stream
-
- [Binary data goes here]
-
- --boundary_value
- Content-Disposition: form-data; name="file_field"; filename="example.txt"
- Content-Type: text/plain
-
- Contents of the example.txt file.
-
- --boundary_value
- Content-Disposition: form-data; name="image"; filename="image.jpg"
- Content-Type: image/jpeg
-
- [Binary image data]
-
- --boundary_value--
- }
- // 检查 boundary, 如果没有则生成
- if (FMultiPartFormData.Boundary = '') then
- begin
- Randomize;
- FMultiPartFormData.Boundary := '--DCSFormBoundary'
- + IntToHex(Random(MaxInt), 8)
- + IntToHex(Random(MaxInt), 8);
- end;
-
- // 结尾数据
- FMultiPartEnd := TArrayUtils.Concat(FMultiPartFormData.FBoundaryBytes, [45, 45, 13, 10]);
-
- LOffset := 0;
- FSize := 0;
- FPosition := 0;
-
- {$region '生成Field的头'}
- SetLength(FFormFieldExArray, FMultiPartFormData.Count);
-
- for I := 0 to FMultiPartFormData.Count - 1 do
- begin
- LFormFieldEx.Offset := LOffset;
- LFormFieldEx.Field := FMultiPartFormData.Items[I];
-
- if (I = 0) then
- LBoundary := FMultiPartFormData.FFirstBoundaryBytes
- else
- LBoundary := FMultiPartFormData.FBoundaryBytes;
-
- // 'Content-Disposition: form-data; name="%s"; filename="%s"'#13#10 +
- // 'Content-Type: %s'#13#10#13#10
-
- LContentType := LFormFieldEx.Field.ContentType;
-
- LPartHeaderStr := Format(
- 'Content-Disposition: form-data; name="%s"', [
- LFormFieldEx.Field.Name
- ]);
- if (LFormFieldEx.Field.FileName <> '') then
- begin
- LPartHeaderStr := LPartHeaderStr
- + Format('; filename="%s"', [LFormFieldEx.Field.FileName]);
-
- if (LContentType = '') then
- LContentType := TCrossHttpUtils.GetFileMIMEType(LFormFieldEx.Field.FileName);
- end;
- LPartHeaderStr := LPartHeaderStr + #13#10;
-
- if (LContentType <> '') then
- begin
- LPartHeaderStr := LPartHeaderStr
- + Format('Content-Type: %s', [LContentType])
- + #13#10;
- end;
- LPartHeaderStr := LPartHeaderStr + #13#10;
-
- LPartHeaderBytes := TEncoding.UTF8.GetBytes(LPartHeaderStr);
-
- LFormFieldEx.Header := TArrayUtils.Concat([
- LBoundary, [13, 10], LPartHeaderBytes]);
-
- Inc(FSize, LFormFieldEx.HeaderSize);
- Inc(FSize, LFormFieldEx.DataSize);
- Inc(LOffset, LFormFieldEx.TotalSize);
-
- FFormFieldExArray[I] := LFormFieldEx;
- end;
- {$endregion}
-
- FEndPos := LOffset;
- Inc(FSize, Length(FMultiPartEnd));
-end;
-
-{ TResponseCookies }
-
-procedure TResponseCookies.AddOrSet(const AName, AValue: string;
- AMaxAge: Integer; const APath, ADomain: string; AHttpOnly, ASecure: Boolean);
-begin
- SetCookie(AName, TResponseCookie.Create(AName, AValue, AMaxAge, APath, ADomain, AHttpOnly, ASecure));
-end;
-
-function TResponseCookies.GetCookieIndex(const AName: string): Integer;
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- if TStrUtils.SameText(Items[I].Name, AName) then Exit(I);
- Result := -1;
-end;
-
-procedure TResponseCookies.Remove(const AName: string);
-var
- I: Integer;
-begin
- I := GetCookieIndex(AName);
- if (I >= 0) then
- inherited Delete(I);
-end;
-
-function TResponseCookies.GetCookie(const AName: string): TResponseCookie;
-var
- I: Integer;
-begin
- I := GetCookieIndex(AName);
- if (I >= 0) then
- Result := Items[I]
- else
- begin
- Result := TResponseCookie.Create(AName, '', 0);
- Add(Result);
- end;
-end;
-
-procedure TResponseCookies.SetCookie(const AName: string;
- const Value: TResponseCookie);
-var
- I: Integer;
-begin
- I := GetCookieIndex(AName);
- if (I >= 0) then
- Items[I] := Value
- else
- Add(Value);
-end;
-
-{ TSessionBase }
-
-constructor TSessionBase.Create(const AOwner: TSessionsBase; const ASessionID: string);
-var
- LNow: TDateTime;
-begin
- LNow := Now;
-
- FOwner := AOwner;
-
- SetSessionID(ASessionID);
- SetCreateTime(LNow);
- SetLastAccessTime(LNow);
-end;
-
-function TSessionBase.Expired: Boolean;
-begin
- Result := (ExpiryTime > 0) and (Now.SecondsDiffer(LastAccessTime) >= ExpiryTime);
-end;
-
-function TSessionBase.GetOwner: ISessions;
-begin
- Result := FOwner;
-end;
-
-procedure TSessionBase.Touch;
-begin
- LastAccessTime := Now;
-end;
-
-{ TSession }
-
-constructor TSession.Create(const AOwner: TSessionsBase; const ASessionID: string);
-begin
- FValues := TDictionary.Create;
-
- inherited Create(AOwner, ASessionID);
-end;
-
-destructor TSession.Destroy;
-begin
- FreeAndNil(FValues);
- inherited;
-end;
-
-function TSession.GetCreateTime: TDateTime;
-begin
- Result := FCreateTime;
-end;
-
-function TSession.GetExpiryTime: Integer;
-begin
- Result := FExpire;
-end;
-
-function TSession.GetLastAccessTime: TDateTime;
-begin
- Result := FLastAccessTime;
-end;
-
-function TSession.GetSessionID: string;
-begin
- Result := FSessionID;
-end;
-
-function TSession.GetValue(const AName: string): string;
-begin
- if not FValues.TryGetValue(AName, Result) then
- Result := '';
- FLastAccessTime := Now;
-end;
-
-procedure TSession.SetCreateTime(const ACreateTime: TDateTime);
-begin
- FCreateTime := ACreateTime;
-end;
-
-procedure TSession.SetExpiryTime(const AValue: Integer);
-begin
- FExpire := AValue;
-end;
-
-procedure TSession.SetLastAccessTime(const ALastAccessTime: TDateTime);
-begin
- FLastAccessTime := ALastAccessTime;
-end;
-
-procedure TSession.SetSessionID(const ASessionID: string);
-begin
- FSessionID := ASessionID;
-end;
-
-procedure TSession.SetValue(const AName, AValue: string);
-begin
- if (AValue <> '') then
- FValues.AddOrSetValue(AName, AValue)
- else
- FValues.Remove(AName);
- FLastAccessTime := Now;
-end;
-
-{ TSessionsBase }
-
-function TSessionsBase.AddSession(const ASessionID: string): ISession;
-begin
- Result := GetSessionClass.Create(Self, ASessionID);
- Result.ExpiryTime := ExpiryTime;
- AddSession(ASessionID, Result);
-end;
-
-function TSessionsBase.AddSession: ISession;
-begin
- Result := AddSession(NewSessionID);
-end;
-
-function TSessionsBase.ExistsSession(const ASessionID: string): Boolean;
-var
- LStuff: ISession;
-begin
- Result := ExistsSession(ASessionID, LStuff);
-end;
-
-procedure TSessionsBase.RemoveSession(const ASessionID: string);
-var
- LSession: ISession;
-begin
- if ExistsSession(ASessionID, LSession) then
- RemoveSession(LSession);
-end;
-
-procedure TSessionsBase.RemoveSession(const ASession: ISession);
-begin
- RemoveSessions([ASession]);
-end;
-
-{ TSessions }
-
-constructor TSessions.Create(ANewGUIDFunc: TFunc);
-begin
- FNewGUIDFunc := ANewGUIDFunc;
- FSessions := TDictionary.Create;
- FLocker := TReadWriteLock.Create;
- FSessionClass := TSession;
- CreateExpiredProcThread;
-end;
-
-procedure TSessions.Clear;
-begin
- FSessions.Clear;
-end;
-
-constructor TSessions.Create;
-begin
- Create(nil);
-end;
-
-destructor TSessions.Destroy;
-var
- LTimeout: TStopwatch;
-begin
- FShutdown := True;
- LTimeout := TStopwatch.StartNew;
- while FExpiredProcRunning and (LTimeout.ElapsedMilliseconds < 5000) do Sleep(10);
-
- BeginWrite;
- FSessions.Clear;
- EndWrite;
- FreeAndNil(FSessions);
-
- inherited;
-end;
-
-procedure TSessions.AddSession(const ASessionID: string; ASession: ISession);
-begin
- if (ASession.ExpiryTime = 0) then
- ASession.ExpiryTime := ExpiryTime;
- FSessions.AddOrSetValue(ASessionID, ASession);
-end;
-
-procedure TSessions.AfterClearExpiredSessions;
-begin
-
-end;
-
-procedure TSessions.BeforeClearExpiredSessions;
-begin
-
-end;
-
-procedure TSessions.BeginRead;
-begin
- FLocker.BeginRead;
-end;
-
-procedure TSessions.BeginWrite;
-begin
- FLocker.BeginWrite;
-end;
-
-procedure TSessions.EndRead;
-begin
- FLocker.EndRead;
-end;
-
-procedure TSessions.EndWrite;
-begin
- FLocker.EndWrite;
-end;
-
-function TSessions.ExistsSession(const ASessionID: string;
- var ASession: ISession): Boolean;
-begin
- Result := FSessions.TryGetValue(ASessionID, ASession);
- if Result then
- ASession.Touch;
-end;
-
-procedure TSessions.CreateExpiredProcThread;
-begin
- TAnonymousThread.Create(
- procedure
- var
- LWatch: TStopwatch;
- begin
- FExpiredProcRunning := True;
- try
- LWatch := TStopwatch.StartNew;
- while not FShutdown do
- begin
- // 每 1 分钟清理一次超时 Session
- if (FExpire > 0) and (LWatch.Elapsed.TotalMinutes >= 1) then
- begin
- _ClearExpiredSessions;
- LWatch.Reset;
- LWatch.Start;
- end;
- Sleep(10);
- end;
- finally
- FExpiredProcRunning := False;
- end;
- end).Start;
-end;
-
-function TSessions.NewSessionID: string;
-begin
- if Assigned(FNewGUIDFunc) then
- Result := FNewGUIDFunc()
- else
- Result := TUtils.GetGUID.ToLower;
-end;
-
-function TSessions.OnCheckExpiredSession(const ASession: ISession): Boolean;
-begin
- Result := ASession.Expired;
-end;
-
-function TSessions.GetCount: Integer;
-begin
- Result := FSessions.Count;
-end;
-
-function TSessions.GetEnumerator: TEnumerator;
-begin
- Result := TDictionary.TValueEnumerator.Create(FSessions);
-end;
-
-function TSessions.GetExpiryTime: Integer;
-begin
- Result := FExpire;
-end;
-
-function TSessions.GetItem(const AIndex: Integer): ISession;
-var
- LIndex: Integer;
- LPair: TPair;
-begin
- LIndex := 0;
- for LPair in FSessions do
- begin
- if (LIndex = AIndex) then Exit(LPair.Value);
- Inc(LIndex);
- end;
- Result := nil;
-end;
-
-function TSessions.GetSession(const ASessionID: string): ISession;
-var
- LSessionID: string;
-begin
- LSessionID := ASessionID;
- BeginWrite;
- try
- if (LSessionID = '') then
- LSessionID := NewSessionID;
- if not FSessions.TryGetValue(LSessionID, Result) then
- begin
- Result := FSessionClass.Create(Self, LSessionID);
- Result.ExpiryTime := ExpiryTime;
- AddSession(LSessionID, Result);
- end;
- finally
- EndWrite;
- end;
-
- Result.LastAccessTime := Now;
-end;
-
-function TSessions.GetSessionClass: TSessionClass;
-begin
- Result := FSessionClass;
-end;
-
-procedure TSessions.RemoveSessions(const ASessions: TArray);
-var
- LSession: ISession;
-begin
- for LSession in ASessions do
- FSessions.Remove(LSession.SessionID);
-end;
-
-procedure TSessions.SetExpiryTime(const Value: Integer);
-begin
- FExpire := Value;
-end;
-
-procedure TSessions.SetSessionClass(const Value: TSessionClass);
-begin
- FSessionClass := Value;
-end;
-
-procedure TSessions._ClearExpiredSessions;
-var
- LPair: TPair;
- LDelSessions: TArray;
-begin
- BeginWrite;
- try
- BeforeClearExpiredSessions;
-
- LDelSessions := nil;
- for LPair in FSessions do
- begin
- if FShutdown then Break;
-
- if OnCheckExpiredSession(LPair.Value) then
- LDelSessions := LDelSessions + [LPair.Value];
- end;
- RemoveSessions(LDelSessions);
-
- AfterClearExpiredSessions;
- finally
- EndWrite;
- end;
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossHttpParams;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ Generics.Collections,
+ Generics.Defaults,
+ DateUtils,
+ Math,
+
+ {$IFDEF DELPHI}
+ System.Diagnostics,
+ {$ELSE}
+ DTF.Types,
+ DTF.Diagnostics,
+ DTF.Generics,
+ {$ENDIF}
+
+ Net.CrossHttpUtils,
+
+ Utils.AnonymousThread,
+ Utils.RegEx,
+ Utils.IOUtils,
+ Utils.DateTime,
+ Utils.StrUtils,
+ Utils.SyncObjs,
+ Utils.ArrayUtils,
+ Utils.Utils;
+
+type
+ TNameValue = record
+ Name, Value: string;
+ constructor Create(const AName, AValue: string);
+ end;
+
+ INameValueComparer = IComparer;
+ TNameValueComparison = {$IFDEF DELPHI}TComparison{$ELSE}TComparisonAnonymousFunc{$ENDIF};
+ TNameValueComparer = {$IFDEF DELPHI}TDelegatedComparer{$ELSE}TDelegatedComparerAnonymousFunc{$ENDIF};
+
+ ///
+ /// 参数基础类
+ ///
+ TBaseParams = class
+ private type
+ TEnumerator = class
+ private
+ FIndex: Integer;
+ FParams: TBaseParams;
+ public
+ constructor Create(const AParams: TBaseParams);
+ function GetCurrent: TNameValue; inline;
+ function MoveNext: Boolean; inline;
+ property Current: TNameValue read GetCurrent;
+ end;
+ private
+ FParams: TList;
+
+ function GetParamIndex(const AName: string): Integer;
+ function GetParam(const AName: string): string;
+ procedure SetParam(const AName, AValue: string);
+ function GetCount: Integer;
+ function GetItem(AIndex: Integer): TNameValue;
+ procedure SetItem(AIndex: Integer; const AValue: TNameValue);
+ public
+ constructor Create; overload; virtual;
+ constructor Create(const AEncodedParams: string); overload; virtual;
+ destructor Destroy; override;
+
+ ///
+ /// 枚举器
+ ///
+ function GetEnumerator: TEnumerator; inline;
+
+ ///
+ /// 从源对象设置数据
+ ///
+ procedure Assign(const ASource: TBaseParams);
+
+ ///
+ /// 添加参数
+ ///
+ procedure Add(const AParamValue: TNameValue); overload;
+
+ ///
+ /// 添加参数
+ ///
+ ///
+ /// 参数名
+ ///
+ ///
+ /// 参数值
+ ///
+ ///
+ /// 是否允许重名参数
+ ///
+ procedure Add(const AName, AValue: string; ADupAllowed: Boolean = False); overload;
+
+ ///
+ /// 添加已编码参数
+ ///
+ ///
+ /// 已编码参数字符串
+ ///
+ procedure Add(const AEncodedParams: string); overload;
+
+ ///
+ /// 根据名称删除指定参数
+ ///
+ ///
+ /// 参数名称
+ ///
+ procedure Remove(const AName: string); overload;
+
+ ///
+ /// 根据序号删除指定参数
+ ///
+ ///
+ /// 参数序号
+ ///
+ procedure Remove(AIndex: Integer); overload;
+
+ ///
+ /// 清除所有参数
+ ///
+ procedure Clear;
+
+ ///
+ /// 对参数排序
+ ///
+ ///
+ /// 自定义比较函数，为nil时按参数名排序
+ ///
+ procedure Sort(const AComparison: TNameValueComparison = nil);
+
+ ///
+ /// 从已编码的字符串中解码
+ ///
+ ///
+ /// 已编码字符串
+ ///
+ ///
+ /// 是否清除现有数据
+ ///
+ ///
+ /// 解码是否成功
+ ///
+ function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; virtual; abstract;
+
+ ///
+ /// 编码为字符串
+ ///
+ ///
+ /// 编码后的字符串
+ ///
+ function Encode: string; virtual; abstract;
+
+ ///
+ /// 获取参数值
+ ///
+ ///
+ /// 参数名称
+ ///
+ ///
+ /// 返回的参数值
+ ///
+ ///
+ /// 如果找到参数返回True，否则返回False
+ ///
+ function GetParamValue(const AName: string; out AValue: string): Boolean;
+
+ ///
+ /// 获取指定名称的所有参数值
+ ///
+ ///
+ /// 参数名称
+ ///
+ ///
+ /// 返回的参数值数组
+ ///
+ ///
+ /// 如果找到参数返回True，否则返回False
+ ///
+ function GetHeaderValues(const AName: string; out AValues: TArray): Boolean;
+
+ ///
+ /// 是否存在参数
+ ///
+ ///
+ /// 参数名称
+ ///
+ ///
+ /// 如果存在参数返回True，否则返回False
+ ///
+ function ExistsParam(const AName: string): Boolean;
+
+ ///
+ /// 按名称访问参数
+ ///
+ ///
+ /// 参数名称
+ ///
+ ///
+ /// 参数值，如果不存在返回空字符串
+ ///
+ property Params[const AName: string]: string read GetParam write SetParam; default;
+
+ ///
+ /// 按序号访问参数
+ ///
+ ///
+ /// 参数序号
+ ///
+ ///
+ /// 参数名值对
+ ///
+ property Items[AIndex: Integer]: TNameValue read GetItem write SetItem;
+
+ ///
+ /// 参数个数
+ ///
+ property Count: Integer read GetCount;
+ end;
+
+ ///
+ /// Url参数类
+ ///
+ THttpUrlParams = class(TBaseParams)
+ private
+ FEncodeName: Boolean;
+ FEncodeValue: Boolean;
+ public
+ constructor Create; override;
+
+ ///
+ /// 从已编码的字符串中解码
+ ///
+ ///
+ /// 已编码字符串
+ ///
+ ///
+ /// 是否清除现有数据
+ ///
+ function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
+
+ ///
+ /// 编码为字符串
+ ///
+ function Encode: string; override;
+
+ ///
+ /// 是否对名称做编码
+ ///
+ property EncodeName: Boolean read FEncodeName write FEncodeName;
+
+ ///
+ /// 是否对名称做编码
+ ///
+ property EncodeValue: Boolean read FEncodeValue write FEncodeValue;
+ end;
+
+ ///
+ /// HTTP头类
+ ///
+ THttpHeader = class(TBaseParams)
+ public
+ ///
+ /// 从已编码的字符串中解码
+ ///
+ ///
+ /// 已编码字符串
+ ///
+ ///
+ /// 是否清除现有数据
+ ///
+ function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
+
+ ///
+ /// 编码为字符串
+ ///
+ function Encode: string; override;
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// x-www-form-urlencoded 格式参数
+ ///
+ {$ENDREGION}
+ TFormUrlEncoded = class(THttpUrlParams);
+
+ ///
+ /// 带分隔符的参数
+ ///
+ TDelimitParams = class(TBaseParams)
+ private
+ FDelimiter: Char;
+ FUrlEncode: Boolean;
+ public
+ constructor Create(const ADelimiter: Char; const AUrlEncode: Boolean = False); reintroduce; overload; virtual;
+ constructor Create(const AEncodedParams: string; const ADelimiter: Char; const AUrlEncode: Boolean = False); reintroduce; overload; virtual;
+
+ ///
+ /// 从已编码的字符串中解码
+ ///
+ ///
+ /// 已编码字符串
+ ///
+ ///
+ /// 是否清除现有数据
+ ///
+ function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
+
+ ///
+ /// 编码为字符串
+ ///
+ function Encode: string; override;
+
+ ///
+ /// 分隔字符
+ ///
+ property Delimiter: Char read FDelimiter write FDelimiter;
+
+ ///
+ /// 是否进行URL编解码
+ ///
+ property UrlEncode: Boolean read FUrlEncode write FUrlEncode;
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 客户端请求头中的Cookies
+ ///
+ ///
+ ///
+ /// 格式如下
+ ///
+ ///
+ /// Cookie: name1=value1; name2=value2; ...
+ ///
+ ///
+ {$ENDREGION}
+ TRequestCookies = class(TBaseParams)
+ public
+ ///
+ /// 从已编码的字符串中解码
+ ///
+ ///
+ /// 已编码字符串
+ ///
+ ///
+ /// 是否清除现有数据
+ ///
+ function Decode(const AEncodedParams: string; AClear: Boolean = True): Boolean; override;
+
+ ///
+ /// 编码为字符串
+ ///
+ function Encode: string; override;
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 响应头中的Cookie
+ ///
+ ///
+ ///
+ /// 格式如下
+ ///
+ ///
+ /// Set-Cookie: name=value; [expires=date;] [path=path;]
+ /// [domain=domain;] [secure;] [HttpOnly;]
+ ///
+ ///
+ {$ENDREGION}
+ TResponseCookie = record
+ ///
+ /// Cookie名称
+ ///
+ Name: string;
+
+ ///
+ /// Cookie数据
+ ///
+ Value: string;
+
+ ///
+ /// Cookie有效期秒数, 如果设置为0则浏览器关闭后该Cookie即失效
+ ///
+ MaxAge: Integer;
+
+ ///
+ /// 域名作用域
+ ///
+ ///
+ /// 定义Cookie的生效作用域, 只有当域名和路径同时满足的时候, 浏览器才会将Cookie发送给Server.
+ /// 如果没有设置Domain和Path的话, 他们会被默认为当前请求页面对应值
+ ///
+ Domain: string;
+
+ ///
+ /// 路径作用域
+ ///
+ ///
+ /// 定义Cookie的生效作用域, 只有当域名和路径同时满足的时候, 浏览器才会将Cookie发送给Server.
+ /// 如果没有设置Domain和Path的话, 他们会被默认为当前请求页面对应值
+ ///
+ Path: string;
+
+ ///
+ /// 是否启用 HttpOnly
+ ///
+ ///
+ /// HttpOnly字段告诉浏览器, 只有在HTTP协议下使用, 对浏览器的脚本不可见, 所以跨站脚本攻击时也不会被窃取
+ ///
+ HttpOnly: Boolean;
+
+ ///
+ /// 是否启用Secure
+ ///
+ ///
+ /// Secure字段告诉浏览器在https通道时, 对Cookie进行安全加密, 这样即时有黑客监听也无法获取cookie内容
+ ///
+ Secure: Boolean;
+
+ constructor Create(const AName, AValue: string; AMaxAge: Integer;
+ const APath: string = ''; const ADomain: string = '';
+ AHttpOnly: Boolean = False; ASecure: Boolean = False); overload;
+
+ constructor Create(const ACookieData: string; const ADomain: string = ''); overload;
+
+ function Encode: string;
+ end;
+
+ ///
+ /// Cookie类
+ ///
+ TResponseCookies = class(TList)
+ private
+ function GetCookieIndex(const AName: string): Integer;
+ function GetCookie(const AName: string): TResponseCookie;
+ procedure SetCookie(const AName: string; const Value: TResponseCookie);
+ public
+ procedure AddOrSet(const AName, AValue: string; AMaxAge: Integer;
+ const APath: string = ''; const ADomain: string = '';
+ AHttpOnly: Boolean = False; ASecure: Boolean = False);
+ procedure Remove(const AName: string);
+
+ property Cookies[const AName: string]: TResponseCookie read GetCookie write SetCookie;
+ end;
+
+ TFormField = class
+ private
+ FName: string;
+ FValue: TStream;
+ FFileName: string;
+ FFilePath: string;
+ FContentType: string;
+ FContentTransferEncoding: string;
+ FValueOwned, FIsTempFile: Boolean;
+ public
+ constructor Create; overload;
+ destructor Destroy; override;
+
+ ///
+ /// 从源对象设置数据
+ ///
+ procedure Assign(const ASource: TFormField);
+
+ ///
+ /// 将数据转为字节
+ ///
+ function AsBytes: TBytes;
+
+ ///
+ /// 将数据转为字符串
+ ///
+ ///
+ /// 字符串编码
+ ///
+ function AsString(AEncoding: TEncoding = nil): string;
+
+ ///
+ /// 释放流数据
+ ///
+ procedure FreeValue;
+
+ ///
+ /// 名称
+ ///
+ property Name: string read FName;
+
+ ///
+ /// 原始流数据
+ ///
+ property Value: TStream read FValue;
+
+ ///
+ /// 文件名（只有文件才有该属性）
+ ///
+ property FileName: string read FFileName;
+
+ ///
+ /// 文件保存路径（只有文件才有该属性）
+ ///
+ property FilePath: string read FFilePath;
+
+ ///
+ /// 内容类型（只有文件才有该属性）
+ ///
+ property ContentType: string read FContentType;
+ property ContentTransferEncoding: string read FContentTransferEncoding;
+ end;
+
+ ///
+ /// FormData解码结果
+ ///
+ TFormDataDecodeResult = (frContinue, frComplete, frFailed);
+
+ ///
+ /// MultiPartFormData类
+ ///
+ THttpMultiPartFormData = class
+ private type
+ TEnumerator = class
+ private
+ FList: TList;
+ FIndex: Integer;
+ public
+ constructor Create(const AList: TList);
+ function GetCurrent: TFormField; inline;
+ function MoveNext: Boolean; inline;
+ property Current: TFormField read GetCurrent;
+ end;
+ public type
+ TDecodeState = (dsBoundary, dsDetect, dsPartHeader, dsPartData);
+
+ ///
+ /// 头部结束标记检测状态机, 严格匹配 #13#10#13#10 序列
+ ///
+ TLineEndState = (lesCR1, lesLF1, lesCR2, lesLF2);
+
+ ///
+ /// dsDetect 状态: Boundary 标记之后判断是 Header 数据还是结束标记
+ ///
+ TPostBoundaryState = (pbsDetect, pbsHeader1, pbsEnd1, pbsEnd2, pbsEnd3);
+ private const
+ MAX_PART_HEADER: Integer = 64 * 1024;
+ private
+ FBoundary, FStoragePath: string;
+ FFirstBoundaryBytes, FBoundaryBytes, FLookbehind: TBytes;
+ FBoundaryIndex, FPartDataBegin: Integer;
+ FPostBoundaryState: TPostBoundaryState;
+ FPrevBoundaryIndex: Integer;
+ FDecodeState: TDecodeState;
+ FLineEndState: TLineEndState;
+ FPartFields: TObjectList;
+ FCurrentPartHeader: TBytes;
+ FCurrentPartHeaderLen: Integer;
+ FCurrentPartField: TFormField;
+ FAutoDeleteFiles: Boolean;
+ FMaxPartDataSize: Integer;
+ FCurrentPartDataSize: Int64;
+
+ function GetItemIndex(const AName: string): Integer;
+ function GetItem(AIndex: Integer): TFormField;
+ function GetCount: Integer;
+ function GetDataSize: Integer;
+ function GetField(const AName: string): TFormField;
+ procedure SetBoundary(const AValue: string);
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 枚举器
+ ///
+ {$ENDREGION}
+ function GetEnumerator: TEnumerator; inline;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 从源对象设置数据
+ ///
+ {$ENDREGION}
+ procedure Assign(const ASource: THttpMultiPartFormData);
+
+ {$REGION 'Documentation'}
+ ///
+ /// 初始化Boundary(Decode之前调用)
+ ///
+ {$ENDREGION}
+ procedure InitWithBoundary(const ABoundary: string);
+
+ {$REGION 'Documentation'}
+ ///
+ /// 从内存中解码(必须先调用InitWithBoundary)
+ ///
+ ///
+ /// 待解码数据
+ ///
+ ///
+ /// 数据长度
+ ///
+ ///
+ /// 已知限制: 仅支持 multipart/form-data; 不支持 RFC 2046 preamble/epilogue 文本;
+ /// 不支持 multipart/mixed 嵌套; Content-Transfer-Encoding 仅存储不解码.
+ ///
+ {$ENDREGION}
+ function Decode(const ABuf: Pointer; ALen: Integer): TFormDataDecodeResult; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 从内存中解码并返回实际消费的字节数(必须先调用InitWithBoundary)
+ ///
+ ///
+ /// 待解码数据
+ ///
+ ///
+ /// 数据长度
+ ///
+ ///
+ /// 出参: 实际消费的字节数. frComplete 时可能小于 ALen, 调用方需要用剩余字节继续后续解析.
+ ///
+ {$ENDREGION}
+ function Decode(const ABuf: Pointer; ALen: Integer; out AConsumed: Integer): TFormDataDecodeResult; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 从数据流解码(必须先调用InitWithBoundary)
+ ///
+ ///
+ /// 待解码数据流
+ ///
+ {$ENDREGION}
+ function Decode(const AStream: TStream): TFormDataDecodeResult; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 清除所有Items
+ ///
+ {$ENDREGION}
+ procedure Clear;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 添加字段
+ ///
+ ///
+ /// 字段对象
+ ///
+ {$ENDREGION}
+ function AddField(const AField: TFormField): TFormField; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 添加字段
+ ///
+ ///
+ /// 字段名
+ ///
+ ///
+ /// 字段值
+ ///
+ {$ENDREGION}
+ function AddField(const AFieldName: string; const AValue: TBytes): TFormField; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 添加字段
+ ///
+ ///
+ /// 字段名
+ ///
+ ///
+ /// 字段值
+ ///
+ {$ENDREGION}
+ function AddField(const AFieldName, AValue: string): TFormField; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 添加文件字段
+ ///
+ ///
+ /// 字段名
+ ///
+ ///
+ /// 文件名
+ ///
+ ///
+ /// 文件流
+ ///
+ ///
+ /// 是否自动释放
+ ///
+ {$ENDREGION}
+ function AddFile(const AFieldName, AFileName: string;
+ const AStream: TStream; const AOwned: Boolean = False): TFormField; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 添加文件字段
+ ///
+ ///
+ /// 字段名
+ ///
+ ///
+ /// 文件名
+ ///
+ {$ENDREGION}
+ function AddFile(const AFieldName, AFileName: string): TFormField; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 根据名称删除指定字段
+ ///
+ ///
+ /// 字段名
+ ///
+ {$ENDREGION}
+ procedure Remove(const AFieldName: string); overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 根据序号删除指定字段
+ ///
+ ///
+ /// 字段序号
+ ///
+ {$ENDREGION}
+ procedure Remove(AIndex: Integer); overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 查找参数
+ ///
+ {$ENDREGION}
+ function FindField(const AFieldName: string; out AField: TFormField): Boolean;
+
+ function AsBytes(const AFieldName: string; out AValue: TBytes): Boolean; overload;
+ function AsBytes(const AFieldName: string): TBytes; overload;
+
+ function AsStream(const AFieldName: string; out AValue: TStream): Boolean; overload;
+ function AsStream(const AFieldName: string): TStream; overload;
+
+ function AsString(const AFieldName: string; const AEncoding: TEncoding; out AValue: string): Boolean; overload;
+ function AsString(const AFieldName: string; out AValue: string): Boolean; overload;
+ function AsString(const AFieldName: string; const AEncoding: TEncoding = nil): string; overload;
+
+ {$REGION 'Documentation'}
+ ///
+ /// Boundary特征字符串
+ ///
+ {$ENDREGION}
+ property Boundary: string read FBoundary write SetBoundary;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 上传文件保存的路径
+ ///
+ {$ENDREGION}
+ property StoragePath: string read FStoragePath write FStoragePath;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 按序号访问参数
+ ///
+ {$ENDREGION}
+ property Items[AIndex: Integer]: TFormField read GetItem;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 按名称访问参数
+ ///
+ {$ENDREGION}
+ property Fields[const AName: string]: TFormField read GetField;
+
+ {$REGION 'Documentation'}
+ ///
+ /// Items个数(只读)
+ ///
+ {$ENDREGION}
+ property Count: Integer read GetCount;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 所有Items数据的总尺寸(字节数)
+ ///
+ {$ENDREGION}
+ property DataSize: Integer read GetDataSize;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 对象释放时自动删除上传的文件
+ ///
+ {$ENDREGION}
+ property AutoDeleteFiles: Boolean read FAutoDeleteFiles write FAutoDeleteFiles;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 单个 Part Body 最大字节数, 0 表示不限制. 超过限制时 Decode 返回 frFailed.
+ ///
+ {$ENDREGION}
+ property MaxPartDataSize: Integer read FMaxPartDataSize write FMaxPartDataSize;
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// MultiPartFormData流
+ ///
+ ///
+ /// 动态从 MultiPartFormData 对象中读取数据, 而不是打包到内存中, 所以支持从磁盘加载超大文件
+ ///
+ {$ENDREGION}
+ THttpMultiPartFormStream = class(TStream)
+ private type
+ TFormFieldEx = record
+ Header: TBytes;
+ Field: TFormField;
+ Offset: Int64;
+
+ function HeaderSize: Integer;
+ function DataSize: Int64;
+ function TotalSize: Int64;
+ end;
+
+ TFormFieldExArray = TArray;
+ private
+ FMultiPartFormData: THttpMultiPartFormData;
+ FOwned: Boolean;
+ FFormFieldExArray: TFormFieldExArray;
+ FMultiPartEnd: TBytes;
+ FSize, FPosition, FEndPos: Int64;
+
+ procedure _Init;
+ function _GetFiledIndexByOffset(const AOffset: Int64): Integer;
+ public
+ constructor Create(const AMultiPartFormData: THttpMultiPartFormData;
+ const AOwned: Boolean = False); reintroduce;
+ destructor Destroy; override;
+
+ function Read(var ABuffer; ACount: Longint): Longint; override;
+ function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
+
+ property MultiPartFormData: THttpMultiPartFormData read FMultiPartFormData;
+ end;
+
+ TSessionsBase = class;
+ ISessions = interface;
+
+ ///
+ /// Session成员接口
+ ///
+ ISession = interface
+ ['{A3D525A1-C534-4CE6-969B-53C5B8CB77C3}']
+ function GetOwner: ISessions;
+
+ function GetSessionID: string;
+ function GetCreateTime: TDateTime;
+ function GetLastAccessTime: TDateTime;
+ function GetExpiryTime: Integer;
+ function GetValue(const AName: string): string;
+ procedure SetSessionID(const ASessionID: string);
+ procedure SetCreateTime(const ACreateTime: TDateTime);
+ procedure SetLastAccessTime(const ALastAccessTime: TDateTime);
+ procedure SetExpiryTime(const Value: Integer);
+ procedure SetValue(const AName, AValue: string);
+
+ ///
+ /// 更新最后访问时间
+ ///
+ procedure Touch;
+
+ ///
+ /// 是否已过期
+ ///
+ function Expired: Boolean;
+
+ ///
+ /// 父容器
+ ///
+ property Owner: ISessions read GetOwner;
+
+ ///
+ /// Session ID
+ ///
+ property SessionID: string read GetSessionID write SetSessionID;
+
+ ///
+ /// 创建时间
+ ///
+ property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
+
+ ///
+ /// 最后访问时间
+ ///
+ property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
+
+ ///
+ /// Session过期时间(秒)
+ ///
+ ///
+ ///
+ /// -
+ /// 值大于0时, 当Session超过设定值秒数没有使用就会被释放;
+ ///
+ /// -
+ /// 值等于0时, 使用父容器的超时设置
+ ///
+ /// -
+ /// 值小于0时, Session生成后一直有效
+ ///
+ ///
+ ///
+ property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
+
+ ///
+ /// Session是一个KEY-VALUE结构的数据, 该属性用于访问其中的成员值
+ ///
+ property Values[const AName: string]: string read GetValue write SetValue; default;
+ end;
+
+ TSessionBase = class abstract(TInterfacedObject, ISession)
+ private
+ FOwner: TSessionsBase;
+ protected
+ function GetOwner: ISessions;
+ function GetSessionID: string; virtual; abstract;
+ function GetCreateTime: TDateTime; virtual; abstract;
+ function GetLastAccessTime: TDateTime; virtual; abstract;
+ function GetExpiryTime: Integer; virtual; abstract;
+ function GetValue(const AName: string): string; virtual; abstract;
+ procedure SetSessionID(const ASessionID: string); virtual; abstract;
+ procedure SetCreateTime(const ACreateTime: TDateTime); virtual; abstract;
+ procedure SetLastAccessTime(const ALastAccessTime: TDateTime); virtual; abstract;
+ procedure SetExpiryTime(const Value: Integer); virtual; abstract;
+ procedure SetValue(const AName, AValue: string); virtual; abstract;
+ public
+ constructor Create(const AOwner: TSessionsBase; const ASessionID: string); virtual;
+
+ procedure Touch; virtual;
+ function Expired: Boolean; virtual;
+
+ property Owner: ISessions read GetOwner;
+
+ property SessionID: string read GetSessionID write SetSessionID;
+ property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
+ property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
+ property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
+ property Values[const AName: string]: string read GetValue write SetValue; default;
+ end;
+
+ TSession = class(TSessionBase)
+ protected
+ FSessionID: string;
+ FCreateTime: TDateTime;
+ FLastAccessTime: TDateTime;
+ FExpire: Integer;
+ FValues: TDictionary;
+
+ function GetSessionID: string; override;
+ function GetCreateTime: TDateTime; override;
+ function GetLastAccessTime: TDateTime; override;
+ function GetExpiryTime: Integer; override;
+ function GetValue(const AName: string): string; override;
+ procedure SetSessionID(const ASessionID: string); override;
+ procedure SetCreateTime(const ACreateTime: TDateTime); override;
+ procedure SetLastAccessTime(const ALastAccessTime: TDateTime); override;
+ procedure SetExpiryTime(const AValue: Integer); override;
+ procedure SetValue(const AName, AValue: string); override;
+ public
+ constructor Create(const AOwner: TSessionsBase; const ASessionID: string); override;
+ destructor Destroy; override;
+
+ property SessionID: string read GetSessionID write SetSessionID;
+ property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
+ property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
+ property Values[const AName: string]: string read GetValue write SetValue; default;
+ end;
+
+ TSessionClass = class of TSessionBase;
+
+ ///
+ /// Session管理接口
+ ///
+ ISessions = interface
+ ['{5187CA76-4CC4-4986-B67B-BC3E76D6CD74}']
+ function GetEnumerator: TEnumerator;
+
+ function GetSessionClass: TSessionClass;
+ function GetCount: Integer;
+ function GetItem(const AIndex: Integer): ISession;
+ function GetSession(const ASessionID: string): ISession;
+ function GetExpiryTime: Integer;
+ procedure SetSessionClass(const Value: TSessionClass);
+ procedure SetExpiryTime(const Value: Integer);
+
+ ///
+ /// 开始写(用于线程同步)
+ ///
+ procedure BeginWrite;
+
+ ///
+ /// 结束写(用于线程同步)
+ ///
+ procedure EndWrite;
+
+ ///
+ /// 开始读(用于线程同步)
+ ///
+ procedure BeginRead;
+
+ ///
+ /// 结束读(用于线程同步)
+ ///
+ procedure EndRead;
+
+ ///
+ /// 生成新Session ID
+ ///
+ function NewSessionID: string;
+
+ ///
+ /// 检查是否存在指定ID的Session
+ ///
+ ///
+ /// Session ID
+ ///
+ ///
+ /// 如果存在指定的Session， 则将实例保存到该参数中
+ ///
+ function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; overload;
+
+ ///
+ /// 检查是否存在指定ID的Session
+ ///
+ ///
+ /// Session ID
+ ///
+ function ExistsSession(const ASessionID: string): Boolean; overload;
+
+ ///
+ /// 新增Session
+ ///
+ ///
+ /// Session ID
+ ///
+ ///
+ /// Session实例
+ ///
+ function AddSession(const ASessionID: string): ISession; overload;
+
+ ///
+ /// 新增Session
+ ///
+ ///
+ /// Session实例
+ ///
+ function AddSession: ISession; overload;
+
+ ///
+ /// 新增Session
+ ///
+ ///
+ /// Session ID
+ ///
+ ///
+ /// Session实例
+ ///
+ procedure AddSession(const ASessionID: string; ASession: ISession); overload;
+
+ ///
+ /// 删除Session
+ ///
+ ///
+ /// Session对象
+ ///
+ procedure RemoveSession(const ASession: ISession); overload;
+
+ ///
+ /// 删除Session
+ ///
+ ///
+ /// Session ID
+ ///
+ procedure RemoveSession(const ASessionID: string); overload;
+
+ ///
+ /// 批量删除Session
+ ///
+ ///
+ /// Session对象数据
+ ///
+ procedure RemoveSessions(const ASessions: TArray);
+
+ ///
+ /// 清除所有Session
+ ///
+ procedure Clear;
+
+ ///
+ /// Session类
+ ///
+ property SessionClass: TSessionClass read GetSessionClass write SetSessionClass;
+
+ ///
+ /// Session个数
+ ///
+ property Count: Integer read GetCount;
+
+ ///
+ /// 获取指定序号的Session, 如果不存在则返回nil
+ ///
+ property Items[const AIndex: Integer]: ISession read GetItem;
+
+ ///
+ /// 获取指定ID的Session, 如果不存在则会新建一个
+ ///
+ ///
+ /// Session ID
+ ///
+ property Sessions[const ASessionID: string]: ISession read GetSession; default;
+
+ ///
+ /// Session过期时间(秒)
+ ///
+ ///
+ ///
+ /// -
+ /// 值大于0时, 当Session超过设定值秒数没有使用就会被释放;
+ ///
+ /// -
+ /// 值小于等于0时, Session生成后一直有效
+ ///
+ ///
+ ///
+ property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
+ end;
+
+ TSessionsBase = class abstract(TInterfacedObject, ISessions)
+ protected
+ function GetSessionClass: TSessionClass; virtual; abstract;
+ function GetCount: Integer; virtual; abstract;
+ function GetItem(const AIndex: Integer): ISession; virtual; abstract;
+ function GetSession(const ASessionID: string): ISession; virtual; abstract;
+ function GetExpiryTime: Integer; virtual; abstract;
+ procedure SetSessionClass(const Value: TSessionClass); virtual; abstract;
+ procedure SetExpiryTime(const Value: Integer); virtual; abstract;
+ public
+ function GetEnumerator: TEnumerator; virtual; abstract;
+
+ procedure BeginWrite; virtual; abstract;
+ procedure EndWrite; virtual; abstract;
+
+ procedure BeginRead; virtual; abstract;
+ procedure EndRead; virtual; abstract;
+
+ function NewSessionID: string; virtual; abstract;
+ function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; overload; virtual; abstract;
+ function ExistsSession(const ASessionID: string): Boolean; overload; virtual;
+ function AddSession(const ASessionID: string): ISession; overload; virtual;
+ function AddSession: ISession; overload;
+ procedure AddSession(const ASessionID: string; ASession: ISession); overload; virtual; abstract;
+
+ procedure RemoveSessions(const ASessions: TArray); virtual; abstract;
+ procedure RemoveSession(const ASession: ISession); overload; virtual;
+ procedure RemoveSession(const ASessionID: string); overload; virtual;
+
+ procedure Clear; virtual; abstract;
+
+ property SessionClass: TSessionClass read GetSessionClass write SetSessionClass;
+ property Count: Integer read GetCount;
+ property Items[const AIndex: Integer]: ISession read GetItem;
+ property Sessions[const ASessionID: string]: ISession read GetSession; default;
+ property ExpiryTime: Integer read GetExpiryTime write SetExpiryTime;
+ end;
+
+ TSessions = class(TSessionsBase)
+ private
+ FNewGUIDFunc: TFunc;
+ FLocker: IReadWriteLock;
+ FSessionClass: TSessionClass;
+ FExpire: Integer;
+ FShutdown, FExpiredProcRunning: Boolean;
+
+ procedure _ClearExpiredSessions;
+ protected
+ FSessions: TDictionary;
+
+ function GetSessionClass: TSessionClass; override;
+ function GetCount: Integer; override;
+ function GetItem(const AIndex: Integer): ISession; override;
+ function GetSession(const ASessionID: string): ISession; override;
+ function GetExpiryTime: Integer; override;
+ procedure SetSessionClass(const Value: TSessionClass); override;
+ procedure SetExpiryTime(const Value: Integer); override;
+
+ procedure BeforeClearExpiredSessions; virtual;
+ function OnCheckExpiredSession(const ASession: ISession): Boolean; virtual;
+ procedure AfterClearExpiredSessions; virtual;
+ procedure CreateExpiredProcThread;
+ public
+ constructor Create(ANewGUIDFunc: TFunc); overload; virtual;
+ constructor Create; overload; virtual;
+ destructor Destroy; override;
+
+ function GetEnumerator: TEnumerator; override;
+
+ procedure BeginWrite; override;
+ procedure EndWrite; override;
+
+ procedure BeginRead; override;
+ procedure EndRead; override;
+
+ function NewSessionID: string; override;
+ function ExistsSession(const ASessionID: string; var ASession: ISession): Boolean; override;
+ procedure AddSession(const ASessionID: string; ASession: ISession); override;
+
+ procedure RemoveSessions(const ASessions: TArray); override;
+
+ procedure Clear; override;
+
+ property NewGUIDFunc: TFunc read FNewGUIDFunc write FNewGUIDFunc;
+ end;
+
+implementation
+
+function _IsHttpToken(const AValue: string): Boolean;
+var
+ I: Integer;
+begin
+ if (AValue = '') then Exit(False);
+
+ for I := 1 to Length(AValue) do
+ begin
+ case AValue[I] of
+ 'A'..'Z', 'a'..'z', '0'..'9',
+ '!', '#', '$', '%', '&', '''', '*', '+', '-', '.', '^', '_', '`', '|', '~': ;
+ else
+ Exit(False);
+ end;
+ end;
+
+ Result := True;
+end;
+
+function _IsCookieOctets(const AValue: string): Boolean;
+var
+ I, LCode: Integer;
+begin
+ for I := 1 to Length(AValue) do
+ begin
+ LCode := Ord(AValue[I]);
+ case LCode of
+ $21, // '!'
+ $23..$2B, // '#' to '+'
+ $2D..$3A, // '-' to ':'
+ $3C..$5B, // '<' to '['
+ $5D..$7E: ; // ']' to '~'
+ else
+ Exit(False);
+ end;
+ end;
+
+ Result := True;
+end;
+
+function _IsCookieAvValue(const AValue: string): Boolean;
+var
+ I, LCode: Integer;
+begin
+ for I := 1 to Length(AValue) do
+ begin
+ LCode := Ord(AValue[I]);
+ if (LCode < $20) or (LCode >= $7F) or (AValue[I] = ';') then
+ Exit(False);
+ end;
+
+ Result := True;
+end;
+
+function _TryNormalizeCookieValue(const AValue: string; out ANormalizedValue: string): Boolean;
+begin
+ ANormalizedValue := AValue;
+ if (Length(ANormalizedValue) >= 2) then
+ if (ANormalizedValue[1] = '"')
+ and (ANormalizedValue[High(ANormalizedValue)] = '"') then
+ ANormalizedValue := Copy(ANormalizedValue, 2, Length(ANormalizedValue) - 2);
+
+ Result := _IsCookieOctets(ANormalizedValue);
+end;
+
+function _NormalizeCookieDomain(const AValue: string): string;
+begin
+ if not _IsCookieAvValue(AValue) then Exit('');
+
+ Result := AValue.Trim.ToLower;
+ if (Result <> '') then
+ if (Result[1] = '.') then
+ Delete(Result, 1, 1);
+end;
+
+function _TryParseCookieMaxAge(const AValue: string; out AMaxAge: Integer): Boolean;
+var
+ I: Integer;
+begin
+ AMaxAge := 0;
+ Result := False;
+ if (AValue = '') then Exit;
+
+ if (AValue[1] = '-') then
+ begin
+ if (Length(AValue) = 1) then Exit;
+ for I := 2 to Length(AValue) do
+ if not CharInSet(AValue[I], ['0'..'9']) then Exit;
+ end else
+ begin
+ for I := 1 to Length(AValue) do
+ if not CharInSet(AValue[I], ['0'..'9']) then Exit;
+ end;
+
+ Result := TryStrToInt(AValue, AMaxAge);
+end;
+
+{ TNameValue }
+
+constructor TNameValue.Create(const AName,
+ AValue: string);
+begin
+ Name := AName;
+ Value := AValue;
+end;
+
+{ TBaseParams.TEnumerator }
+
+constructor TBaseParams.TEnumerator.Create(const AParams: TBaseParams);
+begin
+ FParams := AParams;
+ FIndex := -1;
+end;
+
+function TBaseParams.TEnumerator.GetCurrent: TNameValue;
+begin
+ Result := FParams.Items[FIndex];
+end;
+
+function TBaseParams.TEnumerator.MoveNext: Boolean;
+begin
+ Inc(FIndex);
+ Result := (FIndex < FParams.Count);
+end;
+
+{ TBaseParams }
+
+constructor TBaseParams.Create;
+begin
+ FParams := TList.Create(TComparer.Construct(
+ function(const Left, Right: TNameValue): Integer
+ begin
+ Result := CompareText(Left.Name, Right.Name, TLocaleOptions.loUserLocale);
+ end));
+end;
+
+constructor TBaseParams.Create(const AEncodedParams: string);
+begin
+ Create;
+ Decode(AEncodedParams, True);
+end;
+
+destructor TBaseParams.Destroy;
+begin
+ FreeAndNil(FParams);
+ inherited;
+end;
+
+procedure TBaseParams.Add(const AName, AValue: string; ADupAllowed: Boolean);
+begin
+ if ADupAllowed then
+ FParams.Add(TNameValue.Create(AName, AValue))
+ else
+ SetParam(AName, AValue);
+end;
+
+procedure TBaseParams.Add(const AEncodedParams: string);
+begin
+ Decode(AEncodedParams, False);
+end;
+
+procedure TBaseParams.Assign(const ASource: TBaseParams);
+var
+ LParamItem: TNameValue;
+begin
+ Clear;
+
+ if (ASource = nil) or (ASource.Count <= 0) then Exit;
+
+ for LParamItem in ASource do
+ Add(LParamItem);
+end;
+
+procedure TBaseParams.Add(const AParamValue: TNameValue);
+begin
+ FParams.Add(AParamValue);
+end;
+
+procedure TBaseParams.Clear;
+begin
+ FParams.Clear;
+end;
+
+function TBaseParams.GetParamIndex(const AName: string): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FParams.Count - 1 do
+ if TStrUtils.SameText(FParams[I].Name, AName) then Exit(I);
+ Result := -1;
+end;
+
+function TBaseParams.GetParamValue(const AName: string;
+ out AValue: string): Boolean;
+var
+ I: Integer;
+begin
+ I := GetParamIndex(AName);
+ if (I >= 0) then
+ begin
+ AValue := FParams[I].Value;
+ Exit(True);
+ end;
+
+ AValue := '';
+ Result := False;
+end;
+
+function TBaseParams.GetHeaderValues(const AName: string;
+ out AValues: TArray): Boolean;
+var
+ I, LCount: Integer;
+begin
+ SetLength(AValues, FParams.Count);
+ LCount := 0;
+ Result := False;
+ for I := 0 to FParams.Count - 1 do
+ begin
+ if not TStrUtils.SameText(FParams[I].Name, AName) then Continue;
+ AValues[LCount] := FParams[I].Value;
+ Inc(LCount);
+ Result := True;
+ end;
+ SetLength(AValues, LCount);
+end;
+
+procedure TBaseParams.Remove(const AName: string);
+var
+ I: Integer;
+begin
+ I := GetParamIndex(AName);
+ if (I >= 0) then
+ FParams.Delete(I);
+end;
+
+procedure TBaseParams.Remove(AIndex: Integer);
+begin
+ FParams.Delete(AIndex);
+end;
+
+function TBaseParams.GetCount: Integer;
+begin
+ Result := FParams.Count;
+end;
+
+function TBaseParams.GetEnumerator: TEnumerator;
+begin
+ Result := TEnumerator.Create(Self);
+end;
+
+function TBaseParams.GetItem(AIndex: Integer): TNameValue;
+begin
+ Result := FParams.Items[AIndex];
+end;
+
+function TBaseParams.ExistsParam(const AName: string): Boolean;
+begin
+ Result := (GetParamIndex(AName) >= 0);
+end;
+
+function TBaseParams.GetParam(const AName: string): string;
+var
+ I: Integer;
+begin
+ I := GetParamIndex(AName);
+ if (I >= 0) then
+ Exit(FParams[I].Value);
+ Result := '';
+end;
+
+procedure TBaseParams.SetItem(AIndex: Integer; const AValue: TNameValue);
+begin
+ FParams[AIndex] := AValue;
+end;
+
+procedure TBaseParams.SetParam(const AName, AValue: string);
+var
+ I: Integer;
+ LItem: TNameValue;
+begin
+ I := GetParamIndex(AName);
+ if (I >= 0) then
+ begin
+ LItem := FParams[I];
+ LItem.Value := AValue;
+ FParams[I] := LItem;
+ end else
+ FParams.Add(TNameValue.Create(AName, AValue));
+end;
+
+procedure TBaseParams.Sort(const AComparison: TNameValueComparison);
+var
+ LComparer: INameValueComparer;
+begin
+ if Assigned(AComparison) then
+ LComparer := TNameValueComparer.Create(AComparison)
+ else
+ LComparer := TNameValueComparer.Create(
+ function(const Left, Right: TNameValue): Integer
+ begin
+ Result := CompareStr(Left.Name, Right.Name, TLocaleOptions.loInvariantLocale);
+ end);
+
+ FParams.Sort(LComparer);
+end;
+
+{ THttpUrlParams }
+
+constructor THttpUrlParams.Create;
+begin
+ inherited Create;
+
+ // RFC 3986 / WHATWG application/x-www-form-urlencoded:
+ // key 与 value 内含的 reserved/非 unreserved 字符都必须 percent-encode,
+ // 否则 key 中的 '&'/'='/'#' 等会被服务端误解析 (参数注入风险).
+ // 与 Go url.Values.Encode / Python urlencode / Java URLEncoder 等主流库默认行为一致.
+ FEncodeName := True;
+ FEncodeValue := True;
+end;
+
+function THttpUrlParams.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
+var
+ p, pEnd, q: PChar;
+ LName, LValue: string;
+ LSize, LDecodedCount: Integer;
+begin
+ if AClear then
+ FParams.Clear;
+
+ LDecodedCount := 0;
+ p := PChar(AEncodedParams);
+ pEnd := p + Length(AEncodedParams);
+ while (p < pEnd) do
+ begin
+ // WHATWG application/x-www-form-urlencoded parser: 按 '&' 拆分并忽略空片段.
+ while (p < pEnd) and (p^ = '&') do
+ Inc(p);
+ if (p >= pEnd) then Break;
+
+ q := p;
+ LSize := 0;
+ while (p < pEnd) and (p^ <> '=') and (p^ <> '&') do
+ begin
+ Inc(LSize);
+ Inc(p);
+ end;
+ SetString(LName, q, LSize);
+ LName := TCrossHttpUtils.UrlDecode(LName);
+
+ if (p < pEnd) and (p^ = '=') then
+ begin
+ Inc(p);
+
+ q := p;
+ LSize := 0;
+ while (p < pEnd) and (p^ <> '&') do
+ begin
+ Inc(LSize);
+ Inc(p);
+ end;
+ SetString(LValue, q, LSize);
+ LValue := TCrossHttpUtils.UrlDecode(LValue);
+ end else
+ begin
+ LValue := '';
+ end;
+
+ Add(LName, LValue, True);
+ Inc(LDecodedCount);
+ end;
+
+ Result := (LDecodedCount > 0);
+end;
+
+function THttpUrlParams.Encode: string;
+var
+ I: Integer;
+ LName, LValue: string;
+begin
+ Result := '';
+ for I := 0 to FParams.Count - 1 do
+ begin
+ if (I > 0) then
+ Result := Result + '&';
+
+ if FEncodeName then
+ LName := TCrossHttpUtils.UrlEncode(FParams[I].Name)
+ else
+ LName := FParams[I].Name;
+ Result := Result + LName;
+
+ if FEncodeValue then
+ LValue := TCrossHttpUtils.UrlEncode(FParams[I].Value)
+ else
+ LValue := FParams[I].Value;
+ if (LValue <> '') then
+ Result := Result + '=' + LValue;
+ end;
+end;
+
+{ THttpHeader }
+
+function THttpHeader.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
+const
+ CR = #13;
+ LF = #10;
+var
+ P, PEnd, LLineStart, LColonPos, LValueStart, LValueEnd: PChar;
+ LCh: Char;
+ LName, LValue: string;
+ LLineValid, LInName: Boolean;
+ LDecodedCount: Integer;
+begin
+ if AClear then
+ FParams.Clear;
+
+ LDecodedCount := 0;
+ P := PChar(AEncodedParams);
+ PEnd := P + Length(AEncodedParams);
+
+ // 单趟状态机解析 (RFC 7230 §3): 每行字符仅访问 1 次, 同时完成
+ // 1) CRLF 边界检测: bare-CR / bare-LF 立即拒绝 (Exit(False)),
+ // 防御 \r\r\n\n 等走私序列及上下游切分不一致
+ // 2) ':' 定位 (切 name / value)
+ // 3) value 前后 OWS 跳过 + 尾随 OWS 自动 trim
+ // 4) name 每字节 token 校验 + value 每字节 CTL 校验
+ // 非法行整行跳过 (仅限 name/value 校验失败, 不含 bare-CR/LF),
+ // 与 THttpHeader.Encode 过滤策略对称, 作为深度防御.
+ while (P < PEnd) do
+ begin
+ LLineStart := P;
+ LColonPos := nil;
+ LValueStart := nil;
+ LValueEnd := nil;
+ LLineValid := True;
+ LInName := True;
+
+ // 内层: 逐字节扫描本行, 直到 CRLF 或 PEnd
+ while (P < PEnd) do
+ begin
+ LCh := P^;
+
+ if (LCh = CR) then
+ begin
+ if (P + 1 < PEnd) and ((P + 1)^ = LF) then
+ Break; // 完整 CRLF: 退出内层, P 仍指向 CR
+ // bare-CR: 立即拒绝, 防御 \r\r\n\n 等走私序列
+ if AClear then FParams.Clear;
+ Exit(False);
+ end;
+
+ if (LCh = LF) then
+ begin
+ // bare-LF: 立即拒绝
+ if AClear then FParams.Clear;
+ Exit(False);
+ end;
+
+ if LInName then
+ begin
+ if (LCh = ':') then
+ begin
+ LColonPos := P;
+ LInName := False;
+ end else
+ if not TCrossHttpUtils.IsTokenChar(LCh) then
+ // name 段非 token 字符 (含 OWS / CTL / 非 ASCII 等) → 非法
+ LLineValid := False;
+ end else
+ begin
+ // value 段: 前导 OWS 跳过, 记录首/末非 OWS 位置, 同时校验 CTL
+ if (LCh <> ' ') and (LCh <> #9) then
+ begin
+ if (LValueStart = nil) then
+ LValueStart := P;
+ LValueEnd := P + 1; // exclusive: 最后非 OWS 字符之后位置
+ if not TCrossHttpUtils.IsHeaderValueChar(LCh) then
+ LLineValid := False;
+ end;
+ end;
+
+ Inc(P);
+ end;
+
+ // 退出内层: P 指向 CR (CRLF 完整) 或 P >= PEnd (末尾无 CRLF).
+ // 末尾无 CRLF 的残行也按相同规则尝试入库, 兼容 multipart part header
+ // 等调用方剥掉块终止符 \r\n\r\n 后再喂入的字符串. 主路径 HTTP
+ // request/response header 末尾必带空行 \r\n, 始终走 CRLF 完整分支,
+ // 严格性不变.
+ if (P < PEnd) then
+ Inc(P, 2); // 跳过 CRLF; PEnd 路径 P 已等于 PEnd, 外层 while 自然退出
+
+ if not LLineValid then Continue;
+
+ // 空行: header 块结束标记, 跳过.
+ // CRLF 完整路径: LLineStart 指向被消费 CRLF 的位置 (即 P - 2)
+ // PEnd 路径 : LLineStart 等于 P (本行 0 字节)
+ if (LLineStart = P) or (LLineStart = P - 2) then Continue;
+
+ // 必须出现过 ':'
+ if (LColonPos = nil) then Continue;
+
+ // name 不能为空
+ if (LColonPos = LLineStart) then Continue;
+
+ SetString(LName, LLineStart, LColonPos - LLineStart);
+
+ if (LValueStart = nil) then
+ LValue := ''
+ else
+ SetString(LValue, LValueStart, LValueEnd - LValueStart);
+
+ Add(LName, LValue, True);
+ Inc(LDecodedCount);
+ end;
+
+ Result := (LDecodedCount > 0);
+end;
+
+function THttpHeader.Encode: string;
+var
+ I: Integer;
+ LName, LValue: string;
+begin
+ // 防御 HTTP 响应拆分 (Response Splitting):
+ // Header name 必须是 RFC 7230 token, value 不允许 CR/LF/CTL.
+ // 非法 entry 直接跳过 (业务方应在写入前自行 sanitize), 避免拼到 wire 上注入伪造响应.
+ Result := '';
+ for I := 0 to FParams.Count - 1 do
+ begin
+ LName := FParams[I].Name;
+ LValue := FParams[I].Value;
+
+ if not TCrossHttpUtils.IsValidHeaderName(LName) then Continue;
+ if not TCrossHttpUtils.IsValidHeaderValue(LValue) then Continue;
+
+ Result := Result + LName + ': ' + LValue + #13#10;
+ end;
+ Result := Result + #13#10;
+end;
+
+{ TDelimitParams }
+
+constructor TDelimitParams.Create(const ADelimiter: Char; const AUrlEncode: Boolean);
+begin
+ FDelimiter := ADelimiter;
+ FUrlEncode := AUrlEncode;
+
+ inherited Create;
+end;
+
+constructor TDelimitParams.Create(const AEncodedParams: string;
+ const ADelimiter: Char; const AUrlEncode: Boolean);
+begin
+ FDelimiter := ADelimiter;
+ FUrlEncode := AUrlEncode;
+
+ inherited Create(AEncodedParams);
+end;
+
+function TDelimitParams.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
+var
+ p, pEnd, q: PChar;
+ LName, LValue: string;
+ LSize, LDecodedCount: Integer;
+begin
+ if AClear then
+ FParams.Clear;
+
+ LDecodedCount := 0;
+ p := PChar(AEncodedParams);
+ pEnd := p + Length(AEncodedParams);
+ while (p < pEnd) do
+ begin
+ q := p;
+ LSize := 0;
+ while (p < pEnd) and (p^ <> '=') do
+ begin
+ Inc(LSize);
+ Inc(p);
+ end;
+ SetString(LName, q, LSize);
+ // 跳过多余的'='
+ while (p < pEnd) and (p^ = '=') do
+ Inc(p);
+
+ q := p;
+ LSize := 0;
+ while (p < pEnd) and (p^ <> FDelimiter) do
+ begin
+ Inc(LSize);
+ Inc(p);
+ end;
+ SetString(LValue, q, LSize);
+ if FUrlEncode then
+ LValue := TCrossHttpUtils.UrlDecode(LValue);
+ // 跳过多余的';'
+ while (p < pEnd) and ((p^ = FDelimiter) or (p^ = ' ')) do
+ Inc(p);
+
+ Add(LName, LValue);
+ Inc(LDecodedCount);
+ end;
+
+ Result := (LDecodedCount > 0);
+end;
+
+function TDelimitParams.Encode: string;
+var
+ I: Integer;
+ LValue: string;
+begin
+ Result := '';
+ for I := 0 to FParams.Count - 1 do
+ begin
+ if (I > 0) then
+ Result := Result + FDelimiter + ' ';
+ LValue := FParams[I].Value;
+ if FUrlEncode then
+ LValue := TCrossHttpUtils.UrlEncode(LValue);
+ Result := Result + FParams[I].Name + '=' + LValue;
+ end;
+end;
+
+{ TRequestCookies }
+
+function TRequestCookies.Decode(const AEncodedParams: string; AClear: Boolean): Boolean;
+var
+ LParsedParams: TList;
+ LItem: TNameValue;
+ LPos, LLen, LPairEnd, LEqualsPos, LDecodedCount: Integer;
+ LPair: string;
+ LName, LValue: string;
+ LNormalizedValue: string;
+begin
+ LDecodedCount := 0;
+ Result := False;
+ // 先解析到临时列表，确保整行 Cookie 全部合法后再提交，避免失败时留下半解析数据。
+ LParsedParams := TList.Create;
+ try
+ LLen := Length(AEncodedParams);
+ LPos := 1;
+ while (LPos <= LLen) do
+ begin
+ // 跳过空白字符(空格和制表符)
+ while (LPos <= LLen) and CharInSet(AEncodedParams[LPos], [' ', #9]) do
+ Inc(LPos);
+ if (LPos > LLen) then Break;
+
+ LPairEnd := LPos;
+ // 查找分号分隔符, 确定当前 cookie-pair 的结束位置
+ while (LPairEnd <= LLen) and (AEncodedParams[LPairEnd] <> ';') do
+ Inc(LPairEnd);
+
+ // 提取当前 cookie-pair 字符串
+ LPair := Copy(AEncodedParams, LPos, LPairEnd - LPos);
+ // 查找等号位置, 用于分割 name 和 value
+ LEqualsPos := Pos('=', LPair);
+ // 如果没有等号或等号在第一个位置(name 为空), 则认为格式非法
+ if (LEqualsPos <= 1) then
+ begin
+ if AClear then FParams.Clear;
+ Exit;
+ end;
+
+ // 提取 name 部分（等号之前的内容）
+ LName := Copy(LPair, 1, LEqualsPos - 1);
+ // 提取 value 部分（等号之后的所有内容）
+ LValue := Copy(LPair, LEqualsPos + 1, MaxInt);
+ // 校验 name 是否为合法的 HTTP token, 以及 value 是否为合法的 cookie 值
+ if not _IsHttpToken(LName)
+ or not _TryNormalizeCookieValue(LValue, LNormalizedValue) then
+ begin
+ if AClear then FParams.Clear;
+ Exit;
+ end;
+
+ LParsedParams.Add(TNameValue.Create(LName, LNormalizedValue));
+ LPos := LPairEnd + 1;
+ Inc(LDecodedCount);
+ end;
+
+ // 所有 cookie-pair 均校验通过后，才按 AClear 语义提交到 FParams。
+ if AClear then
+ FParams.Clear;
+ for LItem in LParsedParams do
+ Add(LItem.Name, LItem.Value);
+ Result := (LDecodedCount > 0);
+ finally
+ FreeAndNil(LParsedParams);
+ end;
+end;
+
+function TRequestCookies.Encode: string;
+var
+ I: Integer;
+ LName, LValue: string;
+begin
+ Result := '';
+ for I := 0 to FParams.Count - 1 do
+ begin
+ if (I > 0) then
+ Result := Result + '; ';
+ LName := FParams[I].Name;
+ LValue := FParams[I].Value;
+ if not _IsHttpToken(LName) then
+ raise Exception.CreateFmt('Invalid cookie name: %s', [LName]);
+ if not _IsCookieOctets(LValue) then
+ raise Exception.CreateFmt('Invalid cookie value: %s', [LName]);
+ Result := Result + LName + '=' + LValue;
+ end;
+end;
+
+{ TResponseCookie }
+
+constructor TResponseCookie.Create(const AName, AValue: string;
+ AMaxAge: Integer; const APath, ADomain: string; AHttpOnly, ASecure: Boolean);
+begin
+ Self.Name := AName;
+ Self.Value := AValue;
+ Self.MaxAge := AMaxAge;
+ Self.Path := APath;
+ Self.Domain := _NormalizeCookieDomain(ADomain);
+ Self.HttpOnly := AHttpOnly;
+ Self.Secure := ASecure;
+end;
+
+constructor TResponseCookie.Create(const ACookieData, ADomain: string);
+
+ procedure SetExpires(const AValue: string);
+ var
+ LMaxAge: Integer;
+ begin
+ if (Self.MaxAge = 0) then
+ begin
+ LMaxAge := TCrossHttpUtils.RFC1123_StrToDate(AValue).SecondsDiffer(Now);
+ if (LMaxAge > 0) then
+ Self.MaxAge := LMaxAge;
+ end;
+ end;
+
+ procedure SetMaxAge(const AValue: string);
+ var
+ LMaxAge: Integer;
+ begin
+ if _TryParseCookieMaxAge(AValue, LMaxAge) then
+ Self.MaxAge := LMaxAge;
+ end;
+
+ procedure SetPath(const AValue: string);
+ begin
+ if (AValue <> '') and (AValue[1] = '/') and _IsCookieAvValue(AValue) then
+ Self.Path := AValue;
+ end;
+
+ procedure SetDomain(const AValue: string);
+ var
+ LDomain: string;
+ begin
+ LDomain := _NormalizeCookieDomain(AValue);
+ if (LDomain <> '') then
+ Self.Domain := LDomain;
+ end;
+
+var
+ LValues: TArray;
+ I: Integer;
+ LPos: Integer;
+ LName: string;
+ LValue: string;
+begin
+ Self.Name := '';
+ Self.Value := '';
+ Self.MaxAge := 0;
+ Self.Path := '/';
+ Self.Domain := _NormalizeCookieDomain(ADomain);
+ Self.HttpOnly := False;
+ Self.Secure := False;
+
+ LValues := ACookieData.Split([Char(';')], Char('"'));
+ if Length(LValues) = 0 then Exit;
+
+ LPos := LValues[0].IndexOf(Char('='));
+ if (LPos <= 0) then Exit;
+
+ Self.Name := LValues[0].Substring(0, LPos).Trim;
+ if not _IsHttpToken(Self.Name)
+ or not _TryNormalizeCookieValue(LValues[0].Substring(LPos + 1).Trim, Self.Value) then
+ begin
+ Self.Name := '';
+ Self.Value := '';
+ Exit;
+ end;
+
+ for I := 1 to High(LValues) do
+ begin
+ LPos := LValues[I].IndexOf(Char('='));
+ if LPos > 0 then
+ begin
+ LName := LValues[I].Substring(0, LPos).Trim;
+ LValue := LValues[I].Substring(LPos + 1).Trim;
+ if (LValue.Length > 1) and (LValue.Chars[0] = '"') and (LValue[High(LValue)] = '"') then
+ LValue := LValue.Substring(1, LValue.Length - 2);
+ end
+ else
+ begin
+ LName := LValues[I].Trim;
+ LValue := '';
+ end;
+
+ if TStrUtils.SameText(LName, 'Max-Age') then
+ SetMaxAge(LValue)
+ else if TStrUtils.SameText(LName, 'Expires') then
+ SetExpires(LValue)
+ else if TStrUtils.SameText(LName, 'Path') then
+ SetPath(LValue)
+ else if TStrUtils.SameText(LName, 'Domain') then
+ SetDomain(LValue)
+ else if TStrUtils.SameText(LName, 'HttpOnly') then
+ Self.HttpOnly := True
+ else if TStrUtils.SameText(LName, 'Secure') then
+ Self.Secure := True;
+ end;
+end;
+
+function TResponseCookie.Encode: string;
+begin
+ if not _IsHttpToken(Self.Name) then
+ raise Exception.CreateFmt('Invalid cookie name: %s', [Self.Name]);
+ if not _IsCookieOctets(Self.Value) then
+ raise Exception.CreateFmt('Invalid cookie value: %s', [Self.Value]);
+ if not _IsCookieAvValue(Self.Path) then
+ raise Exception.CreateFmt('Invalid cookie path: %s', [Self.Name]);
+ if (Self.Path <> '') and (Self.Path[1] <> '/') then
+ raise Exception.CreateFmt('Invalid cookie path: %s', [Self.Name]);
+ if not _IsCookieAvValue(Self.Domain) then
+ raise Exception.CreateFmt('Invalid cookie domain: %s', [Self.Name]);
+
+ Result := Self.Name + '=' + Self.Value;
+
+ if (Self.MaxAge > 0) then
+ Result := Result + '; Max-Age=' + Self.MaxAge.ToString;
+ if (Self.Path <> '') then
+ Result := Result + '; Path=' + Self.Path;
+ if (Self.Domain <> '') then
+ Result := Result + '; Domain=' + Self.Domain;
+ if Self.HttpOnly then
+ Result := Result + '; HttpOnly';
+ if Self.Secure then
+ Result := Result + '; Secure';
+end;
+
+{ TFormField }
+
+constructor TFormField.Create;
+begin
+ FValueOwned := True;
+end;
+
+destructor TFormField.Destroy;
+begin
+ FreeValue;
+
+ inherited;
+end;
+
+procedure TFormField.FreeValue;
+begin
+ if FValueOwned and Assigned(FValue) then
+ FreeAndNil(FValue);
+end;
+
+function TFormField.AsBytes: TBytes;
+var
+ LBufSize: Integer;
+begin
+ if (FValue = nil) or (FValue.Size <= 0) then Exit(nil);
+
+ if (FValue is TBytesStream) then
+ begin
+ Result := TBytesStream(FValue).Bytes;
+ SetLength(Result, FValue.Size);
+ end else
+ begin
+ FValue.Position := 0;
+ LBufSize := FValue.Size;
+ SetLength(Result, LBufSize);
+ FValue.ReadBuffer(Result, LBufSize);
+ end;
+end;
+
+procedure TFormField.Assign(const ASource: TFormField);
+begin
+ FreeValue;
+
+ if (ASource = nil) then Exit;
+
+ FName := ASource.FName;
+ FValueOwned := ASource.FValueOwned;
+ FIsTempFile := ASource.FIsTempFile;
+ FFileName := ASource.FFileName;
+ FFilePath := ASource.FFilePath;
+ FContentType := ASource.FContentType;
+ FContentTransferEncoding := ASource.FContentTransferEncoding;
+
+ if ASource.FValueOwned then
+ begin
+ if (FFilePath <> '') then
+ FValue := TFileUtils.OpenRead(FFilePath, fmShareDenyNone)
+ else
+ begin
+ FValue := TBytesStream.Create;
+ FValue.CopyFrom(ASource.FValue, 0);
+ end;
+ end else
+ begin
+ FValue := ASource.FValue;
+ end;
+end;
+
+function TFormField.AsString(AEncoding: TEncoding): string;
+begin
+ Result := TUtils.GetString(FValue, AEncoding);
+end;
+
+{ THttpMultiPartFormData.TEnumerator }
+
+constructor THttpMultiPartFormData.TEnumerator.Create(
+ const AList: TList);
+begin
+ inherited Create;
+ FList := AList;
+ FIndex := -1;
+end;
+
+function THttpMultiPartFormData.TEnumerator.GetCurrent: TFormField;
+begin
+ Result := FList[FIndex];
+end;
+
+function THttpMultiPartFormData.TEnumerator.MoveNext: Boolean;
+begin
+ Inc(FIndex);
+ Result := (FIndex < FList.Count);
+end;
+
+{ THttpMultiPartFormData }
+
+constructor THttpMultiPartFormData.Create;
+begin
+ FDecodeState := dsBoundary;
+ SetLength(FCurrentPartHeader, MAX_PART_HEADER);
+ FCurrentPartHeaderLen := 0;
+ FPartFields := TObjectList.Create(True);
+ FAutoDeleteFiles := True;
+ FMaxPartDataSize := 0;
+ FCurrentPartDataSize := 0;
+end;
+
+function THttpMultiPartFormData.Decode(
+ const AStream: TStream): TFormDataDecodeResult;
+const
+ BUF_SIZE = 1024 * 32;
+var
+ LBuffer: array [0..BUF_SIZE - 1] of Byte;
+ N: Integer;
+begin
+ while True do
+ begin
+ N := AStream.Read(LBuffer[0], BUF_SIZE);
+ Result := Decode(@LBuffer[0], N);
+
+ if (Result in [frComplete, frFailed])
+ or (N < BUF_SIZE) then Exit;
+ end;
+end;
+
+destructor THttpMultiPartFormData.Destroy;
+begin
+ Clear;
+ FCurrentPartHeader := nil;
+ FCurrentPartField := nil;
+ FreeAndNil(FPartFields);
+ inherited;
+end;
+
+function THttpMultiPartFormData.AddField(const AField: TFormField): TFormField;
+begin
+ FPartFields.Add(AField);
+ Result := AField;
+end;
+
+function THttpMultiPartFormData.AddField(const AFieldName: string;
+ const AValue: TBytes): TFormField;
+begin
+ Result := TFormField.Create;
+ Result.FName := AFieldName;
+ Result.FValueOwned := True;
+ Result.FValue := TBytesStream.Create(AValue);
+ Result.FContentType := TMediaType.APPLICATION_OCTET_STREAM;
+
+ FPartFields.Add(Result);
+end;
+
+function THttpMultiPartFormData.AddField(const AFieldName, AValue: string): TFormField;
+begin
+ Result := TFormField.Create;
+ Result.FName := AFieldName;
+ Result.FValueOwned := True;
+ Result.FValue := TBytesStream.Create(TEncoding.UTF8.GetBytes(AValue));
+
+ FPartFields.Add(Result);
+end;
+
+function THttpMultiPartFormData.AddFile(const AFieldName, AFileName: string;
+ const AStream: TStream; const AOwned: Boolean): TFormField;
+begin
+ Result := TFormField.Create;
+ Result.FName := AFieldName;
+ Result.FFileName := AFileName;
+ Result.FValueOwned := AOwned;
+ Result.FValue := AStream;
+ Result.FContentType := TCrossHttpUtils.GetFileMIMEType(AFileName);
+
+ FPartFields.Add(Result);
+end;
+
+function THttpMultiPartFormData.AddFile(const AFieldName, AFileName: string): TFormField;
+begin
+ Result := AddFile(AFieldName,
+ ExtractFileName(AFileName),
+ TFileUtils.OpenRead(AFileName, fmShareDenyNone),
+ True);
+ Result.FFilePath := AFileName;
+end;
+
+procedure THttpMultiPartFormData.Assign(const ASource: THttpMultiPartFormData);
+var
+ LSrcField, LNewField: TFormField;
+begin
+ Clear;
+
+ Boundary := ASource.Boundary;
+
+ for LSrcField in ASource do
+ begin
+ LNewField := TFormField.Create;
+ LNewField.Assign(LSrcField);
+
+ AddField(LNewField);
+ end;
+end;
+
+function THttpMultiPartFormData.AsBytes(const AFieldName: string;
+ out AValue: TBytes): Boolean;
+var
+ LField: TFormField;
+begin
+ Result := FindField(AFieldName, LField);
+ if Result then
+ AValue := LField.AsBytes
+ else
+ AValue := nil;
+end;
+
+function THttpMultiPartFormData.AsBytes(const AFieldName: string): TBytes;
+begin
+ AsBytes(AFieldName, Result);
+end;
+
+function THttpMultiPartFormData.AsStream(const AFieldName: string;
+ out AValue: TStream): Boolean;
+var
+ LField: TFormField;
+begin
+ Result := FindField(AFieldName, LField);
+ if Result then
+ begin
+ AValue := LField.Value;
+ if (AValue.Size > 0) then
+ AValue.Position := 0;
+ end else
+ AValue := nil;
+end;
+
+function THttpMultiPartFormData.AsStream(const AFieldName: string): TStream;
+begin
+ AsStream(AFieldName, Result);
+end;
+
+function THttpMultiPartFormData.AsString(const AFieldName: string;
+ const AEncoding: TEncoding; out AValue: string): Boolean;
+var
+ LField: TFormField;
+begin
+ Result := FindField(AFieldName, LField);
+ if Result then
+ AValue := LField.AsString(AEncoding)
+ else
+ AValue := '';
+end;
+
+function THttpMultiPartFormData.AsString(const AFieldName: string;
+ out AValue: string): Boolean;
+begin
+ Result := AsString(AFieldName, nil, AValue);
+end;
+
+function THttpMultiPartFormData.AsString(const AFieldName: string;
+ const AEncoding: TEncoding): string;
+begin
+ AsString(AFieldName, AEncoding, Result);
+end;
+
+procedure THttpMultiPartFormData.Clear;
+var
+ LField: TFormField;
+begin
+ for LField in FPartFields do
+ begin
+ if FAutoDeleteFiles and (LField.FilePath <> '')
+ and FileExists(LField.FilePath) then
+ begin
+ LField.FreeValue;
+
+ if LField.FIsTempFile then
+ DeleteFile(LField.FilePath);
+ end;
+ end;
+
+ FPartFields.Clear;
+end;
+
+function THttpMultiPartFormData.FindField(const AFieldName: string;
+ out AField: TFormField): Boolean;
+var
+ I: Integer;
+begin
+ I := GetItemIndex(AFieldName);
+ if (I >= 0) then
+ begin
+ AField := FPartFields[I];
+ Exit(True);
+ end;
+
+ AField := nil;
+ Result := False;
+end;
+
+function THttpMultiPartFormData.GetItem(AIndex: Integer): TFormField;
+begin
+ Result := FPartFields.Items[AIndex];
+end;
+
+function THttpMultiPartFormData.GetItemIndex(const AName: string): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FPartFields.Count - 1 do
+ if TStrUtils.SameText(FPartFields[I].Name, AName) then Exit(I);
+ Result := -1;
+end;
+
+function THttpMultiPartFormData.GetCount: Integer;
+begin
+ Result := FPartFields.Count;
+end;
+
+function THttpMultiPartFormData.GetDataSize: Integer;
+var
+ LPartField: TFormField;
+begin
+ Result := 0;
+ for LPartField in FPartFields do
+ Inc(Result, LPartField.FValue.Size);
+end;
+
+function THttpMultiPartFormData.GetEnumerator: TEnumerator;
+begin
+ Result := TEnumerator.Create(FPartFields);
+end;
+
+function THttpMultiPartFormData.GetField(const AName: string): TFormField;
+var
+ I: Integer;
+begin
+ I := GetItemIndex(AName);
+ if (I >= 0) then
+ Exit(FPartFields[I]);
+ Result := nil;
+end;
+
+procedure THttpMultiPartFormData.InitWithBoundary(const ABoundary: string);
+begin
+ // Decode 返回 frFailed 后, 调用方应调用 InitWithBoundary 重用实例;
+ // Clear 会根据 AutoDeleteFiles 清理半解析的临时文件.
+ Clear;
+
+ SetBoundary(ABoundary);
+
+ FDecodeState := dsBoundary;
+ FBoundaryIndex := 0;
+ FPrevBoundaryIndex := 0;
+ FCurrentPartDataSize := 0;
+ FCurrentPartHeaderLen := 0;
+ FCurrentPartField := nil;
+ SetLength(FLookbehind, Length(FBoundaryBytes) + 8);
+end;
+
+procedure THttpMultiPartFormData.Remove(AIndex: Integer);
+begin
+ FPartFields.Delete(AIndex);
+end;
+
+procedure THttpMultiPartFormData.Remove(const AFieldName: string);
+var
+ I: Integer;
+begin
+ I := GetItemIndex(AFieldName);
+ if (I >= 0) then
+ FPartFields.Delete(I);
+end;
+
+procedure THttpMultiPartFormData.SetBoundary(const AValue: string);
+begin
+ if (FBoundary <> AValue) then
+ begin
+ FBoundary := AValue;
+ FBoundary := FBoundary.Trim(['"']);
+
+ // 第一块数据是紧跟着 HTTP HEADER 的, 前面没有多余的 #13#10
+ FFirstBoundaryBytes := TEncoding.ASCII.GetBytes('--' + FBoundary);
+
+ // 第二块及以后的数据 Boundary 前面都会有 #13#10
+ FBoundaryBytes := TArrayUtils.Concat([13, 10], FFirstBoundaryBytes);
+ end;
+end;
+
+function THttpMultiPartFormData.Decode(const ABuf: Pointer; ALen: Integer; out AConsumed: Integer): TFormDataDecodeResult;
+ function __NewFileID: string;
+ begin
+ Result := TUtils.GetGUID.ToLower;
+ end;
+
+ function __InitFormFieldByHeader(AFormField: TFormField; const AHeader: string): Boolean;
+ var
+ LFieldHeader: THttpHeader;
+ LContentDisposition: string;
+ LMatch: TMatch;
+ begin
+ Result := False;
+
+ LFieldHeader := THttpHeader.Create;
+ try
+ LFieldHeader.Decode(AHeader);
+ LContentDisposition := LFieldHeader['Content-Disposition'];
+ if (LContentDisposition = '') then Exit;
+
+ AFormField.FContentType := LFieldHeader['Content-Type'];
+
+ LMatch := TRegEx.Match(LContentDisposition, '\bname="(.*?)"(?=;|$)', [TRegExOption.roIgnoreCase]);
+ if LMatch.Success then
+ AFormField.FName := LMatch.Groups[1].Value;
+
+ // 使用 Content-Type 来判断是否需要按文件保存更为准确
+ // 前端通过流的方式提交, 可能不会传递 filename 属性,
+ // 这种情况收到的 AHeader 是这样的:
+ // Content-Disposition: form-data; name="test_content"
+ // Content-Type: application/octet-stream
+ // 这种数据也可以当成文件来储存, 随机给它分配一个文件名即可
+ // 而普通的文本数据是不会有 Content-Type 的：
+ // Content-Disposition: form-data; name="test_text"
+ if (AFormField.FContentType <> '') then
+ begin
+ LMatch := TRegEx.Match(LContentDisposition, '\bfilename="(.*?)"(?=;|$)', [TRegExOption.roIgnoreCase]);
+ // 带 filename 属性的头:
+ // Content-Disposition: form-data; name="content"; filename="test.json"
+ // Content-Type: application/json
+ if LMatch.Success then
+ begin
+ AFormField.FFileName := TPathUtils.GetFileName(LMatch.Groups[1].Value);
+ AFormField.FFilePath := TPathUtils.Combine(FStoragePath,
+ __NewFileID + TPathUtils.GetExtension(AFormField.FFileName));
+ end else
+ begin
+ AFormField.FFileName := __NewFileID + '.bin';
+ AFormField.FFilePath := TPathUtils.Combine(FStoragePath,
+ AFormField.FFileName);
+ end;
+
+ AFormField.FIsTempFile := True;
+ AFormField.FValue := TFileUtils.OpenCreate(AFormField.FFilePath);
+ end else
+ AFormField.FValue := TBytesStream.Create(nil);
+
+ AFormField.FValueOwned := True;
+ // 注意: Content-Transfer-Encoding (base64/quoted-printable) 仅存储不解码,
+ // dsPartData 阶段总是按原始字节写入, 如需支持非二进制传输编码需在此增加解码层.
+ AFormField.FContentTransferEncoding := LFieldHeader['Content-Transfer-Encoding'];
+ finally
+ FreeAndNil(LFieldHeader);
+ end;
+
+ Result := True;
+ end;
+var
+ C: Byte;
+ I, LSize: Integer;
+ P: PByte;
+ LPartHeader: string;
+begin
+ AConsumed := 0;
+ if (FBoundaryBytes = nil) then Exit(frFailed);
+
+ (*
+ ***************************************
+ ***** multipart/form-data数据格式 *****
+ ***************************************
+
+ # 请求头, 这个是必须的, 需要指定Content-Type为multipart/form-data, 指定唯一边界值
+ Content-Type: multipart/form-data; boundary=${Boundary}
+
+ # 请求体
+ --${Boundary}
+ Content-Disposition: form-data; name="name of file"
+ Content-Type: application/octet-stream
+
+ bytes of file
+ --${Boundary}
+ Content-Disposition: form-data; name="name of pdf"; filename="pdf-file.pdf"
+ Content-Type: application/octet-stream
+
+ bytes of pdf file
+ --${Boundary}
+ Content-Disposition: form-data; name="key"
+ Content-Type: text/plain;charset=UTF-8
+
+ text encoded in UTF-8
+ --${Boundary}--
+ *)
+
+ P := ABuf;
+ I := 0;
+ while (I < ALen) do
+ begin
+ C := P[I];
+ case FDecodeState of
+ // 检测Boundary, 以确定第一块数据
+ dsBoundary:
+ begin
+ // 第一块数据是紧跟着 HTTP HEADER 的, 前面没有多余的 #13#10
+ // 所以这里检测时要跳过 2 个字节
+ if (C = FFirstBoundaryBytes[FBoundaryIndex]) then
+ Inc(FBoundaryIndex)
+ else
+ FBoundaryIndex := 0;
+ // --Boundary
+ if (FBoundaryIndex >= Length(FFirstBoundaryBytes)) then
+ begin
+ FDecodeState := dsDetect;
+ FLineEndState := lesCR1;
+ FBoundaryIndex := 0;
+ FPostBoundaryState := pbsDetect;
+ end;
+ end;
+
+ // 已通过Boundary检测, 继续检测以确定后面有数据还是已到结束
+ dsDetect:
+ begin
+ // 严格匹配 #13#10 (Header) 或 --#13#10 (End), 拒绝其他任何字节
+ case FPostBoundaryState of
+ pbsDetect:
+ if (C = 45) then // '-'
+ FPostBoundaryState := pbsEnd1
+ else if (C = 13) then // '\r'
+ FPostBoundaryState := pbsHeader1
+ else if (C = 32) or (C = 9) then // RFC 2046 LWSP
+ { stay in pbsDetect }
+ else
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ pbsEnd1:
+ if (C = 45) then // '-'
+ FPostBoundaryState := pbsEnd2
+ else
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ pbsEnd2:
+ if (C = 13) then // '\r'
+ FPostBoundaryState := pbsEnd3
+ else
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ pbsEnd3:
+ if (C = 10) then // '\n' → --Boundary--#13#10
+ begin
+ FDecodeState := dsBoundary;
+ FLineEndState := lesCR1;
+ FBoundaryIndex := 0;
+ FPostBoundaryState := pbsDetect;
+ AConsumed := I + 1;
+ Exit(frComplete);
+ end else
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ pbsHeader1:
+ if (C = 10) then // '\n' → --Boundary#13#10
+ begin
+ FCurrentPartHeaderLen := 0;
+ FDecodeState := dsPartHeader;
+ FLineEndState := lesCR1;
+ FBoundaryIndex := 0;
+ FPostBoundaryState := pbsDetect;
+ end else
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ end;
+ end;
+
+ dsPartHeader:
+ begin
+ FCurrentPartHeader[FCurrentPartHeaderLen] := C;
+ Inc(FCurrentPartHeaderLen);
+
+ // 状态机严格匹配 #13#10#13#10 序列
+ case FLineEndState of
+ lesCR1: if (C = 13) then FLineEndState := lesLF1;
+ lesLF1:
+ if (C = 10) then FLineEndState := lesCR2
+ else if (C <> 13) then FLineEndState := lesCR1;
+ lesCR2:
+ if (C = 13) then FLineEndState := lesLF2
+ else FLineEndState := lesCR1;
+ lesLF2:
+ if (C = 10) then
+ begin
+ FLineEndState := lesCR1;
+ // 块头部结束 #13#10#13#10
+ // 块头部通常采用UTF8编码
+ LPartHeader := TUtils.GetString(@FCurrentPartHeader[0], FCurrentPartHeaderLen - 4{#13#10#13#10});
+ FCurrentPartHeaderLen := 0;
+ FCurrentPartField := TFormField.Create;
+ if not __InitFormFieldByHeader(FCurrentPartField, LPartHeader) then
+ begin
+ FreeAndNil(FCurrentPartField);
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ FPartFields.Add(FCurrentPartField);
+
+ FDecodeState := dsPartData;
+ FPartDataBegin := -1;
+ FBoundaryIndex := 0;
+ FPrevBoundaryIndex := 0;
+ FCurrentPartDataSize := 0;
+ end else
+ if (C = 13) then FLineEndState := lesLF1
+ else FLineEndState := lesCR1;
+ end;
+
+ // 块头部过大, 视为非法数据
+ if (FCurrentPartHeaderLen > MAX_PART_HEADER) then
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ end;
+
+ dsPartData:
+ begin
+ // 如果这是一个新的数据块, 需要保存数据块起始位置
+ if (FPartDataBegin < 0) then
+ FPartDataBegin := I;
+
+ // 检测Boundary
+ if (C = FBoundaryBytes[FBoundaryIndex]) then
+ begin
+ Inc(FBoundaryIndex);
+
+ if (FPrevBoundaryIndex > 0) then
+ begin
+ FLookbehind[FPrevBoundaryIndex] := C;
+ Inc(FPrevBoundaryIndex);
+ end;
+ end else
+ begin
+ // 上一个内存块结尾有部分有点像Boundary的数据,
+ // 进一步判断之后确定不是Boundary, 需要把这部分数据写入Field中
+ if (FPrevBoundaryIndex > 0) then
+ begin
+ FCurrentPartField.FValue.Write(FLookbehind[0], FPrevBoundaryIndex);
+ Inc(FCurrentPartDataSize, FPrevBoundaryIndex);
+ // 检查单 Part Body 大小是否超限 (与块结尾检查对称)
+ if (FMaxPartDataSize > 0) and (FCurrentPartDataSize > FMaxPartDataSize) then
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+ FPrevBoundaryIndex := 0;
+ FPartDataBegin := I;
+ end;
+
+ if (FBoundaryIndex > 0) then
+ begin
+ // 之前检测到有一部分数据跟Boundary有点像, 但是到这个字节可以确定之前
+ // 这部分数据并不是Boundary, 需要把这部分数据写入Field中
+ FCurrentPartField.FValue.Write(P[FPartDataBegin], I - FPartDataBegin);
+ Inc(FCurrentPartDataSize, I - FPartDataBegin);
+ FPartDataBegin := I;
+
+ FBoundaryIndex := 0;
+
+ // 再次检测Boundary
+ if (C = FBoundaryBytes[FBoundaryIndex]) then
+ Inc(FBoundaryIndex);
+ end;
+ end;
+
+ // 如果已到内存块结束或者已经解析出一个完整的数据块
+ if (I >= ALen - 1) or (FBoundaryIndex >= Length(FBoundaryBytes)) then
+ begin
+ // 将内存块数据存入Field中
+ if (FPartDataBegin >= 0) then
+ begin
+ LSize := I - FPartDataBegin - FBoundaryIndex + 1;
+ if (LSize > 0) then
+ begin
+ FCurrentPartField.FValue.Write(P[FPartDataBegin], LSize);
+ Inc(FCurrentPartDataSize, LSize);
+ end;
+ end;
+
+ // 检查单 Part Body 大小是否超限 (必须在状态切换前检查)
+ if (FMaxPartDataSize > 0) and (FCurrentPartDataSize > FMaxPartDataSize) then
+ begin
+ AConsumed := I + 1;
+ Exit(frFailed);
+ end;
+
+ // 已解析出一个完整的数据块
+ if (FBoundaryIndex >= Length(FBoundaryBytes)) then
+ begin
+ FCurrentPartField.FValue.Position := 0;
+ FDecodeState := dsDetect;
+ FBoundaryIndex := 0;
+ FPrevBoundaryIndex := 0;
+ FCurrentPartDataSize := 0;
+ end else
+ // 已解析到本内存块结尾, 但是发现了部分有点像Boundary的数据
+ // 将其保存起来
+ if (FPrevBoundaryIndex = 0) and (FBoundaryIndex > 0) then
+ begin
+ FPrevBoundaryIndex := FBoundaryIndex;
+ Move(P[I - FBoundaryIndex + 1], FLookbehind[0], FBoundaryIndex);
+ end;
+
+ // 数据块起始位置需要在之后决定
+ FPartDataBegin := -1;
+ end;
+ end;
+ end;
+
+ Inc(I);
+ end;
+
+ AConsumed := ALen;
+ Result := frContinue;
+end;
+
+function THttpMultiPartFormData.Decode(const ABuf: Pointer; ALen: Integer): TFormDataDecodeResult;
+var
+ LDummy: Integer;
+begin
+ // 兼容旧调用方: 丢弃 consumed; 仅在调用方明确知道 multipart 数据帧严格对齐时使用.
+ Result := Decode(ABuf, ALen, LDummy);
+end;
+
+{ THttpMultiPartFormStream.TFormFieldEx }
+
+function THttpMultiPartFormStream.TFormFieldEx.DataSize: Int64;
+begin
+ if (Field <> nil) and (Field.Value <> nil) then
+ Result := Field.Value.Size
+ else
+ Result := 0;
+end;
+
+function THttpMultiPartFormStream.TFormFieldEx.HeaderSize: Integer;
+begin
+ Result := Length(Header);
+end;
+
+function THttpMultiPartFormStream.TFormFieldEx.TotalSize: Int64;
+begin
+ Result := HeaderSize + DataSize;
+end;
+
+{ THttpMultiPartFormStream }
+
+constructor THttpMultiPartFormStream.Create(
+ const AMultiPartFormData: THttpMultiPartFormData; const AOwned: Boolean);
+begin
+ FMultiPartFormData := AMultiPartFormData;
+ FOwned := AOwned;
+
+ _Init;
+end;
+
+destructor THttpMultiPartFormStream.Destroy;
+begin
+ if FOwned and (FMultiPartFormData <> nil) then
+ FreeAndNil(FMultiPartFormData);
+
+ inherited;
+end;
+
+function THttpMultiPartFormStream.Read(var ABuffer; ACount: Longint): Longint;
+var
+ LReadCount, LPos, LHeaderPos, LDataPos, LCount, LHeaderCount, LDataCount, LEndPos, LEndCount: Int64;
+ LFieldIndex: Integer;
+ LFieldEx: TFormFieldEx;
+ P: PByte;
+begin
+ Result := 0;
+ if (FPosition < 0) or (FPosition >= FSize) or (ACount <= 0) then Exit;
+
+ // 计算实际还能读取多少字节数据
+ if (ACount + FPosition <= FSize) then
+ LReadCount := ACount
+ else
+ LReadCount := FSize - FPosition;
+
+ Result := LReadCount;
+
+ P := @ABuffer;
+
+ {$region '从 Field 中读取数据'}
+ while (LReadCount > 0) do
+ begin
+ LFieldIndex := _GetFiledIndexByOffset(FPosition);
+ if (LFieldIndex < 0) then Break;
+
+ LFieldEx := FFormFieldExArray[LFieldIndex];
+
+ // 计算要读取的数据位于这个 Field 的偏移
+ LPos := FPosition - LFieldEx.Offset;
+
+ // 计算需要从这个 Field 中读取多少字节
+ LCount := Min(LFieldEx.TotalSize - LPos, LReadCount);
+
+ // 计算分别需要从 Header 和 Data 中读取多少字节
+ if (LPos < LFieldEx.HeaderSize) then
+ begin
+ LHeaderPos := LPos;
+ LDataPos := 0;
+
+ LHeaderCount := Min(LFieldEx.HeaderSize - LHeaderPos, LCount);
+ LDataCount := LCount - LHeaderCount;
+ end else
+ begin
+ LHeaderPos := -1;
+ LDataPos := LPos - LFieldEx.HeaderSize;
+
+ LHeaderCount := 0;
+ LDataCount := LCount - LHeaderCount;
+ end;
+
+ // 读取 Header
+ if (LHeaderCount > 0) then
+ begin
+ Move(LFieldEx.Header[LHeaderPos], P^, LHeaderCount);
+ Inc(P, LHeaderCount);
+ Dec(LReadCount, LHeaderCount);
+
+ Seek(LHeaderCount, soCurrent);
+ end;
+
+ // 读取 Data
+ if (LDataCount > 0) then
+ begin
+ LFieldEx.Field.Value.Position := LDataPos;
+ LFieldEx.Field.Value.Read(P^, LDataCount);
+ Inc(P, LDataCount);
+ Dec(LReadCount, LDataCount);
+
+ Seek(LDataCount, soCurrent);
+ end;
+ end;
+ {$endregion}
+
+ // 从尾巴读取数据
+ if (LReadCount > 0) then
+ begin
+ LEndPos := FPosition - FEndPos;
+ LEndCount := Min(Length(FMultiPartEnd) - LEndPos, LReadCount);
+
+ if (LEndCount > 0) then
+ begin
+ Move(FMultiPartEnd[LEndPos], P^, LEndCount);
+// Inc(P, LEndCount);
+// Dec(LReadCount, LEndCount);
+
+ Seek(LEndCount, soCurrent);
+ end;
+ end;
+end;
+
+function THttpMultiPartFormStream.Seek(const AOffset: Int64;
+ AOrigin: TSeekOrigin): Int64;
+begin
+ case AOrigin of
+ soBeginning: FPosition := AOffset;
+ soCurrent: Inc(FPosition, AOffset);
+ soEnd: FPosition := FSize + AOffset;
+ end;
+
+ if (FPosition < 0) then
+ FPosition := -1;
+
+ if (FPosition > FSize) then
+ FPosition := FSize;
+
+ Result := FPosition;
+end;
+
+function THttpMultiPartFormStream._GetFiledIndexByOffset(
+ const AOffset: Int64): Integer;
+var
+ LOffset: Int64;
+ I: Integer;
+begin
+ Result := -1;
+ if (AOffset < 0) or (AOffset >= FSize) then Exit;
+
+ LOffset := 0;
+
+ for I := 0 to High(FFormFieldExArray) do
+ begin
+ Inc(LOffset, FFormFieldExArray[I].TotalSize);
+ if (AOffset < LOffset) then Exit(I);
+ end;
+end;
+
+procedure THttpMultiPartFormStream._Init;
+var
+ I: Integer;
+ LFormFieldEx: TFormFieldEx;
+ LContentType, LPartHeaderStr: string;
+ LPartHeaderBytes, LBoundary: TBytes;
+ LOffset: Int64;
+begin
+ {
+ --boundary_value
+ Content-Disposition: form-data; name="text_field"
+
+ This is a simple text field.
+
+ --boundary_value
+ Content-Disposition: form-data; name="binary_data"
+ Content-Type: application/octet-stream
+
+ [Binary data goes here]
+
+ --boundary_value
+ Content-Disposition: form-data; name="file_field"; filename="example.txt"
+ Content-Type: text/plain
+
+ Contents of the example.txt file.
+
+ --boundary_value
+ Content-Disposition: form-data; name="image"; filename="image.jpg"
+ Content-Type: image/jpeg
+
+ [Binary image data]
+
+ --boundary_value--
+ }
+ // 检查 boundary, 如果没有则生成
+ if (FMultiPartFormData.Boundary = '') then
+ begin
+ Randomize;
+ FMultiPartFormData.Boundary := '--DCSFormBoundary'
+ + IntToHex(Random(MaxInt), 8)
+ + IntToHex(Random(MaxInt), 8);
+ end;
+
+ // 结尾数据
+ FMultiPartEnd := TArrayUtils.Concat(FMultiPartFormData.FBoundaryBytes, [45, 45, 13, 10]);
+
+ LOffset := 0;
+ FSize := 0;
+ FPosition := 0;
+
+ {$region '生成Field的头'}
+ SetLength(FFormFieldExArray, FMultiPartFormData.Count);
+
+ for I := 0 to FMultiPartFormData.Count - 1 do
+ begin
+ LFormFieldEx.Offset := LOffset;
+ LFormFieldEx.Field := FMultiPartFormData.Items[I];
+
+ if (I = 0) then
+ LBoundary := FMultiPartFormData.FFirstBoundaryBytes
+ else
+ LBoundary := FMultiPartFormData.FBoundaryBytes;
+
+ // 'Content-Disposition: form-data; name="%s"; filename="%s"'#13#10 +
+ // 'Content-Type: %s'#13#10#13#10
+
+ LContentType := LFormFieldEx.Field.ContentType;
+
+ LPartHeaderStr := Format(
+ 'Content-Disposition: form-data; name="%s"', [
+ LFormFieldEx.Field.Name
+ ]);
+ if (LFormFieldEx.Field.FileName <> '') then
+ begin
+ LPartHeaderStr := LPartHeaderStr
+ + Format('; filename="%s"', [LFormFieldEx.Field.FileName]);
+
+ if (LContentType = '') then
+ LContentType := TCrossHttpUtils.GetFileMIMEType(LFormFieldEx.Field.FileName);
+ end;
+ LPartHeaderStr := LPartHeaderStr + #13#10;
+
+ if (LContentType <> '') then
+ begin
+ LPartHeaderStr := LPartHeaderStr
+ + Format('Content-Type: %s', [LContentType])
+ + #13#10;
+ end;
+ LPartHeaderStr := LPartHeaderStr + #13#10;
+
+ LPartHeaderBytes := TEncoding.UTF8.GetBytes(LPartHeaderStr);
+
+ LFormFieldEx.Header := TArrayUtils.Concat([
+ LBoundary, [13, 10], LPartHeaderBytes]);
+
+ Inc(FSize, LFormFieldEx.HeaderSize);
+ Inc(FSize, LFormFieldEx.DataSize);
+ Inc(LOffset, LFormFieldEx.TotalSize);
+
+ FFormFieldExArray[I] := LFormFieldEx;
+ end;
+ {$endregion}
+
+ FEndPos := LOffset;
+ Inc(FSize, Length(FMultiPartEnd));
+end;
+
+{ TResponseCookies }
+
+procedure TResponseCookies.AddOrSet(const AName, AValue: string;
+ AMaxAge: Integer; const APath, ADomain: string; AHttpOnly, ASecure: Boolean);
+begin
+ SetCookie(AName, TResponseCookie.Create(AName, AValue, AMaxAge, APath, ADomain, AHttpOnly, ASecure));
+end;
+
+function TResponseCookies.GetCookieIndex(const AName: string): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ if TStrUtils.SameText(Items[I].Name, AName) then Exit(I);
+ Result := -1;
+end;
+
+procedure TResponseCookies.Remove(const AName: string);
+var
+ I: Integer;
+begin
+ I := GetCookieIndex(AName);
+ if (I >= 0) then
+ inherited Delete(I);
+end;
+
+function TResponseCookies.GetCookie(const AName: string): TResponseCookie;
+var
+ I: Integer;
+begin
+ I := GetCookieIndex(AName);
+ if (I >= 0) then
+ Result := Items[I]
+ else
+ begin
+ Result := TResponseCookie.Create(AName, '', 0);
+ Add(Result);
+ end;
+end;
+
+procedure TResponseCookies.SetCookie(const AName: string;
+ const Value: TResponseCookie);
+var
+ I: Integer;
+begin
+ I := GetCookieIndex(AName);
+ if (I >= 0) then
+ Items[I] := Value
+ else
+ Add(Value);
+end;
+
+{ TSessionBase }
+
+constructor TSessionBase.Create(const AOwner: TSessionsBase; const ASessionID: string);
+var
+ LNow: TDateTime;
+begin
+ LNow := Now;
+
+ FOwner := AOwner;
+
+ SetSessionID(ASessionID);
+ SetCreateTime(LNow);
+ SetLastAccessTime(LNow);
+end;
+
+function TSessionBase.Expired: Boolean;
+begin
+ Result := (ExpiryTime > 0) and (Now.SecondsDiffer(LastAccessTime) >= ExpiryTime);
+end;
+
+function TSessionBase.GetOwner: ISessions;
+begin
+ Result := FOwner;
+end;
+
+procedure TSessionBase.Touch;
+begin
+ LastAccessTime := Now;
+end;
+
+{ TSession }
+
+constructor TSession.Create(const AOwner: TSessionsBase; const ASessionID: string);
+begin
+ FValues := TDictionary.Create;
+
+ inherited Create(AOwner, ASessionID);
+end;
+
+destructor TSession.Destroy;
+begin
+ FreeAndNil(FValues);
+ inherited;
+end;
+
+function TSession.GetCreateTime: TDateTime;
+begin
+ Result := FCreateTime;
+end;
+
+function TSession.GetExpiryTime: Integer;
+begin
+ Result := FExpire;
+end;
+
+function TSession.GetLastAccessTime: TDateTime;
+begin
+ Result := FLastAccessTime;
+end;
+
+function TSession.GetSessionID: string;
+begin
+ Result := FSessionID;
+end;
+
+function TSession.GetValue(const AName: string): string;
+begin
+ if not FValues.TryGetValue(AName, Result) then
+ Result := '';
+ FLastAccessTime := Now;
+end;
+
+procedure TSession.SetCreateTime(const ACreateTime: TDateTime);
+begin
+ FCreateTime := ACreateTime;
+end;
+
+procedure TSession.SetExpiryTime(const AValue: Integer);
+begin
+ FExpire := AValue;
+end;
+
+procedure TSession.SetLastAccessTime(const ALastAccessTime: TDateTime);
+begin
+ FLastAccessTime := ALastAccessTime;
+end;
+
+procedure TSession.SetSessionID(const ASessionID: string);
+begin
+ FSessionID := ASessionID;
+end;
+
+procedure TSession.SetValue(const AName, AValue: string);
+begin
+ if (AValue <> '') then
+ FValues.AddOrSetValue(AName, AValue)
+ else
+ FValues.Remove(AName);
+ FLastAccessTime := Now;
+end;
+
+{ TSessionsBase }
+
+function TSessionsBase.AddSession(const ASessionID: string): ISession;
+begin
+ Result := GetSessionClass.Create(Self, ASessionID);
+ Result.ExpiryTime := ExpiryTime;
+ AddSession(ASessionID, Result);
+end;
+
+function TSessionsBase.AddSession: ISession;
+begin
+ Result := AddSession(NewSessionID);
+end;
+
+function TSessionsBase.ExistsSession(const ASessionID: string): Boolean;
+var
+ LStuff: ISession;
+begin
+ Result := ExistsSession(ASessionID, LStuff);
+end;
+
+procedure TSessionsBase.RemoveSession(const ASessionID: string);
+var
+ LSession: ISession;
+begin
+ if ExistsSession(ASessionID, LSession) then
+ RemoveSession(LSession);
+end;
+
+procedure TSessionsBase.RemoveSession(const ASession: ISession);
+begin
+ RemoveSessions([ASession]);
+end;
+
+{ TSessions }
+
+constructor TSessions.Create(ANewGUIDFunc: TFunc);
+begin
+ FNewGUIDFunc := ANewGUIDFunc;
+ FSessions := TDictionary.Create;
+ FLocker := TReadWriteLock.Create;
+ FSessionClass := TSession;
+ CreateExpiredProcThread;
+end;
+
+procedure TSessions.Clear;
+begin
+ FSessions.Clear;
+end;
+
+constructor TSessions.Create;
+begin
+ Create(nil);
+end;
+
+destructor TSessions.Destroy;
+var
+ LTimeout: TStopwatch;
+begin
+ FShutdown := True;
+ LTimeout := TStopwatch.StartNew;
+ while FExpiredProcRunning and (LTimeout.ElapsedMilliseconds < 5000) do Sleep(10);
+
+ BeginWrite;
+ FSessions.Clear;
+ EndWrite;
+ FreeAndNil(FSessions);
+
+ inherited;
+end;
+
+procedure TSessions.AddSession(const ASessionID: string; ASession: ISession);
+begin
+ if (ASession.ExpiryTime = 0) then
+ ASession.ExpiryTime := ExpiryTime;
+ FSessions.AddOrSetValue(ASessionID, ASession);
+end;
+
+procedure TSessions.AfterClearExpiredSessions;
+begin
+
+end;
+
+procedure TSessions.BeforeClearExpiredSessions;
+begin
+
+end;
+
+procedure TSessions.BeginRead;
+begin
+ FLocker.BeginRead;
+end;
+
+procedure TSessions.BeginWrite;
+begin
+ FLocker.BeginWrite;
+end;
+
+procedure TSessions.EndRead;
+begin
+ FLocker.EndRead;
+end;
+
+procedure TSessions.EndWrite;
+begin
+ FLocker.EndWrite;
+end;
+
+function TSessions.ExistsSession(const ASessionID: string;
+ var ASession: ISession): Boolean;
+begin
+ Result := FSessions.TryGetValue(ASessionID, ASession);
+ if Result then
+ ASession.Touch;
+end;
+
+procedure TSessions.CreateExpiredProcThread;
+begin
+ TAnonymousThread.Create(
+ procedure
+ var
+ LWatch: TStopwatch;
+ begin
+ FExpiredProcRunning := True;
+ try
+ LWatch := TStopwatch.StartNew;
+ while not FShutdown do
+ begin
+ // 每 1 分钟清理一次超时 Session
+ if (FExpire > 0) and (LWatch.Elapsed.TotalMinutes >= 1) then
+ begin
+ _ClearExpiredSessions;
+ LWatch.Reset;
+ LWatch.Start;
+ end;
+ Sleep(10);
+ end;
+ finally
+ FExpiredProcRunning := False;
+ end;
+ end).Start;
+end;
+
+function TSessions.NewSessionID: string;
+begin
+ if Assigned(FNewGUIDFunc) then
+ Result := FNewGUIDFunc()
+ else
+ Result := TUtils.GetGUID.ToLower;
+end;
+
+function TSessions.OnCheckExpiredSession(const ASession: ISession): Boolean;
+begin
+ Result := ASession.Expired;
+end;
+
+function TSessions.GetCount: Integer;
+begin
+ Result := FSessions.Count;
+end;
+
+function TSessions.GetEnumerator: TEnumerator;
+begin
+ Result := TDictionary.TValueEnumerator.Create(FSessions);
+end;
+
+function TSessions.GetExpiryTime: Integer;
+begin
+ Result := FExpire;
+end;
+
+function TSessions.GetItem(const AIndex: Integer): ISession;
+var
+ LIndex: Integer;
+ LPair: TPair;
+begin
+ LIndex := 0;
+ for LPair in FSessions do
+ begin
+ if (LIndex = AIndex) then Exit(LPair.Value);
+ Inc(LIndex);
+ end;
+ Result := nil;
+end;
+
+function TSessions.GetSession(const ASessionID: string): ISession;
+var
+ LSessionID: string;
+begin
+ LSessionID := ASessionID;
+ BeginWrite;
+ try
+ if (LSessionID = '') then
+ LSessionID := NewSessionID;
+ if not FSessions.TryGetValue(LSessionID, Result) then
+ begin
+ Result := FSessionClass.Create(Self, LSessionID);
+ Result.ExpiryTime := ExpiryTime;
+ AddSession(LSessionID, Result);
+ end;
+ finally
+ EndWrite;
+ end;
+
+ Result.LastAccessTime := Now;
+end;
+
+function TSessions.GetSessionClass: TSessionClass;
+begin
+ Result := FSessionClass;
+end;
+
+procedure TSessions.RemoveSessions(const ASessions: TArray);
+var
+ LSession: ISession;
+begin
+ for LSession in ASessions do
+ FSessions.Remove(LSession.SessionID);
+end;
+
+procedure TSessions.SetExpiryTime(const Value: Integer);
+begin
+ FExpire := Value;
+end;
+
+procedure TSessions.SetSessionClass(const Value: TSessionClass);
+begin
+ FSessionClass := Value;
+end;
+
+procedure TSessions._ClearExpiredSessions;
+var
+ LPair: TPair;
+ LDelSessions: TArray;
+begin
+ BeginWrite;
+ try
+ BeforeClearExpiredSessions;
+
+ LDelSessions := nil;
+ for LPair in FSessions do
+ begin
+ if FShutdown then Break;
+
+ if OnCheckExpiredSession(LPair.Value) then
+ LDelSessions := LDelSessions + [LPair.Value];
+ end;
+ RemoveSessions(LDelSessions);
+
+ AfterClearExpiredSessions;
+ finally
+ EndWrite;
+ end;
+end;
+
+end.
diff --git a/Net/Net.CrossHttpServer.pas b/Net/Net.CrossHttpServer.pas
index 539abb8..0b3d0bd 100644
--- a/Net/Net.CrossHttpServer.pas
+++ b/Net/Net.CrossHttpServer.pas
@@ -1,5879 +1,5879 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossHttpServer;
-
-{$I zLib.inc}
-
-{
- Linux下需要安装zlib1g-dev开发包
- sudo apt-get install zlib1g-dev
-}
-
-interface
-
-uses
- Classes,
- SysUtils,
- Math,
- Generics.Collections,
- //ZLib,
- {$IFDEF DELPHI}
- ZLib,
- {$ELSE}
- DTF.StaticZLib,
- {$ENDIF}
-
- Net.SocketAPI,
- Net.CrossSocket.Base,
- Net.CrossSocket,
- Net.CrossServer,
- Net.CrossHttpParams,
- Net.CrossHttpUtils,
- Net.CrossHttpParser,
-
- Utils.StrUtils,
- Utils.IOUtils,
- Utils.Hash,
- Utils.RegEx,
- Utils.SyncObjs,
- Utils.ArrayUtils,
- Utils.DateTime;
-
-const
- CROSS_HTTP_SERVER_NAME = 'CrossHttpServer/3.0';
- MIN_COMPRESS_SIZE = 512;
- WILDCARD_CHAR = '*';
- REGEX_CHARS: array of Char = [':', '*', '?', '(', ')', '[', '{', '|', '+', '.'];
-
-type
- ECrossHttpException = class(Exception)
- private
- FStatusCode: Integer;
- public
- constructor Create(const AMessage: string; AStatusCode: Integer = 400); reintroduce; virtual;
- constructor CreateFmt(const AMessage: string; const AArgs: array of const; AStatusCode: Integer = 400); reintroduce; virtual;
- property StatusCode: Integer read FStatusCode write FStatusCode;
- end;
-
- ICrossHttpServer = interface;
- ICrossHttpRequest = interface;
- ICrossHttpResponse = interface;
- IHttpResponseQueueItem = interface;
-
- TCrossHttpServer = class;
- TCrossHttpRequest = class;
- TCrossHttpResponse = class;
- THttpResponseQueueItem = class;
-
- ///
- /// HTTP连接接口
- ///
- ICrossHttpConnection = interface(ICrossServerConnection)
- ['{72E9AC44-958C-4C6F-8769-02EA5EC3E9A8}']
- function GetRequest: ICrossHttpRequest;
- function GetResponse: ICrossHttpResponse;
- function GetServer: ICrossHttpServer;
- function GetPending: Integer;
-
- ///
- /// 请求对象
- ///
- property Request: ICrossHttpRequest read GetRequest;
-
- ///
- /// 响应对象
- ///
- property Response: ICrossHttpResponse read GetResponse;
-
- ///
- /// Server对象
- ///
- property Server: ICrossHttpServer read GetServer;
-
- ///
- /// 当前连接上"已开始解析但尚未完成响应"的请求数量
- /// (含正在处理中的与已入队等待发送的)
- ///
- property Pending: Integer read GetPending;
- end;
-
- ///
- /// 请求体类型
- ///
- TBodyType = (btNone, btUrlEncoded, btMultiPart, btBinary);
-
- ///
- /// HTTP请求接口
- ///
- ICrossHttpRequest = interface
- ['{B26B7E7B-6B24-4D86-AB58-EBC20722CFDD}']
- function GetConnection: ICrossHttpConnection;
- function GetRawRequestText: string;
- function GetRawPathAndQuery: string;
- function GetMethod: string;
- function GetPath: string;
- function GetPathAndQuery: string;
- function GetVersion: string;
- function GetHeader: THttpHeader;
- function GetCookies: TRequestCookies;
- function GetSession: ISession;
- function GetParams: THttpUrlParams;
- function GetQuery: THttpUrlParams;
- function GetQueryText: string;
- function GetBody: TObject;
- function GetRawBody: TStream;
- function GetBodyType: TBodyType;
- function GetKeepAlive: Boolean;
- function GetAccept: string;
- function GetAcceptEncoding: string;
- function GetAcceptLanguage: string;
- function GetReferer: string;
- function GetUserAgent: string;
- function GetIfModifiedSince: TDateTime;
- function GetIfNoneMatch: string;
- function GetRange: string;
- function GetIfRange: string;
- function GetAuthorization: string;
- function GetXForwardedFor: string;
- function GetContentLength: Int64;
- function GetHostName: string;
- function GetHostPort: Word;
- function GetContentType: string;
- function GetContentEncoding: string;
- function GetRequestBoundary: string;
- function GetRequestCmdLine: string;
- function GetRequestConnection: string;
- function GetTransferEncoding: string;
- function GetIsChunked: Boolean;
- function GetIsMultiPartFormData: Boolean;
- function GetIsUrlEncodedFormData: Boolean;
- function GetPostDataSize: Int64;
-
- ///
- /// HTTP连接对象
- ///
- property Connection: ICrossHttpConnection read GetConnection;
-
- ///
- /// 原始请求数据
- ///
- property RawRequestText: string read GetRawRequestText;
-
- ///
- /// 原始请求路径及参数
- ///
- property RawPathAndParams: string read GetRawPathAndQuery;
-
- ///
- /// 请求方法
- ///
- /// -
- /// GET
- ///
- /// -
- /// POST
- ///
- /// -
- /// PUT
- ///
- /// -
- /// DELETE
- ///
- /// -
- /// HEAD
- ///
- /// -
- /// OPTIONS
- ///
- /// -
- /// TRACE
- ///
- /// -
- /// CONNECT
- ///
- /// -
- /// PATCH
- ///
- /// -
- /// COPY
- ///
- /// -
- /// LINK
- ///
- /// -
- /// UNLINK
- ///
- /// -
- /// PURGE
- ///
- /// -
- /// LOCK
- ///
- /// -
- /// UNLOCK
- ///
- /// -
- /// PROPFIND
- ///
- ///
- ///
- property Method: string read GetMethod;
-
- ///
- ///
- /// 请求路径, 不包含参数部分
- ///
- ///
- /// 比如: /api/callapi1
- ///
- ///
- property Path: string read GetPath;
-
- ///
- ///
- /// 请求路径及参数
- ///
- ///
- /// 比如: /api/callapi1?aaa=111&bbb=222
- ///
- ///
- property PathAndQuery: string read GetPathAndQuery;
-
- ///
- /// 请求版本:
- ///
- /// -
- /// HTTP/1.0
- ///
- /// -
- /// HTTP/1.1
- ///
- ///
- ///
- property Version: string read GetVersion;
-
- ///
- /// HTTP请求头
- ///
- property Header: THttpHeader read GetHeader;
-
- ///
- /// 客户端传递过来的Cookies
- ///
- property Cookies: TRequestCookies read GetCookies;
-
- ///
- /// Session对象
- ///
- ///
- ///
- /// 只有在Server开启了Session支持的情况, 该属性才有效, 否则该属性为nil
- ///
- ///
- /// 要开启Server的Session支持, 只需要设置Server.SessionIDCookieName不为空即可
- ///
- ///
- property Session: ISession read GetSession;
-
- ///
- ///
- /// 请求路径中定义的参数
- ///
- ///
- /// 比如定义了一个Get('/echo/:text', cb) 然后有一个请求为 /echo/hello, 那么 Params
- /// 中就会有一个名为 'text', 值为 'hello' 的参数
- ///
- ///
- property Params: THttpUrlParams read GetParams;
-
- ///
- /// 请求路径后形如?key1=value1&key2=value2的参数
- ///
- property Query: THttpUrlParams read GetQuery;
-
- ///
- ///
- /// 请求路径中定义的参数
- ///
- ///
- property QueryText: string read GetQueryText;
-
- ///
- /// 解析后的Body数据, 通过检查BodyType可以知道数据类型:
- ///
- /// -
- /// btNone(nil)
- ///
- /// -
- /// btUrlEncoded(TFormUrlEncoded)
- ///
- /// -
- /// btMultiPart(THttpMultiPartFormData)
- ///
- /// -
- /// btBinary(TMemoryStream)
- ///
- ///
- ///
- property Body: TObject read GetBody;
-
- ///
- /// 原始Body数据流, 仅对btUrlEncoded和btBinary缓存; multipart/form-data返回nil
- ///
- ///
- /// 调用方只读使用, 不负责释放
- ///
- property RawBody: TStream read GetRawBody;
-
- ///
- /// Body的类型,
- ///
- /// -
- /// btNone(nil)
- ///
- /// -
- /// btUrlEncoded(TFormUrlEncoded)
- ///
- /// -
- /// btMultiPart(THttpMultiPartFormData)
- ///
- /// -
- /// btBinary(TMemoryStream)
- ///
- ///
- ///
- property BodyType: TBodyType read GetBodyType;
-
- ///
- /// KeepAliv标志
- ///
- property KeepAlive: Boolean read GetKeepAlive;
-
- ///
- /// 客户端能接收的数据种类
- ///
- ///
- /// image/webp,image/*,*/*;q=0.8
- ///
- property Accept: string read GetAccept;
-
- ///
- /// 客户端能接收的编码
- ///
- ///
- /// gzip, deflate, sdch
- ///
- property AcceptEncoding: string read GetAcceptEncoding;
-
- ///
- /// 客户端能接收的语言
- ///
- ///
- /// zh-CN,zh;q=0.8
- ///
- property AcceptLanguage: string read GetAcceptLanguage;
-
- ///
- /// 参考地址, 描述该请求由哪个页面发出
- ///
- property Referer: string read GetReferer;
-
- ///
- /// 用户代理
- ///
- ///
- /// Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like
- /// Gecko) Chrome/50.0.2661.102 Safari/537.36
- ///
- property UserAgent: string read GetUserAgent;
-
- ///
- /// 请求内容在浏览器端的缓存时间
- ///
- property IfModifiedSince: TDateTime read GetIfModifiedSince;
-
- ///
- /// 请求内容在浏览器端的标记
- ///
- property IfNoneMatch: string read GetIfNoneMatch;
-
- ///
- /// 请求分块传输
- ///
- property Range: string read GetRange;
-
- ///
- /// 请求分块传输时传往服务器的标记, 用于服务器比较数据是否已发生变化
- ///
- property IfRange: string read GetIfRange;
-
- ///
- /// 简单认证信息
- ///
- property Authorization: string read GetAuthorization;
-
- ///
- /// 通过HTTP代理或负载均衡方式连接到Web服务器的客户端最原始的IP地址的HTTP请求头字段
- ///
- property XForwardedFor: string read GetXForwardedFor;
-
- ///
- /// 请求数据长度
- ///
- property ContentLength: Int64 read GetContentLength;
-
- ///
- /// 请求的主机名(域名、IP)
- ///
- property HostName: string read GetHostName;
-
- ///
- /// 请求的主机端口
- ///
- property HostPort: Word read GetHostPort;
-
- ///
- /// 内容类型
- ///
- property ContentType: string read GetContentType;
-
- ///
- /// 请求命令行(也就是HTTP请求的第一行)
- ///
- property RequestCmdLine: string read GetRequestCmdLine;
-
- ///
- /// 请求分界符
- ///
- property RequestBoundary: string read GetRequestBoundary;
-
- ///
- /// 传输编码
- ///
- property TransferEncoding: string read GetTransferEncoding;
-
- ///
- /// 内容编码
- ///
- property ContentEncoding: string read GetContentEncoding;
-
- ///
- /// 连接方式
- ///
- property RequestConnection: string read GetRequestConnection;
-
- ///
- /// 请求数据是否使用块编码
- ///
- property IsChunked: Boolean read GetIsChunked;
-
- ///
- /// 请求数据是使用 multipart/form-data 方式提交的
- ///
- property IsMultiPartFormData: Boolean read GetIsMultiPartFormData;
-
- ///
- /// 请求数据是使用 application/x-www-form-urlencoded 方式提交的
- ///
- property IsUrlEncodedFormData: Boolean read GetIsUrlEncodedFormData;
-
- ///
- /// 请求数据大小
- ///
- property PostDataSize: Int64 read GetPostDataSize;
- end;
-
- ///
- /// 提供块数据的匿名函数
- ///
- TCrossHttpChunkDataFunc = reference to function(const AData: PPointer; const ACount: PNativeInt): Boolean;
-
- ///
- /// HTTP响应队列项接口
- /// 用于按请求解析顺序串行化每个连接上的响应发送, 避免 pipelining 响应交错
- ///
- IHttpResponseQueueItem = interface
- ['{B03F35B7-6984-41A8-9AA0-6B3D48F18F91}']
- function GetRequest: ICrossHttpRequest;
- function GetResponse: ICrossHttpResponse;
- function GetSource: TCrossHttpChunkDataFunc;
- function GetCallback: TCrossConnectionCallback;
- function GetReady: Boolean;
- function GetSending: Boolean;
- function GetCompleted: Boolean;
- function GetKeepAlive: Boolean;
- function GetStatusCode: Integer;
-
- procedure SetRequest(const AValue: ICrossHttpRequest);
- procedure SetResponse(const AValue: ICrossHttpResponse);
- procedure SetSource(const AValue: TCrossHttpChunkDataFunc);
- procedure SetCallback(const AValue: TCrossConnectionCallback);
- procedure SetReady(const AValue: Boolean);
- procedure SetSending(const AValue: Boolean);
- procedure SetCompleted(const AValue: Boolean);
- procedure SetKeepAlive(const AValue: Boolean);
- procedure SetStatusCode(const AValue: Integer);
-
- property Request: ICrossHttpRequest read GetRequest write SetRequest;
- property Response: ICrossHttpResponse read GetResponse write SetResponse;
- property Source: TCrossHttpChunkDataFunc read GetSource write SetSource;
- property Callback: TCrossConnectionCallback read GetCallback write SetCallback;
- property Ready: Boolean read GetReady write SetReady;
- property Sending: Boolean read GetSending write SetSending;
- property Completed: Boolean read GetCompleted write SetCompleted;
- property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive;
- property StatusCode: Integer read GetStatusCode write SetStatusCode;
- end;
-
- ///
- /// HTTP响应队列项实现类
- ///
- THttpResponseQueueItem = class(TInterfacedObject, IHttpResponseQueueItem)
- private
- FRequest: ICrossHttpRequest;
- FResponse: ICrossHttpResponse;
- FSource: TCrossHttpChunkDataFunc;
- FCallback: TCrossConnectionCallback;
- FReady: Boolean;
- FSending: Boolean;
- FCompleted: Boolean;
- FKeepAlive: Boolean;
- FStatusCode: Integer;
- protected
- function GetRequest: ICrossHttpRequest;
- function GetResponse: ICrossHttpResponse;
- function GetSource: TCrossHttpChunkDataFunc;
- function GetCallback: TCrossConnectionCallback;
- function GetReady: Boolean;
- function GetSending: Boolean;
- function GetCompleted: Boolean;
- function GetKeepAlive: Boolean;
- function GetStatusCode: Integer;
-
- procedure SetRequest(const AValue: ICrossHttpRequest);
- procedure SetResponse(const AValue: ICrossHttpResponse);
- procedure SetSource(const AValue: TCrossHttpChunkDataFunc);
- procedure SetCallback(const AValue: TCrossConnectionCallback);
- procedure SetReady(const AValue: Boolean);
- procedure SetSending(const AValue: Boolean);
- procedure SetCompleted(const AValue: Boolean);
- procedure SetKeepAlive(const AValue: Boolean);
- procedure SetStatusCode(const AValue: Integer);
- end;
-
- ///
- /// HTTP应答接口
- ///
- ICrossHttpResponse = interface
- ['{5E15C20F-E221-4B10-90FC-222173A6F3E8}']
- function GetConnection: ICrossHttpConnection;
- function GetRequest: ICrossHttpRequest;
- function GetStatusCode: Integer;
- function GetStatusText: string;
- function GetContentType: string;
- function GetLocation: string;
- function GetHeader: THttpHeader;
- function GetCookies: TResponseCookies;
- function GetSent: Boolean;
-
- procedure SetContentType(const Value: string);
- procedure SetLocation(const Value: string);
- procedure SetStatusCode(Value: Integer);
- procedure SetStatusText(const Value: string);
-
- ///
- /// 重置数据
- ///
- procedure Reset;
-
- ///
- /// 压缩发送块数据
- ///
- ///
- /// 产生块数据的匿名函数
- /// // AData: 数据指针
- /// // ACount: 数据大小
- /// // Result: 如果返回True, 则发送数据; 如果返回False, 则忽略AData和ACount并结束发送
- /// function(const AData: PPointer; const ACount: PNativeInt): Boolean
- /// begin
- /// end
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 本方法实现了一边压缩一边发送数据, 所以可以支持无限大的分块数据的压缩发送, 而不用占用太多的内存和CPU
- /// zlib参考手册:
- ///
- procedure SendZCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送无类型数据
- ///
- ///
- /// 无类型数据
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- procedure SendZCompress(const ABody; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- procedure SendZCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- procedure SendZCompress(const ABody: TBytes; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure SendZCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure SendZCompress(const ABody: TStream; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 压缩发送字符串数据
- ///
- ///
- /// 字符串数据
- ///
- ///
- /// 压缩方式
- ///
- ///
- /// 回调函数
- ///
- procedure SendZCompress(const ABody: string; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送块数据
- ///
- ///
- /// 产生块数据的匿名函数
- /// // AData: 数据指针
- /// // ACount: 数据大小
- /// // Result: 如果返回True, 则发送数据; 如果返回False, 则忽略AData和ACount并结束发送
- /// function(const AData: PPointer; const ACount: PNativeInt): Boolean
- /// begin
- /// end
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 使用该方法可以一边生成数据一边发送, 无需等待数据全部准备完成
- ///
- procedure SendNoCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送无类型数据
- ///
- ///
- /// 无类型数据
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- procedure SendNoCompress(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- procedure SendNoCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 回调函数
- ///
- procedure SendNoCompress(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure SendNoCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure SendNoCompress(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 不压缩发送字符串数据
- ///
- ///
- /// 字符串数据
- ///
- ///
- /// 回调函数
- ///
- procedure SendNoCompress(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送无类型数据
- ///
- ///
- /// 无类型数据
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- procedure Send(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- procedure Send(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送字节数据
- ///
- ///
- /// 字节数据
- ///
- ///
- /// 回调函数
- ///
- procedure Send(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 偏移量
- ///
- ///
- /// 数据大小
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure Send(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送流数据
- ///
- ///
- /// 流数据
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
- ///
- procedure Send(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送字符串数据
- ///
- ///
- /// 字符串数据
- ///
- ///
- /// 回调函数
- ///
- procedure Send(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送Json字符串数据
- ///
- ///
- /// Json字符串数据
- ///
- ///
- /// 回调函数
- ///
- procedure Json(const AJson: string; const ACallback: TCrossConnectionCallback = nil);
-
- ///
- /// 发送文件内容
- ///
- ///
- /// 文件名
- ///
- ///
- /// 回调函数
- ///
- procedure SendFile(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
-
- ///
- /// 将文件以下载形式发送
- ///
- ///
- /// 文件名
- ///
- ///
- /// 回调函数
- ///
- procedure Download(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
-
- ///
- /// 发送状态码
- ///
- ///
- /// 状态码
- ///
- ///
- /// 描述信息(body)
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 描述信息即是body数据, 如果设置为空, 则body也为空
- ///
- procedure SendStatus(const AStatusCode: Integer; const ADescription: string;
- const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送状态码
- ///
- ///
- /// 状态码
- ///
- ///
- /// 回调函数
- ///
- ///
- /// 该方法根据状态码生成默认的body数据
- ///
- procedure SendStatus(const AStatusCode: Integer;
- const ACallback: TCrossConnectionCallback = nil); overload;
-
- ///
- /// 发送重定向Url命令
- ///
- ///
- /// 新的Url
- ///
- ///
- /// 回调函数
- ///
- procedure Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback = nil);
-
- ///
- /// 设置Content-Disposition, 令客户端将收到的数据作为文件下载处理
- ///
- ///
- /// 文件名
- ///
- procedure Attachment(const AFileName: string);
-
- ///
- /// HTTP连接对象
- ///
- property Connection: ICrossHttpConnection read GetConnection;
-
- ///
- /// 请求对象
- ///
- property Request: ICrossHttpRequest read GetRequest;
-
- ///
- /// 状态码
- ///
- property StatusCode: Integer read GetStatusCode write SetStatusCode;
-
- ///
- /// 状态文本
- ///
- property StatusText: string read GetStatusText write SetStatusText;
-
- ///
- /// 内容类型
- ///
- property ContentType: string read GetContentType write SetContentType;
-
- ///
- /// 重定向Url
- ///
- property Location: string read GetLocation write SetLocation;
-
- ///
- /// HTTP响应头
- ///
- property Header: THttpHeader read GetHeader;
-
- ///
- /// 设置Cookies
- ///
- property Cookies: TResponseCookies read GetCookies;
-
- ///
- /// 是否已经发送数据
- ///
- property Sent: Boolean read GetSent;
- end;
-
- TCrossHttpRouterProc = reference to procedure(const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; var AHandled: Boolean);
- TCrossHttpRouterMethod = procedure(const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; var AHandled: Boolean) of object;
-
- TCrossHttpConnEvent = procedure(const Sender: TObject; const AConnection: ICrossHttpConnection) of object;
- TCrossHttpRequestExceptionEvent = procedure(const Sender: TObject; const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; const AException: Exception) of object;
-
- TCrossHttpRequestEvent = procedure(const Sender: TObject;
- const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
- var AHandled: Boolean) of object;
-
- // Begin/End 事件签名带上 ARequest/AResponse, 让事件 handler 能拿到本次事件
- // 对应的请求/响应对象, 不再依赖连接级 FRequest/FResponse 兼容视图
- // (该兼容视图在 pipelining 下语义模糊, 已不再由 _FinishQueueItem 维护)
- TCrossHttpRequestBeginEvent = procedure(const Sender: TObject;
- const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse) of object;
- TCrossHttpRequestEndEvent = procedure(const Sender: TObject;
- const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
- const ASuccess: Boolean) of object;
-
- ///
- ///
- /// 跨平台HTTP服务器接口
- ///
- ///
- /// 路由定义方式:
- ///
- ///
- /// Route(AMehod, APath, ARouter)
- ///
- ///
- /// Get(APath, ARouter)
- ///
- ///
- /// Put(APath, ARouter)
- ///
- ///
- /// Post(APath, ARouter)
- ///
- ///
- /// Delete(APath, ARouter)
- ///
- ///
- /// All(APath, ARouter)
- ///
- ///
- /// 其中AMehod和APath都支持正则表达式, ARouter可以是一个对象方法也可以是匿名函数
- ///
- ///
- ///
- ///
- /// 这里偷了下懒, 没将HTTP和HTTPS分开实现两个不同的接口, 需要通过编译开关选择使用HTTP还是HTTP
- ///
- ///
- /// 通过接口引用计数保证连接的有效性，所以可以在路由函数中调用线程池来处理业务逻辑，而不用担心处理过程中连接对象被释放
- ///
- ///
- /// 每个请求的响应流程大致为：
- ///
- ///
- /// -
- /// 执行匹配的中间件;
- ///
- /// -
- /// 执行匹配的路由
- ///
- ///
- ///
- ///
- /// // 在线程池中处理业务逻辑
- /// FCrossHttpServer.Route('GET', '/runtask/:name',
- /// procedure(ARequest: ICrossHttpRequest; AResponse: ICrossHttpResponse)
- /// begin
- /// System.Threading.TTask.Run(
- /// procedure
- /// begin
- /// CallTask(ARequest.Params['name']);
- /// end);
- /// end);
- /// // 正则表达式
- /// FCrossHttpServer.Route('GET', '/query/:count(\d+)',
- /// procedure(ARequest: ICrossHttpRequest; AResponse: ICrossHttpResponse)
- /// begin
- /// System.Threading.TTask.Run(
- /// procedure
- /// begin
- /// CallQuery(ARequest.Params['count'].ToInteger);
- /// end);
- /// end);
- ///
- ICrossHttpServer = interface(ICrossServer)
- ['{224D16AA-317C-435E-9C2E-92868E578DB3}']
- function GetStoragePath: string;
- function GetAutoDeleteFiles: Boolean;
- function GetMaxHeaderSize: Int64;
- function GetMaxPostDataSize: Int64;
- function GetMaxCompressRatio: Integer;
- function GetCompressible: Boolean;
- function GetMinCompressSize: Int64;
- function GetSessions: ISessions;
- function GetSessionIDCookieName: string;
- function GetOnRequestBegin: TCrossHttpRequestBeginEvent;
- function GetOnRequest: TCrossHttpRequestEvent;
- function GetOnRequestEnd: TCrossHttpRequestEndEvent;
- function GetOnRequestException: TCrossHttpRequestExceptionEvent;
-
- procedure SetStoragePath(const Value: string);
- procedure SetAutoDeleteFiles(const Value: Boolean);
- procedure SetMaxHeaderSize(const Value: Int64);
- procedure SetMaxPostDataSize(const Value: Int64);
- procedure SetMaxCompressRatio(const Value: Integer);
- procedure SetCompressible(const Value: Boolean);
- procedure SetMinCompressSize(const Value: Int64);
- procedure SetSessions(const Value: ISessions);
- procedure SetSessionIDCookieName(const Value: string);
- procedure SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
- procedure SetOnRequest(const Value: TCrossHttpRequestEvent);
- procedure SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
- procedure SetOnRequestException(const Value: TCrossHttpRequestExceptionEvent);
-
- ///
- /// 注册中间件
- ///
- ///
- /// 请求方式
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 中间件处理匿名函数, 执行完处理函数之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
- /// 否则后续匹配的中间件及路由不会被执行
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const AMethod, APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册中间件
- ///
- ///
- /// 请求方式
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 中间件处理匿名方法, 执行完处理方法之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
- /// 否则后续匹配的中间件及路由不会被执行
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const AMethod, APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册中间件
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 中间件处理匿名函数, 执行完处理函数之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
- /// 否则后续匹配的中间件及路由不会被执行
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册中间件
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 中间件处理匿名方法, 执行完处理方法之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
- /// 否则后续匹配的中间件及路由不会被执行
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册中间件
- ///
- ///
- /// 中间件处理匿名函数, 执行完处理函数之后还会继续执行后续匹配的中间件及路由
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册中间件
- ///
- ///
- /// 中间件处理方法, 执行完处理方法之后还会继续执行后续匹配的中间件及路由
- ///
- ///
- ///
- /// -
- /// 中间件严格按照注册时的顺序被调用
- ///
- /// -
- /// 中间件先于路由执行
- ///
- ///
- ///
- function Use(const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册路由(请求处理函数)
- ///
- ///
- /// 请求方式, GET/POST/PUT/DELETE等, 支持正则表达式, * 表示处理全部请求方式
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Route(const AMethod, APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册路由(请求处理函数)
- ///
- ///
- /// 请求方式, GET/POST/PUT/DELETE等, 支持正则表达式, * 表示处理全部请求方式
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Route(const AMethod, APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册GET路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Get(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册GET路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Get(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册PUT路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Put(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册PUT路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Put(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册POST路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Post(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册POST路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Post(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册DELETE路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Delete(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册DELETE路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function Delete(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册全部请求方式路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理匿名函数
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function All(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
-
- ///
- /// 注册全部请求方式路由(请求处理函数)
- ///
- ///
- /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
- /// /path/:param1/:param2(\d+)|/path/:param
- ///
- ///
- /// 路由处理方法
- ///
- ///
- ///
- /// -
- /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
- /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
- ///
- /// -
- /// 路由中的正则表达式用法与node.js express相同
- ///
- ///
- ///
- function All(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- ///
- /// 注册静态文件路由
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 静态文件目录, 该目录及子目录下的文件都将作为静态文件返回
- ///
- function &Static(const APath, ALocalStaticDir: string): ICrossHttpServer;
-
- ///
- /// 注册文件列表路由
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 本地文件目录
- ///
- function Dir(const APath, ALocalDir: string): ICrossHttpServer;
-
- ///
- /// 注册含有默认首页文件的静态文件路由
- ///
- ///
- /// 请求路径
- ///
- ///
- /// 含有默认首页文件的本地目录
- ///
- ///
- /// 默认的首页文件,按顺序选择,先找到哪个就使用哪个
- ///
- function Index(const APath, ALocalDir: string; const ADefIndexFiles: TArray): ICrossHttpServer;
-
- ///
- /// 删除指定路由
- ///
- function RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
-
- ///
- /// 清除所有路由
- ///
- function ClearRouters: ICrossHttpServer;
-
- ///
- /// 删除指定中间件
- ///
- function RemoveMiddleware(const AMethod, APath: string): ICrossHttpServer;
-
- ///
- /// 清除所有中间件
- ///
- function ClearMiddlewares: ICrossHttpServer;
-
- ///
- /// 上传文件保存路径
- ///
- ///
- /// 用于保存multipart/form-data上传的文件
- ///
- property StoragePath: string read GetStoragePath write SetStoragePath;
-
- ///
- /// 对象释放时自动删除上传的文件
- ///
- property AutoDeleteFiles: Boolean read GetAutoDeleteFiles write SetAutoDeleteFiles;
-
- ///
- /// 最大允许HEADER的数据尺寸
- ///
- /// -
- /// > 0, 限制HEADER尺寸
- ///
- /// -
- /// <= 0, 不限制
- ///
- ///
- ///
- property MaxHeaderSize: Int64 read GetMaxHeaderSize write SetMaxHeaderSize;
-
- ///
- /// 最大允许POST的数据尺寸
- ///
- /// -
- /// > 0, 限制上传数据尺寸
- ///
- /// -
- /// <= 0, 不限制
- ///
- ///
- ///
- property MaxPostDataSize: Int64 read GetMaxPostDataSize write SetMaxPostDataSize;
-
- ///
- /// gzip/deflate 解压时的最大压缩比 (DecodedSize / EncodedSize)
- ///
- /// -
- /// > 0, 解压输出与输入比超过该值则按 zip bomb 拒绝 (400)
- ///
- /// -
- /// = 0, 不做压缩比检查 (仅靠 MaxPostDataSize 拦截)
- ///
- ///
- ///
- ///
- /// 合法 gzip 通常 1.5-15:1, 极规整数据 (StringOfChar, 大块重复字节) 可达 100-500:1
- /// 经典 zip bomb 1000:1 起 (42.zip ~100000:1), 默认 1000:1 兜底拦截 bomb
- ///
- property MaxCompressRatio: Integer read GetMaxCompressRatio write SetMaxCompressRatio;
-
- ///
- /// 是否开启压缩
- ///
- ///
- /// 开启压缩后, 发往客户端的数据将会进行压缩处理
- ///
- property Compressible: Boolean read GetCompressible write SetCompressible;
-
- ///
- /// 最小允许压缩的数据尺寸
- ///
- ///
- ///
- /// -
- /// 如果设置值大于0, 则只有Body数据尺寸大于等于该值才会进行压缩
- ///
- /// -
- /// 如果设置值小于等于0, 则无视Body数据尺寸, 始终进行压缩
- ///
- /// -
- /// 由于数据是分块压缩发送, 所以数据无论多大都不会占用更多的资源, 也就不需要限制最大压缩尺寸了
- ///
- /// -
- /// 目前支持的压缩方式: gzip, deflate
- ///
- ///
- ///
- property MinCompressSize: Int64 read GetMinCompressSize write SetMinCompressSize;
-
- ///
- /// Sessions接口对象
- ///
- ///
- /// 通过它管理所有Session, 如果不设置则Session功能将不会被启用
- ///
- property Sessions: ISessions read GetSessions write SetSessions;
-
- ///
- ///
- /// SessionID在Cookie中存储的名称
- ///
- ///
- ///
- /// 如果设置为空, 则Session功能将不会被启用
- ///
- property SessionIDCookieName: string read GetSessionIDCookieName write SetSessionIDCookieName;
-
- property OnRequestBegin: TCrossHttpRequestBeginEvent read GetOnRequestBegin write SetOnRequestBegin;
- property OnRequest: TCrossHttpRequestEvent read GetOnRequest write SetOnRequest;
- property OnRequestEnd: TCrossHttpRequestEndEvent read GetOnRequestEnd write SetOnRequestEnd;
- property OnRequestException: TCrossHttpRequestExceptionEvent read GetOnRequestException write SetOnRequestException;
- end;
-
- TCrossHttpConnection = class(TCrossServerConnection, ICrossHttpConnection)
- private
- FServer: TCrossHttpServer;
- FRequestObj: TCrossHttpRequest;
- FRequest: ICrossHttpRequest;
- FResponseObj: TCrossHttpResponse;
- FResponse: ICrossHttpResponse;
- FHttpParser: ICrossHttpParser;
- FPending: Integer;
-
- // pipelining 响应队列, 按请求解析顺序串行化响应发送
- FResponseQueue: TList;
- FResponseQueueLock: ILock;
- FSendingResponse: Boolean;
-
- {$region 'HttpParser事件'}
- // 以下事件都在 FHttpParser.Decode 中被触发
- // 而 FHttpParser.Decode 在 ParseRecvData 中被调用
- // ParseRecvData 在 FServer.LogicReceived 中被调用
- // FServer.LogicReceived 被 TCrossConnectionBase._LockRecv 保护
- // 所以无需担心以下事件的多线程安全问题
- procedure _OnHeaderData(const ADataPtr: Pointer; const ADataSize: Integer);
- function _OnGetHeaderValue(const AHeaderName: string; out AHeaderValues: TArray): Boolean;
- procedure _OnBodyBegin;
- procedure _OnBodyData(const ADataPtr: Pointer; const ADataSize: Integer);
- procedure _OnBodyEnd;
- procedure _OnParseBegin;
- procedure _OnParseSuccess;
- procedure _OnParseFailed(const ACode: Integer; const AError: string);
- {$endregion}
-
- // 响应队列内部方法
- procedure _QueueResponseReady(const AItem: IHttpResponseQueueItem;
- const ASource: TCrossHttpChunkDataFunc;
- const ACallback: TCrossConnectionCallback);
- procedure _SendQueueItem(const AItem: IHttpResponseQueueItem);
- procedure _FinishQueueItem(const AItem: IHttpResponseQueueItem; const ASuccess: Boolean);
-
- // 调用前必须已持有 FResponseQueueLock; 若可发送则取出队首 ready item
- // 并设置 FSendingResponse / item.Sending, 否则返回 nil
- function _TryDequeueReadyLocked: IHttpResponseQueueItem;
-
- // 调用前必须已持有 FResponseQueueLock; 清空队列, 同时主动断开每个 item
- // 内对 request/response/source/callback 的接口引用, 避免与 response.FQueueItem
- // 等形成的循环引用导致 item 永不释放
- procedure _ClearResponseQueueLocked;
- protected
- function GetRequest: ICrossHttpRequest;
- function GetResponse: ICrossHttpResponse;
- function GetServer: ICrossHttpServer;
- function GetPending: Integer;
-
- procedure ParseRecvData(var ABuf: Pointer; var ALen: Integer); virtual;
-
- procedure ReleaseRequest; virtual;
- procedure ReleaseResponse; virtual;
-
- // socket 关闭时主动打破 connection 与 request/response 之间的循环引用,
- // 并清空响应队列, 避免连接关闭后 connection 因循环引用永不释放导致内存泄漏
- procedure InternalClose; override;
- public
- constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback); override;
- destructor Destroy; override;
-
- property Request: ICrossHttpRequest read GetRequest;
- property Response: ICrossHttpResponse read GetResponse;
- property Server: ICrossHttpServer read GetServer;
- property Pending: Integer read GetPending;
- end;
-
- TCrossHttpRequest = class(TInterfacedObject, ICrossHttpRequest)
- private
- FRawRequestText: string;
- FMethod, FPath, FQueryText, FPathAndQuery, FVersion: string;
- FRawPath, FRawQueryText, FRawPathAndQuery: string;
- FHttpVerNum: Integer;
- FKeepAlive: Boolean;
- FAccept: string;
- FReferer: string;
- FAcceptLanguage: string;
- FAcceptEncoding: string;
- FUserAgent: string;
- FIfModifiedSince: TDateTime;
- FIfNoneMatch: string;
- FRange: string;
- FIfRange: string;
- FAuthorization: string;
- FXForwardedFor: string;
- FContentLength: Int64;
- FHostName: string;
- FHostPort: Word;
-
- FPostDataSize: Int64;
-
- FRequestCmdLine: string;
- FContentType: string;
- FRequestBoundary: string;
- FTransferEncoding: string;
- FContentEncoding: string;
- FRequestCookies: string;
- FRequestHost: string;
- FRequestConnection: string;
-
- FConnectionObj: TCrossHttpConnection;
- FConnection: ICrossHttpConnection;
- FServer: TCrossHttpServer;
- FHeader: THttpHeader;
- FCookies: TRequestCookies;
- FSession: ISession;
- FParams: THttpUrlParams;
- FQuery: THttpUrlParams;
- FBody: TObject;
- FRawBody: TMemoryStream;
- FBodyType: TBodyType;
- FIsChunked: Boolean;
- private
- function CalcIsChunked: Boolean; inline;
- protected
- function GetConnection: ICrossHttpConnection;
- function GetRawRequestText: string;
- function GetRawPathAndQuery: string;
- function GetMethod: string;
- function GetPath: string;
- function GetPathAndQuery: string;
- function GetVersion: string;
- function GetHeader: THttpHeader;
- function GetCookies: TRequestCookies;
- function GetSession: ISession;
- function GetParams: THttpUrlParams;
- function GetQueryText: string;
- function GetQuery: THttpUrlParams;
- function GetBody: TObject;
- function GetRawBody: TStream;
- function GetBodyType: TBodyType;
- function GetKeepAlive: Boolean;
- function GetAccept: string;
- function GetAcceptEncoding: string;
- function GetAcceptLanguage: string;
- function GetReferer: string;
- function GetUserAgent: string;
- function GetIfModifiedSince: TDateTime;
- function GetIfNoneMatch: string;
- function GetRange: string;
- function GetIfRange: string;
- function GetAuthorization: string;
- function GetXForwardedFor: string;
- function GetContentLength: Int64;
- function GetHostName: string;
- function GetHostPort: Word;
- function GetContentType: string;
- function GetContentEncoding: string;
- function GetRequestBoundary: string;
- function GetRequestCmdLine: string;
- function GetRequestConnection: string;
- function GetTransferEncoding: string;
- function GetIsChunked: Boolean;
- function GetIsMultiPartFormData: Boolean;
- function GetIsUrlEncodedFormData: Boolean;
- function GetPostDataSize: Int64;
-
- function ParseHeader(const ADataPtr: Pointer; const ADataSize: Integer): Boolean;
- public
- constructor Create(const AConnection: TCrossHttpConnection);
- destructor Destroy; override;
-
- property Connection: ICrossHttpConnection read GetConnection;
- property RawRequestText: string read GetRawRequestText;
- property RawPathAndParams: string read GetRawPathAndQuery;
- property Method: string read GetMethod;
- property Path: string read GetPath;
- property PathAndQuery: string read GetPathAndQuery;
- property Version: string read GetVersion;
- property Header: THttpHeader read GetHeader;
- property Cookies: TRequestCookies read GetCookies;
- property Session: ISession read GetSession;
- property Params: THttpUrlParams read GetParams;
- property Query: THttpUrlParams read GetQuery;
- property QueryText: string read GetQueryText;
- property Body: TObject read GetBody;
- property RawBody: TStream read GetRawBody;
- property BodyType: TBodyType read GetBodyType;
- property KeepAlive: Boolean read GetKeepAlive;
- property Accept: string read GetAccept;
- property AcceptEncoding: string read GetAcceptEncoding;
- property AcceptLanguage: string read GetAcceptLanguage;
- property Referer: string read GetReferer;
- property UserAgent: string read GetUserAgent;
- property IfModifiedSince: TDateTime read GetIfModifiedSince;
- property IfNoneMatch: string read GetIfNoneMatch;
- property Range: string read GetRange;
- property IfRange: string read GetIfRange;
- property Authorization: string read GetAuthorization;
- property XForwardedFor: string read GetXForwardedFor;
- property ContentLength: Int64 read GetContentLength;
- property HostName: string read GetHostName;
- property HostPort: Word read GetHostPort;
- property ContentType: string read GetContentType;
-
- property RequestCmdLine: string read GetRequestCmdLine;
-
- property RequestBoundary: string read GetRequestBoundary;
- property TransferEncoding: string read GetTransferEncoding;
- property ContentEncoding: string read GetContentEncoding;
- property RequestConnection: string read GetRequestConnection;
- property IsChunked: Boolean read GetIsChunked;
- property IsMultiPartFormData: Boolean read GetIsMultiPartFormData;
- property IsUrlEncodedFormData: Boolean read GetIsUrlEncodedFormData;
- property PostDataSize: Int64 read GetPostDataSize;
- end;
-
- TCrossHttpResponse = class(TInterfacedObject, ICrossHttpResponse)
- public const
- SND_BUF_SIZE = TCrossConnection.SND_BUF_SIZE;
- private
- FConnectionObj: TCrossHttpConnection;
- FConnection: ICrossHttpConnection;
- FRequest: ICrossHttpRequest;
- FStatusCode: Integer;
- FStatusText: string;
- FHeader: THttpHeader;
- FCookies: TResponseCookies;
- FSendStatus: Integer;
- FQueueItem: IHttpResponseQueueItem;
-
- procedure Reset;
- function _CreateHeader(const ABodySize: Int64; AChunked: Boolean): TBytes;
-
- {$region '内部: 基础发送方法'}
- procedure _Send(const ASource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure _Send(const AHeaderSource, ABodySource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
- {$endregion}
-
- function _CheckCompress(const ABodySize: Int64; out ACompressType: TCompressType): Boolean;
-
- // TCustomMemoryStream 优化: 直接获取内存指针, 避免逐块读流
- function _GetMemoryStreamPointer(const AStream: TStream;
- const AOffset, ACount: Int64; out P: PByte; out LSize: Int64): Boolean; inline;
-
- {$region '压缩发送'}
- procedure SendZCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendZCompress(const ABody: Pointer; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendZCompress(const ABody; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendZCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendZCompress(const ABody: TBytes; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendZCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendZCompress(const ABody: TStream; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendZCompress(const ABody: string; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
- {$endregion}
-
- {$region '不压缩发送'}
- procedure SendNoCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendNoCompress(const ABody: Pointer; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendNoCompress(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendNoCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendNoCompress(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendNoCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendNoCompress(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure SendNoCompress(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
- {$endregion}
-
- {$region '常规方法'}
- procedure Send(const ABody: Pointer; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure Send(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure Send(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure Send(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure Send(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
- procedure Send(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload; inline;
- procedure Send(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
-
- procedure Json(const AJson: string; const ACallback: TCrossConnectionCallback = nil);
-
- procedure SendFile(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
- procedure Download(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
- procedure SendStatus(const AStatusCode: Integer; const ADescription: string;
- const ACallback: TCrossConnectionCallback = nil); overload;
- procedure SendStatus(const AStatusCode: Integer;
- const ACallback: TCrossConnectionCallback = nil); overload;
- procedure Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback = nil);
- procedure Attachment(const AFileName: string);
- {$endregion}
- protected
- function GetConnection: ICrossHttpConnection;
- function GetRequest: ICrossHttpRequest;
- function GetStatusCode: Integer;
- function GetStatusText: string;
- function GetContentType: string;
- function GetLocation: string;
- function GetHeader: THttpHeader;
- function GetCookies: TResponseCookies;
- function GetSent: Boolean;
-
- procedure SetContentType(const Value: string);
- procedure SetLocation(const Value: string);
- procedure SetStatusCode(Value: Integer);
- procedure SetStatusText(const Value: string);
- public
- constructor Create(const AConnection: TCrossHttpConnection;
- const ARequest: ICrossHttpRequest;
- const AQueueItem: IHttpResponseQueueItem);
- destructor Destroy; override;
- end;
-
- ///
- /// 路由参数定义
- ///
- TRouteParam = record
- Name: string; // 参数名
- Pattern: string; // 正则模式
- end;
-
- ///
- /// 路由类型
- ///
- TRouteType = (
- ///
- /// 静态路由
- ///
- rtStatic,
-
- ///
- /// 正则路由
- /// 例如: /users/:id, /users/:id/echo, /users/:id(\d+)
- ///
- rtRegex,
-
- ///
- /// 通配符路由
- /// 例如: /files/*, 其中*就是通配符节点, 通配符节点只能出现在路径最后一段
- ///
- rtWildcard
- );
-
- ///
- /// 路由接口
- ///
- IRouter = interface
- ['{5A7E2B1C-8D3F-4E69-A0C5-2F1B8E6D4A93}']
- function GetRouteType: TRouteType;
- function GetMethodPattern: string;
- function GetRegEx: IRegEx;
-
- procedure AddRouterProc(const ARouterProc: TCrossHttpRouterProc); overload;
- procedure AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod); overload;
-
- procedure Execute(const ARequest: ICrossHttpRequest;
- const AResponse: ICrossHttpResponse; var AHandled: Boolean);
-
- property RouteType: TRouteType read GetRouteType;
- property MethodPattern: string read GetMethodPattern;
- property RegEx: IRegEx read GetRegEx;
- end;
-
- ///
- /// 路由
- ///
- TRouter = class(TInterfacedObject, IRouter)
- private
- // 路由类型
- FRouteType: TRouteType;
- // 方法模式(如 "GET", "GET|POST", "*" 等)
- FMethodPattern: string;
- FLock: IReadWriteLock;
-
- // 路由处理函数
- FRouterProcList: TList;
- FRouterMethodList: TList;
-
- function GetRouteType: TRouteType;
- function GetMethodPattern: string;
- function GetRegEx: IRegEx;
- public
- constructor Create(const AMethodPattern: string);
- destructor Destroy; override;
-
- procedure AddRouterProc(const ARouterProc: TCrossHttpRouterProc); overload;
- procedure AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod); overload;
-
- procedure Execute(const ARequest: ICrossHttpRequest;
- const AResponse: ICrossHttpResponse; var AHandled: Boolean);
- end;
-
- ///
- /// 路由段
- ///
- TRouteSegment = class
- private
- FOriginal: string; // 原始段
- FPattern: string; // 完整模式
- FParams: TArray; // 参数定义数组
- FRouteType: TRouteType; // 路由类型
- public
- constructor Create(const AOriginal, APattern: string;
- const AParams: TArray; ARouteType: TRouteType);
-
- // 正则匹配
- // 只有正则匹配的路由才需要处理参数
- function RegexMatch(const ASegment: string; const ARequest: ICrossHttpRequest): Boolean;
-
- property Original: string read FOriginal;
- property Pattern: string read FPattern;
- property Params: TArray read FParams;
- property RouteType: TRouteType read FRouteType;
- end;
-
- ///
- /// 路由节点
- ///
- TRouteNode = class
- private
- FRouteType: TRouteType; // 路由类型
- FSegment: TRouteSegment; // 路由段
-
- FStaticChildren: TObjectDictionary; // 静态子节点
- FRegexChildren: TObjectList; // 正则子节点
- FWildcardChild: TRouteNode; // 通配符子节点
-
- FStaticRouteMethodItems: TDictionary; // 静态方法路由项列表
- FRegexRouteMethodItems: TList; // 正则方法路由项列表
- FWildcardRouteMethodItem: IRouter; // 通配符路由项
-
- function GetChildNode(const ASegment: string; const ARouteType: TRouteType; out ARouteNode: TRouteNode): Boolean;
- function CreateChildNode(const ASegment: TRouteSegment): TRouteNode;
- public
- constructor Create(ARouteType: TRouteType; const ASegment: TRouteSegment);
- destructor Destroy; override;
-
- // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST)
- procedure AddRouter(const AMethodPattern: string; const ARouter: IRouter);
- function GetRouter(const AMethodPattern: string; out ARouter: IRouter): Boolean;
- function RemoveRouter(const AMethodPattern: string): Boolean;
-
- // 注意: 查找使用的是确定的请求方法(比如 GET POST)
- function MatchRouter(const AMethod: string; out ARouter: IRouter): Boolean;
- function IsEmpty: Boolean;
-
- property RouteType: TRouteType read FRouteType;
- property Segment: TRouteSegment read FSegment;
- property StaticChildren: TObjectDictionary read FStaticChildren;
- property RegexChildren: TObjectList read FRegexChildren;
- property WildcardChild: TRouteNode read FWildcardChild;
- end;
-
- ///
- /// 路由树
- ///
- TCrossHttpRouterTree = class
- private
- FRoot: TRouteNode;
- FLock: IReadWriteLock;
-
- function CreateSegment(const ASegment: string; const ARouteType: TRouteType): TRouteSegment;
-
- // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST, /user/:id)
- procedure AddRouterToNode(ANode: TRouteNode; const APathPatternSegments: TArray;
- AIndex: Integer; const AMethodPattern: string; const ARouter: IRouter);
- function GetRouterFromNode(ANode: TRouteNode; const APathPatternSegments: TArray;
- AIndex: Integer; const AMethodPattern: string; out ARouter: IRouter): Boolean;
- function RemoveRouterFromNode(ANode: TRouteNode; const APathPatternSegments: TArray;
- AIndex: Integer; const AMethodPattern: string): Boolean;
-
- function GetWildcardValue(const APathSegments: TArray;
- AIndex: Integer; const AQueryText: string): string;
- // 注意: 查找使用的是确定的请求方法和路径(比如 GET POST, /user/123)
- function MatchRouterInNode(ANode: TRouteNode; const APathSegments: TArray;
- AIndex: Integer; const AMethod: string; const ARequest: ICrossHttpRequest;
- out ARouter: IRouter): Boolean;
- public
- constructor Create;
- destructor Destroy; override;
-
- // 将请求路径分段
- class function ParsePath(const APath: string): TArray; static;
-
- // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST, /user/:id)
- procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouter: IRouter); overload;
- function GetRouter(const AMethodPattern, APathPattern: string; out ARouter: IRouter): Boolean; overload;
- function GetRouter(const AMethodPattern, APathPattern: string): IRouter; overload;
-
- procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouterProc: TCrossHttpRouterProc); overload;
- procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouterMethod: TCrossHttpRouterMethod); overload;
-
- procedure RemoveRouter(const AMethodPattern, APathPattern: string);
-
- // 注意: 查找与请求匹配的路由
- function MatchRouter(const APathSegments: TArray; const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean; overload;
- function MatchRouter(const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean; overload;
- procedure Clear;
- end;
-
- TCrossHttpServer = class(TCrossServer, ICrossHttpServer)
- private const
- SESSIONID_COOKIE_NAME = 'cross_sessionid';
- private
- FStoragePath: string;
- FAutoDeleteFiles: Boolean;
- FMaxPostDataSize: Int64;
- FMaxHeaderSize: Int64;
- FMaxCompressRatio: Integer;
- FMinCompressSize: Int64;
- FSessionIDCookieName: string;
-
- FRouters: TCrossHttpRouterTree;
- FMiddlewares: TCrossHttpRouterTree;
-
- FSessions: ISessions;
- FOnRequestBegin: TCrossHttpRequestBeginEvent;
- FOnRequestEnd: TCrossHttpRequestEndEvent;
- FOnRequest: TCrossHttpRequestEvent;
- FOnRequestException: TCrossHttpRequestExceptionEvent;
- FCompressible: Boolean;
- protected
- function GetStoragePath: string;
- function GetAutoDeleteFiles: Boolean;
- function GetMaxHeaderSize: Int64;
- function GetMaxPostDataSize: Int64;
- function GetMaxCompressRatio: Integer;
- function GetCompressible: Boolean;
- function GetMinCompressSize: Int64;
- function GetSessions: ISessions;
- function GetSessionIDCookieName: string;
- function GetOnRequest: TCrossHttpRequestEvent;
- function GetOnRequestEnd: TCrossHttpRequestEndEvent;
- function GetOnRequestBegin: TCrossHttpRequestBeginEvent;
- function GetOnRequestException: TCrossHttpRequestExceptionEvent;
-
- procedure SetStoragePath(const Value: string);
- procedure SetAutoDeleteFiles(const Value: Boolean);
- procedure SetMaxHeaderSize(const Value: Int64);
- procedure SetMaxPostDataSize(const Value: Int64);
- procedure SetMaxCompressRatio(const Value: Integer);
- procedure SetCompressible(const Value: Boolean);
- procedure SetMinCompressSize(const Value: Int64);
- procedure SetSessions(const Value: ISessions);
- procedure SetSessionIDCookieName(const Value: string);
- procedure SetOnRequest(const Value: TCrossHttpRequestEvent);
- procedure SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
- procedure SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
- procedure SetOnRequestException(const Value: TCrossHttpRequestExceptionEvent);
- protected
- function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
-
- procedure LogicReceived(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer); override;
- protected
- // 处理请求前
- // 显式传入 ARequest/AResponse, 避免在 pipelining 场景下从 connection 字段读取产生 race
- procedure DoOnRequestBegin(const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse); virtual;
-
- // 处理请求
- procedure DoOnRequest(const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse); virtual;
-
- // 处理请求后
- procedure DoOnRequestEnd(const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
- const ASuccess: Boolean); virtual;
- public
- constructor Create(const AIoThreads: Integer; const ASsl: Boolean); override;
- destructor Destroy; override;
-
- function Use(const AMethod, APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Use(const AMethod, APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
- function Use(const APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Use(const APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
- function Use(const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Use(const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function Route(const AMethod, APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Route(const AMethod, APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function Get(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Get(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function Put(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Put(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function Post(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Post(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function Delete(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function Delete(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function All(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
- function All(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
-
- function &Static(const APath, ALocalStaticDir: string): ICrossHttpServer;
- function Dir(const APath, ALocalDir: string): ICrossHttpServer;
- function Index(const APath, ALocalDir: string; const ADefIndexFiles: TArray): ICrossHttpServer;
-
- function RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
- function ClearRouters: ICrossHttpServer;
-
- function RemoveMiddleware(const AMethod, APath: string): ICrossHttpServer;
- function ClearMiddlewares: ICrossHttpServer;
-
- property StoragePath: string read GetStoragePath write SetStoragePath;
- property AutoDeleteFiles: Boolean read GetAutoDeleteFiles write SetAutoDeleteFiles;
- property MaxHeaderSize: Int64 read GetMaxHeaderSize write SetMaxHeaderSize;
- property MaxPostDataSize: Int64 read GetMaxPostDataSize write SetMaxPostDataSize;
- property MaxCompressRatio: Integer read GetMaxCompressRatio write SetMaxCompressRatio;
- property Compressible: Boolean read GetCompressible write SetCompressible;
- property MinCompressSize: Int64 read GetMinCompressSize write SetMinCompressSize;
- property Sessions: ISessions read GetSessions write SetSessions;
- property SessionIDCookieName: string read GetSessionIDCookieName write SetSessionIDCookieName;
-
- property OnRequestBegin: TCrossHttpRequestBeginEvent read GetOnRequestBegin write SetOnRequestBegin;
- property OnRequest: TCrossHttpRequestEvent read GetOnRequest write SetOnRequest;
- property OnRequestEnd: TCrossHttpRequestEndEvent read GetOnRequestEnd write SetOnRequestEnd;
- property OnRequestException: TCrossHttpRequestExceptionEvent read GetOnRequestException write SetOnRequestException;
- end;
-
-implementation
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- Utils.Utils,
- Net.CrossHttpRouter;
-
-const
- // HTTP/1.1 100 Continue 临时响应，用于 Expect: 100-continue 流程
- CResponse100Continue: AnsiString = 'HTTP/1.1 100 Continue'#13#10#13#10;
-
-
-{ ECrossHttpException }
-
-constructor ECrossHttpException.Create(const AMessage: string;
- AStatusCode: Integer);
-begin
- inherited Create(AMessage);
- FStatusCode := AStatusCode;
-end;
-
-constructor ECrossHttpException.CreateFmt(const AMessage: string;
- const AArgs: array of const; AStatusCode: Integer);
-begin
- inherited CreateFmt(AMessage, AArgs);
- FStatusCode := AStatusCode;
-end;
-
-{ THttpResponseQueueItem }
-
-function THttpResponseQueueItem.GetRequest: ICrossHttpRequest;
-begin
- Result := FRequest;
-end;
-
-function THttpResponseQueueItem.GetResponse: ICrossHttpResponse;
-begin
- Result := FResponse;
-end;
-
-function THttpResponseQueueItem.GetSource: TCrossHttpChunkDataFunc;
-begin
- Result := FSource;
-end;
-
-function THttpResponseQueueItem.GetCallback: TCrossConnectionCallback;
-begin
- Result := FCallback;
-end;
-
-function THttpResponseQueueItem.GetReady: Boolean;
-begin
- Result := FReady;
-end;
-
-function THttpResponseQueueItem.GetSending: Boolean;
-begin
- Result := FSending;
-end;
-
-function THttpResponseQueueItem.GetCompleted: Boolean;
-begin
- Result := FCompleted;
-end;
-
-function THttpResponseQueueItem.GetKeepAlive: Boolean;
-begin
- Result := FKeepAlive;
-end;
-
-function THttpResponseQueueItem.GetStatusCode: Integer;
-begin
- Result := FStatusCode;
-end;
-
-procedure THttpResponseQueueItem.SetRequest(const AValue: ICrossHttpRequest);
-begin
- FRequest := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetResponse(const AValue: ICrossHttpResponse);
-begin
- FResponse := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetSource(const AValue: TCrossHttpChunkDataFunc);
-begin
- FSource := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetCallback(const AValue: TCrossConnectionCallback);
-begin
- FCallback := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetReady(const AValue: Boolean);
-begin
- FReady := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetSending(const AValue: Boolean);
-begin
- FSending := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetCompleted(const AValue: Boolean);
-begin
- FCompleted := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetKeepAlive(const AValue: Boolean);
-begin
- FKeepAlive := AValue;
-end;
-
-procedure THttpResponseQueueItem.SetStatusCode(const AValue: Integer);
-begin
- FStatusCode := AValue;
-end;
-
-{ TCrossHttpConnection }
-
-constructor TCrossHttpConnection.Create(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback);
-begin
- inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
-
- FServer := AOwner as TCrossHttpServer;
-
- FResponseQueue := TList.Create;
- FResponseQueueLock := TLock.Create;
-
- FHttpParser := TCrossHttpParser.Create(pmServer);
- FHttpParser.MaxHeaderSize := FServer.MaxHeaderSize;
- FHttpParser.MaxBodyDataSize := FServer.MaxPostDataSize;
- FHttpParser.MaxCompressRatio := FServer.MaxCompressRatio;
- FHttpParser.OnHeaderData := _OnHeaderData;
- FHttpParser.OnGetHeaderValue := _OnGetHeaderValue;
- FHttpParser.OnBodyBegin := _OnBodyBegin;
- FHttpParser.OnBodyData := _OnBodyData;
- FHttpParser.OnBodyEnd := _OnBodyEnd;
- FHttpParser.OnParseBegin := _OnParseBegin;
- FHttpParser.OnParseSuccess := _OnParseSuccess;
- FHttpParser.OnParseFailed := _OnParseFailed;
-end;
-
-destructor TCrossHttpConnection.Destroy;
-begin
- if (FRequest <> nil) then
- (FRequest as TCrossHttpRequest).FConnection := nil;
-
- if (FResponse <> nil) then
- (FResponse as TCrossHttpResponse).FConnection := nil;
-
- ReleaseRequest;
- ReleaseResponse;
-
- // 队列清理由 InternalClose 负责 (包括 _ClearResponseQueueLocked 触发 callbacks),
- // 此处仅做 defensive 的 FreeAndNil, 避免重复清理
- FreeAndNil(FResponseQueue);
- FResponseQueueLock := nil;
-
- FHttpParser := nil;
-
- inherited;
-end;
-
-function TCrossHttpConnection.GetRequest: ICrossHttpRequest;
-begin
- Result := FRequest;
-end;
-
-function TCrossHttpConnection.GetResponse: ICrossHttpResponse;
-begin
- Result := FResponse;
-end;
-
-function TCrossHttpConnection.GetServer: ICrossHttpServer;
-begin
- Result := Owner as ICrossHttpServer;
-end;
-
-function TCrossHttpConnection.GetPending: Integer;
-begin
- // 读取在多 IO 线程间发生, 与 _OnParseBegin 的 AtomicIncrement /
- // _FinishQueueItem 的 AtomicDecrement 保持原子语义
- Result := AtomicCmpExchange(FPending, 0, 0);
-end;
-
-procedure TCrossHttpConnection.ParseRecvData(var ABuf: Pointer;
- var ALen: Integer);
-begin
- if (FHttpParser <> nil) then
- FHttpParser.Decode(ABuf, ALen)
- else
- ALen := 0;
-end;
-
-procedure TCrossHttpConnection.ReleaseRequest;
-begin
- FRequestObj := nil;
- FRequest := nil;
-end;
-
-procedure TCrossHttpConnection.ReleaseResponse;
-begin
- FResponseObj := nil;
- FResponse := nil;
-end;
-
-procedure TCrossHttpConnection.InternalClose;
-begin
- // 必须在 socket 关闭时主动断开连接级 FRequest/FResponse 与 request.FConnection /
- // response.FConnection 之间的循环引用. 否则 connection.FRequest 持有 request, 而
- // request.FConnection 又持有 connection, refcount 永不归零, 不仅 connection 不会
- // 销毁, 队列内 item / request body / response header 等也全部泄漏.
- if (FRequest <> nil) then
- (FRequest as TCrossHttpRequest).FConnection := nil;
- if (FResponse <> nil) then
- (FResponse as TCrossHttpResponse).FConnection := nil;
- ReleaseRequest;
- ReleaseResponse;
-
- // 清空响应队列中剩余 items: 它们持有的 request/response/source/callback 接口字段
- // 与 response.FQueueItem 形成循环引用. 必须先逐个清空 item 内的接口字段,
- // 再 Clear 队列, 否则 items 引用计数减 1 之后仍因循环引用而不会归零, 导致泄漏
- if (FResponseQueueLock <> nil) and (FResponseQueue <> nil) then
- begin
- FResponseQueueLock.Enter;
- try
- FSendingResponse := False;
- _ClearResponseQueueLocked;
- finally
- FResponseQueueLock.Leave;
- end;
- end;
-
- inherited InternalClose;
-end;
-
-function TCrossHttpConnection._TryDequeueReadyLocked: IHttpResponseQueueItem;
-begin
- Result := nil;
-
- if FSendingResponse then Exit;
- if (FResponseQueue = nil) or (FResponseQueue.Count = 0) then Exit;
- if not FResponseQueue[0].Ready then Exit;
-
- // 从队列中移除队首, 由调用方的局部接口引用保活后续发送过程
- Result := FResponseQueue[0];
- FResponseQueue.Delete(0);
- FSendingResponse := True;
- Result.Sending := True;
-end;
-
-// _ClearResponseQueueLocked:
-// 调用前必须持有 FResponseQueueLock.
-// 按队列注册顺序 (FIFO) 收集所有 callback, 清空队列并逐个清空 item 内部接口引用,
-// 锁外按收集顺序触发 callback(False) 通知业务方发送失败.
-// 注意: callback 中不应操作连接状态 (如 Disconnect), 因为此时连接正在关闭流程中.
-procedure TCrossHttpConnection._ClearResponseQueueLocked;
-var
- I: Integer;
- LItem: IHttpResponseQueueItem;
- LCallbacks: TArray;
-begin
- if (FResponseQueue = nil) then Exit;
-
- // 收集所有待通知 callback (在本方法尾部、队列清空后触发),
- // 避免静默丢弃导致业务方 hang 等通知.
- SetLength(LCallbacks, FResponseQueue.Count);
- for I := 0 to FResponseQueue.Count - 1 do
- begin
- LItem := FResponseQueue[I];
- if (LItem <> nil) then
- begin
- LCallbacks[I] := LItem.Callback;
- LItem.Request := nil;
- LItem.Response := nil;
- LItem.Source := nil;
- LItem.Callback := nil;
- end;
- end;
-
- FResponseQueue.Clear;
-
- // 触发所有被丢弃的 callback (通知失败)
- for I := 0 to High(LCallbacks) do
- if Assigned(LCallbacks[I]) then
- LCallbacks[I](Self, False);
-end;
-
-procedure TCrossHttpConnection._QueueResponseReady(
- const AItem: IHttpResponseQueueItem;
- const ASource: TCrossHttpChunkDataFunc;
- const ACallback: TCrossConnectionCallback);
-var
- LAlreadyReadyOrCompleted: Boolean;
- LItemToSend: IHttpResponseQueueItem;
-begin
- if (AItem = nil) then
- begin
- if Assigned(ACallback) then
- ACallback(Self, False);
- Exit;
- end;
-
- LAlreadyReadyOrCompleted := False;
- LItemToSend := nil;
-
- // 单次锁块完成 "标记 ready" 与 "尝试 take 队首" 两件事
- // 减少 happy path 上的锁/解锁次数, 降低高并发竞争开销
- FResponseQueueLock.Enter;
- try
- if AItem.Ready or AItem.Completed then
- begin
- // 同一个 item 不允许重复 ready, 不修改原有 Source/Callback
- LAlreadyReadyOrCompleted := True;
- end else
- begin
- AItem.Source := ASource;
- AItem.Callback := ACallback;
- AItem.KeepAlive := AItem.Request.KeepAlive;
- AItem.StatusCode := AItem.Response.StatusCode;
- AItem.Ready := True;
-
- // 没有正在发送时, 立即尝试取队首 ready item
- LItemToSend := _TryDequeueReadyLocked;
- end;
- finally
- FResponseQueueLock.Leave;
- end;
-
- if LAlreadyReadyOrCompleted then
- begin
- // 安全降级: 对重复传入的 callback 触发失败, 避免调用方静默挂起
- if Assigned(ACallback) then
- ACallback(Self, False);
- Exit;
- end;
-
- if (LItemToSend <> nil) then
- _SendQueueItem(LItemToSend);
-end;
-
-procedure TCrossHttpConnection._SendQueueItem(const AItem: IHttpResponseQueueItem);
-var
- LConnection: ICrossHttpConnection;
- LSender: TCrossConnectionCallback;
-begin
- LConnection := Self;
-
- LSender :=
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- var
- LData: Pointer;
- LCount: NativeInt;
- LSource: TCrossHttpChunkDataFunc;
- begin
- if not ASuccess then
- begin
- _FinishQueueItem(AItem, False);
- LConnection := nil;
- LSender := nil;
- Exit;
- end;
-
- LSource := AItem.Source;
- LData := nil;
- LCount := 0;
- if not Assigned(LSource)
- or not LSource(@LData, @LCount)
- or (LData = nil)
- or (LCount <= 0) then
- begin
- // StatusCode>=500 表示压缩/发送过程中发生了不可恢复的错误
- _FinishQueueItem(AItem, AItem.StatusCode < 500);
- LConnection := nil;
- LSender := nil;
- Exit;
- end;
-
- AConnection.SendBuf(LData^, LCount, LSender);
- end;
-
- LSender(LConnection, True);
-end;
-
-procedure TCrossHttpConnection._FinishQueueItem(
- const AItem: IHttpResponseQueueItem; const ASuccess: Boolean);
-var
- LRequest: ICrossHttpRequest;
- LResponse: ICrossHttpResponse;
- LCallback: TCrossConnectionCallback;
- LNeedDisconnect, LDoEnd: Boolean;
- LItemNext: IHttpResponseQueueItem;
-begin
- LDoEnd := False;
- LNeedDisconnect := False;
- LRequest := nil;
- LResponse := nil;
- LCallback := nil;
- LItemNext := nil;
-
- // 单次锁块完成 "标记 completed + 释放 sending 标志 + 尝试 take 下一个 ready item"
- // 三件事, 锁外再触发下一个 item 的发送, 避免两次进出锁的开销
- FResponseQueueLock.Enter;
- try
- // 先复位 FSendingResponse, 确保无论 AItem 是否已经 Completed 都不会挂起后续响应
- FSendingResponse := False;
- if not AItem.Completed then
- begin
- LRequest := AItem.Request;
- LResponse := AItem.Response;
- LCallback := AItem.Callback;
- LNeedDisconnect := ASuccess and ((not AItem.KeepAlive) or (AItem.StatusCode >= 500));
-
- AItem.Completed := True;
- LDoEnd := True;
-
- // 关键: 立即清空 item 对外部对象的接口引用, 打破循环引用导致的内存泄漏:
- // response.FQueueItem -> item.FResponse -> response (双向接口循环)
- // item.FSource -> 匿名方法 (captured Self=response) -> response (隐式循环)
- // 不在此处释放, 这些引用要等到 connection 释放才能解开, 而 connection
- // 又被 request.FConnection / response.FConnection 持有, 形成多重循环
- AItem.Request := nil;
- AItem.Response := nil;
- AItem.Source := nil;
- AItem.Callback := nil;
-
- // 仅在 happy path 下提前 take 下一个 item; 失败/disconnect 路径不取,
- // 让 connection 关闭流程清理剩余 queue
- if ASuccess and (not LNeedDisconnect) then
- LItemNext := _TryDequeueReadyLocked;
- end;
- finally
- FResponseQueueLock.Leave;
- end;
-
- if LDoEnd then
- begin
- // 不写 FRequest/FResponse 连接级字段, 这两个字段仅由 _OnParseBegin
- // 在 _LockRecv 内独占写入. 当前完成 item 的 request/response 通过
- // LRequest/LResponse 显式传给 DoOnRequestEnd, 进而传给 OnRequestEnd 事件,
- // 事件 handler 可直接从参数拿到精确对应的请求/响应, 不需要读连接字段
- AtomicDecrement(FPending);
-
- // 用户 callback 可能抛异常, 必须用 try/finally 保证 DoOnRequestEnd 触发
- try
- if Assigned(LCallback) then
- LCallback(Self, ASuccess);
- finally
- FServer.DoOnRequestEnd(Self, LRequest, LResponse, ASuccess);
- end;
- end;
-
- if (not ASuccess) or LNeedDisconnect then
- Disconnect
- else if (LItemNext <> nil) then
- _SendQueueItem(LItemNext);
-end;
-
-procedure TCrossHttpConnection._OnBodyBegin;
-var
- LMultiPart: THttpMultiPartFormData;
-begin
- {$region '创建Body'}
- case FRequestObj.GetBodyType of
- btMultiPart:
- begin
- if (FServer.FStoragePath <> '') and not DirectoryExists(FServer.FStoragePath) then
- ForceDirectories(FServer.FStoragePath);
-
- LMultiPart := THttpMultiPartFormData.Create;
- LMultiPart.StoragePath := FServer.FStoragePath;
- LMultiPart.AutoDeleteFiles := FServer.FAutoDeleteFiles;
- LMultiPart.InitWithBoundary(FRequestObj.RequestBoundary);
- if (FRequestObj.FBody = FRequestObj.FRawBody) then
- FRequestObj.FBody := nil
- else
- FreeAndNil(FRequestObj.FBody);
- FreeAndNil(FRequestObj.FRawBody);
- FRequestObj.FBody := LMultiPart;
- end;
-
- btUrlEncoded, btBinary:
- begin
- // 二次校验: Parser 层可能未限制时由 Server 层兜底
- if (FServer.FMaxPostDataSize > 0) and (FRequestObj.FContentLength > FServer.FMaxPostDataSize) then
- begin
- _OnParseFailed(413, 'Request body too large.');
- Exit; // FBody 保持 nil, _OnBodyData/_OnBodyEnd 有 nil guard 安全跳过
- end;
- if (FRequestObj.FBody = FRequestObj.FRawBody) then
- FRequestObj.FBody := nil
- else
- FreeAndNil(FRequestObj.FBody);
- FreeAndNil(FRequestObj.FRawBody);
- FRequestObj.FRawBody := TMemoryStream.Create;
- FRequestObj.FBody := FRequestObj.FRawBody;
- end;
- end;
- {$endregion}
-end;
-
-procedure TCrossHttpConnection._OnBodyData(const ADataPtr: Pointer;
- const ADataSize: Integer);
-begin
- if (FRequestObj.FBody = nil) then Exit;
-
- Inc(FRequestObj.FPostDataSize, ADataSize);
-
- case FRequestObj.GetBodyType of
- btMultiPart:
- (FRequestObj.FBody as THttpMultiPartFormData).Decode(ADataPtr, ADataSize);
-
- btUrlEncoded, btBinary:
- if (FRequestObj.FRawBody <> nil) then
- FRequestObj.FRawBody.Write(ADataPtr^, ADataSize);
- end;
-end;
-
-procedure TCrossHttpConnection._OnBodyEnd;
-var
- LUrlEncodedStr: string;
- LUrlEncodedBody: TFormUrlEncoded;
-begin
- if (FRequestObj.FBody = nil) then Exit;
-
- case FRequestObj.GetBodyType of
- btUrlEncoded:
- begin
- if (FRequestObj.FRawBody = nil) then Exit;
-
- SetString(LUrlEncodedStr,
- MarshaledAString(FRequestObj.FRawBody.Memory),
- FRequestObj.FRawBody.Size);
- LUrlEncodedBody := TFormUrlEncoded.Create;
- if LUrlEncodedBody.Decode(LUrlEncodedStr) then
- begin
- if (FRequestObj.FBody = FRequestObj.FRawBody) then
- FRequestObj.FBody := nil
- else
- FreeAndNil(FRequestObj.FBody);
- FRequestObj.FBody := LUrlEncodedBody;
- FRequestObj.FRawBody.Position := 0;
- end else
- begin
- FreeAndNil(LUrlEncodedBody);
- // 如果按 UrlEncoded 方式解码失败, 则保留原始数据
- // 并将类型改为 btBinary
- FRequestObj.FBodyType := btBinary;
- FRequestObj.FBody := FRequestObj.FRawBody;
- FRequestObj.FRawBody.Position := 0;
- end;
- end;
-
- btBinary:
- if (FRequestObj.FRawBody <> nil) then
- FRequestObj.FRawBody.Position := 0;
- end;
-end;
-
-function TCrossHttpConnection._OnGetHeaderValue(const AHeaderName: string;
- out AHeaderValues: TArray): Boolean;
-begin
- Result := FRequest.Header.GetHeaderValues(AHeaderName, AHeaderValues);
-end;
-
-procedure TCrossHttpConnection._OnHeaderData(const ADataPtr: Pointer;
- const ADataSize: Integer);
-var
- LParsed: Boolean;
- LExpect: string;
-begin
- // ParseHeader 内部已用 try/except 将各类解析异常转为 Result := False,
- // 这里仍再加一层护栏, 防止以后修改 ParseHeader 时遗漏局部 try/except
- // 导致恶意/畸形请求的异常上抛到 LogicReceived 环外. 统一归一为 400 响应.
- try
- LParsed := (FRequest as TCrossHttpRequest).ParseHeader(ADataPtr, ADataSize);
- except
- LParsed := False;
- end;
-
- if not LParsed then
- begin
- _OnParseFailed(400, 'Invalid request header.');
- Abort;
- end;
-
- // RFC 7231 §5.1.1: Expect: 100-continue 支持
- //
- // 协议流程:
- // 客户端发送 header (含 Expect: 100-continue) →
- // 服务器在此处发送 100 Continue (临时响应, 不走响应队列) →
- // Parser 继续接收 body (_OnBodyBegin → _OnBodyData → _OnBodyEnd) →
- // _OnParseSuccess → DoOnRequest 正常处理路由/中间件 →
- // 最终发送正式响应 (200/404/500 等)
- //
- // 注意:
- // 100 Continue 只是一个协议层 "请继续" 信号, 不代表服务器接受该请求.
- // 当前实现不在此阶段做认证/校验, 意味着即使后续 DoOnRequest 返回 401,
- // 客户端也已发送完整 body. 对于大多数客户端, 不带 Expect 头时的行为
- // 也是如此 (body 总会随 header 一起发送), 所以无实际功能损失.
- // SendBuf 是非阻塞操作, 在 _LockRecv 内调用安全.
- LExpect := FRequest.Header[HEADER_EXPECT];
- if TStrUtils.SameText(LExpect.Trim, '100-continue') then
- Self.SendBuf(@CResponse100Continue[1], Length(CResponse100Continue), nil);
-end;
-
-procedure TCrossHttpConnection._OnParseBegin;
-var
- LItem: IHttpResponseQueueItem;
-begin
- // 本函数以及其它 HttpParser 回调均由 FHttpParser.Decode -> ParseRecvData ->
- // FServer.LogicReceived -> TCrossSocketBase.TriggerReceived 同步触发,
- // 调用链起点已由 TriggerReceived 加上 TCrossConnectionBase._LockRecv,
- // 所以这里不需要也不应该重复加锁
-
- // 为本次请求创建独立的 queue item, 队列顺序由解析顺序决定
- LItem := THttpResponseQueueItem.Create;
-
- FRequestObj := TCrossHttpRequest.Create(Self);
- FRequest := FRequestObj;
-
- // 创建响应对象, 显式绑定到 request 和 queue item, 确保异步发送时
- // 不依赖连接级 FRequest/FResponse 字段
- FResponseObj := TCrossHttpResponse.Create(Self, FRequest, LItem);
- FResponse := FResponseObj;
-
- LItem.Request := FRequest;
- LItem.Response := FResponse;
-
- FResponseQueueLock.Enter;
- try
- FResponseQueue.Add(LItem);
- finally
- FResponseQueueLock.Leave;
- end;
-
- AtomicIncrement(FPending);
-end;
-
-procedure TCrossHttpConnection._OnParseFailed(const ACode: Integer;
- const AError: string);
-begin
- if (FResponse <> nil) then
- FResponse.SendStatus(ACode, AError)
- else
- Close;
-end;
-
-procedure TCrossHttpConnection._OnParseSuccess;
-var
- LConnection: ICrossHttpConnection;
- LRequest: ICrossHttpRequest;
- LResponse: ICrossHttpResponse;
-begin
- LConnection := Self;
- // 这里是 _LockRecv 保护下的同步调用, FRequest/FResponse 此刻仍是
- // _OnParseBegin 刚写入的当前 parse item 的 request/response.
- // 显式捕获为局部接口引用的真正意义在于: 一旦后续业务释放锁
- // (如未来调整架构则业务可能在锁外运行) 或 _OnParseBegin 重新写入
- // 连接级字段, 本局部变量仍以接口引用计数保证当前请求/响应对象存活,
- // 不会读到错位对象。对象生命周期本质上由接口引用计数保证, 与锁无关
- LRequest := FRequest;
- LResponse := FResponse;
- FServer.DoOnRequestBegin(LConnection, LRequest, LResponse);
- FServer.DoOnRequest(LConnection, LRequest, LResponse);
-end;
-
-function IsRegEx(const APattern: string): Boolean; inline;
-begin
- Result := (APattern.IndexOfAny(REGEX_CHARS) >= 0);
-end;
-
-function IsWildcard(const APattern: string): Boolean; inline;
-begin
- Result := (APattern = WILDCARD_CHAR);
-end;
-
-function GetPatternType(const APattern: string): TRouteType; inline;
-begin
- // 通配符
- if IsWildcard(APattern) then
- Result := rtWildcard
- // 正则
- else if IsRegEx(APattern) then
- Result := rtRegex
- // 静态
- else
- Result := rtStatic;
-end;
-
-function CreateRouterRegEx(const APattern: string): IRegEx;
-var
- LPattern: string;
-begin
- LPattern := APattern;
- if (LPattern = '*') then
- LPattern := '.*';
-
- // 添加正则表达式的开始和结束锚点
- if not LPattern.StartsWith('^') then
- LPattern := '^' + LPattern;
- if not LPattern.EndsWith('$') then
- LPattern := LPattern + '$';
-
- Result := TRegEx.Create(LPattern);
- Result.Options := [roIgnoreCase];
-end;
-
-{ TRouter }
-
-procedure TRouter.AddRouterProc(const ARouterProc: TCrossHttpRouterProc);
-begin
- FLock.BeginWrite;
- try
- FRouterProcList.Add(ARouterProc);
- finally
- FLock.EndWrite;
- end;
-end;
-
-procedure TRouter.AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod);
-begin
- FLock.BeginWrite;
- try
- FRouterMethodList.Add(ARouterMethod);
- finally
- FLock.EndWrite;
- end;
-end;
-
-constructor TRouter.Create(const AMethodPattern: string);
-begin
- FMethodPattern := AMethodPattern;
- FRouteType := GetPatternType(AMethodPattern);
-
- FRouterProcList := TList.Create;
- FRouterMethodList := TList.Create;
- FLock := TReadWriteLock.Create;
-end;
-
-destructor TRouter.Destroy;
-begin
- FreeAndNil(FRouterProcList);
- FreeAndNil(FRouterMethodList);
-
- inherited;
-end;
-
-function TRouter.GetRouteType: TRouteType;
-begin
- Result := FRouteType;
-end;
-
-function TRouter.GetMethodPattern: string;
-begin
- Result := FMethodPattern;
-end;
-
-function TRouter.GetRegEx: IRegEx;
-begin
- Result := nil;
- if (FRouteType = rtRegex) then
- Result := CreateRouterRegEx(FMethodPattern);
-end;
-
-procedure TRouter.Execute(const ARequest: ICrossHttpRequest;
- const AResponse: ICrossHttpResponse; var AHandled: Boolean);
-var
- LRouterProcArr: TArray;
- LRouterMethodArr: TArray;
- LRouterProc: TCrossHttpRouterProc;
- LRouterMethod: TCrossHttpRouterMethod;
-begin
- FLock.BeginRead;
- try
- LRouterProcArr := FRouterProcList.ToArray;
- LRouterMethodArr := FRouterMethodList.ToArray;
- finally
- FLock.EndRead;
- end;
-
- for LRouterProc in LRouterProcArr do
- begin
- if Assigned(LRouterProc) then
- begin
- LRouterProc(ARequest, AResponse, AHandled);
- if AHandled or AResponse.Sent then Exit;
- end;
- end;
-
- for LRouterMethod in LRouterMethodArr do
- begin
- if Assigned(LRouterMethod) then
- begin
- LRouterMethod(ARequest, AResponse, AHandled);
- if AHandled or AResponse.Sent then Exit;
- end;
- end;
-end;
-
-{ TRouteSegment }
-
-constructor TRouteSegment.Create(const AOriginal, APattern: string;
- const AParams: TArray; ARouteType: TRouteType);
-begin
- inherited Create;
- FOriginal := AOriginal;
- FPattern := APattern;
- FParams := AParams;
- FRouteType := ARouteType;
-end;
-
-function TRouteSegment.RegexMatch(const ASegment: string; const ARequest: ICrossHttpRequest): Boolean;
-var
- I: Integer;
- LRegEx: IRegEx;
-begin
- Result := False;
-
- case FRouteType of
- rtRegex:
- begin
- LRegEx := CreateRouterRegEx(FPattern);
- if LRegEx <> nil then
- begin
- LRegEx.Subject := ASegment;
- Result := LRegEx.Match;
- if Result and Assigned(ARequest) then
- begin
- // 提取所有参数值
- for I := 0 to High(FParams) do
- ARequest.Params[FParams[I].Name] := LRegEx.Groups[I + 1];
- end;
- end;
- end;
- end;
-end;
-
-{ TRouteNode }
-
-constructor TRouteNode.Create(ARouteType: TRouteType; const ASegment: TRouteSegment);
-begin
- inherited Create;
-
- FRouteType := ARouteType;
- FSegment := ASegment;
- FStaticChildren := TObjectDictionary.Create([doOwnsValues]);
- FRegexChildren := TObjectList.Create(True);
-
- FStaticRouteMethodItems := TDictionary.Create;
- FRegexRouteMethodItems := TList.Create;
-end;
-
-destructor TRouteNode.Destroy;
-begin
- FreeAndNil(FSegment);
- FreeAndNil(FStaticChildren);
- FreeAndNil(FRegexChildren);
- FreeAndNil(FWildcardChild);
-
- FreeAndNil(FStaticRouteMethodItems);
- FreeAndNil(FRegexRouteMethodItems);
- FWildcardRouteMethodItem := nil;
-
- inherited;
-end;
-
-function TRouteNode.CreateChildNode(const ASegment: TRouteSegment): TRouteNode;
-begin
- case ASegment.RouteType of
- rtStatic:
- begin
- Result := TRouteNode.Create(rtStatic, ASegment);
- FStaticChildren.Add(ASegment.Original.ToLower, Result);
- end;
-
- rtRegex:
- begin
- Result := TRouteNode.Create(rtRegex, ASegment);
- FRegexChildren.Add(Result);
- end;
-
- rtWildcard:
- begin
- if FWildcardChild = nil then
- FWildcardChild := TRouteNode.Create(rtWildcard, ASegment);
- Result := FWildcardChild;
- end;
- else
- Result := nil;
- end;
-end;
-
-procedure TRouteNode.AddRouter(const AMethodPattern: string; const ARouter: IRouter);
-begin
- case ARouter.RouteType of
- rtStatic:
- FStaticRouteMethodItems.AddOrSetValue(AMethodPattern.ToLower, ARouter);
-
- rtRegex:
- FRegexRouteMethodItems.Add(ARouter);
-
- rtWildcard:
- FWildcardRouteMethodItem := ARouter;
- end;
-end;
-
-function TRouteNode.GetChildNode(const ASegment: string;
- const ARouteType: TRouteType; out ARouteNode: TRouteNode): Boolean;
-var
- LChild: TRouteNode;
-begin
- case ARouteType of
- rtStatic:
- begin
- Result := FStaticChildren.TryGetValue(ASegment.ToLower, ARouteNode)
- end;
-
- rtRegex:
- begin
- for LChild in FRegexChildren do
- begin
- if (LChild.Segment.Original = ASegment) then
- begin
- ARouteNode := LChild;
- Exit(True);
- end;
- end;
-
- Result := False;
- end;
-
- rtWildcard:
- begin
- ARouteNode := FWildcardChild;
- Result := (ARouteNode <> nil);
- end;
- else
- ARouteNode := nil;
- Result := False;
- end;
-end;
-
-function TRouteNode.GetRouter(const AMethodPattern: string;
- out ARouter: IRouter): Boolean;
-var
- I: Integer;
- LRouter: IRouter;
-begin
- Result := False;
-
- // 先尝试从静态方法路由中查找
- if FStaticRouteMethodItems.TryGetValue(AMethodPattern.ToLower, ARouter) then
- Exit(True);
-
- // 从正则方法路由中查找
- for I := 0 to FRegexRouteMethodItems.Count - 1 do
- begin
- LRouter := FRegexRouteMethodItems[I];
- if SameText(LRouter.MethodPattern, AMethodPattern) then
- begin
- ARouter := LRouter;
- Exit(True);
- end;
- end;
-
- // 从通配符方法路由中查找
- if (FWildcardRouteMethodItem <> nil) and IsWildcard(AMethodPattern) then
- begin
- ARouter := FWildcardRouteMethodItem;
- Exit(True);
- end;
-end;
-
-function TRouteNode.MatchRouter(const AMethod: string;
- out ARouter: IRouter): Boolean;
-var
- LRouter: IRouter;
- LRegEx: IRegEx;
-begin
- Result := False;
-
- // 优先从静态方法路由中查找
- if FStaticRouteMethodItems.TryGetValue(AMethod.ToLower, LRouter) then
- begin
- ARouter := LRouter;
- Exit(True);
- end;
-
- // 遍历所有正则方法路由项, 找到第一个匹配的
- for LRouter in FRegexRouteMethodItems do
- begin
- // 正则表达式方法使用局部匹配器, 避免并发请求共享匹配状态
- LRegEx := LRouter.RegEx;
- if (LRegEx <> nil) then
- begin
- LRegEx.Subject := AMethod;
- if LRegEx.Match then
- begin
- ARouter := LRouter;
- Exit(True);
- end;
- end;
- end;
-
- // 通配符
- if (FWildcardRouteMethodItem <> nil) then
- begin
- ARouter := FWildcardRouteMethodItem;
- Exit(True);
- end;
-end;
-
-function TRouteNode.RemoveRouter(const AMethodPattern: string): Boolean;
-var
- LLowerMethod: string;
- I: Integer;
- LRouter: IRouter;
-begin
- Result := False;
-
- // 先尝试从静态方法路由中删除
- LLowerMethod := AMethodPattern.ToLower;
- if FStaticRouteMethodItems.ContainsKey(LLowerMethod) then
- begin
- FStaticRouteMethodItems.Remove(LLowerMethod);
- Exit(True);
- end;
-
- // 从通配符方法路由删除
- if (FWildcardRouteMethodItem <> nil) and IsWildcard(AMethodPattern) then
- begin
- FWildcardRouteMethodItem := nil;
- Exit(True);
- end;
-
- // 遍历正则方法路由项, 删除匹配的路由
- for I := FRegexRouteMethodItems.Count - 1 downto 0 do
- begin
- LRouter := FRegexRouteMethodItems[I];
- if SameText(LRouter.MethodPattern, AMethodPattern) then
- begin
- FRegexRouteMethodItems.Delete(I);
- Exit(True);
- end;
- end;
-end;
-
-function TRouteNode.IsEmpty: Boolean;
-begin
- // 节点为空的条件: 没有子节点且没有路由处理函数
- Result := (FStaticChildren.Count = 0) and
- (FRegexChildren.Count = 0) and
- (FWildcardChild = nil) and
- (FStaticRouteMethodItems.Count = 0) and
- (FRegexRouteMethodItems.Count = 0) and
- (FWildcardRouteMethodItem = nil);
-end;
-
-{ TCrossHttpRouterTree }
-
-constructor TCrossHttpRouterTree.Create;
-begin
- inherited Create;
-
- FRoot := TRouteNode.Create(rtStatic, TRouteSegment.Create('', '', [], rtStatic));
- FLock := TReadWriteLock.Create;
-end;
-
-destructor TCrossHttpRouterTree.Destroy;
-begin
- FreeAndNil(FRoot);
-
- inherited;
-end;
-
-function TCrossHttpRouterTree.CreateSegment(const ASegment: string;
- const ARouteType: TRouteType): TRouteSegment;
-var
- LPattern: string;
- LParams: TArray;
-begin
- LPattern := ASegment;
- LParams := [];
-
- // 正则段需要处理参数
- if (ARouteType = rtRegex) then
- begin
- LPattern := ASegment;
- LParams := [];
- // 使用正则表达式匹配所有参数模式
- // 匹配 :param 和 :param(pattern) 格式
- // 可以在参数后面增加正则限定参数 :number(\d+), :word(\w+)
- LPattern := TRegEx.Replace(LPattern, ':(\w+)(?:\((.*?)\))?',
- function(const AMatch: TMatch): string
- var
- LParamName, LParamPattern: string;
- LParam: TRouteParam;
- begin
- if not AMatch.Success then Exit('');
-
- if (AMatch.Groups.Count > 1) then
- LParamName := AMatch.Groups[1].Value
- else
- LParamName := '';
- if (AMatch.Groups.Count > 2) then
- LParamPattern := AMatch.Groups[2].Value
- else
- LParamPattern := '';
-
- if (LParamPattern = '') or (LParamPattern = '*') then
- LParamPattern := '.*';
-
- Result := '(' + LParamPattern + ')';
-
- LParam.Name := LParamName;
- LParam.Pattern := LParamPattern;
- LParams := LParams + [LParam];
- end);
- end;
-
- Result := TRouteSegment.Create(ASegment, LPattern, LParams, ARouteType);
-end;
-
-class function TCrossHttpRouterTree.ParsePath(const APath: string): TArray;
-begin
- // 请求的是根路径, 无需拆分
- if (APath = '/') or (APath = '') then
- begin
- Result := [''];
- Exit;
- end;
-
- // 把请求路径按/拆分成多段
- Result := APath.Split(['/'], TStringSplitOptions.ExcludeEmpty);
- if (Result = nil) then
- Result := [''];
-end;
-
-procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern, APathPattern: string;
- const ARouter: IRouter);
-var
- LPathSegments: TArray;
-begin
- FLock.BeginWrite;
- try
- LPathSegments := ParsePath(APathPattern);
- AddRouterToNode(FRoot, LPathSegments, 0, AMethodPattern, ARouter);
- finally
- FLock.EndWrite;
- end;
-end;
-
-procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern,
- APathPattern: string; const ARouterProc: TCrossHttpRouterProc);
-var
- LRouter: IRouter;
-begin
- LRouter := GetRouter(AMethodPattern, APathPattern);
- LRouter.AddRouterProc(ARouterProc);
-end;
-
-procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern,
- APathPattern: string; const ARouterMethod: TCrossHttpRouterMethod);
-var
- LRouter: IRouter;
-begin
- LRouter := GetRouter(AMethodPattern, APathPattern);
- LRouter.AddRouterProc(ARouterMethod);
-end;
-
-procedure TCrossHttpRouterTree.AddRouterToNode(ANode: TRouteNode;
- const APathPatternSegments: TArray; AIndex: Integer; const AMethodPattern: string;
- const ARouter: IRouter);
-var
- LSegmentPattern: string;
- LRouteType: TRouteType;
- LRouteSegment: TRouteSegment;
- LChild: TRouteNode;
-begin
- if (AIndex > High(APathPatternSegments)) then
- begin
- // 到达路径末尾, 添加路由
- ANode.AddRouter(AMethodPattern, ARouter);
- Exit;
- end;
-
- LSegmentPattern := APathPatternSegments[AIndex];
- LRouteType := GetPatternType(LSegmentPattern);
-
- if not ANode.GetChildNode(LSegmentPattern, LRouteType, LChild) then
- begin
- LRouteSegment := CreateSegment(LSegmentPattern, LRouteType);
- LChild := ANode.CreateChildNode(LRouteSegment);
- end;
-
- AddRouterToNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
-end;
-
-function TCrossHttpRouterTree.GetRouter(const AMethodPattern,
- APathPattern: string; out ARouter: IRouter): Boolean;
-var
- LPathSegments: TArray;
-begin
- FLock.BeginRead;
- try
- LPathSegments := ParsePath(APathPattern);
- Result := GetRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern, ARouter);
- finally
- FLock.EndRead;
- end;
-end;
-
-function TCrossHttpRouterTree.GetRouter(const AMethodPattern,
- APathPattern: string): IRouter;
-var
- LPathSegments: TArray;
-begin
- FLock.BeginWrite;
- try
- LPathSegments := ParsePath(APathPattern);
- if not GetRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern, Result) then
- begin
- Result := TRouter.Create(AMethodPattern);
- AddRouterToNode(FRoot, LPathSegments, 0, AMethodPattern, Result);
- end;
- finally
- FLock.EndWrite;
- end;
-end;
-
-function TCrossHttpRouterTree.GetRouterFromNode(ANode: TRouteNode;
- const APathPatternSegments: TArray; AIndex: Integer;
- const AMethodPattern: string; out ARouter: IRouter): Boolean;
-var
- LSegmentPattern: string;
- LRouteType: TRouteType;
- LChild: TRouteNode;
- LFound: Boolean;
-begin
- Result := False;
-
- if (AIndex > High(APathPatternSegments)) then
- begin
- // 到达路径末尾, 查找该节点的路由
- Result := ANode.GetRouter(AMethodPattern, ARouter);
- Exit;
- end;
-
- LSegmentPattern := APathPatternSegments[AIndex];
- LRouteType := GetPatternType(LSegmentPattern);
-
- case LRouteType of
- rtStatic:
- // 从静态子节点中查找路由
- if ANode.StaticChildren.TryGetValue(LSegmentPattern.ToLower, LChild) then
- begin
- LFound := GetRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
- Result := Result or LFound;
- end;
-
- rtRegex:
- // 从正则子节点中查找路由
- for LChild in ANode.RegexChildren do
- begin
- if SameText(LChild.Segment.Original, LSegmentPattern) then
- begin
- LFound := GetRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
- Result := Result or LFound;
- if Result then Break;
- end;
- end;
-
- rtWildcard:
- // 从通配符子节点查找路由
- if (ANode.WildcardChild <> nil) then
- begin
- LFound := ANode.WildcardChild.GetRouter(AMethodPattern, ARouter);
- Result := Result or LFound;
- end;
- end;
-end;
-
-function TCrossHttpRouterTree.GetWildcardValue(
- const APathSegments: TArray; AIndex: Integer;
- const AQueryText: string): string;
-begin
- Result := string.Join('/', APathSegments, AIndex, Length(APathSegments) - AIndex);
- if (AQueryText <> '') then
- Result := Result + '?' + AQueryText;
-end;
-
-function TCrossHttpRouterTree.MatchRouterInNode(ANode: TRouteNode;
- const APathSegments: TArray; AIndex: Integer; const AMethod: string;
- const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean;
-var
- LSegment, LWildcardValue: string;
- LChild: TRouteNode;
-begin
- Result := False;
-
- if (AIndex > High(APathSegments)) then
- begin
- // 到达路径末尾, 查找匹配方法的路由
- Result := ANode.MatchRouter(AMethod, ARouter);
-
- // 尝试从通配符子节点查找路由
- if not Result and (ANode.WildcardChild <> nil) then
- begin
- Result := ANode.WildcardChild.MatchRouter(AMethod, ARouter);
- if Result then
- begin
- LWildcardValue := GetWildcardValue(APathSegments, AIndex, ARequest.QueryText);
- if Assigned(ARequest) then
- ARequest.Params[WILDCARD_CHAR] := LWildcardValue;
- end;
- end;
-
- Exit;
- end;
-
- LSegment := APathSegments[AIndex];
-
- // 1. 首先尝试精确匹配静态节点
- if ANode.StaticChildren.TryGetValue(LSegment.ToLower, LChild) then
- begin
- Result := MatchRouterInNode(LChild, APathSegments, AIndex + 1, AMethod,
- ARequest, ARouter);
- if Result then Exit;
- end;
-
- // 2. 尝试正则节点(支持多参数)
- for LChild in ANode.RegexChildren do
- begin
- if LChild.Segment.RegexMatch(LSegment, ARequest) then
- begin
- // 普通正则节点, 继续递归匹配
- Result := MatchRouterInNode(LChild, APathSegments, AIndex + 1, AMethod,
- ARequest, ARouter);
- if Result then Exit;
- end;
- end;
-
- // 3. 最后尝试通配符子节点(优先级最低)
- if (ANode.WildcardChild <> nil) then
- begin
- Result := ANode.WildcardChild.MatchRouter(AMethod, ARouter);
- if Result then
- begin
- LWildcardValue := GetWildcardValue(APathSegments, AIndex, ARequest.QueryText);
- if Assigned(ARequest) then
- ARequest.Params[WILDCARD_CHAR] := LWildcardValue;
-
- Exit;
- end;
- end;
-end;
-
-function TCrossHttpRouterTree.MatchRouter(const APathSegments: TArray;
- const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean;
-begin
- FLock.BeginRead;
- try
- if FRoot.IsEmpty then
- begin
- ARouter := nil;
- Exit(False);
- end;
-
- Result := MatchRouterInNode(FRoot, APathSegments, 0, ARequest.Method, ARequest, ARouter);
- finally
- FLock.EndRead;
- end;
-end;
-
-function TCrossHttpRouterTree.MatchRouter(const ARequest: ICrossHttpRequest;
- out ARouter: IRouter): Boolean;
-var
- LPathSegments: TArray;
-begin
- LPathSegments := ParsePath(ARequest.Path);
- Result := MatchRouter(LPathSegments, ARequest, ARouter);
-end;
-
-function TCrossHttpRouterTree.RemoveRouterFromNode(ANode: TRouteNode;
- const APathPatternSegments: TArray; AIndex: Integer; const AMethodPattern: string): Boolean;
-var
- LSegmentPattern, LLowerSegment: string;
- LRouteType: TRouteType;
- LChild: TRouteNode;
- LRemoved: Boolean;
- I: Integer;
-begin
- Result := False;
-
- if (AIndex > High(APathPatternSegments)) then
- begin
- // 到达路径末尾, 删除该节点的路由
- Result := ANode.RemoveRouter(AMethodPattern);
- Exit;
- end;
-
- LSegmentPattern := APathPatternSegments[AIndex];
- LRouteType := GetPatternType(LSegmentPattern);
- LLowerSegment := LSegmentPattern.ToLower;
-
- case LRouteType of
- rtStatic:
- // 从静态子节点中删除路由
- if ANode.StaticChildren.TryGetValue(LLowerSegment, LChild) then
- begin
- LRemoved := RemoveRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern);
-
- // 如果子节点变空, 删除它
- if LRemoved and LChild.IsEmpty then
- ANode.StaticChildren.Remove(LLowerSegment);
-
- Result := Result or LRemoved;
- end;
-
- rtRegex:
- // 从正则子节点中删除路由（逆序遍历，避免在迭代中修改集合）
- for I := ANode.RegexChildren.Count - 1 downto 0 do
- begin
- LChild := ANode.RegexChildren[I];
- if SameText(LChild.Segment.Original, LSegmentPattern) then
- begin
- LRemoved := RemoveRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern);
-
- // 如果子节点变空, 删除它
- if LRemoved and LChild.IsEmpty then
- ANode.RegexChildren.Delete(I);
-
- Result := Result or LRemoved;
- if Result then Break;
- end;
- end;
-
- rtWildcard:
- // 从通配符子节点删除路由
- if (ANode.WildcardChild <> nil) then
- begin
- LRemoved := ANode.WildcardChild.RemoveRouter(AMethodPattern);
-
- // 如果子节点变空, 删除它
- if LRemoved and ANode.WildcardChild.IsEmpty then
- FreeAndNil(ANode.FWildcardChild);
-
- Result := Result or LRemoved;
- end;
- end;
-end;
-
-procedure TCrossHttpRouterTree.RemoveRouter(const AMethodPattern, APathPattern: string);
-var
- LPathSegments: TArray;
-begin
- FLock.BeginWrite;
- try
- LPathSegments := ParsePath(APathPattern);
- RemoveRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern);
- finally
- FLock.EndWrite;
- end;
-end;
-
-procedure TCrossHttpRouterTree.Clear;
-begin
- FLock.BeginWrite;
- try
- FreeAndNil(FRoot);
- FRoot := TRouteNode.Create(rtStatic, TRouteSegment.Create('', '', [], rtStatic));
- finally
- FLock.EndWrite;
- end;
-end;
-
-{ TCrossHttpServer }
-
-function TCrossHttpServer.All(const APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Route('*', APath, ARouterProc);
-end;
-
-function TCrossHttpServer.All(const APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Route('*', APath, ARouterMethod);
-end;
-
-constructor TCrossHttpServer.Create(const AIoThreads: Integer; const ASsl: Boolean);
-begin
- inherited Create(AIoThreads, ASsl);
-
- FRouters := TCrossHttpRouterTree.Create;
- FMiddlewares := TCrossHttpRouterTree.Create;
-
- Port := 80;
- Addr := '';
-
- FCompressible := True;
- FMinCompressSize := MIN_COMPRESS_SIZE;
- FMaxCompressRatio := DEFAULT_MAX_COMPRESS_RATIO;
- FStoragePath := TCrossHttpUtils.CombinePath(TUtils.AppPath, 'temp', PathDelim) + PathDelim;
- FSessionIDCookieName := SESSIONID_COOKIE_NAME;
-end;
-
-function TCrossHttpServer.CreateConnection(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
-begin
- Result := TCrossHttpConnection.Create(
- AOwner,
- AClientSocket,
- AConnectType,
- AHost,
- AConnectCb);
-end;
-
-destructor TCrossHttpServer.Destroy;
-begin
- Stop;
-
- FreeAndNil(FRouters);
- FreeAndNil(FMiddlewares);
-
- inherited Destroy;
-end;
-
-function TCrossHttpServer.Dir(const APath, ALocalDir: string): ICrossHttpServer;
-var
- LReqPath: string;
-begin
- LReqPath := APath;
- if not LReqPath.EndsWith('/') then
- LReqPath := LReqPath + '/';
- LReqPath := LReqPath + '*';
- Result := Get(LReqPath, TNetCrossRouter.Dir(APath, ALocalDir, '*'));
-end;
-
-function TCrossHttpServer.Delete(const APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Route('DELETE', APath, ARouterProc);
-end;
-
-function TCrossHttpServer.Delete(const APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Route('DELETE', APath, ARouterMethod);
-end;
-
-procedure TCrossHttpServer.DoOnRequestBegin(
- const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse);
-begin
- if Assigned(FOnRequestBegin) then
- FOnRequestBegin(Self, AConnection, ARequest, AResponse);
-end;
-
-procedure TCrossHttpServer.DoOnRequestEnd(
- const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
- const ASuccess: Boolean);
-begin
- if Assigned(FOnRequestEnd) then
- FOnRequestEnd(Self, AConnection, ARequest, AResponse, ASuccess);
-end;
-
-procedure TCrossHttpServer.DoOnRequest(const AConnection: ICrossHttpConnection;
- const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse);
-var
- LRequest: ICrossHttpRequest;
- LResponse: ICrossHttpResponse;
- LSessionID: string;
- LPathSegments: TArray;
- LHandled: Boolean;
- LRouter: IRouter;
-begin
- // 显式接收来自 _OnParseSuccess 的 request/response, 不再读取连接字段,
- // 避免与 _FinishQueueItem 等异步线程构成 race
- LRequest := ARequest;
- LResponse := AResponse;
- LHandled := False;
-
- try
- {$region 'Session'}
- if (FSessions <> nil) and (FSessionIDCookieName <> '') then
- begin
- LSessionID := LRequest.Cookies[FSessionIDCookieName];
- (LRequest as TCrossHttpRequest).FSession := FSessions.Sessions[LSessionID];
- if (LRequest.Session <> nil) and (LRequest.Session.SessionID <> LSessionID) then
- begin
- LSessionID := LRequest.Session.SessionID;
- LResponse.Cookies.AddOrSet(FSessionIDCookieName, LSessionID, 0);
- end;
- end;
- {$endregion}
-
- // 提前拆分请求路径, 可以减少一次 ParsePath 调用
- LPathSegments := TCrossHttpRouterTree.ParsePath(LRequest.Path);
-
- {$region '中间件'}
- // 执行匹配的中间件
- if FMiddlewares.MatchRouter(LPathSegments, LRequest, LRouter) then
- begin
- // 中间件通常用于请求的预处理
- // 所以默认将 LHandled 置为 False, 以保证后续路由能被执行
- // 除非用户在中间件中明确指定了 LHandled := True, 表明该请求无需后续路由响应了
- LHandled := False;
- LRouter.Execute(LRequest, LResponse, LHandled);
-
- // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
- if LHandled or LResponse.Sent then Exit;
- end;
- {$endregion}
-
- {$region '路由'}
- // 执行匹配的路由
- if FRouters.MatchRouter(LPathSegments, LRequest, LRouter) then
- begin
- // 路由用于响应请求
- // 所以默认将 LHandled 置为 True, 以保证不会有多个匹配的路由被执行
- // 除非用户在路由中明确指定了 LHandled := False, 表明该路由并没有
- // 完成请求响应, 还需要后续路由继续进行响应
- LHandled := True;
- LRouter.Execute(LRequest, LResponse, LHandled);
-
- // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
- if LHandled or LResponse.Sent then Exit;
- end;
- {$endregion}
-
- {$region '响应请求事件'}
- if Assigned(FOnRequest)
- and not (LHandled or LResponse.Sent) then
- begin
- FOnRequest(Self, AConnection, LRequest, LResponse, LHandled);
-
- // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
- if LHandled or LResponse.Sent then Exit;
- end;
- {$endregion}
-
- // 如果该请求没有被任何中间件、事件、路由响应, 返回 404
- if not (LHandled or LResponse.Sent) then
- LResponse.SendStatus(404);
- except
- on e: Exception do
- begin
- if Assigned(FOnRequestException) then
- FOnRequestException(Self, LRequest, LResponse, e)
- else if LResponse.Sent then
- AConnection.Disconnect
- else if (e is ECrossHttpException) then
- LResponse.SendStatus(ECrossHttpException(e).StatusCode, ECrossHttpException(e).Message)
- else
- LResponse.SendStatus(500, e.Message);
- end;
- end;
-end;
-
-function TCrossHttpServer.Get(const APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Route('GET', APath, ARouterProc);
-end;
-
-function TCrossHttpServer.Get(const APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Route('GET', APath, ARouterMethod);
-end;
-
-function TCrossHttpServer.GetOnRequestEnd: TCrossHttpRequestEndEvent;
-begin
- Result := FOnRequestEnd;
-end;
-
-function TCrossHttpServer.GetAutoDeleteFiles: Boolean;
-begin
- Result := FAutoDeleteFiles;
-end;
-
-function TCrossHttpServer.GetOnRequestBegin: TCrossHttpRequestBeginEvent;
-begin
- Result := FOnRequestBegin;
-end;
-
-function TCrossHttpServer.GetCompressible: Boolean;
-begin
- Result := FCompressible;
-end;
-
-function TCrossHttpServer.GetMaxHeaderSize: Int64;
-begin
- Result := FMaxHeaderSize;
-end;
-
-function TCrossHttpServer.GetMaxPostDataSize: Int64;
-begin
- Result := FMaxPostDataSize;
-end;
-
-function TCrossHttpServer.GetMaxCompressRatio: Integer;
-begin
- Result := FMaxCompressRatio;
-end;
-
-function TCrossHttpServer.GetMinCompressSize: Int64;
-begin
- Result := FMinCompressSize;
-end;
-
-function TCrossHttpServer.GetOnRequest: TCrossHttpRequestEvent;
-begin
- Result := FOnRequest;
-end;
-
-function TCrossHttpServer.GetOnRequestException: TCrossHttpRequestExceptionEvent;
-begin
- Result := FOnRequestException;
-end;
-
-function TCrossHttpServer.GetSessionIDCookieName: string;
-begin
- Result := FSessionIDCookieName;
-end;
-
-function TCrossHttpServer.GetSessions: ISessions;
-begin
- Result := FSessions;
-end;
-
-function TCrossHttpServer.GetStoragePath: string;
-begin
- Result := FStoragePath;
-end;
-
-procedure TCrossHttpServer.SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
-begin
- FOnRequestEnd := Value;
-end;
-
-procedure TCrossHttpServer.SetAutoDeleteFiles(const Value: Boolean);
-begin
- FAutoDeleteFiles := Value;
-end;
-
-procedure TCrossHttpServer.SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
-begin
- FOnRequestBegin := Value;
-end;
-
-procedure TCrossHttpServer.SetCompressible(const Value: Boolean);
-begin
- FCompressible := Value;
-end;
-
-procedure TCrossHttpServer.SetMaxHeaderSize(const Value: Int64);
-begin
- FMaxHeaderSize := Value;
-end;
-
-procedure TCrossHttpServer.SetMaxPostDataSize(const Value: Int64);
-begin
- FMaxPostDataSize := Value;
-end;
-
-procedure TCrossHttpServer.SetMaxCompressRatio(const Value: Integer);
-begin
- FMaxCompressRatio := Value;
-end;
-
-procedure TCrossHttpServer.SetMinCompressSize(const Value: Int64);
-begin
- FMinCompressSize := Value;
-end;
-
-procedure TCrossHttpServer.SetOnRequest(const Value: TCrossHttpRequestEvent);
-begin
- FOnRequest := Value;
-end;
-
-procedure TCrossHttpServer.SetOnRequestException(
- const Value: TCrossHttpRequestExceptionEvent);
-begin
- FOnRequestException := Value;
-end;
-
-procedure TCrossHttpServer.SetSessionIDCookieName(const Value: string);
-begin
- FSessionIDCookieName := Value;
-end;
-
-procedure TCrossHttpServer.SetSessions(const Value: ISessions);
-begin
- FSessions := Value;
-end;
-
-procedure TCrossHttpServer.SetStoragePath(const Value: string);
-begin
- FStoragePath := Value;
-end;
-
-function TCrossHttpServer.Static(const APath,
- ALocalStaticDir: string): ICrossHttpServer;
-var
- LReqPath: string;
-begin
- LReqPath := APath;
- if not LReqPath.EndsWith('/') then
- LReqPath := LReqPath + '/';
- LReqPath := LReqPath + '*';
- Result := Get(LReqPath, TNetCrossRouter.Static(ALocalStaticDir, '*'));
-end;
-
-function TCrossHttpServer.Index(const APath, ALocalDir: string;
- const ADefIndexFiles: TArray): ICrossHttpServer;
-var
- LReqPath: string;
-begin
- LReqPath := APath;
- if not LReqPath.EndsWith('/') then
- LReqPath := LReqPath + '/';
- LReqPath := LReqPath + '*';
- Result := Get(LReqPath, TNetCrossRouter.Index(ALocalDir, '*', ADefIndexFiles));
-end;
-
-function TCrossHttpServer.Post(const APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Route('POST', APath, ARouterProc);
-end;
-
-function TCrossHttpServer.Post(const APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Route('POST', APath, ARouterMethod);
-end;
-
-function TCrossHttpServer.Put(const APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Route('PUT', APath, ARouterMethod);
-end;
-
-function TCrossHttpServer.Put(const APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Route('PUT', APath, ARouterProc);
-end;
-
-function TCrossHttpServer.Route(const AMethod, APath: string;
- const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- FRouters.AddRouter(AMethod, APath, ARouterProc);
- Result := Self;
-end;
-
-function TCrossHttpServer.Route(const AMethod, APath: string;
- const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- FRouters.AddRouter(AMethod, APath, ARouterMethod);
- Result := Self;
-end;
-
-function TCrossHttpServer.RemoveMiddleware(const AMethod,
- APath: string): ICrossHttpServer;
-begin
- FMiddlewares.RemoveRouter(AMethod, APath);
- Result := Self;
-end;
-
-function TCrossHttpServer.RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
-begin
- FRouters.RemoveRouter(AMethod, APath);
- Result := Self;
-end;
-
-function TCrossHttpServer.ClearMiddlewares: ICrossHttpServer;
-begin
- FMiddlewares.Clear;
- Result := Self;
-end;
-
-function TCrossHttpServer.ClearRouters: ICrossHttpServer;
-begin
- FRouters.Clear;
- Result := Self;
-end;
-
-procedure TCrossHttpServer.LogicReceived(const AConnection: ICrossConnection;
- const ABuf: Pointer; const ALen: Integer);
-var
- LConnObj: TCrossHttpConnection;
- LBuf: Pointer;
- LLen: Integer;
-begin
- LConnObj := AConnection as TCrossHttpConnection;
- LBuf := ABuf;
- LLen := ALen;
-
- while (LLen > 0) do
- LConnObj.ParseRecvData(LBuf, LLen);
-
- inherited LogicReceived(AConnection, ABuf, ALen);
-end;
-
-function TCrossHttpServer.Use(
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Use('*', '*', AMiddlewareMethod);
-end;
-
-function TCrossHttpServer.Use(
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Use('*', '*', AMiddlewareProc);
-end;
-
-function TCrossHttpServer.Use(const AMethod, APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- FMiddlewares.AddRouter(AMethod, APath, AMiddlewareMethod);
- Result := Self;
-end;
-
-function TCrossHttpServer.Use(const AMethod, APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- FMiddlewares.AddRouter(AMethod, APath, AMiddlewareProc);
- Result := Self;
-end;
-
-function TCrossHttpServer.Use(const APath: string;
- const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
-begin
- Result := Use('*', APath, AMiddlewareMethod);
-end;
-
-function TCrossHttpServer.Use(const APath: string;
- const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
-begin
- Result := Use('*', APath, AMiddlewareProc);
-end;
-
-{ TCrossHttpRequest }
-
-constructor TCrossHttpRequest.Create(const AConnection: TCrossHttpConnection);
-begin
- FConnectionObj := AConnection;
- FConnection := AConnection;
- FServer := FConnection.Owner as TCrossHttpServer;
-
- FHeader := THttpHeader.Create;
- FCookies := TRequestCookies.Create;
- FParams := THttpUrlParams.Create;
- FQuery := THttpUrlParams.Create;
-end;
-
-destructor TCrossHttpRequest.Destroy;
-begin
- FreeAndNil(FHeader);
- FreeAndNil(FCookies);
- FreeAndNil(FParams);
- FreeAndNil(FQuery);
- if (FBody = FRawBody) then
- FBody := nil
- else
- FreeAndNil(FBody);
- FreeAndNil(FRawBody);
-
- inherited;
-end;
-
-function TCrossHttpRequest.GetAccept: string;
-begin
- Result := FAccept;
-end;
-
-function TCrossHttpRequest.GetAcceptEncoding: string;
-begin
- Result := FAcceptEncoding;
-end;
-
-function TCrossHttpRequest.GetAcceptLanguage: string;
-begin
- Result := FAcceptLanguage;
-end;
-
-function TCrossHttpRequest.GetAuthorization: string;
-begin
- Result := FAuthorization;
-end;
-
-function TCrossHttpRequest.GetBody: TObject;
-begin
- Result := FBody;
-end;
-
-function TCrossHttpRequest.GetRawBody: TStream;
-begin
- Result := FRawBody;
-end;
-
-function TCrossHttpRequest.GetBodyType: TBodyType;
-begin
- Result := FBodyType;
-end;
-
-function TCrossHttpRequest.GetConnection: ICrossHttpConnection;
-begin
- Result := FConnection;
-end;
-
-function TCrossHttpRequest.GetContentEncoding: string;
-begin
- Result := FContentEncoding;
-end;
-
-function TCrossHttpRequest.GetContentLength: Int64;
-begin
- Result := FContentLength;
-end;
-
-function TCrossHttpRequest.GetContentType: string;
-begin
- Result := FContentType;
-end;
-
-function TCrossHttpRequest.GetCookies: TRequestCookies;
-begin
- Result := FCookies;
-end;
-
-function TCrossHttpRequest.GetHeader: THttpHeader;
-begin
- Result := FHeader;
-end;
-
-function TCrossHttpRequest.GetHostName: string;
-begin
- Result := FHostName;
-end;
-
-function TCrossHttpRequest.GetHostPort: Word;
-begin
- Result := FHostPort;
-end;
-
-function TCrossHttpRequest.GetIfModifiedSince: TDateTime;
-begin
- Result := FIfModifiedSince;
-end;
-
-function TCrossHttpRequest.GetIfNoneMatch: string;
-begin
- Result := FIfNoneMatch;
-end;
-
-function TCrossHttpRequest.GetIfRange: string;
-begin
- Result := FIfRange;
-end;
-
-function TCrossHttpRequest.GetIsChunked: Boolean;
-begin
- Result := FIsChunked;
-end;
-
-function TCrossHttpRequest.CalcIsChunked: Boolean;
-var
- LEncodings: TArray;
-begin
- // RFC 7230 §3.3.1: Transfer-Encoding 可以是逗号分隔列表, 最终编码为最后一个
- LEncodings := FTransferEncoding.Trim.Split([',']);
- if Length(LEncodings) > 0 then
- Result := TStrUtils.SameText(LEncodings[Length(LEncodings) - 1].Trim, 'chunked')
- else
- Result := False;
-end;
-
-function TCrossHttpRequest.GetIsMultiPartFormData: Boolean;
-begin
- Result := TStrUtils.SameText(FContentType, TMediaType.MULTIPART_FORM_DATA);
-end;
-
-function TCrossHttpRequest.GetIsUrlEncodedFormData: Boolean;
-begin
- Result := TStrUtils.SameText(FContentType, TMediaType.APPLICATION_FORM_URLENCODED_TYPE);
-end;
-
-function TCrossHttpRequest.GetKeepAlive: Boolean;
-begin
- Result := FKeepAlive;
-end;
-
-function TCrossHttpRequest.GetMethod: string;
-begin
- Result := FMethod;
-end;
-
-function TCrossHttpRequest.GetParams: THttpUrlParams;
-begin
- Result := FParams;
-end;
-
-function TCrossHttpRequest.GetQueryText: string;
-begin
- Result := FQueryText;
-end;
-
-function TCrossHttpRequest.GetPath: string;
-begin
- Result := FPath;
-end;
-
-function TCrossHttpRequest.GetPathAndQuery: string;
-begin
- Result := FPathAndQuery;
-end;
-
-function TCrossHttpRequest.GetPostDataSize: Int64;
-begin
- Result := FPostDataSize;
-end;
-
-function TCrossHttpRequest.GetQuery: THttpUrlParams;
-begin
- Result := FQuery;
-end;
-
-function TCrossHttpRequest.GetRange: string;
-begin
- Result := FRange;
-end;
-
-function TCrossHttpRequest.GetRawPathAndQuery: string;
-begin
- Result := FRawPathAndQuery;
-end;
-
-function TCrossHttpRequest.GetRawRequestText: string;
-begin
- Result := FRawRequestText;
-end;
-
-function TCrossHttpRequest.GetReferer: string;
-begin
- Result := FReferer;
-end;
-
-function TCrossHttpRequest.GetRequestBoundary: string;
-begin
- Result := FRequestBoundary;
-end;
-
-function TCrossHttpRequest.GetRequestCmdLine: string;
-begin
- Result := FRequestCmdLine;
-end;
-
-function TCrossHttpRequest.GetRequestConnection: string;
-begin
- Result := FRequestConnection;
-end;
-
-function TCrossHttpRequest.GetSession: ISession;
-begin
- Result := FSession;
-end;
-
-function TCrossHttpRequest.GetTransferEncoding: string;
-begin
- Result := FTransferEncoding;
-end;
-
-function TCrossHttpRequest.GetUserAgent: string;
-begin
- Result := FUserAgent;
-end;
-
-function TCrossHttpRequest.GetVersion: string;
-begin
- Result := FVersion;
-end;
-
-function TCrossHttpRequest.GetXForwardedFor: string;
-begin
- Result := FXForwardedFor;
-end;
-
-function TCrossHttpRequest.ParseHeader(const ADataPtr: Pointer;
- const ADataSize: Integer): Boolean;
-var
- LRequestHeader, LPortStr: string;
- LCookieValues, LCLValues: TArray;
- LFirstCL: string;
- I, J: Integer;
- LPortInt: Integer;
-begin
- Assert(Self <> nil, 'FRequest is nil');
-
- // 整体包一层 try/except 保证任何畸形输入都以 Result := False 返回,
- // 不会让异常上抛到 _OnHeaderData 环外. 常见调用点如:
- // - Substring/IndexOf 上的越界 (请求行过短、缺少空格等)
- // - LPortStr.ToInteger 遇到非数字时抛 EConvertError
- // - THttpHeader.Decode 内部异常
- // - FCookies.Decode 内部异常
- // 都被这里统一归为 400 Bad Request
- try
- SetString(FRawRequestText, MarshaledAString(ADataPtr), ADataSize);
-
- // 拒绝包含 NUL 字节的请求 (可能导致跨编译器字符串行为差异)
- if (FRawRequestText.IndexOf(#0) >= 0) then
- Exit(False);
-
- I := FRawRequestText.IndexOf(#13#10);
- // 第一行是请求命令行
- // GET /home?param=123 HTTP/1.1
- FRequestCmdLine := FRawRequestText.Substring(0, I);
- // 第二行起是请求头
- LRequestHeader := FRawRequestText.Substring(I + 2);
- // 解析请求头
- FHeader.Decode(LRequestHeader);
-
- // 请求行必须包含三段: METHOD SP PATH SP VERSION (RFC 7230 §3.1.1)
- // 任何一段为空都不合法, 否则会出现:
- // - FMethod=='' 导致路由匹配疑难
- // - FVersion 含错位片段 (如 "GET") 导致 _CreateHeader 输出伪 HTTP 状态行
- // 这里在拆分前先检查两个空格的位置严格递增, 三段均非空
- I := FRequestCmdLine.IndexOf(' ');
- if (I <= 0) then Exit(False);
- J := FRequestCmdLine.IndexOf(' ', I + 1);
- if (J <= I + 1) or (J >= FRequestCmdLine.Length - 1) then Exit(False);
-
- // 请求方法(GET, POST, PUT, DELETE...)
- FMethod := FRequestCmdLine.Substring(0, I).ToUpper;
-
- // 路径及参数(/home?param=123)
- FRawPathAndQuery := FRequestCmdLine.Substring(I + 1, J - I - 1);
-
- // 请求的HTTP版本(HTTP/1.1)
- FVersion := FRequestCmdLine.Substring(J + 1).ToUpper;
-
- // 解析?key1=value1&key2=value2参数
- J := FRawPathAndQuery.IndexOf('?');
- if (J < 0) then
- begin
- FRawPath := FRawPathAndQuery;
- FRawQueryText := '';
- FQueryText := '';
- end else
- begin
- FRawPath := FRawPathAndQuery.Substring(0, J);
- FRawQueryText := FRawPathAndQuery.Substring(J + 1);
- FQueryText := TCrossHttpUtils.UrlDecode(FRawQueryText);
- end;
-
- FPath := TCrossHttpUtils.UrlDecode(FRawPath);
- FPathAndQuery := FPath;
- if (FQueryText <> '') then
- FPathAndQuery := FPathAndQuery + '?' + FQueryText;
-
- FQuery.Decode(FRawQueryText);
-
- // HTTP协议版本
- if (FVersion = '') then
- FVersion := 'HTTP/1.0';
- if (FVersion = 'HTTP/1.0') then
- FHttpVerNum := 10
- else
- FHttpVerNum := 11;
- FKeepAlive := (FHttpVerNum = 11);
-
- FContentType := FHeader[HEADER_CONTENT_TYPE];
- FRequestBoundary := '';
- J := FContentType.IndexOf(';');
- if (J >= 0) then
- begin
- // RFC 2046: 分号前后允许有任意空白, 兼容 "; boundary=" 和 ";boundary=" 两种格式
- FRequestBoundary := FContentType.Substring(J + 1).Trim;
- if FRequestBoundary.StartsWith('boundary=', True) then
- FRequestBoundary := FRequestBoundary.Substring(9);
-
- FContentType := FContentType.Substring(0, J).Trim;
- end;
-
- // RFC 7230 §3.3.2: 多个 Content-Length 值不同时必须拒绝请求
- if FHeader.GetHeaderValues(HEADER_CONTENT_LENGTH, LCLValues) and (Length(LCLValues) > 0) then
- begin
- LFirstCL := LCLValues[0].Trim;
- for I := 1 to High(LCLValues) do
- if not TStrUtils.SameText(LCLValues[I].Trim, LFirstCL) then
- Exit(False);
- FContentLength := StrToInt64Def(LFirstCL, -1);
- end else
- FContentLength := -1;
-
- // IPv4: 192.168.1.100:8080
- // 192.168.1.100
- // IPv6: [fc00::20:80:5:2]:8080
- // [fc00::20:80:5:2]
- FRequestHost := FHeader[HEADER_HOST];
- LPortStr := '';
-
- J := FRequestHost.IndexOf(']');
- if (J >= 0) then
- begin
- FHostName := FRequestHost.Substring(1, J - 1);
- J := FRequestHost.IndexOf(':', J);
- if (J >= 0) then
- LPortStr := FRequestHost.Substring(J + 1);
- end else
- begin
- J := FRequestHost.IndexOf(':');
- if (J >= 0) then
- begin
- FHostName := FRequestHost.Substring(0, J);
- LPortStr := FRequestHost.Substring(J + 1);
- end else
- FHostName := FRequestHost;
- end;
- // RFC 7230 §5.4: Host 头中 port 必须是十进制数字. 这里用 TryStrToInt
- // 避免 ToInteger 在畸形输入 (如 "abc"、超出 Int32 范围) 时抛 EConvertError;
- // 超出 Word (0..65535) 范围亦视为非法 port, 不静默截断高位
- if (LPortStr <> '') then
- begin
- if not TryStrToInt(LPortStr, LPortInt)
- or (LPortInt < 0) or (LPortInt > High(Word)) then
- Exit(False);
- FHostPort := Word(LPortInt);
- end else
- FHostPort := GetConnection.Server.Port;
-
- FRequestConnection := FHeader[HEADER_CONNECTION];
- // HTTP/1.0 默认KeepAlive=False，只有显示指定了Connection: keep-alive才认为KeepAlive=True
- // HTTP/1.1 默认KeepAlive=True，只有显示指定了Connection: close才认为KeepAlive=False
- if FHttpVerNum = 10 then
- FKeepAlive := TStrUtils.SameText(FRequestConnection, 'keep-alive')
- else if TStrUtils.SameText(FRequestConnection, 'close') then
- FKeepAlive := False;
-
- FTransferEncoding := FHeader[HEADER_TRANSFER_ENCODING];
- FIsChunked := CalcIsChunked;
- FContentEncoding := FHeader[HEADER_CONTENT_ENCODING];
- FAccept := FHeader[HEADER_ACCEPT];
- FReferer := FHeader[HEADER_REFERER];
- FAcceptLanguage := FHeader[HEADER_ACCEPT_LANGUAGE];
- FAcceptEncoding := FHeader[HEADER_ACCEPT_ENCODING];
- FUserAgent := FHeader[HEADER_USER_AGENT];
- FAuthorization := FHeader[HEADER_AUTHORIZATION];
- // 获取并解析 Cookie 头
- // RFC 6265 建议客户端只发送一个 Cookie 头
- // 但部分代理/旧客户端可能拆分成多行，按 RFC 7230 §3.2.2 合并处理
- if FHeader.GetHeaderValues(HEADER_COOKIE, LCookieValues)
- and (Length(LCookieValues) > 0) then
- begin
- // RFC 6265 建议客户端只发送一个 Cookie 头
- // 但部分代理/旧客户端可能拆分成多行，按 RFC 7230 §3.2.2 合并处理
- if (Length(LCookieValues) = 1) then
- FRequestCookies := LCookieValues[0]
- else
- FRequestCookies := string.Join('; ', LCookieValues);
- end else
- FRequestCookies := '';
- FIfModifiedSince := TCrossHttpUtils.RFC1123_StrToDate(FHeader[HEADER_IF_MODIFIED_SINCE]);
- FIfNoneMatch := FHeader[HEADER_IF_NONE_MATCH];
- FRange := FHeader[HEADER_RANGE];
- FIfRange := FHeader[HEADER_IF_RANGE];
- FXForwardedFor:= FHeader[HEADER_X_FORWARDED_FOR];
-
- // 解析Cookies
- if (FRequestCookies <> '') then
- begin
- if not FCookies.Decode(FRequestCookies, True) then Exit(False);
- end else
- FCookies.Clear;
-
- if IsMultiPartFormData then
- FBodyType := btMultiPart
- else if IsUrlEncodedFormData then
- FBodyType := btUrlEncoded
- else
- FBodyType := btBinary;
-
- Result := True;
- except
- // 任何解析异常都归一为 Result := False, 由 _OnHeaderData 发 400.
- // 不记详细错误原因 (不足类型安全且可能被恶意请求刷日志),
- // 需要调试时可临时加 Logger 输出.
- on Exception do
- Result := False;
- end;
-end;
-
-{ TCrossHttpResponse }
-
-constructor TCrossHttpResponse.Create(const AConnection: TCrossHttpConnection;
- const ARequest: ICrossHttpRequest;
- const AQueueItem: IHttpResponseQueueItem);
-begin
- FConnectionObj := AConnection;
- FConnection := AConnection;
- FRequest := ARequest;
- FQueueItem := AQueueItem;
- FHeader := THttpHeader.Create;
- FCookies := TResponseCookies.Create;
- FStatusCode := 200;
-end;
-
-destructor TCrossHttpResponse.Destroy;
-begin
- FreeAndNil(FHeader);
- FreeAndNil(FCookies);
- FQueueItem := nil;
- inherited;
-end;
-
-procedure TCrossHttpResponse.Download(const AFileName: string;
- const ACallback: TCrossConnectionCallback);
-begin
- Attachment(AFileName);
- SendFile(AFileName, ACallback);
-end;
-
-function TCrossHttpResponse.GetConnection: ICrossHttpConnection;
-begin
- Result := FConnection;
-end;
-
-function TCrossHttpResponse.GetContentType: string;
-begin
- Result := FHeader[HEADER_CONTENT_TYPE];
-end;
-
-function TCrossHttpResponse.GetCookies: TResponseCookies;
-begin
- Result := FCookies;
-end;
-
-function TCrossHttpResponse.GetHeader: THttpHeader;
-begin
- Result := FHeader;
-end;
-
-function TCrossHttpResponse.GetLocation: string;
-begin
- Result := FHeader[HEADER_LOCATION];
-end;
-
-function TCrossHttpResponse.GetRequest: ICrossHttpRequest;
-begin
- Result := FRequest;
-end;
-
-function TCrossHttpResponse.GetSent: Boolean;
-begin
- Result := (AtomicCmpExchange(FSendStatus, 0, 0) > 0);
-end;
-
-function TCrossHttpResponse.GetStatusCode: Integer;
-begin
- Result := FStatusCode;
-end;
-
-function TCrossHttpResponse.GetStatusText: string;
-begin
- Result := FStatusText;
-end;
-
-procedure TCrossHttpResponse.Json(const AJson: string;
- const ACallback: TCrossConnectionCallback);
-begin
- SetContentType(TMediaType.APPLICATION_JSON_UTF8);
- Send(AJson, ACallback);
-end;
-
-procedure TCrossHttpResponse.Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback);
-begin
- SetLocation(AUrl);
- SendStatus(302, '', ACallback);
-end;
-
-procedure TCrossHttpResponse.Reset;
-begin
- FSendStatus := 0;
- FStatusCode := 200;
- FHeader.Clear;
- FCookies.Clear;
-end;
-
-procedure TCrossHttpResponse.Attachment(const AFileName: string);
-begin
- if (GetContentType = '') then
- SetContentType(TCrossHttpUtils.GetFileMIMEType(AFileName));
- FHeader[HEADER_CONTENT_DISPOSITION] := 'attachment; filename="' +
- TCrossHttpUtils.UrlEncode(ExtractFileName(AFileName)) + '"';
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: Pointer; const ACount: NativeInt;
- const ACallback: TCrossConnectionCallback);
-var
- LCompressType: TCompressType;
-begin
- if _CheckCompress(ACount, LCompressType) then
- SendZCompress(ABody, ACount, LCompressType, ACallback)
- else
- SendNoCompress(ABody, ACount, ACallback);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody; const ACount: NativeInt;
- const ACallback: TCrossConnectionCallback);
-begin
- Send(@ABody, ACount, ACallback);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: TBytes;
- const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
- LOffset, LCount: NativeInt;
-begin
- // 增加其引用计数
- LBody := ABody;
-
- LOffset := AOffset;
- LCount := ACount;
- TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
-
- Send(Pointer(PByte(LBody) + LOffset), LCount,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- // 减少引用计数
- LBody := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: TBytes;
- const ACallback: TCrossConnectionCallback);
-begin
- Send(ABody, 0, Length(ABody), ACallback);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: TStream;
- const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback);
-var
- LCompressType: TCompressType;
-begin
- if (ABody <> nil) and _CheckCompress(ABody.Size, LCompressType) then
- SendZCompress(ABody, AOffset, ACount, LCompressType, ACallback)
- else
- SendNoCompress(ABody, AOffset, ACount, ACallback);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: TStream;
- const ACallback: TCrossConnectionCallback);
-begin
- Send(ABody, 0, 0, ACallback);
-end;
-
-procedure TCrossHttpResponse.Send(const ABody: string;
- const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
-begin
- LBody := TEncoding.UTF8.GetBytes(ABody);
- if (GetContentType = '') then
- SetContentType(TMediaType.TEXT_HTML_UTF8);
-
- Send(LBody, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(
- const AChunkSource: TCrossHttpChunkDataFunc;
- const ACallback: TCrossConnectionCallback);
-{
-HTTP头\r\n\r\n
-块尺寸\r\n
-块内容
-\r\n块尺寸\r\n
-块内容
-\r\n0\r\n\r\n
-}
-type
- TChunkState = (csHead, csBody, csDone);
-const
- CHUNK_END: array [0..6] of Byte = (13, 10, 48, 13, 10, 13, 10); // \r\n0\r\n\r\n
-var
- LHeaderBytes, LChunkHeader: TBytes;
- LChunked, LIsFirstChunk: Boolean;
- LChunkState: TChunkState;
- LChunkData: Pointer;
- LChunkSize: NativeInt;
-begin
- // 先取出第一个数据块
- // 如果有数据才需要使用 chunked 方式发送数据
- if Assigned(AChunkSource) then
- begin
- LChunked := AChunkSource(@LChunkData, @LChunkSize)
- and (LChunkData <> nil)
- and (LChunkSize > 0);
- end else
- LChunked := False;
-
- LIsFirstChunk := True;
- LChunkState := csHead;
-
- _Send(
- // HEADER
- function(const AData: PPointer; const ADataSize: PNativeInt): Boolean
- begin
- LHeaderBytes := _CreateHeader(0, LChunked);
-
- AData^ := @LHeaderBytes[0];
- ADataSize^ := Length(LHeaderBytes);
-
- Result := (ADataSize^ > 0);
- end,
- // BODY
- function(const AData: PPointer; const ADataSize: PNativeInt): Boolean
- begin
- if not LChunked then Exit(False);
-
- case LChunkState of
- csHead:
- begin
- if LIsFirstChunk then
- begin
- LIsFirstChunk := False;
- LChunkHeader := [];
- end else
- begin
- LChunkData := nil;
- LChunkSize := 0;
- if not Assigned(AChunkSource)
- or not AChunkSource(@LChunkData, @LChunkSize)
- or (LChunkData = nil)
- or (LChunkSize <= 0) then
- begin
- LChunkState := csDone;
-
- AData^ := @CHUNK_END[0];
- ADataSize^ := Length(CHUNK_END);
-
- Result := (ADataSize^ > 0);
-
- Exit;
- end;
-
- LChunkHeader := [13, 10];
- end;
-
- // FPC编译器在Linux下有BUG(FPC 3.3.1)
- // 无法将函数返回的字节数组直接与其它字节数组使用加号拼接
- // 实际上使用加号拼接字节数组还有其它各种异常
- // 所以改用我的TArrayUtils.Concat进行拼接
- LChunkHeader := TArrayUtils.Concat([
- LChunkHeader,
- TEncoding.ASCII.GetBytes(IntToHex(LChunkSize, 0)),
- [13, 10]
- ]);
-
- LChunkState := csBody;
-
- AData^ := @LChunkHeader[0];
- ADataSize^ := Length(LChunkHeader);
-
- Result := (ADataSize^ > 0);
- end;
-
- csBody:
- begin
- LChunkState := csHead;
-
- AData^ := LChunkData;
- ADataSize^ := LChunkSize;
-
- Result := (ADataSize^ > 0);
- end;
-
- csDone:
- begin
- Result := False;
- end;
- else
- Result := False;
- end;
- end,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- LHeaderBytes := nil;
- LChunkHeader := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendFile(const AFileName: string;
- const ACallback: TCrossConnectionCallback);
-var
- LStream: TStream;
- LLastModified: TDateTime;
- LRequest: TCrossHttpRequest;
- LLastModifiedStr, LETag: string;
- LRangeStr: string;
- LRangeBegin, LRangeEnd, LOffset, LCount, LFileSize: Int64;
-begin
- if not FileExists(AFileName) then
- begin
- FHeader.Remove(HEADER_CONTENT_DISPOSITION);
- SendStatus(404, ACallback);
- Exit;
- end;
-
- if (GetContentType = '') then
- SetContentType(TCrossHttpUtils.GetFileMIMEType(AFileName));
-
- try
- // 根据请求头中的时间戳决定是否需要发送文件数据
- // 当请求头中的时间戳与文件时间一致时, 浏览器会自动从本地加载文件数据
- // 服务端无需发送文件数据
- LRequest := GetRequest as TCrossHttpRequest;
- LLastModified := TFileUtils.GetLastWriteTime(AFileName);
-
- if (LRequest.IfModifiedSince > 0) and (LRequest.IfModifiedSince >= (LLastModified - (1 / SecsPerDay))) then
- begin
- // 304不要带任何body数据, 否则部分浏览器会报告无效的RESPONSE
- SendStatus(304, '', ACallback);
- Exit;
- end;
-
- LLastModifiedStr := TCrossHttpUtils.RFC1123_DateToStr(LLastModified);
-
- LETag := '"' + TUtils.BytesToHex(THashMD5.GetHashBytes(
- ExtractFileName(AFileName) + LLastModifiedStr)) + '"';
- if (LRequest.IfNoneMatch = LETag) then
- begin
- // 304不要带任何body数据, 否则部分浏览器会报告无效的RESPONSE
- SendStatus(304, '', ACallback);
- Exit;
- end;
-
- LStream := TFileUtils.OpenRead(AFileName, fmShareDenyNone);
- except
- on e: Exception do
- begin
- FHeader.Remove(HEADER_CONTENT_DISPOSITION);
- SendStatus(404, TStrUtils.Format('%s, %s', [e.ClassName, e.Message]), ACallback);
- Exit;
- end;
- end;
-
- LFileSize := LStream.Size;
-
- // 在响应头中加入文件时间戳
- // 浏览器会根据该时间戳决定是否从本地缓存中直接加载数据
- FHeader[HEADER_LAST_MODIFIED] := LLastModifiedStr;
- FHeader[HEADER_ETAG] := LETag;
-
- // 告诉浏览器支持分块传输
- FHeader[HEADER_ACCEPT_RANGES] := 'bytes';
-
- // Range 请求处理 (RFC 7233 §3.1)
- // 仅当 Range 头存在且 If-Range 校验通过 (无 If-Range 或 If-Range == ETag) 时才走分块逻辑.
- // If-Range 不匹配时, RFC 7233 §3.2 要求回退为完整 200 响应.
- LRangeStr := LRequest.Range;
- if (LRangeStr <> '')
- and ((LRequest.IfRange = '') or (LRequest.IfRange = LETag)) then
- begin
- if not TCrossHttpUtils.ParseSingleByteRange(LRangeStr, LFileSize, LRangeBegin, LRangeEnd) then
- begin
- // 不可满足的 Range -> 416 Range Not Satisfiable (RFC 7233 §4.4)
- // 必须返回 Content-Range: bytes */ 告知客户端实际资源大小.
- FreeAndNil(LStream);
- FHeader.Remove(HEADER_CONTENT_DISPOSITION);
- FHeader[HEADER_CONTENT_RANGE] := TStrUtils.Format('bytes */%d', [LFileSize]);
- SendStatus(416, ACallback);
- Exit;
- end;
-
- LOffset := LRangeBegin;
- LCount := LRangeEnd - LRangeBegin + 1;
-
- // 返回分块信息
- // Content-Range: bytes -/
- FHeader[HEADER_CONTENT_RANGE] := TStrUtils.Format('bytes %d-%d/%d',
- [LRangeBegin, LRangeEnd, LFileSize]);
-
- // 断点续传需要返回206状态码, 而不是200
- FStatusCode := 206;
- end else
- begin
- LOffset := 0;
- LCount := LFileSize;
- end;
-
- // 206 Range 响应禁止压缩：Content-Range 描述的是原始字节偏移，
- // 压缩后字节与范围不对应，会导致断点续传客户端数据错乱 (RFC 7233)
- SendNoCompress(LStream, LOffset, LCount,
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- FreeAndNil(LStream);
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SetContentType(const Value: string);
-begin
- FHeader[HEADER_CONTENT_TYPE] := Value;
-end;
-
-procedure TCrossHttpResponse.SetLocation(const Value: string);
-begin
- FHeader[HEADER_LOCATION] := Value;
-end;
-
-procedure TCrossHttpResponse.SetStatusCode(Value: Integer);
-begin
- FStatusCode := Value;
-end;
-
-procedure TCrossHttpResponse.SetStatusText(const Value: string);
-begin
- FStatusText := Value;
-end;
-
-function TCrossHttpResponse._CheckCompress(const ABodySize: Int64;
- out ACompressType: TCompressType): Boolean;
-var
- LContType, LRequestAcceptEncoding, LEnc, LQPart: string;
- LServer: ICrossHttpServer;
- LEncodings: TArray;
- I, LQSep: Integer;
- LGzipQ, LDeflateQ, LBestQ: Double;
-begin
- LContType := GetContentType;
- LServer := GetConnection.Server;
-
- if Assigned(LServer)
- and LServer.Compressible
- and (ABodySize > 0)
- and ((LServer.MinCompressSize <= 0) or (ABodySize >= LServer.MinCompressSize))
- and ((Pos('text/', LContType.ToLower) > 0)
- or (Pos('application/json', LContType.ToLower) > 0)
- or (Pos('javascript', LContType.ToLower) > 0)
- or (Pos('xml', LContType.ToLower) > 0)
- ) then
- begin
- LRequestAcceptEncoding := GetRequest.AcceptEncoding;
-
- // 按 q-value 排序选最优编码 (RFC 7231 §5.3.4).
- // q 值越高优先级越高, 缺省 q=1.0; q=0 表示明确拒绝.
- LEncodings := LRequestAcceptEncoding.Split([',']);
- begin
- LGzipQ := 0;
- LDeflateQ := 0;
- for I := 0 to High(LEncodings) do
- begin
- LEnc := LEncodings[I].Trim;
- LQSep := LEnc.IndexOf(';');
- LBestQ := 1.0;
- if LQSep >= 0 then
- begin
- LQPart := LEnc.Substring(LQSep + 1).Trim.ToLower;
- LEnc := LEnc.Substring(0, LQSep).Trim;
- if LQPart.StartsWith('q=') then
- LBestQ := StrToFloatDef(Copy(LQPart, 3, MaxInt), 0);
- if LBestQ <= 0 then
- Continue;
- end;
- if TStrUtils.SameText(LEnc, 'gzip') and (LBestQ > LGzipQ) then
- LGzipQ := LBestQ
- else if TStrUtils.SameText(LEnc, 'deflate') and (LBestQ > LDeflateQ) then
- LDeflateQ := LBestQ;
- end;
- // 优先 gzip (服务器普遍偏好); 仅当 deflate q 严格更高时选 deflate
- if (LGzipQ > 0) and (LGzipQ >= LDeflateQ) then
- begin
- ACompressType := ctGZip;
- Exit(True);
- end;
- if LDeflateQ > 0 then
- begin
- ACompressType := ctDeflate;
- Exit(True);
- end;
- end;
- end;
-
- ACompressType := ctNone;
- Result := False;
-end;
-
-function TCrossHttpResponse._GetMemoryStreamPointer(const AStream: TStream;
- const AOffset, ACount: Int64; out P: PByte; out LSize: Int64): Boolean;
-begin
- if (AStream is TCustomMemoryStream) then
- begin
- P := PByte(TCustomMemoryStream(AStream).Memory) + AOffset;
- LSize := ACount;
- Exit(True);
- end;
- Result := False;
-end;
-
-function TCrossHttpResponse._CreateHeader(const ABodySize: Int64;
- AChunked: Boolean): TBytes;
-var
- LHeaderStr, LStatusText, LHttpVersion: string;
- LCookie: TResponseCookie;
-begin
- if (GetContentType = '') then
- SetContentType(TMediaType.APPLICATION_OCTET_STREAM);
- if (FHeader[HEADER_CONNECTION] = '') then
- begin
- if (FStatusCode >= 400) or (not FRequest.KeepAlive) then
- FHeader[HEADER_CONNECTION] := 'close'
- else
- FHeader[HEADER_CONNECTION] := 'keep-alive';
- end;
-
- if (FStatusCode = 204) or (FStatusCode = 304) then
- begin
- FHeader.Remove(HEADER_CONTENT_LENGTH);
- FHeader.Remove(HEADER_TRANSFER_ENCODING);
- end
- else if AChunked then
- begin
- FHeader[HEADER_TRANSFER_ENCODING] := 'chunked';
- FHeader.Remove(HEADER_CONTENT_LENGTH);
- end else
- begin
- FHeader[HEADER_CONTENT_LENGTH] := ABodySize.ToString;
- FHeader.Remove(HEADER_TRANSFER_ENCODING);
- end;
-
- if (FHeader[HEADER_CROSS_HTTP_SERVER] = '') then
- FHeader[HEADER_CROSS_HTTP_SERVER] := CROSS_HTTP_SERVER_NAME;
-
- if (FStatusText <> '') then
- begin
- if TCrossHttpUtils.IsValidHeaderValue(FStatusText) then
- LStatusText := FStatusText
- else
- begin
- _Log('_CreateHeader: FStatusText contains invalid chars, falling back to default');
- LStatusText := TCrossHttpUtils.GetHttpStatusText(FStatusCode);
- end;
- end else
- LStatusText := TCrossHttpUtils.GetHttpStatusText(FStatusCode);
-
- // Parser 在 psHeader 阶段早失败时, ParseHeader 尚未运行, FRequest.Version 为空.
- // 必须回退到 'HTTP/1.1', 否则状态行成 ' 400 Bad Request' (缺版本前缀, 客户端无法识别).
- LHttpVersion := FRequest.Version;
- if (LHttpVersion = '') then
- LHttpVersion := 'HTTP/1.1';
- LHeaderStr := LHttpVersion + ' ' + FStatusCode.ToString + ' ' +
- LStatusText + #13#10;
-
- for LCookie in FCookies do
- begin
- try
- LHeaderStr := LHeaderStr + HEADER_SETCOOKIE + ': ' + LCookie.Encode + #13#10;
- except
- on E: Exception do
- begin
- _Log('TCrossHttpResponse._CreateHeader: skip invalid cookie: %s', [E.Message]);
- Continue;
- end;
- end;
- end;
-
- LHeaderStr := LHeaderStr + FHeader.Encode;
-
- Result := TEncoding.ASCII.GetBytes(LHeaderStr);
-end;
-
-procedure TCrossHttpResponse._Send(const ASource: TCrossHttpChunkDataFunc;
- const ACallback: TCrossConnectionCallback);
-begin
- // 用 AtomicCmpExchange 抢首次发送权限: 如果已有 Send 调用, 直接拒绝.
- // 防止两个 Send 之间的 Source/Callback 覆盖导致第一个 callback 永远不触发.
- if AtomicCmpExchange(FSendStatus, 1, 0) <> 0 then
- begin
- if Assigned(ACallback) then
- ACallback(FConnection, False);
- Exit;
- end;
-
- if (FConnectionObj = nil) or (FQueueItem = nil) then
- begin
- if Assigned(ACallback) then
- ACallback(FConnection, False);
- Exit;
- end;
-
- FConnectionObj._QueueResponseReady(FQueueItem, ASource, ACallback);
-end;
-
-procedure TCrossHttpResponse._Send(const AHeaderSource,
- ABodySource: TCrossHttpChunkDataFunc;
- const ACallback: TCrossConnectionCallback);
-var
- LHeaderDone: Boolean;
-begin
- // HEAD 请求不应包含响应体 (RFC 7231 §4.3.2)
- if (FRequest.Method = 'HEAD') then
- begin
- _Send(AHeaderSource, ACallback);
- Exit;
- end;
-
- LHeaderDone := False;
-
- _Send(
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- if not LHeaderDone then
- begin
- LHeaderDone := True;
- Result := Assigned(AHeaderSource) and AHeaderSource(AData, ACount);
- end else
- begin
- Result := Assigned(ABodySource) and ABodySource(AData, ACount);
- end;
- end,
- ACallback);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: Pointer;
- const ACount: NativeInt; const ACallback: TCrossConnectionCallback);
-{
-HTTP头\r\n\r\n
-内容
-}
-var
- P: PByte;
- LSize: NativeInt;
- LHeaderBytes: TBytes;
-begin
- P := ABody;
- LSize := ACount;
-
- _Send(
- // HEADER
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- LHeaderBytes := _CreateHeader(LSize, False);
-
- AData^ := @LHeaderBytes[0];
- ACount^ := Length(LHeaderBytes);
-
- Result := (ACount^ > 0);
- end,
- // BODY
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- AData^ := P;
- ACount^ := Min(LSize, SND_BUF_SIZE);
- Result := (ACount^ > 0);
-
- if (LSize > SND_BUF_SIZE) then
- begin
- Inc(P, SND_BUF_SIZE);
- Dec(LSize, SND_BUF_SIZE);
- end else
- begin
- LSize := 0;
- P := nil;
- end;
- end,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- LHeaderBytes := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody; const ACount: NativeInt;
- const ACallback: TCrossConnectionCallback);
-begin
- SendNoCompress(@ABody, ACount, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: TBytes;
- const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
- LOffset, LCount: NativeInt;
-begin
- // 增加其引用计数
- LBody := ABody;
-
- LOffset := AOffset;
- LCount := ACount;
- TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
-
- SendNoCompress(Pointer(PByte(LBody) + LOffset), LCount,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- // 减少引用计数
- LBody := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: TBytes;
- const ACallback: TCrossConnectionCallback);
-begin
- SendNoCompress(ABody, 0, Length(ABody), ACallback);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: TStream;
- const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback);
-var
- LOffset, LCount: Int64;
- LBody: TStream;
- LHeaderBytes, LBuffer: TBytes;
- LP: PByte;
- LSize: Int64;
-begin
- if (ABody = nil) then
- begin
- SendNoCompress(nil, 0, ACallback);
- Exit;
- end;
-
- LOffset := AOffset;
- LCount := ACount;
- TCrossHttpUtils.AdjustOffsetCount(ABody.Size, LOffset, LCount);
-
- if _GetMemoryStreamPointer(ABody, LOffset, LCount, LP, LSize) then
- begin
- SendNoCompress(LP^, LSize, ACallback);
- Exit;
- end;
-
- LBody := ABody;
- LBody.Position := LOffset;
-
- SetLength(LBuffer, SND_BUF_SIZE);
-
- _Send(
- // HEADER
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- LHeaderBytes := _CreateHeader(LCount, False);
-
- AData^ := @LHeaderBytes[0];
- ACount^ := Length(LHeaderBytes);
-
- Result := (ACount^ > 0);
- end,
- // BODY
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- if (LCount <= 0) then Exit(False);
-
- AData^ := @LBuffer[0];
- ACount^ := LBody.Read(LBuffer[0], Min(LCount, SND_BUF_SIZE));
-
- Result := (ACount^ > 0);
-
- if Result then
- Dec(LCount, ACount^);
- end,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- LHeaderBytes := nil;
- LBuffer := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: TStream;
- const ACallback: TCrossConnectionCallback);
-begin
- SendNoCompress(ABody, 0, 0, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendNoCompress(const ABody: string;
- const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
-begin
- LBody := TEncoding.UTF8.GetBytes(ABody);
- if (GetContentType = '') then
- SetContentType(TMediaType.TEXT_HTML_UTF8);
-
- SendNoCompress(LBody, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendStatus(const AStatusCode: Integer;
- const ADescription: string; const ACallback: TCrossConnectionCallback);
-begin
- SetStatusCode(AStatusCode);
- Send(ADescription, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendStatus(const AStatusCode: Integer;
- const ACallback: TCrossConnectionCallback);
-begin
- SendStatus(AStatusCode, TCrossHttpUtils.GetHttpStatusText(AStatusCode), ACallback);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(
- const AChunkSource: TCrossHttpChunkDataFunc;
- const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
-{
- 本方法实现了一边压缩一边发送数据, 所以可以支持无限大的分块数据的压缩发送,
- 而不用占用太多的内存和CPU
-
- zlib参考手册: http://www.zlib.net/zlib_how.html
-}
-var
- LZStream: TZStreamRec;
- LZFlush: Integer;
- LZResult: Integer;
- LOutSize: Integer;
- LBuffer: TBytes;
- LZError: Boolean;
-begin
- if (ACompressType = ctNone) then
- begin
- SendNoCompress(AChunkSource, ACallback);
- Exit;
- end;
-
- // 返回压缩方式
- FHeader[HEADER_CONTENT_ENCODING] := ZLIB_CONTENT_ENCODING[ACompressType];
-
- // 明确告知缓存服务器按照 Accept-Encoding 字段的内容, 分别缓存不同的版本
- FHeader[HEADER_VARY] := HEADER_ACCEPT_ENCODING;
-
- SetLength(LBuffer, SND_BUF_SIZE);
-
- FillChar(LZStream, SizeOf(TZStreamRec), 0);
- LZResult := Z_OK;
- LZFlush := Z_NO_FLUSH;
-
- if (deflateInit2(LZStream, Z_DEFAULT_COMPRESSION,
- Z_DEFLATED, ZLIB_WINDOW_BITS[ACompressType], 8, Z_DEFAULT_STRATEGY) <> Z_OK) then
- begin
- SetStatusCode(500);
- if (FQueueItem <> nil) then
- FQueueItem.StatusCode := 500;
- // 走正常队列流程: _Send → _QueueResponseReady → _SendQueueItem
- // → body 为空立即返回 False → _FinishQueueItem (配合 StatusCode>=500 触发 Disconnect) → ACallback 在锁外异步通知
- SendNoCompress(nil, 0, ACallback);
- Exit;
- end;
-
- LZError := False;
-
- SendNoCompress(
- // CHUNK
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- var
- LChunkData: Pointer;
- LChunkSize: NativeInt;
- begin
- repeat
- // 当 deflate(LZStream, Z_FINISH) 被调用后
- // 返回 Z_STREAM_END 表示所有数据处理完毕
- if (LZResult = Z_STREAM_END) then
- begin
- AData^ := nil;
- ACount^ := 0;
- Exit(False);
- end;
-
- // 输入缓冲区已经处理完毕
- // 需要填入新数据
- if (LZStream.avail_in = 0) then
- begin
- LChunkData := nil;
- LChunkSize := 0;
- if not Assigned(AChunkSource)
- or not AChunkSource(@LChunkData, @LChunkSize)
- or (LChunkData = nil)
- or (LChunkSize <= 0) then
- LZFlush := Z_FINISH // 如果没有后续数据了, 准备结束压缩
- else
- LZFlush := Z_NO_FLUSH;
-
- // 压缩数据输入缓冲区
- LZStream.avail_in := LChunkSize;
- LZStream.next_in := LChunkData;
- end;
-
- // 压缩数据输出缓冲区
- LZStream.avail_out := SND_BUF_SIZE;
- LZStream.next_out := @LBuffer[0];
-
- // 进行压缩处理
- // 输入缓冲区数据可以大于输出缓冲区
- // 这种情况可以多次调用 deflate 分批压缩,
- // 直到 avail_in=0 表示当前输入缓冲区数据已压缩完毕
- LZResult := deflate(LZStream, LZFlush);
-
- // 压缩出错之后直接结束
- // 这里也可能会返回 Z_STREAM_END(1)
- // 返回 Z_STREAM_END(1) 这一次还是有数据的
- // 所以要到下次 CHUNK 函数被调用的时候再结束
- if (LZResult < 0) then
- begin
- LZError := True; // 标记压缩错误，回调中将向调用方传递 False
- // 标记 500 以触发 _FinishQueueItem 中 LNeedDisconnect 断开连接
- if (FQueueItem <> nil) then
- FQueueItem.StatusCode := 500;
- AData^ := nil;
- ACount^ := 0;
- Exit(False);
- end;
-
- // 已压缩完成的数据大小
- LOutSize := SND_BUF_SIZE - LZStream.avail_out;
- until (LOutSize > 0);
-
- // 已压缩的数据
- AData^ := @LBuffer[0];
- ACount^ := LOutSize;
-
- Result := (ACount^ > 0);
- end,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- LBuffer := nil;
- deflateEnd(LZStream);
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess and not LZError);
- end);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: Pointer;
- const ACount: NativeInt; const ACompressType: TCompressType;
- const ACallback: TCrossConnectionCallback);
-var
- P: PByte;
- LSize: NativeInt;
-begin
- P := ABody;
- LSize := ACount;
-
- SendZCompress(
- // CHUNK
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- AData^ := P;
- ACount^ := Min(LSize, SND_BUF_SIZE);
- Result := (ACount^ > 0);
-
- if (LSize > SND_BUF_SIZE) then
- begin
- Inc(P, SND_BUF_SIZE);
- Dec(LSize, SND_BUF_SIZE);
- end else
- begin
- LSize := 0;
- P := nil;
- end;
- end,
- ACompressType,
- ACallback);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody; const ACount: NativeInt;
- const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
-begin
- SendZCompress(@ABody, ACount, ACompressType, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: TBytes;
- const AOffset, ACount: NativeInt; const ACompressType: TCompressType;
- const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
- LOffset, LCount: NativeInt;
-begin
- // 增加其引用计数
- LBody := ABody;
-
- LOffset := AOffset;
- LCount := ACount;
- TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
-
- SendZCompress(Pointer(PByte(LBody) + LOffset), LCount, ACompressType,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- // 减少引用计数
- LBody := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: TBytes;
- const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
-begin
- SendZCompress(ABody, 0, Length(ABody), ACompressType, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: TStream;
- const AOffset, ACount: Int64; const ACompressType: TCompressType;
- const ACallback: TCrossConnectionCallback);
-var
- LOffset, LCount: Int64;
- LBody: TStream;
- LBuffer: TBytes;
- LP: PByte;
- LSize: Int64;
-begin
- if (ABody = nil) then
- begin
- SendNoCompress(nil, 0, ACallback);
- Exit;
- end;
-
- LOffset := AOffset;
- LCount := ACount;
- TCrossHttpUtils.AdjustOffsetCount(ABody.Size, LOffset, LCount);
-
- if _GetMemoryStreamPointer(ABody, LOffset, LCount, LP, LSize) then
- begin
- SendZCompress(LP^, LSize, ACompressType, ACallback);
- Exit;
- end;
-
- LBody := ABody;
- LBody.Position := LOffset;
-
- SetLength(LBuffer, SND_BUF_SIZE);
-
- SendZCompress(
- // CHUNK
- function(const AData: PPointer; const ACount: PNativeInt): Boolean
- begin
- if (LCount <= 0) then Exit(False);
-
- ACount^ := LBody.Read(LBuffer[0], Min(LCount, SND_BUF_SIZE));
- AData^ := @LBuffer[0];
-
- Result := (ACount^ > 0);
-
- if Result then
- Dec(LCount, ACount^);
- end,
- ACompressType,
- // CALLBACK
- procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
- begin
- LBuffer := nil;
-
- if Assigned(ACallback) then
- ACallback(AConnection, ASuccess);
- end);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: TStream;
- const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
-begin
- SendZCompress(ABody, 0, 0, ACompressType, ACallback);
-end;
-
-procedure TCrossHttpResponse.SendZCompress(const ABody: string;
- const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
-var
- LBody: TBytes;
-begin
- LBody := TEncoding.UTF8.GetBytes(ABody);
- if (GetContentType = '') then
- SetContentType(TMediaType.TEXT_HTML_UTF8);
-
- SendZCompress(LBody, ACompressType, ACallback);
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossHttpServer;
+
+{$I zLib.inc}
+
+{
+ Linux下需要安装zlib1g-dev开发包
+ sudo apt-get install zlib1g-dev
+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Math,
+ Generics.Collections,
+ //ZLib,
+ {$IFDEF DELPHI}
+ ZLib,
+ {$ELSE}
+ DTF.StaticZLib,
+ {$ENDIF}
+
+ Net.SocketAPI,
+ Net.CrossSocket.Base,
+ Net.CrossSocket,
+ Net.CrossServer,
+ Net.CrossHttpParams,
+ Net.CrossHttpUtils,
+ Net.CrossHttpParser,
+
+ Utils.StrUtils,
+ Utils.IOUtils,
+ Utils.Hash,
+ Utils.RegEx,
+ Utils.SyncObjs,
+ Utils.ArrayUtils,
+ Utils.DateTime;
+
+const
+ CROSS_HTTP_SERVER_NAME = 'CrossHttpServer/3.0';
+ MIN_COMPRESS_SIZE = 512;
+ WILDCARD_CHAR = '*';
+ REGEX_CHARS: array of Char = [':', '*', '?', '(', ')', '[', '{', '|', '+', '.'];
+
+type
+ ECrossHttpException = class(Exception)
+ private
+ FStatusCode: Integer;
+ public
+ constructor Create(const AMessage: string; AStatusCode: Integer = 400); reintroduce; virtual;
+ constructor CreateFmt(const AMessage: string; const AArgs: array of const; AStatusCode: Integer = 400); reintroduce; virtual;
+ property StatusCode: Integer read FStatusCode write FStatusCode;
+ end;
+
+ ICrossHttpServer = interface;
+ ICrossHttpRequest = interface;
+ ICrossHttpResponse = interface;
+ IHttpResponseQueueItem = interface;
+
+ TCrossHttpServer = class;
+ TCrossHttpRequest = class;
+ TCrossHttpResponse = class;
+ THttpResponseQueueItem = class;
+
+ ///
+ /// HTTP连接接口
+ ///
+ ICrossHttpConnection = interface(ICrossServerConnection)
+ ['{72E9AC44-958C-4C6F-8769-02EA5EC3E9A8}']
+ function GetRequest: ICrossHttpRequest;
+ function GetResponse: ICrossHttpResponse;
+ function GetServer: ICrossHttpServer;
+ function GetPending: Integer;
+
+ ///
+ /// 请求对象
+ ///
+ property Request: ICrossHttpRequest read GetRequest;
+
+ ///
+ /// 响应对象
+ ///
+ property Response: ICrossHttpResponse read GetResponse;
+
+ ///
+ /// Server对象
+ ///
+ property Server: ICrossHttpServer read GetServer;
+
+ ///
+ /// 当前连接上"已开始解析但尚未完成响应"的请求数量
+ /// (含正在处理中的与已入队等待发送的)
+ ///
+ property Pending: Integer read GetPending;
+ end;
+
+ ///
+ /// 请求体类型
+ ///
+ TBodyType = (btNone, btUrlEncoded, btMultiPart, btBinary);
+
+ ///
+ /// HTTP请求接口
+ ///
+ ICrossHttpRequest = interface
+ ['{B26B7E7B-6B24-4D86-AB58-EBC20722CFDD}']
+ function GetConnection: ICrossHttpConnection;
+ function GetRawRequestText: string;
+ function GetRawPathAndQuery: string;
+ function GetMethod: string;
+ function GetPath: string;
+ function GetPathAndQuery: string;
+ function GetVersion: string;
+ function GetHeader: THttpHeader;
+ function GetCookies: TRequestCookies;
+ function GetSession: ISession;
+ function GetParams: THttpUrlParams;
+ function GetQuery: THttpUrlParams;
+ function GetQueryText: string;
+ function GetBody: TObject;
+ function GetRawBody: TStream;
+ function GetBodyType: TBodyType;
+ function GetKeepAlive: Boolean;
+ function GetAccept: string;
+ function GetAcceptEncoding: string;
+ function GetAcceptLanguage: string;
+ function GetReferer: string;
+ function GetUserAgent: string;
+ function GetIfModifiedSince: TDateTime;
+ function GetIfNoneMatch: string;
+ function GetRange: string;
+ function GetIfRange: string;
+ function GetAuthorization: string;
+ function GetXForwardedFor: string;
+ function GetContentLength: Int64;
+ function GetHostName: string;
+ function GetHostPort: Word;
+ function GetContentType: string;
+ function GetContentEncoding: string;
+ function GetRequestBoundary: string;
+ function GetRequestCmdLine: string;
+ function GetRequestConnection: string;
+ function GetTransferEncoding: string;
+ function GetIsChunked: Boolean;
+ function GetIsMultiPartFormData: Boolean;
+ function GetIsUrlEncodedFormData: Boolean;
+ function GetPostDataSize: Int64;
+
+ ///
+ /// HTTP连接对象
+ ///
+ property Connection: ICrossHttpConnection read GetConnection;
+
+ ///
+ /// 原始请求数据
+ ///
+ property RawRequestText: string read GetRawRequestText;
+
+ ///
+ /// 原始请求路径及参数
+ ///
+ property RawPathAndParams: string read GetRawPathAndQuery;
+
+ ///
+ /// 请求方法
+ ///
+ /// -
+ /// GET
+ ///
+ /// -
+ /// POST
+ ///
+ /// -
+ /// PUT
+ ///
+ /// -
+ /// DELETE
+ ///
+ /// -
+ /// HEAD
+ ///
+ /// -
+ /// OPTIONS
+ ///
+ /// -
+ /// TRACE
+ ///
+ /// -
+ /// CONNECT
+ ///
+ /// -
+ /// PATCH
+ ///
+ /// -
+ /// COPY
+ ///
+ /// -
+ /// LINK
+ ///
+ /// -
+ /// UNLINK
+ ///
+ /// -
+ /// PURGE
+ ///
+ /// -
+ /// LOCK
+ ///
+ /// -
+ /// UNLOCK
+ ///
+ /// -
+ /// PROPFIND
+ ///
+ ///
+ ///
+ property Method: string read GetMethod;
+
+ ///
+ ///
+ /// 请求路径, 不包含参数部分
+ ///
+ ///
+ /// 比如: /api/callapi1
+ ///
+ ///
+ property Path: string read GetPath;
+
+ ///
+ ///
+ /// 请求路径及参数
+ ///
+ ///
+ /// 比如: /api/callapi1?aaa=111&bbb=222
+ ///
+ ///
+ property PathAndQuery: string read GetPathAndQuery;
+
+ ///
+ /// 请求版本:
+ ///
+ /// -
+ /// HTTP/1.0
+ ///
+ /// -
+ /// HTTP/1.1
+ ///
+ ///
+ ///
+ property Version: string read GetVersion;
+
+ ///
+ /// HTTP请求头
+ ///
+ property Header: THttpHeader read GetHeader;
+
+ ///
+ /// 客户端传递过来的Cookies
+ ///
+ property Cookies: TRequestCookies read GetCookies;
+
+ ///
+ /// Session对象
+ ///
+ ///
+ ///
+ /// 只有在Server开启了Session支持的情况, 该属性才有效, 否则该属性为nil
+ ///
+ ///
+ /// 要开启Server的Session支持, 只需要设置Server.SessionIDCookieName不为空即可
+ ///
+ ///
+ property Session: ISession read GetSession;
+
+ ///
+ ///
+ /// 请求路径中定义的参数
+ ///
+ ///
+ /// 比如定义了一个Get('/echo/:text', cb) 然后有一个请求为 /echo/hello, 那么 Params
+ /// 中就会有一个名为 'text', 值为 'hello' 的参数
+ ///
+ ///
+ property Params: THttpUrlParams read GetParams;
+
+ ///
+ /// 请求路径后形如?key1=value1&key2=value2的参数
+ ///
+ property Query: THttpUrlParams read GetQuery;
+
+ ///
+ ///
+ /// 请求路径中定义的参数
+ ///
+ ///
+ property QueryText: string read GetQueryText;
+
+ ///
+ /// 解析后的Body数据, 通过检查BodyType可以知道数据类型:
+ ///
+ /// -
+ /// btNone(nil)
+ ///
+ /// -
+ /// btUrlEncoded(TFormUrlEncoded)
+ ///
+ /// -
+ /// btMultiPart(THttpMultiPartFormData)
+ ///
+ /// -
+ /// btBinary(TMemoryStream)
+ ///
+ ///
+ ///
+ property Body: TObject read GetBody;
+
+ ///
+ /// 原始Body数据流, 仅对btUrlEncoded和btBinary缓存; multipart/form-data返回nil
+ ///
+ ///
+ /// 调用方只读使用, 不负责释放
+ ///
+ property RawBody: TStream read GetRawBody;
+
+ ///
+ /// Body的类型,
+ ///
+ /// -
+ /// btNone(nil)
+ ///
+ /// -
+ /// btUrlEncoded(TFormUrlEncoded)
+ ///
+ /// -
+ /// btMultiPart(THttpMultiPartFormData)
+ ///
+ /// -
+ /// btBinary(TMemoryStream)
+ ///
+ ///
+ ///
+ property BodyType: TBodyType read GetBodyType;
+
+ ///
+ /// KeepAliv标志
+ ///
+ property KeepAlive: Boolean read GetKeepAlive;
+
+ ///
+ /// 客户端能接收的数据种类
+ ///
+ ///
+ /// image/webp,image/*,*/*;q=0.8
+ ///
+ property Accept: string read GetAccept;
+
+ ///
+ /// 客户端能接收的编码
+ ///
+ ///
+ /// gzip, deflate, sdch
+ ///
+ property AcceptEncoding: string read GetAcceptEncoding;
+
+ ///
+ /// 客户端能接收的语言
+ ///
+ ///
+ /// zh-CN,zh;q=0.8
+ ///
+ property AcceptLanguage: string read GetAcceptLanguage;
+
+ ///
+ /// 参考地址, 描述该请求由哪个页面发出
+ ///
+ property Referer: string read GetReferer;
+
+ ///
+ /// 用户代理
+ ///
+ ///
+ /// Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like
+ /// Gecko) Chrome/50.0.2661.102 Safari/537.36
+ ///
+ property UserAgent: string read GetUserAgent;
+
+ ///
+ /// 请求内容在浏览器端的缓存时间
+ ///
+ property IfModifiedSince: TDateTime read GetIfModifiedSince;
+
+ ///
+ /// 请求内容在浏览器端的标记
+ ///
+ property IfNoneMatch: string read GetIfNoneMatch;
+
+ ///
+ /// 请求分块传输
+ ///
+ property Range: string read GetRange;
+
+ ///
+ /// 请求分块传输时传往服务器的标记, 用于服务器比较数据是否已发生变化
+ ///
+ property IfRange: string read GetIfRange;
+
+ ///
+ /// 简单认证信息
+ ///
+ property Authorization: string read GetAuthorization;
+
+ ///
+ /// 通过HTTP代理或负载均衡方式连接到Web服务器的客户端最原始的IP地址的HTTP请求头字段
+ ///
+ property XForwardedFor: string read GetXForwardedFor;
+
+ ///
+ /// 请求数据长度
+ ///
+ property ContentLength: Int64 read GetContentLength;
+
+ ///
+ /// 请求的主机名(域名、IP)
+ ///
+ property HostName: string read GetHostName;
+
+ ///
+ /// 请求的主机端口
+ ///
+ property HostPort: Word read GetHostPort;
+
+ ///
+ /// 内容类型
+ ///
+ property ContentType: string read GetContentType;
+
+ ///
+ /// 请求命令行(也就是HTTP请求的第一行)
+ ///
+ property RequestCmdLine: string read GetRequestCmdLine;
+
+ ///
+ /// 请求分界符
+ ///
+ property RequestBoundary: string read GetRequestBoundary;
+
+ ///
+ /// 传输编码
+ ///
+ property TransferEncoding: string read GetTransferEncoding;
+
+ ///
+ /// 内容编码
+ ///
+ property ContentEncoding: string read GetContentEncoding;
+
+ ///
+ /// 连接方式
+ ///
+ property RequestConnection: string read GetRequestConnection;
+
+ ///
+ /// 请求数据是否使用块编码
+ ///
+ property IsChunked: Boolean read GetIsChunked;
+
+ ///
+ /// 请求数据是使用 multipart/form-data 方式提交的
+ ///
+ property IsMultiPartFormData: Boolean read GetIsMultiPartFormData;
+
+ ///
+ /// 请求数据是使用 application/x-www-form-urlencoded 方式提交的
+ ///
+ property IsUrlEncodedFormData: Boolean read GetIsUrlEncodedFormData;
+
+ ///
+ /// 请求数据大小
+ ///
+ property PostDataSize: Int64 read GetPostDataSize;
+ end;
+
+ ///
+ /// 提供块数据的匿名函数
+ ///
+ TCrossHttpChunkDataFunc = reference to function(const AData: PPointer; const ACount: PNativeInt): Boolean;
+
+ ///
+ /// HTTP响应队列项接口
+ /// 用于按请求解析顺序串行化每个连接上的响应发送, 避免 pipelining 响应交错
+ ///
+ IHttpResponseQueueItem = interface
+ ['{B03F35B7-6984-41A8-9AA0-6B3D48F18F91}']
+ function GetRequest: ICrossHttpRequest;
+ function GetResponse: ICrossHttpResponse;
+ function GetSource: TCrossHttpChunkDataFunc;
+ function GetCallback: TCrossConnectionCallback;
+ function GetReady: Boolean;
+ function GetSending: Boolean;
+ function GetCompleted: Boolean;
+ function GetKeepAlive: Boolean;
+ function GetStatusCode: Integer;
+
+ procedure SetRequest(const AValue: ICrossHttpRequest);
+ procedure SetResponse(const AValue: ICrossHttpResponse);
+ procedure SetSource(const AValue: TCrossHttpChunkDataFunc);
+ procedure SetCallback(const AValue: TCrossConnectionCallback);
+ procedure SetReady(const AValue: Boolean);
+ procedure SetSending(const AValue: Boolean);
+ procedure SetCompleted(const AValue: Boolean);
+ procedure SetKeepAlive(const AValue: Boolean);
+ procedure SetStatusCode(const AValue: Integer);
+
+ property Request: ICrossHttpRequest read GetRequest write SetRequest;
+ property Response: ICrossHttpResponse read GetResponse write SetResponse;
+ property Source: TCrossHttpChunkDataFunc read GetSource write SetSource;
+ property Callback: TCrossConnectionCallback read GetCallback write SetCallback;
+ property Ready: Boolean read GetReady write SetReady;
+ property Sending: Boolean read GetSending write SetSending;
+ property Completed: Boolean read GetCompleted write SetCompleted;
+ property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive;
+ property StatusCode: Integer read GetStatusCode write SetStatusCode;
+ end;
+
+ ///
+ /// HTTP响应队列项实现类
+ ///
+ THttpResponseQueueItem = class(TInterfacedObject, IHttpResponseQueueItem)
+ private
+ FRequest: ICrossHttpRequest;
+ FResponse: ICrossHttpResponse;
+ FSource: TCrossHttpChunkDataFunc;
+ FCallback: TCrossConnectionCallback;
+ FReady: Boolean;
+ FSending: Boolean;
+ FCompleted: Boolean;
+ FKeepAlive: Boolean;
+ FStatusCode: Integer;
+ protected
+ function GetRequest: ICrossHttpRequest;
+ function GetResponse: ICrossHttpResponse;
+ function GetSource: TCrossHttpChunkDataFunc;
+ function GetCallback: TCrossConnectionCallback;
+ function GetReady: Boolean;
+ function GetSending: Boolean;
+ function GetCompleted: Boolean;
+ function GetKeepAlive: Boolean;
+ function GetStatusCode: Integer;
+
+ procedure SetRequest(const AValue: ICrossHttpRequest);
+ procedure SetResponse(const AValue: ICrossHttpResponse);
+ procedure SetSource(const AValue: TCrossHttpChunkDataFunc);
+ procedure SetCallback(const AValue: TCrossConnectionCallback);
+ procedure SetReady(const AValue: Boolean);
+ procedure SetSending(const AValue: Boolean);
+ procedure SetCompleted(const AValue: Boolean);
+ procedure SetKeepAlive(const AValue: Boolean);
+ procedure SetStatusCode(const AValue: Integer);
+ end;
+
+ ///
+ /// HTTP应答接口
+ ///
+ ICrossHttpResponse = interface
+ ['{5E15C20F-E221-4B10-90FC-222173A6F3E8}']
+ function GetConnection: ICrossHttpConnection;
+ function GetRequest: ICrossHttpRequest;
+ function GetStatusCode: Integer;
+ function GetStatusText: string;
+ function GetContentType: string;
+ function GetLocation: string;
+ function GetHeader: THttpHeader;
+ function GetCookies: TResponseCookies;
+ function GetSent: Boolean;
+
+ procedure SetContentType(const Value: string);
+ procedure SetLocation(const Value: string);
+ procedure SetStatusCode(Value: Integer);
+ procedure SetStatusText(const Value: string);
+
+ ///
+ /// 重置数据
+ ///
+ procedure Reset;
+
+ ///
+ /// 压缩发送块数据
+ ///
+ ///
+ /// 产生块数据的匿名函数
+ /// // AData: 数据指针
+ /// // ACount: 数据大小
+ /// // Result: 如果返回True, 则发送数据; 如果返回False, 则忽略AData和ACount并结束发送
+ /// function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ /// begin
+ /// end
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 本方法实现了一边压缩一边发送数据, 所以可以支持无限大的分块数据的压缩发送, 而不用占用太多的内存和CPU
+ /// zlib参考手册:
+ ///
+ procedure SendZCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送无类型数据
+ ///
+ ///
+ /// 无类型数据
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendZCompress(const ABody; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendZCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendZCompress(const ABody: TBytes; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure SendZCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure SendZCompress(const ABody: TStream; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 压缩发送字符串数据
+ ///
+ ///
+ /// 字符串数据
+ ///
+ ///
+ /// 压缩方式
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendZCompress(const ABody: string; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送块数据
+ ///
+ ///
+ /// 产生块数据的匿名函数
+ /// // AData: 数据指针
+ /// // ACount: 数据大小
+ /// // Result: 如果返回True, 则发送数据; 如果返回False, 则忽略AData和ACount并结束发送
+ /// function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ /// begin
+ /// end
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 使用该方法可以一边生成数据一边发送, 无需等待数据全部准备完成
+ ///
+ procedure SendNoCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送无类型数据
+ ///
+ ///
+ /// 无类型数据
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendNoCompress(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendNoCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendNoCompress(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure SendNoCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure SendNoCompress(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 不压缩发送字符串数据
+ ///
+ ///
+ /// 字符串数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendNoCompress(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送无类型数据
+ ///
+ ///
+ /// 无类型数据
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Send(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Send(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送字节数据
+ ///
+ ///
+ /// 字节数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Send(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 偏移量
+ ///
+ ///
+ /// 数据大小
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure Send(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送流数据
+ ///
+ ///
+ /// 流数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 必须保证发送过程中流对象的有效性, 要释放流对象可以放到回调函数中进行
+ ///
+ procedure Send(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送字符串数据
+ ///
+ ///
+ /// 字符串数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Send(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送Json字符串数据
+ ///
+ ///
+ /// Json字符串数据
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Json(const AJson: string; const ACallback: TCrossConnectionCallback = nil);
+
+ ///
+ /// 发送文件内容
+ ///
+ ///
+ /// 文件名
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure SendFile(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
+
+ ///
+ /// 将文件以下载形式发送
+ ///
+ ///
+ /// 文件名
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Download(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
+
+ ///
+ /// 发送状态码
+ ///
+ ///
+ /// 状态码
+ ///
+ ///
+ /// 描述信息(body)
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 描述信息即是body数据, 如果设置为空, 则body也为空
+ ///
+ procedure SendStatus(const AStatusCode: Integer; const ADescription: string;
+ const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送状态码
+ ///
+ ///
+ /// 状态码
+ ///
+ ///
+ /// 回调函数
+ ///
+ ///
+ /// 该方法根据状态码生成默认的body数据
+ ///
+ procedure SendStatus(const AStatusCode: Integer;
+ const ACallback: TCrossConnectionCallback = nil); overload;
+
+ ///
+ /// 发送重定向Url命令
+ ///
+ ///
+ /// 新的Url
+ ///
+ ///
+ /// 回调函数
+ ///
+ procedure Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback = nil);
+
+ ///
+ /// 设置Content-Disposition, 令客户端将收到的数据作为文件下载处理
+ ///
+ ///
+ /// 文件名
+ ///
+ procedure Attachment(const AFileName: string);
+
+ ///
+ /// HTTP连接对象
+ ///
+ property Connection: ICrossHttpConnection read GetConnection;
+
+ ///
+ /// 请求对象
+ ///
+ property Request: ICrossHttpRequest read GetRequest;
+
+ ///
+ /// 状态码
+ ///
+ property StatusCode: Integer read GetStatusCode write SetStatusCode;
+
+ ///
+ /// 状态文本
+ ///
+ property StatusText: string read GetStatusText write SetStatusText;
+
+ ///
+ /// 内容类型
+ ///
+ property ContentType: string read GetContentType write SetContentType;
+
+ ///
+ /// 重定向Url
+ ///
+ property Location: string read GetLocation write SetLocation;
+
+ ///
+ /// HTTP响应头
+ ///
+ property Header: THttpHeader read GetHeader;
+
+ ///
+ /// 设置Cookies
+ ///
+ property Cookies: TResponseCookies read GetCookies;
+
+ ///
+ /// 是否已经发送数据
+ ///
+ property Sent: Boolean read GetSent;
+ end;
+
+ TCrossHttpRouterProc = reference to procedure(const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; var AHandled: Boolean);
+ TCrossHttpRouterMethod = procedure(const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; var AHandled: Boolean) of object;
+
+ TCrossHttpConnEvent = procedure(const Sender: TObject; const AConnection: ICrossHttpConnection) of object;
+ TCrossHttpRequestExceptionEvent = procedure(const Sender: TObject; const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse; const AException: Exception) of object;
+
+ TCrossHttpRequestEvent = procedure(const Sender: TObject;
+ const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
+ var AHandled: Boolean) of object;
+
+ // Begin/End 事件签名带上 ARequest/AResponse, 让事件 handler 能拿到本次事件
+ // 对应的请求/响应对象, 不再依赖连接级 FRequest/FResponse 兼容视图
+ // (该兼容视图在 pipelining 下语义模糊, 已不再由 _FinishQueueItem 维护)
+ TCrossHttpRequestBeginEvent = procedure(const Sender: TObject;
+ const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse) of object;
+ TCrossHttpRequestEndEvent = procedure(const Sender: TObject;
+ const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
+ const ASuccess: Boolean) of object;
+
+ ///
+ ///
+ /// 跨平台HTTP服务器接口
+ ///
+ ///
+ /// 路由定义方式:
+ ///
+ ///
+ /// Route(AMehod, APath, ARouter)
+ ///
+ ///
+ /// Get(APath, ARouter)
+ ///
+ ///
+ /// Put(APath, ARouter)
+ ///
+ ///
+ /// Post(APath, ARouter)
+ ///
+ ///
+ /// Delete(APath, ARouter)
+ ///
+ ///
+ /// All(APath, ARouter)
+ ///
+ ///
+ /// 其中AMehod和APath都支持正则表达式, ARouter可以是一个对象方法也可以是匿名函数
+ ///
+ ///
+ ///
+ ///
+ /// 这里偷了下懒, 没将HTTP和HTTPS分开实现两个不同的接口, 需要通过编译开关选择使用HTTP还是HTTP
+ ///
+ ///
+ /// 通过接口引用计数保证连接的有效性，所以可以在路由函数中调用线程池来处理业务逻辑，而不用担心处理过程中连接对象被释放
+ ///
+ ///
+ /// 每个请求的响应流程大致为：
+ ///
+ ///
+ /// -
+ /// 执行匹配的中间件;
+ ///
+ /// -
+ /// 执行匹配的路由
+ ///
+ ///
+ ///
+ ///
+ /// // 在线程池中处理业务逻辑
+ /// FCrossHttpServer.Route('GET', '/runtask/:name',
+ /// procedure(ARequest: ICrossHttpRequest; AResponse: ICrossHttpResponse)
+ /// begin
+ /// System.Threading.TTask.Run(
+ /// procedure
+ /// begin
+ /// CallTask(ARequest.Params['name']);
+ /// end);
+ /// end);
+ /// // 正则表达式
+ /// FCrossHttpServer.Route('GET', '/query/:count(\d+)',
+ /// procedure(ARequest: ICrossHttpRequest; AResponse: ICrossHttpResponse)
+ /// begin
+ /// System.Threading.TTask.Run(
+ /// procedure
+ /// begin
+ /// CallQuery(ARequest.Params['count'].ToInteger);
+ /// end);
+ /// end);
+ ///
+ ICrossHttpServer = interface(ICrossServer)
+ ['{224D16AA-317C-435E-9C2E-92868E578DB3}']
+ function GetStoragePath: string;
+ function GetAutoDeleteFiles: Boolean;
+ function GetMaxHeaderSize: Int64;
+ function GetMaxPostDataSize: Int64;
+ function GetMaxCompressRatio: Integer;
+ function GetCompressible: Boolean;
+ function GetMinCompressSize: Int64;
+ function GetSessions: ISessions;
+ function GetSessionIDCookieName: string;
+ function GetOnRequestBegin: TCrossHttpRequestBeginEvent;
+ function GetOnRequest: TCrossHttpRequestEvent;
+ function GetOnRequestEnd: TCrossHttpRequestEndEvent;
+ function GetOnRequestException: TCrossHttpRequestExceptionEvent;
+
+ procedure SetStoragePath(const Value: string);
+ procedure SetAutoDeleteFiles(const Value: Boolean);
+ procedure SetMaxHeaderSize(const Value: Int64);
+ procedure SetMaxPostDataSize(const Value: Int64);
+ procedure SetMaxCompressRatio(const Value: Integer);
+ procedure SetCompressible(const Value: Boolean);
+ procedure SetMinCompressSize(const Value: Int64);
+ procedure SetSessions(const Value: ISessions);
+ procedure SetSessionIDCookieName(const Value: string);
+ procedure SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
+ procedure SetOnRequest(const Value: TCrossHttpRequestEvent);
+ procedure SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
+ procedure SetOnRequestException(const Value: TCrossHttpRequestExceptionEvent);
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 请求方式
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 中间件处理匿名函数, 执行完处理函数之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
+ /// 否则后续匹配的中间件及路由不会被执行
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const AMethod, APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 请求方式
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 中间件处理匿名方法, 执行完处理方法之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
+ /// 否则后续匹配的中间件及路由不会被执行
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const AMethod, APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 中间件处理匿名函数, 执行完处理函数之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
+ /// 否则后续匹配的中间件及路由不会被执行
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 中间件处理匿名方法, 执行完处理方法之后, 如果AHandled=False则会继续执行后续匹配的中间件及路由,
+ /// 否则后续匹配的中间件及路由不会被执行
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 中间件处理匿名函数, 执行完处理函数之后还会继续执行后续匹配的中间件及路由
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册中间件
+ ///
+ ///
+ /// 中间件处理方法, 执行完处理方法之后还会继续执行后续匹配的中间件及路由
+ ///
+ ///
+ ///
+ /// -
+ /// 中间件严格按照注册时的顺序被调用
+ ///
+ /// -
+ /// 中间件先于路由执行
+ ///
+ ///
+ ///
+ function Use(const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册路由(请求处理函数)
+ ///
+ ///
+ /// 请求方式, GET/POST/PUT/DELETE等, 支持正则表达式, * 表示处理全部请求方式
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Route(const AMethod, APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册路由(请求处理函数)
+ ///
+ ///
+ /// 请求方式, GET/POST/PUT/DELETE等, 支持正则表达式, * 表示处理全部请求方式
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Route(const AMethod, APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册GET路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Get(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册GET路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Get(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册PUT路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Put(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册PUT路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Put(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册POST路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Post(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册POST路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Post(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册DELETE路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Delete(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册DELETE路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function Delete(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册全部请求方式路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理匿名函数
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function All(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+
+ ///
+ /// 注册全部请求方式路由(请求处理函数)
+ ///
+ ///
+ /// 请求路径, 支持正则表达式, * 表示处理全部请求路径,
例如:
+ /// /path/:param1/:param2(\d+)|/path/:param
+ ///
+ ///
+ /// 路由处理方法
+ ///
+ ///
+ ///
+ /// -
+ /// 路由严格按照注册时的顺序被调用, 所以如果在注册了AMethod=*,
+ /// APath=*的路由之后，再注册的其它路由将不会被调用. 所以强烈建议把 "* 路由" 放到最后注册.
+ ///
+ /// -
+ /// 路由中的正则表达式用法与node.js express相同
+ ///
+ ///
+ ///
+ function All(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ ///
+ /// 注册静态文件路由
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 静态文件目录, 该目录及子目录下的文件都将作为静态文件返回
+ ///
+ function &Static(const APath, ALocalStaticDir: string): ICrossHttpServer;
+
+ ///
+ /// 注册文件列表路由
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 本地文件目录
+ ///
+ function Dir(const APath, ALocalDir: string): ICrossHttpServer;
+
+ ///
+ /// 注册含有默认首页文件的静态文件路由
+ ///
+ ///
+ /// 请求路径
+ ///
+ ///
+ /// 含有默认首页文件的本地目录
+ ///
+ ///
+ /// 默认的首页文件,按顺序选择,先找到哪个就使用哪个
+ ///
+ function Index(const APath, ALocalDir: string; const ADefIndexFiles: TArray): ICrossHttpServer;
+
+ ///
+ /// 删除指定路由
+ ///
+ function RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
+
+ ///
+ /// 清除所有路由
+ ///
+ function ClearRouters: ICrossHttpServer;
+
+ ///
+ /// 删除指定中间件
+ ///
+ function RemoveMiddleware(const AMethod, APath: string): ICrossHttpServer;
+
+ ///
+ /// 清除所有中间件
+ ///
+ function ClearMiddlewares: ICrossHttpServer;
+
+ ///
+ /// 上传文件保存路径
+ ///
+ ///
+ /// 用于保存multipart/form-data上传的文件
+ ///
+ property StoragePath: string read GetStoragePath write SetStoragePath;
+
+ ///
+ /// 对象释放时自动删除上传的文件
+ ///
+ property AutoDeleteFiles: Boolean read GetAutoDeleteFiles write SetAutoDeleteFiles;
+
+ ///
+ /// 最大允许HEADER的数据尺寸
+ ///
+ /// -
+ /// > 0, 限制HEADER尺寸
+ ///
+ /// -
+ /// <= 0, 不限制
+ ///
+ ///
+ ///
+ property MaxHeaderSize: Int64 read GetMaxHeaderSize write SetMaxHeaderSize;
+
+ ///
+ /// 最大允许POST的数据尺寸
+ ///
+ /// -
+ /// > 0, 限制上传数据尺寸
+ ///
+ /// -
+ /// <= 0, 不限制
+ ///
+ ///
+ ///
+ property MaxPostDataSize: Int64 read GetMaxPostDataSize write SetMaxPostDataSize;
+
+ ///
+ /// gzip/deflate 解压时的最大压缩比 (DecodedSize / EncodedSize)
+ ///
+ /// -
+ /// > 0, 解压输出与输入比超过该值则按 zip bomb 拒绝 (400)
+ ///
+ /// -
+ /// = 0, 不做压缩比检查 (仅靠 MaxPostDataSize 拦截)
+ ///
+ ///
+ ///
+ ///
+ /// 合法 gzip 通常 1.5-15:1, 极规整数据 (StringOfChar, 大块重复字节) 可达 100-500:1
+ /// 经典 zip bomb 1000:1 起 (42.zip ~100000:1), 默认 1000:1 兜底拦截 bomb
+ ///
+ property MaxCompressRatio: Integer read GetMaxCompressRatio write SetMaxCompressRatio;
+
+ ///
+ /// 是否开启压缩
+ ///
+ ///
+ /// 开启压缩后, 发往客户端的数据将会进行压缩处理
+ ///
+ property Compressible: Boolean read GetCompressible write SetCompressible;
+
+ ///
+ /// 最小允许压缩的数据尺寸
+ ///
+ ///
+ ///
+ /// -
+ /// 如果设置值大于0, 则只有Body数据尺寸大于等于该值才会进行压缩
+ ///
+ /// -
+ /// 如果设置值小于等于0, 则无视Body数据尺寸, 始终进行压缩
+ ///
+ /// -
+ /// 由于数据是分块压缩发送, 所以数据无论多大都不会占用更多的资源, 也就不需要限制最大压缩尺寸了
+ ///
+ /// -
+ /// 目前支持的压缩方式: gzip, deflate
+ ///
+ ///
+ ///
+ property MinCompressSize: Int64 read GetMinCompressSize write SetMinCompressSize;
+
+ ///
+ /// Sessions接口对象
+ ///
+ ///
+ /// 通过它管理所有Session, 如果不设置则Session功能将不会被启用
+ ///
+ property Sessions: ISessions read GetSessions write SetSessions;
+
+ ///
+ ///
+ /// SessionID在Cookie中存储的名称
+ ///
+ ///
+ ///
+ /// 如果设置为空, 则Session功能将不会被启用
+ ///
+ property SessionIDCookieName: string read GetSessionIDCookieName write SetSessionIDCookieName;
+
+ property OnRequestBegin: TCrossHttpRequestBeginEvent read GetOnRequestBegin write SetOnRequestBegin;
+ property OnRequest: TCrossHttpRequestEvent read GetOnRequest write SetOnRequest;
+ property OnRequestEnd: TCrossHttpRequestEndEvent read GetOnRequestEnd write SetOnRequestEnd;
+ property OnRequestException: TCrossHttpRequestExceptionEvent read GetOnRequestException write SetOnRequestException;
+ end;
+
+ TCrossHttpConnection = class(TCrossServerConnection, ICrossHttpConnection)
+ private
+ FServer: TCrossHttpServer;
+ FRequestObj: TCrossHttpRequest;
+ FRequest: ICrossHttpRequest;
+ FResponseObj: TCrossHttpResponse;
+ FResponse: ICrossHttpResponse;
+ FHttpParser: ICrossHttpParser;
+ FPending: Integer;
+
+ // pipelining 响应队列, 按请求解析顺序串行化响应发送
+ FResponseQueue: TList;
+ FResponseQueueLock: ILock;
+ FSendingResponse: Boolean;
+
+ {$region 'HttpParser事件'}
+ // 以下事件都在 FHttpParser.Decode 中被触发
+ // 而 FHttpParser.Decode 在 ParseRecvData 中被调用
+ // ParseRecvData 在 FServer.LogicReceived 中被调用
+ // FServer.LogicReceived 被 TCrossConnectionBase._LockRecv 保护
+ // 所以无需担心以下事件的多线程安全问题
+ procedure _OnHeaderData(const ADataPtr: Pointer; const ADataSize: Integer);
+ function _OnGetHeaderValue(const AHeaderName: string; out AHeaderValues: TArray): Boolean;
+ procedure _OnBodyBegin;
+ procedure _OnBodyData(const ADataPtr: Pointer; const ADataSize: Integer);
+ procedure _OnBodyEnd;
+ procedure _OnParseBegin;
+ procedure _OnParseSuccess;
+ procedure _OnParseFailed(const ACode: Integer; const AError: string);
+ {$endregion}
+
+ // 响应队列内部方法
+ procedure _QueueResponseReady(const AItem: IHttpResponseQueueItem;
+ const ASource: TCrossHttpChunkDataFunc;
+ const ACallback: TCrossConnectionCallback);
+ procedure _SendQueueItem(const AItem: IHttpResponseQueueItem);
+ procedure _FinishQueueItem(const AItem: IHttpResponseQueueItem; const ASuccess: Boolean);
+
+ // 调用前必须已持有 FResponseQueueLock; 若可发送则取出队首 ready item
+ // 并设置 FSendingResponse / item.Sending, 否则返回 nil
+ function _TryDequeueReadyLocked: IHttpResponseQueueItem;
+
+ // 调用前必须已持有 FResponseQueueLock; 清空队列, 同时主动断开每个 item
+ // 内对 request/response/source/callback 的接口引用, 避免与 response.FQueueItem
+ // 等形成的循环引用导致 item 永不释放
+ procedure _ClearResponseQueueLocked;
+ protected
+ function GetRequest: ICrossHttpRequest;
+ function GetResponse: ICrossHttpResponse;
+ function GetServer: ICrossHttpServer;
+ function GetPending: Integer;
+
+ procedure ParseRecvData(var ABuf: Pointer; var ALen: Integer); virtual;
+
+ procedure ReleaseRequest; virtual;
+ procedure ReleaseResponse; virtual;
+
+ // socket 关闭时主动打破 connection 与 request/response 之间的循环引用,
+ // 并清空响应队列, 避免连接关闭后 connection 因循环引用永不释放导致内存泄漏
+ procedure InternalClose; override;
+ public
+ constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback); override;
+ destructor Destroy; override;
+
+ property Request: ICrossHttpRequest read GetRequest;
+ property Response: ICrossHttpResponse read GetResponse;
+ property Server: ICrossHttpServer read GetServer;
+ property Pending: Integer read GetPending;
+ end;
+
+ TCrossHttpRequest = class(TInterfacedObject, ICrossHttpRequest)
+ private
+ FRawRequestText: string;
+ FMethod, FPath, FQueryText, FPathAndQuery, FVersion: string;
+ FRawPath, FRawQueryText, FRawPathAndQuery: string;
+ FHttpVerNum: Integer;
+ FKeepAlive: Boolean;
+ FAccept: string;
+ FReferer: string;
+ FAcceptLanguage: string;
+ FAcceptEncoding: string;
+ FUserAgent: string;
+ FIfModifiedSince: TDateTime;
+ FIfNoneMatch: string;
+ FRange: string;
+ FIfRange: string;
+ FAuthorization: string;
+ FXForwardedFor: string;
+ FContentLength: Int64;
+ FHostName: string;
+ FHostPort: Word;
+
+ FPostDataSize: Int64;
+
+ FRequestCmdLine: string;
+ FContentType: string;
+ FRequestBoundary: string;
+ FTransferEncoding: string;
+ FContentEncoding: string;
+ FRequestCookies: string;
+ FRequestHost: string;
+ FRequestConnection: string;
+
+ FConnectionObj: TCrossHttpConnection;
+ FConnection: ICrossHttpConnection;
+ FServer: TCrossHttpServer;
+ FHeader: THttpHeader;
+ FCookies: TRequestCookies;
+ FSession: ISession;
+ FParams: THttpUrlParams;
+ FQuery: THttpUrlParams;
+ FBody: TObject;
+ FRawBody: TMemoryStream;
+ FBodyType: TBodyType;
+ FIsChunked: Boolean;
+ private
+ function CalcIsChunked: Boolean; inline;
+ protected
+ function GetConnection: ICrossHttpConnection;
+ function GetRawRequestText: string;
+ function GetRawPathAndQuery: string;
+ function GetMethod: string;
+ function GetPath: string;
+ function GetPathAndQuery: string;
+ function GetVersion: string;
+ function GetHeader: THttpHeader;
+ function GetCookies: TRequestCookies;
+ function GetSession: ISession;
+ function GetParams: THttpUrlParams;
+ function GetQueryText: string;
+ function GetQuery: THttpUrlParams;
+ function GetBody: TObject;
+ function GetRawBody: TStream;
+ function GetBodyType: TBodyType;
+ function GetKeepAlive: Boolean;
+ function GetAccept: string;
+ function GetAcceptEncoding: string;
+ function GetAcceptLanguage: string;
+ function GetReferer: string;
+ function GetUserAgent: string;
+ function GetIfModifiedSince: TDateTime;
+ function GetIfNoneMatch: string;
+ function GetRange: string;
+ function GetIfRange: string;
+ function GetAuthorization: string;
+ function GetXForwardedFor: string;
+ function GetContentLength: Int64;
+ function GetHostName: string;
+ function GetHostPort: Word;
+ function GetContentType: string;
+ function GetContentEncoding: string;
+ function GetRequestBoundary: string;
+ function GetRequestCmdLine: string;
+ function GetRequestConnection: string;
+ function GetTransferEncoding: string;
+ function GetIsChunked: Boolean;
+ function GetIsMultiPartFormData: Boolean;
+ function GetIsUrlEncodedFormData: Boolean;
+ function GetPostDataSize: Int64;
+
+ function ParseHeader(const ADataPtr: Pointer; const ADataSize: Integer): Boolean;
+ public
+ constructor Create(const AConnection: TCrossHttpConnection);
+ destructor Destroy; override;
+
+ property Connection: ICrossHttpConnection read GetConnection;
+ property RawRequestText: string read GetRawRequestText;
+ property RawPathAndParams: string read GetRawPathAndQuery;
+ property Method: string read GetMethod;
+ property Path: string read GetPath;
+ property PathAndQuery: string read GetPathAndQuery;
+ property Version: string read GetVersion;
+ property Header: THttpHeader read GetHeader;
+ property Cookies: TRequestCookies read GetCookies;
+ property Session: ISession read GetSession;
+ property Params: THttpUrlParams read GetParams;
+ property Query: THttpUrlParams read GetQuery;
+ property QueryText: string read GetQueryText;
+ property Body: TObject read GetBody;
+ property RawBody: TStream read GetRawBody;
+ property BodyType: TBodyType read GetBodyType;
+ property KeepAlive: Boolean read GetKeepAlive;
+ property Accept: string read GetAccept;
+ property AcceptEncoding: string read GetAcceptEncoding;
+ property AcceptLanguage: string read GetAcceptLanguage;
+ property Referer: string read GetReferer;
+ property UserAgent: string read GetUserAgent;
+ property IfModifiedSince: TDateTime read GetIfModifiedSince;
+ property IfNoneMatch: string read GetIfNoneMatch;
+ property Range: string read GetRange;
+ property IfRange: string read GetIfRange;
+ property Authorization: string read GetAuthorization;
+ property XForwardedFor: string read GetXForwardedFor;
+ property ContentLength: Int64 read GetContentLength;
+ property HostName: string read GetHostName;
+ property HostPort: Word read GetHostPort;
+ property ContentType: string read GetContentType;
+
+ property RequestCmdLine: string read GetRequestCmdLine;
+
+ property RequestBoundary: string read GetRequestBoundary;
+ property TransferEncoding: string read GetTransferEncoding;
+ property ContentEncoding: string read GetContentEncoding;
+ property RequestConnection: string read GetRequestConnection;
+ property IsChunked: Boolean read GetIsChunked;
+ property IsMultiPartFormData: Boolean read GetIsMultiPartFormData;
+ property IsUrlEncodedFormData: Boolean read GetIsUrlEncodedFormData;
+ property PostDataSize: Int64 read GetPostDataSize;
+ end;
+
+ TCrossHttpResponse = class(TInterfacedObject, ICrossHttpResponse)
+ public const
+ SND_BUF_SIZE = TCrossConnection.SND_BUF_SIZE;
+ private
+ FConnectionObj: TCrossHttpConnection;
+ FConnection: ICrossHttpConnection;
+ FRequest: ICrossHttpRequest;
+ FStatusCode: Integer;
+ FStatusText: string;
+ FHeader: THttpHeader;
+ FCookies: TResponseCookies;
+ FSendStatus: Integer;
+ FQueueItem: IHttpResponseQueueItem;
+
+ procedure Reset;
+ function _CreateHeader(const ABodySize: Int64; AChunked: Boolean): TBytes;
+
+ {$region '内部: 基础发送方法'}
+ procedure _Send(const ASource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure _Send(const AHeaderSource, ABodySource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
+ {$endregion}
+
+ function _CheckCompress(const ABodySize: Int64; out ACompressType: TCompressType): Boolean;
+
+ // TCustomMemoryStream 优化: 直接获取内存指针, 避免逐块读流
+ function _GetMemoryStreamPointer(const AStream: TStream;
+ const AOffset, ACount: Int64; out P: PByte; out LSize: Int64): Boolean; inline;
+
+ {$region '压缩发送'}
+ procedure SendZCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendZCompress(const ABody: Pointer; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendZCompress(const ABody; const ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendZCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendZCompress(const ABody: TBytes; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendZCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendZCompress(const ABody: TStream; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendZCompress(const ABody: string; const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback = nil); overload;
+ {$endregion}
+
+ {$region '不压缩发送'}
+ procedure SendNoCompress(const AChunkSource: TCrossHttpChunkDataFunc; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendNoCompress(const ABody: Pointer; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendNoCompress(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendNoCompress(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendNoCompress(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendNoCompress(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendNoCompress(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure SendNoCompress(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
+ {$endregion}
+
+ {$region '常规方法'}
+ procedure Send(const ABody: Pointer; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure Send(const ABody; const ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure Send(const ABody: TBytes; const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure Send(const ABody: TBytes; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure Send(const ABody: TStream; const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure Send(const ABody: TStream; const ACallback: TCrossConnectionCallback = nil); overload; inline;
+ procedure Send(const ABody: string; const ACallback: TCrossConnectionCallback = nil); overload;
+
+ procedure Json(const AJson: string; const ACallback: TCrossConnectionCallback = nil);
+
+ procedure SendFile(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
+ procedure Download(const AFileName: string; const ACallback: TCrossConnectionCallback = nil);
+ procedure SendStatus(const AStatusCode: Integer; const ADescription: string;
+ const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure SendStatus(const AStatusCode: Integer;
+ const ACallback: TCrossConnectionCallback = nil); overload;
+ procedure Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback = nil);
+ procedure Attachment(const AFileName: string);
+ {$endregion}
+ protected
+ function GetConnection: ICrossHttpConnection;
+ function GetRequest: ICrossHttpRequest;
+ function GetStatusCode: Integer;
+ function GetStatusText: string;
+ function GetContentType: string;
+ function GetLocation: string;
+ function GetHeader: THttpHeader;
+ function GetCookies: TResponseCookies;
+ function GetSent: Boolean;
+
+ procedure SetContentType(const Value: string);
+ procedure SetLocation(const Value: string);
+ procedure SetStatusCode(Value: Integer);
+ procedure SetStatusText(const Value: string);
+ public
+ constructor Create(const AConnection: TCrossHttpConnection;
+ const ARequest: ICrossHttpRequest;
+ const AQueueItem: IHttpResponseQueueItem);
+ destructor Destroy; override;
+ end;
+
+ ///
+ /// 路由参数定义
+ ///
+ TRouteParam = record
+ Name: string; // 参数名
+ Pattern: string; // 正则模式
+ end;
+
+ ///
+ /// 路由类型
+ ///
+ TRouteType = (
+ ///
+ /// 静态路由
+ ///
+ rtStatic,
+
+ ///
+ /// 正则路由
+ /// 例如: /users/:id, /users/:id/echo, /users/:id(\d+)
+ ///
+ rtRegex,
+
+ ///
+ /// 通配符路由
+ /// 例如: /files/*, 其中*就是通配符节点, 通配符节点只能出现在路径最后一段
+ ///
+ rtWildcard
+ );
+
+ ///
+ /// 路由接口
+ ///
+ IRouter = interface
+ ['{5A7E2B1C-8D3F-4E69-A0C5-2F1B8E6D4A93}']
+ function GetRouteType: TRouteType;
+ function GetMethodPattern: string;
+ function GetRegEx: IRegEx;
+
+ procedure AddRouterProc(const ARouterProc: TCrossHttpRouterProc); overload;
+ procedure AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod); overload;
+
+ procedure Execute(const ARequest: ICrossHttpRequest;
+ const AResponse: ICrossHttpResponse; var AHandled: Boolean);
+
+ property RouteType: TRouteType read GetRouteType;
+ property MethodPattern: string read GetMethodPattern;
+ property RegEx: IRegEx read GetRegEx;
+ end;
+
+ ///
+ /// 路由
+ ///
+ TRouter = class(TInterfacedObject, IRouter)
+ private
+ // 路由类型
+ FRouteType: TRouteType;
+ // 方法模式(如 "GET", "GET|POST", "*" 等)
+ FMethodPattern: string;
+ FLock: IReadWriteLock;
+
+ // 路由处理函数
+ FRouterProcList: TList;
+ FRouterMethodList: TList;
+
+ function GetRouteType: TRouteType;
+ function GetMethodPattern: string;
+ function GetRegEx: IRegEx;
+ public
+ constructor Create(const AMethodPattern: string);
+ destructor Destroy; override;
+
+ procedure AddRouterProc(const ARouterProc: TCrossHttpRouterProc); overload;
+ procedure AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod); overload;
+
+ procedure Execute(const ARequest: ICrossHttpRequest;
+ const AResponse: ICrossHttpResponse; var AHandled: Boolean);
+ end;
+
+ ///
+ /// 路由段
+ ///
+ TRouteSegment = class
+ private
+ FOriginal: string; // 原始段
+ FPattern: string; // 完整模式
+ FParams: TArray; // 参数定义数组
+ FRouteType: TRouteType; // 路由类型
+ public
+ constructor Create(const AOriginal, APattern: string;
+ const AParams: TArray; ARouteType: TRouteType);
+
+ // 正则匹配
+ // 只有正则匹配的路由才需要处理参数
+ function RegexMatch(const ASegment: string; const ARequest: ICrossHttpRequest): Boolean;
+
+ property Original: string read FOriginal;
+ property Pattern: string read FPattern;
+ property Params: TArray read FParams;
+ property RouteType: TRouteType read FRouteType;
+ end;
+
+ ///
+ /// 路由节点
+ ///
+ TRouteNode = class
+ private
+ FRouteType: TRouteType; // 路由类型
+ FSegment: TRouteSegment; // 路由段
+
+ FStaticChildren: TObjectDictionary; // 静态子节点
+ FRegexChildren: TObjectList; // 正则子节点
+ FWildcardChild: TRouteNode; // 通配符子节点
+
+ FStaticRouteMethodItems: TDictionary; // 静态方法路由项列表
+ FRegexRouteMethodItems: TList; // 正则方法路由项列表
+ FWildcardRouteMethodItem: IRouter; // 通配符路由项
+
+ function GetChildNode(const ASegment: string; const ARouteType: TRouteType; out ARouteNode: TRouteNode): Boolean;
+ function CreateChildNode(const ASegment: TRouteSegment): TRouteNode;
+ public
+ constructor Create(ARouteType: TRouteType; const ASegment: TRouteSegment);
+ destructor Destroy; override;
+
+ // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST)
+ procedure AddRouter(const AMethodPattern: string; const ARouter: IRouter);
+ function GetRouter(const AMethodPattern: string; out ARouter: IRouter): Boolean;
+ function RemoveRouter(const AMethodPattern: string): Boolean;
+
+ // 注意: 查找使用的是确定的请求方法(比如 GET POST)
+ function MatchRouter(const AMethod: string; out ARouter: IRouter): Boolean;
+ function IsEmpty: Boolean;
+
+ property RouteType: TRouteType read FRouteType;
+ property Segment: TRouteSegment read FSegment;
+ property StaticChildren: TObjectDictionary read FStaticChildren;
+ property RegexChildren: TObjectList read FRegexChildren;
+ property WildcardChild: TRouteNode read FWildcardChild;
+ end;
+
+ ///
+ /// 路由树
+ ///
+ TCrossHttpRouterTree = class
+ private
+ FRoot: TRouteNode;
+ FLock: IReadWriteLock;
+
+ function CreateSegment(const ASegment: string; const ARouteType: TRouteType): TRouteSegment;
+
+ // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST, /user/:id)
+ procedure AddRouterToNode(ANode: TRouteNode; const APathPatternSegments: TArray;
+ AIndex: Integer; const AMethodPattern: string; const ARouter: IRouter);
+ function GetRouterFromNode(ANode: TRouteNode; const APathPatternSegments: TArray;
+ AIndex: Integer; const AMethodPattern: string; out ARouter: IRouter): Boolean;
+ function RemoveRouterFromNode(ANode: TRouteNode; const APathPatternSegments: TArray;
+ AIndex: Integer; const AMethodPattern: string): Boolean;
+
+ function GetWildcardValue(const APathSegments: TArray;
+ AIndex: Integer; const AQueryText: string): string;
+ // 注意: 查找使用的是确定的请求方法和路径(比如 GET POST, /user/123)
+ function MatchRouterInNode(ANode: TRouteNode; const APathSegments: TArray;
+ AIndex: Integer; const AMethod: string; const ARequest: ICrossHttpRequest;
+ out ARouter: IRouter): Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ // 将请求路径分段
+ class function ParsePath(const APath: string): TArray; static;
+
+ // 注意: 添加和删除是使用的模式字符串(比如 GET POST GET|POST, /user/:id)
+ procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouter: IRouter); overload;
+ function GetRouter(const AMethodPattern, APathPattern: string; out ARouter: IRouter): Boolean; overload;
+ function GetRouter(const AMethodPattern, APathPattern: string): IRouter; overload;
+
+ procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouterProc: TCrossHttpRouterProc); overload;
+ procedure AddRouter(const AMethodPattern, APathPattern: string; const ARouterMethod: TCrossHttpRouterMethod); overload;
+
+ procedure RemoveRouter(const AMethodPattern, APathPattern: string);
+
+ // 注意: 查找与请求匹配的路由
+ function MatchRouter(const APathSegments: TArray; const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean; overload;
+ function MatchRouter(const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean; overload;
+ procedure Clear;
+ end;
+
+ TCrossHttpServer = class(TCrossServer, ICrossHttpServer)
+ private const
+ SESSIONID_COOKIE_NAME = 'cross_sessionid';
+ private
+ FStoragePath: string;
+ FAutoDeleteFiles: Boolean;
+ FMaxPostDataSize: Int64;
+ FMaxHeaderSize: Int64;
+ FMaxCompressRatio: Integer;
+ FMinCompressSize: Int64;
+ FSessionIDCookieName: string;
+
+ FRouters: TCrossHttpRouterTree;
+ FMiddlewares: TCrossHttpRouterTree;
+
+ FSessions: ISessions;
+ FOnRequestBegin: TCrossHttpRequestBeginEvent;
+ FOnRequestEnd: TCrossHttpRequestEndEvent;
+ FOnRequest: TCrossHttpRequestEvent;
+ FOnRequestException: TCrossHttpRequestExceptionEvent;
+ FCompressible: Boolean;
+ protected
+ function GetStoragePath: string;
+ function GetAutoDeleteFiles: Boolean;
+ function GetMaxHeaderSize: Int64;
+ function GetMaxPostDataSize: Int64;
+ function GetMaxCompressRatio: Integer;
+ function GetCompressible: Boolean;
+ function GetMinCompressSize: Int64;
+ function GetSessions: ISessions;
+ function GetSessionIDCookieName: string;
+ function GetOnRequest: TCrossHttpRequestEvent;
+ function GetOnRequestEnd: TCrossHttpRequestEndEvent;
+ function GetOnRequestBegin: TCrossHttpRequestBeginEvent;
+ function GetOnRequestException: TCrossHttpRequestExceptionEvent;
+
+ procedure SetStoragePath(const Value: string);
+ procedure SetAutoDeleteFiles(const Value: Boolean);
+ procedure SetMaxHeaderSize(const Value: Int64);
+ procedure SetMaxPostDataSize(const Value: Int64);
+ procedure SetMaxCompressRatio(const Value: Integer);
+ procedure SetCompressible(const Value: Boolean);
+ procedure SetMinCompressSize(const Value: Int64);
+ procedure SetSessions(const Value: ISessions);
+ procedure SetSessionIDCookieName(const Value: string);
+ procedure SetOnRequest(const Value: TCrossHttpRequestEvent);
+ procedure SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
+ procedure SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
+ procedure SetOnRequestException(const Value: TCrossHttpRequestExceptionEvent);
+ protected
+ function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
+
+ procedure LogicReceived(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer); override;
+ protected
+ // 处理请求前
+ // 显式传入 ARequest/AResponse, 避免在 pipelining 场景下从 connection 字段读取产生 race
+ procedure DoOnRequestBegin(const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse); virtual;
+
+ // 处理请求
+ procedure DoOnRequest(const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse); virtual;
+
+ // 处理请求后
+ procedure DoOnRequestEnd(const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
+ const ASuccess: Boolean); virtual;
+ public
+ constructor Create(const AIoThreads: Integer; const ASsl: Boolean); override;
+ destructor Destroy; override;
+
+ function Use(const AMethod, APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Use(const AMethod, APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+ function Use(const APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Use(const APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+ function Use(const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Use(const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function Route(const AMethod, APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Route(const AMethod, APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function Get(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Get(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function Put(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Put(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function Post(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Post(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function Delete(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function Delete(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function All(const APath: string; const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer; overload;
+ function All(const APath: string; const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer; overload;
+
+ function &Static(const APath, ALocalStaticDir: string): ICrossHttpServer;
+ function Dir(const APath, ALocalDir: string): ICrossHttpServer;
+ function Index(const APath, ALocalDir: string; const ADefIndexFiles: TArray): ICrossHttpServer;
+
+ function RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
+ function ClearRouters: ICrossHttpServer;
+
+ function RemoveMiddleware(const AMethod, APath: string): ICrossHttpServer;
+ function ClearMiddlewares: ICrossHttpServer;
+
+ property StoragePath: string read GetStoragePath write SetStoragePath;
+ property AutoDeleteFiles: Boolean read GetAutoDeleteFiles write SetAutoDeleteFiles;
+ property MaxHeaderSize: Int64 read GetMaxHeaderSize write SetMaxHeaderSize;
+ property MaxPostDataSize: Int64 read GetMaxPostDataSize write SetMaxPostDataSize;
+ property MaxCompressRatio: Integer read GetMaxCompressRatio write SetMaxCompressRatio;
+ property Compressible: Boolean read GetCompressible write SetCompressible;
+ property MinCompressSize: Int64 read GetMinCompressSize write SetMinCompressSize;
+ property Sessions: ISessions read GetSessions write SetSessions;
+ property SessionIDCookieName: string read GetSessionIDCookieName write SetSessionIDCookieName;
+
+ property OnRequestBegin: TCrossHttpRequestBeginEvent read GetOnRequestBegin write SetOnRequestBegin;
+ property OnRequest: TCrossHttpRequestEvent read GetOnRequest write SetOnRequest;
+ property OnRequestEnd: TCrossHttpRequestEndEvent read GetOnRequestEnd write SetOnRequestEnd;
+ property OnRequestException: TCrossHttpRequestExceptionEvent read GetOnRequestException write SetOnRequestException;
+ end;
+
+implementation
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ Utils.Utils,
+ Net.CrossHttpRouter;
+
+const
+ // HTTP/1.1 100 Continue 临时响应，用于 Expect: 100-continue 流程
+ CResponse100Continue: AnsiString = 'HTTP/1.1 100 Continue'#13#10#13#10;
+
+
+{ ECrossHttpException }
+
+constructor ECrossHttpException.Create(const AMessage: string;
+ AStatusCode: Integer);
+begin
+ inherited Create(AMessage);
+ FStatusCode := AStatusCode;
+end;
+
+constructor ECrossHttpException.CreateFmt(const AMessage: string;
+ const AArgs: array of const; AStatusCode: Integer);
+begin
+ inherited CreateFmt(AMessage, AArgs);
+ FStatusCode := AStatusCode;
+end;
+
+{ THttpResponseQueueItem }
+
+function THttpResponseQueueItem.GetRequest: ICrossHttpRequest;
+begin
+ Result := FRequest;
+end;
+
+function THttpResponseQueueItem.GetResponse: ICrossHttpResponse;
+begin
+ Result := FResponse;
+end;
+
+function THttpResponseQueueItem.GetSource: TCrossHttpChunkDataFunc;
+begin
+ Result := FSource;
+end;
+
+function THttpResponseQueueItem.GetCallback: TCrossConnectionCallback;
+begin
+ Result := FCallback;
+end;
+
+function THttpResponseQueueItem.GetReady: Boolean;
+begin
+ Result := FReady;
+end;
+
+function THttpResponseQueueItem.GetSending: Boolean;
+begin
+ Result := FSending;
+end;
+
+function THttpResponseQueueItem.GetCompleted: Boolean;
+begin
+ Result := FCompleted;
+end;
+
+function THttpResponseQueueItem.GetKeepAlive: Boolean;
+begin
+ Result := FKeepAlive;
+end;
+
+function THttpResponseQueueItem.GetStatusCode: Integer;
+begin
+ Result := FStatusCode;
+end;
+
+procedure THttpResponseQueueItem.SetRequest(const AValue: ICrossHttpRequest);
+begin
+ FRequest := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetResponse(const AValue: ICrossHttpResponse);
+begin
+ FResponse := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetSource(const AValue: TCrossHttpChunkDataFunc);
+begin
+ FSource := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetCallback(const AValue: TCrossConnectionCallback);
+begin
+ FCallback := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetReady(const AValue: Boolean);
+begin
+ FReady := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetSending(const AValue: Boolean);
+begin
+ FSending := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetCompleted(const AValue: Boolean);
+begin
+ FCompleted := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetKeepAlive(const AValue: Boolean);
+begin
+ FKeepAlive := AValue;
+end;
+
+procedure THttpResponseQueueItem.SetStatusCode(const AValue: Integer);
+begin
+ FStatusCode := AValue;
+end;
+
+{ TCrossHttpConnection }
+
+constructor TCrossHttpConnection.Create(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback);
+begin
+ inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
+
+ FServer := AOwner as TCrossHttpServer;
+
+ FResponseQueue := TList.Create;
+ FResponseQueueLock := TLock.Create;
+
+ FHttpParser := TCrossHttpParser.Create(pmServer);
+ FHttpParser.MaxHeaderSize := FServer.MaxHeaderSize;
+ FHttpParser.MaxBodyDataSize := FServer.MaxPostDataSize;
+ FHttpParser.MaxCompressRatio := FServer.MaxCompressRatio;
+ FHttpParser.OnHeaderData := _OnHeaderData;
+ FHttpParser.OnGetHeaderValue := _OnGetHeaderValue;
+ FHttpParser.OnBodyBegin := _OnBodyBegin;
+ FHttpParser.OnBodyData := _OnBodyData;
+ FHttpParser.OnBodyEnd := _OnBodyEnd;
+ FHttpParser.OnParseBegin := _OnParseBegin;
+ FHttpParser.OnParseSuccess := _OnParseSuccess;
+ FHttpParser.OnParseFailed := _OnParseFailed;
+end;
+
+destructor TCrossHttpConnection.Destroy;
+begin
+ if (FRequest <> nil) then
+ (FRequest as TCrossHttpRequest).FConnection := nil;
+
+ if (FResponse <> nil) then
+ (FResponse as TCrossHttpResponse).FConnection := nil;
+
+ ReleaseRequest;
+ ReleaseResponse;
+
+ // 队列清理由 InternalClose 负责 (包括 _ClearResponseQueueLocked 触发 callbacks),
+ // 此处仅做 defensive 的 FreeAndNil, 避免重复清理
+ FreeAndNil(FResponseQueue);
+ FResponseQueueLock := nil;
+
+ FHttpParser := nil;
+
+ inherited;
+end;
+
+function TCrossHttpConnection.GetRequest: ICrossHttpRequest;
+begin
+ Result := FRequest;
+end;
+
+function TCrossHttpConnection.GetResponse: ICrossHttpResponse;
+begin
+ Result := FResponse;
+end;
+
+function TCrossHttpConnection.GetServer: ICrossHttpServer;
+begin
+ Result := Owner as ICrossHttpServer;
+end;
+
+function TCrossHttpConnection.GetPending: Integer;
+begin
+ // 读取在多 IO 线程间发生, 与 _OnParseBegin 的 AtomicIncrement /
+ // _FinishQueueItem 的 AtomicDecrement 保持原子语义
+ Result := AtomicCmpExchange(FPending, 0, 0);
+end;
+
+procedure TCrossHttpConnection.ParseRecvData(var ABuf: Pointer;
+ var ALen: Integer);
+begin
+ if (FHttpParser <> nil) then
+ FHttpParser.Decode(ABuf, ALen)
+ else
+ ALen := 0;
+end;
+
+procedure TCrossHttpConnection.ReleaseRequest;
+begin
+ FRequestObj := nil;
+ FRequest := nil;
+end;
+
+procedure TCrossHttpConnection.ReleaseResponse;
+begin
+ FResponseObj := nil;
+ FResponse := nil;
+end;
+
+procedure TCrossHttpConnection.InternalClose;
+begin
+ // 必须在 socket 关闭时主动断开连接级 FRequest/FResponse 与 request.FConnection /
+ // response.FConnection 之间的循环引用. 否则 connection.FRequest 持有 request, 而
+ // request.FConnection 又持有 connection, refcount 永不归零, 不仅 connection 不会
+ // 销毁, 队列内 item / request body / response header 等也全部泄漏.
+ if (FRequest <> nil) then
+ (FRequest as TCrossHttpRequest).FConnection := nil;
+ if (FResponse <> nil) then
+ (FResponse as TCrossHttpResponse).FConnection := nil;
+ ReleaseRequest;
+ ReleaseResponse;
+
+ // 清空响应队列中剩余 items: 它们持有的 request/response/source/callback 接口字段
+ // 与 response.FQueueItem 形成循环引用. 必须先逐个清空 item 内的接口字段,
+ // 再 Clear 队列, 否则 items 引用计数减 1 之后仍因循环引用而不会归零, 导致泄漏
+ if (FResponseQueueLock <> nil) and (FResponseQueue <> nil) then
+ begin
+ FResponseQueueLock.Enter;
+ try
+ FSendingResponse := False;
+ _ClearResponseQueueLocked;
+ finally
+ FResponseQueueLock.Leave;
+ end;
+ end;
+
+ inherited InternalClose;
+end;
+
+function TCrossHttpConnection._TryDequeueReadyLocked: IHttpResponseQueueItem;
+begin
+ Result := nil;
+
+ if FSendingResponse then Exit;
+ if (FResponseQueue = nil) or (FResponseQueue.Count = 0) then Exit;
+ if not FResponseQueue[0].Ready then Exit;
+
+ // 从队列中移除队首, 由调用方的局部接口引用保活后续发送过程
+ Result := FResponseQueue[0];
+ FResponseQueue.Delete(0);
+ FSendingResponse := True;
+ Result.Sending := True;
+end;
+
+// _ClearResponseQueueLocked:
+// 调用前必须持有 FResponseQueueLock.
+// 按队列注册顺序 (FIFO) 收集所有 callback, 清空队列并逐个清空 item 内部接口引用,
+// 锁外按收集顺序触发 callback(False) 通知业务方发送失败.
+// 注意: callback 中不应操作连接状态 (如 Disconnect), 因为此时连接正在关闭流程中.
+procedure TCrossHttpConnection._ClearResponseQueueLocked;
+var
+ I: Integer;
+ LItem: IHttpResponseQueueItem;
+ LCallbacks: TArray;
+begin
+ if (FResponseQueue = nil) then Exit;
+
+ // 收集所有待通知 callback (在本方法尾部、队列清空后触发),
+ // 避免静默丢弃导致业务方 hang 等通知.
+ SetLength(LCallbacks, FResponseQueue.Count);
+ for I := 0 to FResponseQueue.Count - 1 do
+ begin
+ LItem := FResponseQueue[I];
+ if (LItem <> nil) then
+ begin
+ LCallbacks[I] := LItem.Callback;
+ LItem.Request := nil;
+ LItem.Response := nil;
+ LItem.Source := nil;
+ LItem.Callback := nil;
+ end;
+ end;
+
+ FResponseQueue.Clear;
+
+ // 触发所有被丢弃的 callback (通知失败)
+ for I := 0 to High(LCallbacks) do
+ if Assigned(LCallbacks[I]) then
+ LCallbacks[I](Self, False);
+end;
+
+procedure TCrossHttpConnection._QueueResponseReady(
+ const AItem: IHttpResponseQueueItem;
+ const ASource: TCrossHttpChunkDataFunc;
+ const ACallback: TCrossConnectionCallback);
+var
+ LAlreadyReadyOrCompleted: Boolean;
+ LItemToSend: IHttpResponseQueueItem;
+begin
+ if (AItem = nil) then
+ begin
+ if Assigned(ACallback) then
+ ACallback(Self, False);
+ Exit;
+ end;
+
+ LAlreadyReadyOrCompleted := False;
+ LItemToSend := nil;
+
+ // 单次锁块完成 "标记 ready" 与 "尝试 take 队首" 两件事
+ // 减少 happy path 上的锁/解锁次数, 降低高并发竞争开销
+ FResponseQueueLock.Enter;
+ try
+ if AItem.Ready or AItem.Completed then
+ begin
+ // 同一个 item 不允许重复 ready, 不修改原有 Source/Callback
+ LAlreadyReadyOrCompleted := True;
+ end else
+ begin
+ AItem.Source := ASource;
+ AItem.Callback := ACallback;
+ AItem.KeepAlive := AItem.Request.KeepAlive;
+ AItem.StatusCode := AItem.Response.StatusCode;
+ AItem.Ready := True;
+
+ // 没有正在发送时, 立即尝试取队首 ready item
+ LItemToSend := _TryDequeueReadyLocked;
+ end;
+ finally
+ FResponseQueueLock.Leave;
+ end;
+
+ if LAlreadyReadyOrCompleted then
+ begin
+ // 安全降级: 对重复传入的 callback 触发失败, 避免调用方静默挂起
+ if Assigned(ACallback) then
+ ACallback(Self, False);
+ Exit;
+ end;
+
+ if (LItemToSend <> nil) then
+ _SendQueueItem(LItemToSend);
+end;
+
+procedure TCrossHttpConnection._SendQueueItem(const AItem: IHttpResponseQueueItem);
+var
+ LConnection: ICrossHttpConnection;
+ LSender: TCrossConnectionCallback;
+begin
+ LConnection := Self;
+
+ LSender :=
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ var
+ LData: Pointer;
+ LCount: NativeInt;
+ LSource: TCrossHttpChunkDataFunc;
+ begin
+ if not ASuccess then
+ begin
+ _FinishQueueItem(AItem, False);
+ LConnection := nil;
+ LSender := nil;
+ Exit;
+ end;
+
+ LSource := AItem.Source;
+ LData := nil;
+ LCount := 0;
+ if not Assigned(LSource)
+ or not LSource(@LData, @LCount)
+ or (LData = nil)
+ or (LCount <= 0) then
+ begin
+ // StatusCode>=500 表示压缩/发送过程中发生了不可恢复的错误
+ _FinishQueueItem(AItem, AItem.StatusCode < 500);
+ LConnection := nil;
+ LSender := nil;
+ Exit;
+ end;
+
+ AConnection.SendBuf(LData^, LCount, LSender);
+ end;
+
+ LSender(LConnection, True);
+end;
+
+procedure TCrossHttpConnection._FinishQueueItem(
+ const AItem: IHttpResponseQueueItem; const ASuccess: Boolean);
+var
+ LRequest: ICrossHttpRequest;
+ LResponse: ICrossHttpResponse;
+ LCallback: TCrossConnectionCallback;
+ LNeedDisconnect, LDoEnd: Boolean;
+ LItemNext: IHttpResponseQueueItem;
+begin
+ LDoEnd := False;
+ LNeedDisconnect := False;
+ LRequest := nil;
+ LResponse := nil;
+ LCallback := nil;
+ LItemNext := nil;
+
+ // 单次锁块完成 "标记 completed + 释放 sending 标志 + 尝试 take 下一个 ready item"
+ // 三件事, 锁外再触发下一个 item 的发送, 避免两次进出锁的开销
+ FResponseQueueLock.Enter;
+ try
+ // 先复位 FSendingResponse, 确保无论 AItem 是否已经 Completed 都不会挂起后续响应
+ FSendingResponse := False;
+ if not AItem.Completed then
+ begin
+ LRequest := AItem.Request;
+ LResponse := AItem.Response;
+ LCallback := AItem.Callback;
+ LNeedDisconnect := ASuccess and ((not AItem.KeepAlive) or (AItem.StatusCode >= 500));
+
+ AItem.Completed := True;
+ LDoEnd := True;
+
+ // 关键: 立即清空 item 对外部对象的接口引用, 打破循环引用导致的内存泄漏:
+ // response.FQueueItem -> item.FResponse -> response (双向接口循环)
+ // item.FSource -> 匿名方法 (captured Self=response) -> response (隐式循环)
+ // 不在此处释放, 这些引用要等到 connection 释放才能解开, 而 connection
+ // 又被 request.FConnection / response.FConnection 持有, 形成多重循环
+ AItem.Request := nil;
+ AItem.Response := nil;
+ AItem.Source := nil;
+ AItem.Callback := nil;
+
+ // 仅在 happy path 下提前 take 下一个 item; 失败/disconnect 路径不取,
+ // 让 connection 关闭流程清理剩余 queue
+ if ASuccess and (not LNeedDisconnect) then
+ LItemNext := _TryDequeueReadyLocked;
+ end;
+ finally
+ FResponseQueueLock.Leave;
+ end;
+
+ if LDoEnd then
+ begin
+ // 不写 FRequest/FResponse 连接级字段, 这两个字段仅由 _OnParseBegin
+ // 在 _LockRecv 内独占写入. 当前完成 item 的 request/response 通过
+ // LRequest/LResponse 显式传给 DoOnRequestEnd, 进而传给 OnRequestEnd 事件,
+ // 事件 handler 可直接从参数拿到精确对应的请求/响应, 不需要读连接字段
+ AtomicDecrement(FPending);
+
+ // 用户 callback 可能抛异常, 必须用 try/finally 保证 DoOnRequestEnd 触发
+ try
+ if Assigned(LCallback) then
+ LCallback(Self, ASuccess);
+ finally
+ FServer.DoOnRequestEnd(Self, LRequest, LResponse, ASuccess);
+ end;
+ end;
+
+ if (not ASuccess) or LNeedDisconnect then
+ Disconnect
+ else if (LItemNext <> nil) then
+ _SendQueueItem(LItemNext);
+end;
+
+procedure TCrossHttpConnection._OnBodyBegin;
+var
+ LMultiPart: THttpMultiPartFormData;
+begin
+ {$region '创建Body'}
+ case FRequestObj.GetBodyType of
+ btMultiPart:
+ begin
+ if (FServer.FStoragePath <> '') and not DirectoryExists(FServer.FStoragePath) then
+ ForceDirectories(FServer.FStoragePath);
+
+ LMultiPart := THttpMultiPartFormData.Create;
+ LMultiPart.StoragePath := FServer.FStoragePath;
+ LMultiPart.AutoDeleteFiles := FServer.FAutoDeleteFiles;
+ LMultiPart.InitWithBoundary(FRequestObj.RequestBoundary);
+ if (FRequestObj.FBody = FRequestObj.FRawBody) then
+ FRequestObj.FBody := nil
+ else
+ FreeAndNil(FRequestObj.FBody);
+ FreeAndNil(FRequestObj.FRawBody);
+ FRequestObj.FBody := LMultiPart;
+ end;
+
+ btUrlEncoded, btBinary:
+ begin
+ // 二次校验: Parser 层可能未限制时由 Server 层兜底
+ if (FServer.FMaxPostDataSize > 0) and (FRequestObj.FContentLength > FServer.FMaxPostDataSize) then
+ begin
+ _OnParseFailed(413, 'Request body too large.');
+ Exit; // FBody 保持 nil, _OnBodyData/_OnBodyEnd 有 nil guard 安全跳过
+ end;
+ if (FRequestObj.FBody = FRequestObj.FRawBody) then
+ FRequestObj.FBody := nil
+ else
+ FreeAndNil(FRequestObj.FBody);
+ FreeAndNil(FRequestObj.FRawBody);
+ FRequestObj.FRawBody := TMemoryStream.Create;
+ FRequestObj.FBody := FRequestObj.FRawBody;
+ end;
+ end;
+ {$endregion}
+end;
+
+procedure TCrossHttpConnection._OnBodyData(const ADataPtr: Pointer;
+ const ADataSize: Integer);
+begin
+ if (FRequestObj.FBody = nil) then Exit;
+
+ Inc(FRequestObj.FPostDataSize, ADataSize);
+
+ case FRequestObj.GetBodyType of
+ btMultiPart:
+ (FRequestObj.FBody as THttpMultiPartFormData).Decode(ADataPtr, ADataSize);
+
+ btUrlEncoded, btBinary:
+ if (FRequestObj.FRawBody <> nil) then
+ FRequestObj.FRawBody.Write(ADataPtr^, ADataSize);
+ end;
+end;
+
+procedure TCrossHttpConnection._OnBodyEnd;
+var
+ LUrlEncodedStr: string;
+ LUrlEncodedBody: TFormUrlEncoded;
+begin
+ if (FRequestObj.FBody = nil) then Exit;
+
+ case FRequestObj.GetBodyType of
+ btUrlEncoded:
+ begin
+ if (FRequestObj.FRawBody = nil) then Exit;
+
+ SetString(LUrlEncodedStr,
+ MarshaledAString(FRequestObj.FRawBody.Memory),
+ FRequestObj.FRawBody.Size);
+ LUrlEncodedBody := TFormUrlEncoded.Create;
+ if LUrlEncodedBody.Decode(LUrlEncodedStr) then
+ begin
+ if (FRequestObj.FBody = FRequestObj.FRawBody) then
+ FRequestObj.FBody := nil
+ else
+ FreeAndNil(FRequestObj.FBody);
+ FRequestObj.FBody := LUrlEncodedBody;
+ FRequestObj.FRawBody.Position := 0;
+ end else
+ begin
+ FreeAndNil(LUrlEncodedBody);
+ // 如果按 UrlEncoded 方式解码失败, 则保留原始数据
+ // 并将类型改为 btBinary
+ FRequestObj.FBodyType := btBinary;
+ FRequestObj.FBody := FRequestObj.FRawBody;
+ FRequestObj.FRawBody.Position := 0;
+ end;
+ end;
+
+ btBinary:
+ if (FRequestObj.FRawBody <> nil) then
+ FRequestObj.FRawBody.Position := 0;
+ end;
+end;
+
+function TCrossHttpConnection._OnGetHeaderValue(const AHeaderName: string;
+ out AHeaderValues: TArray): Boolean;
+begin
+ Result := FRequest.Header.GetHeaderValues(AHeaderName, AHeaderValues);
+end;
+
+procedure TCrossHttpConnection._OnHeaderData(const ADataPtr: Pointer;
+ const ADataSize: Integer);
+var
+ LParsed: Boolean;
+ LExpect: string;
+begin
+ // ParseHeader 内部已用 try/except 将各类解析异常转为 Result := False,
+ // 这里仍再加一层护栏, 防止以后修改 ParseHeader 时遗漏局部 try/except
+ // 导致恶意/畸形请求的异常上抛到 LogicReceived 环外. 统一归一为 400 响应.
+ try
+ LParsed := (FRequest as TCrossHttpRequest).ParseHeader(ADataPtr, ADataSize);
+ except
+ LParsed := False;
+ end;
+
+ if not LParsed then
+ begin
+ _OnParseFailed(400, 'Invalid request header.');
+ Abort;
+ end;
+
+ // RFC 7231 §5.1.1: Expect: 100-continue 支持
+ //
+ // 协议流程:
+ // 客户端发送 header (含 Expect: 100-continue) →
+ // 服务器在此处发送 100 Continue (临时响应, 不走响应队列) →
+ // Parser 继续接收 body (_OnBodyBegin → _OnBodyData → _OnBodyEnd) →
+ // _OnParseSuccess → DoOnRequest 正常处理路由/中间件 →
+ // 最终发送正式响应 (200/404/500 等)
+ //
+ // 注意:
+ // 100 Continue 只是一个协议层 "请继续" 信号, 不代表服务器接受该请求.
+ // 当前实现不在此阶段做认证/校验, 意味着即使后续 DoOnRequest 返回 401,
+ // 客户端也已发送完整 body. 对于大多数客户端, 不带 Expect 头时的行为
+ // 也是如此 (body 总会随 header 一起发送), 所以无实际功能损失.
+ // SendBuf 是非阻塞操作, 在 _LockRecv 内调用安全.
+ LExpect := FRequest.Header[HEADER_EXPECT];
+ if TStrUtils.SameText(LExpect.Trim, '100-continue') then
+ Self.SendBuf(@CResponse100Continue[1], Length(CResponse100Continue), nil);
+end;
+
+procedure TCrossHttpConnection._OnParseBegin;
+var
+ LItem: IHttpResponseQueueItem;
+begin
+ // 本函数以及其它 HttpParser 回调均由 FHttpParser.Decode -> ParseRecvData ->
+ // FServer.LogicReceived -> TCrossSocketBase.TriggerReceived 同步触发,
+ // 调用链起点已由 TriggerReceived 加上 TCrossConnectionBase._LockRecv,
+ // 所以这里不需要也不应该重复加锁
+
+ // 为本次请求创建独立的 queue item, 队列顺序由解析顺序决定
+ LItem := THttpResponseQueueItem.Create;
+
+ FRequestObj := TCrossHttpRequest.Create(Self);
+ FRequest := FRequestObj;
+
+ // 创建响应对象, 显式绑定到 request 和 queue item, 确保异步发送时
+ // 不依赖连接级 FRequest/FResponse 字段
+ FResponseObj := TCrossHttpResponse.Create(Self, FRequest, LItem);
+ FResponse := FResponseObj;
+
+ LItem.Request := FRequest;
+ LItem.Response := FResponse;
+
+ FResponseQueueLock.Enter;
+ try
+ FResponseQueue.Add(LItem);
+ finally
+ FResponseQueueLock.Leave;
+ end;
+
+ AtomicIncrement(FPending);
+end;
+
+procedure TCrossHttpConnection._OnParseFailed(const ACode: Integer;
+ const AError: string);
+begin
+ if (FResponse <> nil) then
+ FResponse.SendStatus(ACode, AError)
+ else
+ Close;
+end;
+
+procedure TCrossHttpConnection._OnParseSuccess;
+var
+ LConnection: ICrossHttpConnection;
+ LRequest: ICrossHttpRequest;
+ LResponse: ICrossHttpResponse;
+begin
+ LConnection := Self;
+ // 这里是 _LockRecv 保护下的同步调用, FRequest/FResponse 此刻仍是
+ // _OnParseBegin 刚写入的当前 parse item 的 request/response.
+ // 显式捕获为局部接口引用的真正意义在于: 一旦后续业务释放锁
+ // (如未来调整架构则业务可能在锁外运行) 或 _OnParseBegin 重新写入
+ // 连接级字段, 本局部变量仍以接口引用计数保证当前请求/响应对象存活,
+ // 不会读到错位对象。对象生命周期本质上由接口引用计数保证, 与锁无关
+ LRequest := FRequest;
+ LResponse := FResponse;
+ FServer.DoOnRequestBegin(LConnection, LRequest, LResponse);
+ FServer.DoOnRequest(LConnection, LRequest, LResponse);
+end;
+
+function IsRegEx(const APattern: string): Boolean; inline;
+begin
+ Result := (APattern.IndexOfAny(REGEX_CHARS) >= 0);
+end;
+
+function IsWildcard(const APattern: string): Boolean; inline;
+begin
+ Result := (APattern = WILDCARD_CHAR);
+end;
+
+function GetPatternType(const APattern: string): TRouteType; inline;
+begin
+ // 通配符
+ if IsWildcard(APattern) then
+ Result := rtWildcard
+ // 正则
+ else if IsRegEx(APattern) then
+ Result := rtRegex
+ // 静态
+ else
+ Result := rtStatic;
+end;
+
+function CreateRouterRegEx(const APattern: string): IRegEx;
+var
+ LPattern: string;
+begin
+ LPattern := APattern;
+ if (LPattern = '*') then
+ LPattern := '.*';
+
+ // 添加正则表达式的开始和结束锚点
+ if not LPattern.StartsWith('^') then
+ LPattern := '^' + LPattern;
+ if not LPattern.EndsWith('$') then
+ LPattern := LPattern + '$';
+
+ Result := TRegEx.Create(LPattern);
+ Result.Options := [roIgnoreCase];
+end;
+
+{ TRouter }
+
+procedure TRouter.AddRouterProc(const ARouterProc: TCrossHttpRouterProc);
+begin
+ FLock.BeginWrite;
+ try
+ FRouterProcList.Add(ARouterProc);
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+procedure TRouter.AddRouterProc(const ARouterMethod: TCrossHttpRouterMethod);
+begin
+ FLock.BeginWrite;
+ try
+ FRouterMethodList.Add(ARouterMethod);
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+constructor TRouter.Create(const AMethodPattern: string);
+begin
+ FMethodPattern := AMethodPattern;
+ FRouteType := GetPatternType(AMethodPattern);
+
+ FRouterProcList := TList.Create;
+ FRouterMethodList := TList.Create;
+ FLock := TReadWriteLock.Create;
+end;
+
+destructor TRouter.Destroy;
+begin
+ FreeAndNil(FRouterProcList);
+ FreeAndNil(FRouterMethodList);
+
+ inherited;
+end;
+
+function TRouter.GetRouteType: TRouteType;
+begin
+ Result := FRouteType;
+end;
+
+function TRouter.GetMethodPattern: string;
+begin
+ Result := FMethodPattern;
+end;
+
+function TRouter.GetRegEx: IRegEx;
+begin
+ Result := nil;
+ if (FRouteType = rtRegex) then
+ Result := CreateRouterRegEx(FMethodPattern);
+end;
+
+procedure TRouter.Execute(const ARequest: ICrossHttpRequest;
+ const AResponse: ICrossHttpResponse; var AHandled: Boolean);
+var
+ LRouterProcArr: TArray;
+ LRouterMethodArr: TArray;
+ LRouterProc: TCrossHttpRouterProc;
+ LRouterMethod: TCrossHttpRouterMethod;
+begin
+ FLock.BeginRead;
+ try
+ LRouterProcArr := FRouterProcList.ToArray;
+ LRouterMethodArr := FRouterMethodList.ToArray;
+ finally
+ FLock.EndRead;
+ end;
+
+ for LRouterProc in LRouterProcArr do
+ begin
+ if Assigned(LRouterProc) then
+ begin
+ LRouterProc(ARequest, AResponse, AHandled);
+ if AHandled or AResponse.Sent then Exit;
+ end;
+ end;
+
+ for LRouterMethod in LRouterMethodArr do
+ begin
+ if Assigned(LRouterMethod) then
+ begin
+ LRouterMethod(ARequest, AResponse, AHandled);
+ if AHandled or AResponse.Sent then Exit;
+ end;
+ end;
+end;
+
+{ TRouteSegment }
+
+constructor TRouteSegment.Create(const AOriginal, APattern: string;
+ const AParams: TArray; ARouteType: TRouteType);
+begin
+ inherited Create;
+ FOriginal := AOriginal;
+ FPattern := APattern;
+ FParams := AParams;
+ FRouteType := ARouteType;
+end;
+
+function TRouteSegment.RegexMatch(const ASegment: string; const ARequest: ICrossHttpRequest): Boolean;
+var
+ I: Integer;
+ LRegEx: IRegEx;
+begin
+ Result := False;
+
+ case FRouteType of
+ rtRegex:
+ begin
+ LRegEx := CreateRouterRegEx(FPattern);
+ if LRegEx <> nil then
+ begin
+ LRegEx.Subject := ASegment;
+ Result := LRegEx.Match;
+ if Result and Assigned(ARequest) then
+ begin
+ // 提取所有参数值
+ for I := 0 to High(FParams) do
+ ARequest.Params[FParams[I].Name] := LRegEx.Groups[I + 1];
+ end;
+ end;
+ end;
+ end;
+end;
+
+{ TRouteNode }
+
+constructor TRouteNode.Create(ARouteType: TRouteType; const ASegment: TRouteSegment);
+begin
+ inherited Create;
+
+ FRouteType := ARouteType;
+ FSegment := ASegment;
+ FStaticChildren := TObjectDictionary.Create([doOwnsValues]);
+ FRegexChildren := TObjectList.Create(True);
+
+ FStaticRouteMethodItems := TDictionary.Create;
+ FRegexRouteMethodItems := TList.Create;
+end;
+
+destructor TRouteNode.Destroy;
+begin
+ FreeAndNil(FSegment);
+ FreeAndNil(FStaticChildren);
+ FreeAndNil(FRegexChildren);
+ FreeAndNil(FWildcardChild);
+
+ FreeAndNil(FStaticRouteMethodItems);
+ FreeAndNil(FRegexRouteMethodItems);
+ FWildcardRouteMethodItem := nil;
+
+ inherited;
+end;
+
+function TRouteNode.CreateChildNode(const ASegment: TRouteSegment): TRouteNode;
+begin
+ case ASegment.RouteType of
+ rtStatic:
+ begin
+ Result := TRouteNode.Create(rtStatic, ASegment);
+ FStaticChildren.Add(ASegment.Original.ToLower, Result);
+ end;
+
+ rtRegex:
+ begin
+ Result := TRouteNode.Create(rtRegex, ASegment);
+ FRegexChildren.Add(Result);
+ end;
+
+ rtWildcard:
+ begin
+ if FWildcardChild = nil then
+ FWildcardChild := TRouteNode.Create(rtWildcard, ASegment);
+ Result := FWildcardChild;
+ end;
+ else
+ Result := nil;
+ end;
+end;
+
+procedure TRouteNode.AddRouter(const AMethodPattern: string; const ARouter: IRouter);
+begin
+ case ARouter.RouteType of
+ rtStatic:
+ FStaticRouteMethodItems.AddOrSetValue(AMethodPattern.ToLower, ARouter);
+
+ rtRegex:
+ FRegexRouteMethodItems.Add(ARouter);
+
+ rtWildcard:
+ FWildcardRouteMethodItem := ARouter;
+ end;
+end;
+
+function TRouteNode.GetChildNode(const ASegment: string;
+ const ARouteType: TRouteType; out ARouteNode: TRouteNode): Boolean;
+var
+ LChild: TRouteNode;
+begin
+ case ARouteType of
+ rtStatic:
+ begin
+ Result := FStaticChildren.TryGetValue(ASegment.ToLower, ARouteNode)
+ end;
+
+ rtRegex:
+ begin
+ for LChild in FRegexChildren do
+ begin
+ if (LChild.Segment.Original = ASegment) then
+ begin
+ ARouteNode := LChild;
+ Exit(True);
+ end;
+ end;
+
+ Result := False;
+ end;
+
+ rtWildcard:
+ begin
+ ARouteNode := FWildcardChild;
+ Result := (ARouteNode <> nil);
+ end;
+ else
+ ARouteNode := nil;
+ Result := False;
+ end;
+end;
+
+function TRouteNode.GetRouter(const AMethodPattern: string;
+ out ARouter: IRouter): Boolean;
+var
+ I: Integer;
+ LRouter: IRouter;
+begin
+ Result := False;
+
+ // 先尝试从静态方法路由中查找
+ if FStaticRouteMethodItems.TryGetValue(AMethodPattern.ToLower, ARouter) then
+ Exit(True);
+
+ // 从正则方法路由中查找
+ for I := 0 to FRegexRouteMethodItems.Count - 1 do
+ begin
+ LRouter := FRegexRouteMethodItems[I];
+ if SameText(LRouter.MethodPattern, AMethodPattern) then
+ begin
+ ARouter := LRouter;
+ Exit(True);
+ end;
+ end;
+
+ // 从通配符方法路由中查找
+ if (FWildcardRouteMethodItem <> nil) and IsWildcard(AMethodPattern) then
+ begin
+ ARouter := FWildcardRouteMethodItem;
+ Exit(True);
+ end;
+end;
+
+function TRouteNode.MatchRouter(const AMethod: string;
+ out ARouter: IRouter): Boolean;
+var
+ LRouter: IRouter;
+ LRegEx: IRegEx;
+begin
+ Result := False;
+
+ // 优先从静态方法路由中查找
+ if FStaticRouteMethodItems.TryGetValue(AMethod.ToLower, LRouter) then
+ begin
+ ARouter := LRouter;
+ Exit(True);
+ end;
+
+ // 遍历所有正则方法路由项, 找到第一个匹配的
+ for LRouter in FRegexRouteMethodItems do
+ begin
+ // 正则表达式方法使用局部匹配器, 避免并发请求共享匹配状态
+ LRegEx := LRouter.RegEx;
+ if (LRegEx <> nil) then
+ begin
+ LRegEx.Subject := AMethod;
+ if LRegEx.Match then
+ begin
+ ARouter := LRouter;
+ Exit(True);
+ end;
+ end;
+ end;
+
+ // 通配符
+ if (FWildcardRouteMethodItem <> nil) then
+ begin
+ ARouter := FWildcardRouteMethodItem;
+ Exit(True);
+ end;
+end;
+
+function TRouteNode.RemoveRouter(const AMethodPattern: string): Boolean;
+var
+ LLowerMethod: string;
+ I: Integer;
+ LRouter: IRouter;
+begin
+ Result := False;
+
+ // 先尝试从静态方法路由中删除
+ LLowerMethod := AMethodPattern.ToLower;
+ if FStaticRouteMethodItems.ContainsKey(LLowerMethod) then
+ begin
+ FStaticRouteMethodItems.Remove(LLowerMethod);
+ Exit(True);
+ end;
+
+ // 从通配符方法路由删除
+ if (FWildcardRouteMethodItem <> nil) and IsWildcard(AMethodPattern) then
+ begin
+ FWildcardRouteMethodItem := nil;
+ Exit(True);
+ end;
+
+ // 遍历正则方法路由项, 删除匹配的路由
+ for I := FRegexRouteMethodItems.Count - 1 downto 0 do
+ begin
+ LRouter := FRegexRouteMethodItems[I];
+ if SameText(LRouter.MethodPattern, AMethodPattern) then
+ begin
+ FRegexRouteMethodItems.Delete(I);
+ Exit(True);
+ end;
+ end;
+end;
+
+function TRouteNode.IsEmpty: Boolean;
+begin
+ // 节点为空的条件: 没有子节点且没有路由处理函数
+ Result := (FStaticChildren.Count = 0) and
+ (FRegexChildren.Count = 0) and
+ (FWildcardChild = nil) and
+ (FStaticRouteMethodItems.Count = 0) and
+ (FRegexRouteMethodItems.Count = 0) and
+ (FWildcardRouteMethodItem = nil);
+end;
+
+{ TCrossHttpRouterTree }
+
+constructor TCrossHttpRouterTree.Create;
+begin
+ inherited Create;
+
+ FRoot := TRouteNode.Create(rtStatic, TRouteSegment.Create('', '', [], rtStatic));
+ FLock := TReadWriteLock.Create;
+end;
+
+destructor TCrossHttpRouterTree.Destroy;
+begin
+ FreeAndNil(FRoot);
+
+ inherited;
+end;
+
+function TCrossHttpRouterTree.CreateSegment(const ASegment: string;
+ const ARouteType: TRouteType): TRouteSegment;
+var
+ LPattern: string;
+ LParams: TArray;
+begin
+ LPattern := ASegment;
+ LParams := [];
+
+ // 正则段需要处理参数
+ if (ARouteType = rtRegex) then
+ begin
+ LPattern := ASegment;
+ LParams := [];
+ // 使用正则表达式匹配所有参数模式
+ // 匹配 :param 和 :param(pattern) 格式
+ // 可以在参数后面增加正则限定参数 :number(\d+), :word(\w+)
+ LPattern := TRegEx.Replace(LPattern, ':(\w+)(?:\((.*?)\))?',
+ function(const AMatch: TMatch): string
+ var
+ LParamName, LParamPattern: string;
+ LParam: TRouteParam;
+ begin
+ if not AMatch.Success then Exit('');
+
+ if (AMatch.Groups.Count > 1) then
+ LParamName := AMatch.Groups[1].Value
+ else
+ LParamName := '';
+ if (AMatch.Groups.Count > 2) then
+ LParamPattern := AMatch.Groups[2].Value
+ else
+ LParamPattern := '';
+
+ if (LParamPattern = '') or (LParamPattern = '*') then
+ LParamPattern := '.*';
+
+ Result := '(' + LParamPattern + ')';
+
+ LParam.Name := LParamName;
+ LParam.Pattern := LParamPattern;
+ LParams := LParams + [LParam];
+ end);
+ end;
+
+ Result := TRouteSegment.Create(ASegment, LPattern, LParams, ARouteType);
+end;
+
+class function TCrossHttpRouterTree.ParsePath(const APath: string): TArray;
+begin
+ // 请求的是根路径, 无需拆分
+ if (APath = '/') or (APath = '') then
+ begin
+ Result := [''];
+ Exit;
+ end;
+
+ // 把请求路径按/拆分成多段
+ Result := APath.Split(['/'], TStringSplitOptions.ExcludeEmpty);
+ if (Result = nil) then
+ Result := [''];
+end;
+
+procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern, APathPattern: string;
+ const ARouter: IRouter);
+var
+ LPathSegments: TArray;
+begin
+ FLock.BeginWrite;
+ try
+ LPathSegments := ParsePath(APathPattern);
+ AddRouterToNode(FRoot, LPathSegments, 0, AMethodPattern, ARouter);
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern,
+ APathPattern: string; const ARouterProc: TCrossHttpRouterProc);
+var
+ LRouter: IRouter;
+begin
+ LRouter := GetRouter(AMethodPattern, APathPattern);
+ LRouter.AddRouterProc(ARouterProc);
+end;
+
+procedure TCrossHttpRouterTree.AddRouter(const AMethodPattern,
+ APathPattern: string; const ARouterMethod: TCrossHttpRouterMethod);
+var
+ LRouter: IRouter;
+begin
+ LRouter := GetRouter(AMethodPattern, APathPattern);
+ LRouter.AddRouterProc(ARouterMethod);
+end;
+
+procedure TCrossHttpRouterTree.AddRouterToNode(ANode: TRouteNode;
+ const APathPatternSegments: TArray; AIndex: Integer; const AMethodPattern: string;
+ const ARouter: IRouter);
+var
+ LSegmentPattern: string;
+ LRouteType: TRouteType;
+ LRouteSegment: TRouteSegment;
+ LChild: TRouteNode;
+begin
+ if (AIndex > High(APathPatternSegments)) then
+ begin
+ // 到达路径末尾, 添加路由
+ ANode.AddRouter(AMethodPattern, ARouter);
+ Exit;
+ end;
+
+ LSegmentPattern := APathPatternSegments[AIndex];
+ LRouteType := GetPatternType(LSegmentPattern);
+
+ if not ANode.GetChildNode(LSegmentPattern, LRouteType, LChild) then
+ begin
+ LRouteSegment := CreateSegment(LSegmentPattern, LRouteType);
+ LChild := ANode.CreateChildNode(LRouteSegment);
+ end;
+
+ AddRouterToNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
+end;
+
+function TCrossHttpRouterTree.GetRouter(const AMethodPattern,
+ APathPattern: string; out ARouter: IRouter): Boolean;
+var
+ LPathSegments: TArray;
+begin
+ FLock.BeginRead;
+ try
+ LPathSegments := ParsePath(APathPattern);
+ Result := GetRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern, ARouter);
+ finally
+ FLock.EndRead;
+ end;
+end;
+
+function TCrossHttpRouterTree.GetRouter(const AMethodPattern,
+ APathPattern: string): IRouter;
+var
+ LPathSegments: TArray;
+begin
+ FLock.BeginWrite;
+ try
+ LPathSegments := ParsePath(APathPattern);
+ if not GetRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern, Result) then
+ begin
+ Result := TRouter.Create(AMethodPattern);
+ AddRouterToNode(FRoot, LPathSegments, 0, AMethodPattern, Result);
+ end;
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+function TCrossHttpRouterTree.GetRouterFromNode(ANode: TRouteNode;
+ const APathPatternSegments: TArray; AIndex: Integer;
+ const AMethodPattern: string; out ARouter: IRouter): Boolean;
+var
+ LSegmentPattern: string;
+ LRouteType: TRouteType;
+ LChild: TRouteNode;
+ LFound: Boolean;
+begin
+ Result := False;
+
+ if (AIndex > High(APathPatternSegments)) then
+ begin
+ // 到达路径末尾, 查找该节点的路由
+ Result := ANode.GetRouter(AMethodPattern, ARouter);
+ Exit;
+ end;
+
+ LSegmentPattern := APathPatternSegments[AIndex];
+ LRouteType := GetPatternType(LSegmentPattern);
+
+ case LRouteType of
+ rtStatic:
+ // 从静态子节点中查找路由
+ if ANode.StaticChildren.TryGetValue(LSegmentPattern.ToLower, LChild) then
+ begin
+ LFound := GetRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
+ Result := Result or LFound;
+ end;
+
+ rtRegex:
+ // 从正则子节点中查找路由
+ for LChild in ANode.RegexChildren do
+ begin
+ if SameText(LChild.Segment.Original, LSegmentPattern) then
+ begin
+ LFound := GetRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern, ARouter);
+ Result := Result or LFound;
+ if Result then Break;
+ end;
+ end;
+
+ rtWildcard:
+ // 从通配符子节点查找路由
+ if (ANode.WildcardChild <> nil) then
+ begin
+ LFound := ANode.WildcardChild.GetRouter(AMethodPattern, ARouter);
+ Result := Result or LFound;
+ end;
+ end;
+end;
+
+function TCrossHttpRouterTree.GetWildcardValue(
+ const APathSegments: TArray; AIndex: Integer;
+ const AQueryText: string): string;
+begin
+ Result := string.Join('/', APathSegments, AIndex, Length(APathSegments) - AIndex);
+ if (AQueryText <> '') then
+ Result := Result + '?' + AQueryText;
+end;
+
+function TCrossHttpRouterTree.MatchRouterInNode(ANode: TRouteNode;
+ const APathSegments: TArray; AIndex: Integer; const AMethod: string;
+ const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean;
+var
+ LSegment, LWildcardValue: string;
+ LChild: TRouteNode;
+begin
+ Result := False;
+
+ if (AIndex > High(APathSegments)) then
+ begin
+ // 到达路径末尾, 查找匹配方法的路由
+ Result := ANode.MatchRouter(AMethod, ARouter);
+
+ // 尝试从通配符子节点查找路由
+ if not Result and (ANode.WildcardChild <> nil) then
+ begin
+ Result := ANode.WildcardChild.MatchRouter(AMethod, ARouter);
+ if Result then
+ begin
+ LWildcardValue := GetWildcardValue(APathSegments, AIndex, ARequest.QueryText);
+ if Assigned(ARequest) then
+ ARequest.Params[WILDCARD_CHAR] := LWildcardValue;
+ end;
+ end;
+
+ Exit;
+ end;
+
+ LSegment := APathSegments[AIndex];
+
+ // 1. 首先尝试精确匹配静态节点
+ if ANode.StaticChildren.TryGetValue(LSegment.ToLower, LChild) then
+ begin
+ Result := MatchRouterInNode(LChild, APathSegments, AIndex + 1, AMethod,
+ ARequest, ARouter);
+ if Result then Exit;
+ end;
+
+ // 2. 尝试正则节点(支持多参数)
+ for LChild in ANode.RegexChildren do
+ begin
+ if LChild.Segment.RegexMatch(LSegment, ARequest) then
+ begin
+ // 普通正则节点, 继续递归匹配
+ Result := MatchRouterInNode(LChild, APathSegments, AIndex + 1, AMethod,
+ ARequest, ARouter);
+ if Result then Exit;
+ end;
+ end;
+
+ // 3. 最后尝试通配符子节点(优先级最低)
+ if (ANode.WildcardChild <> nil) then
+ begin
+ Result := ANode.WildcardChild.MatchRouter(AMethod, ARouter);
+ if Result then
+ begin
+ LWildcardValue := GetWildcardValue(APathSegments, AIndex, ARequest.QueryText);
+ if Assigned(ARequest) then
+ ARequest.Params[WILDCARD_CHAR] := LWildcardValue;
+
+ Exit;
+ end;
+ end;
+end;
+
+function TCrossHttpRouterTree.MatchRouter(const APathSegments: TArray;
+ const ARequest: ICrossHttpRequest; out ARouter: IRouter): Boolean;
+begin
+ FLock.BeginRead;
+ try
+ if FRoot.IsEmpty then
+ begin
+ ARouter := nil;
+ Exit(False);
+ end;
+
+ Result := MatchRouterInNode(FRoot, APathSegments, 0, ARequest.Method, ARequest, ARouter);
+ finally
+ FLock.EndRead;
+ end;
+end;
+
+function TCrossHttpRouterTree.MatchRouter(const ARequest: ICrossHttpRequest;
+ out ARouter: IRouter): Boolean;
+var
+ LPathSegments: TArray;
+begin
+ LPathSegments := ParsePath(ARequest.Path);
+ Result := MatchRouter(LPathSegments, ARequest, ARouter);
+end;
+
+function TCrossHttpRouterTree.RemoveRouterFromNode(ANode: TRouteNode;
+ const APathPatternSegments: TArray; AIndex: Integer; const AMethodPattern: string): Boolean;
+var
+ LSegmentPattern, LLowerSegment: string;
+ LRouteType: TRouteType;
+ LChild: TRouteNode;
+ LRemoved: Boolean;
+ I: Integer;
+begin
+ Result := False;
+
+ if (AIndex > High(APathPatternSegments)) then
+ begin
+ // 到达路径末尾, 删除该节点的路由
+ Result := ANode.RemoveRouter(AMethodPattern);
+ Exit;
+ end;
+
+ LSegmentPattern := APathPatternSegments[AIndex];
+ LRouteType := GetPatternType(LSegmentPattern);
+ LLowerSegment := LSegmentPattern.ToLower;
+
+ case LRouteType of
+ rtStatic:
+ // 从静态子节点中删除路由
+ if ANode.StaticChildren.TryGetValue(LLowerSegment, LChild) then
+ begin
+ LRemoved := RemoveRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern);
+
+ // 如果子节点变空, 删除它
+ if LRemoved and LChild.IsEmpty then
+ ANode.StaticChildren.Remove(LLowerSegment);
+
+ Result := Result or LRemoved;
+ end;
+
+ rtRegex:
+ // 从正则子节点中删除路由（逆序遍历，避免在迭代中修改集合）
+ for I := ANode.RegexChildren.Count - 1 downto 0 do
+ begin
+ LChild := ANode.RegexChildren[I];
+ if SameText(LChild.Segment.Original, LSegmentPattern) then
+ begin
+ LRemoved := RemoveRouterFromNode(LChild, APathPatternSegments, AIndex + 1, AMethodPattern);
+
+ // 如果子节点变空, 删除它
+ if LRemoved and LChild.IsEmpty then
+ ANode.RegexChildren.Delete(I);
+
+ Result := Result or LRemoved;
+ if Result then Break;
+ end;
+ end;
+
+ rtWildcard:
+ // 从通配符子节点删除路由
+ if (ANode.WildcardChild <> nil) then
+ begin
+ LRemoved := ANode.WildcardChild.RemoveRouter(AMethodPattern);
+
+ // 如果子节点变空, 删除它
+ if LRemoved and ANode.WildcardChild.IsEmpty then
+ FreeAndNil(ANode.FWildcardChild);
+
+ Result := Result or LRemoved;
+ end;
+ end;
+end;
+
+procedure TCrossHttpRouterTree.RemoveRouter(const AMethodPattern, APathPattern: string);
+var
+ LPathSegments: TArray;
+begin
+ FLock.BeginWrite;
+ try
+ LPathSegments := ParsePath(APathPattern);
+ RemoveRouterFromNode(FRoot, LPathSegments, 0, AMethodPattern);
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+procedure TCrossHttpRouterTree.Clear;
+begin
+ FLock.BeginWrite;
+ try
+ FreeAndNil(FRoot);
+ FRoot := TRouteNode.Create(rtStatic, TRouteSegment.Create('', '', [], rtStatic));
+ finally
+ FLock.EndWrite;
+ end;
+end;
+
+{ TCrossHttpServer }
+
+function TCrossHttpServer.All(const APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Route('*', APath, ARouterProc);
+end;
+
+function TCrossHttpServer.All(const APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Route('*', APath, ARouterMethod);
+end;
+
+constructor TCrossHttpServer.Create(const AIoThreads: Integer; const ASsl: Boolean);
+begin
+ inherited Create(AIoThreads, ASsl);
+
+ FRouters := TCrossHttpRouterTree.Create;
+ FMiddlewares := TCrossHttpRouterTree.Create;
+
+ Port := 80;
+ Addr := '';
+
+ FCompressible := True;
+ FMinCompressSize := MIN_COMPRESS_SIZE;
+ FMaxCompressRatio := DEFAULT_MAX_COMPRESS_RATIO;
+ FStoragePath := TCrossHttpUtils.CombinePath(TUtils.AppPath, 'temp', PathDelim) + PathDelim;
+ FSessionIDCookieName := SESSIONID_COOKIE_NAME;
+end;
+
+function TCrossHttpServer.CreateConnection(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
+begin
+ Result := TCrossHttpConnection.Create(
+ AOwner,
+ AClientSocket,
+ AConnectType,
+ AHost,
+ AConnectCb);
+end;
+
+destructor TCrossHttpServer.Destroy;
+begin
+ Stop;
+
+ FreeAndNil(FRouters);
+ FreeAndNil(FMiddlewares);
+
+ inherited Destroy;
+end;
+
+function TCrossHttpServer.Dir(const APath, ALocalDir: string): ICrossHttpServer;
+var
+ LReqPath: string;
+begin
+ LReqPath := APath;
+ if not LReqPath.EndsWith('/') then
+ LReqPath := LReqPath + '/';
+ LReqPath := LReqPath + '*';
+ Result := Get(LReqPath, TNetCrossRouter.Dir(APath, ALocalDir, '*'));
+end;
+
+function TCrossHttpServer.Delete(const APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Route('DELETE', APath, ARouterProc);
+end;
+
+function TCrossHttpServer.Delete(const APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Route('DELETE', APath, ARouterMethod);
+end;
+
+procedure TCrossHttpServer.DoOnRequestBegin(
+ const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse);
+begin
+ if Assigned(FOnRequestBegin) then
+ FOnRequestBegin(Self, AConnection, ARequest, AResponse);
+end;
+
+procedure TCrossHttpServer.DoOnRequestEnd(
+ const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse;
+ const ASuccess: Boolean);
+begin
+ if Assigned(FOnRequestEnd) then
+ FOnRequestEnd(Self, AConnection, ARequest, AResponse, ASuccess);
+end;
+
+procedure TCrossHttpServer.DoOnRequest(const AConnection: ICrossHttpConnection;
+ const ARequest: ICrossHttpRequest; const AResponse: ICrossHttpResponse);
+var
+ LRequest: ICrossHttpRequest;
+ LResponse: ICrossHttpResponse;
+ LSessionID: string;
+ LPathSegments: TArray;
+ LHandled: Boolean;
+ LRouter: IRouter;
+begin
+ // 显式接收来自 _OnParseSuccess 的 request/response, 不再读取连接字段,
+ // 避免与 _FinishQueueItem 等异步线程构成 race
+ LRequest := ARequest;
+ LResponse := AResponse;
+ LHandled := False;
+
+ try
+ {$region 'Session'}
+ if (FSessions <> nil) and (FSessionIDCookieName <> '') then
+ begin
+ LSessionID := LRequest.Cookies[FSessionIDCookieName];
+ (LRequest as TCrossHttpRequest).FSession := FSessions.Sessions[LSessionID];
+ if (LRequest.Session <> nil) and (LRequest.Session.SessionID <> LSessionID) then
+ begin
+ LSessionID := LRequest.Session.SessionID;
+ LResponse.Cookies.AddOrSet(FSessionIDCookieName, LSessionID, 0);
+ end;
+ end;
+ {$endregion}
+
+ // 提前拆分请求路径, 可以减少一次 ParsePath 调用
+ LPathSegments := TCrossHttpRouterTree.ParsePath(LRequest.Path);
+
+ {$region '中间件'}
+ // 执行匹配的中间件
+ if FMiddlewares.MatchRouter(LPathSegments, LRequest, LRouter) then
+ begin
+ // 中间件通常用于请求的预处理
+ // 所以默认将 LHandled 置为 False, 以保证后续路由能被执行
+ // 除非用户在中间件中明确指定了 LHandled := True, 表明该请求无需后续路由响应了
+ LHandled := False;
+ LRouter.Execute(LRequest, LResponse, LHandled);
+
+ // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
+ if LHandled or LResponse.Sent then Exit;
+ end;
+ {$endregion}
+
+ {$region '路由'}
+ // 执行匹配的路由
+ if FRouters.MatchRouter(LPathSegments, LRequest, LRouter) then
+ begin
+ // 路由用于响应请求
+ // 所以默认将 LHandled 置为 True, 以保证不会有多个匹配的路由被执行
+ // 除非用户在路由中明确指定了 LHandled := False, 表明该路由并没有
+ // 完成请求响应, 还需要后续路由继续进行响应
+ LHandled := True;
+ LRouter.Execute(LRequest, LResponse, LHandled);
+
+ // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
+ if LHandled or LResponse.Sent then Exit;
+ end;
+ {$endregion}
+
+ {$region '响应请求事件'}
+ if Assigned(FOnRequest)
+ and not (LHandled or LResponse.Sent) then
+ begin
+ FOnRequest(Self, AConnection, LRequest, LResponse, LHandled);
+
+ // 如果已经发送了数据, 则后续的事件和路由响应都不需要执行了
+ if LHandled or LResponse.Sent then Exit;
+ end;
+ {$endregion}
+
+ // 如果该请求没有被任何中间件、事件、路由响应, 返回 404
+ if not (LHandled or LResponse.Sent) then
+ LResponse.SendStatus(404);
+ except
+ on e: Exception do
+ begin
+ if Assigned(FOnRequestException) then
+ FOnRequestException(Self, LRequest, LResponse, e)
+ else if LResponse.Sent then
+ AConnection.Disconnect
+ else if (e is ECrossHttpException) then
+ LResponse.SendStatus(ECrossHttpException(e).StatusCode, ECrossHttpException(e).Message)
+ else
+ LResponse.SendStatus(500, e.Message);
+ end;
+ end;
+end;
+
+function TCrossHttpServer.Get(const APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Route('GET', APath, ARouterProc);
+end;
+
+function TCrossHttpServer.Get(const APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Route('GET', APath, ARouterMethod);
+end;
+
+function TCrossHttpServer.GetOnRequestEnd: TCrossHttpRequestEndEvent;
+begin
+ Result := FOnRequestEnd;
+end;
+
+function TCrossHttpServer.GetAutoDeleteFiles: Boolean;
+begin
+ Result := FAutoDeleteFiles;
+end;
+
+function TCrossHttpServer.GetOnRequestBegin: TCrossHttpRequestBeginEvent;
+begin
+ Result := FOnRequestBegin;
+end;
+
+function TCrossHttpServer.GetCompressible: Boolean;
+begin
+ Result := FCompressible;
+end;
+
+function TCrossHttpServer.GetMaxHeaderSize: Int64;
+begin
+ Result := FMaxHeaderSize;
+end;
+
+function TCrossHttpServer.GetMaxPostDataSize: Int64;
+begin
+ Result := FMaxPostDataSize;
+end;
+
+function TCrossHttpServer.GetMaxCompressRatio: Integer;
+begin
+ Result := FMaxCompressRatio;
+end;
+
+function TCrossHttpServer.GetMinCompressSize: Int64;
+begin
+ Result := FMinCompressSize;
+end;
+
+function TCrossHttpServer.GetOnRequest: TCrossHttpRequestEvent;
+begin
+ Result := FOnRequest;
+end;
+
+function TCrossHttpServer.GetOnRequestException: TCrossHttpRequestExceptionEvent;
+begin
+ Result := FOnRequestException;
+end;
+
+function TCrossHttpServer.GetSessionIDCookieName: string;
+begin
+ Result := FSessionIDCookieName;
+end;
+
+function TCrossHttpServer.GetSessions: ISessions;
+begin
+ Result := FSessions;
+end;
+
+function TCrossHttpServer.GetStoragePath: string;
+begin
+ Result := FStoragePath;
+end;
+
+procedure TCrossHttpServer.SetOnRequestEnd(const Value: TCrossHttpRequestEndEvent);
+begin
+ FOnRequestEnd := Value;
+end;
+
+procedure TCrossHttpServer.SetAutoDeleteFiles(const Value: Boolean);
+begin
+ FAutoDeleteFiles := Value;
+end;
+
+procedure TCrossHttpServer.SetOnRequestBegin(const Value: TCrossHttpRequestBeginEvent);
+begin
+ FOnRequestBegin := Value;
+end;
+
+procedure TCrossHttpServer.SetCompressible(const Value: Boolean);
+begin
+ FCompressible := Value;
+end;
+
+procedure TCrossHttpServer.SetMaxHeaderSize(const Value: Int64);
+begin
+ FMaxHeaderSize := Value;
+end;
+
+procedure TCrossHttpServer.SetMaxPostDataSize(const Value: Int64);
+begin
+ FMaxPostDataSize := Value;
+end;
+
+procedure TCrossHttpServer.SetMaxCompressRatio(const Value: Integer);
+begin
+ FMaxCompressRatio := Value;
+end;
+
+procedure TCrossHttpServer.SetMinCompressSize(const Value: Int64);
+begin
+ FMinCompressSize := Value;
+end;
+
+procedure TCrossHttpServer.SetOnRequest(const Value: TCrossHttpRequestEvent);
+begin
+ FOnRequest := Value;
+end;
+
+procedure TCrossHttpServer.SetOnRequestException(
+ const Value: TCrossHttpRequestExceptionEvent);
+begin
+ FOnRequestException := Value;
+end;
+
+procedure TCrossHttpServer.SetSessionIDCookieName(const Value: string);
+begin
+ FSessionIDCookieName := Value;
+end;
+
+procedure TCrossHttpServer.SetSessions(const Value: ISessions);
+begin
+ FSessions := Value;
+end;
+
+procedure TCrossHttpServer.SetStoragePath(const Value: string);
+begin
+ FStoragePath := Value;
+end;
+
+function TCrossHttpServer.Static(const APath,
+ ALocalStaticDir: string): ICrossHttpServer;
+var
+ LReqPath: string;
+begin
+ LReqPath := APath;
+ if not LReqPath.EndsWith('/') then
+ LReqPath := LReqPath + '/';
+ LReqPath := LReqPath + '*';
+ Result := Get(LReqPath, TNetCrossRouter.Static(ALocalStaticDir, '*'));
+end;
+
+function TCrossHttpServer.Index(const APath, ALocalDir: string;
+ const ADefIndexFiles: TArray): ICrossHttpServer;
+var
+ LReqPath: string;
+begin
+ LReqPath := APath;
+ if not LReqPath.EndsWith('/') then
+ LReqPath := LReqPath + '/';
+ LReqPath := LReqPath + '*';
+ Result := Get(LReqPath, TNetCrossRouter.Index(ALocalDir, '*', ADefIndexFiles));
+end;
+
+function TCrossHttpServer.Post(const APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Route('POST', APath, ARouterProc);
+end;
+
+function TCrossHttpServer.Post(const APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Route('POST', APath, ARouterMethod);
+end;
+
+function TCrossHttpServer.Put(const APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Route('PUT', APath, ARouterMethod);
+end;
+
+function TCrossHttpServer.Put(const APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Route('PUT', APath, ARouterProc);
+end;
+
+function TCrossHttpServer.Route(const AMethod, APath: string;
+ const ARouterProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ FRouters.AddRouter(AMethod, APath, ARouterProc);
+ Result := Self;
+end;
+
+function TCrossHttpServer.Route(const AMethod, APath: string;
+ const ARouterMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ FRouters.AddRouter(AMethod, APath, ARouterMethod);
+ Result := Self;
+end;
+
+function TCrossHttpServer.RemoveMiddleware(const AMethod,
+ APath: string): ICrossHttpServer;
+begin
+ FMiddlewares.RemoveRouter(AMethod, APath);
+ Result := Self;
+end;
+
+function TCrossHttpServer.RemoveRouter(const AMethod, APath: string): ICrossHttpServer;
+begin
+ FRouters.RemoveRouter(AMethod, APath);
+ Result := Self;
+end;
+
+function TCrossHttpServer.ClearMiddlewares: ICrossHttpServer;
+begin
+ FMiddlewares.Clear;
+ Result := Self;
+end;
+
+function TCrossHttpServer.ClearRouters: ICrossHttpServer;
+begin
+ FRouters.Clear;
+ Result := Self;
+end;
+
+procedure TCrossHttpServer.LogicReceived(const AConnection: ICrossConnection;
+ const ABuf: Pointer; const ALen: Integer);
+var
+ LConnObj: TCrossHttpConnection;
+ LBuf: Pointer;
+ LLen: Integer;
+begin
+ LConnObj := AConnection as TCrossHttpConnection;
+ LBuf := ABuf;
+ LLen := ALen;
+
+ while (LLen > 0) do
+ LConnObj.ParseRecvData(LBuf, LLen);
+
+ inherited LogicReceived(AConnection, ABuf, ALen);
+end;
+
+function TCrossHttpServer.Use(
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Use('*', '*', AMiddlewareMethod);
+end;
+
+function TCrossHttpServer.Use(
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Use('*', '*', AMiddlewareProc);
+end;
+
+function TCrossHttpServer.Use(const AMethod, APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ FMiddlewares.AddRouter(AMethod, APath, AMiddlewareMethod);
+ Result := Self;
+end;
+
+function TCrossHttpServer.Use(const AMethod, APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ FMiddlewares.AddRouter(AMethod, APath, AMiddlewareProc);
+ Result := Self;
+end;
+
+function TCrossHttpServer.Use(const APath: string;
+ const AMiddlewareMethod: TCrossHttpRouterMethod): ICrossHttpServer;
+begin
+ Result := Use('*', APath, AMiddlewareMethod);
+end;
+
+function TCrossHttpServer.Use(const APath: string;
+ const AMiddlewareProc: TCrossHttpRouterProc): ICrossHttpServer;
+begin
+ Result := Use('*', APath, AMiddlewareProc);
+end;
+
+{ TCrossHttpRequest }
+
+constructor TCrossHttpRequest.Create(const AConnection: TCrossHttpConnection);
+begin
+ FConnectionObj := AConnection;
+ FConnection := AConnection;
+ FServer := FConnection.Owner as TCrossHttpServer;
+
+ FHeader := THttpHeader.Create;
+ FCookies := TRequestCookies.Create;
+ FParams := THttpUrlParams.Create;
+ FQuery := THttpUrlParams.Create;
+end;
+
+destructor TCrossHttpRequest.Destroy;
+begin
+ FreeAndNil(FHeader);
+ FreeAndNil(FCookies);
+ FreeAndNil(FParams);
+ FreeAndNil(FQuery);
+ if (FBody = FRawBody) then
+ FBody := nil
+ else
+ FreeAndNil(FBody);
+ FreeAndNil(FRawBody);
+
+ inherited;
+end;
+
+function TCrossHttpRequest.GetAccept: string;
+begin
+ Result := FAccept;
+end;
+
+function TCrossHttpRequest.GetAcceptEncoding: string;
+begin
+ Result := FAcceptEncoding;
+end;
+
+function TCrossHttpRequest.GetAcceptLanguage: string;
+begin
+ Result := FAcceptLanguage;
+end;
+
+function TCrossHttpRequest.GetAuthorization: string;
+begin
+ Result := FAuthorization;
+end;
+
+function TCrossHttpRequest.GetBody: TObject;
+begin
+ Result := FBody;
+end;
+
+function TCrossHttpRequest.GetRawBody: TStream;
+begin
+ Result := FRawBody;
+end;
+
+function TCrossHttpRequest.GetBodyType: TBodyType;
+begin
+ Result := FBodyType;
+end;
+
+function TCrossHttpRequest.GetConnection: ICrossHttpConnection;
+begin
+ Result := FConnection;
+end;
+
+function TCrossHttpRequest.GetContentEncoding: string;
+begin
+ Result := FContentEncoding;
+end;
+
+function TCrossHttpRequest.GetContentLength: Int64;
+begin
+ Result := FContentLength;
+end;
+
+function TCrossHttpRequest.GetContentType: string;
+begin
+ Result := FContentType;
+end;
+
+function TCrossHttpRequest.GetCookies: TRequestCookies;
+begin
+ Result := FCookies;
+end;
+
+function TCrossHttpRequest.GetHeader: THttpHeader;
+begin
+ Result := FHeader;
+end;
+
+function TCrossHttpRequest.GetHostName: string;
+begin
+ Result := FHostName;
+end;
+
+function TCrossHttpRequest.GetHostPort: Word;
+begin
+ Result := FHostPort;
+end;
+
+function TCrossHttpRequest.GetIfModifiedSince: TDateTime;
+begin
+ Result := FIfModifiedSince;
+end;
+
+function TCrossHttpRequest.GetIfNoneMatch: string;
+begin
+ Result := FIfNoneMatch;
+end;
+
+function TCrossHttpRequest.GetIfRange: string;
+begin
+ Result := FIfRange;
+end;
+
+function TCrossHttpRequest.GetIsChunked: Boolean;
+begin
+ Result := FIsChunked;
+end;
+
+function TCrossHttpRequest.CalcIsChunked: Boolean;
+var
+ LEncodings: TArray;
+begin
+ // RFC 7230 §3.3.1: Transfer-Encoding 可以是逗号分隔列表, 最终编码为最后一个
+ LEncodings := FTransferEncoding.Trim.Split([',']);
+ if Length(LEncodings) > 0 then
+ Result := TStrUtils.SameText(LEncodings[Length(LEncodings) - 1].Trim, 'chunked')
+ else
+ Result := False;
+end;
+
+function TCrossHttpRequest.GetIsMultiPartFormData: Boolean;
+begin
+ Result := TStrUtils.SameText(FContentType, TMediaType.MULTIPART_FORM_DATA);
+end;
+
+function TCrossHttpRequest.GetIsUrlEncodedFormData: Boolean;
+begin
+ Result := TStrUtils.SameText(FContentType, TMediaType.APPLICATION_FORM_URLENCODED_TYPE);
+end;
+
+function TCrossHttpRequest.GetKeepAlive: Boolean;
+begin
+ Result := FKeepAlive;
+end;
+
+function TCrossHttpRequest.GetMethod: string;
+begin
+ Result := FMethod;
+end;
+
+function TCrossHttpRequest.GetParams: THttpUrlParams;
+begin
+ Result := FParams;
+end;
+
+function TCrossHttpRequest.GetQueryText: string;
+begin
+ Result := FQueryText;
+end;
+
+function TCrossHttpRequest.GetPath: string;
+begin
+ Result := FPath;
+end;
+
+function TCrossHttpRequest.GetPathAndQuery: string;
+begin
+ Result := FPathAndQuery;
+end;
+
+function TCrossHttpRequest.GetPostDataSize: Int64;
+begin
+ Result := FPostDataSize;
+end;
+
+function TCrossHttpRequest.GetQuery: THttpUrlParams;
+begin
+ Result := FQuery;
+end;
+
+function TCrossHttpRequest.GetRange: string;
+begin
+ Result := FRange;
+end;
+
+function TCrossHttpRequest.GetRawPathAndQuery: string;
+begin
+ Result := FRawPathAndQuery;
+end;
+
+function TCrossHttpRequest.GetRawRequestText: string;
+begin
+ Result := FRawRequestText;
+end;
+
+function TCrossHttpRequest.GetReferer: string;
+begin
+ Result := FReferer;
+end;
+
+function TCrossHttpRequest.GetRequestBoundary: string;
+begin
+ Result := FRequestBoundary;
+end;
+
+function TCrossHttpRequest.GetRequestCmdLine: string;
+begin
+ Result := FRequestCmdLine;
+end;
+
+function TCrossHttpRequest.GetRequestConnection: string;
+begin
+ Result := FRequestConnection;
+end;
+
+function TCrossHttpRequest.GetSession: ISession;
+begin
+ Result := FSession;
+end;
+
+function TCrossHttpRequest.GetTransferEncoding: string;
+begin
+ Result := FTransferEncoding;
+end;
+
+function TCrossHttpRequest.GetUserAgent: string;
+begin
+ Result := FUserAgent;
+end;
+
+function TCrossHttpRequest.GetVersion: string;
+begin
+ Result := FVersion;
+end;
+
+function TCrossHttpRequest.GetXForwardedFor: string;
+begin
+ Result := FXForwardedFor;
+end;
+
+function TCrossHttpRequest.ParseHeader(const ADataPtr: Pointer;
+ const ADataSize: Integer): Boolean;
+var
+ LRequestHeader, LPortStr: string;
+ LCookieValues, LCLValues: TArray;
+ LFirstCL: string;
+ I, J: Integer;
+ LPortInt: Integer;
+begin
+ Assert(Self <> nil, 'FRequest is nil');
+
+ // 整体包一层 try/except 保证任何畸形输入都以 Result := False 返回,
+ // 不会让异常上抛到 _OnHeaderData 环外. 常见调用点如:
+ // - Substring/IndexOf 上的越界 (请求行过短、缺少空格等)
+ // - LPortStr.ToInteger 遇到非数字时抛 EConvertError
+ // - THttpHeader.Decode 内部异常
+ // - FCookies.Decode 内部异常
+ // 都被这里统一归为 400 Bad Request
+ try
+ SetString(FRawRequestText, MarshaledAString(ADataPtr), ADataSize);
+
+ // 拒绝包含 NUL 字节的请求 (可能导致跨编译器字符串行为差异)
+ if (FRawRequestText.IndexOf(#0) >= 0) then
+ Exit(False);
+
+ I := FRawRequestText.IndexOf(#13#10);
+ // 第一行是请求命令行
+ // GET /home?param=123 HTTP/1.1
+ FRequestCmdLine := FRawRequestText.Substring(0, I);
+ // 第二行起是请求头
+ LRequestHeader := FRawRequestText.Substring(I + 2);
+ // 解析请求头
+ FHeader.Decode(LRequestHeader);
+
+ // 请求行必须包含三段: METHOD SP PATH SP VERSION (RFC 7230 §3.1.1)
+ // 任何一段为空都不合法, 否则会出现:
+ // - FMethod=='' 导致路由匹配疑难
+ // - FVersion 含错位片段 (如 "GET") 导致 _CreateHeader 输出伪 HTTP 状态行
+ // 这里在拆分前先检查两个空格的位置严格递增, 三段均非空
+ I := FRequestCmdLine.IndexOf(' ');
+ if (I <= 0) then Exit(False);
+ J := FRequestCmdLine.IndexOf(' ', I + 1);
+ if (J <= I + 1) or (J >= FRequestCmdLine.Length - 1) then Exit(False);
+
+ // 请求方法(GET, POST, PUT, DELETE...)
+ FMethod := FRequestCmdLine.Substring(0, I).ToUpper;
+
+ // 路径及参数(/home?param=123)
+ FRawPathAndQuery := FRequestCmdLine.Substring(I + 1, J - I - 1);
+
+ // 请求的HTTP版本(HTTP/1.1)
+ FVersion := FRequestCmdLine.Substring(J + 1).ToUpper;
+
+ // 解析?key1=value1&key2=value2参数
+ J := FRawPathAndQuery.IndexOf('?');
+ if (J < 0) then
+ begin
+ FRawPath := FRawPathAndQuery;
+ FRawQueryText := '';
+ FQueryText := '';
+ end else
+ begin
+ FRawPath := FRawPathAndQuery.Substring(0, J);
+ FRawQueryText := FRawPathAndQuery.Substring(J + 1);
+ FQueryText := TCrossHttpUtils.UrlDecode(FRawQueryText);
+ end;
+
+ FPath := TCrossHttpUtils.UrlDecode(FRawPath);
+ FPathAndQuery := FPath;
+ if (FQueryText <> '') then
+ FPathAndQuery := FPathAndQuery + '?' + FQueryText;
+
+ FQuery.Decode(FRawQueryText);
+
+ // HTTP协议版本
+ if (FVersion = '') then
+ FVersion := 'HTTP/1.0';
+ if (FVersion = 'HTTP/1.0') then
+ FHttpVerNum := 10
+ else
+ FHttpVerNum := 11;
+ FKeepAlive := (FHttpVerNum = 11);
+
+ FContentType := FHeader[HEADER_CONTENT_TYPE];
+ FRequestBoundary := '';
+ J := FContentType.IndexOf(';');
+ if (J >= 0) then
+ begin
+ // RFC 2046: 分号前后允许有任意空白, 兼容 "; boundary=" 和 ";boundary=" 两种格式
+ FRequestBoundary := FContentType.Substring(J + 1).Trim;
+ if FRequestBoundary.StartsWith('boundary=', True) then
+ FRequestBoundary := FRequestBoundary.Substring(9);
+
+ FContentType := FContentType.Substring(0, J).Trim;
+ end;
+
+ // RFC 7230 §3.3.2: 多个 Content-Length 值不同时必须拒绝请求
+ if FHeader.GetHeaderValues(HEADER_CONTENT_LENGTH, LCLValues) and (Length(LCLValues) > 0) then
+ begin
+ LFirstCL := LCLValues[0].Trim;
+ for I := 1 to High(LCLValues) do
+ if not TStrUtils.SameText(LCLValues[I].Trim, LFirstCL) then
+ Exit(False);
+ FContentLength := StrToInt64Def(LFirstCL, -1);
+ end else
+ FContentLength := -1;
+
+ // IPv4: 192.168.1.100:8080
+ // 192.168.1.100
+ // IPv6: [fc00::20:80:5:2]:8080
+ // [fc00::20:80:5:2]
+ FRequestHost := FHeader[HEADER_HOST];
+ LPortStr := '';
+
+ J := FRequestHost.IndexOf(']');
+ if (J >= 0) then
+ begin
+ FHostName := FRequestHost.Substring(1, J - 1);
+ J := FRequestHost.IndexOf(':', J);
+ if (J >= 0) then
+ LPortStr := FRequestHost.Substring(J + 1);
+ end else
+ begin
+ J := FRequestHost.IndexOf(':');
+ if (J >= 0) then
+ begin
+ FHostName := FRequestHost.Substring(0, J);
+ LPortStr := FRequestHost.Substring(J + 1);
+ end else
+ FHostName := FRequestHost;
+ end;
+ // RFC 7230 §5.4: Host 头中 port 必须是十进制数字. 这里用 TryStrToInt
+ // 避免 ToInteger 在畸形输入 (如 "abc"、超出 Int32 范围) 时抛 EConvertError;
+ // 超出 Word (0..65535) 范围亦视为非法 port, 不静默截断高位
+ if (LPortStr <> '') then
+ begin
+ if not TryStrToInt(LPortStr, LPortInt)
+ or (LPortInt < 0) or (LPortInt > High(Word)) then
+ Exit(False);
+ FHostPort := Word(LPortInt);
+ end else
+ FHostPort := GetConnection.Server.Port;
+
+ FRequestConnection := FHeader[HEADER_CONNECTION];
+ // HTTP/1.0 默认KeepAlive=False，只有显示指定了Connection: keep-alive才认为KeepAlive=True
+ // HTTP/1.1 默认KeepAlive=True，只有显示指定了Connection: close才认为KeepAlive=False
+ if FHttpVerNum = 10 then
+ FKeepAlive := TStrUtils.SameText(FRequestConnection, 'keep-alive')
+ else if TStrUtils.SameText(FRequestConnection, 'close') then
+ FKeepAlive := False;
+
+ FTransferEncoding := FHeader[HEADER_TRANSFER_ENCODING];
+ FIsChunked := CalcIsChunked;
+ FContentEncoding := FHeader[HEADER_CONTENT_ENCODING];
+ FAccept := FHeader[HEADER_ACCEPT];
+ FReferer := FHeader[HEADER_REFERER];
+ FAcceptLanguage := FHeader[HEADER_ACCEPT_LANGUAGE];
+ FAcceptEncoding := FHeader[HEADER_ACCEPT_ENCODING];
+ FUserAgent := FHeader[HEADER_USER_AGENT];
+ FAuthorization := FHeader[HEADER_AUTHORIZATION];
+ // 获取并解析 Cookie 头
+ // RFC 6265 建议客户端只发送一个 Cookie 头
+ // 但部分代理/旧客户端可能拆分成多行，按 RFC 7230 §3.2.2 合并处理
+ if FHeader.GetHeaderValues(HEADER_COOKIE, LCookieValues)
+ and (Length(LCookieValues) > 0) then
+ begin
+ // RFC 6265 建议客户端只发送一个 Cookie 头
+ // 但部分代理/旧客户端可能拆分成多行，按 RFC 7230 §3.2.2 合并处理
+ if (Length(LCookieValues) = 1) then
+ FRequestCookies := LCookieValues[0]
+ else
+ FRequestCookies := string.Join('; ', LCookieValues);
+ end else
+ FRequestCookies := '';
+ FIfModifiedSince := TCrossHttpUtils.RFC1123_StrToDate(FHeader[HEADER_IF_MODIFIED_SINCE]);
+ FIfNoneMatch := FHeader[HEADER_IF_NONE_MATCH];
+ FRange := FHeader[HEADER_RANGE];
+ FIfRange := FHeader[HEADER_IF_RANGE];
+ FXForwardedFor:= FHeader[HEADER_X_FORWARDED_FOR];
+
+ // 解析Cookies
+ if (FRequestCookies <> '') then
+ begin
+ if not FCookies.Decode(FRequestCookies, True) then Exit(False);
+ end else
+ FCookies.Clear;
+
+ if IsMultiPartFormData then
+ FBodyType := btMultiPart
+ else if IsUrlEncodedFormData then
+ FBodyType := btUrlEncoded
+ else
+ FBodyType := btBinary;
+
+ Result := True;
+ except
+ // 任何解析异常都归一为 Result := False, 由 _OnHeaderData 发 400.
+ // 不记详细错误原因 (不足类型安全且可能被恶意请求刷日志),
+ // 需要调试时可临时加 Logger 输出.
+ on Exception do
+ Result := False;
+ end;
+end;
+
+{ TCrossHttpResponse }
+
+constructor TCrossHttpResponse.Create(const AConnection: TCrossHttpConnection;
+ const ARequest: ICrossHttpRequest;
+ const AQueueItem: IHttpResponseQueueItem);
+begin
+ FConnectionObj := AConnection;
+ FConnection := AConnection;
+ FRequest := ARequest;
+ FQueueItem := AQueueItem;
+ FHeader := THttpHeader.Create;
+ FCookies := TResponseCookies.Create;
+ FStatusCode := 200;
+end;
+
+destructor TCrossHttpResponse.Destroy;
+begin
+ FreeAndNil(FHeader);
+ FreeAndNil(FCookies);
+ FQueueItem := nil;
+ inherited;
+end;
+
+procedure TCrossHttpResponse.Download(const AFileName: string;
+ const ACallback: TCrossConnectionCallback);
+begin
+ Attachment(AFileName);
+ SendFile(AFileName, ACallback);
+end;
+
+function TCrossHttpResponse.GetConnection: ICrossHttpConnection;
+begin
+ Result := FConnection;
+end;
+
+function TCrossHttpResponse.GetContentType: string;
+begin
+ Result := FHeader[HEADER_CONTENT_TYPE];
+end;
+
+function TCrossHttpResponse.GetCookies: TResponseCookies;
+begin
+ Result := FCookies;
+end;
+
+function TCrossHttpResponse.GetHeader: THttpHeader;
+begin
+ Result := FHeader;
+end;
+
+function TCrossHttpResponse.GetLocation: string;
+begin
+ Result := FHeader[HEADER_LOCATION];
+end;
+
+function TCrossHttpResponse.GetRequest: ICrossHttpRequest;
+begin
+ Result := FRequest;
+end;
+
+function TCrossHttpResponse.GetSent: Boolean;
+begin
+ Result := (AtomicCmpExchange(FSendStatus, 0, 0) > 0);
+end;
+
+function TCrossHttpResponse.GetStatusCode: Integer;
+begin
+ Result := FStatusCode;
+end;
+
+function TCrossHttpResponse.GetStatusText: string;
+begin
+ Result := FStatusText;
+end;
+
+procedure TCrossHttpResponse.Json(const AJson: string;
+ const ACallback: TCrossConnectionCallback);
+begin
+ SetContentType(TMediaType.APPLICATION_JSON_UTF8);
+ Send(AJson, ACallback);
+end;
+
+procedure TCrossHttpResponse.Redirect(const AUrl: string; const ACallback: TCrossConnectionCallback);
+begin
+ SetLocation(AUrl);
+ SendStatus(302, '', ACallback);
+end;
+
+procedure TCrossHttpResponse.Reset;
+begin
+ FSendStatus := 0;
+ FStatusCode := 200;
+ FHeader.Clear;
+ FCookies.Clear;
+end;
+
+procedure TCrossHttpResponse.Attachment(const AFileName: string);
+begin
+ if (GetContentType = '') then
+ SetContentType(TCrossHttpUtils.GetFileMIMEType(AFileName));
+ FHeader[HEADER_CONTENT_DISPOSITION] := 'attachment; filename="' +
+ TCrossHttpUtils.UrlEncode(ExtractFileName(AFileName)) + '"';
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: Pointer; const ACount: NativeInt;
+ const ACallback: TCrossConnectionCallback);
+var
+ LCompressType: TCompressType;
+begin
+ if _CheckCompress(ACount, LCompressType) then
+ SendZCompress(ABody, ACount, LCompressType, ACallback)
+ else
+ SendNoCompress(ABody, ACount, ACallback);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody; const ACount: NativeInt;
+ const ACallback: TCrossConnectionCallback);
+begin
+ Send(@ABody, ACount, ACallback);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: TBytes;
+ const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+ LOffset, LCount: NativeInt;
+begin
+ // 增加其引用计数
+ LBody := ABody;
+
+ LOffset := AOffset;
+ LCount := ACount;
+ TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
+
+ Send(Pointer(PByte(LBody) + LOffset), LCount,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ // 减少引用计数
+ LBody := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: TBytes;
+ const ACallback: TCrossConnectionCallback);
+begin
+ Send(ABody, 0, Length(ABody), ACallback);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: TStream;
+ const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback);
+var
+ LCompressType: TCompressType;
+begin
+ if (ABody <> nil) and _CheckCompress(ABody.Size, LCompressType) then
+ SendZCompress(ABody, AOffset, ACount, LCompressType, ACallback)
+ else
+ SendNoCompress(ABody, AOffset, ACount, ACallback);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: TStream;
+ const ACallback: TCrossConnectionCallback);
+begin
+ Send(ABody, 0, 0, ACallback);
+end;
+
+procedure TCrossHttpResponse.Send(const ABody: string;
+ const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+begin
+ LBody := TEncoding.UTF8.GetBytes(ABody);
+ if (GetContentType = '') then
+ SetContentType(TMediaType.TEXT_HTML_UTF8);
+
+ Send(LBody, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(
+ const AChunkSource: TCrossHttpChunkDataFunc;
+ const ACallback: TCrossConnectionCallback);
+{
+HTTP头\r\n\r\n
+块尺寸\r\n
+块内容
+\r\n块尺寸\r\n
+块内容
+\r\n0\r\n\r\n
+}
+type
+ TChunkState = (csHead, csBody, csDone);
+const
+ CHUNK_END: array [0..6] of Byte = (13, 10, 48, 13, 10, 13, 10); // \r\n0\r\n\r\n
+var
+ LHeaderBytes, LChunkHeader: TBytes;
+ LChunked, LIsFirstChunk: Boolean;
+ LChunkState: TChunkState;
+ LChunkData: Pointer;
+ LChunkSize: NativeInt;
+begin
+ // 先取出第一个数据块
+ // 如果有数据才需要使用 chunked 方式发送数据
+ if Assigned(AChunkSource) then
+ begin
+ LChunked := AChunkSource(@LChunkData, @LChunkSize)
+ and (LChunkData <> nil)
+ and (LChunkSize > 0);
+ end else
+ LChunked := False;
+
+ LIsFirstChunk := True;
+ LChunkState := csHead;
+
+ _Send(
+ // HEADER
+ function(const AData: PPointer; const ADataSize: PNativeInt): Boolean
+ begin
+ LHeaderBytes := _CreateHeader(0, LChunked);
+
+ AData^ := @LHeaderBytes[0];
+ ADataSize^ := Length(LHeaderBytes);
+
+ Result := (ADataSize^ > 0);
+ end,
+ // BODY
+ function(const AData: PPointer; const ADataSize: PNativeInt): Boolean
+ begin
+ if not LChunked then Exit(False);
+
+ case LChunkState of
+ csHead:
+ begin
+ if LIsFirstChunk then
+ begin
+ LIsFirstChunk := False;
+ LChunkHeader := [];
+ end else
+ begin
+ LChunkData := nil;
+ LChunkSize := 0;
+ if not Assigned(AChunkSource)
+ or not AChunkSource(@LChunkData, @LChunkSize)
+ or (LChunkData = nil)
+ or (LChunkSize <= 0) then
+ begin
+ LChunkState := csDone;
+
+ AData^ := @CHUNK_END[0];
+ ADataSize^ := Length(CHUNK_END);
+
+ Result := (ADataSize^ > 0);
+
+ Exit;
+ end;
+
+ LChunkHeader := [13, 10];
+ end;
+
+ // FPC编译器在Linux下有BUG(FPC 3.3.1)
+ // 无法将函数返回的字节数组直接与其它字节数组使用加号拼接
+ // 实际上使用加号拼接字节数组还有其它各种异常
+ // 所以改用我的TArrayUtils.Concat进行拼接
+ LChunkHeader := TArrayUtils.Concat([
+ LChunkHeader,
+ TEncoding.ASCII.GetBytes(IntToHex(LChunkSize, 0)),
+ [13, 10]
+ ]);
+
+ LChunkState := csBody;
+
+ AData^ := @LChunkHeader[0];
+ ADataSize^ := Length(LChunkHeader);
+
+ Result := (ADataSize^ > 0);
+ end;
+
+ csBody:
+ begin
+ LChunkState := csHead;
+
+ AData^ := LChunkData;
+ ADataSize^ := LChunkSize;
+
+ Result := (ADataSize^ > 0);
+ end;
+
+ csDone:
+ begin
+ Result := False;
+ end;
+ else
+ Result := False;
+ end;
+ end,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ LHeaderBytes := nil;
+ LChunkHeader := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendFile(const AFileName: string;
+ const ACallback: TCrossConnectionCallback);
+var
+ LStream: TStream;
+ LLastModified: TDateTime;
+ LRequest: TCrossHttpRequest;
+ LLastModifiedStr, LETag: string;
+ LRangeStr: string;
+ LRangeBegin, LRangeEnd, LOffset, LCount, LFileSize: Int64;
+begin
+ if not FileExists(AFileName) then
+ begin
+ FHeader.Remove(HEADER_CONTENT_DISPOSITION);
+ SendStatus(404, ACallback);
+ Exit;
+ end;
+
+ if (GetContentType = '') then
+ SetContentType(TCrossHttpUtils.GetFileMIMEType(AFileName));
+
+ try
+ // 根据请求头中的时间戳决定是否需要发送文件数据
+ // 当请求头中的时间戳与文件时间一致时, 浏览器会自动从本地加载文件数据
+ // 服务端无需发送文件数据
+ LRequest := GetRequest as TCrossHttpRequest;
+ LLastModified := TFileUtils.GetLastWriteTime(AFileName);
+
+ if (LRequest.IfModifiedSince > 0) and (LRequest.IfModifiedSince >= (LLastModified - (1 / SecsPerDay))) then
+ begin
+ // 304不要带任何body数据, 否则部分浏览器会报告无效的RESPONSE
+ SendStatus(304, '', ACallback);
+ Exit;
+ end;
+
+ LLastModifiedStr := TCrossHttpUtils.RFC1123_DateToStr(LLastModified);
+
+ LETag := '"' + TUtils.BytesToHex(THashMD5.GetHashBytes(
+ ExtractFileName(AFileName) + LLastModifiedStr)) + '"';
+ if (LRequest.IfNoneMatch = LETag) then
+ begin
+ // 304不要带任何body数据, 否则部分浏览器会报告无效的RESPONSE
+ SendStatus(304, '', ACallback);
+ Exit;
+ end;
+
+ LStream := TFileUtils.OpenRead(AFileName, fmShareDenyNone);
+ except
+ on e: Exception do
+ begin
+ FHeader.Remove(HEADER_CONTENT_DISPOSITION);
+ SendStatus(404, TStrUtils.Format('%s, %s', [e.ClassName, e.Message]), ACallback);
+ Exit;
+ end;
+ end;
+
+ LFileSize := LStream.Size;
+
+ // 在响应头中加入文件时间戳
+ // 浏览器会根据该时间戳决定是否从本地缓存中直接加载数据
+ FHeader[HEADER_LAST_MODIFIED] := LLastModifiedStr;
+ FHeader[HEADER_ETAG] := LETag;
+
+ // 告诉浏览器支持分块传输
+ FHeader[HEADER_ACCEPT_RANGES] := 'bytes';
+
+ // Range 请求处理 (RFC 7233 §3.1)
+ // 仅当 Range 头存在且 If-Range 校验通过 (无 If-Range 或 If-Range == ETag) 时才走分块逻辑.
+ // If-Range 不匹配时, RFC 7233 §3.2 要求回退为完整 200 响应.
+ LRangeStr := LRequest.Range;
+ if (LRangeStr <> '')
+ and ((LRequest.IfRange = '') or (LRequest.IfRange = LETag)) then
+ begin
+ if not TCrossHttpUtils.ParseSingleByteRange(LRangeStr, LFileSize, LRangeBegin, LRangeEnd) then
+ begin
+ // 不可满足的 Range -> 416 Range Not Satisfiable (RFC 7233 §4.4)
+ // 必须返回 Content-Range: bytes */ 告知客户端实际资源大小.
+ FreeAndNil(LStream);
+ FHeader.Remove(HEADER_CONTENT_DISPOSITION);
+ FHeader[HEADER_CONTENT_RANGE] := TStrUtils.Format('bytes */%d', [LFileSize]);
+ SendStatus(416, ACallback);
+ Exit;
+ end;
+
+ LOffset := LRangeBegin;
+ LCount := LRangeEnd - LRangeBegin + 1;
+
+ // 返回分块信息
+ // Content-Range: bytes -/
+ FHeader[HEADER_CONTENT_RANGE] := TStrUtils.Format('bytes %d-%d/%d',
+ [LRangeBegin, LRangeEnd, LFileSize]);
+
+ // 断点续传需要返回206状态码, 而不是200
+ FStatusCode := 206;
+ end else
+ begin
+ LOffset := 0;
+ LCount := LFileSize;
+ end;
+
+ // 206 Range 响应禁止压缩：Content-Range 描述的是原始字节偏移，
+ // 压缩后字节与范围不对应，会导致断点续传客户端数据错乱 (RFC 7233)
+ SendNoCompress(LStream, LOffset, LCount,
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ FreeAndNil(LStream);
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SetContentType(const Value: string);
+begin
+ FHeader[HEADER_CONTENT_TYPE] := Value;
+end;
+
+procedure TCrossHttpResponse.SetLocation(const Value: string);
+begin
+ FHeader[HEADER_LOCATION] := Value;
+end;
+
+procedure TCrossHttpResponse.SetStatusCode(Value: Integer);
+begin
+ FStatusCode := Value;
+end;
+
+procedure TCrossHttpResponse.SetStatusText(const Value: string);
+begin
+ FStatusText := Value;
+end;
+
+function TCrossHttpResponse._CheckCompress(const ABodySize: Int64;
+ out ACompressType: TCompressType): Boolean;
+var
+ LContType, LRequestAcceptEncoding, LEnc, LQPart: string;
+ LServer: ICrossHttpServer;
+ LEncodings: TArray;
+ I, LQSep: Integer;
+ LGzipQ, LDeflateQ, LBestQ: Double;
+begin
+ LContType := GetContentType;
+ LServer := GetConnection.Server;
+
+ if Assigned(LServer)
+ and LServer.Compressible
+ and (ABodySize > 0)
+ and ((LServer.MinCompressSize <= 0) or (ABodySize >= LServer.MinCompressSize))
+ and ((Pos('text/', LContType.ToLower) > 0)
+ or (Pos('application/json', LContType.ToLower) > 0)
+ or (Pos('javascript', LContType.ToLower) > 0)
+ or (Pos('xml', LContType.ToLower) > 0)
+ ) then
+ begin
+ LRequestAcceptEncoding := GetRequest.AcceptEncoding;
+
+ // 按 q-value 排序选最优编码 (RFC 7231 §5.3.4).
+ // q 值越高优先级越高, 缺省 q=1.0; q=0 表示明确拒绝.
+ LEncodings := LRequestAcceptEncoding.Split([',']);
+ begin
+ LGzipQ := 0;
+ LDeflateQ := 0;
+ for I := 0 to High(LEncodings) do
+ begin
+ LEnc := LEncodings[I].Trim;
+ LQSep := LEnc.IndexOf(';');
+ LBestQ := 1.0;
+ if LQSep >= 0 then
+ begin
+ LQPart := LEnc.Substring(LQSep + 1).Trim.ToLower;
+ LEnc := LEnc.Substring(0, LQSep).Trim;
+ if LQPart.StartsWith('q=') then
+ LBestQ := StrToFloatDef(Copy(LQPart, 3, MaxInt), 0);
+ if LBestQ <= 0 then
+ Continue;
+ end;
+ if TStrUtils.SameText(LEnc, 'gzip') and (LBestQ > LGzipQ) then
+ LGzipQ := LBestQ
+ else if TStrUtils.SameText(LEnc, 'deflate') and (LBestQ > LDeflateQ) then
+ LDeflateQ := LBestQ;
+ end;
+ // 优先 gzip (服务器普遍偏好); 仅当 deflate q 严格更高时选 deflate
+ if (LGzipQ > 0) and (LGzipQ >= LDeflateQ) then
+ begin
+ ACompressType := ctGZip;
+ Exit(True);
+ end;
+ if LDeflateQ > 0 then
+ begin
+ ACompressType := ctDeflate;
+ Exit(True);
+ end;
+ end;
+ end;
+
+ ACompressType := ctNone;
+ Result := False;
+end;
+
+function TCrossHttpResponse._GetMemoryStreamPointer(const AStream: TStream;
+ const AOffset, ACount: Int64; out P: PByte; out LSize: Int64): Boolean;
+begin
+ if (AStream is TCustomMemoryStream) then
+ begin
+ P := PByte(TCustomMemoryStream(AStream).Memory) + AOffset;
+ LSize := ACount;
+ Exit(True);
+ end;
+ Result := False;
+end;
+
+function TCrossHttpResponse._CreateHeader(const ABodySize: Int64;
+ AChunked: Boolean): TBytes;
+var
+ LHeaderStr, LStatusText, LHttpVersion: string;
+ LCookie: TResponseCookie;
+begin
+ if (GetContentType = '') then
+ SetContentType(TMediaType.APPLICATION_OCTET_STREAM);
+ if (FHeader[HEADER_CONNECTION] = '') then
+ begin
+ if (FStatusCode >= 400) or (not FRequest.KeepAlive) then
+ FHeader[HEADER_CONNECTION] := 'close'
+ else
+ FHeader[HEADER_CONNECTION] := 'keep-alive';
+ end;
+
+ if (FStatusCode = 204) or (FStatusCode = 304) then
+ begin
+ FHeader.Remove(HEADER_CONTENT_LENGTH);
+ FHeader.Remove(HEADER_TRANSFER_ENCODING);
+ end
+ else if AChunked then
+ begin
+ FHeader[HEADER_TRANSFER_ENCODING] := 'chunked';
+ FHeader.Remove(HEADER_CONTENT_LENGTH);
+ end else
+ begin
+ FHeader[HEADER_CONTENT_LENGTH] := ABodySize.ToString;
+ FHeader.Remove(HEADER_TRANSFER_ENCODING);
+ end;
+
+ if (FHeader[HEADER_CROSS_HTTP_SERVER] = '') then
+ FHeader[HEADER_CROSS_HTTP_SERVER] := CROSS_HTTP_SERVER_NAME;
+
+ if (FStatusText <> '') then
+ begin
+ if TCrossHttpUtils.IsValidHeaderValue(FStatusText) then
+ LStatusText := FStatusText
+ else
+ begin
+ _Log('_CreateHeader: FStatusText contains invalid chars, falling back to default');
+ LStatusText := TCrossHttpUtils.GetHttpStatusText(FStatusCode);
+ end;
+ end else
+ LStatusText := TCrossHttpUtils.GetHttpStatusText(FStatusCode);
+
+ // Parser 在 psHeader 阶段早失败时, ParseHeader 尚未运行, FRequest.Version 为空.
+ // 必须回退到 'HTTP/1.1', 否则状态行成 ' 400 Bad Request' (缺版本前缀, 客户端无法识别).
+ LHttpVersion := FRequest.Version;
+ if (LHttpVersion = '') then
+ LHttpVersion := 'HTTP/1.1';
+ LHeaderStr := LHttpVersion + ' ' + FStatusCode.ToString + ' ' +
+ LStatusText + #13#10;
+
+ for LCookie in FCookies do
+ begin
+ try
+ LHeaderStr := LHeaderStr + HEADER_SETCOOKIE + ': ' + LCookie.Encode + #13#10;
+ except
+ on E: Exception do
+ begin
+ _Log('TCrossHttpResponse._CreateHeader: skip invalid cookie: %s', [E.Message]);
+ Continue;
+ end;
+ end;
+ end;
+
+ LHeaderStr := LHeaderStr + FHeader.Encode;
+
+ Result := TEncoding.ASCII.GetBytes(LHeaderStr);
+end;
+
+procedure TCrossHttpResponse._Send(const ASource: TCrossHttpChunkDataFunc;
+ const ACallback: TCrossConnectionCallback);
+begin
+ // 用 AtomicCmpExchange 抢首次发送权限: 如果已有 Send 调用, 直接拒绝.
+ // 防止两个 Send 之间的 Source/Callback 覆盖导致第一个 callback 永远不触发.
+ if AtomicCmpExchange(FSendStatus, 1, 0) <> 0 then
+ begin
+ if Assigned(ACallback) then
+ ACallback(FConnection, False);
+ Exit;
+ end;
+
+ if (FConnectionObj = nil) or (FQueueItem = nil) then
+ begin
+ if Assigned(ACallback) then
+ ACallback(FConnection, False);
+ Exit;
+ end;
+
+ FConnectionObj._QueueResponseReady(FQueueItem, ASource, ACallback);
+end;
+
+procedure TCrossHttpResponse._Send(const AHeaderSource,
+ ABodySource: TCrossHttpChunkDataFunc;
+ const ACallback: TCrossConnectionCallback);
+var
+ LHeaderDone: Boolean;
+begin
+ // HEAD 请求不应包含响应体 (RFC 7231 §4.3.2)
+ if (FRequest.Method = 'HEAD') then
+ begin
+ _Send(AHeaderSource, ACallback);
+ Exit;
+ end;
+
+ LHeaderDone := False;
+
+ _Send(
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ if not LHeaderDone then
+ begin
+ LHeaderDone := True;
+ Result := Assigned(AHeaderSource) and AHeaderSource(AData, ACount);
+ end else
+ begin
+ Result := Assigned(ABodySource) and ABodySource(AData, ACount);
+ end;
+ end,
+ ACallback);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: Pointer;
+ const ACount: NativeInt; const ACallback: TCrossConnectionCallback);
+{
+HTTP头\r\n\r\n
+内容
+}
+var
+ P: PByte;
+ LSize: NativeInt;
+ LHeaderBytes: TBytes;
+begin
+ P := ABody;
+ LSize := ACount;
+
+ _Send(
+ // HEADER
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ LHeaderBytes := _CreateHeader(LSize, False);
+
+ AData^ := @LHeaderBytes[0];
+ ACount^ := Length(LHeaderBytes);
+
+ Result := (ACount^ > 0);
+ end,
+ // BODY
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ AData^ := P;
+ ACount^ := Min(LSize, SND_BUF_SIZE);
+ Result := (ACount^ > 0);
+
+ if (LSize > SND_BUF_SIZE) then
+ begin
+ Inc(P, SND_BUF_SIZE);
+ Dec(LSize, SND_BUF_SIZE);
+ end else
+ begin
+ LSize := 0;
+ P := nil;
+ end;
+ end,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ LHeaderBytes := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody; const ACount: NativeInt;
+ const ACallback: TCrossConnectionCallback);
+begin
+ SendNoCompress(@ABody, ACount, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: TBytes;
+ const AOffset, ACount: NativeInt; const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+ LOffset, LCount: NativeInt;
+begin
+ // 增加其引用计数
+ LBody := ABody;
+
+ LOffset := AOffset;
+ LCount := ACount;
+ TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
+
+ SendNoCompress(Pointer(PByte(LBody) + LOffset), LCount,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ // 减少引用计数
+ LBody := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: TBytes;
+ const ACallback: TCrossConnectionCallback);
+begin
+ SendNoCompress(ABody, 0, Length(ABody), ACallback);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: TStream;
+ const AOffset, ACount: Int64; const ACallback: TCrossConnectionCallback);
+var
+ LOffset, LCount: Int64;
+ LBody: TStream;
+ LHeaderBytes, LBuffer: TBytes;
+ LP: PByte;
+ LSize: Int64;
+begin
+ if (ABody = nil) then
+ begin
+ SendNoCompress(nil, 0, ACallback);
+ Exit;
+ end;
+
+ LOffset := AOffset;
+ LCount := ACount;
+ TCrossHttpUtils.AdjustOffsetCount(ABody.Size, LOffset, LCount);
+
+ if _GetMemoryStreamPointer(ABody, LOffset, LCount, LP, LSize) then
+ begin
+ SendNoCompress(LP^, LSize, ACallback);
+ Exit;
+ end;
+
+ LBody := ABody;
+ LBody.Position := LOffset;
+
+ SetLength(LBuffer, SND_BUF_SIZE);
+
+ _Send(
+ // HEADER
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ LHeaderBytes := _CreateHeader(LCount, False);
+
+ AData^ := @LHeaderBytes[0];
+ ACount^ := Length(LHeaderBytes);
+
+ Result := (ACount^ > 0);
+ end,
+ // BODY
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ if (LCount <= 0) then Exit(False);
+
+ AData^ := @LBuffer[0];
+ ACount^ := LBody.Read(LBuffer[0], Min(LCount, SND_BUF_SIZE));
+
+ Result := (ACount^ > 0);
+
+ if Result then
+ Dec(LCount, ACount^);
+ end,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ LHeaderBytes := nil;
+ LBuffer := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: TStream;
+ const ACallback: TCrossConnectionCallback);
+begin
+ SendNoCompress(ABody, 0, 0, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendNoCompress(const ABody: string;
+ const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+begin
+ LBody := TEncoding.UTF8.GetBytes(ABody);
+ if (GetContentType = '') then
+ SetContentType(TMediaType.TEXT_HTML_UTF8);
+
+ SendNoCompress(LBody, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendStatus(const AStatusCode: Integer;
+ const ADescription: string; const ACallback: TCrossConnectionCallback);
+begin
+ SetStatusCode(AStatusCode);
+ Send(ADescription, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendStatus(const AStatusCode: Integer;
+ const ACallback: TCrossConnectionCallback);
+begin
+ SendStatus(AStatusCode, TCrossHttpUtils.GetHttpStatusText(AStatusCode), ACallback);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(
+ const AChunkSource: TCrossHttpChunkDataFunc;
+ const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
+{
+ 本方法实现了一边压缩一边发送数据, 所以可以支持无限大的分块数据的压缩发送,
+ 而不用占用太多的内存和CPU
+
+ zlib参考手册: http://www.zlib.net/zlib_how.html
+}
+var
+ LZStream: TZStreamRec;
+ LZFlush: Integer;
+ LZResult: Integer;
+ LOutSize: Integer;
+ LBuffer: TBytes;
+ LZError: Boolean;
+begin
+ if (ACompressType = ctNone) then
+ begin
+ SendNoCompress(AChunkSource, ACallback);
+ Exit;
+ end;
+
+ // 返回压缩方式
+ FHeader[HEADER_CONTENT_ENCODING] := ZLIB_CONTENT_ENCODING[ACompressType];
+
+ // 明确告知缓存服务器按照 Accept-Encoding 字段的内容, 分别缓存不同的版本
+ FHeader[HEADER_VARY] := HEADER_ACCEPT_ENCODING;
+
+ SetLength(LBuffer, SND_BUF_SIZE);
+
+ FillChar(LZStream, SizeOf(TZStreamRec), 0);
+ LZResult := Z_OK;
+ LZFlush := Z_NO_FLUSH;
+
+ if (deflateInit2(LZStream, Z_DEFAULT_COMPRESSION,
+ Z_DEFLATED, ZLIB_WINDOW_BITS[ACompressType], 8, Z_DEFAULT_STRATEGY) <> Z_OK) then
+ begin
+ SetStatusCode(500);
+ if (FQueueItem <> nil) then
+ FQueueItem.StatusCode := 500;
+ // 走正常队列流程: _Send → _QueueResponseReady → _SendQueueItem
+ // → body 为空立即返回 False → _FinishQueueItem (配合 StatusCode>=500 触发 Disconnect) → ACallback 在锁外异步通知
+ SendNoCompress(nil, 0, ACallback);
+ Exit;
+ end;
+
+ LZError := False;
+
+ SendNoCompress(
+ // CHUNK
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ var
+ LChunkData: Pointer;
+ LChunkSize: NativeInt;
+ begin
+ repeat
+ // 当 deflate(LZStream, Z_FINISH) 被调用后
+ // 返回 Z_STREAM_END 表示所有数据处理完毕
+ if (LZResult = Z_STREAM_END) then
+ begin
+ AData^ := nil;
+ ACount^ := 0;
+ Exit(False);
+ end;
+
+ // 输入缓冲区已经处理完毕
+ // 需要填入新数据
+ if (LZStream.avail_in = 0) then
+ begin
+ LChunkData := nil;
+ LChunkSize := 0;
+ if not Assigned(AChunkSource)
+ or not AChunkSource(@LChunkData, @LChunkSize)
+ or (LChunkData = nil)
+ or (LChunkSize <= 0) then
+ LZFlush := Z_FINISH // 如果没有后续数据了, 准备结束压缩
+ else
+ LZFlush := Z_NO_FLUSH;
+
+ // 压缩数据输入缓冲区
+ LZStream.avail_in := LChunkSize;
+ LZStream.next_in := LChunkData;
+ end;
+
+ // 压缩数据输出缓冲区
+ LZStream.avail_out := SND_BUF_SIZE;
+ LZStream.next_out := @LBuffer[0];
+
+ // 进行压缩处理
+ // 输入缓冲区数据可以大于输出缓冲区
+ // 这种情况可以多次调用 deflate 分批压缩,
+ // 直到 avail_in=0 表示当前输入缓冲区数据已压缩完毕
+ LZResult := deflate(LZStream, LZFlush);
+
+ // 压缩出错之后直接结束
+ // 这里也可能会返回 Z_STREAM_END(1)
+ // 返回 Z_STREAM_END(1) 这一次还是有数据的
+ // 所以要到下次 CHUNK 函数被调用的时候再结束
+ if (LZResult < 0) then
+ begin
+ LZError := True; // 标记压缩错误，回调中将向调用方传递 False
+ // 标记 500 以触发 _FinishQueueItem 中 LNeedDisconnect 断开连接
+ if (FQueueItem <> nil) then
+ FQueueItem.StatusCode := 500;
+ AData^ := nil;
+ ACount^ := 0;
+ Exit(False);
+ end;
+
+ // 已压缩完成的数据大小
+ LOutSize := SND_BUF_SIZE - LZStream.avail_out;
+ until (LOutSize > 0);
+
+ // 已压缩的数据
+ AData^ := @LBuffer[0];
+ ACount^ := LOutSize;
+
+ Result := (ACount^ > 0);
+ end,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ LBuffer := nil;
+ deflateEnd(LZStream);
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess and not LZError);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: Pointer;
+ const ACount: NativeInt; const ACompressType: TCompressType;
+ const ACallback: TCrossConnectionCallback);
+var
+ P: PByte;
+ LSize: NativeInt;
+begin
+ P := ABody;
+ LSize := ACount;
+
+ SendZCompress(
+ // CHUNK
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ AData^ := P;
+ ACount^ := Min(LSize, SND_BUF_SIZE);
+ Result := (ACount^ > 0);
+
+ if (LSize > SND_BUF_SIZE) then
+ begin
+ Inc(P, SND_BUF_SIZE);
+ Dec(LSize, SND_BUF_SIZE);
+ end else
+ begin
+ LSize := 0;
+ P := nil;
+ end;
+ end,
+ ACompressType,
+ ACallback);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody; const ACount: NativeInt;
+ const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
+begin
+ SendZCompress(@ABody, ACount, ACompressType, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: TBytes;
+ const AOffset, ACount: NativeInt; const ACompressType: TCompressType;
+ const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+ LOffset, LCount: NativeInt;
+begin
+ // 增加其引用计数
+ LBody := ABody;
+
+ LOffset := AOffset;
+ LCount := ACount;
+ TCrossHttpUtils.AdjustOffsetCount(Length(ABody), LOffset, LCount);
+
+ SendZCompress(Pointer(PByte(LBody) + LOffset), LCount, ACompressType,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ // 减少引用计数
+ LBody := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: TBytes;
+ const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
+begin
+ SendZCompress(ABody, 0, Length(ABody), ACompressType, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: TStream;
+ const AOffset, ACount: Int64; const ACompressType: TCompressType;
+ const ACallback: TCrossConnectionCallback);
+var
+ LOffset, LCount: Int64;
+ LBody: TStream;
+ LBuffer: TBytes;
+ LP: PByte;
+ LSize: Int64;
+begin
+ if (ABody = nil) then
+ begin
+ SendNoCompress(nil, 0, ACallback);
+ Exit;
+ end;
+
+ LOffset := AOffset;
+ LCount := ACount;
+ TCrossHttpUtils.AdjustOffsetCount(ABody.Size, LOffset, LCount);
+
+ if _GetMemoryStreamPointer(ABody, LOffset, LCount, LP, LSize) then
+ begin
+ SendZCompress(LP^, LSize, ACompressType, ACallback);
+ Exit;
+ end;
+
+ LBody := ABody;
+ LBody.Position := LOffset;
+
+ SetLength(LBuffer, SND_BUF_SIZE);
+
+ SendZCompress(
+ // CHUNK
+ function(const AData: PPointer; const ACount: PNativeInt): Boolean
+ begin
+ if (LCount <= 0) then Exit(False);
+
+ ACount^ := LBody.Read(LBuffer[0], Min(LCount, SND_BUF_SIZE));
+ AData^ := @LBuffer[0];
+
+ Result := (ACount^ > 0);
+
+ if Result then
+ Dec(LCount, ACount^);
+ end,
+ ACompressType,
+ // CALLBACK
+ procedure(const AConnection: ICrossConnection; const ASuccess: Boolean)
+ begin
+ LBuffer := nil;
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, ASuccess);
+ end);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: TStream;
+ const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
+begin
+ SendZCompress(ABody, 0, 0, ACompressType, ACallback);
+end;
+
+procedure TCrossHttpResponse.SendZCompress(const ABody: string;
+ const ACompressType: TCompressType; const ACallback: TCrossConnectionCallback);
+var
+ LBody: TBytes;
+begin
+ LBody := TEncoding.UTF8.GetBytes(ABody);
+ if (GetContentType = '') then
+ SetContentType(TMediaType.TEXT_HTML_UTF8);
+
+ SendZCompress(LBody, ACompressType, ACallback);
+end;
+
+end.
diff --git a/Net/Net.CrossHttpUtils.pas b/Net/Net.CrossHttpUtils.pas
index 0e76de8..55d11f7 100644
--- a/Net/Net.CrossHttpUtils.pas
+++ b/Net/Net.CrossHttpUtils.pas
@@ -1,2113 +1,2113 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossHttpUtils;
-
-{$I zLib.inc}
-
-interface
-
-uses
- SysUtils,
- DateUtils,
-
- Utils.DateTime,
- Utils.StrUtils,
- Utils.Utils,
- Utils.IOUtils;
-
-type
- THttpStatus = record
- Code: Integer;
- Text: string;
- end;
-
- TMimeValue = record
- Key: string;
- Value: string;
- end;
-
- {$REGION 'Documentation'}
- ///
- /// HTTP版本信息
- ///
- {$ENDREGION}
- THttpVersion = (hvHttp10, hvHttp11);
-
- {$REGION 'Documentation'}
- ///
- /// 压缩类型
- ///
- {$ENDREGION}
- TCompressType = (ctNone, ctGZip, ctDeflate);
-
-const
- HTTP = 'http';
- HTTPS = 'https';
- HTTP_DEFAULT_PORT = 80;
- HTTPS_DEFAULT_PORT = 443;
- WS = 'ws';
- WSS = 'wss';
- WEBSOCKET = 'websocket';
- WEBSOCKET_VERSION = '13';
-
- HTTP_VER_STR: array [THttpVersion] of string = ('HTTP/1.0', 'HTTP/1.1');
-
- {$REGION '常用 HTTP 头'}
- HEADER_ACCEPT = 'Accept';
- HEADER_ACCEPT_CHARSET = 'Accept-Charset';
- HEADER_ACCEPT_ENCODING = 'Accept-Encoding';
- HEADER_ACCEPT_LANGUAGE = 'Accept-Language';
- HEADER_ACCEPT_RANGES = 'Accept-Ranges';
- HEADER_AUTHORIZATION = 'Authorization';
- HEADER_CACHE_CONTROL = 'Cache-Control';
- HEADER_CONNECTION = 'Connection';
- HEADER_CONTENT_DISPOSITION = 'Content-Disposition';
- HEADER_CONTENT_ENCODING = 'Content-Encoding';
- HEADER_CONTENT_LANGUAGE = 'Content-Language';
- HEADER_CONTENT_LENGTH = 'Content-Length';
- HEADER_CONTENT_RANGE = 'Content-Range';
- HEADER_CONTENT_TYPE = 'Content-Type';
- HEADER_COOKIE = 'Cookie';
- HEADER_CROSS_HTTP_CLIENT = 'Client';
- HEADER_CROSS_HTTP_SERVER = 'Server';
- HEADER_ETAG = 'ETag';
- HEADER_EXPECT = 'Expect';
- HEADER_HOST = 'Host';
- HEADER_IF_MODIFIED_SINCE = 'If-Modified-Since';
- HEADER_IF_NONE_MATCH = 'If-None-Match';
- HEADER_IF_RANGE = 'If-Range';
- HEADER_LAST_MODIFIED = 'Last-Modified';
- HEADER_LOCATION = 'Location';
- HEADER_PRAGMA = 'Pragma';
- HEADER_PROXY_AUTHENTICATE = 'Proxy-Authenticate';
- HEADER_PROXY_AUTHORIZATION = 'Proxy-Authorization';
- HEADER_RANGE = 'Range';
- HEADER_REFERER = 'Referer';
- HEADER_SEC_WEBSOCKET_ACCEPT = 'Sec-WebSocket-Accept';
- HEADER_SEC_WEBSOCKET_KEY = 'Sec-WebSocket-Key';
- HEADER_SEC_WEBSOCKET_VERSION = 'Sec-WebSocket-Version';
- HEADER_SETCOOKIE = 'Set-Cookie';
- HEADER_TRANSFER_ENCODING = 'Transfer-Encoding';
- HEADER_UPGRADE = 'Upgrade';
- HEADER_USER_AGENT = 'User-Agent';
- HEADER_VARY = 'Vary';
- HEADER_WWW_AUTHENTICATE = 'WWW-Authenticate';
- HEADER_X_METHOD_OVERRIDE = 'x-method-override';
- HEADER_X_FORWARDED_FOR = 'X-Forwarded-For';
- HEADER_X_REAL_IP = 'X-Real-IP';
- HEADER_X_FORWARDED_HOST = 'X-Forwarded-Host';
- HEADER_X_FORWARDED_SERVER = 'X-Forwarded-Server';
- {$ENDREGION}
-
- ZLIB_BUF_SIZE = 32768;
- ZLIB_WINDOW_BITS: array [TCompressType] of Integer = (0, 15 + 16{gzip}, 15{deflate});
- ZLIB_CONTENT_ENCODING: array [TCompressType] of string = ('', 'gzip', 'deflate');
-
- {$REGION '常用状态码'}
- STATUS_CODES: array [0..56] of THttpStatus = (
- (Code: 100; Text: 'Continue'),
- (Code: 101; Text: 'Switching Protocols'),
- (Code: 102; Text: 'Processing'), // RFC 2518, obsoleted by RFC 4918
- (Code: 200; Text: 'OK'),
- (Code: 201; Text: 'Created'),
- (Code: 202; Text: 'Accepted'),
- (Code: 203; Text: 'Non-Authoritative Information'),
- (Code: 204; Text: 'No Content'),
- (Code: 205; Text: 'Reset Content'),
- (Code: 206; Text: 'Partial Content'),
- (Code: 207; Text: 'Multi-Status'), // RFC 4918
- (Code: 300; Text: 'Multiple Choices'),
- (Code: 301; Text: 'Moved Permanently'),
- (Code: 302; Text: 'Moved Temporarily'),
- (Code: 303; Text: 'See Other'),
- (Code: 304; Text: 'Not Modified'),
- (Code: 305; Text: 'Use Proxy'),
- (Code: 307; Text: 'Temporary Redirect'),
- (Code: 308; Text: 'Permanent Redirect'), // RFC 7238
- (Code: 400; Text: 'Bad Request'),
- (Code: 401; Text: 'Unauthorized'),
- (Code: 402; Text: 'Payment Required'),
- (Code: 403; Text: 'Forbidden'),
- (Code: 404; Text: 'Not Found'),
- (Code: 405; Text: 'Method Not Allowed'),
- (Code: 406; Text: 'Not Acceptable'),
- (Code: 407; Text: 'Proxy Authentication Required'),
- (Code: 408; Text: 'Request Timeout'),
- (Code: 409; Text: 'Conflict'),
- (Code: 410; Text: 'Gone'),
- (Code: 411; Text: 'Length Required'),
- (Code: 412; Text: 'Precondition Failed'),
- (Code: 413; Text: 'Request Entity Too Large'),
- (Code: 414; Text: 'Request URI Too Large'),
- (Code: 415; Text: 'Unsupported Media Type'),
- (Code: 416; Text: 'Requested Range Not Satisfiable'),
- (Code: 417; Text: 'Expectation Failed'),
- (Code: 418; Text: 'I''m a teapot'), // RFC 2324
- (Code: 422; Text: 'Unprocessable Entity'), // RFC 4918
- (Code: 423; Text: 'Locked'), // RFC 4918
- (Code: 424; Text: 'Failed Dependency'), // RFC 4918
- (Code: 425; Text: 'Unordered Collection'), // RFC 4918
- (Code: 426; Text: 'Upgrade Required'), // RFC 2817
- (Code: 428; Text: 'Precondition Required'), // RFC 6585
- (Code: 429; Text: 'Too Many Requests'), // RFC 6585
- (Code: 431; Text: 'Request Header Fields Too Large'), // RFC 6585
- (Code: 500; Text: 'Internal Server Error'),
- (Code: 501; Text: 'Not Implemented'),
- (Code: 502; Text: 'Bad Gateway'),
- (Code: 503; Text: 'Service Unavailable'),
- (Code: 504; Text: 'Gateway Timeout'),
- (Code: 505; Text: 'HTTP Version Not Supported'),
- (Code: 506; Text: 'Variant Also Negotiates'), // RFC 2295
- (Code: 507; Text: 'Insufficient Storage'), // RFC 4918
- (Code: 509; Text: 'Bandwidth Limit Exceeded'),
- (Code: 510; Text: 'Not Extended'), // RFC 2774
- (Code: 511; Text: 'Network Authentication Required') // RFC 6585
- );
- {$ENDREGION}
-
- {$REGION 'MIME CONST'}
- MIME_TYPES: array[0..988] of TMimeValue = (
- (Key: 'ez'; Value: 'application/andrew-inset'), // do not localize
- (Key: 'aw'; Value: 'application/applixware'), // do not localize
- (Key: 'atom'; Value: 'application/atom+xml'), // do not localize
- (Key: 'atomcat'; Value: 'application/atomcat+xml'), // do not localize
- (Key: 'atomsvc'; Value: 'application/atomsvc+xml'), // do not localize
- (Key: 'ccxml'; Value: 'application/ccxml+xml'), // do not localize
- (Key: 'cdmia'; Value: 'application/cdmi-capability'), // do not localize
- (Key: 'cdmic'; Value: 'application/cdmi-container'), // do not localize
- (Key: 'cdmid'; Value: 'application/cdmi-domain'), // do not localize
- (Key: 'cdmio'; Value: 'application/cdmi-object'), // do not localize
- (Key: 'cdmiq'; Value: 'application/cdmi-queue'), // do not localize
- (Key: 'cu'; Value: 'application/cu-seeme'), // do not localize
- (Key: 'davmount'; Value: 'application/davmount+xml'), // do not localize
- (Key: 'dbk'; Value: 'application/docbook+xml'), // do not localize
- (Key: 'dssc'; Value: 'application/dssc+der'), // do not localize
- (Key: 'xdssc'; Value: 'application/dssc+xml'), // do not localize
- (Key: 'ecma'; Value: 'application/ecmascript'), // do not localize
- (Key: 'emma'; Value: 'application/emma+xml'), // do not localize
- (Key: 'epub'; Value: 'application/epub+zip'), // do not localize
- (Key: 'exi'; Value: 'application/exi'), // do not localize
- (Key: 'pfr'; Value: 'application/font-tdpfr'), // do not localize
- (Key: 'gml'; Value: 'application/gml+xml'), // do not localize
- (Key: 'gpx'; Value: 'application/gpx+xml'), // do not localize
- (Key: 'gxf'; Value: 'application/gxf'), // do not localize
- (Key: 'stk'; Value: 'application/hyperstudio'), // do not localize
- (Key: 'ink'; Value: 'application/inkml+xml'), // do not localize
- (Key: 'inkml'; Value: 'application/inkml+xml'), // do not localize
- (Key: 'ipfix'; Value: 'application/ipfix'), // do not localize
- (Key: 'jar'; Value: 'application/java-archive'), // do not localize
- (Key: 'ser'; Value: 'application/java-serialized-object'), // do not localize
- (Key: 'class'; Value: 'application/java-vm'), // do not localize
- (Key: 'js'; Value: 'application/javascript'), // do not localize
- (Key: 'json'; Value: 'application/json'), // do not localize
- (Key: 'jsonml'; Value: 'application/jsonml+json'), // do not localize
- (Key: 'lostxml'; Value: 'application/lost+xml'), // do not localize
- (Key: 'hqx'; Value: 'application/mac-binhex40'), // do not localize
- (Key: 'cpt'; Value: 'application/mac-compactpro'), // do not localize
- (Key: 'mads'; Value: 'application/mads+xml'), // do not localize
- (Key: 'mrc'; Value: 'application/marc'), // do not localize
- (Key: 'mrcx'; Value: 'application/marcxml+xml'), // do not localize
- (Key: 'ma'; Value: 'application/mathematica'), // do not localize
- (Key: 'nb'; Value: 'application/mathematica'), // do not localize
- (Key: 'mb'; Value: 'application/mathematica'), // do not localize
- (Key: 'mathml'; Value: 'application/mathml+xml'), // do not localize
- (Key: 'mbox'; Value: 'application/mbox'), // do not localize
- (Key: 'mscml'; Value: 'application/mediaservercontrol+xml'), // do not localize
- (Key: 'metalink'; Value: 'application/metalink+xml'), // do not localize
- (Key: 'meta4'; Value: 'application/metalink4+xml'), // do not localize
- (Key: 'mets'; Value: 'application/mets+xml'), // do not localize
- (Key: 'mods'; Value: 'application/mods+xml'), // do not localize
- (Key: 'm21'; Value: 'application/mp21'), // do not localize
- (Key: 'mp21'; Value: 'application/mp21'), // do not localize
- (Key: 'mp4s'; Value: 'application/mp4'), // do not localize
- (Key: 'doc'; Value: 'application/msword'), // do not localize
- (Key: 'dot'; Value: 'application/msword'), // do not localize
- (Key: 'mxf'; Value: 'application/mxf'), // do not localize
- (Key: 'bin'; Value: 'application/octet-stream'), // do not localize
- (Key: 'bpk'; Value: 'application/octet-stream'), // do not localize
- (Key: 'class'; Value: 'application/octet-stream'), // do not localize
- (Key: 'deploy'; Value: 'application/octet-stream'), // do not localize
- (Key: 'dist'; Value: 'application/octet-stream'), // do not localize
- (Key: 'distz'; Value: 'application/octet-stream'), // do not localize
- (Key: 'dmg'; Value: 'application/octet-stream'), // do not localize
- (Key: 'dms'; Value: 'application/octet-stream'), // do not localize
- (Key: 'dump'; Value: 'application/octet-stream'), // do not localize
- (Key: 'elc'; Value: 'application/octet-stream'), // do not localize
- (Key: 'iso'; Value: 'application/octet-stream'), // do not localize
- (Key: 'lha'; Value: 'application/octet-stream'), // do not localize
- (Key: 'lrf'; Value: 'application/octet-stream'), // do not localize
- (Key: 'lzh'; Value: 'application/octet-stream'), // do not localize
- (Key: 'mar'; Value: 'application/octet-stream'), // do not localize
- (Key: 'pkg'; Value: 'application/octet-stream'), // do not localize
- (Key: 'so'; Value: 'application/octet-stream'), // do not localize
- (Key: 'oda'; Value: 'application/oda'), // do not localize
- (Key: 'opf'; Value: 'application/oebps-package+xml'), // do not localize
- (Key: 'ogx'; Value: 'application/ogg'), // do not localize
- (Key: 'omdoc'; Value: 'application/omdoc+xml'), // do not localize
- (Key: 'onetoc'; Value: 'application/onenote'), // do not localize
- (Key: 'onetoc2'; Value: 'application/onenote'), // do not localize
- (Key: 'onetmp'; Value: 'application/onenote'), // do not localize
- (Key: 'onepkg'; Value: 'application/onenote'), // do not localize
- (Key: 'oxps'; Value: 'application/oxps'), // do not localize
- (Key: 'xer'; Value: 'application/patch-ops-error+xml'), // do not localize
- (Key: 'pdf'; Value: 'application/pdf'), // do not localize
- (Key: 'pgp'; Value: 'application/pgp-encrypted'), // do not localize
- (Key: 'asc'; Value: 'application/pgp-signature'), // do not localize
- (Key: 'sig'; Value: 'application/pgp-signature'), // do not localize
- (Key: 'prf'; Value: 'application/pics-rules'), // do not localize
- (Key: 'p10'; Value: 'application/pkcs10'), // do not localize
- (Key: 'p7m'; Value: 'application/pkcs7-mime'), // do not localize
- (Key: 'p7c'; Value: 'application/pkcs7-mime'), // do not localize
- (Key: 'p7s'; Value: 'application/pkcs7-signature'), // do not localize
- (Key: 'p8'; Value: 'application/pkcs8'), // do not localize
- (Key: 'ac'; Value: 'application/pkix-attr-cert'), // do not localize
- (Key: 'cer'; Value: 'application/pkix-cert'), // do not localize
- (Key: 'crl'; Value: 'application/pkix-crl'), // do not localize
- (Key: 'pkipath'; Value: 'application/pkix-pkipath'), // do not localize
- (Key: 'pki'; Value: 'application/pkixcmp'), // do not localize
- (Key: 'pls'; Value: 'application/pls+xml'), // do not localize
- (Key: 'ai'; Value: 'application/postscript'), // do not localize
- (Key: 'eps'; Value: 'application/postscript'), // do not localize
- (Key: 'ps'; Value: 'application/postscript'), // do not localize
- (Key: 'cww'; Value: 'application/prs.cww'), // do not localize
- (Key: 'pskcxml'; Value: 'application/pskc+xml'), // do not localize
- (Key: 'rdf'; Value: 'application/rdf+xml'), // do not localize
- (Key: 'rif'; Value: 'application/reginfo+xml'), // do not localize
- (Key: 'rnc'; Value: 'application/relax-ng-compact-syntax'), // do not localize
- (Key: 'rl'; Value: 'application/resource-lists+xml'), // do not localize
- (Key: 'rld'; Value: 'application/resource-lists-diff+xml'), // do not localize
- (Key: 'rs'; Value: 'application/rls-services+xml'), // do not localize
- (Key: 'gbr'; Value: 'application/rpki-ghostbusters'), // do not localize
- (Key: 'mft'; Value: 'application/rpki-manifest'), // do not localize
- (Key: 'roa'; Value: 'application/rpki-roa'), // do not localize
- (Key: 'rsd'; Value: 'application/rsd+xml'), // do not localize
- (Key: 'rss'; Value: 'application/rss+xml'), // do not localize
- (Key: 'rtf'; Value: 'application/rtf'), // do not localize
- (Key: 'sbml'; Value: 'application/sbml+xml'), // do not localize
- (Key: 'scq'; Value: 'application/scvp-cv-request'), // do not localize
- (Key: 'scs'; Value: 'application/scvp-cv-response'), // do not localize
- (Key: 'spq'; Value: 'application/scvp-vp-request'), // do not localize
- (Key: 'spp'; Value: 'application/scvp-vp-response'), // do not localize
- (Key: 'sdp'; Value: 'application/sdp'), // do not localize
- (Key: 'setpay'; Value: 'application/set-payment-initiation'), // do not localize
- (Key: 'setreg'; Value: 'application/set-registration-initiation'), // do not localize
- (Key: 'shf'; Value: 'application/shf+xml'), // do not localize
- (Key: 'smi'; Value: 'application/smil+xml'), // do not localize
- (Key: 'smil'; Value: 'application/smil+xml'), // do not localize
- (Key: 'rq'; Value: 'application/sparql-query'), // do not localize
- (Key: 'srx'; Value: 'application/sparql-results+xml'), // do not localize
- (Key: 'gram'; Value: 'application/srgs'), // do not localize
- (Key: 'grxml'; Value: 'application/srgs+xml'), // do not localize
- (Key: 'sru'; Value: 'application/sru+xml'), // do not localize
- (Key: 'ssdl'; Value: 'application/ssdl+xml'), // do not localize
- (Key: 'ssml'; Value: 'application/ssml+xml'), // do not localize
- (Key: 'tei'; Value: 'application/tei+xml'), // do not localize
- (Key: 'teicorpus'; Value: 'application/tei+xml'), // do not localize
- (Key: 'tfi'; Value: 'application/thraud+xml'), // do not localize
- (Key: 'tsd'; Value: 'application/timestamped-data'), // do not localize
- (Key: 'plb'; Value: 'application/vnd.3gpp.pic-bw-large'), // do not localize
- (Key: 'psb'; Value: 'application/vnd.3gpp.pic-bw-small'), // do not localize
- (Key: 'pvb'; Value: 'application/vnd.3gpp.pic-bw-var'), // do not localize
- (Key: 'tcap'; Value: 'application/vnd.3gpp2.tcap'), // do not localize
- (Key: 'pwn'; Value: 'application/vnd.3m.post-it-notes'), // do not localize
- (Key: 'aso'; Value: 'application/vnd.accpac.simply.aso'), // do not localize
- (Key: 'imp'; Value: 'application/vnd.accpac.simply.imp'), // do not localize
- (Key: 'acu'; Value: 'application/vnd.acucobol'), // do not localize
- (Key: 'atc'; Value: 'application/vnd.acucorp'), // do not localize
- (Key: 'acutc'; Value: 'application/vnd.acucorp'), // do not localize
- (Key: 'air'; Value: 'application/vnd.adobe.air-application-installer-package+zip'), // do not localize
- (Key: 'fcdt'; Value: 'application/vnd.adobe.formscentral.fcdt'), // do not localize
- (Key: 'fxp'; Value: 'application/vnd.adobe.fxp'), // do not localize
- (Key: 'fxpl'; Value: 'application/vnd.adobe.fxp'), // do not localize
- (Key: 'xdp'; Value: 'application/vnd.adobe.xdp+xml'), // do not localize
- (Key: 'xfdf'; Value: 'application/vnd.adobe.xfdf'), // do not localize
- (Key: 'ahead'; Value: 'application/vnd.ahead.space'), // do not localize
- (Key: 'azf'; Value: 'application/vnd.airzip.filesecure.azf'), // do not localize
- (Key: 'azs'; Value: 'application/vnd.airzip.filesecure.azs'), // do not localize
- (Key: 'azw'; Value: 'application/vnd.amazon.ebook'), // do not localize
- (Key: 'acc'; Value: 'application/vnd.americandynamics.acc'), // do not localize
- (Key: 'ami'; Value: 'application/vnd.amiga.ami'), // do not localize
- (Key: 'apk'; Value: 'application/vnd.android.package-archive'), // do not localize
- (Key: 'cii'; Value: 'application/vnd.anser-web-certificate-issue-initiation'), // do not localize
- (Key: 'fti'; Value: 'application/vnd.anser-web-funds-transfer-initiation'), // do not localize
- (Key: 'atx'; Value: 'application/vnd.antix.game-component'), // do not localize
- (Key: 'mpkg'; Value: 'application/vnd.apple.installer+xml'), // do not localize
- (Key: 'm3u8'; Value: 'application/vnd.apple.mpegurl'), // do not localize
- (Key: 'swi'; Value: 'application/vnd.aristanetworks.swi'), // do not localize
- (Key: 'iota'; Value: 'application/vnd.astraea-software.iota'), // do not localize
- (Key: 'aep'; Value: 'application/vnd.audiograph'), // do not localize
- (Key: 'mpm'; Value: 'application/vnd.blueice.multipass'), // do not localize
- (Key: 'bmi'; Value: 'application/vnd.bmi'), // do not localize
- (Key: 'rep'; Value: 'application/vnd.businessobjects'), // do not localize
- (Key: 'cdxml'; Value: 'application/vnd.chemdraw+xml'), // do not localize
- (Key: 'mmd'; Value: 'application/vnd.chipnuts.karaoke-mmd'), // do not localize
- (Key: 'cdy'; Value: 'application/vnd.cinderella'), // do not localize
- (Key: 'cla'; Value: 'application/vnd.claymore'), // do not localize
- (Key: 'rp9'; Value: 'application/vnd.cloanto.rp9'), // do not localize
- (Key: 'c4g'; Value: 'application/vnd.clonk.c4group'), // do not localize
- (Key: 'c4d'; Value: 'application/vnd.clonk.c4group'), // do not localize
- (Key: 'c4f'; Value: 'application/vnd.clonk.c4group'), // do not localize
- (Key: 'c4p'; Value: 'application/vnd.clonk.c4group'), // do not localize
- (Key: 'c4u'; Value: 'application/vnd.clonk.c4group'), // do not localize
- (Key: 'c11amc'; Value: 'application/vnd.cluetrust.cartomobile-config'), // do not localize
- (Key: 'c11amz'; Value: 'application/vnd.cluetrust.cartomobile-config-pkg'), // do not localize
- (Key: 'csp'; Value: 'application/vnd.commonspace'), // do not localize
- (Key: 'cdbcmsg'; Value: 'application/vnd.contact.cmsg'), // do not localize
- (Key: 'cmc'; Value: 'application/vnd.cosmocaller'), // do not localize
- (Key: 'clkx'; Value: 'application/vnd.crick.clicker'), // do not localize
- (Key: 'clkk'; Value: 'application/vnd.crick.clicker.keyboard'), // do not localize
- (Key: 'clkp'; Value: 'application/vnd.crick.clicker.palette'), // do not localize
- (Key: 'clkt'; Value: 'application/vnd.crick.clicker.template'), // do not localize
- (Key: 'clkw'; Value: 'application/vnd.crick.clicker.wordbank'), // do not localize
- (Key: 'wbs'; Value: 'application/vnd.criticaltools.wbs+xml'), // do not localize
- (Key: 'pml'; Value: 'application/vnd.ctc-posml'), // do not localize
- (Key: 'ppd'; Value: 'application/vnd.cups-ppd'), // do not localize
- (Key: 'car'; Value: 'application/vnd.curl.car'), // do not localize
- (Key: 'pcurl'; Value: 'application/vnd.curl.pcurl'), // do not localize
- (Key: 'dart'; Value: 'application/vnd.dart'), // do not localize
- (Key: 'rdz'; Value: 'application/vnd.data-vision.rdz'), // do not localize
- (Key: 'uvf'; Value: 'application/vnd.dece.data'), // do not localize
- (Key: 'uvvf'; Value: 'application/vnd.dece.data'), // do not localize
- (Key: 'uvd'; Value: 'application/vnd.dece.data'), // do not localize
- (Key: 'uvvd'; Value: 'application/vnd.dece.data'), // do not localize
- (Key: 'uvt'; Value: 'application/vnd.dece.ttml+xml'), // do not localize
- (Key: 'uvvt'; Value: 'application/vnd.dece.ttml+xml'), // do not localize
- (Key: 'uvx'; Value: 'application/vnd.dece.unspecified'), // do not localize
- (Key: 'uvvx'; Value: 'application/vnd.dece.unspecified'), // do not localize
- (Key: 'uvz'; Value: 'application/vnd.dece.zip'), // do not localize
- (Key: 'uvvz'; Value: 'application/vnd.dece.zip'), // do not localize
- (Key: 'fe_launch'; Value: 'application/vnd.denovo.fcselayout-link'), // do not localize
- (Key: 'dna'; Value: 'application/vnd.dna'), // do not localize
- (Key: 'mlp'; Value: 'application/vnd.dolby.mlp'), // do not localize
- (Key: 'dpg'; Value: 'application/vnd.dpgraph'), // do not localize
- (Key: 'dfac'; Value: 'application/vnd.dreamfactory'), // do not localize
- (Key: 'kpxx'; Value: 'application/vnd.ds-keypoint'), // do not localize
- (Key: 'ait'; Value: 'application/vnd.dvb.ait'), // do not localize
- (Key: 'svc'; Value: 'application/vnd.dvb.service'), // do not localize
- (Key: 'geo'; Value: 'application/vnd.dynageo'), // do not localize
- (Key: 'mag'; Value: 'application/vnd.ecowin.chart'), // do not localize
- (Key: 'nml'; Value: 'application/vnd.enliven'), // do not localize
- (Key: 'esf'; Value: 'application/vnd.epson.esf'), // do not localize
- (Key: 'msf'; Value: 'application/vnd.epson.msf'), // do not localize
- (Key: 'qam'; Value: 'application/vnd.epson.quickanime'), // do not localize
- (Key: 'slt'; Value: 'application/vnd.epson.salt'), // do not localize
- (Key: 'ssf'; Value: 'application/vnd.epson.ssf'), // do not localize
- (Key: 'es3'; Value: 'application/vnd.eszigno3+xml'), // do not localize
- (Key: 'et3'; Value: 'application/vnd.eszigno3+xml'), // do not localize
- (Key: 'ez2'; Value: 'application/vnd.ezpix-album'), // do not localize
- (Key: 'ez3'; Value: 'application/vnd.ezpix-package'), // do not localize
- (Key: 'fdf'; Value: 'application/vnd.fdf'), // do not localize
- (Key: 'mseed'; Value: 'application/vnd.fdsn.mseed'), // do not localize
- (Key: 'seed'; Value: 'application/vnd.fdsn.seed'), // do not localize
- (Key: 'dataless'; Value: 'application/vnd.fdsn.seed'), // do not localize
- (Key: 'gph'; Value: 'application/vnd.flographit'), // do not localize
- (Key: 'ftc'; Value: 'application/vnd.fluxtime.clip'), // do not localize
- (Key: 'fm'; Value: 'application/vnd.framemaker'), // do not localize
- (Key: 'frame'; Value: 'application/vnd.framemaker'), // do not localize
- (Key: 'maker'; Value: 'application/vnd.framemaker'), // do not localize
- (Key: 'book'; Value: 'application/vnd.framemaker'), // do not localize
- (Key: 'fnc'; Value: 'application/vnd.frogans.fnc'), // do not localize
- (Key: 'ltf'; Value: 'application/vnd.frogans.ltf'), // do not localize
- (Key: 'fsc'; Value: 'application/vnd.fsc.weblaunch'), // do not localize
- (Key: 'oas'; Value: 'application/vnd.fujitsu.oasys'), // do not localize
- (Key: 'oa2'; Value: 'application/vnd.fujitsu.oasys2'), // do not localize
- (Key: 'oa3'; Value: 'application/vnd.fujitsu.oasys3'), // do not localize
- (Key: 'fg5'; Value: 'application/vnd.fujitsu.oasysgp'), // do not localize
- (Key: 'bh2'; Value: 'application/vnd.fujitsu.oasysprs'), // do not localize
- (Key: 'ddd'; Value: 'application/vnd.fujixerox.ddd'), // do not localize
- (Key: 'xdw'; Value: 'application/vnd.fujixerox.docuworks'), // do not localize
- (Key: 'xbd'; Value: 'application/vnd.fujixerox.docuworks.binder'), // do not localize
- (Key: 'fzs'; Value: 'application/vnd.fuzzysheet'), // do not localize
- (Key: 'txd'; Value: 'application/vnd.genomatix.tuxedo'), // do not localize
- (Key: 'ggb'; Value: 'application/vnd.geogebra.file'), // do not localize
- (Key: 'ggt'; Value: 'application/vnd.geogebra.tool'), // do not localize
- (Key: 'gex'; Value: 'application/vnd.geometry-explorer'), // do not localize
- (Key: 'gre'; Value: 'application/vnd.geometry-explorer'), // do not localize
- (Key: 'gxt'; Value: 'application/vnd.geonext'), // do not localize
- (Key: 'g2w'; Value: 'application/vnd.geoplan'), // do not localize
- (Key: 'g3w'; Value: 'application/vnd.geospace'), // do not localize
- (Key: 'gmx'; Value: 'application/vnd.gmx'), // do not localize
- (Key: 'kml'; Value: 'application/vnd.google-earth.kml+xml'), // do not localize
- (Key: 'kmz'; Value: 'application/vnd.google-earth.kmz'), // do not localize
- (Key: 'gqf'; Value: 'application/vnd.grafeq'), // do not localize
- (Key: 'gqs'; Value: 'application/vnd.grafeq'), // do not localize
- (Key: 'gac'; Value: 'application/vnd.groove-account'), // do not localize
- (Key: 'ghf'; Value: 'application/vnd.groove-help'), // do not localize
- (Key: 'gim'; Value: 'application/vnd.groove-identity-message'), // do not localize
- (Key: 'grv'; Value: 'application/vnd.groove-injector'), // do not localize
- (Key: 'gtm'; Value: 'application/vnd.groove-tool-message'), // do not localize
- (Key: 'tpl'; Value: 'application/vnd.groove-tool-template'), // do not localize
- (Key: 'vcg'; Value: 'application/vnd.groove-vcard'), // do not localize
- (Key: 'hal'; Value: 'application/vnd.hal+xml'), // do not localize
- (Key: 'zmm'; Value: 'application/vnd.handheld-entertainment+xml'), // do not localize
- (Key: 'hbci'; Value: 'application/vnd.hbci'), // do not localize
- (Key: 'les'; Value: 'application/vnd.hhe.lesson-player'), // do not localize
- (Key: 'hpgl'; Value: 'application/vnd.hp-hpgl'), // do not localize
- (Key: 'hpid'; Value: 'application/vnd.hp-hpid'), // do not localize
- (Key: 'hps'; Value: 'application/vnd.hp-hps'), // do not localize
- (Key: 'jlt'; Value: 'application/vnd.hp-jlyt'), // do not localize
- (Key: 'pcl'; Value: 'application/vnd.hp-pcl'), // do not localize
- (Key: 'pclxl'; Value: 'application/vnd.hp-pclxl'), // do not localize
- (Key: 'sfd-hdstx'; Value: 'application/vnd.hydrostatix.sof-data'), // do not localize
- (Key: 'mpy'; Value: 'application/vnd.ibm.minipay'), // do not localize
- (Key: 'afp'; Value: 'application/vnd.ibm.modcap'), // do not localize
- (Key: 'listafp'; Value: 'application/vnd.ibm.modcap'), // do not localize
- (Key: 'list3820'; Value: 'application/vnd.ibm.modcap'), // do not localize
- (Key: 'irm'; Value: 'application/vnd.ibm.rights-management'), // do not localize
- (Key: 'sc'; Value: 'application/vnd.ibm.secure-container'), // do not localize
- (Key: 'icc'; Value: 'application/vnd.iccprofile'), // do not localize
- (Key: 'icm'; Value: 'application/vnd.iccprofile'), // do not localize
- (Key: 'igl'; Value: 'application/vnd.igloader'), // do not localize
- (Key: 'ivp'; Value: 'application/vnd.immervision-ivp'), // do not localize
- (Key: 'ivu'; Value: 'application/vnd.immervision-ivu'), // do not localize
- (Key: 'igm'; Value: 'application/vnd.insors.igm'), // do not localize
- (Key: 'xpw'; Value: 'application/vnd.intercon.formnet'), // do not localize
- (Key: 'xpx'; Value: 'application/vnd.intercon.formnet'), // do not localize
- (Key: 'i2g'; Value: 'application/vnd.intergeo'), // do not localize
- (Key: 'qbo'; Value: 'application/vnd.intu.qbo'), // do not localize
- (Key: 'qfx'; Value: 'application/vnd.intu.qfx'), // do not localize
- (Key: 'rcprofile'; Value: 'application/vnd.ipunplugged.rcprofile'), // do not localize
- (Key: 'irp'; Value: 'application/vnd.irepository.package+xml'), // do not localize
- (Key: 'xpr'; Value: 'application/vnd.is-xpr'), // do not localize
- (Key: 'fcs'; Value: 'application/vnd.isac.fcs'), // do not localize
- (Key: 'jam'; Value: 'application/vnd.jam'), // do not localize
- (Key: 'rms'; Value: 'application/vnd.jcp.javame.midlet-rms'), // do not localize
- (Key: 'jisp'; Value: 'application/vnd.jisp'), // do not localize
- (Key: 'joda'; Value: 'application/vnd.joost.joda-archive'), // do not localize
- (Key: 'ktz'; Value: 'application/vnd.kahootz'), // do not localize
- (Key: 'ktr'; Value: 'application/vnd.kahootz'), // do not localize
- (Key: 'karbon'; Value: 'application/vnd.kde.karbon'), // do not localize
- (Key: 'chrt'; Value: 'application/vnd.kde.kchart'), // do not localize
- (Key: 'kfo'; Value: 'application/vnd.kde.kformula'), // do not localize
- (Key: 'flw'; Value: 'application/vnd.kde.kivio'), // do not localize
- (Key: 'kon'; Value: 'application/vnd.kde.kontour'), // do not localize
- (Key: 'kpr'; Value: 'application/vnd.kde.kpresenter'), // do not localize
- (Key: 'kpt'; Value: 'application/vnd.kde.kpresenter'), // do not localize
- (Key: 'ksp'; Value: 'application/vnd.kde.kspread'), // do not localize
- (Key: 'kwd'; Value: 'application/vnd.kde.kword'), // do not localize
- (Key: 'kwt'; Value: 'application/vnd.kde.kword'), // do not localize
- (Key: 'htke'; Value: 'application/vnd.kenameaapp'), // do not localize
- (Key: 'kia'; Value: 'application/vnd.kidspiration'), // do not localize
- (Key: 'kne'; Value: 'application/vnd.kinar'), // do not localize
- (Key: 'knp'; Value: 'application/vnd.kinar'), // do not localize
- (Key: 'skp'; Value: 'application/vnd.koan'), // do not localize
- (Key: 'skd'; Value: 'application/vnd.koan'), // do not localize
- (Key: 'skt'; Value: 'application/vnd.koan'), // do not localize
- (Key: 'skm'; Value: 'application/vnd.koan'), // do not localize
- (Key: 'sse'; Value: 'application/vnd.kodak-descriptor'), // do not localize
- (Key: 'lasxml'; Value: 'application/vnd.las.las+xml'), // do not localize
- (Key: 'lbd'; Value: 'application/vnd.llamagraphics.life-balance.desktop'), // do not localize
- (Key: 'lbe'; Value: 'application/vnd.llamagraphics.life-balance.exchange+xml'), // do not localize
- (Key: '123'; Value: 'application/vnd.lotus-1-2-3'), // do not localize
- (Key: 'apr'; Value: 'application/vnd.lotus-approach'), // do not localize
- (Key: 'pre'; Value: 'application/vnd.lotus-freelance'), // do not localize
- (Key: 'nsf'; Value: 'application/vnd.lotus-notes'), // do not localize
- (Key: 'org'; Value: 'application/vnd.lotus-organizer'), // do not localize
- (Key: 'scm'; Value: 'application/vnd.lotus-screencam'), // do not localize
- (Key: 'lwp'; Value: 'application/vnd.lotus-wordpro'), // do not localize
- (Key: 'portpkg'; Value: 'application/vnd.macports.portpkg'), // do not localize
- (Key: 'mcd'; Value: 'application/vnd.mcd'), // do not localize
- (Key: 'mc1'; Value: 'application/vnd.medcalcdata'), // do not localize
- (Key: 'cdkey'; Value: 'application/vnd.mediastation.cdkey'), // do not localize
- (Key: 'mwf'; Value: 'application/vnd.mfer'), // do not localize
- (Key: 'mfm'; Value: 'application/vnd.mfmp'), // do not localize
- (Key: 'flo'; Value: 'application/vnd.micrografx.flo'), // do not localize
- (Key: 'igx'; Value: 'application/vnd.micrografx.igx'), // do not localize
- (Key: 'mif'; Value: 'application/vnd.mif'), // do not localize
- (Key: 'daf'; Value: 'application/vnd.mobius.daf'), // do not localize
- (Key: 'dis'; Value: 'application/vnd.mobius.dis'), // do not localize
- (Key: 'mbk'; Value: 'application/vnd.mobius.mbk'), // do not localize
- (Key: 'mqy'; Value: 'application/vnd.mobius.mqy'), // do not localize
- (Key: 'msl'; Value: 'application/vnd.mobius.msl'), // do not localize
- (Key: 'plc'; Value: 'application/vnd.mobius.plc'), // do not localize
- (Key: 'txf'; Value: 'application/vnd.mobius.txf'), // do not localize
- (Key: 'mpn'; Value: 'application/vnd.mophun.application'), // do not localize
- (Key: 'mpc'; Value: 'application/vnd.mophun.certificate'), // do not localize
- (Key: 'xul'; Value: 'application/vnd.mozilla.xul+xml'), // do not localize
- (Key: 'cil'; Value: 'application/vnd.ms-artgalry'), // do not localize
- (Key: 'cab'; Value: 'application/vnd.ms-cab-compressed'), // do not localize
- (Key: 'xls'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xlm'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xla'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xlc'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xlt'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xlw'; Value: 'application/vnd.ms-excel'), // do not localize
- (Key: 'xlam'; Value: 'application/vnd.ms-excel.addin.macroenabled.12'), // do not localize
- (Key: 'xlsb'; Value: 'application/vnd.ms-excel.sheet.binary.macroenabled.12'), // do not localize
- (Key: 'xlsm'; Value: 'application/vnd.ms-excel.sheet.macroenabled.12'), // do not localize
- (Key: 'xltm'; Value: 'application/vnd.ms-excel.template.macroenabled.12'), // do not localize
- (Key: 'eot'; Value: 'application/vnd.ms-fontobject'), // do not localize
- (Key: 'chm'; Value: 'application/vnd.ms-htmlhelp'), // do not localize
- (Key: 'ims'; Value: 'application/vnd.ms-ims'), // do not localize
- (Key: 'lrm'; Value: 'application/vnd.ms-lrm'), // do not localize
- (Key: 'thmx'; Value: 'application/vnd.ms-officetheme'), // do not localize
- (Key: 'cat'; Value: 'application/vnd.ms-pki.seccat'), // do not localize
- (Key: 'stl'; Value: 'application/vnd.ms-pki.stl'), // do not localize
- (Key: 'ppt'; Value: 'application/vnd.ms-powerpoint'), // do not localize
- (Key: 'pps'; Value: 'application/vnd.ms-powerpoint'), // do not localize
- (Key: 'pot'; Value: 'application/vnd.ms-powerpoint'), // do not localize
- (Key: 'ppam'; Value: 'application/vnd.ms-powerpoint.addin.macroenabled.12'), // do not localize
- (Key: 'pptm'; Value: 'application/vnd.ms-powerpoint.presentation.macroenabled.12'), // do not localize
- (Key: 'sldm'; Value: 'application/vnd.ms-powerpoint.slide.macroenabled.12'), // do not localize
- (Key: 'ppsm'; Value: 'application/vnd.ms-powerpoint.slideshow.macroenabled.12'), // do not localize
- (Key: 'potm'; Value: 'application/vnd.ms-powerpoint.template.macroenabled.12'), // do not localize
- (Key: 'mpp'; Value: 'application/vnd.ms-project'), // do not localize
- (Key: 'mpt'; Value: 'application/vnd.ms-project'), // do not localize
- (Key: 'docm'; Value: 'application/vnd.ms-word.document.macroenabled.12'), // do not localize
- (Key: 'dotm'; Value: 'application/vnd.ms-word.template.macroenabled.12'), // do not localize
- (Key: 'wps'; Value: 'application/vnd.ms-works'), // do not localize
- (Key: 'wks'; Value: 'application/vnd.ms-works'), // do not localize
- (Key: 'wcm'; Value: 'application/vnd.ms-works'), // do not localize
- (Key: 'wdb'; Value: 'application/vnd.ms-works'), // do not localize
- (Key: 'wpl'; Value: 'application/vnd.ms-wpl'), // do not localize
- (Key: 'xps'; Value: 'application/vnd.ms-xpsdocument'), // do not localize
- (Key: 'mseq'; Value: 'application/vnd.mseq'), // do not localize
- (Key: 'mus'; Value: 'application/vnd.musician'), // do not localize
- (Key: 'msty'; Value: 'application/vnd.muvee.style'), // do not localize
- (Key: 'taglet'; Value: 'application/vnd.mynfc'), // do not localize
- (Key: 'nlu'; Value: 'application/vnd.neurolanguage.nlu'), // do not localize
- (Key: 'ntf'; Value: 'application/vnd.nitf'), // do not localize
- (Key: 'nitf'; Value: 'application/vnd.nitf'), // do not localize
- (Key: 'nnd'; Value: 'application/vnd.noblenet-directory'), // do not localize
- (Key: 'nns'; Value: 'application/vnd.noblenet-sealer'), // do not localize
- (Key: 'nnw'; Value: 'application/vnd.noblenet-web'), // do not localize
- (Key: 'ngdat'; Value: 'application/vnd.nokia.n-gage.data'), // do not localize
- (Key: 'n-gage'; Value: 'application/vnd.nokia.n-gage.symbian.install'), // do not localize
- (Key: 'rpst'; Value: 'application/vnd.nokia.radio-preset'), // do not localize
- (Key: 'rpss'; Value: 'application/vnd.nokia.radio-presets'), // do not localize
- (Key: 'edm'; Value: 'application/vnd.novadigm.edm'), // do not localize
- (Key: 'edx'; Value: 'application/vnd.novadigm.edx'), // do not localize
- (Key: 'ext'; Value: 'application/vnd.novadigm.ext'), // do not localize
- (Key: 'odc'; Value: 'application/vnd.oasis.opendocument.chart'), // do not localize
- (Key: 'otc'; Value: 'application/vnd.oasis.opendocument.chart-template'), // do not localize
- (Key: 'odb'; Value: 'application/vnd.oasis.opendocument.database'), // do not localize
- (Key: 'odf'; Value: 'application/vnd.oasis.opendocument.formula'), // do not localize
- (Key: 'odft'; Value: 'application/vnd.oasis.opendocument.formula-template'), // do not localize
- (Key: 'odg'; Value: 'application/vnd.oasis.opendocument.graphics'), // do not localize
- (Key: 'otg'; Value: 'application/vnd.oasis.opendocument.graphics-template'), // do not localize
- (Key: 'odi'; Value: 'application/vnd.oasis.opendocument.image'), // do not localize
- (Key: 'oti'; Value: 'application/vnd.oasis.opendocument.image-template'), // do not localize
- (Key: 'odp'; Value: 'application/vnd.oasis.opendocument.presentation'), // do not localize
- (Key: 'otp'; Value: 'application/vnd.oasis.opendocument.presentation-template'), // do not localize
- (Key: 'ods'; Value: 'application/vnd.oasis.opendocument.spreadsheet'), // do not localize
- (Key: 'ots'; Value: 'application/vnd.oasis.opendocument.spreadsheet-template'), // do not localize
- (Key: 'odt'; Value: 'application/vnd.oasis.opendocument.text'), // do not localize
- (Key: 'odm'; Value: 'application/vnd.oasis.opendocument.text-master'), // do not localize
- (Key: 'ott'; Value: 'application/vnd.oasis.opendocument.text-template'), // do not localize
- (Key: 'oth'; Value: 'application/vnd.oasis.opendocument.text-web'), // do not localize
- (Key: 'xo'; Value: 'application/vnd.olpc-sugar'), // do not localize
- (Key: 'dd2'; Value: 'application/vnd.oma.dd2+xml'), // do not localize
- (Key: 'oxt'; Value: 'application/vnd.openofficeorg.extension'), // do not localize
- (Key: 'pptx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.presentation'), // do not localize
- (Key: 'sldx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.slide'), // do not localize
- (Key: 'ppsx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.slideshow'), // do not localize
- (Key: 'potx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.template'), // do not localize
- (Key: 'xlsx'; Value: 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'), // do not localize
- (Key: 'xltx'; Value: 'application/vnd.openxmlformats-officedocument.spreadsheetml.template'), // do not localize
- (Key: 'docx'; Value: 'application/vnd.openxmlformats-officedocument.wordprocessingml.document'), // do not localize
- (Key: 'dotx'; Value: 'application/vnd.openxmlformats-officedocument.wordprocessingml.template'), // do not localize
- (Key: 'mgp'; Value: 'application/vnd.osgeo.mapguide.package'), // do not localize
- (Key: 'dp'; Value: 'application/vnd.osgi.dp'), // do not localize
- (Key: 'esa'; Value: 'application/vnd.osgi.subsystem'), // do not localize
- (Key: 'pdb'; Value: 'application/vnd.palm'), // do not localize
- (Key: 'pqa'; Value: 'application/vnd.palm'), // do not localize
- (Key: 'oprc'; Value: 'application/vnd.palm'), // do not localize
- (Key: 'paw'; Value: 'application/vnd.pawaafile'), // do not localize
- (Key: 'str'; Value: 'application/vnd.pg.format'), // do not localize
- (Key: 'ei6'; Value: 'application/vnd.pg.osasli'), // do not localize
- (Key: 'efif'; Value: 'application/vnd.picsel'), // do not localize
- (Key: 'wg'; Value: 'application/vnd.pmi.widget'), // do not localize
- (Key: 'plf'; Value: 'application/vnd.pocketlearn'), // do not localize
- (Key: 'pbd'; Value: 'application/vnd.powerbuilder6'), // do not localize
- (Key: 'box'; Value: 'application/vnd.previewsystems.box'), // do not localize
- (Key: 'mgz'; Value: 'application/vnd.proteus.magazine'), // do not localize
- (Key: 'qps'; Value: 'application/vnd.publishare-delta-tree'), // do not localize
- (Key: 'ptid'; Value: 'application/vnd.pvi.ptid1'), // do not localize
- (Key: 'qxd'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'qxt'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'qwd'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'qwt'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'qxl'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'qxb'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
- (Key: 'bed'; Value: 'application/vnd.realvnc.bed'), // do not localize
- (Key: 'mxl'; Value: 'application/vnd.recordare.musicxml'), // do not localize
- (Key: 'musicxml'; Value: 'application/vnd.recordare.musicxml+xml'), // do not localize
- (Key: 'cryptonote'; Value: 'application/vnd.rig.cryptonote'), // do not localize
- (Key: 'cod'; Value: 'application/vnd.rim.cod'), // do not localize
- (Key: 'rm'; Value: 'application/vnd.rn-realmedia'), // do not localize
- (Key: 'rmvb'; Value: 'application/vnd.rn-realmedia-vbr'), // do not localize
- (Key: 'link66'; Value: 'application/vnd.route66.link66+xml'), // do not localize
- (Key: 'st'; Value: 'application/vnd.sailingtracker.track'), // do not localize
- (Key: 'see'; Value: 'application/vnd.seemail'), // do not localize
- (Key: 'sema'; Value: 'application/vnd.sema'), // do not localize
- (Key: 'semd'; Value: 'application/vnd.semd'), // do not localize
- (Key: 'semf'; Value: 'application/vnd.semf'), // do not localize
- (Key: 'ifm'; Value: 'application/vnd.shana.informed.formdata'), // do not localize
- (Key: 'itp'; Value: 'application/vnd.shana.informed.formtemplate'), // do not localize
- (Key: 'iif'; Value: 'application/vnd.shana.informed.interchange'), // do not localize
- (Key: 'ipk'; Value: 'application/vnd.shana.informed.package'), // do not localize
- (Key: 'twd'; Value: 'application/vnd.simtech-mindmapper'), // do not localize
- (Key: 'twds'; Value: 'application/vnd.simtech-mindmapper'), // do not localize
- (Key: 'mmf'; Value: 'application/vnd.smaf'), // do not localize
- (Key: 'teacher'; Value: 'application/vnd.smart.teacher'), // do not localize
- (Key: 'sdkm'; Value: 'application/vnd.solent.sdkm+xml'), // do not localize
- (Key: 'sdkd'; Value: 'application/vnd.solent.sdkm+xml'), // do not localize
- (Key: 'dxp'; Value: 'application/vnd.spotfire.dxp'), // do not localize
- (Key: 'sfs'; Value: 'application/vnd.spotfire.sfs'), // do not localize
- (Key: 'sdc'; Value: 'application/vnd.stardivision.calc'), // do not localize
- (Key: 'sda'; Value: 'application/vnd.stardivision.draw'), // do not localize
- (Key: 'sdd'; Value: 'application/vnd.stardivision.impress'), // do not localize
- (Key: 'smf'; Value: 'application/vnd.stardivision.math'), // do not localize
- (Key: 'sdw'; Value: 'application/vnd.stardivision.writer'), // do not localize
- (Key: 'vor'; Value: 'application/vnd.stardivision.writer'), // do not localize
- (Key: 'sgl'; Value: 'application/vnd.stardivision.writer-global'), // do not localize
- (Key: 'smzip'; Value: 'application/vnd.stepmania.package'), // do not localize
- (Key: 'sm'; Value: 'application/vnd.stepmania.stepchart'), // do not localize
- (Key: 'sxc'; Value: 'application/vnd.sun.xml.calc'), // do not localize
- (Key: 'stc'; Value: 'application/vnd.sun.xml.calc.template'), // do not localize
- (Key: 'sxd'; Value: 'application/vnd.sun.xml.draw'), // do not localize
- (Key: 'std'; Value: 'application/vnd.sun.xml.draw.template'), // do not localize
- (Key: 'sxi'; Value: 'application/vnd.sun.xml.impress'), // do not localize
- (Key: 'sti'; Value: 'application/vnd.sun.xml.impress.template'), // do not localize
- (Key: 'sxm'; Value: 'application/vnd.sun.xml.math'), // do not localize
- (Key: 'sxw'; Value: 'application/vnd.sun.xml.writer'), // do not localize
- (Key: 'sxg'; Value: 'application/vnd.sun.xml.writer.global'), // do not localize
- (Key: 'stw'; Value: 'application/vnd.sun.xml.writer.template'), // do not localize
- (Key: 'sus'; Value: 'application/vnd.sus-calendar'), // do not localize
- (Key: 'susp'; Value: 'application/vnd.sus-calendar'), // do not localize
- (Key: 'svd'; Value: 'application/vnd.svd'), // do not localize
- (Key: 'sis'; Value: 'application/vnd.symbian.install'), // do not localize
- (Key: 'sisx'; Value: 'application/vnd.symbian.install'), // do not localize
- (Key: 'xsm'; Value: 'application/vnd.syncml+xml'), // do not localize
- (Key: 'bdm'; Value: 'application/vnd.syncml.dm+wbxml'), // do not localize
- (Key: 'xdm'; Value: 'application/vnd.syncml.dm+xml'), // do not localize
- (Key: 'tao'; Value: 'application/vnd.tao.intent-module-archive'), // do not localize
- (Key: 'pcap'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
- (Key: 'cap'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
- (Key: 'dmp'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
- (Key: 'tmo'; Value: 'application/vnd.tmobile-livetv'), // do not localize
- (Key: 'tpt'; Value: 'application/vnd.trid.tpt'), // do not localize
- (Key: 'mxs'; Value: 'application/vnd.triscape.mxs'), // do not localize
- (Key: 'tra'; Value: 'application/vnd.trueapp'), // do not localize
- (Key: 'ufd'; Value: 'application/vnd.ufdl'), // do not localize
- (Key: 'ufdl'; Value: 'application/vnd.ufdl'), // do not localize
- (Key: 'utz'; Value: 'application/vnd.uiq.theme'), // do not localize
- (Key: 'umj'; Value: 'application/vnd.umajin'), // do not localize
- (Key: 'unityweb'; Value: 'application/vnd.unity'), // do not localize
- (Key: 'uoml'; Value: 'application/vnd.uoml+xml'), // do not localize
- (Key: 'vcx'; Value: 'application/vnd.vcx'), // do not localize
- (Key: 'vsd'; Value: 'application/vnd.visio'), // do not localize
- (Key: 'vst'; Value: 'application/vnd.visio'), // do not localize
- (Key: 'vss'; Value: 'application/vnd.visio'), // do not localize
- (Key: 'vsw'; Value: 'application/vnd.visio'), // do not localize
- (Key: 'vis'; Value: 'application/vnd.visionary'), // do not localize
- (Key: 'vsf'; Value: 'application/vnd.vsf'), // do not localize
- (Key: 'wbxml'; Value: 'application/vnd.wap.wbxml'), // do not localize
- (Key: 'wmlc'; Value: 'application/vnd.wap.wmlc'), // do not localize
- (Key: 'wmlsc'; Value: 'application/vnd.wap.wmlscriptc'), // do not localize
- (Key: 'wtb'; Value: 'application/vnd.webturbo'), // do not localize
- (Key: 'nbp'; Value: 'application/vnd.wolfram.player'), // do not localize
- (Key: 'wpd'; Value: 'application/vnd.wordperfect'), // do not localize
- (Key: 'wqd'; Value: 'application/vnd.wqd'), // do not localize
- (Key: 'stf'; Value: 'application/vnd.wt.stf'), // do not localize
- (Key: 'xar'; Value: 'application/vnd.xara'), // do not localize
- (Key: 'xfdl'; Value: 'application/vnd.xfdl'), // do not localize
- (Key: 'hvd'; Value: 'application/vnd.yamaha.hv-dic'), // do not localize
- (Key: 'hvs'; Value: 'application/vnd.yamaha.hv-script'), // do not localize
- (Key: 'hvp'; Value: 'application/vnd.yamaha.hv-voice'), // do not localize
- (Key: 'osf'; Value: 'application/vnd.yamaha.openscoreformat'), // do not localize
- (Key: 'osfpvg'; Value: 'application/vnd.yamaha.openscoreformat.osfpvg+xml'), // do not localize
- (Key: 'saf'; Value: 'application/vnd.yamaha.smaf-audio'), // do not localize
- (Key: 'spf'; Value: 'application/vnd.yamaha.smaf-phrase'), // do not localize
- (Key: 'cmp'; Value: 'application/vnd.yellowriver-custom-menu'), // do not localize
- (Key: 'zir'; Value: 'application/vnd.zul'), // do not localize
- (Key: 'zirz'; Value: 'application/vnd.zul'), // do not localize
- (Key: 'zaz'; Value: 'application/vnd.zzazz.deck+xml'), // do not localize
- (Key: 'vxml'; Value: 'application/voicexml+xml'), // do not localize
- (Key: 'wgt'; Value: 'application/widget'), // do not localize
- (Key: 'hlp'; Value: 'application/winhlp'), // do not localize
- (Key: 'wsdl'; Value: 'application/wsdl+xml'), // do not localize
- (Key: 'wspolicy'; Value: 'application/wspolicy+xml'), // do not localize
- (Key: '7z'; Value: 'application/x-7z-compressed'), // do not localize
- (Key: 'abw'; Value: 'application/x-abiword'), // do not localize
- (Key: 'ace'; Value: 'application/x-ace-compressed'), // do not localize
- (Key: 'dmg'; Value: 'application/x-apple-diskimage'), // do not localize
- (Key: 'aab'; Value: 'application/x-authorware-bin'), // do not localize
- (Key: 'x32'; Value: 'application/x-authorware-bin'), // do not localize
- (Key: 'u32'; Value: 'application/x-authorware-bin'), // do not localize
- (Key: 'vox'; Value: 'application/x-authorware-bin'), // do not localize
- (Key: 'aam'; Value: 'application/x-authorware-map'), // do not localize
- (Key: 'aas'; Value: 'application/x-authorware-seg'), // do not localize
- (Key: 'bcpio'; Value: 'application/x-bcpio'), // do not localize
- (Key: 'torrent'; Value: 'application/x-bittorrent'), // do not localize
- (Key: 'blb'; Value: 'application/x-blorb'), // do not localize
- (Key: 'blorb'; Value: 'application/x-blorb'), // do not localize
- (Key: 'bz'; Value: 'application/x-bzip'), // do not localize
- (Key: 'bz2'; Value: 'application/x-bzip2'), // do not localize
- (Key: 'boz'; Value: 'application/x-bzip2'), // do not localize
- (Key: 'cbr'; Value: 'application/x-cbr'), // do not localize
- (Key: 'cba'; Value: 'application/x-cbr'), // do not localize
- (Key: 'cbt'; Value: 'application/x-cbr'), // do not localize
- (Key: 'cbz'; Value: 'application/x-cbr'), // do not localize
- (Key: 'cb7'; Value: 'application/x-cbr'), // do not localize
- (Key: 'vcd'; Value: 'application/x-cdlink'), // do not localize
- (Key: 'cfs'; Value: 'application/x-cfs-compressed'), // do not localize
- (Key: 'chat'; Value: 'application/x-chat'), // do not localize
- (Key: 'pgn'; Value: 'application/x-chess-pgn'), // do not localize
- (Key: 'nsc'; Value: 'application/x-conference'), // do not localize
- (Key: 'cpio'; Value: 'application/x-cpio'), // do not localize
- (Key: 'csh'; Value: 'application/x-csh'), // do not localize
- (Key: 'deb'; Value: 'application/x-debian-package'), // do not localize
- (Key: 'udeb'; Value: 'application/x-debian-package'), // do not localize
- (Key: 'dgc'; Value: 'application/x-dgc-compressed'), // do not localize
- (Key: 'dir'; Value: 'application/x-director'), // do not localize
- (Key: 'dcr'; Value: 'application/x-director'), // do not localize
- (Key: 'dxr'; Value: 'application/x-director'), // do not localize
- (Key: 'cst'; Value: 'application/x-director'), // do not localize
- (Key: 'cct'; Value: 'application/x-director'), // do not localize
- (Key: 'cxt'; Value: 'application/x-director'), // do not localize
- (Key: 'w3d'; Value: 'application/x-director'), // do not localize
- (Key: 'fgd'; Value: 'application/x-director'), // do not localize
- (Key: 'swa'; Value: 'application/x-director'), // do not localize
- (Key: 'wad'; Value: 'application/x-doom'), // do not localize
- (Key: 'ncx'; Value: 'application/x-dtbncx+xml'), // do not localize
- (Key: 'dtb'; Value: 'application/x-dtbook+xml'), // do not localize
- (Key: 'res'; Value: 'application/x-dtbresource+xml'), // do not localize
- (Key: 'dvi'; Value: 'application/x-dvi'), // do not localize
- (Key: 'evy'; Value: 'application/x-envoy'), // do not localize
- (Key: 'eva'; Value: 'application/x-eva'), // do not localize
- (Key: 'bdf'; Value: 'application/x-font-bdf'), // do not localize
- (Key: 'gsf'; Value: 'application/x-font-ghostscript'), // do not localize
- (Key: 'psf'; Value: 'application/x-font-linux-psf'), // do not localize
- (Key: 'otf'; Value: 'application/x-font-otf'), // do not localize
- (Key: 'pcf'; Value: 'application/x-font-pcf'), // do not localize
- (Key: 'snf'; Value: 'application/x-font-snf'), // do not localize
- (Key: 'ttf'; Value: 'application/x-font-ttf'), // do not localize
- (Key: 'ttc'; Value: 'application/x-font-ttf'), // do not localize
- (Key: 'pfa'; Value: 'application/x-font-type1'), // do not localize
- (Key: 'pfb'; Value: 'application/x-font-type1'), // do not localize
- (Key: 'pfm'; Value: 'application/x-font-type1'), // do not localize
- (Key: 'afm'; Value: 'application/x-font-type1'), // do not localize
- (Key: 'woff'; Value: 'application/x-font-woff'), // do not localize
- (Key: 'arc'; Value: 'application/x-freearc'), // do not localize
- (Key: 'spl'; Value: 'application/x-futuresplash'), // do not localize
- (Key: 'gca'; Value: 'application/x-gca-compressed'), // do not localize
- (Key: 'ulx'; Value: 'application/x-glulx'), // do not localize
- (Key: 'gnumeric'; Value: 'application/x-gnumeric'), // do not localize
- (Key: 'gramps'; Value: 'application/x-gramps-xml'), // do not localize
- (Key: 'gtar'; Value: 'application/x-gtar'), // do not localize
- (Key: 'hdf'; Value: 'application/x-hdf'), // do not localize
- (Key: 'install'; Value: 'application/x-install-instructions'), // do not localize
- (Key: 'iso'; Value: 'application/x-iso9660-image'), // do not localize
- (Key: 'jnlp'; Value: 'application/x-java-jnlp-file'), // do not localize
- (Key: 'latex'; Value: 'application/x-latex'), // do not localize
- (Key: 'lzh'; Value: 'application/x-lzh-compressed'), // do not localize
- (Key: 'lha'; Value: 'application/x-lzh-compressed'), // do not localize
- (Key: 'mie'; Value: 'application/x-mie'), // do not localize
- (Key: 'prc'; Value: 'application/x-mobipocket-ebook'), // do not localize
- (Key: 'mobi'; Value: 'application/x-mobipocket-ebook'), // do not localize
- (Key: 'application'; Value: 'application/x-ms-application'), // do not localize
- (Key: 'lnk'; Value: 'application/x-ms-shortcut'), // do not localize
- (Key: 'wmd'; Value: 'application/x-ms-wmd'), // do not localize
- (Key: 'wmz'; Value: 'application/x-ms-wmz'), // do not localize
- (Key: 'xbap'; Value: 'application/x-ms-xbap'), // do not localize
- (Key: 'mdb'; Value: 'application/x-msaccess'), // do not localize
- (Key: 'obd'; Value: 'application/x-msbinder'), // do not localize
- (Key: 'crd'; Value: 'application/x-mscardfile'), // do not localize
- (Key: 'clp'; Value: 'application/x-msclip'), // do not localize
- (Key: 'exe'; Value: 'application/x-msdownload'), // do not localize
- (Key: 'dll'; Value: 'application/x-msdownload'), // do not localize
- (Key: 'com'; Value: 'application/x-msdownload'), // do not localize
- (Key: 'bat'; Value: 'application/x-msdownload'), // do not localize
- (Key: 'msi'; Value: 'application/x-msdownload'), // do not localize
- (Key: 'mvb'; Value: 'application/x-msmediaview'), // do not localize
- (Key: 'm13'; Value: 'application/x-msmediaview'), // do not localize
- (Key: 'm14'; Value: 'application/x-msmediaview'), // do not localize
- (Key: 'wmf'; Value: 'application/x-msmetafile'), // do not localize
- (Key: 'wmz'; Value: 'application/x-msmetafile'), // do not localize
- (Key: 'emf'; Value: 'application/x-msmetafile'), // do not localize
- (Key: 'emz'; Value: 'application/x-msmetafile'), // do not localize
- (Key: 'mny'; Value: 'application/x-msmoney'), // do not localize
- (Key: 'pub'; Value: 'application/x-mspublisher'), // do not localize
- (Key: 'scd'; Value: 'application/x-msschedule'), // do not localize
- (Key: 'trm'; Value: 'application/x-msterminal'), // do not localize
- (Key: 'wri'; Value: 'application/x-mswrite'), // do not localize
- (Key: 'nc'; Value: 'application/x-netcdf'), // do not localize
- (Key: 'cdf'; Value: 'application/x-netcdf'), // do not localize
- (Key: 'nzb'; Value: 'application/x-nzb'), // do not localize
- (Key: 'p12'; Value: 'application/x-pkcs12'), // do not localize
- (Key: 'pfx'; Value: 'application/x-pkcs12'), // do not localize
- (Key: 'p7b'; Value: 'application/x-pkcs7-certificates'), // do not localize
- (Key: 'spc'; Value: 'application/x-pkcs7-certificates'), // do not localize
- (Key: 'p7r'; Value: 'application/x-pkcs7-certreqresp'), // do not localize
- (Key: 'rar'; Value: 'application/x-rar-compressed'), // do not localize
- (Key: 'ris'; Value: 'application/x-research-info-systems'), // do not localize
- (Key: 'sh'; Value: 'application/x-sh'), // do not localize
- (Key: 'shar'; Value: 'application/x-shar'), // do not localize
- (Key: 'swf'; Value: 'application/x-shockwave-flash'), // do not localize
- (Key: 'xap'; Value: 'application/x-silverlight-app'), // do not localize
- (Key: 'sql'; Value: 'application/x-sql'), // do not localize
- (Key: 'sit'; Value: 'application/x-stuffit'), // do not localize
- (Key: 'sitx'; Value: 'application/x-stuffitx'), // do not localize
- (Key: 'srt'; Value: 'application/x-subrip'), // do not localize
- (Key: 'sv4cpio'; Value: 'application/x-sv4cpio'), // do not localize
- (Key: 'sv4crc'; Value: 'application/x-sv4crc'), // do not localize
- (Key: 't3'; Value: 'application/x-t3vm-image'), // do not localize
- (Key: 'gam'; Value: 'application/x-tads'), // do not localize
- (Key: 'tar'; Value: 'application/x-tar'), // do not localize
- (Key: 'tcl'; Value: 'application/x-tcl'), // do not localize
- (Key: 'tex'; Value: 'application/x-tex'), // do not localize
- (Key: 'tfm'; Value: 'application/x-tex-tfm'), // do not localize
- (Key: 'texinfo'; Value: 'application/x-texinfo'), // do not localize
- (Key: 'texi'; Value: 'application/x-texinfo'), // do not localize
- (Key: 'obj'; Value: 'application/x-tgif'), // do not localize
- (Key: 'ustar'; Value: 'application/x-ustar'), // do not localize
- (Key: 'src'; Value: 'application/x-wais-source'), // do not localize
- (Key: 'der'; Value: 'application/x-x509-ca-cert'), // do not localize
- (Key: 'crt'; Value: 'application/x-x509-ca-cert'), // do not localize
- (Key: 'fig'; Value: 'application/x-xfig'), // do not localize
- (Key: 'xlf'; Value: 'application/x-xliff+xml'), // do not localize
- (Key: 'xpi'; Value: 'application/x-xpinstall'), // do not localize
- (Key: 'xz'; Value: 'application/x-xz'), // do not localize
- (Key: 'z1'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z2'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z3'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z4'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z5'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z6'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z7'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'z8'; Value: 'application/x-zmachine'), // do not localize
- (Key: 'xaml'; Value: 'application/xaml+xml'), // do not localize
- (Key: 'xdf'; Value: 'application/xcap-diff+xml'), // do not localize
- (Key: 'xenc'; Value: 'application/xenc+xml'), // do not localize
- (Key: 'xhtml'; Value: 'application/xhtml+xml'), // do not localize
- (Key: 'xht'; Value: 'application/xhtml+xml'), // do not localize
- (Key: 'xml'; Value: 'application/xml'), // do not localize
- (Key: 'xsl'; Value: 'application/xml'), // do not localize
- (Key: 'dtd'; Value: 'application/xml-dtd'), // do not localize
- (Key: 'xop'; Value: 'application/xop+xml'), // do not localize
- (Key: 'xpl'; Value: 'application/xproc+xml'), // do not localize
- (Key: 'xslt'; Value: 'application/xslt+xml'), // do not localize
- (Key: 'xspf'; Value: 'application/xspf+xml'), // do not localize
- (Key: 'mxml'; Value: 'application/xv+xml'), // do not localize
- (Key: 'xhvml'; Value: 'application/xv+xml'), // do not localize
- (Key: 'xvml'; Value: 'application/xv+xml'), // do not localize
- (Key: 'xvm'; Value: 'application/xv+xml'), // do not localize
- (Key: 'yang'; Value: 'application/yang'), // do not localize
- (Key: 'yin'; Value: 'application/yin+xml'), // do not localize
- (Key: 'zip'; Value: 'application/zip'), // do not localize
- (Key: 'adp'; Value: 'audio/adpcm'), // do not localize
- (Key: 'au'; Value: 'audio/basic'), // do not localize
- (Key: 'snd'; Value: 'audio/basic'), // do not localize
- (Key: 'mid'; Value: 'audio/midi'), // do not localize
- (Key: 'midi'; Value: 'audio/midi'), // do not localize
- (Key: 'kar'; Value: 'audio/midi'), // do not localize
- (Key: 'rmi'; Value: 'audio/midi'), // do not localize
- (Key: 'mp4a'; Value: 'audio/mp4'), // do not localize
- (Key: 'mpga'; Value: 'audio/mpeg'), // do not localize
- (Key: 'mp2'; Value: 'audio/mpeg'), // do not localize
- (Key: 'mp2a'; Value: 'audio/mpeg'), // do not localize
- (Key: 'mp3'; Value: 'audio/mpeg'), // do not localize
- (Key: 'm2a'; Value: 'audio/mpeg'), // do not localize
- (Key: 'm3a'; Value: 'audio/mpeg'), // do not localize
- (Key: 'oga'; Value: 'audio/ogg'), // do not localize
- (Key: 'ogg'; Value: 'audio/ogg'), // do not localize
- (Key: 'spx'; Value: 'audio/ogg'), // do not localize
- (Key: 's3m'; Value: 'audio/s3m'), // do not localize
- (Key: 'sil'; Value: 'audio/silk'), // do not localize
- (Key: 'uva'; Value: 'audio/vnd.dece.audio'), // do not localize
- (Key: 'uvva'; Value: 'audio/vnd.dece.audio'), // do not localize
- (Key: 'eol'; Value: 'audio/vnd.digital-winds'), // do not localize
- (Key: 'dra'; Value: 'audio/vnd.dra'), // do not localize
- (Key: 'dts'; Value: 'audio/vnd.dts'), // do not localize
- (Key: 'dtshd'; Value: 'audio/vnd.dts.hd'), // do not localize
- (Key: 'lvp'; Value: 'audio/vnd.lucent.voice'), // do not localize
- (Key: 'pya'; Value: 'audio/vnd.ms-playready.media.pya'), // do not localize
- (Key: 'ecelp4800'; Value: 'audio/vnd.nuera.ecelp4800'), // do not localize
- (Key: 'ecelp7470'; Value: 'audio/vnd.nuera.ecelp7470'), // do not localize
- (Key: 'ecelp9600'; Value: 'audio/vnd.nuera.ecelp9600'), // do not localize
- (Key: 'rip'; Value: 'audio/vnd.rip'), // do not localize
- (Key: 'weba'; Value: 'audio/webm'), // do not localize
- (Key: 'aac'; Value: 'audio/x-aac'), // do not localize
- (Key: 'aif'; Value: 'audio/x-aiff'), // do not localize
- (Key: 'aiff'; Value: 'audio/x-aiff'), // do not localize
- (Key: 'aifc'; Value: 'audio/x-aiff'), // do not localize
- (Key: 'caf'; Value: 'audio/x-caf'), // do not localize
- (Key: 'flac'; Value: 'audio/x-flac'), // do not localize
- (Key: 'mka'; Value: 'audio/x-matroska'), // do not localize
- (Key: 'm3u'; Value: 'audio/x-mpegurl'), // do not localize
- (Key: 'wax'; Value: 'audio/x-ms-wax'), // do not localize
- (Key: 'wma'; Value: 'audio/x-ms-wma'), // do not localize
- (Key: 'ram'; Value: 'audio/x-pn-realaudio'), // do not localize
- (Key: 'ra'; Value: 'audio/x-pn-realaudio'), // do not localize
- (Key: 'rmp'; Value: 'audio/x-pn-realaudio-plugin'), // do not localize
- (Key: 'wav'; Value: 'audio/x-wav'), // do not localize
- (Key: 'xm'; Value: 'audio/xm'), // do not localize
- (Key: 'cdx'; Value: 'chemical/x-cdx'), // do not localize
- (Key: 'cif'; Value: 'chemical/x-cif'), // do not localize
- (Key: 'cmdf'; Value: 'chemical/x-cmdf'), // do not localize
- (Key: 'cml'; Value: 'chemical/x-cml'), // do not localize
- (Key: 'csml'; Value: 'chemical/x-csml'), // do not localize
- (Key: 'xyz'; Value: 'chemical/x-xyz'), // do not localize
- (Key: 'bmp'; Value: 'image/bmp'), // do not localize
- (Key: 'cgm'; Value: 'image/cgm'), // do not localize
- (Key: 'g3'; Value: 'image/g3fax'), // do not localize
- (Key: 'gif'; Value: 'image/gif'), // do not localize
- (Key: 'ief'; Value: 'image/ief'), // do not localize
- (Key: 'jpeg'; Value: 'image/jpeg'), // do not localize
- (Key: 'jpg'; Value: 'image/jpeg'), // do not localize
- (Key: 'jpe'; Value: 'image/jpeg'), // do not localize
- (Key: 'ktx'; Value: 'image/ktx'), // do not localize
- (Key: 'png'; Value: 'image/png'), // do not localize
- (Key: 'btif'; Value: 'image/prs.btif'), // do not localize
- (Key: 'sgi'; Value: 'image/sgi'), // do not localize
- (Key: 'svg'; Value: 'image/svg+xml'), // do not localize
- (Key: 'svgz'; Value: 'image/svg+xml'), // do not localize
- (Key: 'tiff'; Value: 'image/tiff'), // do not localize
- (Key: 'tif'; Value: 'image/tiff'), // do not localize
- (Key: 'psd'; Value: 'image/vnd.adobe.photoshop'), // do not localize
- (Key: 'uvi'; Value: 'image/vnd.dece.graphic'), // do not localize
- (Key: 'uvvi'; Value: 'image/vnd.dece.graphic'), // do not localize
- (Key: 'uvg'; Value: 'image/vnd.dece.graphic'), // do not localize
- (Key: 'uvvg'; Value: 'image/vnd.dece.graphic'), // do not localize
- (Key: 'sub'; Value: 'image/vnd.dvb.subtitle'), // do not localize
- (Key: 'djvu'; Value: 'image/vnd.djvu'), // do not localize
- (Key: 'djv'; Value: 'image/vnd.djvu'), // do not localize
- (Key: 'dwg'; Value: 'image/vnd.dwg'), // do not localize
- (Key: 'dxf'; Value: 'image/vnd.dxf'), // do not localize
- (Key: 'fbs'; Value: 'image/vnd.fastbidsheet'), // do not localize
- (Key: 'fpx'; Value: 'image/vnd.fpx'), // do not localize
- (Key: 'fst'; Value: 'image/vnd.fst'), // do not localize
- (Key: 'mmr'; Value: 'image/vnd.fujixerox.edmics-mmr'), // do not localize
- (Key: 'rlc'; Value: 'image/vnd.fujixerox.edmics-rlc'), // do not localize
- (Key: 'mdi'; Value: 'image/vnd.ms-modi'), // do not localize
- (Key: 'wdp'; Value: 'image/vnd.ms-photo'), // do not localize
- (Key: 'npx'; Value: 'image/vnd.net-fpx'), // do not localize
- (Key: 'wbmp'; Value: 'image/vnd.wap.wbmp'), // do not localize
- (Key: 'xif'; Value: 'image/vnd.xiff'), // do not localize
- (Key: 'webp'; Value: 'image/webp'), // do not localize
- (Key: '3ds'; Value: 'image/x-3ds'), // do not localize
- (Key: 'ras'; Value: 'image/x-cmu-raster'), // do not localize
- (Key: 'cmx'; Value: 'image/x-cmx'), // do not localize
- (Key: 'fh'; Value: 'image/x-freehand'), // do not localize
- (Key: 'fhc'; Value: 'image/x-freehand'), // do not localize
- (Key: 'fh4'; Value: 'image/x-freehand'), // do not localize
- (Key: 'fh5'; Value: 'image/x-freehand'), // do not localize
- (Key: 'fh7'; Value: 'image/x-freehand'), // do not localize
- (Key: 'ico'; Value: 'image/x-icon'), // do not localize
- (Key: 'sid'; Value: 'image/x-mrsid-image'), // do not localize
- (Key: 'pcx'; Value: 'image/x-pcx'), // do not localize
- (Key: 'pic'; Value: 'image/x-pict'), // do not localize
- (Key: 'pct'; Value: 'image/x-pict'), // do not localize
- (Key: 'pnm'; Value: 'image/x-portable-anymap'), // do not localize
- (Key: 'pbm'; Value: 'image/x-portable-bitmap'), // do not localize
- (Key: 'pgm'; Value: 'image/x-portable-graymap'), // do not localize
- (Key: 'ppm'; Value: 'image/x-portable-pixmap'), // do not localize
- (Key: 'rgb'; Value: 'image/x-rgb'), // do not localize
- (Key: 'tga'; Value: 'image/x-tga'), // do not localize
- (Key: 'xbm'; Value: 'image/x-xbitmap'), // do not localize
- (Key: 'xpm'; Value: 'image/x-xpixmap'), // do not localize
- (Key: 'xwd'; Value: 'image/x-xwindowdump'), // do not localize
- (Key: 'eml'; Value: 'message/rfc822'), // do not localize
- (Key: 'mime'; Value: 'message/rfc822'), // do not localize
- (Key: 'igs'; Value: 'model/iges'), // do not localize
- (Key: 'iges'; Value: 'model/iges'), // do not localize
- (Key: 'msh'; Value: 'model/mesh'), // do not localize
- (Key: 'mesh'; Value: 'model/mesh'), // do not localize
- (Key: 'silo'; Value: 'model/mesh'), // do not localize
- (Key: 'dae'; Value: 'model/vnd.collada+xml'), // do not localize
- (Key: 'dwf'; Value: 'model/vnd.dwf'), // do not localize
- (Key: 'gdl'; Value: 'model/vnd.gdl'), // do not localize
- (Key: 'gtw'; Value: 'model/vnd.gtw'), // do not localize
- (Key: 'mts'; Value: 'model/vnd.mts'), // do not localize
- (Key: 'vtu'; Value: 'model/vnd.vtu'), // do not localize
- (Key: 'wrl'; Value: 'model/vrml'), // do not localize
- (Key: 'vrml'; Value: 'model/vrml'), // do not localize
- (Key: 'x3db'; Value: 'model/x3d+binary'), // do not localize
- (Key: 'x3dbz'; Value: 'model/x3d+binary'), // do not localize
- (Key: 'x3dv'; Value: 'model/x3d+vrml'), // do not localize
- (Key: 'x3dvz'; Value: 'model/x3d+vrml'), // do not localize
- (Key: 'x3d'; Value: 'model/x3d+xml'), // do not localize
- (Key: 'x3dz'; Value: 'model/x3d+xml'), // do not localize
- (Key: 'appcache'; Value: 'text/cache-manifest'), // do not localize
- (Key: 'ics'; Value: 'text/calendar'), // do not localize
- (Key: 'ifb'; Value: 'text/calendar'), // do not localize
- (Key: 'css'; Value: 'text/css'), // do not localize
- (Key: 'csv'; Value: 'text/csv'), // do not localize
- (Key: 'html'; Value: 'text/html'), // do not localize
- (Key: 'htm'; Value: 'text/html'), // do not localize
- (Key: 'n3'; Value: 'text/n3'), // do not localize
- (Key: 'txt'; Value: 'text/plain'), // do not localize
- (Key: 'text'; Value: 'text/plain'), // do not localize
- (Key: 'conf'; Value: 'text/plain'), // do not localize
- (Key: 'def'; Value: 'text/plain'), // do not localize
- (Key: 'list'; Value: 'text/plain'), // do not localize
- (Key: 'log'; Value: 'text/plain'), // do not localize
- (Key: 'in'; Value: 'text/plain'), // do not localize
- (Key: 'dsc'; Value: 'text/prs.lines.tag'), // do not localize
- (Key: 'rtx'; Value: 'text/richtext'), // do not localize
- (Key: 'sgml'; Value: 'text/sgml'), // do not localize
- (Key: 'sgm'; Value: 'text/sgml'), // do not localize
- (Key: 'tsv'; Value: 'text/tab-separated-values'), // do not localize
- (Key: 't'; Value: 'text/troff'), // do not localize
- (Key: 'tr'; Value: 'text/troff'), // do not localize
- (Key: 'roff'; Value: 'text/troff'), // do not localize
- (Key: 'man'; Value: 'text/troff'), // do not localize
- (Key: 'me'; Value: 'text/troff'), // do not localize
- (Key: 'ms'; Value: 'text/troff'), // do not localize
- (Key: 'ttl'; Value: 'text/turtle'), // do not localize
- (Key: 'uri'; Value: 'text/uri-list'), // do not localize
- (Key: 'uris'; Value: 'text/uri-list'), // do not localize
- (Key: 'urls'; Value: 'text/uri-list'), // do not localize
- (Key: 'vcard'; Value: 'text/vcard'), // do not localize
- (Key: 'curl'; Value: 'text/vnd.curl'), // do not localize
- (Key: 'dcurl'; Value: 'text/vnd.curl.dcurl'), // do not localize
- (Key: 'scurl'; Value: 'text/vnd.curl.scurl'), // do not localize
- (Key: 'mcurl'; Value: 'text/vnd.curl.mcurl'), // do not localize
- (Key: 'sub'; Value: 'text/vnd.dvb.subtitle'), // do not localize
- (Key: 'fly'; Value: 'text/vnd.fly'), // do not localize
- (Key: 'flx'; Value: 'text/vnd.fmi.flexstor'), // do not localize
- (Key: 'gv'; Value: 'text/vnd.graphviz'), // do not localize
- (Key: '3dml'; Value: 'text/vnd.in3d.3dml'), // do not localize
- (Key: 'spot'; Value: 'text/vnd.in3d.spot'), // do not localize
- (Key: 'jad'; Value: 'text/vnd.sun.j2me.app-descriptor'), // do not localize
- (Key: 'wml'; Value: 'text/vnd.wap.wml'), // do not localize
- (Key: 'wmls'; Value: 'text/vnd.wap.wmlscript'), // do not localize
- (Key: 's'; Value: 'text/x-asm'), // do not localize
- (Key: 'asm'; Value: 'text/x-asm'), // do not localize
- (Key: 'c'; Value: 'text/x-c'), // do not localize
- (Key: 'cc'; Value: 'text/x-c'), // do not localize
- (Key: 'cxx'; Value: 'text/x-c'), // do not localize
- (Key: 'cpp'; Value: 'text/x-c'), // do not localize
- (Key: 'h'; Value: 'text/x-c'), // do not localize
- (Key: 'hh'; Value: 'text/x-c'), // do not localize
- (Key: 'dic'; Value: 'text/x-c'), // do not localize
- (Key: 'f'; Value: 'text/x-fortran'), // do not localize
- (Key: 'for'; Value: 'text/x-fortran'), // do not localize
- (Key: 'f77'; Value: 'text/x-fortran'), // do not localize
- (Key: 'f90'; Value: 'text/x-fortran'), // do not localize
- (Key: 'java'; Value: 'text/x-java-source'), // do not localize
- (Key: 'opml'; Value: 'text/x-opml'), // do not localize
- (Key: 'p'; Value: 'text/x-pascal'), // do not localize
- (Key: 'pas'; Value: 'text/x-pascal'), // do not localize
- (Key: 'nfo'; Value: 'text/x-nfo'), // do not localize
- (Key: 'etx'; Value: 'text/x-setext'), // do not localize
- (Key: 'sfv'; Value: 'text/x-sfv'), // do not localize
- (Key: 'uu'; Value: 'text/x-uuencode'), // do not localize
- (Key: 'vcs'; Value: 'text/x-vcalendar'), // do not localize
- (Key: 'vcf'; Value: 'text/x-vcard'), // do not localize
- (Key: '3gp'; Value: 'video/3gpp'), // do not localize
- (Key: '3g2'; Value: 'video/3gpp2'), // do not localize
- (Key: 'h261'; Value: 'video/h261'), // do not localize
- (Key: 'h263'; Value: 'video/h263'), // do not localize
- (Key: 'h264'; Value: 'video/h264'), // do not localize
- (Key: 'jpgv'; Value: 'video/jpeg'), // do not localize
- (Key: 'jpm'; Value: 'video/jpm'), // do not localize
- (Key: 'jpgm'; Value: 'video/jpm'), // do not localize
- (Key: 'mj2'; Value: 'video/mj2'), // do not localize
- (Key: 'mjp2'; Value: 'video/mj2'), // do not localize
- (Key: 'mp4'; Value: 'video/mp4'), // do not localize
- (Key: 'mp4v'; Value: 'video/mp4'), // do not localize
- (Key: 'mpg4'; Value: 'video/mp4'), // do not localize
- (Key: 'mpeg'; Value: 'video/mpeg'), // do not localize
- (Key: 'mpg'; Value: 'video/mpeg'), // do not localize
- (Key: 'mpe'; Value: 'video/mpeg'), // do not localize
- (Key: 'm1v'; Value: 'video/mpeg'), // do not localize
- (Key: 'm2v'; Value: 'video/mpeg'), // do not localize
- (Key: 'ogv'; Value: 'video/ogg'), // do not localize
- (Key: 'qt'; Value: 'video/quicktime'), // do not localize
- (Key: 'mov'; Value: 'video/quicktime'), // do not localize
- (Key: 'uvh'; Value: 'video/vnd.dece.hd'), // do not localize
- (Key: 'uvvh'; Value: 'video/vnd.dece.hd'), // do not localize
- (Key: 'uvm'; Value: 'video/vnd.dece.mobile'), // do not localize
- (Key: 'uvvm'; Value: 'video/vnd.dece.mobile'), // do not localize
- (Key: 'uvp'; Value: 'video/vnd.dece.pd'), // do not localize
- (Key: 'uvvp'; Value: 'video/vnd.dece.pd'), // do not localize
- (Key: 'uvs'; Value: 'video/vnd.dece.sd'), // do not localize
- (Key: 'uvvs'; Value: 'video/vnd.dece.sd'), // do not localize
- (Key: 'uvv'; Value: 'video/vnd.dece.video'), // do not localize
- (Key: 'uvvv'; Value: 'video/vnd.dece.video'), // do not localize
- (Key: 'dvb'; Value: 'video/vnd.dvb.file'), // do not localize
- (Key: 'fvt'; Value: 'video/vnd.fvt'), // do not localize
- (Key: 'mxu'; Value: 'video/vnd.mpegurl'), // do not localize
- (Key: 'm4u'; Value: 'video/vnd.mpegurl'), // do not localize
- (Key: 'pyv'; Value: 'video/vnd.ms-playready.media.pyv'), // do not localize
- (Key: 'uvu'; Value: 'video/vnd.uvvu.mp4'), // do not localize
- (Key: 'uvvu'; Value: 'video/vnd.uvvu.mp4'), // do not localize
- (Key: 'viv'; Value: 'video/vnd.vivo'), // do not localize
- (Key: 'webm'; Value: 'video/webm'), // do not localize
- (Key: 'f4v'; Value: 'video/x-f4v'), // do not localize
- (Key: 'fli'; Value: 'video/x-fli'), // do not localize
- (Key: 'flv'; Value: 'video/x-flv'), // do not localize
- (Key: 'm4v'; Value: 'video/x-m4v'), // do not localize
- (Key: 'mkv'; Value: 'video/x-matroska'), // do not localize
- (Key: 'mk3d'; Value: 'video/x-matroska'), // do not localize
- (Key: 'mks'; Value: 'video/x-matroska'), // do not localize
- (Key: 'mng'; Value: 'video/x-mng'), // do not localize
- (Key: 'asf'; Value: 'video/x-ms-asf'), // do not localize
- (Key: 'asx'; Value: 'video/x-ms-asf'), // do not localize
- (Key: 'vob'; Value: 'video/x-ms-vob'), // do not localize
- (Key: 'wm'; Value: 'video/x-ms-wm'), // do not localize
- (Key: 'wmv'; Value: 'video/x-ms-wmv'), // do not localize
- (Key: 'wmx'; Value: 'video/x-ms-wmx'), // do not localize
- (Key: 'wvx'; Value: 'video/x-ms-wvx'), // do not localize
- (Key: 'avi'; Value: 'video/x-msvideo'), // do not localize
- (Key: 'movie'; Value: 'video/x-sgi-movie'), // do not localize
- (Key: 'smv'; Value: 'video/x-smv'), // do not localize
- (Key: 'ice'; Value: 'x-conference/x-cooltalk'), // do not localize
- (Key: 'wasm'; Value: 'application/wasm') // do not localize
- );
- {$ENDREGION}
-
-type
- THttpMethod = class
- public const
- GET = 'GET';
- POST = 'POST';
- PUT = 'PUT';
- DELETE = 'DELETE';
- HEAD = 'HEAD';
- OPTIONS = 'OPTIONS';
- TRACE = 'TRACE';
- CONNECT = 'CONNECT';
- PROPFIND = 'PROPFIND';
- LOCK = 'LOCK';
- UNLOCK = 'UNLOCK';
- COPY = 'COPY';
- MOVE = 'MOVE';
- MKCOL = 'MKCOL';
- end;
-
- {$REGION 'Documentation'}
- ///
- /// 常用媒体类型
- ///
- {$ENDREGION}
- TMediaType = class
- public const
- DELIM_PARAMS = '; ';
- CHARSET_NAME = 'charset';
- CHARSET_UTF8 = 'UTF-8';
- CHARSET_UTF8_DEF = CHARSET_NAME + '=' + CHARSET_UTF8;
-
- TEXT_PLAIN = 'text/plain';
- TEXT_PLAIN_UTF8 = TEXT_PLAIN + DELIM_PARAMS + CHARSET_UTF8_DEF;
-
- TEXT_XML = 'text/xml';
- TEXT_XML_UTF8 = TEXT_XML + DELIM_PARAMS + CHARSET_UTF8_DEF;
-
- TEXT_HTML = 'text/html';
- TEXT_HTML_UTF8 = TEXT_HTML + DELIM_PARAMS + CHARSET_UTF8_DEF;
-
- APPLICATION_JSON = 'application/json';
- APPLICATION_JSON_UTF8 = APPLICATION_JSON + DELIM_PARAMS + CHARSET_UTF8_DEF;
-
- APPLICATION_XML = 'application/xml';
- APPLICATION_XML_UTF8 = APPLICATION_XML + DELIM_PARAMS + CHARSET_UTF8_DEF;
-
- APPLICATION_OCTET_STREAM = 'application/octet-stream';
- APPLICATION_FORM_URLENCODED_TYPE = 'application/x-www-form-urlencoded';
-
- MULTIPART_FORM_DATA = 'multipart/form-data';
- MULTIPART_FORM_DATA_BOUNDARY = MULTIPART_FORM_DATA + DELIM_PARAMS + 'boundary=';
-
- WILDCARD = '*/*';
- end;
-
- TCrossHttpUtils = class
- private const
- RFC1123_StrWeekDay: string = 'MonTueWedThuFriSatSun';
- RFC1123_StrMonth : string = 'JanFebMarAprMayJunJulAugSepOctNovDec';
- public
- class function GetHttpStatusText(const AStatusCode: Integer): string; static;
- class function GetFileMIMEType(const AFileName: string): string; static;
- class function RFC1123_DateToStr(const ADate: TDateTime): string; static; inline;
- class function RFC1123_StrToDate(const ADateStr: string): TDateTime; static;
-
- class function ExtractUrl(const AUrl: string; out AProtocol, AHost: string;
- out APort: Word; out APath: string): Boolean; static;
- class function CreateUrl(const AProtocol, AHost: string;
- const APort: Word; const APath: string): string; static;
-
- class function CombinePath(const APath1, APath2: string; const APathDelim: Char = '/'): string; static;
- class function IsSamePath(const APath1, APath2: string): Boolean; static;
-
- class function GetPathWithoutParams(const APath: string): string; static;
-
- ///
- /// 尝试解析本地路径，确保路径安全性
- ///
- ///
- /// 本地基础目录
- ///
- ///
- /// 要解析的相对路径
- ///
- ///
- /// 解析后的完整路径
- ///
- ///
- /// 如果路径有效且在基础目录内返回True，否则返回False
- ///
- ///
- /// 此函数会验证路径的安全性，防止路径遍历攻击
- ///
- class function TryUrlPathToLocalPath(const ALocalBaseDir, AUrlPath: string;
- out AResolvedPath: string): Boolean; static;
-
- class function HtmlEncode(const AInput: string): string; static;
- class function HtmlDecode(const AInput: string): string; static;
-
- ///
- /// URL percent-encoding (RFC 3986 §2.1)
- ///
- ///
- /// 待编码字符串(支持 unicode, 内部统一按 UTF-8 字节流处理)
- ///
- ///
- /// 附加的"无需编码"字符集. 默认仅按 RFC 3986 unreserved 集
- /// (ALPHA / DIGIT / "-" / "." / "_" / "~") 不编码, 其他字符全部 percent-encode.
- /// 调用方可据 URI 组件传入合理子集, 如 path 段内可保留 ['/', ':', '@'].
- ///
- ///
- /// 是否将输入按"已含 percent-encoded 序列的 URI 组件"对待 (Normalizer 语义).
- /// - False (默认, Encoder 语义): 输入视作原始数据, '%' 字符按字面编码为 '%25'.
- /// 适用于参数值/表单字段等"原始字节"场景. 与 RFC 3986 §2.1 Encoder 语义、
- /// 主流库 (Go QueryEscape / Python quote / Java URLEncoder) 默认行为一致.
- /// - True (Normalizer 语义): 遇到 '%' + 2 hex 数字时保留 3 字符不再编码,
- /// 避免二次编码 (RFC 3986 §2.4 "MUST NOT encode the same string more than once").
- /// 适用于"用户传入的 URL 片段可能已部分编码"场景, 类似 Python requote_uri.
- ///
- class function UrlEncode(const S: string; const ANoConversion: TSysCharSet = [];
- const APreserveEncoded: Boolean = False): string; static;
- class function UrlDecode(const S: string): string; static;
-
- // Delphi 12+ 编译器将NativeInt与Integer(目标32位)和Int64(目标64位)等同
- {$IF DEFINED(DELPHI) AND (CompilerVersion < 36)}
- class procedure AdjustOffsetCount(const ABodySize: NativeInt; var AOffset, ACount: NativeInt); overload; static;
- {$ENDIF}
- class procedure AdjustOffsetCount(const ABodySize: Integer; var AOffset, ACount: Integer); overload; static;
- class procedure AdjustOffsetCount(const ABodySize: Int64; var AOffset, ACount: Int64); overload; static;
-
- ///
- /// 严格解析 HTTP Range 请求头中的单一 byte-range (RFC 7233 §2.1, §3.1).
- ///
- ///
- /// 原始 Range 头, 如 "bytes=0-499" / "bytes=500-" / "bytes=-200".
- ///
- ///
- /// 资源完整长度, 必须 > 0.
- ///
- ///
- /// 解析成功时, 输出区间起点 (含, 0-based).
- ///
- ///
- /// 解析成功时, 输出区间终点 (含, 0-based, < AContentLength).
- ///
- ///
- /// True: 区间合法且可满足, AStart/AEnd 已正确设置.
- /// False: 缺前缀 / 多 range / 非法数字 / 不可满足 (start > end / start >= size /
- /// suffix=0). 调用方应返回 416 + "Content-Range: bytes */size".
- ///
- ///
- /// 不支持 multipart/byteranges (含 ',' 一律拒绝), 与 Nginx/Apache 在小文件上的常见策略一致.
- ///
- class function ParseSingleByteRange(const ARangeHeader: string;
- const AContentLength: Int64; out AStart, AEnd: Int64): Boolean; static;
-
- ///
- /// 校验 HTTP header field-value 是否安全, 不允许出现 CR/LF (RFC 7230 §3.2.4).
- ///
- ///
- /// 主要用于防御响应拆分 (HTTP Response Splitting) 攻击: 若业务把含 CR/LF 的用户输入
- /// 写入响应 header, 可能被攻击者注入伪造响应行或 header.
- ///
- class function IsValidHeaderValue(const AValue: string): Boolean; static;
-
- ///
- /// 校验 HTTP header field-name 是否符合 RFC 7230 token 字符集.
- ///
- class function IsValidHeaderName(const AName: string): Boolean; static;
-
- ///
- /// 单字符版本: 判断字符是否属于 RFC 7230 §3.2.6 token 字符集.
- ///
- ///
- /// token = ALPHA / DIGIT / "!" "#" "$" "%" "&" "'" "*" "+" "-" "." "^" "_" "`" "|" "~"
- /// 提供给逐字节扫描场景 (如 THttpHeader.Decode 单趟状态机) 复用规则, 避免重复定义.
- ///
- class function IsTokenChar(ACh: Char): Boolean; static; inline;
-
- ///
- /// 单字符版本: 判断字符是否是合法的 HTTP header field-value 字符.
- ///
- ///
- /// 合法: HTAB(#9) / 可见 ASCII ($20..$7E) / $80+ 高位字符 (历史宽松, 兼容 UTF-8).
- /// 非法: NUL/CR/LF 等其他 CTL ($00..$08, $0A..$1F) 与 DEL ($7F).
- /// 提供给逐字节扫描场景复用规则, 避免重复定义.
- ///
- class function IsHeaderValueChar(ACh: Char): Boolean; static; inline;
- end;
-
-implementation
-
-{ TCrossHttpUtils }
-
-class function TCrossHttpUtils.GetHttpStatusText(const AStatusCode: Integer): string;
-var
- LStatusItem: THttpStatus;
-begin
- for LStatusItem in STATUS_CODES do
- if (LStatusItem.Code = AStatusCode) then Exit(LStatusItem.Text);
- Result := AStatusCode.ToString;
-end;
-
-class function TCrossHttpUtils.GetPathWithoutParams(
- const APath: string): string;
-var
- LIndex: Integer;
-begin
- LIndex := APath.IndexOf('?');
- if (LIndex >= 0) then
- Result := APath.Substring(0, LIndex)
- else
- Result := APath;
-end;
-
-class function TCrossHttpUtils.HtmlDecode(const AInput: string): string;
-var
- LSp, LRp, LCp, LTp: PChar;
- LStr: string;
- I, LCode: Integer;
- LValid: Boolean;
-begin
- if (AInput = '') then Exit('');
-
- SetLength(Result, Length(AInput));
- LSp := PChar(AInput);
- LRp := PChar(Result);
- while LSp^ <> #0 do
- begin
- case LSp^ of
- '&':
- begin
- LCp := LSp;
- Inc(LSp);
- LValid := False;
- case LSp^ of
- 'a':
- if StrLComp(LSp, 'amp;', 4) = 0 then { do not localize }
- begin
- Inc(LSp, 3);
- LRp^ := '&';
- LValid := True;
- end
- else if StrLComp(LSp, 'apos;', 5) = 0 then { do not localize }
- begin
- Inc(LSp, 4);
- LRp^ := '''';
- LValid := True;
- end;
- 'l':
- if StrLComp(LSp, 'lt;', 3) = 0 then { do not localize }
- begin
- Inc(LSp, 2);
- LRp^ := '<';
- LValid := True;
- end;
- 'g':
- if StrLComp(LSp, 'gt;', 3) = 0 then { do not localize }
- begin
- Inc(LSp, 2);
- LRp^ := '>';
- LValid := True;
- end;
- 'q':
- if StrLComp(LSp, 'quot;', 5) = 0 then { do not localize }
- begin
- Inc(LSp, 4);
- LRp^ := '"';
- LValid := True;
- end;
- '#':
- begin
- LTp := LSp;
- Inc(LTp);
- while (LSp^ <> ';') and (LSp^ <> #0) do
- Inc(LSp);
- SetString(LStr, LTp, LSp - LTp);
- Val(LStr, I, LCode);
- if LCode = 0 then
- begin
- if I >= $10000 then
- begin
- // DoDecode surrogate pair
- LRp^ := Char(((I - $10000) div $400) + $D800);
- Inc(LRp);
- LRp^ := Char(((I - $10000) and $3FF) + $DC00);
- end
- else
- LRp^ := Chr((I));
- LValid := True;
- end
- else
- LSp := LTp - 1;
- end;
- end;
- if not LValid then
- begin
- LSp := LCp;
- LRp^ := LSp^;
- end;
- end
- else
- LRp^ := LSp^;
- end;
- Inc(LRp);
- Inc(LSp);
- end;
- SetLength(Result, LRp - PChar(Result));
-end;
-
-class function TCrossHttpUtils.HtmlEncode(const AInput: string): string;
-var
- LSp, LRp: PChar;
-begin
- if (AInput = '') then Exit('');
-
- SetLength(Result, Length(AInput) * 10);
- LSp := PChar(AInput);
- LRp := PChar(Result);
- // Convert: &, <, >, "
- while LSp^ <> #0 do
- begin
- case LSp^ of
- '&':
- begin
- StrMove(LRp, '&', 5);
- Inc(LRp, 5);
- end;
- '<':
- begin
- StrMove(LRp, '<', 4);
- Inc(LRp, 4);
- end;
- '>':
- begin
- StrMove(LRp, '>', 4);
- Inc(LRp, 4);
- end;
- '"':
- begin
- StrMove(LRp, '"', 6);
- Inc(LRp, 6);
- end;
- else
- begin
- LRp^ := LSp^;
- Inc(LRp);
- end;
- end;
- Inc(LSp);
- end;
- SetLength(Result, LRp - PChar(Result));
-end;
-
-class function TCrossHttpUtils.IsSamePath(const APath1,
- APath2: string): Boolean;
-begin
- if (Length(APath1) >= Length(APath2)) then
- Result := (Pos(APath2, APath1) = 1)
- else
- Result := (Pos(APath1, APath2) = 1);
-end;
-
-{$IF DEFINED(DELPHI) AND (CompilerVersion < 36)}
-class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: NativeInt;
- var AOffset, ACount: NativeInt);
-begin
- {$region '修正 AOffset'}
- // 偏移为正数, 从头部开始计算偏移
- if (AOffset >= 0) then
- begin
- AOffset := AOffset;
- if (AOffset >= ABodySize) then
- AOffset := ABodySize - 1;
- end else
- // 偏移为负数, 从尾部开始计算偏移
- begin
- AOffset := ABodySize + AOffset;
- if (AOffset < 0) then
- AOffset := 0;
- end;
- {$endregion}
-
- {$region '修正 ACount'}
- // ACount<=0表示需要处理所有数据
- if (ACount <= 0) then
- ACount := ABodySize;
-
- if (ABodySize - AOffset < ACount) then
- ACount := ABodySize - AOffset;
- {$endregion}
-end;
-{$ENDIF}
-
-class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: Integer;
- var AOffset, ACount: Integer);
-begin
- {$region '修正 AOffset'}
- // 偏移为正数, 从头部开始计算偏移
- if (AOffset >= 0) then
- begin
- AOffset := AOffset;
- if (AOffset >= ABodySize) then
- AOffset := ABodySize - 1;
- end else
- // 偏移为负数, 从尾部开始计算偏移
- begin
- AOffset := ABodySize + AOffset;
- if (AOffset < 0) then
- AOffset := 0;
- end;
- {$endregion}
-
- {$region '修正 ACount'}
- // ACount<=0表示需要处理所有数据
- if (ACount <= 0) then
- ACount := ABodySize;
-
- if (ABodySize - AOffset < ACount) then
- ACount := ABodySize - AOffset;
- {$endregion}
-end;
-
-class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: Int64;
- var AOffset, ACount: Int64);
-begin
- {$region '修正 AOffset'}
- // 偏移为正数, 从头部开始计算偏移
- if (AOffset >= 0) then
- begin
- AOffset := AOffset;
- if (AOffset >= ABodySize) then
- AOffset := ABodySize - 1;
- end else
- // 偏移为负数, 从尾部开始计算偏移
- begin
- AOffset := ABodySize + AOffset;
- if (AOffset < 0) then
- AOffset := 0;
- end;
- {$endregion}
-
- {$region '修正 ACount'}
- // ACount<=0表示需要处理所有数据
- if (ACount <= 0) then
- ACount := ABodySize;
-
- if (ABodySize - AOffset < ACount) then
- ACount := ABodySize - AOffset;
- {$endregion}
-end;
-
-class function TCrossHttpUtils.CombinePath(const APath1,
- APath2: string; const APathDelim: Char): string;
-begin
- Result := TPathUtils.Combine(APath1, APath2, APathDelim);
-end;
-
-class function TCrossHttpUtils.CreateUrl(const AProtocol, AHost: string;
- const APort: Word; const APath: string): string;
-var
- LPath: string;
-begin
- if (APath = '') then
- LPath := '/'
- else if (APath[1] = '/') then
- LPath := APath
- else
- LPath := '/' + APath;
-
- Result := Format('%s://%s', [AProtocol, AHost]);
-
- if (SameText(AProtocol, HTTP) and (APort = HTTP_DEFAULT_PORT))
- or (SameText(AProtocol, HTTPS) and (APort = HTTPS_DEFAULT_PORT)) then
- Result := Result + LPath
- else
- Result := Result + Format(':%d%s', [APort, LPath]);
-end;
-
-class function TCrossHttpUtils.ExtractUrl(const AUrl: string; out AProtocol,
- AHost: string; out APort: Word; out APath: string): Boolean;
-var
- LProtocolIndex, LIPv6Index, LPortIndex, LPathIndex, LQueryIndex, LPort: Integer;
- LPortStr: string;
-begin
- // http://www.test.com/abc
- // http://www.test.com:8080/abc
- // https://www.test.com/abc
- // https://www.test.com:8080/abc
- // www.test.com:8080/abc
- // www.test.com/abc
- // www.test.com
- // http://[aabb::20:80:5:2]:8080/abc
- // [aabb::20:80:5:2]
-
- Result := False;
-
- // 找 :// 定位协议类型
- LProtocolIndex := AUrl.IndexOf('://');
- if (LProtocolIndex >= 0) then
- begin
- // 提取协议类型
- AProtocol := AUrl.Substring(0, LProtocolIndex).Trim;
- Inc(LProtocolIndex, 3);
- end else
- begin
- // 默认协议 http
- AProtocol := HTTP;
- LProtocolIndex := 0;
- end;
-
- // 找 ] 定位IPv6地址
- LIPv6Index := AUrl.IndexOf(']', LProtocolIndex);
-
- if (LIPv6Index >= 0) then
- begin
- // 找 : 定位端口
- LPortIndex := AUrl.IndexOf(':', LIPv6Index + 1);
-
- // 找 / 定位路径
- LPathIndex := AUrl.IndexOf('/', LIPv6Index + 1);
-
- // 避免在参数部分出现 : 被当成端口定位
- if (LPathIndex >= 0) and (LPortIndex > LPathIndex) then
- LPortIndex := -1;
-
- // 找 ? 定位参数
- LQueryIndex := AUrl.IndexOf('?', LIPv6Index + 1);
- end else
- begin
- // 找 : 定位端口
- LPortIndex := AUrl.IndexOf(':', LProtocolIndex);
-
- // 找 / 定位路径
- LPathIndex := AUrl.IndexOf('/', LProtocolIndex);
-
- // 避免在参数部分出现 : 被当成端口定位
- if (LPathIndex >= 0) and (LPortIndex > LPathIndex) then
- LPortIndex := -1;
-
- // 找 ? 定位参数
- LQueryIndex := AUrl.IndexOf('?', LProtocolIndex);
- end;
-
- if (LPathIndex < 0) then
- begin
- if (LQueryIndex >= 0) then
- LPathIndex := LQueryIndex
- else
- LPathIndex := Length(AUrl);
- end;
-
- if (LPortIndex >= 0) then
- begin
- // 提取主机地址
- AHost := AUrl.Substring(LProtocolIndex, LPortIndex - LProtocolIndex);
-
- // 提取主机端口
- LPortStr := AUrl.Substring(LPortIndex + 1, LPathIndex - LPortIndex - 1);
- if not TryStrToInt(LPortStr, LPort) then Exit;
-
- APort := LPort;
- end else
- begin
- // 提取主机地址
- AHost := AUrl.Substring(LProtocolIndex, LPathIndex - LProtocolIndex);
-
- // 根据协议类型决定默认端口
- if TStrUtils.SameText(AProtocol, HTTPS)
- or TStrUtils.SameText(AProtocol, WSS) then
- APort := HTTPS_DEFAULT_PORT
- else
- APort := HTTP_DEFAULT_PORT;
- end;
-
- // 提取路径
- APath := AUrl.Substring(LPathIndex, MaxInt);
- if (APath = '') then
- APath := '/'
- else if (APath[1] <> '/') then
- APath := '/' + APath;
-
- Result := (AHost <> '');
-end;
-
-class function TCrossHttpUtils.GetFileMIMEType(const AFileName: string): string;
-var
- LExt: string;
- LMimeItem: TMimeValue;
-begin
- LExt := ExtractFileExt(AFileName).Substring(1);
- for LMimeItem in MIME_TYPES do
- if TStrUtils.SameText(LMimeItem.Key, LExt) then
- Exit(LMimeItem.Value);
- Result := TMediaType.APPLICATION_OCTET_STREAM;
-end;
-
-class function TCrossHttpUtils.RFC1123_DateToStr(const ADate: TDateTime): string;
-begin
- // Fri, 30 Jul 2024 10:10:35 GMT
- Result := ADate.ToRFC1123(True);
-end;
-
-class function TCrossHttpUtils.RFC1123_StrToDate(const ADateStr: string) : TDateTime;
-var
- LYear, LMonth, LDay: Word;
- LHour, LMin, LSec: Word;
-begin
- // Fri, 30 Jul 2024 10:10:35 GMT
- if (Length(ADateStr) = 29) then
- begin
- LDay := StrToIntDef(Copy(ADateStr, 6, 2), 0);
- LMonth := (Pos(Copy(ADateStr, 9, 3), RFC1123_StrMonth) + 2) div 3;
- LYear := StrToIntDef(Copy(ADateStr, 13, 4), 0);
- LHour := StrToIntDef(Copy(ADateStr, 18, 2), 0);
- LMin := StrToIntDef(Copy(ADateStr, 21, 2), 0);
- LSec := StrToIntDef(Copy(ADateStr, 24, 2), 0);
- end else
- // Fri, 30 Jul 24 10:10:35 GMT
- // Fri, 30-Jul-24 10:10:35 GMT
- if (Length(ADateStr) = 27) then
- begin
- LDay := StrToIntDef(Copy(ADateStr, 6, 2), 0);
- LMonth := (Pos(Copy(ADateStr, 9, 3), RFC1123_StrMonth) + 2) div 3;
- LYear := 2000 + StrToIntDef(Copy(ADateStr, 13, 2), 0);
- LHour := StrToIntDef(Copy(ADateStr, 16, 2), 0);
- LMin := StrToIntDef(Copy(ADateStr, 19, 2), 0);
- LSec := StrToIntDef(Copy(ADateStr, 22, 2), 0);
- end else
- Exit(0);
-
- if not TryEncodeDateTime(LYear, LMonth, LDay, LHour, LMin, LSec, 0, Result) then
- Result := 0;
-end;
-
-class function TCrossHttpUtils.TryUrlPathToLocalPath(const ALocalBaseDir,
- AUrlPath: string; out AResolvedPath: string): Boolean;
-begin
- Result := TPathUtils.TryResolveLocalPath(
- ALocalBaseDir,
- TCrossHttpUtils.GetPathWithoutParams(AUrlPath).Trim,
- AResolvedPath);
-end;
-
-class function TCrossHttpUtils.UrlDecode(const S: string): string;
-var
- LSrcBytes, LDstBytes: TBytes;
- LSrcLen, LSrcIdx, LDstIdx: Integer;
- H, L: Byte;
- C: Byte;
-begin
- if (S = '') then Exit('');
-
- // 先把输入 unicode 字符串 UTF-8 编码为字节流, 与 UrlEncode 对称.
- // 这样允许输入混合: ASCII percent-encoded ('%E4%B8%AD') 与 unicode 原字符 ('中') 都能正确处理.
- LSrcBytes := TEncoding.UTF8.GetBytes(S);
- LSrcLen := Length(LSrcBytes);
- SetLength(LDstBytes, LSrcLen);
-
- LSrcIdx := 0;
- LDstIdx := 0;
- while (LSrcIdx < LSrcLen) do
- begin
- C := LSrcBytes[LSrcIdx];
- case C of
- // 兼容早期 form-urlencoded: '+' → 空格
- Ord('+'):
- begin
- LDstBytes[LDstIdx] := Ord(' ');
- Inc(LSrcIdx);
- end;
-
- Ord('%'):
- begin
- if (LSrcIdx + 2 < LSrcLen)
- and TUtils.HexCharToByte(Char(LSrcBytes[LSrcIdx + 1]), H)
- and TUtils.HexCharToByte(Char(LSrcBytes[LSrcIdx + 2]), L) then
- begin
- LDstBytes[LDstIdx] := L + (H shl 4);
- Inc(LSrcIdx, 3);
- end else
- begin
- // 非法 %xx, 原样保留 '%' 字符
- LDstBytes[LDstIdx] := Ord('%');
- Inc(LSrcIdx);
- end;
- end;
- else
- // 包含 ASCII 与 UTF-8 多字节序列的高字节, 都原样透传
- LDstBytes[LDstIdx] := C;
- Inc(LSrcIdx);
- end;
-
- Inc(LDstIdx);
- end;
- SetLength(LDstBytes, LDstIdx);
-
- Result := TEncoding.UTF8.GetString(LDstBytes);
-end;
-
-class function TCrossHttpUtils.UrlEncode(const S: string; const ANoConversion: TSysCharSet;
- const APreserveEncoded: Boolean): string;
-const
- HEX_CHARS: array[0..15] of Char = (
- '0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
-
- function _IsHexByte(const AByte: Byte): Boolean; inline;
- begin
- case AByte of
- Ord('0')..Ord('9'),
- Ord('a')..Ord('f'),
- Ord('A')..Ord('F'):
- Result := True;
- else
- Result := False;
- end;
- end;
-
-var
- LUTF8Bytes: TBytes;
- LLen, I: Integer;
- C: Byte;
- P: PChar;
-begin
- if (S = '') then Exit('');
-
- // 先将 unicode 字符串编码为 utf8 字节数组
- LUTF8Bytes := TEncoding.UTF8.GetBytes(S);
- LLen := Length(LUTF8Bytes);
-
- // 预分配编码字符串, 比一直累加效率高很多
- // 预分配尺寸为 utf8 字节数组长度的 3 倍
- // 之所以预分配 3 倍, 是因为每个 utf8 字节最长可能被编码为 %xy 这样的字符串
- SetLength(Result, LLen * 3);
- P := PChar(Result);
-
- I := 0;
- while (I < LLen) do
- begin
- C := LUTF8Bytes[I];
- case C of
- // https://datatracker.ietf.org/doc/html/rfc3986
- // RFC 3986 中明确定义了未保留字(无需编码)包含以下这些
- // 字母数字：大小写英文字母(A-Z, a-z)和数字(0-9)。
- // 特殊字符：连字符(-)，下划线(_)，点号(.)，和波浪号(~)。
- Ord('0')..Ord('9'),
- Ord('a')..Ord('z'),
- Ord('A')..Ord('Z'),
- Ord('-'), Ord('_'), Ord('.'), Ord('~'):
- begin
- P^ := Char(C);
- Inc(P);
- end;
- else
- // RFC 3986 §2.4: 已 percent-encoded 的 %xx 序列不应被二次编码.
- // APreserveEncoded=True 时, 遇到 % 后跟 2 个 hex 数字, 原样保留 3 字符.
- if APreserveEncoded and (C = Ord('%')) and (I + 2 < LLen)
- and _IsHexByte(LUTF8Bytes[I + 1])
- and _IsHexByte(LUTF8Bytes[I + 2]) then
- begin
- P^ := '%';
- Inc(P);
- P^ := Char(LUTF8Bytes[I + 1]);
- Inc(P);
- P^ := Char(LUTF8Bytes[I + 2]);
- Inc(P);
- Inc(I, 2); // 跳过两个 hex 字节, 循环底部还会 Inc(I) 一次
- end else
- if CharInSet(Char(C), ANoConversion) then
- begin
- P^ := Char(C);
- Inc(P);
- end else
- begin
- P^ := '%';
- Inc(P);
-
- P^ := HEX_CHARS[C shr 4];
- Inc(P);
-
- P^ := HEX_CHARS[C and $F];
- Inc(P);
- end;
- end;
- Inc(I);
- end;
-
- // 修正编码字符串的实际长度
- SetLength(Result, P - PChar(Result));
-end;
-
-class function TCrossHttpUtils.ParseSingleByteRange(const ARangeHeader: string;
- const AContentLength: Int64; out AStart, AEnd: Int64): Boolean;
-const
- PREFIX = 'bytes=';
-
- function _IsAsciiDigits(const S: string): Boolean;
- var
- I: Integer;
- begin
- if (S = '') then Exit(False);
- for I := 1 to Length(S) do
- case S[I] of
- '0'..'9': ;
- else
- Exit(False);
- end;
- Result := True;
- end;
-
-var
- LSpec, LStartStr, LEndStr: string;
- LDashPos: Integer;
- LStartVal, LEndVal: Int64;
- LHasStart, LHasEnd: Boolean;
-begin
- AStart := 0;
- AEnd := 0;
- Result := False;
-
- // 资源长度必须 > 0
- if (AContentLength <= 0) then Exit;
-
- // 必须以 'bytes=' 前缀开头 (RFC 7233 §3.1, 大小写不敏感)
- if (Length(ARangeHeader) <= Length(PREFIX))
- or not ARangeHeader.StartsWith(PREFIX, True) then Exit;
-
- LSpec := Copy(ARangeHeader, Length(PREFIX) + 1, MaxInt).Trim;
- if (LSpec = '') then Exit;
-
- // 不支持 multipart/byteranges (含 ',' 一律拒绝)
- if (LSpec.IndexOf(',') >= 0) then Exit;
-
- // 必须存在且仅有一个 '-'
- LDashPos := LSpec.IndexOf('-');
- if (LDashPos < 0) then Exit;
- if (LSpec.LastIndexOf('-') <> LDashPos) then Exit;
-
- // 不对子串再 Trim, 避免 'bytes=0 - 100' 内嵌空格被静默吞掉.
- // RFC 7230 ABNF 不允许 byte-range-spec 内含 OWS/BWS.
- LStartStr := LSpec.Substring(0, LDashPos);
- LEndStr := LSpec.Substring(LDashPos + 1);
-
- LHasStart := (LStartStr <> '');
- LHasEnd := (LEndStr <> '');
-
- // 至少要有一个端点; 'bytes=-' 是非法的
- if (not LHasStart) and (not LHasEnd) then Exit;
-
- // 解析 start (必须为纯 ASCII 十进制数字)
- if LHasStart then
- begin
- if not _IsAsciiDigits(LStartStr) then Exit;
- if not TryStrToInt64(LStartStr, LStartVal) then Exit;
- if (LStartVal < 0) then Exit;
- end else
- LStartVal := 0;
-
- // 解析 end (必须为纯 ASCII 十进制数字)
- if LHasEnd then
- begin
- if not _IsAsciiDigits(LEndStr) then Exit;
- if not TryStrToInt64(LEndStr, LEndVal) then Exit;
- if (LEndVal < 0) then Exit;
- end else
- LEndVal := 0;
-
- if LHasStart and LHasEnd then
- begin
- // bytes=start-end: 要求 0 <= start <= end < size
- if (LStartVal > LEndVal) then Exit;
- if (LStartVal >= AContentLength) then Exit;
- // end 超出文件大小时按 RFC 7233 §2.1 截断到 size-1
- if (LEndVal >= AContentLength) then
- LEndVal := AContentLength - 1;
- AStart := LStartVal;
- AEnd := LEndVal;
- end else
- if LHasStart then
- begin
- // bytes=start-: 从 start 取到末尾
- if (LStartVal >= AContentLength) then Exit;
- AStart := LStartVal;
- AEnd := AContentLength - 1;
- end else
- begin
- // bytes=-suffix: 取末尾 suffix 字节; suffix 必须 > 0
- if (LEndVal = 0) then Exit;
- if (LEndVal >= AContentLength) then
- AStart := 0
- else
- AStart := AContentLength - LEndVal;
- AEnd := AContentLength - 1;
- end;
-
- Result := True;
-end;
-
-class function TCrossHttpUtils.IsTokenChar(ACh: Char): Boolean;
-begin
- // RFC 7230 §3.2.6 token: ALPHA / DIGIT / "!" "#" "$" "%" "&" "'" "*" "+"
- // "-" "." "^" "_" "`" "|" "~"
- case ACh of
- 'A'..'Z', 'a'..'z', '0'..'9',
- '!', '#', '$', '%', '&', '''', '*', '+', '-', '.', '^', '_', '`', '|', '~':
- Result := True;
- else
- Result := False;
- end;
-end;
-
-class function TCrossHttpUtils.IsHeaderValueChar(ACh: Char): Boolean;
-begin
- // RFC 7230 §3.2.4 field-value:
- // 合法: HTAB(#9) / 可见 ASCII (#32..#126) / #128+ 高位字符 (历史宽松, 兼容 UTF-8).
- // 非法: 其他 CTL (#0..#8, #10..#31) 与 DEL (#127), CR/LF/NUL 是响应拆分主要载体.
- case Ord(ACh) of
- 9, 32..126, 128..$FFFF:
- Result := True;
- else
- Result := False;
- end;
-end;
-
-class function TCrossHttpUtils.IsValidHeaderName(const AName: string): Boolean;
-var
- I: Integer;
-begin
- if (AName = '') then Exit(False);
- for I := 1 to Length(AName) do
- if not IsTokenChar(AName[I]) then Exit(False);
- Result := True;
-end;
-
-class function TCrossHttpUtils.IsValidHeaderValue(const AValue: string): Boolean;
-var
- I: Integer;
-begin
- for I := 1 to Length(AValue) do
- if not IsHeaderValueChar(AValue[I]) then Exit(False);
- Result := True;
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossHttpUtils;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ SysUtils,
+ DateUtils,
+
+ Utils.DateTime,
+ Utils.StrUtils,
+ Utils.Utils,
+ Utils.IOUtils;
+
+type
+ THttpStatus = record
+ Code: Integer;
+ Text: string;
+ end;
+
+ TMimeValue = record
+ Key: string;
+ Value: string;
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// HTTP版本信息
+ ///
+ {$ENDREGION}
+ THttpVersion = (hvHttp10, hvHttp11);
+
+ {$REGION 'Documentation'}
+ ///
+ /// 压缩类型
+ ///
+ {$ENDREGION}
+ TCompressType = (ctNone, ctGZip, ctDeflate);
+
+const
+ HTTP = 'http';
+ HTTPS = 'https';
+ HTTP_DEFAULT_PORT = 80;
+ HTTPS_DEFAULT_PORT = 443;
+ WS = 'ws';
+ WSS = 'wss';
+ WEBSOCKET = 'websocket';
+ WEBSOCKET_VERSION = '13';
+
+ HTTP_VER_STR: array [THttpVersion] of string = ('HTTP/1.0', 'HTTP/1.1');
+
+ {$REGION '常用 HTTP 头'}
+ HEADER_ACCEPT = 'Accept';
+ HEADER_ACCEPT_CHARSET = 'Accept-Charset';
+ HEADER_ACCEPT_ENCODING = 'Accept-Encoding';
+ HEADER_ACCEPT_LANGUAGE = 'Accept-Language';
+ HEADER_ACCEPT_RANGES = 'Accept-Ranges';
+ HEADER_AUTHORIZATION = 'Authorization';
+ HEADER_CACHE_CONTROL = 'Cache-Control';
+ HEADER_CONNECTION = 'Connection';
+ HEADER_CONTENT_DISPOSITION = 'Content-Disposition';
+ HEADER_CONTENT_ENCODING = 'Content-Encoding';
+ HEADER_CONTENT_LANGUAGE = 'Content-Language';
+ HEADER_CONTENT_LENGTH = 'Content-Length';
+ HEADER_CONTENT_RANGE = 'Content-Range';
+ HEADER_CONTENT_TYPE = 'Content-Type';
+ HEADER_COOKIE = 'Cookie';
+ HEADER_CROSS_HTTP_CLIENT = 'Client';
+ HEADER_CROSS_HTTP_SERVER = 'Server';
+ HEADER_ETAG = 'ETag';
+ HEADER_EXPECT = 'Expect';
+ HEADER_HOST = 'Host';
+ HEADER_IF_MODIFIED_SINCE = 'If-Modified-Since';
+ HEADER_IF_NONE_MATCH = 'If-None-Match';
+ HEADER_IF_RANGE = 'If-Range';
+ HEADER_LAST_MODIFIED = 'Last-Modified';
+ HEADER_LOCATION = 'Location';
+ HEADER_PRAGMA = 'Pragma';
+ HEADER_PROXY_AUTHENTICATE = 'Proxy-Authenticate';
+ HEADER_PROXY_AUTHORIZATION = 'Proxy-Authorization';
+ HEADER_RANGE = 'Range';
+ HEADER_REFERER = 'Referer';
+ HEADER_SEC_WEBSOCKET_ACCEPT = 'Sec-WebSocket-Accept';
+ HEADER_SEC_WEBSOCKET_KEY = 'Sec-WebSocket-Key';
+ HEADER_SEC_WEBSOCKET_VERSION = 'Sec-WebSocket-Version';
+ HEADER_SETCOOKIE = 'Set-Cookie';
+ HEADER_TRANSFER_ENCODING = 'Transfer-Encoding';
+ HEADER_UPGRADE = 'Upgrade';
+ HEADER_USER_AGENT = 'User-Agent';
+ HEADER_VARY = 'Vary';
+ HEADER_WWW_AUTHENTICATE = 'WWW-Authenticate';
+ HEADER_X_METHOD_OVERRIDE = 'x-method-override';
+ HEADER_X_FORWARDED_FOR = 'X-Forwarded-For';
+ HEADER_X_REAL_IP = 'X-Real-IP';
+ HEADER_X_FORWARDED_HOST = 'X-Forwarded-Host';
+ HEADER_X_FORWARDED_SERVER = 'X-Forwarded-Server';
+ {$ENDREGION}
+
+ ZLIB_BUF_SIZE = 32768;
+ ZLIB_WINDOW_BITS: array [TCompressType] of Integer = (0, 15 + 16{gzip}, 15{deflate});
+ ZLIB_CONTENT_ENCODING: array [TCompressType] of string = ('', 'gzip', 'deflate');
+
+ {$REGION '常用状态码'}
+ STATUS_CODES: array [0..56] of THttpStatus = (
+ (Code: 100; Text: 'Continue'),
+ (Code: 101; Text: 'Switching Protocols'),
+ (Code: 102; Text: 'Processing'), // RFC 2518, obsoleted by RFC 4918
+ (Code: 200; Text: 'OK'),
+ (Code: 201; Text: 'Created'),
+ (Code: 202; Text: 'Accepted'),
+ (Code: 203; Text: 'Non-Authoritative Information'),
+ (Code: 204; Text: 'No Content'),
+ (Code: 205; Text: 'Reset Content'),
+ (Code: 206; Text: 'Partial Content'),
+ (Code: 207; Text: 'Multi-Status'), // RFC 4918
+ (Code: 300; Text: 'Multiple Choices'),
+ (Code: 301; Text: 'Moved Permanently'),
+ (Code: 302; Text: 'Moved Temporarily'),
+ (Code: 303; Text: 'See Other'),
+ (Code: 304; Text: 'Not Modified'),
+ (Code: 305; Text: 'Use Proxy'),
+ (Code: 307; Text: 'Temporary Redirect'),
+ (Code: 308; Text: 'Permanent Redirect'), // RFC 7238
+ (Code: 400; Text: 'Bad Request'),
+ (Code: 401; Text: 'Unauthorized'),
+ (Code: 402; Text: 'Payment Required'),
+ (Code: 403; Text: 'Forbidden'),
+ (Code: 404; Text: 'Not Found'),
+ (Code: 405; Text: 'Method Not Allowed'),
+ (Code: 406; Text: 'Not Acceptable'),
+ (Code: 407; Text: 'Proxy Authentication Required'),
+ (Code: 408; Text: 'Request Timeout'),
+ (Code: 409; Text: 'Conflict'),
+ (Code: 410; Text: 'Gone'),
+ (Code: 411; Text: 'Length Required'),
+ (Code: 412; Text: 'Precondition Failed'),
+ (Code: 413; Text: 'Request Entity Too Large'),
+ (Code: 414; Text: 'Request URI Too Large'),
+ (Code: 415; Text: 'Unsupported Media Type'),
+ (Code: 416; Text: 'Requested Range Not Satisfiable'),
+ (Code: 417; Text: 'Expectation Failed'),
+ (Code: 418; Text: 'I''m a teapot'), // RFC 2324
+ (Code: 422; Text: 'Unprocessable Entity'), // RFC 4918
+ (Code: 423; Text: 'Locked'), // RFC 4918
+ (Code: 424; Text: 'Failed Dependency'), // RFC 4918
+ (Code: 425; Text: 'Unordered Collection'), // RFC 4918
+ (Code: 426; Text: 'Upgrade Required'), // RFC 2817
+ (Code: 428; Text: 'Precondition Required'), // RFC 6585
+ (Code: 429; Text: 'Too Many Requests'), // RFC 6585
+ (Code: 431; Text: 'Request Header Fields Too Large'), // RFC 6585
+ (Code: 500; Text: 'Internal Server Error'),
+ (Code: 501; Text: 'Not Implemented'),
+ (Code: 502; Text: 'Bad Gateway'),
+ (Code: 503; Text: 'Service Unavailable'),
+ (Code: 504; Text: 'Gateway Timeout'),
+ (Code: 505; Text: 'HTTP Version Not Supported'),
+ (Code: 506; Text: 'Variant Also Negotiates'), // RFC 2295
+ (Code: 507; Text: 'Insufficient Storage'), // RFC 4918
+ (Code: 509; Text: 'Bandwidth Limit Exceeded'),
+ (Code: 510; Text: 'Not Extended'), // RFC 2774
+ (Code: 511; Text: 'Network Authentication Required') // RFC 6585
+ );
+ {$ENDREGION}
+
+ {$REGION 'MIME CONST'}
+ MIME_TYPES: array[0..988] of TMimeValue = (
+ (Key: 'ez'; Value: 'application/andrew-inset'), // do not localize
+ (Key: 'aw'; Value: 'application/applixware'), // do not localize
+ (Key: 'atom'; Value: 'application/atom+xml'), // do not localize
+ (Key: 'atomcat'; Value: 'application/atomcat+xml'), // do not localize
+ (Key: 'atomsvc'; Value: 'application/atomsvc+xml'), // do not localize
+ (Key: 'ccxml'; Value: 'application/ccxml+xml'), // do not localize
+ (Key: 'cdmia'; Value: 'application/cdmi-capability'), // do not localize
+ (Key: 'cdmic'; Value: 'application/cdmi-container'), // do not localize
+ (Key: 'cdmid'; Value: 'application/cdmi-domain'), // do not localize
+ (Key: 'cdmio'; Value: 'application/cdmi-object'), // do not localize
+ (Key: 'cdmiq'; Value: 'application/cdmi-queue'), // do not localize
+ (Key: 'cu'; Value: 'application/cu-seeme'), // do not localize
+ (Key: 'davmount'; Value: 'application/davmount+xml'), // do not localize
+ (Key: 'dbk'; Value: 'application/docbook+xml'), // do not localize
+ (Key: 'dssc'; Value: 'application/dssc+der'), // do not localize
+ (Key: 'xdssc'; Value: 'application/dssc+xml'), // do not localize
+ (Key: 'ecma'; Value: 'application/ecmascript'), // do not localize
+ (Key: 'emma'; Value: 'application/emma+xml'), // do not localize
+ (Key: 'epub'; Value: 'application/epub+zip'), // do not localize
+ (Key: 'exi'; Value: 'application/exi'), // do not localize
+ (Key: 'pfr'; Value: 'application/font-tdpfr'), // do not localize
+ (Key: 'gml'; Value: 'application/gml+xml'), // do not localize
+ (Key: 'gpx'; Value: 'application/gpx+xml'), // do not localize
+ (Key: 'gxf'; Value: 'application/gxf'), // do not localize
+ (Key: 'stk'; Value: 'application/hyperstudio'), // do not localize
+ (Key: 'ink'; Value: 'application/inkml+xml'), // do not localize
+ (Key: 'inkml'; Value: 'application/inkml+xml'), // do not localize
+ (Key: 'ipfix'; Value: 'application/ipfix'), // do not localize
+ (Key: 'jar'; Value: 'application/java-archive'), // do not localize
+ (Key: 'ser'; Value: 'application/java-serialized-object'), // do not localize
+ (Key: 'class'; Value: 'application/java-vm'), // do not localize
+ (Key: 'js'; Value: 'application/javascript'), // do not localize
+ (Key: 'json'; Value: 'application/json'), // do not localize
+ (Key: 'jsonml'; Value: 'application/jsonml+json'), // do not localize
+ (Key: 'lostxml'; Value: 'application/lost+xml'), // do not localize
+ (Key: 'hqx'; Value: 'application/mac-binhex40'), // do not localize
+ (Key: 'cpt'; Value: 'application/mac-compactpro'), // do not localize
+ (Key: 'mads'; Value: 'application/mads+xml'), // do not localize
+ (Key: 'mrc'; Value: 'application/marc'), // do not localize
+ (Key: 'mrcx'; Value: 'application/marcxml+xml'), // do not localize
+ (Key: 'ma'; Value: 'application/mathematica'), // do not localize
+ (Key: 'nb'; Value: 'application/mathematica'), // do not localize
+ (Key: 'mb'; Value: 'application/mathematica'), // do not localize
+ (Key: 'mathml'; Value: 'application/mathml+xml'), // do not localize
+ (Key: 'mbox'; Value: 'application/mbox'), // do not localize
+ (Key: 'mscml'; Value: 'application/mediaservercontrol+xml'), // do not localize
+ (Key: 'metalink'; Value: 'application/metalink+xml'), // do not localize
+ (Key: 'meta4'; Value: 'application/metalink4+xml'), // do not localize
+ (Key: 'mets'; Value: 'application/mets+xml'), // do not localize
+ (Key: 'mods'; Value: 'application/mods+xml'), // do not localize
+ (Key: 'm21'; Value: 'application/mp21'), // do not localize
+ (Key: 'mp21'; Value: 'application/mp21'), // do not localize
+ (Key: 'mp4s'; Value: 'application/mp4'), // do not localize
+ (Key: 'doc'; Value: 'application/msword'), // do not localize
+ (Key: 'dot'; Value: 'application/msword'), // do not localize
+ (Key: 'mxf'; Value: 'application/mxf'), // do not localize
+ (Key: 'bin'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'bpk'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'class'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'deploy'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'dist'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'distz'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'dmg'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'dms'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'dump'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'elc'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'iso'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'lha'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'lrf'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'lzh'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'mar'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'pkg'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'so'; Value: 'application/octet-stream'), // do not localize
+ (Key: 'oda'; Value: 'application/oda'), // do not localize
+ (Key: 'opf'; Value: 'application/oebps-package+xml'), // do not localize
+ (Key: 'ogx'; Value: 'application/ogg'), // do not localize
+ (Key: 'omdoc'; Value: 'application/omdoc+xml'), // do not localize
+ (Key: 'onetoc'; Value: 'application/onenote'), // do not localize
+ (Key: 'onetoc2'; Value: 'application/onenote'), // do not localize
+ (Key: 'onetmp'; Value: 'application/onenote'), // do not localize
+ (Key: 'onepkg'; Value: 'application/onenote'), // do not localize
+ (Key: 'oxps'; Value: 'application/oxps'), // do not localize
+ (Key: 'xer'; Value: 'application/patch-ops-error+xml'), // do not localize
+ (Key: 'pdf'; Value: 'application/pdf'), // do not localize
+ (Key: 'pgp'; Value: 'application/pgp-encrypted'), // do not localize
+ (Key: 'asc'; Value: 'application/pgp-signature'), // do not localize
+ (Key: 'sig'; Value: 'application/pgp-signature'), // do not localize
+ (Key: 'prf'; Value: 'application/pics-rules'), // do not localize
+ (Key: 'p10'; Value: 'application/pkcs10'), // do not localize
+ (Key: 'p7m'; Value: 'application/pkcs7-mime'), // do not localize
+ (Key: 'p7c'; Value: 'application/pkcs7-mime'), // do not localize
+ (Key: 'p7s'; Value: 'application/pkcs7-signature'), // do not localize
+ (Key: 'p8'; Value: 'application/pkcs8'), // do not localize
+ (Key: 'ac'; Value: 'application/pkix-attr-cert'), // do not localize
+ (Key: 'cer'; Value: 'application/pkix-cert'), // do not localize
+ (Key: 'crl'; Value: 'application/pkix-crl'), // do not localize
+ (Key: 'pkipath'; Value: 'application/pkix-pkipath'), // do not localize
+ (Key: 'pki'; Value: 'application/pkixcmp'), // do not localize
+ (Key: 'pls'; Value: 'application/pls+xml'), // do not localize
+ (Key: 'ai'; Value: 'application/postscript'), // do not localize
+ (Key: 'eps'; Value: 'application/postscript'), // do not localize
+ (Key: 'ps'; Value: 'application/postscript'), // do not localize
+ (Key: 'cww'; Value: 'application/prs.cww'), // do not localize
+ (Key: 'pskcxml'; Value: 'application/pskc+xml'), // do not localize
+ (Key: 'rdf'; Value: 'application/rdf+xml'), // do not localize
+ (Key: 'rif'; Value: 'application/reginfo+xml'), // do not localize
+ (Key: 'rnc'; Value: 'application/relax-ng-compact-syntax'), // do not localize
+ (Key: 'rl'; Value: 'application/resource-lists+xml'), // do not localize
+ (Key: 'rld'; Value: 'application/resource-lists-diff+xml'), // do not localize
+ (Key: 'rs'; Value: 'application/rls-services+xml'), // do not localize
+ (Key: 'gbr'; Value: 'application/rpki-ghostbusters'), // do not localize
+ (Key: 'mft'; Value: 'application/rpki-manifest'), // do not localize
+ (Key: 'roa'; Value: 'application/rpki-roa'), // do not localize
+ (Key: 'rsd'; Value: 'application/rsd+xml'), // do not localize
+ (Key: 'rss'; Value: 'application/rss+xml'), // do not localize
+ (Key: 'rtf'; Value: 'application/rtf'), // do not localize
+ (Key: 'sbml'; Value: 'application/sbml+xml'), // do not localize
+ (Key: 'scq'; Value: 'application/scvp-cv-request'), // do not localize
+ (Key: 'scs'; Value: 'application/scvp-cv-response'), // do not localize
+ (Key: 'spq'; Value: 'application/scvp-vp-request'), // do not localize
+ (Key: 'spp'; Value: 'application/scvp-vp-response'), // do not localize
+ (Key: 'sdp'; Value: 'application/sdp'), // do not localize
+ (Key: 'setpay'; Value: 'application/set-payment-initiation'), // do not localize
+ (Key: 'setreg'; Value: 'application/set-registration-initiation'), // do not localize
+ (Key: 'shf'; Value: 'application/shf+xml'), // do not localize
+ (Key: 'smi'; Value: 'application/smil+xml'), // do not localize
+ (Key: 'smil'; Value: 'application/smil+xml'), // do not localize
+ (Key: 'rq'; Value: 'application/sparql-query'), // do not localize
+ (Key: 'srx'; Value: 'application/sparql-results+xml'), // do not localize
+ (Key: 'gram'; Value: 'application/srgs'), // do not localize
+ (Key: 'grxml'; Value: 'application/srgs+xml'), // do not localize
+ (Key: 'sru'; Value: 'application/sru+xml'), // do not localize
+ (Key: 'ssdl'; Value: 'application/ssdl+xml'), // do not localize
+ (Key: 'ssml'; Value: 'application/ssml+xml'), // do not localize
+ (Key: 'tei'; Value: 'application/tei+xml'), // do not localize
+ (Key: 'teicorpus'; Value: 'application/tei+xml'), // do not localize
+ (Key: 'tfi'; Value: 'application/thraud+xml'), // do not localize
+ (Key: 'tsd'; Value: 'application/timestamped-data'), // do not localize
+ (Key: 'plb'; Value: 'application/vnd.3gpp.pic-bw-large'), // do not localize
+ (Key: 'psb'; Value: 'application/vnd.3gpp.pic-bw-small'), // do not localize
+ (Key: 'pvb'; Value: 'application/vnd.3gpp.pic-bw-var'), // do not localize
+ (Key: 'tcap'; Value: 'application/vnd.3gpp2.tcap'), // do not localize
+ (Key: 'pwn'; Value: 'application/vnd.3m.post-it-notes'), // do not localize
+ (Key: 'aso'; Value: 'application/vnd.accpac.simply.aso'), // do not localize
+ (Key: 'imp'; Value: 'application/vnd.accpac.simply.imp'), // do not localize
+ (Key: 'acu'; Value: 'application/vnd.acucobol'), // do not localize
+ (Key: 'atc'; Value: 'application/vnd.acucorp'), // do not localize
+ (Key: 'acutc'; Value: 'application/vnd.acucorp'), // do not localize
+ (Key: 'air'; Value: 'application/vnd.adobe.air-application-installer-package+zip'), // do not localize
+ (Key: 'fcdt'; Value: 'application/vnd.adobe.formscentral.fcdt'), // do not localize
+ (Key: 'fxp'; Value: 'application/vnd.adobe.fxp'), // do not localize
+ (Key: 'fxpl'; Value: 'application/vnd.adobe.fxp'), // do not localize
+ (Key: 'xdp'; Value: 'application/vnd.adobe.xdp+xml'), // do not localize
+ (Key: 'xfdf'; Value: 'application/vnd.adobe.xfdf'), // do not localize
+ (Key: 'ahead'; Value: 'application/vnd.ahead.space'), // do not localize
+ (Key: 'azf'; Value: 'application/vnd.airzip.filesecure.azf'), // do not localize
+ (Key: 'azs'; Value: 'application/vnd.airzip.filesecure.azs'), // do not localize
+ (Key: 'azw'; Value: 'application/vnd.amazon.ebook'), // do not localize
+ (Key: 'acc'; Value: 'application/vnd.americandynamics.acc'), // do not localize
+ (Key: 'ami'; Value: 'application/vnd.amiga.ami'), // do not localize
+ (Key: 'apk'; Value: 'application/vnd.android.package-archive'), // do not localize
+ (Key: 'cii'; Value: 'application/vnd.anser-web-certificate-issue-initiation'), // do not localize
+ (Key: 'fti'; Value: 'application/vnd.anser-web-funds-transfer-initiation'), // do not localize
+ (Key: 'atx'; Value: 'application/vnd.antix.game-component'), // do not localize
+ (Key: 'mpkg'; Value: 'application/vnd.apple.installer+xml'), // do not localize
+ (Key: 'm3u8'; Value: 'application/vnd.apple.mpegurl'), // do not localize
+ (Key: 'swi'; Value: 'application/vnd.aristanetworks.swi'), // do not localize
+ (Key: 'iota'; Value: 'application/vnd.astraea-software.iota'), // do not localize
+ (Key: 'aep'; Value: 'application/vnd.audiograph'), // do not localize
+ (Key: 'mpm'; Value: 'application/vnd.blueice.multipass'), // do not localize
+ (Key: 'bmi'; Value: 'application/vnd.bmi'), // do not localize
+ (Key: 'rep'; Value: 'application/vnd.businessobjects'), // do not localize
+ (Key: 'cdxml'; Value: 'application/vnd.chemdraw+xml'), // do not localize
+ (Key: 'mmd'; Value: 'application/vnd.chipnuts.karaoke-mmd'), // do not localize
+ (Key: 'cdy'; Value: 'application/vnd.cinderella'), // do not localize
+ (Key: 'cla'; Value: 'application/vnd.claymore'), // do not localize
+ (Key: 'rp9'; Value: 'application/vnd.cloanto.rp9'), // do not localize
+ (Key: 'c4g'; Value: 'application/vnd.clonk.c4group'), // do not localize
+ (Key: 'c4d'; Value: 'application/vnd.clonk.c4group'), // do not localize
+ (Key: 'c4f'; Value: 'application/vnd.clonk.c4group'), // do not localize
+ (Key: 'c4p'; Value: 'application/vnd.clonk.c4group'), // do not localize
+ (Key: 'c4u'; Value: 'application/vnd.clonk.c4group'), // do not localize
+ (Key: 'c11amc'; Value: 'application/vnd.cluetrust.cartomobile-config'), // do not localize
+ (Key: 'c11amz'; Value: 'application/vnd.cluetrust.cartomobile-config-pkg'), // do not localize
+ (Key: 'csp'; Value: 'application/vnd.commonspace'), // do not localize
+ (Key: 'cdbcmsg'; Value: 'application/vnd.contact.cmsg'), // do not localize
+ (Key: 'cmc'; Value: 'application/vnd.cosmocaller'), // do not localize
+ (Key: 'clkx'; Value: 'application/vnd.crick.clicker'), // do not localize
+ (Key: 'clkk'; Value: 'application/vnd.crick.clicker.keyboard'), // do not localize
+ (Key: 'clkp'; Value: 'application/vnd.crick.clicker.palette'), // do not localize
+ (Key: 'clkt'; Value: 'application/vnd.crick.clicker.template'), // do not localize
+ (Key: 'clkw'; Value: 'application/vnd.crick.clicker.wordbank'), // do not localize
+ (Key: 'wbs'; Value: 'application/vnd.criticaltools.wbs+xml'), // do not localize
+ (Key: 'pml'; Value: 'application/vnd.ctc-posml'), // do not localize
+ (Key: 'ppd'; Value: 'application/vnd.cups-ppd'), // do not localize
+ (Key: 'car'; Value: 'application/vnd.curl.car'), // do not localize
+ (Key: 'pcurl'; Value: 'application/vnd.curl.pcurl'), // do not localize
+ (Key: 'dart'; Value: 'application/vnd.dart'), // do not localize
+ (Key: 'rdz'; Value: 'application/vnd.data-vision.rdz'), // do not localize
+ (Key: 'uvf'; Value: 'application/vnd.dece.data'), // do not localize
+ (Key: 'uvvf'; Value: 'application/vnd.dece.data'), // do not localize
+ (Key: 'uvd'; Value: 'application/vnd.dece.data'), // do not localize
+ (Key: 'uvvd'; Value: 'application/vnd.dece.data'), // do not localize
+ (Key: 'uvt'; Value: 'application/vnd.dece.ttml+xml'), // do not localize
+ (Key: 'uvvt'; Value: 'application/vnd.dece.ttml+xml'), // do not localize
+ (Key: 'uvx'; Value: 'application/vnd.dece.unspecified'), // do not localize
+ (Key: 'uvvx'; Value: 'application/vnd.dece.unspecified'), // do not localize
+ (Key: 'uvz'; Value: 'application/vnd.dece.zip'), // do not localize
+ (Key: 'uvvz'; Value: 'application/vnd.dece.zip'), // do not localize
+ (Key: 'fe_launch'; Value: 'application/vnd.denovo.fcselayout-link'), // do not localize
+ (Key: 'dna'; Value: 'application/vnd.dna'), // do not localize
+ (Key: 'mlp'; Value: 'application/vnd.dolby.mlp'), // do not localize
+ (Key: 'dpg'; Value: 'application/vnd.dpgraph'), // do not localize
+ (Key: 'dfac'; Value: 'application/vnd.dreamfactory'), // do not localize
+ (Key: 'kpxx'; Value: 'application/vnd.ds-keypoint'), // do not localize
+ (Key: 'ait'; Value: 'application/vnd.dvb.ait'), // do not localize
+ (Key: 'svc'; Value: 'application/vnd.dvb.service'), // do not localize
+ (Key: 'geo'; Value: 'application/vnd.dynageo'), // do not localize
+ (Key: 'mag'; Value: 'application/vnd.ecowin.chart'), // do not localize
+ (Key: 'nml'; Value: 'application/vnd.enliven'), // do not localize
+ (Key: 'esf'; Value: 'application/vnd.epson.esf'), // do not localize
+ (Key: 'msf'; Value: 'application/vnd.epson.msf'), // do not localize
+ (Key: 'qam'; Value: 'application/vnd.epson.quickanime'), // do not localize
+ (Key: 'slt'; Value: 'application/vnd.epson.salt'), // do not localize
+ (Key: 'ssf'; Value: 'application/vnd.epson.ssf'), // do not localize
+ (Key: 'es3'; Value: 'application/vnd.eszigno3+xml'), // do not localize
+ (Key: 'et3'; Value: 'application/vnd.eszigno3+xml'), // do not localize
+ (Key: 'ez2'; Value: 'application/vnd.ezpix-album'), // do not localize
+ (Key: 'ez3'; Value: 'application/vnd.ezpix-package'), // do not localize
+ (Key: 'fdf'; Value: 'application/vnd.fdf'), // do not localize
+ (Key: 'mseed'; Value: 'application/vnd.fdsn.mseed'), // do not localize
+ (Key: 'seed'; Value: 'application/vnd.fdsn.seed'), // do not localize
+ (Key: 'dataless'; Value: 'application/vnd.fdsn.seed'), // do not localize
+ (Key: 'gph'; Value: 'application/vnd.flographit'), // do not localize
+ (Key: 'ftc'; Value: 'application/vnd.fluxtime.clip'), // do not localize
+ (Key: 'fm'; Value: 'application/vnd.framemaker'), // do not localize
+ (Key: 'frame'; Value: 'application/vnd.framemaker'), // do not localize
+ (Key: 'maker'; Value: 'application/vnd.framemaker'), // do not localize
+ (Key: 'book'; Value: 'application/vnd.framemaker'), // do not localize
+ (Key: 'fnc'; Value: 'application/vnd.frogans.fnc'), // do not localize
+ (Key: 'ltf'; Value: 'application/vnd.frogans.ltf'), // do not localize
+ (Key: 'fsc'; Value: 'application/vnd.fsc.weblaunch'), // do not localize
+ (Key: 'oas'; Value: 'application/vnd.fujitsu.oasys'), // do not localize
+ (Key: 'oa2'; Value: 'application/vnd.fujitsu.oasys2'), // do not localize
+ (Key: 'oa3'; Value: 'application/vnd.fujitsu.oasys3'), // do not localize
+ (Key: 'fg5'; Value: 'application/vnd.fujitsu.oasysgp'), // do not localize
+ (Key: 'bh2'; Value: 'application/vnd.fujitsu.oasysprs'), // do not localize
+ (Key: 'ddd'; Value: 'application/vnd.fujixerox.ddd'), // do not localize
+ (Key: 'xdw'; Value: 'application/vnd.fujixerox.docuworks'), // do not localize
+ (Key: 'xbd'; Value: 'application/vnd.fujixerox.docuworks.binder'), // do not localize
+ (Key: 'fzs'; Value: 'application/vnd.fuzzysheet'), // do not localize
+ (Key: 'txd'; Value: 'application/vnd.genomatix.tuxedo'), // do not localize
+ (Key: 'ggb'; Value: 'application/vnd.geogebra.file'), // do not localize
+ (Key: 'ggt'; Value: 'application/vnd.geogebra.tool'), // do not localize
+ (Key: 'gex'; Value: 'application/vnd.geometry-explorer'), // do not localize
+ (Key: 'gre'; Value: 'application/vnd.geometry-explorer'), // do not localize
+ (Key: 'gxt'; Value: 'application/vnd.geonext'), // do not localize
+ (Key: 'g2w'; Value: 'application/vnd.geoplan'), // do not localize
+ (Key: 'g3w'; Value: 'application/vnd.geospace'), // do not localize
+ (Key: 'gmx'; Value: 'application/vnd.gmx'), // do not localize
+ (Key: 'kml'; Value: 'application/vnd.google-earth.kml+xml'), // do not localize
+ (Key: 'kmz'; Value: 'application/vnd.google-earth.kmz'), // do not localize
+ (Key: 'gqf'; Value: 'application/vnd.grafeq'), // do not localize
+ (Key: 'gqs'; Value: 'application/vnd.grafeq'), // do not localize
+ (Key: 'gac'; Value: 'application/vnd.groove-account'), // do not localize
+ (Key: 'ghf'; Value: 'application/vnd.groove-help'), // do not localize
+ (Key: 'gim'; Value: 'application/vnd.groove-identity-message'), // do not localize
+ (Key: 'grv'; Value: 'application/vnd.groove-injector'), // do not localize
+ (Key: 'gtm'; Value: 'application/vnd.groove-tool-message'), // do not localize
+ (Key: 'tpl'; Value: 'application/vnd.groove-tool-template'), // do not localize
+ (Key: 'vcg'; Value: 'application/vnd.groove-vcard'), // do not localize
+ (Key: 'hal'; Value: 'application/vnd.hal+xml'), // do not localize
+ (Key: 'zmm'; Value: 'application/vnd.handheld-entertainment+xml'), // do not localize
+ (Key: 'hbci'; Value: 'application/vnd.hbci'), // do not localize
+ (Key: 'les'; Value: 'application/vnd.hhe.lesson-player'), // do not localize
+ (Key: 'hpgl'; Value: 'application/vnd.hp-hpgl'), // do not localize
+ (Key: 'hpid'; Value: 'application/vnd.hp-hpid'), // do not localize
+ (Key: 'hps'; Value: 'application/vnd.hp-hps'), // do not localize
+ (Key: 'jlt'; Value: 'application/vnd.hp-jlyt'), // do not localize
+ (Key: 'pcl'; Value: 'application/vnd.hp-pcl'), // do not localize
+ (Key: 'pclxl'; Value: 'application/vnd.hp-pclxl'), // do not localize
+ (Key: 'sfd-hdstx'; Value: 'application/vnd.hydrostatix.sof-data'), // do not localize
+ (Key: 'mpy'; Value: 'application/vnd.ibm.minipay'), // do not localize
+ (Key: 'afp'; Value: 'application/vnd.ibm.modcap'), // do not localize
+ (Key: 'listafp'; Value: 'application/vnd.ibm.modcap'), // do not localize
+ (Key: 'list3820'; Value: 'application/vnd.ibm.modcap'), // do not localize
+ (Key: 'irm'; Value: 'application/vnd.ibm.rights-management'), // do not localize
+ (Key: 'sc'; Value: 'application/vnd.ibm.secure-container'), // do not localize
+ (Key: 'icc'; Value: 'application/vnd.iccprofile'), // do not localize
+ (Key: 'icm'; Value: 'application/vnd.iccprofile'), // do not localize
+ (Key: 'igl'; Value: 'application/vnd.igloader'), // do not localize
+ (Key: 'ivp'; Value: 'application/vnd.immervision-ivp'), // do not localize
+ (Key: 'ivu'; Value: 'application/vnd.immervision-ivu'), // do not localize
+ (Key: 'igm'; Value: 'application/vnd.insors.igm'), // do not localize
+ (Key: 'xpw'; Value: 'application/vnd.intercon.formnet'), // do not localize
+ (Key: 'xpx'; Value: 'application/vnd.intercon.formnet'), // do not localize
+ (Key: 'i2g'; Value: 'application/vnd.intergeo'), // do not localize
+ (Key: 'qbo'; Value: 'application/vnd.intu.qbo'), // do not localize
+ (Key: 'qfx'; Value: 'application/vnd.intu.qfx'), // do not localize
+ (Key: 'rcprofile'; Value: 'application/vnd.ipunplugged.rcprofile'), // do not localize
+ (Key: 'irp'; Value: 'application/vnd.irepository.package+xml'), // do not localize
+ (Key: 'xpr'; Value: 'application/vnd.is-xpr'), // do not localize
+ (Key: 'fcs'; Value: 'application/vnd.isac.fcs'), // do not localize
+ (Key: 'jam'; Value: 'application/vnd.jam'), // do not localize
+ (Key: 'rms'; Value: 'application/vnd.jcp.javame.midlet-rms'), // do not localize
+ (Key: 'jisp'; Value: 'application/vnd.jisp'), // do not localize
+ (Key: 'joda'; Value: 'application/vnd.joost.joda-archive'), // do not localize
+ (Key: 'ktz'; Value: 'application/vnd.kahootz'), // do not localize
+ (Key: 'ktr'; Value: 'application/vnd.kahootz'), // do not localize
+ (Key: 'karbon'; Value: 'application/vnd.kde.karbon'), // do not localize
+ (Key: 'chrt'; Value: 'application/vnd.kde.kchart'), // do not localize
+ (Key: 'kfo'; Value: 'application/vnd.kde.kformula'), // do not localize
+ (Key: 'flw'; Value: 'application/vnd.kde.kivio'), // do not localize
+ (Key: 'kon'; Value: 'application/vnd.kde.kontour'), // do not localize
+ (Key: 'kpr'; Value: 'application/vnd.kde.kpresenter'), // do not localize
+ (Key: 'kpt'; Value: 'application/vnd.kde.kpresenter'), // do not localize
+ (Key: 'ksp'; Value: 'application/vnd.kde.kspread'), // do not localize
+ (Key: 'kwd'; Value: 'application/vnd.kde.kword'), // do not localize
+ (Key: 'kwt'; Value: 'application/vnd.kde.kword'), // do not localize
+ (Key: 'htke'; Value: 'application/vnd.kenameaapp'), // do not localize
+ (Key: 'kia'; Value: 'application/vnd.kidspiration'), // do not localize
+ (Key: 'kne'; Value: 'application/vnd.kinar'), // do not localize
+ (Key: 'knp'; Value: 'application/vnd.kinar'), // do not localize
+ (Key: 'skp'; Value: 'application/vnd.koan'), // do not localize
+ (Key: 'skd'; Value: 'application/vnd.koan'), // do not localize
+ (Key: 'skt'; Value: 'application/vnd.koan'), // do not localize
+ (Key: 'skm'; Value: 'application/vnd.koan'), // do not localize
+ (Key: 'sse'; Value: 'application/vnd.kodak-descriptor'), // do not localize
+ (Key: 'lasxml'; Value: 'application/vnd.las.las+xml'), // do not localize
+ (Key: 'lbd'; Value: 'application/vnd.llamagraphics.life-balance.desktop'), // do not localize
+ (Key: 'lbe'; Value: 'application/vnd.llamagraphics.life-balance.exchange+xml'), // do not localize
+ (Key: '123'; Value: 'application/vnd.lotus-1-2-3'), // do not localize
+ (Key: 'apr'; Value: 'application/vnd.lotus-approach'), // do not localize
+ (Key: 'pre'; Value: 'application/vnd.lotus-freelance'), // do not localize
+ (Key: 'nsf'; Value: 'application/vnd.lotus-notes'), // do not localize
+ (Key: 'org'; Value: 'application/vnd.lotus-organizer'), // do not localize
+ (Key: 'scm'; Value: 'application/vnd.lotus-screencam'), // do not localize
+ (Key: 'lwp'; Value: 'application/vnd.lotus-wordpro'), // do not localize
+ (Key: 'portpkg'; Value: 'application/vnd.macports.portpkg'), // do not localize
+ (Key: 'mcd'; Value: 'application/vnd.mcd'), // do not localize
+ (Key: 'mc1'; Value: 'application/vnd.medcalcdata'), // do not localize
+ (Key: 'cdkey'; Value: 'application/vnd.mediastation.cdkey'), // do not localize
+ (Key: 'mwf'; Value: 'application/vnd.mfer'), // do not localize
+ (Key: 'mfm'; Value: 'application/vnd.mfmp'), // do not localize
+ (Key: 'flo'; Value: 'application/vnd.micrografx.flo'), // do not localize
+ (Key: 'igx'; Value: 'application/vnd.micrografx.igx'), // do not localize
+ (Key: 'mif'; Value: 'application/vnd.mif'), // do not localize
+ (Key: 'daf'; Value: 'application/vnd.mobius.daf'), // do not localize
+ (Key: 'dis'; Value: 'application/vnd.mobius.dis'), // do not localize
+ (Key: 'mbk'; Value: 'application/vnd.mobius.mbk'), // do not localize
+ (Key: 'mqy'; Value: 'application/vnd.mobius.mqy'), // do not localize
+ (Key: 'msl'; Value: 'application/vnd.mobius.msl'), // do not localize
+ (Key: 'plc'; Value: 'application/vnd.mobius.plc'), // do not localize
+ (Key: 'txf'; Value: 'application/vnd.mobius.txf'), // do not localize
+ (Key: 'mpn'; Value: 'application/vnd.mophun.application'), // do not localize
+ (Key: 'mpc'; Value: 'application/vnd.mophun.certificate'), // do not localize
+ (Key: 'xul'; Value: 'application/vnd.mozilla.xul+xml'), // do not localize
+ (Key: 'cil'; Value: 'application/vnd.ms-artgalry'), // do not localize
+ (Key: 'cab'; Value: 'application/vnd.ms-cab-compressed'), // do not localize
+ (Key: 'xls'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xlm'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xla'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xlc'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xlt'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xlw'; Value: 'application/vnd.ms-excel'), // do not localize
+ (Key: 'xlam'; Value: 'application/vnd.ms-excel.addin.macroenabled.12'), // do not localize
+ (Key: 'xlsb'; Value: 'application/vnd.ms-excel.sheet.binary.macroenabled.12'), // do not localize
+ (Key: 'xlsm'; Value: 'application/vnd.ms-excel.sheet.macroenabled.12'), // do not localize
+ (Key: 'xltm'; Value: 'application/vnd.ms-excel.template.macroenabled.12'), // do not localize
+ (Key: 'eot'; Value: 'application/vnd.ms-fontobject'), // do not localize
+ (Key: 'chm'; Value: 'application/vnd.ms-htmlhelp'), // do not localize
+ (Key: 'ims'; Value: 'application/vnd.ms-ims'), // do not localize
+ (Key: 'lrm'; Value: 'application/vnd.ms-lrm'), // do not localize
+ (Key: 'thmx'; Value: 'application/vnd.ms-officetheme'), // do not localize
+ (Key: 'cat'; Value: 'application/vnd.ms-pki.seccat'), // do not localize
+ (Key: 'stl'; Value: 'application/vnd.ms-pki.stl'), // do not localize
+ (Key: 'ppt'; Value: 'application/vnd.ms-powerpoint'), // do not localize
+ (Key: 'pps'; Value: 'application/vnd.ms-powerpoint'), // do not localize
+ (Key: 'pot'; Value: 'application/vnd.ms-powerpoint'), // do not localize
+ (Key: 'ppam'; Value: 'application/vnd.ms-powerpoint.addin.macroenabled.12'), // do not localize
+ (Key: 'pptm'; Value: 'application/vnd.ms-powerpoint.presentation.macroenabled.12'), // do not localize
+ (Key: 'sldm'; Value: 'application/vnd.ms-powerpoint.slide.macroenabled.12'), // do not localize
+ (Key: 'ppsm'; Value: 'application/vnd.ms-powerpoint.slideshow.macroenabled.12'), // do not localize
+ (Key: 'potm'; Value: 'application/vnd.ms-powerpoint.template.macroenabled.12'), // do not localize
+ (Key: 'mpp'; Value: 'application/vnd.ms-project'), // do not localize
+ (Key: 'mpt'; Value: 'application/vnd.ms-project'), // do not localize
+ (Key: 'docm'; Value: 'application/vnd.ms-word.document.macroenabled.12'), // do not localize
+ (Key: 'dotm'; Value: 'application/vnd.ms-word.template.macroenabled.12'), // do not localize
+ (Key: 'wps'; Value: 'application/vnd.ms-works'), // do not localize
+ (Key: 'wks'; Value: 'application/vnd.ms-works'), // do not localize
+ (Key: 'wcm'; Value: 'application/vnd.ms-works'), // do not localize
+ (Key: 'wdb'; Value: 'application/vnd.ms-works'), // do not localize
+ (Key: 'wpl'; Value: 'application/vnd.ms-wpl'), // do not localize
+ (Key: 'xps'; Value: 'application/vnd.ms-xpsdocument'), // do not localize
+ (Key: 'mseq'; Value: 'application/vnd.mseq'), // do not localize
+ (Key: 'mus'; Value: 'application/vnd.musician'), // do not localize
+ (Key: 'msty'; Value: 'application/vnd.muvee.style'), // do not localize
+ (Key: 'taglet'; Value: 'application/vnd.mynfc'), // do not localize
+ (Key: 'nlu'; Value: 'application/vnd.neurolanguage.nlu'), // do not localize
+ (Key: 'ntf'; Value: 'application/vnd.nitf'), // do not localize
+ (Key: 'nitf'; Value: 'application/vnd.nitf'), // do not localize
+ (Key: 'nnd'; Value: 'application/vnd.noblenet-directory'), // do not localize
+ (Key: 'nns'; Value: 'application/vnd.noblenet-sealer'), // do not localize
+ (Key: 'nnw'; Value: 'application/vnd.noblenet-web'), // do not localize
+ (Key: 'ngdat'; Value: 'application/vnd.nokia.n-gage.data'), // do not localize
+ (Key: 'n-gage'; Value: 'application/vnd.nokia.n-gage.symbian.install'), // do not localize
+ (Key: 'rpst'; Value: 'application/vnd.nokia.radio-preset'), // do not localize
+ (Key: 'rpss'; Value: 'application/vnd.nokia.radio-presets'), // do not localize
+ (Key: 'edm'; Value: 'application/vnd.novadigm.edm'), // do not localize
+ (Key: 'edx'; Value: 'application/vnd.novadigm.edx'), // do not localize
+ (Key: 'ext'; Value: 'application/vnd.novadigm.ext'), // do not localize
+ (Key: 'odc'; Value: 'application/vnd.oasis.opendocument.chart'), // do not localize
+ (Key: 'otc'; Value: 'application/vnd.oasis.opendocument.chart-template'), // do not localize
+ (Key: 'odb'; Value: 'application/vnd.oasis.opendocument.database'), // do not localize
+ (Key: 'odf'; Value: 'application/vnd.oasis.opendocument.formula'), // do not localize
+ (Key: 'odft'; Value: 'application/vnd.oasis.opendocument.formula-template'), // do not localize
+ (Key: 'odg'; Value: 'application/vnd.oasis.opendocument.graphics'), // do not localize
+ (Key: 'otg'; Value: 'application/vnd.oasis.opendocument.graphics-template'), // do not localize
+ (Key: 'odi'; Value: 'application/vnd.oasis.opendocument.image'), // do not localize
+ (Key: 'oti'; Value: 'application/vnd.oasis.opendocument.image-template'), // do not localize
+ (Key: 'odp'; Value: 'application/vnd.oasis.opendocument.presentation'), // do not localize
+ (Key: 'otp'; Value: 'application/vnd.oasis.opendocument.presentation-template'), // do not localize
+ (Key: 'ods'; Value: 'application/vnd.oasis.opendocument.spreadsheet'), // do not localize
+ (Key: 'ots'; Value: 'application/vnd.oasis.opendocument.spreadsheet-template'), // do not localize
+ (Key: 'odt'; Value: 'application/vnd.oasis.opendocument.text'), // do not localize
+ (Key: 'odm'; Value: 'application/vnd.oasis.opendocument.text-master'), // do not localize
+ (Key: 'ott'; Value: 'application/vnd.oasis.opendocument.text-template'), // do not localize
+ (Key: 'oth'; Value: 'application/vnd.oasis.opendocument.text-web'), // do not localize
+ (Key: 'xo'; Value: 'application/vnd.olpc-sugar'), // do not localize
+ (Key: 'dd2'; Value: 'application/vnd.oma.dd2+xml'), // do not localize
+ (Key: 'oxt'; Value: 'application/vnd.openofficeorg.extension'), // do not localize
+ (Key: 'pptx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.presentation'), // do not localize
+ (Key: 'sldx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.slide'), // do not localize
+ (Key: 'ppsx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.slideshow'), // do not localize
+ (Key: 'potx'; Value: 'application/vnd.openxmlformats-officedocument.presentationml.template'), // do not localize
+ (Key: 'xlsx'; Value: 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'), // do not localize
+ (Key: 'xltx'; Value: 'application/vnd.openxmlformats-officedocument.spreadsheetml.template'), // do not localize
+ (Key: 'docx'; Value: 'application/vnd.openxmlformats-officedocument.wordprocessingml.document'), // do not localize
+ (Key: 'dotx'; Value: 'application/vnd.openxmlformats-officedocument.wordprocessingml.template'), // do not localize
+ (Key: 'mgp'; Value: 'application/vnd.osgeo.mapguide.package'), // do not localize
+ (Key: 'dp'; Value: 'application/vnd.osgi.dp'), // do not localize
+ (Key: 'esa'; Value: 'application/vnd.osgi.subsystem'), // do not localize
+ (Key: 'pdb'; Value: 'application/vnd.palm'), // do not localize
+ (Key: 'pqa'; Value: 'application/vnd.palm'), // do not localize
+ (Key: 'oprc'; Value: 'application/vnd.palm'), // do not localize
+ (Key: 'paw'; Value: 'application/vnd.pawaafile'), // do not localize
+ (Key: 'str'; Value: 'application/vnd.pg.format'), // do not localize
+ (Key: 'ei6'; Value: 'application/vnd.pg.osasli'), // do not localize
+ (Key: 'efif'; Value: 'application/vnd.picsel'), // do not localize
+ (Key: 'wg'; Value: 'application/vnd.pmi.widget'), // do not localize
+ (Key: 'plf'; Value: 'application/vnd.pocketlearn'), // do not localize
+ (Key: 'pbd'; Value: 'application/vnd.powerbuilder6'), // do not localize
+ (Key: 'box'; Value: 'application/vnd.previewsystems.box'), // do not localize
+ (Key: 'mgz'; Value: 'application/vnd.proteus.magazine'), // do not localize
+ (Key: 'qps'; Value: 'application/vnd.publishare-delta-tree'), // do not localize
+ (Key: 'ptid'; Value: 'application/vnd.pvi.ptid1'), // do not localize
+ (Key: 'qxd'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'qxt'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'qwd'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'qwt'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'qxl'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'qxb'; Value: 'application/vnd.quark.quarkxpress'), // do not localize
+ (Key: 'bed'; Value: 'application/vnd.realvnc.bed'), // do not localize
+ (Key: 'mxl'; Value: 'application/vnd.recordare.musicxml'), // do not localize
+ (Key: 'musicxml'; Value: 'application/vnd.recordare.musicxml+xml'), // do not localize
+ (Key: 'cryptonote'; Value: 'application/vnd.rig.cryptonote'), // do not localize
+ (Key: 'cod'; Value: 'application/vnd.rim.cod'), // do not localize
+ (Key: 'rm'; Value: 'application/vnd.rn-realmedia'), // do not localize
+ (Key: 'rmvb'; Value: 'application/vnd.rn-realmedia-vbr'), // do not localize
+ (Key: 'link66'; Value: 'application/vnd.route66.link66+xml'), // do not localize
+ (Key: 'st'; Value: 'application/vnd.sailingtracker.track'), // do not localize
+ (Key: 'see'; Value: 'application/vnd.seemail'), // do not localize
+ (Key: 'sema'; Value: 'application/vnd.sema'), // do not localize
+ (Key: 'semd'; Value: 'application/vnd.semd'), // do not localize
+ (Key: 'semf'; Value: 'application/vnd.semf'), // do not localize
+ (Key: 'ifm'; Value: 'application/vnd.shana.informed.formdata'), // do not localize
+ (Key: 'itp'; Value: 'application/vnd.shana.informed.formtemplate'), // do not localize
+ (Key: 'iif'; Value: 'application/vnd.shana.informed.interchange'), // do not localize
+ (Key: 'ipk'; Value: 'application/vnd.shana.informed.package'), // do not localize
+ (Key: 'twd'; Value: 'application/vnd.simtech-mindmapper'), // do not localize
+ (Key: 'twds'; Value: 'application/vnd.simtech-mindmapper'), // do not localize
+ (Key: 'mmf'; Value: 'application/vnd.smaf'), // do not localize
+ (Key: 'teacher'; Value: 'application/vnd.smart.teacher'), // do not localize
+ (Key: 'sdkm'; Value: 'application/vnd.solent.sdkm+xml'), // do not localize
+ (Key: 'sdkd'; Value: 'application/vnd.solent.sdkm+xml'), // do not localize
+ (Key: 'dxp'; Value: 'application/vnd.spotfire.dxp'), // do not localize
+ (Key: 'sfs'; Value: 'application/vnd.spotfire.sfs'), // do not localize
+ (Key: 'sdc'; Value: 'application/vnd.stardivision.calc'), // do not localize
+ (Key: 'sda'; Value: 'application/vnd.stardivision.draw'), // do not localize
+ (Key: 'sdd'; Value: 'application/vnd.stardivision.impress'), // do not localize
+ (Key: 'smf'; Value: 'application/vnd.stardivision.math'), // do not localize
+ (Key: 'sdw'; Value: 'application/vnd.stardivision.writer'), // do not localize
+ (Key: 'vor'; Value: 'application/vnd.stardivision.writer'), // do not localize
+ (Key: 'sgl'; Value: 'application/vnd.stardivision.writer-global'), // do not localize
+ (Key: 'smzip'; Value: 'application/vnd.stepmania.package'), // do not localize
+ (Key: 'sm'; Value: 'application/vnd.stepmania.stepchart'), // do not localize
+ (Key: 'sxc'; Value: 'application/vnd.sun.xml.calc'), // do not localize
+ (Key: 'stc'; Value: 'application/vnd.sun.xml.calc.template'), // do not localize
+ (Key: 'sxd'; Value: 'application/vnd.sun.xml.draw'), // do not localize
+ (Key: 'std'; Value: 'application/vnd.sun.xml.draw.template'), // do not localize
+ (Key: 'sxi'; Value: 'application/vnd.sun.xml.impress'), // do not localize
+ (Key: 'sti'; Value: 'application/vnd.sun.xml.impress.template'), // do not localize
+ (Key: 'sxm'; Value: 'application/vnd.sun.xml.math'), // do not localize
+ (Key: 'sxw'; Value: 'application/vnd.sun.xml.writer'), // do not localize
+ (Key: 'sxg'; Value: 'application/vnd.sun.xml.writer.global'), // do not localize
+ (Key: 'stw'; Value: 'application/vnd.sun.xml.writer.template'), // do not localize
+ (Key: 'sus'; Value: 'application/vnd.sus-calendar'), // do not localize
+ (Key: 'susp'; Value: 'application/vnd.sus-calendar'), // do not localize
+ (Key: 'svd'; Value: 'application/vnd.svd'), // do not localize
+ (Key: 'sis'; Value: 'application/vnd.symbian.install'), // do not localize
+ (Key: 'sisx'; Value: 'application/vnd.symbian.install'), // do not localize
+ (Key: 'xsm'; Value: 'application/vnd.syncml+xml'), // do not localize
+ (Key: 'bdm'; Value: 'application/vnd.syncml.dm+wbxml'), // do not localize
+ (Key: 'xdm'; Value: 'application/vnd.syncml.dm+xml'), // do not localize
+ (Key: 'tao'; Value: 'application/vnd.tao.intent-module-archive'), // do not localize
+ (Key: 'pcap'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
+ (Key: 'cap'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
+ (Key: 'dmp'; Value: 'application/vnd.tcpdump.pcap'), // do not localize
+ (Key: 'tmo'; Value: 'application/vnd.tmobile-livetv'), // do not localize
+ (Key: 'tpt'; Value: 'application/vnd.trid.tpt'), // do not localize
+ (Key: 'mxs'; Value: 'application/vnd.triscape.mxs'), // do not localize
+ (Key: 'tra'; Value: 'application/vnd.trueapp'), // do not localize
+ (Key: 'ufd'; Value: 'application/vnd.ufdl'), // do not localize
+ (Key: 'ufdl'; Value: 'application/vnd.ufdl'), // do not localize
+ (Key: 'utz'; Value: 'application/vnd.uiq.theme'), // do not localize
+ (Key: 'umj'; Value: 'application/vnd.umajin'), // do not localize
+ (Key: 'unityweb'; Value: 'application/vnd.unity'), // do not localize
+ (Key: 'uoml'; Value: 'application/vnd.uoml+xml'), // do not localize
+ (Key: 'vcx'; Value: 'application/vnd.vcx'), // do not localize
+ (Key: 'vsd'; Value: 'application/vnd.visio'), // do not localize
+ (Key: 'vst'; Value: 'application/vnd.visio'), // do not localize
+ (Key: 'vss'; Value: 'application/vnd.visio'), // do not localize
+ (Key: 'vsw'; Value: 'application/vnd.visio'), // do not localize
+ (Key: 'vis'; Value: 'application/vnd.visionary'), // do not localize
+ (Key: 'vsf'; Value: 'application/vnd.vsf'), // do not localize
+ (Key: 'wbxml'; Value: 'application/vnd.wap.wbxml'), // do not localize
+ (Key: 'wmlc'; Value: 'application/vnd.wap.wmlc'), // do not localize
+ (Key: 'wmlsc'; Value: 'application/vnd.wap.wmlscriptc'), // do not localize
+ (Key: 'wtb'; Value: 'application/vnd.webturbo'), // do not localize
+ (Key: 'nbp'; Value: 'application/vnd.wolfram.player'), // do not localize
+ (Key: 'wpd'; Value: 'application/vnd.wordperfect'), // do not localize
+ (Key: 'wqd'; Value: 'application/vnd.wqd'), // do not localize
+ (Key: 'stf'; Value: 'application/vnd.wt.stf'), // do not localize
+ (Key: 'xar'; Value: 'application/vnd.xara'), // do not localize
+ (Key: 'xfdl'; Value: 'application/vnd.xfdl'), // do not localize
+ (Key: 'hvd'; Value: 'application/vnd.yamaha.hv-dic'), // do not localize
+ (Key: 'hvs'; Value: 'application/vnd.yamaha.hv-script'), // do not localize
+ (Key: 'hvp'; Value: 'application/vnd.yamaha.hv-voice'), // do not localize
+ (Key: 'osf'; Value: 'application/vnd.yamaha.openscoreformat'), // do not localize
+ (Key: 'osfpvg'; Value: 'application/vnd.yamaha.openscoreformat.osfpvg+xml'), // do not localize
+ (Key: 'saf'; Value: 'application/vnd.yamaha.smaf-audio'), // do not localize
+ (Key: 'spf'; Value: 'application/vnd.yamaha.smaf-phrase'), // do not localize
+ (Key: 'cmp'; Value: 'application/vnd.yellowriver-custom-menu'), // do not localize
+ (Key: 'zir'; Value: 'application/vnd.zul'), // do not localize
+ (Key: 'zirz'; Value: 'application/vnd.zul'), // do not localize
+ (Key: 'zaz'; Value: 'application/vnd.zzazz.deck+xml'), // do not localize
+ (Key: 'vxml'; Value: 'application/voicexml+xml'), // do not localize
+ (Key: 'wgt'; Value: 'application/widget'), // do not localize
+ (Key: 'hlp'; Value: 'application/winhlp'), // do not localize
+ (Key: 'wsdl'; Value: 'application/wsdl+xml'), // do not localize
+ (Key: 'wspolicy'; Value: 'application/wspolicy+xml'), // do not localize
+ (Key: '7z'; Value: 'application/x-7z-compressed'), // do not localize
+ (Key: 'abw'; Value: 'application/x-abiword'), // do not localize
+ (Key: 'ace'; Value: 'application/x-ace-compressed'), // do not localize
+ (Key: 'dmg'; Value: 'application/x-apple-diskimage'), // do not localize
+ (Key: 'aab'; Value: 'application/x-authorware-bin'), // do not localize
+ (Key: 'x32'; Value: 'application/x-authorware-bin'), // do not localize
+ (Key: 'u32'; Value: 'application/x-authorware-bin'), // do not localize
+ (Key: 'vox'; Value: 'application/x-authorware-bin'), // do not localize
+ (Key: 'aam'; Value: 'application/x-authorware-map'), // do not localize
+ (Key: 'aas'; Value: 'application/x-authorware-seg'), // do not localize
+ (Key: 'bcpio'; Value: 'application/x-bcpio'), // do not localize
+ (Key: 'torrent'; Value: 'application/x-bittorrent'), // do not localize
+ (Key: 'blb'; Value: 'application/x-blorb'), // do not localize
+ (Key: 'blorb'; Value: 'application/x-blorb'), // do not localize
+ (Key: 'bz'; Value: 'application/x-bzip'), // do not localize
+ (Key: 'bz2'; Value: 'application/x-bzip2'), // do not localize
+ (Key: 'boz'; Value: 'application/x-bzip2'), // do not localize
+ (Key: 'cbr'; Value: 'application/x-cbr'), // do not localize
+ (Key: 'cba'; Value: 'application/x-cbr'), // do not localize
+ (Key: 'cbt'; Value: 'application/x-cbr'), // do not localize
+ (Key: 'cbz'; Value: 'application/x-cbr'), // do not localize
+ (Key: 'cb7'; Value: 'application/x-cbr'), // do not localize
+ (Key: 'vcd'; Value: 'application/x-cdlink'), // do not localize
+ (Key: 'cfs'; Value: 'application/x-cfs-compressed'), // do not localize
+ (Key: 'chat'; Value: 'application/x-chat'), // do not localize
+ (Key: 'pgn'; Value: 'application/x-chess-pgn'), // do not localize
+ (Key: 'nsc'; Value: 'application/x-conference'), // do not localize
+ (Key: 'cpio'; Value: 'application/x-cpio'), // do not localize
+ (Key: 'csh'; Value: 'application/x-csh'), // do not localize
+ (Key: 'deb'; Value: 'application/x-debian-package'), // do not localize
+ (Key: 'udeb'; Value: 'application/x-debian-package'), // do not localize
+ (Key: 'dgc'; Value: 'application/x-dgc-compressed'), // do not localize
+ (Key: 'dir'; Value: 'application/x-director'), // do not localize
+ (Key: 'dcr'; Value: 'application/x-director'), // do not localize
+ (Key: 'dxr'; Value: 'application/x-director'), // do not localize
+ (Key: 'cst'; Value: 'application/x-director'), // do not localize
+ (Key: 'cct'; Value: 'application/x-director'), // do not localize
+ (Key: 'cxt'; Value: 'application/x-director'), // do not localize
+ (Key: 'w3d'; Value: 'application/x-director'), // do not localize
+ (Key: 'fgd'; Value: 'application/x-director'), // do not localize
+ (Key: 'swa'; Value: 'application/x-director'), // do not localize
+ (Key: 'wad'; Value: 'application/x-doom'), // do not localize
+ (Key: 'ncx'; Value: 'application/x-dtbncx+xml'), // do not localize
+ (Key: 'dtb'; Value: 'application/x-dtbook+xml'), // do not localize
+ (Key: 'res'; Value: 'application/x-dtbresource+xml'), // do not localize
+ (Key: 'dvi'; Value: 'application/x-dvi'), // do not localize
+ (Key: 'evy'; Value: 'application/x-envoy'), // do not localize
+ (Key: 'eva'; Value: 'application/x-eva'), // do not localize
+ (Key: 'bdf'; Value: 'application/x-font-bdf'), // do not localize
+ (Key: 'gsf'; Value: 'application/x-font-ghostscript'), // do not localize
+ (Key: 'psf'; Value: 'application/x-font-linux-psf'), // do not localize
+ (Key: 'otf'; Value: 'application/x-font-otf'), // do not localize
+ (Key: 'pcf'; Value: 'application/x-font-pcf'), // do not localize
+ (Key: 'snf'; Value: 'application/x-font-snf'), // do not localize
+ (Key: 'ttf'; Value: 'application/x-font-ttf'), // do not localize
+ (Key: 'ttc'; Value: 'application/x-font-ttf'), // do not localize
+ (Key: 'pfa'; Value: 'application/x-font-type1'), // do not localize
+ (Key: 'pfb'; Value: 'application/x-font-type1'), // do not localize
+ (Key: 'pfm'; Value: 'application/x-font-type1'), // do not localize
+ (Key: 'afm'; Value: 'application/x-font-type1'), // do not localize
+ (Key: 'woff'; Value: 'application/x-font-woff'), // do not localize
+ (Key: 'arc'; Value: 'application/x-freearc'), // do not localize
+ (Key: 'spl'; Value: 'application/x-futuresplash'), // do not localize
+ (Key: 'gca'; Value: 'application/x-gca-compressed'), // do not localize
+ (Key: 'ulx'; Value: 'application/x-glulx'), // do not localize
+ (Key: 'gnumeric'; Value: 'application/x-gnumeric'), // do not localize
+ (Key: 'gramps'; Value: 'application/x-gramps-xml'), // do not localize
+ (Key: 'gtar'; Value: 'application/x-gtar'), // do not localize
+ (Key: 'hdf'; Value: 'application/x-hdf'), // do not localize
+ (Key: 'install'; Value: 'application/x-install-instructions'), // do not localize
+ (Key: 'iso'; Value: 'application/x-iso9660-image'), // do not localize
+ (Key: 'jnlp'; Value: 'application/x-java-jnlp-file'), // do not localize
+ (Key: 'latex'; Value: 'application/x-latex'), // do not localize
+ (Key: 'lzh'; Value: 'application/x-lzh-compressed'), // do not localize
+ (Key: 'lha'; Value: 'application/x-lzh-compressed'), // do not localize
+ (Key: 'mie'; Value: 'application/x-mie'), // do not localize
+ (Key: 'prc'; Value: 'application/x-mobipocket-ebook'), // do not localize
+ (Key: 'mobi'; Value: 'application/x-mobipocket-ebook'), // do not localize
+ (Key: 'application'; Value: 'application/x-ms-application'), // do not localize
+ (Key: 'lnk'; Value: 'application/x-ms-shortcut'), // do not localize
+ (Key: 'wmd'; Value: 'application/x-ms-wmd'), // do not localize
+ (Key: 'wmz'; Value: 'application/x-ms-wmz'), // do not localize
+ (Key: 'xbap'; Value: 'application/x-ms-xbap'), // do not localize
+ (Key: 'mdb'; Value: 'application/x-msaccess'), // do not localize
+ (Key: 'obd'; Value: 'application/x-msbinder'), // do not localize
+ (Key: 'crd'; Value: 'application/x-mscardfile'), // do not localize
+ (Key: 'clp'; Value: 'application/x-msclip'), // do not localize
+ (Key: 'exe'; Value: 'application/x-msdownload'), // do not localize
+ (Key: 'dll'; Value: 'application/x-msdownload'), // do not localize
+ (Key: 'com'; Value: 'application/x-msdownload'), // do not localize
+ (Key: 'bat'; Value: 'application/x-msdownload'), // do not localize
+ (Key: 'msi'; Value: 'application/x-msdownload'), // do not localize
+ (Key: 'mvb'; Value: 'application/x-msmediaview'), // do not localize
+ (Key: 'm13'; Value: 'application/x-msmediaview'), // do not localize
+ (Key: 'm14'; Value: 'application/x-msmediaview'), // do not localize
+ (Key: 'wmf'; Value: 'application/x-msmetafile'), // do not localize
+ (Key: 'wmz'; Value: 'application/x-msmetafile'), // do not localize
+ (Key: 'emf'; Value: 'application/x-msmetafile'), // do not localize
+ (Key: 'emz'; Value: 'application/x-msmetafile'), // do not localize
+ (Key: 'mny'; Value: 'application/x-msmoney'), // do not localize
+ (Key: 'pub'; Value: 'application/x-mspublisher'), // do not localize
+ (Key: 'scd'; Value: 'application/x-msschedule'), // do not localize
+ (Key: 'trm'; Value: 'application/x-msterminal'), // do not localize
+ (Key: 'wri'; Value: 'application/x-mswrite'), // do not localize
+ (Key: 'nc'; Value: 'application/x-netcdf'), // do not localize
+ (Key: 'cdf'; Value: 'application/x-netcdf'), // do not localize
+ (Key: 'nzb'; Value: 'application/x-nzb'), // do not localize
+ (Key: 'p12'; Value: 'application/x-pkcs12'), // do not localize
+ (Key: 'pfx'; Value: 'application/x-pkcs12'), // do not localize
+ (Key: 'p7b'; Value: 'application/x-pkcs7-certificates'), // do not localize
+ (Key: 'spc'; Value: 'application/x-pkcs7-certificates'), // do not localize
+ (Key: 'p7r'; Value: 'application/x-pkcs7-certreqresp'), // do not localize
+ (Key: 'rar'; Value: 'application/x-rar-compressed'), // do not localize
+ (Key: 'ris'; Value: 'application/x-research-info-systems'), // do not localize
+ (Key: 'sh'; Value: 'application/x-sh'), // do not localize
+ (Key: 'shar'; Value: 'application/x-shar'), // do not localize
+ (Key: 'swf'; Value: 'application/x-shockwave-flash'), // do not localize
+ (Key: 'xap'; Value: 'application/x-silverlight-app'), // do not localize
+ (Key: 'sql'; Value: 'application/x-sql'), // do not localize
+ (Key: 'sit'; Value: 'application/x-stuffit'), // do not localize
+ (Key: 'sitx'; Value: 'application/x-stuffitx'), // do not localize
+ (Key: 'srt'; Value: 'application/x-subrip'), // do not localize
+ (Key: 'sv4cpio'; Value: 'application/x-sv4cpio'), // do not localize
+ (Key: 'sv4crc'; Value: 'application/x-sv4crc'), // do not localize
+ (Key: 't3'; Value: 'application/x-t3vm-image'), // do not localize
+ (Key: 'gam'; Value: 'application/x-tads'), // do not localize
+ (Key: 'tar'; Value: 'application/x-tar'), // do not localize
+ (Key: 'tcl'; Value: 'application/x-tcl'), // do not localize
+ (Key: 'tex'; Value: 'application/x-tex'), // do not localize
+ (Key: 'tfm'; Value: 'application/x-tex-tfm'), // do not localize
+ (Key: 'texinfo'; Value: 'application/x-texinfo'), // do not localize
+ (Key: 'texi'; Value: 'application/x-texinfo'), // do not localize
+ (Key: 'obj'; Value: 'application/x-tgif'), // do not localize
+ (Key: 'ustar'; Value: 'application/x-ustar'), // do not localize
+ (Key: 'src'; Value: 'application/x-wais-source'), // do not localize
+ (Key: 'der'; Value: 'application/x-x509-ca-cert'), // do not localize
+ (Key: 'crt'; Value: 'application/x-x509-ca-cert'), // do not localize
+ (Key: 'fig'; Value: 'application/x-xfig'), // do not localize
+ (Key: 'xlf'; Value: 'application/x-xliff+xml'), // do not localize
+ (Key: 'xpi'; Value: 'application/x-xpinstall'), // do not localize
+ (Key: 'xz'; Value: 'application/x-xz'), // do not localize
+ (Key: 'z1'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z2'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z3'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z4'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z5'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z6'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z7'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'z8'; Value: 'application/x-zmachine'), // do not localize
+ (Key: 'xaml'; Value: 'application/xaml+xml'), // do not localize
+ (Key: 'xdf'; Value: 'application/xcap-diff+xml'), // do not localize
+ (Key: 'xenc'; Value: 'application/xenc+xml'), // do not localize
+ (Key: 'xhtml'; Value: 'application/xhtml+xml'), // do not localize
+ (Key: 'xht'; Value: 'application/xhtml+xml'), // do not localize
+ (Key: 'xml'; Value: 'application/xml'), // do not localize
+ (Key: 'xsl'; Value: 'application/xml'), // do not localize
+ (Key: 'dtd'; Value: 'application/xml-dtd'), // do not localize
+ (Key: 'xop'; Value: 'application/xop+xml'), // do not localize
+ (Key: 'xpl'; Value: 'application/xproc+xml'), // do not localize
+ (Key: 'xslt'; Value: 'application/xslt+xml'), // do not localize
+ (Key: 'xspf'; Value: 'application/xspf+xml'), // do not localize
+ (Key: 'mxml'; Value: 'application/xv+xml'), // do not localize
+ (Key: 'xhvml'; Value: 'application/xv+xml'), // do not localize
+ (Key: 'xvml'; Value: 'application/xv+xml'), // do not localize
+ (Key: 'xvm'; Value: 'application/xv+xml'), // do not localize
+ (Key: 'yang'; Value: 'application/yang'), // do not localize
+ (Key: 'yin'; Value: 'application/yin+xml'), // do not localize
+ (Key: 'zip'; Value: 'application/zip'), // do not localize
+ (Key: 'adp'; Value: 'audio/adpcm'), // do not localize
+ (Key: 'au'; Value: 'audio/basic'), // do not localize
+ (Key: 'snd'; Value: 'audio/basic'), // do not localize
+ (Key: 'mid'; Value: 'audio/midi'), // do not localize
+ (Key: 'midi'; Value: 'audio/midi'), // do not localize
+ (Key: 'kar'; Value: 'audio/midi'), // do not localize
+ (Key: 'rmi'; Value: 'audio/midi'), // do not localize
+ (Key: 'mp4a'; Value: 'audio/mp4'), // do not localize
+ (Key: 'mpga'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'mp2'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'mp2a'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'mp3'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'm2a'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'm3a'; Value: 'audio/mpeg'), // do not localize
+ (Key: 'oga'; Value: 'audio/ogg'), // do not localize
+ (Key: 'ogg'; Value: 'audio/ogg'), // do not localize
+ (Key: 'spx'; Value: 'audio/ogg'), // do not localize
+ (Key: 's3m'; Value: 'audio/s3m'), // do not localize
+ (Key: 'sil'; Value: 'audio/silk'), // do not localize
+ (Key: 'uva'; Value: 'audio/vnd.dece.audio'), // do not localize
+ (Key: 'uvva'; Value: 'audio/vnd.dece.audio'), // do not localize
+ (Key: 'eol'; Value: 'audio/vnd.digital-winds'), // do not localize
+ (Key: 'dra'; Value: 'audio/vnd.dra'), // do not localize
+ (Key: 'dts'; Value: 'audio/vnd.dts'), // do not localize
+ (Key: 'dtshd'; Value: 'audio/vnd.dts.hd'), // do not localize
+ (Key: 'lvp'; Value: 'audio/vnd.lucent.voice'), // do not localize
+ (Key: 'pya'; Value: 'audio/vnd.ms-playready.media.pya'), // do not localize
+ (Key: 'ecelp4800'; Value: 'audio/vnd.nuera.ecelp4800'), // do not localize
+ (Key: 'ecelp7470'; Value: 'audio/vnd.nuera.ecelp7470'), // do not localize
+ (Key: 'ecelp9600'; Value: 'audio/vnd.nuera.ecelp9600'), // do not localize
+ (Key: 'rip'; Value: 'audio/vnd.rip'), // do not localize
+ (Key: 'weba'; Value: 'audio/webm'), // do not localize
+ (Key: 'aac'; Value: 'audio/x-aac'), // do not localize
+ (Key: 'aif'; Value: 'audio/x-aiff'), // do not localize
+ (Key: 'aiff'; Value: 'audio/x-aiff'), // do not localize
+ (Key: 'aifc'; Value: 'audio/x-aiff'), // do not localize
+ (Key: 'caf'; Value: 'audio/x-caf'), // do not localize
+ (Key: 'flac'; Value: 'audio/x-flac'), // do not localize
+ (Key: 'mka'; Value: 'audio/x-matroska'), // do not localize
+ (Key: 'm3u'; Value: 'audio/x-mpegurl'), // do not localize
+ (Key: 'wax'; Value: 'audio/x-ms-wax'), // do not localize
+ (Key: 'wma'; Value: 'audio/x-ms-wma'), // do not localize
+ (Key: 'ram'; Value: 'audio/x-pn-realaudio'), // do not localize
+ (Key: 'ra'; Value: 'audio/x-pn-realaudio'), // do not localize
+ (Key: 'rmp'; Value: 'audio/x-pn-realaudio-plugin'), // do not localize
+ (Key: 'wav'; Value: 'audio/x-wav'), // do not localize
+ (Key: 'xm'; Value: 'audio/xm'), // do not localize
+ (Key: 'cdx'; Value: 'chemical/x-cdx'), // do not localize
+ (Key: 'cif'; Value: 'chemical/x-cif'), // do not localize
+ (Key: 'cmdf'; Value: 'chemical/x-cmdf'), // do not localize
+ (Key: 'cml'; Value: 'chemical/x-cml'), // do not localize
+ (Key: 'csml'; Value: 'chemical/x-csml'), // do not localize
+ (Key: 'xyz'; Value: 'chemical/x-xyz'), // do not localize
+ (Key: 'bmp'; Value: 'image/bmp'), // do not localize
+ (Key: 'cgm'; Value: 'image/cgm'), // do not localize
+ (Key: 'g3'; Value: 'image/g3fax'), // do not localize
+ (Key: 'gif'; Value: 'image/gif'), // do not localize
+ (Key: 'ief'; Value: 'image/ief'), // do not localize
+ (Key: 'jpeg'; Value: 'image/jpeg'), // do not localize
+ (Key: 'jpg'; Value: 'image/jpeg'), // do not localize
+ (Key: 'jpe'; Value: 'image/jpeg'), // do not localize
+ (Key: 'ktx'; Value: 'image/ktx'), // do not localize
+ (Key: 'png'; Value: 'image/png'), // do not localize
+ (Key: 'btif'; Value: 'image/prs.btif'), // do not localize
+ (Key: 'sgi'; Value: 'image/sgi'), // do not localize
+ (Key: 'svg'; Value: 'image/svg+xml'), // do not localize
+ (Key: 'svgz'; Value: 'image/svg+xml'), // do not localize
+ (Key: 'tiff'; Value: 'image/tiff'), // do not localize
+ (Key: 'tif'; Value: 'image/tiff'), // do not localize
+ (Key: 'psd'; Value: 'image/vnd.adobe.photoshop'), // do not localize
+ (Key: 'uvi'; Value: 'image/vnd.dece.graphic'), // do not localize
+ (Key: 'uvvi'; Value: 'image/vnd.dece.graphic'), // do not localize
+ (Key: 'uvg'; Value: 'image/vnd.dece.graphic'), // do not localize
+ (Key: 'uvvg'; Value: 'image/vnd.dece.graphic'), // do not localize
+ (Key: 'sub'; Value: 'image/vnd.dvb.subtitle'), // do not localize
+ (Key: 'djvu'; Value: 'image/vnd.djvu'), // do not localize
+ (Key: 'djv'; Value: 'image/vnd.djvu'), // do not localize
+ (Key: 'dwg'; Value: 'image/vnd.dwg'), // do not localize
+ (Key: 'dxf'; Value: 'image/vnd.dxf'), // do not localize
+ (Key: 'fbs'; Value: 'image/vnd.fastbidsheet'), // do not localize
+ (Key: 'fpx'; Value: 'image/vnd.fpx'), // do not localize
+ (Key: 'fst'; Value: 'image/vnd.fst'), // do not localize
+ (Key: 'mmr'; Value: 'image/vnd.fujixerox.edmics-mmr'), // do not localize
+ (Key: 'rlc'; Value: 'image/vnd.fujixerox.edmics-rlc'), // do not localize
+ (Key: 'mdi'; Value: 'image/vnd.ms-modi'), // do not localize
+ (Key: 'wdp'; Value: 'image/vnd.ms-photo'), // do not localize
+ (Key: 'npx'; Value: 'image/vnd.net-fpx'), // do not localize
+ (Key: 'wbmp'; Value: 'image/vnd.wap.wbmp'), // do not localize
+ (Key: 'xif'; Value: 'image/vnd.xiff'), // do not localize
+ (Key: 'webp'; Value: 'image/webp'), // do not localize
+ (Key: '3ds'; Value: 'image/x-3ds'), // do not localize
+ (Key: 'ras'; Value: 'image/x-cmu-raster'), // do not localize
+ (Key: 'cmx'; Value: 'image/x-cmx'), // do not localize
+ (Key: 'fh'; Value: 'image/x-freehand'), // do not localize
+ (Key: 'fhc'; Value: 'image/x-freehand'), // do not localize
+ (Key: 'fh4'; Value: 'image/x-freehand'), // do not localize
+ (Key: 'fh5'; Value: 'image/x-freehand'), // do not localize
+ (Key: 'fh7'; Value: 'image/x-freehand'), // do not localize
+ (Key: 'ico'; Value: 'image/x-icon'), // do not localize
+ (Key: 'sid'; Value: 'image/x-mrsid-image'), // do not localize
+ (Key: 'pcx'; Value: 'image/x-pcx'), // do not localize
+ (Key: 'pic'; Value: 'image/x-pict'), // do not localize
+ (Key: 'pct'; Value: 'image/x-pict'), // do not localize
+ (Key: 'pnm'; Value: 'image/x-portable-anymap'), // do not localize
+ (Key: 'pbm'; Value: 'image/x-portable-bitmap'), // do not localize
+ (Key: 'pgm'; Value: 'image/x-portable-graymap'), // do not localize
+ (Key: 'ppm'; Value: 'image/x-portable-pixmap'), // do not localize
+ (Key: 'rgb'; Value: 'image/x-rgb'), // do not localize
+ (Key: 'tga'; Value: 'image/x-tga'), // do not localize
+ (Key: 'xbm'; Value: 'image/x-xbitmap'), // do not localize
+ (Key: 'xpm'; Value: 'image/x-xpixmap'), // do not localize
+ (Key: 'xwd'; Value: 'image/x-xwindowdump'), // do not localize
+ (Key: 'eml'; Value: 'message/rfc822'), // do not localize
+ (Key: 'mime'; Value: 'message/rfc822'), // do not localize
+ (Key: 'igs'; Value: 'model/iges'), // do not localize
+ (Key: 'iges'; Value: 'model/iges'), // do not localize
+ (Key: 'msh'; Value: 'model/mesh'), // do not localize
+ (Key: 'mesh'; Value: 'model/mesh'), // do not localize
+ (Key: 'silo'; Value: 'model/mesh'), // do not localize
+ (Key: 'dae'; Value: 'model/vnd.collada+xml'), // do not localize
+ (Key: 'dwf'; Value: 'model/vnd.dwf'), // do not localize
+ (Key: 'gdl'; Value: 'model/vnd.gdl'), // do not localize
+ (Key: 'gtw'; Value: 'model/vnd.gtw'), // do not localize
+ (Key: 'mts'; Value: 'model/vnd.mts'), // do not localize
+ (Key: 'vtu'; Value: 'model/vnd.vtu'), // do not localize
+ (Key: 'wrl'; Value: 'model/vrml'), // do not localize
+ (Key: 'vrml'; Value: 'model/vrml'), // do not localize
+ (Key: 'x3db'; Value: 'model/x3d+binary'), // do not localize
+ (Key: 'x3dbz'; Value: 'model/x3d+binary'), // do not localize
+ (Key: 'x3dv'; Value: 'model/x3d+vrml'), // do not localize
+ (Key: 'x3dvz'; Value: 'model/x3d+vrml'), // do not localize
+ (Key: 'x3d'; Value: 'model/x3d+xml'), // do not localize
+ (Key: 'x3dz'; Value: 'model/x3d+xml'), // do not localize
+ (Key: 'appcache'; Value: 'text/cache-manifest'), // do not localize
+ (Key: 'ics'; Value: 'text/calendar'), // do not localize
+ (Key: 'ifb'; Value: 'text/calendar'), // do not localize
+ (Key: 'css'; Value: 'text/css'), // do not localize
+ (Key: 'csv'; Value: 'text/csv'), // do not localize
+ (Key: 'html'; Value: 'text/html'), // do not localize
+ (Key: 'htm'; Value: 'text/html'), // do not localize
+ (Key: 'n3'; Value: 'text/n3'), // do not localize
+ (Key: 'txt'; Value: 'text/plain'), // do not localize
+ (Key: 'text'; Value: 'text/plain'), // do not localize
+ (Key: 'conf'; Value: 'text/plain'), // do not localize
+ (Key: 'def'; Value: 'text/plain'), // do not localize
+ (Key: 'list'; Value: 'text/plain'), // do not localize
+ (Key: 'log'; Value: 'text/plain'), // do not localize
+ (Key: 'in'; Value: 'text/plain'), // do not localize
+ (Key: 'dsc'; Value: 'text/prs.lines.tag'), // do not localize
+ (Key: 'rtx'; Value: 'text/richtext'), // do not localize
+ (Key: 'sgml'; Value: 'text/sgml'), // do not localize
+ (Key: 'sgm'; Value: 'text/sgml'), // do not localize
+ (Key: 'tsv'; Value: 'text/tab-separated-values'), // do not localize
+ (Key: 't'; Value: 'text/troff'), // do not localize
+ (Key: 'tr'; Value: 'text/troff'), // do not localize
+ (Key: 'roff'; Value: 'text/troff'), // do not localize
+ (Key: 'man'; Value: 'text/troff'), // do not localize
+ (Key: 'me'; Value: 'text/troff'), // do not localize
+ (Key: 'ms'; Value: 'text/troff'), // do not localize
+ (Key: 'ttl'; Value: 'text/turtle'), // do not localize
+ (Key: 'uri'; Value: 'text/uri-list'), // do not localize
+ (Key: 'uris'; Value: 'text/uri-list'), // do not localize
+ (Key: 'urls'; Value: 'text/uri-list'), // do not localize
+ (Key: 'vcard'; Value: 'text/vcard'), // do not localize
+ (Key: 'curl'; Value: 'text/vnd.curl'), // do not localize
+ (Key: 'dcurl'; Value: 'text/vnd.curl.dcurl'), // do not localize
+ (Key: 'scurl'; Value: 'text/vnd.curl.scurl'), // do not localize
+ (Key: 'mcurl'; Value: 'text/vnd.curl.mcurl'), // do not localize
+ (Key: 'sub'; Value: 'text/vnd.dvb.subtitle'), // do not localize
+ (Key: 'fly'; Value: 'text/vnd.fly'), // do not localize
+ (Key: 'flx'; Value: 'text/vnd.fmi.flexstor'), // do not localize
+ (Key: 'gv'; Value: 'text/vnd.graphviz'), // do not localize
+ (Key: '3dml'; Value: 'text/vnd.in3d.3dml'), // do not localize
+ (Key: 'spot'; Value: 'text/vnd.in3d.spot'), // do not localize
+ (Key: 'jad'; Value: 'text/vnd.sun.j2me.app-descriptor'), // do not localize
+ (Key: 'wml'; Value: 'text/vnd.wap.wml'), // do not localize
+ (Key: 'wmls'; Value: 'text/vnd.wap.wmlscript'), // do not localize
+ (Key: 's'; Value: 'text/x-asm'), // do not localize
+ (Key: 'asm'; Value: 'text/x-asm'), // do not localize
+ (Key: 'c'; Value: 'text/x-c'), // do not localize
+ (Key: 'cc'; Value: 'text/x-c'), // do not localize
+ (Key: 'cxx'; Value: 'text/x-c'), // do not localize
+ (Key: 'cpp'; Value: 'text/x-c'), // do not localize
+ (Key: 'h'; Value: 'text/x-c'), // do not localize
+ (Key: 'hh'; Value: 'text/x-c'), // do not localize
+ (Key: 'dic'; Value: 'text/x-c'), // do not localize
+ (Key: 'f'; Value: 'text/x-fortran'), // do not localize
+ (Key: 'for'; Value: 'text/x-fortran'), // do not localize
+ (Key: 'f77'; Value: 'text/x-fortran'), // do not localize
+ (Key: 'f90'; Value: 'text/x-fortran'), // do not localize
+ (Key: 'java'; Value: 'text/x-java-source'), // do not localize
+ (Key: 'opml'; Value: 'text/x-opml'), // do not localize
+ (Key: 'p'; Value: 'text/x-pascal'), // do not localize
+ (Key: 'pas'; Value: 'text/x-pascal'), // do not localize
+ (Key: 'nfo'; Value: 'text/x-nfo'), // do not localize
+ (Key: 'etx'; Value: 'text/x-setext'), // do not localize
+ (Key: 'sfv'; Value: 'text/x-sfv'), // do not localize
+ (Key: 'uu'; Value: 'text/x-uuencode'), // do not localize
+ (Key: 'vcs'; Value: 'text/x-vcalendar'), // do not localize
+ (Key: 'vcf'; Value: 'text/x-vcard'), // do not localize
+ (Key: '3gp'; Value: 'video/3gpp'), // do not localize
+ (Key: '3g2'; Value: 'video/3gpp2'), // do not localize
+ (Key: 'h261'; Value: 'video/h261'), // do not localize
+ (Key: 'h263'; Value: 'video/h263'), // do not localize
+ (Key: 'h264'; Value: 'video/h264'), // do not localize
+ (Key: 'jpgv'; Value: 'video/jpeg'), // do not localize
+ (Key: 'jpm'; Value: 'video/jpm'), // do not localize
+ (Key: 'jpgm'; Value: 'video/jpm'), // do not localize
+ (Key: 'mj2'; Value: 'video/mj2'), // do not localize
+ (Key: 'mjp2'; Value: 'video/mj2'), // do not localize
+ (Key: 'mp4'; Value: 'video/mp4'), // do not localize
+ (Key: 'mp4v'; Value: 'video/mp4'), // do not localize
+ (Key: 'mpg4'; Value: 'video/mp4'), // do not localize
+ (Key: 'mpeg'; Value: 'video/mpeg'), // do not localize
+ (Key: 'mpg'; Value: 'video/mpeg'), // do not localize
+ (Key: 'mpe'; Value: 'video/mpeg'), // do not localize
+ (Key: 'm1v'; Value: 'video/mpeg'), // do not localize
+ (Key: 'm2v'; Value: 'video/mpeg'), // do not localize
+ (Key: 'ogv'; Value: 'video/ogg'), // do not localize
+ (Key: 'qt'; Value: 'video/quicktime'), // do not localize
+ (Key: 'mov'; Value: 'video/quicktime'), // do not localize
+ (Key: 'uvh'; Value: 'video/vnd.dece.hd'), // do not localize
+ (Key: 'uvvh'; Value: 'video/vnd.dece.hd'), // do not localize
+ (Key: 'uvm'; Value: 'video/vnd.dece.mobile'), // do not localize
+ (Key: 'uvvm'; Value: 'video/vnd.dece.mobile'), // do not localize
+ (Key: 'uvp'; Value: 'video/vnd.dece.pd'), // do not localize
+ (Key: 'uvvp'; Value: 'video/vnd.dece.pd'), // do not localize
+ (Key: 'uvs'; Value: 'video/vnd.dece.sd'), // do not localize
+ (Key: 'uvvs'; Value: 'video/vnd.dece.sd'), // do not localize
+ (Key: 'uvv'; Value: 'video/vnd.dece.video'), // do not localize
+ (Key: 'uvvv'; Value: 'video/vnd.dece.video'), // do not localize
+ (Key: 'dvb'; Value: 'video/vnd.dvb.file'), // do not localize
+ (Key: 'fvt'; Value: 'video/vnd.fvt'), // do not localize
+ (Key: 'mxu'; Value: 'video/vnd.mpegurl'), // do not localize
+ (Key: 'm4u'; Value: 'video/vnd.mpegurl'), // do not localize
+ (Key: 'pyv'; Value: 'video/vnd.ms-playready.media.pyv'), // do not localize
+ (Key: 'uvu'; Value: 'video/vnd.uvvu.mp4'), // do not localize
+ (Key: 'uvvu'; Value: 'video/vnd.uvvu.mp4'), // do not localize
+ (Key: 'viv'; Value: 'video/vnd.vivo'), // do not localize
+ (Key: 'webm'; Value: 'video/webm'), // do not localize
+ (Key: 'f4v'; Value: 'video/x-f4v'), // do not localize
+ (Key: 'fli'; Value: 'video/x-fli'), // do not localize
+ (Key: 'flv'; Value: 'video/x-flv'), // do not localize
+ (Key: 'm4v'; Value: 'video/x-m4v'), // do not localize
+ (Key: 'mkv'; Value: 'video/x-matroska'), // do not localize
+ (Key: 'mk3d'; Value: 'video/x-matroska'), // do not localize
+ (Key: 'mks'; Value: 'video/x-matroska'), // do not localize
+ (Key: 'mng'; Value: 'video/x-mng'), // do not localize
+ (Key: 'asf'; Value: 'video/x-ms-asf'), // do not localize
+ (Key: 'asx'; Value: 'video/x-ms-asf'), // do not localize
+ (Key: 'vob'; Value: 'video/x-ms-vob'), // do not localize
+ (Key: 'wm'; Value: 'video/x-ms-wm'), // do not localize
+ (Key: 'wmv'; Value: 'video/x-ms-wmv'), // do not localize
+ (Key: 'wmx'; Value: 'video/x-ms-wmx'), // do not localize
+ (Key: 'wvx'; Value: 'video/x-ms-wvx'), // do not localize
+ (Key: 'avi'; Value: 'video/x-msvideo'), // do not localize
+ (Key: 'movie'; Value: 'video/x-sgi-movie'), // do not localize
+ (Key: 'smv'; Value: 'video/x-smv'), // do not localize
+ (Key: 'ice'; Value: 'x-conference/x-cooltalk'), // do not localize
+ (Key: 'wasm'; Value: 'application/wasm') // do not localize
+ );
+ {$ENDREGION}
+
+type
+ THttpMethod = class
+ public const
+ GET = 'GET';
+ POST = 'POST';
+ PUT = 'PUT';
+ DELETE = 'DELETE';
+ HEAD = 'HEAD';
+ OPTIONS = 'OPTIONS';
+ TRACE = 'TRACE';
+ CONNECT = 'CONNECT';
+ PROPFIND = 'PROPFIND';
+ LOCK = 'LOCK';
+ UNLOCK = 'UNLOCK';
+ COPY = 'COPY';
+ MOVE = 'MOVE';
+ MKCOL = 'MKCOL';
+ end;
+
+ {$REGION 'Documentation'}
+ ///
+ /// 常用媒体类型
+ ///
+ {$ENDREGION}
+ TMediaType = class
+ public const
+ DELIM_PARAMS = '; ';
+ CHARSET_NAME = 'charset';
+ CHARSET_UTF8 = 'UTF-8';
+ CHARSET_UTF8_DEF = CHARSET_NAME + '=' + CHARSET_UTF8;
+
+ TEXT_PLAIN = 'text/plain';
+ TEXT_PLAIN_UTF8 = TEXT_PLAIN + DELIM_PARAMS + CHARSET_UTF8_DEF;
+
+ TEXT_XML = 'text/xml';
+ TEXT_XML_UTF8 = TEXT_XML + DELIM_PARAMS + CHARSET_UTF8_DEF;
+
+ TEXT_HTML = 'text/html';
+ TEXT_HTML_UTF8 = TEXT_HTML + DELIM_PARAMS + CHARSET_UTF8_DEF;
+
+ APPLICATION_JSON = 'application/json';
+ APPLICATION_JSON_UTF8 = APPLICATION_JSON + DELIM_PARAMS + CHARSET_UTF8_DEF;
+
+ APPLICATION_XML = 'application/xml';
+ APPLICATION_XML_UTF8 = APPLICATION_XML + DELIM_PARAMS + CHARSET_UTF8_DEF;
+
+ APPLICATION_OCTET_STREAM = 'application/octet-stream';
+ APPLICATION_FORM_URLENCODED_TYPE = 'application/x-www-form-urlencoded';
+
+ MULTIPART_FORM_DATA = 'multipart/form-data';
+ MULTIPART_FORM_DATA_BOUNDARY = MULTIPART_FORM_DATA + DELIM_PARAMS + 'boundary=';
+
+ WILDCARD = '*/*';
+ end;
+
+ TCrossHttpUtils = class
+ private const
+ RFC1123_StrWeekDay: string = 'MonTueWedThuFriSatSun';
+ RFC1123_StrMonth : string = 'JanFebMarAprMayJunJulAugSepOctNovDec';
+ public
+ class function GetHttpStatusText(const AStatusCode: Integer): string; static;
+ class function GetFileMIMEType(const AFileName: string): string; static;
+ class function RFC1123_DateToStr(const ADate: TDateTime): string; static; inline;
+ class function RFC1123_StrToDate(const ADateStr: string): TDateTime; static;
+
+ class function ExtractUrl(const AUrl: string; out AProtocol, AHost: string;
+ out APort: Word; out APath: string): Boolean; static;
+ class function CreateUrl(const AProtocol, AHost: string;
+ const APort: Word; const APath: string): string; static;
+
+ class function CombinePath(const APath1, APath2: string; const APathDelim: Char = '/'): string; static;
+ class function IsSamePath(const APath1, APath2: string): Boolean; static;
+
+ class function GetPathWithoutParams(const APath: string): string; static;
+
+ ///
+ /// 尝试解析本地路径，确保路径安全性
+ ///
+ ///
+ /// 本地基础目录
+ ///
+ ///
+ /// 要解析的相对路径
+ ///
+ ///
+ /// 解析后的完整路径
+ ///
+ ///
+ /// 如果路径有效且在基础目录内返回True，否则返回False
+ ///
+ ///
+ /// 此函数会验证路径的安全性，防止路径遍历攻击
+ ///
+ class function TryUrlPathToLocalPath(const ALocalBaseDir, AUrlPath: string;
+ out AResolvedPath: string): Boolean; static;
+
+ class function HtmlEncode(const AInput: string): string; static;
+ class function HtmlDecode(const AInput: string): string; static;
+
+ ///
+ /// URL percent-encoding (RFC 3986 §2.1)
+ ///
+ ///
+ /// 待编码字符串(支持 unicode, 内部统一按 UTF-8 字节流处理)
+ ///
+ ///
+ /// 附加的"无需编码"字符集. 默认仅按 RFC 3986 unreserved 集
+ /// (ALPHA / DIGIT / "-" / "." / "_" / "~") 不编码, 其他字符全部 percent-encode.
+ /// 调用方可据 URI 组件传入合理子集, 如 path 段内可保留 ['/', ':', '@'].
+ ///
+ ///
+ /// 是否将输入按"已含 percent-encoded 序列的 URI 组件"对待 (Normalizer 语义).
+ /// - False (默认, Encoder 语义): 输入视作原始数据, '%' 字符按字面编码为 '%25'.
+ /// 适用于参数值/表单字段等"原始字节"场景. 与 RFC 3986 §2.1 Encoder 语义、
+ /// 主流库 (Go QueryEscape / Python quote / Java URLEncoder) 默认行为一致.
+ /// - True (Normalizer 语义): 遇到 '%' + 2 hex 数字时保留 3 字符不再编码,
+ /// 避免二次编码 (RFC 3986 §2.4 "MUST NOT encode the same string more than once").
+ /// 适用于"用户传入的 URL 片段可能已部分编码"场景, 类似 Python requote_uri.
+ ///
+ class function UrlEncode(const S: string; const ANoConversion: TSysCharSet = [];
+ const APreserveEncoded: Boolean = False): string; static;
+ class function UrlDecode(const S: string): string; static;
+
+ // Delphi 12+ 编译器将NativeInt与Integer(目标32位)和Int64(目标64位)等同
+ {$IF DEFINED(DELPHI) AND (CompilerVersion < 36)}
+ class procedure AdjustOffsetCount(const ABodySize: NativeInt; var AOffset, ACount: NativeInt); overload; static;
+ {$ENDIF}
+ class procedure AdjustOffsetCount(const ABodySize: Integer; var AOffset, ACount: Integer); overload; static;
+ class procedure AdjustOffsetCount(const ABodySize: Int64; var AOffset, ACount: Int64); overload; static;
+
+ ///
+ /// 严格解析 HTTP Range 请求头中的单一 byte-range (RFC 7233 §2.1, §3.1).
+ ///
+ ///
+ /// 原始 Range 头, 如 "bytes=0-499" / "bytes=500-" / "bytes=-200".
+ ///
+ ///
+ /// 资源完整长度, 必须 > 0.
+ ///
+ ///
+ /// 解析成功时, 输出区间起点 (含, 0-based).
+ ///
+ ///
+ /// 解析成功时, 输出区间终点 (含, 0-based, < AContentLength).
+ ///
+ ///
+ /// True: 区间合法且可满足, AStart/AEnd 已正确设置.
+ /// False: 缺前缀 / 多 range / 非法数字 / 不可满足 (start > end / start >= size /
+ /// suffix=0). 调用方应返回 416 + "Content-Range: bytes */size".
+ ///
+ ///
+ /// 不支持 multipart/byteranges (含 ',' 一律拒绝), 与 Nginx/Apache 在小文件上的常见策略一致.
+ ///
+ class function ParseSingleByteRange(const ARangeHeader: string;
+ const AContentLength: Int64; out AStart, AEnd: Int64): Boolean; static;
+
+ ///
+ /// 校验 HTTP header field-value 是否安全, 不允许出现 CR/LF (RFC 7230 §3.2.4).
+ ///
+ ///
+ /// 主要用于防御响应拆分 (HTTP Response Splitting) 攻击: 若业务把含 CR/LF 的用户输入
+ /// 写入响应 header, 可能被攻击者注入伪造响应行或 header.
+ ///
+ class function IsValidHeaderValue(const AValue: string): Boolean; static;
+
+ ///
+ /// 校验 HTTP header field-name 是否符合 RFC 7230 token 字符集.
+ ///
+ class function IsValidHeaderName(const AName: string): Boolean; static;
+
+ ///
+ /// 单字符版本: 判断字符是否属于 RFC 7230 §3.2.6 token 字符集.
+ ///
+ ///
+ /// token = ALPHA / DIGIT / "!" "#" "$" "%" "&" "'" "*" "+" "-" "." "^" "_" "`" "|" "~"
+ /// 提供给逐字节扫描场景 (如 THttpHeader.Decode 单趟状态机) 复用规则, 避免重复定义.
+ ///
+ class function IsTokenChar(ACh: Char): Boolean; static; inline;
+
+ ///
+ /// 单字符版本: 判断字符是否是合法的 HTTP header field-value 字符.
+ ///
+ ///
+ /// 合法: HTAB(#9) / 可见 ASCII ($20..$7E) / $80+ 高位字符 (历史宽松, 兼容 UTF-8).
+ /// 非法: NUL/CR/LF 等其他 CTL ($00..$08, $0A..$1F) 与 DEL ($7F).
+ /// 提供给逐字节扫描场景复用规则, 避免重复定义.
+ ///
+ class function IsHeaderValueChar(ACh: Char): Boolean; static; inline;
+ end;
+
+implementation
+
+{ TCrossHttpUtils }
+
+class function TCrossHttpUtils.GetHttpStatusText(const AStatusCode: Integer): string;
+var
+ LStatusItem: THttpStatus;
+begin
+ for LStatusItem in STATUS_CODES do
+ if (LStatusItem.Code = AStatusCode) then Exit(LStatusItem.Text);
+ Result := AStatusCode.ToString;
+end;
+
+class function TCrossHttpUtils.GetPathWithoutParams(
+ const APath: string): string;
+var
+ LIndex: Integer;
+begin
+ LIndex := APath.IndexOf('?');
+ if (LIndex >= 0) then
+ Result := APath.Substring(0, LIndex)
+ else
+ Result := APath;
+end;
+
+class function TCrossHttpUtils.HtmlDecode(const AInput: string): string;
+var
+ LSp, LRp, LCp, LTp: PChar;
+ LStr: string;
+ I, LCode: Integer;
+ LValid: Boolean;
+begin
+ if (AInput = '') then Exit('');
+
+ SetLength(Result, Length(AInput));
+ LSp := PChar(AInput);
+ LRp := PChar(Result);
+ while LSp^ <> #0 do
+ begin
+ case LSp^ of
+ '&':
+ begin
+ LCp := LSp;
+ Inc(LSp);
+ LValid := False;
+ case LSp^ of
+ 'a':
+ if StrLComp(LSp, 'amp;', 4) = 0 then { do not localize }
+ begin
+ Inc(LSp, 3);
+ LRp^ := '&';
+ LValid := True;
+ end
+ else if StrLComp(LSp, 'apos;', 5) = 0 then { do not localize }
+ begin
+ Inc(LSp, 4);
+ LRp^ := '''';
+ LValid := True;
+ end;
+ 'l':
+ if StrLComp(LSp, 'lt;', 3) = 0 then { do not localize }
+ begin
+ Inc(LSp, 2);
+ LRp^ := '<';
+ LValid := True;
+ end;
+ 'g':
+ if StrLComp(LSp, 'gt;', 3) = 0 then { do not localize }
+ begin
+ Inc(LSp, 2);
+ LRp^ := '>';
+ LValid := True;
+ end;
+ 'q':
+ if StrLComp(LSp, 'quot;', 5) = 0 then { do not localize }
+ begin
+ Inc(LSp, 4);
+ LRp^ := '"';
+ LValid := True;
+ end;
+ '#':
+ begin
+ LTp := LSp;
+ Inc(LTp);
+ while (LSp^ <> ';') and (LSp^ <> #0) do
+ Inc(LSp);
+ SetString(LStr, LTp, LSp - LTp);
+ Val(LStr, I, LCode);
+ if LCode = 0 then
+ begin
+ if I >= $10000 then
+ begin
+ // DoDecode surrogate pair
+ LRp^ := Char(((I - $10000) div $400) + $D800);
+ Inc(LRp);
+ LRp^ := Char(((I - $10000) and $3FF) + $DC00);
+ end
+ else
+ LRp^ := Chr((I));
+ LValid := True;
+ end
+ else
+ LSp := LTp - 1;
+ end;
+ end;
+ if not LValid then
+ begin
+ LSp := LCp;
+ LRp^ := LSp^;
+ end;
+ end
+ else
+ LRp^ := LSp^;
+ end;
+ Inc(LRp);
+ Inc(LSp);
+ end;
+ SetLength(Result, LRp - PChar(Result));
+end;
+
+class function TCrossHttpUtils.HtmlEncode(const AInput: string): string;
+var
+ LSp, LRp: PChar;
+begin
+ if (AInput = '') then Exit('');
+
+ SetLength(Result, Length(AInput) * 10);
+ LSp := PChar(AInput);
+ LRp := PChar(Result);
+ // Convert: &, <, >, "
+ while LSp^ <> #0 do
+ begin
+ case LSp^ of
+ '&':
+ begin
+ StrMove(LRp, '&', 5);
+ Inc(LRp, 5);
+ end;
+ '<':
+ begin
+ StrMove(LRp, '<', 4);
+ Inc(LRp, 4);
+ end;
+ '>':
+ begin
+ StrMove(LRp, '>', 4);
+ Inc(LRp, 4);
+ end;
+ '"':
+ begin
+ StrMove(LRp, '"', 6);
+ Inc(LRp, 6);
+ end;
+ else
+ begin
+ LRp^ := LSp^;
+ Inc(LRp);
+ end;
+ end;
+ Inc(LSp);
+ end;
+ SetLength(Result, LRp - PChar(Result));
+end;
+
+class function TCrossHttpUtils.IsSamePath(const APath1,
+ APath2: string): Boolean;
+begin
+ if (Length(APath1) >= Length(APath2)) then
+ Result := (Pos(APath2, APath1) = 1)
+ else
+ Result := (Pos(APath1, APath2) = 1);
+end;
+
+{$IF DEFINED(DELPHI) AND (CompilerVersion < 36)}
+class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: NativeInt;
+ var AOffset, ACount: NativeInt);
+begin
+ {$region '修正 AOffset'}
+ // 偏移为正数, 从头部开始计算偏移
+ if (AOffset >= 0) then
+ begin
+ AOffset := AOffset;
+ if (AOffset >= ABodySize) then
+ AOffset := ABodySize - 1;
+ end else
+ // 偏移为负数, 从尾部开始计算偏移
+ begin
+ AOffset := ABodySize + AOffset;
+ if (AOffset < 0) then
+ AOffset := 0;
+ end;
+ {$endregion}
+
+ {$region '修正 ACount'}
+ // ACount<=0表示需要处理所有数据
+ if (ACount <= 0) then
+ ACount := ABodySize;
+
+ if (ABodySize - AOffset < ACount) then
+ ACount := ABodySize - AOffset;
+ {$endregion}
+end;
+{$ENDIF}
+
+class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: Integer;
+ var AOffset, ACount: Integer);
+begin
+ {$region '修正 AOffset'}
+ // 偏移为正数, 从头部开始计算偏移
+ if (AOffset >= 0) then
+ begin
+ AOffset := AOffset;
+ if (AOffset >= ABodySize) then
+ AOffset := ABodySize - 1;
+ end else
+ // 偏移为负数, 从尾部开始计算偏移
+ begin
+ AOffset := ABodySize + AOffset;
+ if (AOffset < 0) then
+ AOffset := 0;
+ end;
+ {$endregion}
+
+ {$region '修正 ACount'}
+ // ACount<=0表示需要处理所有数据
+ if (ACount <= 0) then
+ ACount := ABodySize;
+
+ if (ABodySize - AOffset < ACount) then
+ ACount := ABodySize - AOffset;
+ {$endregion}
+end;
+
+class procedure TCrossHttpUtils.AdjustOffsetCount(const ABodySize: Int64;
+ var AOffset, ACount: Int64);
+begin
+ {$region '修正 AOffset'}
+ // 偏移为正数, 从头部开始计算偏移
+ if (AOffset >= 0) then
+ begin
+ AOffset := AOffset;
+ if (AOffset >= ABodySize) then
+ AOffset := ABodySize - 1;
+ end else
+ // 偏移为负数, 从尾部开始计算偏移
+ begin
+ AOffset := ABodySize + AOffset;
+ if (AOffset < 0) then
+ AOffset := 0;
+ end;
+ {$endregion}
+
+ {$region '修正 ACount'}
+ // ACount<=0表示需要处理所有数据
+ if (ACount <= 0) then
+ ACount := ABodySize;
+
+ if (ABodySize - AOffset < ACount) then
+ ACount := ABodySize - AOffset;
+ {$endregion}
+end;
+
+class function TCrossHttpUtils.CombinePath(const APath1,
+ APath2: string; const APathDelim: Char): string;
+begin
+ Result := TPathUtils.Combine(APath1, APath2, APathDelim);
+end;
+
+class function TCrossHttpUtils.CreateUrl(const AProtocol, AHost: string;
+ const APort: Word; const APath: string): string;
+var
+ LPath: string;
+begin
+ if (APath = '') then
+ LPath := '/'
+ else if (APath[1] = '/') then
+ LPath := APath
+ else
+ LPath := '/' + APath;
+
+ Result := Format('%s://%s', [AProtocol, AHost]);
+
+ if (SameText(AProtocol, HTTP) and (APort = HTTP_DEFAULT_PORT))
+ or (SameText(AProtocol, HTTPS) and (APort = HTTPS_DEFAULT_PORT)) then
+ Result := Result + LPath
+ else
+ Result := Result + Format(':%d%s', [APort, LPath]);
+end;
+
+class function TCrossHttpUtils.ExtractUrl(const AUrl: string; out AProtocol,
+ AHost: string; out APort: Word; out APath: string): Boolean;
+var
+ LProtocolIndex, LIPv6Index, LPortIndex, LPathIndex, LQueryIndex, LPort: Integer;
+ LPortStr: string;
+begin
+ // http://www.test.com/abc
+ // http://www.test.com:8080/abc
+ // https://www.test.com/abc
+ // https://www.test.com:8080/abc
+ // www.test.com:8080/abc
+ // www.test.com/abc
+ // www.test.com
+ // http://[aabb::20:80:5:2]:8080/abc
+ // [aabb::20:80:5:2]
+
+ Result := False;
+
+ // 找 :// 定位协议类型
+ LProtocolIndex := AUrl.IndexOf('://');
+ if (LProtocolIndex >= 0) then
+ begin
+ // 提取协议类型
+ AProtocol := AUrl.Substring(0, LProtocolIndex).Trim;
+ Inc(LProtocolIndex, 3);
+ end else
+ begin
+ // 默认协议 http
+ AProtocol := HTTP;
+ LProtocolIndex := 0;
+ end;
+
+ // 找 ] 定位IPv6地址
+ LIPv6Index := AUrl.IndexOf(']', LProtocolIndex);
+
+ if (LIPv6Index >= 0) then
+ begin
+ // 找 : 定位端口
+ LPortIndex := AUrl.IndexOf(':', LIPv6Index + 1);
+
+ // 找 / 定位路径
+ LPathIndex := AUrl.IndexOf('/', LIPv6Index + 1);
+
+ // 避免在参数部分出现 : 被当成端口定位
+ if (LPathIndex >= 0) and (LPortIndex > LPathIndex) then
+ LPortIndex := -1;
+
+ // 找 ? 定位参数
+ LQueryIndex := AUrl.IndexOf('?', LIPv6Index + 1);
+ end else
+ begin
+ // 找 : 定位端口
+ LPortIndex := AUrl.IndexOf(':', LProtocolIndex);
+
+ // 找 / 定位路径
+ LPathIndex := AUrl.IndexOf('/', LProtocolIndex);
+
+ // 避免在参数部分出现 : 被当成端口定位
+ if (LPathIndex >= 0) and (LPortIndex > LPathIndex) then
+ LPortIndex := -1;
+
+ // 找 ? 定位参数
+ LQueryIndex := AUrl.IndexOf('?', LProtocolIndex);
+ end;
+
+ if (LPathIndex < 0) then
+ begin
+ if (LQueryIndex >= 0) then
+ LPathIndex := LQueryIndex
+ else
+ LPathIndex := Length(AUrl);
+ end;
+
+ if (LPortIndex >= 0) then
+ begin
+ // 提取主机地址
+ AHost := AUrl.Substring(LProtocolIndex, LPortIndex - LProtocolIndex);
+
+ // 提取主机端口
+ LPortStr := AUrl.Substring(LPortIndex + 1, LPathIndex - LPortIndex - 1);
+ if not TryStrToInt(LPortStr, LPort) then Exit;
+
+ APort := LPort;
+ end else
+ begin
+ // 提取主机地址
+ AHost := AUrl.Substring(LProtocolIndex, LPathIndex - LProtocolIndex);
+
+ // 根据协议类型决定默认端口
+ if TStrUtils.SameText(AProtocol, HTTPS)
+ or TStrUtils.SameText(AProtocol, WSS) then
+ APort := HTTPS_DEFAULT_PORT
+ else
+ APort := HTTP_DEFAULT_PORT;
+ end;
+
+ // 提取路径
+ APath := AUrl.Substring(LPathIndex, MaxInt);
+ if (APath = '') then
+ APath := '/'
+ else if (APath[1] <> '/') then
+ APath := '/' + APath;
+
+ Result := (AHost <> '');
+end;
+
+class function TCrossHttpUtils.GetFileMIMEType(const AFileName: string): string;
+var
+ LExt: string;
+ LMimeItem: TMimeValue;
+begin
+ LExt := ExtractFileExt(AFileName).Substring(1);
+ for LMimeItem in MIME_TYPES do
+ if TStrUtils.SameText(LMimeItem.Key, LExt) then
+ Exit(LMimeItem.Value);
+ Result := TMediaType.APPLICATION_OCTET_STREAM;
+end;
+
+class function TCrossHttpUtils.RFC1123_DateToStr(const ADate: TDateTime): string;
+begin
+ // Fri, 30 Jul 2024 10:10:35 GMT
+ Result := ADate.ToRFC1123(True);
+end;
+
+class function TCrossHttpUtils.RFC1123_StrToDate(const ADateStr: string) : TDateTime;
+var
+ LYear, LMonth, LDay: Word;
+ LHour, LMin, LSec: Word;
+begin
+ // Fri, 30 Jul 2024 10:10:35 GMT
+ if (Length(ADateStr) = 29) then
+ begin
+ LDay := StrToIntDef(Copy(ADateStr, 6, 2), 0);
+ LMonth := (Pos(Copy(ADateStr, 9, 3), RFC1123_StrMonth) + 2) div 3;
+ LYear := StrToIntDef(Copy(ADateStr, 13, 4), 0);
+ LHour := StrToIntDef(Copy(ADateStr, 18, 2), 0);
+ LMin := StrToIntDef(Copy(ADateStr, 21, 2), 0);
+ LSec := StrToIntDef(Copy(ADateStr, 24, 2), 0);
+ end else
+ // Fri, 30 Jul 24 10:10:35 GMT
+ // Fri, 30-Jul-24 10:10:35 GMT
+ if (Length(ADateStr) = 27) then
+ begin
+ LDay := StrToIntDef(Copy(ADateStr, 6, 2), 0);
+ LMonth := (Pos(Copy(ADateStr, 9, 3), RFC1123_StrMonth) + 2) div 3;
+ LYear := 2000 + StrToIntDef(Copy(ADateStr, 13, 2), 0);
+ LHour := StrToIntDef(Copy(ADateStr, 16, 2), 0);
+ LMin := StrToIntDef(Copy(ADateStr, 19, 2), 0);
+ LSec := StrToIntDef(Copy(ADateStr, 22, 2), 0);
+ end else
+ Exit(0);
+
+ if not TryEncodeDateTime(LYear, LMonth, LDay, LHour, LMin, LSec, 0, Result) then
+ Result := 0;
+end;
+
+class function TCrossHttpUtils.TryUrlPathToLocalPath(const ALocalBaseDir,
+ AUrlPath: string; out AResolvedPath: string): Boolean;
+begin
+ Result := TPathUtils.TryResolveLocalPath(
+ ALocalBaseDir,
+ TCrossHttpUtils.GetPathWithoutParams(AUrlPath).Trim,
+ AResolvedPath);
+end;
+
+class function TCrossHttpUtils.UrlDecode(const S: string): string;
+var
+ LSrcBytes, LDstBytes: TBytes;
+ LSrcLen, LSrcIdx, LDstIdx: Integer;
+ H, L: Byte;
+ C: Byte;
+begin
+ if (S = '') then Exit('');
+
+ // 先把输入 unicode 字符串 UTF-8 编码为字节流, 与 UrlEncode 对称.
+ // 这样允许输入混合: ASCII percent-encoded ('%E4%B8%AD') 与 unicode 原字符 ('中') 都能正确处理.
+ LSrcBytes := TEncoding.UTF8.GetBytes(S);
+ LSrcLen := Length(LSrcBytes);
+ SetLength(LDstBytes, LSrcLen);
+
+ LSrcIdx := 0;
+ LDstIdx := 0;
+ while (LSrcIdx < LSrcLen) do
+ begin
+ C := LSrcBytes[LSrcIdx];
+ case C of
+ // 兼容早期 form-urlencoded: '+' → 空格
+ Ord('+'):
+ begin
+ LDstBytes[LDstIdx] := Ord(' ');
+ Inc(LSrcIdx);
+ end;
+
+ Ord('%'):
+ begin
+ if (LSrcIdx + 2 < LSrcLen)
+ and TUtils.HexCharToByte(Char(LSrcBytes[LSrcIdx + 1]), H)
+ and TUtils.HexCharToByte(Char(LSrcBytes[LSrcIdx + 2]), L) then
+ begin
+ LDstBytes[LDstIdx] := L + (H shl 4);
+ Inc(LSrcIdx, 3);
+ end else
+ begin
+ // 非法 %xx, 原样保留 '%' 字符
+ LDstBytes[LDstIdx] := Ord('%');
+ Inc(LSrcIdx);
+ end;
+ end;
+ else
+ // 包含 ASCII 与 UTF-8 多字节序列的高字节, 都原样透传
+ LDstBytes[LDstIdx] := C;
+ Inc(LSrcIdx);
+ end;
+
+ Inc(LDstIdx);
+ end;
+ SetLength(LDstBytes, LDstIdx);
+
+ Result := TEncoding.UTF8.GetString(LDstBytes);
+end;
+
+class function TCrossHttpUtils.UrlEncode(const S: string; const ANoConversion: TSysCharSet;
+ const APreserveEncoded: Boolean): string;
+const
+ HEX_CHARS: array[0..15] of Char = (
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+
+ function _IsHexByte(const AByte: Byte): Boolean; inline;
+ begin
+ case AByte of
+ Ord('0')..Ord('9'),
+ Ord('a')..Ord('f'),
+ Ord('A')..Ord('F'):
+ Result := True;
+ else
+ Result := False;
+ end;
+ end;
+
+var
+ LUTF8Bytes: TBytes;
+ LLen, I: Integer;
+ C: Byte;
+ P: PChar;
+begin
+ if (S = '') then Exit('');
+
+ // 先将 unicode 字符串编码为 utf8 字节数组
+ LUTF8Bytes := TEncoding.UTF8.GetBytes(S);
+ LLen := Length(LUTF8Bytes);
+
+ // 预分配编码字符串, 比一直累加效率高很多
+ // 预分配尺寸为 utf8 字节数组长度的 3 倍
+ // 之所以预分配 3 倍, 是因为每个 utf8 字节最长可能被编码为 %xy 这样的字符串
+ SetLength(Result, LLen * 3);
+ P := PChar(Result);
+
+ I := 0;
+ while (I < LLen) do
+ begin
+ C := LUTF8Bytes[I];
+ case C of
+ // https://datatracker.ietf.org/doc/html/rfc3986
+ // RFC 3986 中明确定义了未保留字(无需编码)包含以下这些
+ // 字母数字：大小写英文字母(A-Z, a-z)和数字(0-9)。
+ // 特殊字符：连字符(-)，下划线(_)，点号(.)，和波浪号(~)。
+ Ord('0')..Ord('9'),
+ Ord('a')..Ord('z'),
+ Ord('A')..Ord('Z'),
+ Ord('-'), Ord('_'), Ord('.'), Ord('~'):
+ begin
+ P^ := Char(C);
+ Inc(P);
+ end;
+ else
+ // RFC 3986 §2.4: 已 percent-encoded 的 %xx 序列不应被二次编码.
+ // APreserveEncoded=True 时, 遇到 % 后跟 2 个 hex 数字, 原样保留 3 字符.
+ if APreserveEncoded and (C = Ord('%')) and (I + 2 < LLen)
+ and _IsHexByte(LUTF8Bytes[I + 1])
+ and _IsHexByte(LUTF8Bytes[I + 2]) then
+ begin
+ P^ := '%';
+ Inc(P);
+ P^ := Char(LUTF8Bytes[I + 1]);
+ Inc(P);
+ P^ := Char(LUTF8Bytes[I + 2]);
+ Inc(P);
+ Inc(I, 2); // 跳过两个 hex 字节, 循环底部还会 Inc(I) 一次
+ end else
+ if CharInSet(Char(C), ANoConversion) then
+ begin
+ P^ := Char(C);
+ Inc(P);
+ end else
+ begin
+ P^ := '%';
+ Inc(P);
+
+ P^ := HEX_CHARS[C shr 4];
+ Inc(P);
+
+ P^ := HEX_CHARS[C and $F];
+ Inc(P);
+ end;
+ end;
+ Inc(I);
+ end;
+
+ // 修正编码字符串的实际长度
+ SetLength(Result, P - PChar(Result));
+end;
+
+class function TCrossHttpUtils.ParseSingleByteRange(const ARangeHeader: string;
+ const AContentLength: Int64; out AStart, AEnd: Int64): Boolean;
+const
+ PREFIX = 'bytes=';
+
+ function _IsAsciiDigits(const S: string): Boolean;
+ var
+ I: Integer;
+ begin
+ if (S = '') then Exit(False);
+ for I := 1 to Length(S) do
+ case S[I] of
+ '0'..'9': ;
+ else
+ Exit(False);
+ end;
+ Result := True;
+ end;
+
+var
+ LSpec, LStartStr, LEndStr: string;
+ LDashPos: Integer;
+ LStartVal, LEndVal: Int64;
+ LHasStart, LHasEnd: Boolean;
+begin
+ AStart := 0;
+ AEnd := 0;
+ Result := False;
+
+ // 资源长度必须 > 0
+ if (AContentLength <= 0) then Exit;
+
+ // 必须以 'bytes=' 前缀开头 (RFC 7233 §3.1, 大小写不敏感)
+ if (Length(ARangeHeader) <= Length(PREFIX))
+ or not ARangeHeader.StartsWith(PREFIX, True) then Exit;
+
+ LSpec := Copy(ARangeHeader, Length(PREFIX) + 1, MaxInt).Trim;
+ if (LSpec = '') then Exit;
+
+ // 不支持 multipart/byteranges (含 ',' 一律拒绝)
+ if (LSpec.IndexOf(',') >= 0) then Exit;
+
+ // 必须存在且仅有一个 '-'
+ LDashPos := LSpec.IndexOf('-');
+ if (LDashPos < 0) then Exit;
+ if (LSpec.LastIndexOf('-') <> LDashPos) then Exit;
+
+ // 不对子串再 Trim, 避免 'bytes=0 - 100' 内嵌空格被静默吞掉.
+ // RFC 7230 ABNF 不允许 byte-range-spec 内含 OWS/BWS.
+ LStartStr := LSpec.Substring(0, LDashPos);
+ LEndStr := LSpec.Substring(LDashPos + 1);
+
+ LHasStart := (LStartStr <> '');
+ LHasEnd := (LEndStr <> '');
+
+ // 至少要有一个端点; 'bytes=-' 是非法的
+ if (not LHasStart) and (not LHasEnd) then Exit;
+
+ // 解析 start (必须为纯 ASCII 十进制数字)
+ if LHasStart then
+ begin
+ if not _IsAsciiDigits(LStartStr) then Exit;
+ if not TryStrToInt64(LStartStr, LStartVal) then Exit;
+ if (LStartVal < 0) then Exit;
+ end else
+ LStartVal := 0;
+
+ // 解析 end (必须为纯 ASCII 十进制数字)
+ if LHasEnd then
+ begin
+ if not _IsAsciiDigits(LEndStr) then Exit;
+ if not TryStrToInt64(LEndStr, LEndVal) then Exit;
+ if (LEndVal < 0) then Exit;
+ end else
+ LEndVal := 0;
+
+ if LHasStart and LHasEnd then
+ begin
+ // bytes=start-end: 要求 0 <= start <= end < size
+ if (LStartVal > LEndVal) then Exit;
+ if (LStartVal >= AContentLength) then Exit;
+ // end 超出文件大小时按 RFC 7233 §2.1 截断到 size-1
+ if (LEndVal >= AContentLength) then
+ LEndVal := AContentLength - 1;
+ AStart := LStartVal;
+ AEnd := LEndVal;
+ end else
+ if LHasStart then
+ begin
+ // bytes=start-: 从 start 取到末尾
+ if (LStartVal >= AContentLength) then Exit;
+ AStart := LStartVal;
+ AEnd := AContentLength - 1;
+ end else
+ begin
+ // bytes=-suffix: 取末尾 suffix 字节; suffix 必须 > 0
+ if (LEndVal = 0) then Exit;
+ if (LEndVal >= AContentLength) then
+ AStart := 0
+ else
+ AStart := AContentLength - LEndVal;
+ AEnd := AContentLength - 1;
+ end;
+
+ Result := True;
+end;
+
+class function TCrossHttpUtils.IsTokenChar(ACh: Char): Boolean;
+begin
+ // RFC 7230 §3.2.6 token: ALPHA / DIGIT / "!" "#" "$" "%" "&" "'" "*" "+"
+ // "-" "." "^" "_" "`" "|" "~"
+ case ACh of
+ 'A'..'Z', 'a'..'z', '0'..'9',
+ '!', '#', '$', '%', '&', '''', '*', '+', '-', '.', '^', '_', '`', '|', '~':
+ Result := True;
+ else
+ Result := False;
+ end;
+end;
+
+class function TCrossHttpUtils.IsHeaderValueChar(ACh: Char): Boolean;
+begin
+ // RFC 7230 §3.2.4 field-value:
+ // 合法: HTAB(#9) / 可见 ASCII (#32..#126) / #128+ 高位字符 (历史宽松, 兼容 UTF-8).
+ // 非法: 其他 CTL (#0..#8, #10..#31) 与 DEL (#127), CR/LF/NUL 是响应拆分主要载体.
+ case Ord(ACh) of
+ 9, 32..126, 128..$FFFF:
+ Result := True;
+ else
+ Result := False;
+ end;
+end;
+
+class function TCrossHttpUtils.IsValidHeaderName(const AName: string): Boolean;
+var
+ I: Integer;
+begin
+ if (AName = '') then Exit(False);
+ for I := 1 to Length(AName) do
+ if not IsTokenChar(AName[I]) then Exit(False);
+ Result := True;
+end;
+
+class function TCrossHttpUtils.IsValidHeaderValue(const AValue: string): Boolean;
+var
+ I: Integer;
+begin
+ for I := 1 to Length(AValue) do
+ if not IsHeaderValueChar(AValue[I]) then Exit(False);
+ Result := True;
+end;
+
+end.
diff --git a/Net/Net.CrossSocket.Epoll.pas b/Net/Net.CrossSocket.Epoll.pas
index 121a896..cd4bdd3 100644
--- a/Net/Net.CrossSocket.Epoll.pas
+++ b/Net/Net.CrossSocket.Epoll.pas
@@ -1,1077 +1,1077 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossSocket.Epoll;
-
-{$I zLib.inc}
-
-interface
-
-uses
- SysUtils,
- Classes,
- Generics.Collections,
-
- {$IFDEF DELPHI}
- Posix.Base,
- Posix.SysSocket,
- Posix.NetinetIn,
- Posix.UniStd,
- Posix.NetDB,
- Posix.Pthread,
- Posix.ArpaInet,
- Posix.Errno,
- Linux.epoll,
- {$ELSE}
- baseunix,
- unix,
- linux,
- syscall,
- sockets,
- netdb,
- cnetdb,
- DTF.RTL,
- {$ENDIF DELPHI}
-
- Net.SocketAPI,
- Net.CrossSocket.Base,
-
- Utils.SyncObjs,
- Utils.ArrayUtils;
-
-type
- TIoEvent = (ieRead, ieWrite);
- TIoEvents = set of TIoEvent;
-
- TEpollListen = class(TCrossListenBase)
- private
- FEpollHandle: Integer;
- FOpCode: Integer;
-
- function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
- public
- constructor Create(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
- const AFamily, ASockType, AProtocol: Integer); override;
- end;
-
- PSendItem = ^TSendItem;
- TSendItem = record
- Data: PByte;
- Size: Integer;
- Callback: TCrossConnectionCallback;
- end;
-
- TSendQueue = class(TList)
- protected
- procedure Notify(const Value: PSendItem; Action: TCollectionNotification); override;
- end;
-
- TEpollConnection = class(TCrossConnectionBase)
- private
- FEpollHandle: Integer;
- FSendQueue: TSendQueue;
- FEpLock: ILock;
- FOpCode: Integer;
- FInPending, FOutPending: Integer;
-
- function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
- procedure _ClearSendQueue;
-
- // 为了减少死锁的可能, 不使用父类的 _Lock/_Unlock
- // 因为父类的 _Lock/_Unlock 主要用于连接事件和接收数据事件
- // 这里的 _EpLock/_EpUnlock 主要用于发送队列和Epoll事件
- // 在接收完数据之后马上发送数据, 如果使用同一把锁可能会引起死锁
- procedure _EpLock; inline;
- procedure _EpUnlock; inline;
- protected
- procedure InternalClose; override;
- public
- constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback); override;
- destructor Destroy; override;
- end;
-
- // KQUEUE 与 EPOLL 队列的差异
- // KQUEUE的队列中, 一个Socket句柄可以有多条记录, 每个事件一条,
- // 这一点和 EPOLL 不一样, EPOLL中每个Socket句柄只会有一条记录
- // 要监测多个事件时, 只需要将多个事件做位运算加在一起调用 epoll_ctl 即可
- //
- // EPOLLONESHOT 是令 epoll 支持线程池的关键
- // 该参数可以令事件触发后就立即被禁用, 避免让同一个Socket的同一个事件
- // 同时被多个工作线程触发, 由于 epoll 中每个 socket 只有一条记录, 所以
- // 一定要注意带上 EPOLLONESHOT 参数的 epoll_ctl, 在 epoll_wait 之后一定要再次
- // 调用 epoll_ctl 增加要监视的事件
- //
- // EPOLL 发送数据
- // 最好的做法是将实际发送数据的动作放到 EPOLLOUT 触发时进行, 该
- // 事件触发表明 Socket 发送缓存有空闲空间了。IOCP 可以直接将待发送的数据及
- // 回调同时扔给 WSASend, 发送完成后去调用回调即可; EPOLL 机制不一样, 在 EPOLL
- // 中没有类似 WSASend 的函数, 只能自行维护发送数据及回调的队列
- // EPOLL要支持多线程并发发送数据必须创建发送队列, 否则同一个 Socket 的并发发送
- // 极有可能有一部分会被其它发送覆盖掉
- //
- // 由于 EPOLL 中每个套接字在队列中只有一条记录, 也就是说改写套接字的监视事件时
- // 后一次修改会修改之前的, 这就很难使用接口的引用计数机制来保持连接有效性了
- // 这里使用连接UID作为 epoll_ctl 的参数, 在事件触发时通过UID查找连接对象, 这样
- // 同样可以保证事件触发时访问到有效的连接对象, 而且不需要引用计数保证
- TEpollCrossSocket = class(TCrossSocketBase)
- private const
- MAX_EVENT_COUNT = 2048;
- SHUTDOWN_FLAG = UInt64(-1);
- private class threadvar
- FEventList: array [0..MAX_EVENT_COUNT-1] of TEPoll_Event;
- private
- FEpollHandle: Integer;
- FIoThreads: TArray;
- FIdleHandle, FStopHandle: Integer;
- FIdleLock: ILock;
-
- // 利用 eventfd 唤醒并退出IO线程
- procedure _OpenStopHandle;
- procedure _PostStopCommand;
- procedure _CloseStopHandle;
-
- procedure _OpenIdleHandle;
- procedure _CloseIdleHandle;
-
- procedure _HandleAccept(const AListen: ICrossListen);
- procedure _HandleConnect(const AConnection: ICrossConnection);
- procedure _HandleRead(const AConnection: ICrossConnection);
- procedure _HandleWrite(const AConnection: ICrossConnection);
- protected
- function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
- function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
- const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
-
- procedure StartLoop; override;
- procedure StopLoop; override;
-
- procedure Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback = nil); override;
-
- procedure Connect(const AHost: string; const APort, ALocalPort: Word;
- const ACallback: TCrossConnectionCallback = nil); override;
-
- procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer;
- const ACallback: TCrossConnectionCallback = nil); override;
-
- function ProcessIoEvent: Boolean; override;
- public
- constructor Create(const AIoThreads: Integer); override;
- destructor Destroy; override;
- end;
-
-implementation
-
-{ create a file descriptor for event notification }
-{$IFDEF DELPHI}
-function eventfd(initval: Cardinal; flags: Integer): Integer; cdecl;
- external libc name 'eventfd';
-{$ELSE}
-function eventfd(initval: Cardinal; flags: Integer): Integer;
-begin
- Result := do_syscall(syscall_nr_eventfd2, TSysParam(initval), TSysParam(flags));
-end;
-{$ENDIF}
-
-{ TEpollListen }
-
-constructor TEpollListen.Create(const AOwner: TCrossSocketBase;
- const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer);
-begin
- inherited;
-
- FOpCode := EPOLL_CTL_ADD;
- FEpollHandle := TEpollCrossSocket(Owner).FEpollHandle;
-end;
-
-function TEpollListen._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
-var
- LEvent: TEPoll_Event;
-begin
- if (AIoEvents = []) or IsClosed then Exit(False);
-
- LEvent.Events := EPOLLET or EPOLLONESHOT;
- LEvent.Data.u64 := Self.UID;
-
- if (ieRead in AIoEvents) then
- LEvent.Events := LEvent.Events or EPOLLIN;
-
- Result := (epoll_ctl(FEpollHandle, FOpCode, Socket, @LEvent) >= 0);
- FOpCode := EPOLL_CTL_MOD;
-
- if not Result then
- _LogLastOsError('listen epoll_ctl, %s', [Self.DebugInfo]);
-end;
-
-{ TSendQueue }
-
-procedure TSendQueue.Notify(const Value: PSendItem;
- Action: TCollectionNotification);
-begin
- if (Action = TCollectionNotification.cnRemoved) then
- begin
- if (Value <> nil) then
- begin
- Value.Callback := nil;
- System.Dispose(Value);
- end;
- end;
-
- inherited;
-end;
-
-{ TEpollConnection }
-
-constructor TEpollConnection.Create(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback);
-begin
- inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
-
- FEpLock := TLock.Create;
- FSendQueue := TSendQueue.Create;
-
- FEpollHandle := TEpollCrossSocket(Owner).FEpollHandle;
- FOpCode := EPOLL_CTL_ADD;
-end;
-
-destructor TEpollConnection.Destroy;
-begin
- _ClearSendQueue;
-
- FreeAndNil(FSendQueue);
-
- inherited;
-end;
-
-procedure TEpollConnection.InternalClose;
-begin
- _ClearSendQueue;
-
- _EpLock;
- try
- epoll_ctl(FEpollHandle, EPOLL_CTL_DEL, Socket, nil);
- finally
- _EpUnlock;
- end;
-
- inherited InternalClose;
-end;
-
-procedure TEpollConnection._ClearSendQueue;
-var
- LConnection: ICrossConnection;
- LSendItem: PSendItem;
- LCallbacks: TArray;
- LCallback: TCrossConnectionCallback;
-begin
- LConnection := Self;
- LCallbacks := [];
-
- _EpLock;
- try
- // 连接释放时, 先收集所有回调, 然后在锁外执行
- // 避免回调中再次发送数据导致死锁
- if (FSendQueue.Count > 0) then
- begin
- for LSendItem in FSendQueue do
- if Assigned(LSendItem.Callback) then
- TArrayUtils.Append(LCallbacks, LSendItem.Callback);
-
- FSendQueue.Clear;
- end;
- finally
- _EpUnlock;
- end;
-
- // 在锁外执行回调, 告知发送失败
- for LCallback in LCallbacks do
- LCallback(LConnection, False);
-end;
-
-procedure TEpollConnection._EpLock;
-begin
- FEpLock.Enter;
-end;
-
-procedure TEpollConnection._EpUnlock;
-begin
- FEpLock.Leave;
-end;
-
-function TEpollConnection._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
-var
- LEvent: TEPoll_Event;
-begin
- if (AIoEvents = []) or IsClosed then Exit(False);
-
- LEvent.Events := 0;
-
- if (ieRead in AIoEvents) and (AtomicCmpExchange(FInPending, 0, 0) = 0) then
- LEvent.Events := LEvent.Events or EPOLLIN;
-
- if (ieWrite in AIoEvents) and (AtomicCmpExchange(FOutPending, 0, 0) = 0) then
- LEvent.Events := LEvent.Events or EPOLLOUT;
-
- if (LEvent.Events = 0) then Exit(False);
-
- LEvent.Events := LEvent.Events or EPOLLET or EPOLLONESHOT or EPOLLERR or EPOLLHUP;
- LEvent.Data.u64 := Self.UID;
-
- Result := (epoll_ctl(FEpollHandle, FOpCode, Socket, @LEvent) >= 0);
- FOpCode := EPOLL_CTL_MOD;
-
- if not Result then
- begin
- _LogLastOsError('connection epoll_ctl, %s, events=0x%.8x',
- [Self.DebugInfo, LEvent.Events]);
- Close;
- end;
-end;
-
-{ TEpollCrossSocket }
-
-constructor TEpollCrossSocket.Create(const AIoThreads: Integer);
-begin
- inherited;
-
- FIdleLock := TLock.Create;
-end;
-
-destructor TEpollCrossSocket.Destroy;
-begin
- inherited;
-end;
-
-procedure TEpollCrossSocket._CloseIdleHandle;
-begin
- FileClose(FIdleHandle);
-end;
-
-procedure TEpollCrossSocket._CloseStopHandle;
-begin
- FileClose(FStopHandle);
-end;
-
-procedure TEpollCrossSocket._HandleAccept(const AListen: ICrossListen);
-var
- LListen: ICrossListen;
- LConnection: ICrossConnection;
- LEpConnection: TEpollConnection;
- LError: Integer;
- LSocket, LListenSocket, LClientSocket: TSocket;
- LSuccess: Boolean;
-begin
- LListen := AListen;
- LListenSocket := LListen.Socket;
-
- while True do
- begin
- LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
-
- // Accept失败
- // EAGAIN 所有就绪的连接都已处理完毕
- // EMFILE 进程的文件句柄已经用完了
- if (LSocket < 0) then
- begin
- LError := GetLastError;
-
- if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- begin
- end else
- // 当句柄用完了的时候, 释放事先占用的临时句柄
- // 然后再次 accept, 然后将 accept 的句柄关掉
- // 这样可以保证在文件句柄耗尽的时候依然能响应连接请求
- // 并立即将新到的连接关闭
- if (LError = EMFILE) then
- begin
- FIdleLock.Enter;
- try
- _CloseIdleHandle;
- LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
- TSocketAPI.CloseSocket(LSocket);
- _OpenIdleHandle;
- finally
- FIdleLock.Leave;
- end;
- end else
- _LogLastOsError('Accept');
-
- Break;
- end;
-
- LClientSocket := LSocket;
- TSocketAPI.SetNonBlock(LClientSocket, True);
- SetKeepAlive(LClientSocket);
-
- LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
- TriggerConnecting(LConnection);
- TriggerConnected(LConnection);
-
- // 连接建立后监视Socket的读事件
- LEpConnection := LConnection as TEpollConnection;
- LEpConnection._EpLock;
- try
- LSuccess := LEpConnection._UpdateIoEvent([ieRead]);
- finally
- LEpConnection._EpUnlock;
- end;
-
- if not LSuccess then
- begin
- _Log('_HandleAccept._UpdateIoEvent failed, %s', [LConnection.DebugInfo]);
- LConnection.Close;
- end;
- end;
-end;
-
-procedure TEpollCrossSocket._HandleConnect(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LSockErr: Integer;
-begin
- LConnection := AConnection;
-
- // Connect失败
- LSockErr := TSocketAPI.GetError(LConnection.Socket);
- if (LSockErr <> 0) then
- begin
- LConnection.LastNetError := LSockErr;
- _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
- LConnection.Close;
- Exit;
- end;
-
- TriggerConnected(LConnection);
-end;
-
-procedure TEpollCrossSocket._HandleRead(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LEpConnection: TEpollConnection;
- LRcvd, LError: Integer;
-begin
- LConnection := AConnection;
- LEpConnection := LConnection as TEpollConnection;
-
- AtomicIncrement(LEpConnection.FInPending);
- try
- while True do
- begin
- LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
-
- // 对方主动断开连接
- if (LRcvd = 0) then
- begin
- _Log('Recv=0(Close), %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Break;
- end;
-
- if (LRcvd < 0) then
- begin
- LError := GetLastError;
-
- // 被系统信号中断, 可以重新recv
- if (LError = EINTR) then
- begin
- _LogLastOsError('Recv=EINTR, %s', [LConnection.DebugInfo]);
- Continue
- end else
- // 接收缓冲区中数据已经被取完了
- if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- Break
- else
- // 接收出错
- begin
- _LogLastOsError('Recv<0, %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Break;
- end;
- end;
-
- TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
-
- // 回调中可能关闭了连接, 需要检查状态
- if LConnection.IsClosed then Break;
-
- if (LRcvd < RCV_BUF_SIZE) then Break;
- end;
- finally
- AtomicDecrement(LEpConnection.FInPending);
- end;
-end;
-
-procedure TEpollCrossSocket._HandleWrite(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LEpConnection: TEpollConnection;
- LSendItem: PSendItem;
- LSent, LError: Integer;
- LSendCbArr: TArray;
- LSendCb: TCrossConnectionCallback;
-begin
- LConnection := AConnection;
- LEpConnection := LConnection as TEpollConnection;
- LSendCbArr := [];
-
- AtomicIncrement(LEpConnection.FOutPending);
- LEpConnection._EpLock;
- try
- while True do
- begin
- // 检查队列中有没有数据
- if (LEpConnection.FSendQueue.Count <= 0) then Break;
-
- // 获取Socket发送队列中的第一条数据
- LSendItem := LEpConnection.FSendQueue.Items[0];
-
- // 发送数据
- LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size, MSG_NOSIGNAL);
-
- // 对方主动断开连接
- if (LSent = 0) then
- begin
- _Log('Send=0(Close), %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Break;
- end;
-
- // 连接断开或发送错误
- if (LSent < 0) then
- begin
- LError := GetLastError;
-
- // 被系统信号中断, 可以重新send
- if (LError = EINTR) then
- begin
- _LogLastOsError('Send=EINTR, %s', [LConnection.DebugInfo]);
- Continue;
- end else
- // 发送缓冲区已被填满了, 需要等下次唤醒发送线程再继续发送
- if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- Break
- // 发送出错
- else
- begin
- _LogLastOsError('Send<0, %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Break;
- end;
- end;
-
- // 全部发送完成
- if (LSent >= LSendItem.Size) then
- begin
- TArrayUtils.Append(LSendCbArr, LSendItem.Callback);
-
- // 发送成功, 移除已发送成功的数据
- // 必须先从队列移除已发完的数据项, 然后再执行发送成功的回调
- // 因为回调里可能还会发送新的数据, 如果先执行回调再去移除,
- // 就会错误的将回调中放到队列里的新数据移除
- if (LEpConnection.FSendQueue.Count > 0) then
- LEpConnection.FSendQueue.Delete(0);
- end else
- begin
- // 部分发送成功, 在下一次唤醒发送线程时继续处理剩余部分
- Dec(LSendItem.Size, LSent);
- Inc(LSendItem.Data, LSent);
- end;
- end;
- finally
- LEpConnection._EpUnlock;
- AtomicDecrement(LEpConnection.FOutPending);
- end;
-
- // 调用回调
- for LSendCb in LSendCbArr do
- LSendCb(LConnection, True);
-end;
-
-procedure TEpollCrossSocket._OpenIdleHandle;
-begin
- FIdleHandle := FileOpen('/dev/null', fmOpenRead);
-end;
-
-procedure TEpollCrossSocket._OpenStopHandle;
-var
- LEvent: TEPoll_Event;
-begin
- FStopHandle := eventfd(0, 0);
- // 这里不使用 EPOLLET
- // 这样可以保证通知退出的命令发出后, 所有IO线程都会收到
- LEvent.Events := EPOLLIN;
- LEvent.Data.u64 := SHUTDOWN_FLAG;
- epoll_ctl(FEpollHandle, EPOLL_CTL_ADD, FStopHandle, @LEvent);
-end;
-
-procedure TEpollCrossSocket._PostStopCommand;
-var
- LStuff: UInt64;
-begin
- LStuff := 1;
- // 往 FStopHandle 写入任意数据, 唤醒工作线程
- FileWrite(FStopHandle, LStuff, SizeOf(LStuff));
-end;
-
-procedure TEpollCrossSocket.StartLoop;
-var
- I: Integer;
-begin
- if (FIoThreads <> nil) then Exit;
-
- _OpenIdleHandle;
-
- // epoll_create(size)
- // 这个 size 只要传递大于0的任何值都可以
- // 并不是说队列的大小会受限于该值
- // http://man7.org/linux/man-pages/man2/epoll_create.2.html
- FEpollHandle := epoll_create(MAX_EVENT_COUNT);
- SetLength(FIoThreads, GetIoThreads);
- for I := 0 to Length(FIoThreads) - 1 do
- FIoThreads[I] := TIoEventThread.Create(Self);
-
- _OpenStopHandle;
-end;
-
-procedure TEpollCrossSocket.StopLoop;
-var
- I: Integer;
- LCurrentThreadID: TThreadID;
-begin
- if (FIoThreads = nil) then Exit;
-
- CloseAll;
-
- while (FListensCount > 0) or (FConnectionsCount > 0) do Sleep(1);
-
- _PostStopCommand;
-
- LCurrentThreadID := GetCurrentThreadId;
- for I := 0 to Length(FIoThreads) - 1 do
- begin
- if (FIoThreads[I].ThreadID = LCurrentThreadID) then
- raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
-
- FIoThreads[I].WaitFor;
- FreeAndNil(FIoThreads[I]);
- end;
- FIoThreads := nil;
-
- FileClose(FEpollHandle);
- _CloseIdleHandle;
- _CloseStopHandle;
-end;
-
-procedure TEpollCrossSocket.Connect(const AHost: string;
- const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
-
- procedure _Failed1;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- end;
-
- function _Connect(ASocket: TSocket; AAddr: PRawAddrInfo): Boolean;
- procedure _Failed2;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- TSocketAPI.CloseSocket(ASocket);
- end;
- var
- LSockAddr: TRawSockAddrIn;
- LConnection: ICrossConnection;
- LEpConnection: TEpollConnection;
- begin
- FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
- LSockAddr.AddrLen := AAddr.ai_addrlen;
- if (AAddr.ai_family = AF_INET6) then
- begin
- LSockAddr.Addr6.sin6_family := AAddr.ai_family;
- LSockAddr.Addr6.sin6_port := htons(ALocalPort);
- end else
- begin
- LSockAddr.Addr.sin_family := AAddr.ai_family;
- LSockAddr.Addr.sin_port := htons(ALocalPort);
- end;
- if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TEpollCrossSocket._Connect.Bind');
- {$ENDIF}
- _Failed2;
- Exit(False);
- end;
-
- if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0)
- or (GetLastError = EINPROGRESS) then
- begin
- LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
- TriggerConnecting(LConnection);
- LEpConnection := LConnection as TEpollConnection;
-
- LEpConnection._EpLock;
- try
- LEpConnection.ConnectStatus := csConnecting;
- if not LEpConnection._UpdateIoEvent([ieWrite]) then
- begin
- LConnection.Close;
- Exit(False);
- end;
- finally
- LEpConnection._EpUnlock;
- end;
- end else
- begin
- _LogLastOsError('Connect');
-
- _Failed2;
- Exit(False);
- end;
-
- Result := True;
- end;
-
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LSocket: TSocket;
-begin
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- _Failed1;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol);
- if (LSocket = INVALID_SOCKET) then
- begin
- _LogLastOsError('NewSocket');
-
- _Failed1;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LSocket, True);
- SetKeepAlive(LSocket);
-
- if _Connect(LSocket, LAddrInfo) then Exit;
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-
- _Failed1;
-end;
-
-function TEpollCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
-begin
- Result := TEpollConnection.Create(
- AOwner,
- AClientSocket,
- AConnectType,
- AHost,
- AConnectCb);
-end;
-
-function TEpollCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
- const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
-begin
- Result := TEpollListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
-end;
-
-procedure TEpollCrossSocket.Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback);
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LListenSocket: TSocket;
- LListen: ICrossListen;
- LEpListen: TEpollListen;
- LListenSuccess, LUpdateIoEventSuccess: Boolean;
-
- procedure _Failed;
- begin
- if not LListenSuccess and Assigned(ACallback) then
- ACallback(LListen, False);
-
- if (LListen <> nil) then
- LListen.Close
- else if (LListenSocket <> INVALID_SOCKET) then
- TSocketAPI.CloseSocket(LListenSocket);
- end;
-
-begin
- LListenSuccess := False;
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
- LHints.ai_flags := AI_PASSIVE;
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TEpollCrossSocket.Listen.GetAddrInfo');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LListen := nil;
- LListenSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol);
- if (LListenSocket = INVALID_SOCKET) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TEpollCrossSocket.Listen.NewSocket');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LListenSocket, True);
- TSocketAPI.SetReUsePort(LListenSocket, True);
-
- if (LAddrInfo.ai_family = AF_INET6) then
- TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
-
- if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0)
- or (TSocketAPI.Listen(LListenSocket) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TEpollCrossSocket.Listen.Bind');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
- LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
- LEpListen := LListen as TEpollListen;
-
- // 监听套接字的读事件
- // 读事件到达表明有新连接
- LEpListen._Lock;
- try
- LUpdateIoEventSuccess := LEpListen._UpdateIoEvent([ieRead]);
- finally
- LEpListen._Unlock;
- end;
-
- if not LUpdateIoEventSuccess then
- begin
- _Failed;
- Exit;
- end;
-
- // 监听成功
- LListenSuccess := True;
- TriggerListened(LListen);
- if Assigned(ACallback) then
- ACallback(LListen, True);
-
- // 如果端口传入0，让所有地址统一用首个分配到的端口
- if (APort = 0) and (LAddrInfo.ai_next <> nil) then
- Psockaddr_in(LAddrInfo.ai_next.ai_addr).sin_port := htons(LListen.LocalPort);
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-end;
-
-procedure TEpollCrossSocket.Send(const AConnection: ICrossConnection;
- const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
-var
- LEpConnection: TEpollConnection;
- LSendItem: PSendItem;
-begin
- // 测试过先发送, 然后将剩余部分放入发送队列的做法
- // 发现会引起内存访问异常, 放到队列里到IO线程中发送则不会有问题
- {$region '放入发送队列'}
- System.New(LSendItem);
- FillChar(LSendItem^, SizeOf(TSendItem), 0);
- LSendItem.Data := ABuf;
- LSendItem.Size := ALen;
- LSendItem.Callback := ACallback;
-
- LEpConnection := AConnection as TEpollConnection;
-
- LEpConnection._Eplock;
- try
- // 将数据放入队列
- LEpConnection.FSendQueue.Add(LSendItem);
-
- // 由于epoll队列中每个套接字只有一条记录, 为了避免监视发送数据的时候
- // 无法接收数据, 这里必须同时监视读和写
- LEpConnection._UpdateIoEvent([ieRead, ieWrite]);
- finally
- LEpConnection._EpUnlock;
- end;
- {$endregion}
-end;
-
-function TEpollCrossSocket.ProcessIoEvent: Boolean;
-var
- LRet, I: Integer;
- LEvent: TEPoll_Event;
- LCrossUID: UInt64;
- LCrossTag: Byte;
- LListens: TCrossListens;
- LConnections: TCrossConnections;
- LListen: ICrossListen;
- LEpListen: TEpollListen;
- LConnection: ICrossConnection;
- LEpConnection: TEpollConnection;
- LSuccess: Boolean;
- LIoEvents: TIoEvents;
-begin
- // 被系统信号打断或者出错会返回-1, 具体需要根据错误代码判断
- LRet := epoll_wait(FEpollHandle, @FEventList[0], MAX_EVENT_COUNT, -1);
- if (LRet < 0) then
- begin
- _LogLastOsError('epoll_wait');
- LRet := GetLastError;
- // EINTR, epoll_wait 调用被系统信号打断, 可以进行重试
- Exit(LRet = EINTR);
- end;
-
- for I := 0 to LRet - 1 do
- begin
- LEvent := FEventList[I];
-
- // 收到退出命令
- if (LEvent.Data.u64 = SHUTDOWN_FLAG) then Exit(False);
-
- {$region '获取连接或监听对象'}
- LCrossUID := LEvent.Data.u64;
- LCrossTag := GetTagByUID(LCrossUID);
- LListen := nil;
- LConnection := nil;
-
- {$IFDEF DEBUG}
-// _Log('epoll events %.8x, uid %.16x, tag %d', [LEvent.Events, LEvent.Data.u64, LCrossTag]);
- {$ENDIF}
- case LCrossTag of
- UID_LISTEN:
- begin
- LListens := LockListens;
- try
- if not LListens.TryGetValue(LCrossUID, LListen)
- or (LListen = nil) then
- Continue;
- finally
- UnlockListens;
- end;
- end;
-
- UID_CONNECTION:
- begin
- LConnections := LockConnections;
- try
- if not LConnections.TryGetValue(LCrossUID, LConnection)
- or (LConnection = nil) then
- Continue;
- finally
- UnlockConnections;
- end;
- end;
- else
- Continue;
- end;
- {$endregion}
-
- {$region 'IO事件处理'}
- if (LListen <> nil) then
- begin
- if (LEvent.Events and EPOLLIN <> 0) then
- _HandleAccept(LListen);
-
- // 继续接收新连接
- LEpListen := LListen as TEpollListen;
- LEpListen._Lock;
- LEpListen._UpdateIoEvent([ieRead]);
- LEpListen._Unlock;
- end else
- if (LConnection <> nil) then
- begin
- // 连接被断开
- if (LEvent.Events and EPOLLERR <> 0)
- or (LEvent.Events and EPOLLHUP <> 0) then
- begin
- _Log('epoll_wait, %s, EPOLLERR=%d, EPOLLHUP=%d', [
- LConnection.DebugInfo,
- LEvent.Events and EPOLLERR,
- LEvent.Events and EPOLLHUP
- ]);
- LConnection.Close;
- Continue;
- end;
-
- // epoll的读写事件同一时间可能两个同时触发
- if (LEvent.Events and EPOLLIN <> 0) then
- _HandleRead(LConnection);
-
- if (LEvent.Events and EPOLLOUT <> 0) then
- begin
- if (LConnection.ConnectStatus = csConnecting) then
- _HandleConnect(LConnection)
- else
- _HandleWrite(LConnection);
- end;
-
- // 把更新连接的IO事件放到这里统一处理
- // 当读写同时触发的情况, 可以节省一次IO事件更新
- if not LConnection.IsClosed then
- begin
- LEpConnection := LConnection as TEpollConnection;
- LEpConnection._EpLock;
- try
- if (LEpConnection.FSendQueue.Count > 0) then
- LIoEvents := [ieRead, ieWrite]
- else
- LIoEvents := [ieRead];
- LEpConnection._UpdateIoEvent(LIoEvents);
- finally
- LEpConnection._EpUnlock;
- end;
- end;
- end;
- {$endregion}
- end;
-
- Result := True;
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossSocket.Epoll;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ Generics.Collections,
+
+ {$IFDEF DELPHI}
+ Posix.Base,
+ Posix.SysSocket,
+ Posix.NetinetIn,
+ Posix.UniStd,
+ Posix.NetDB,
+ Posix.Pthread,
+ Posix.ArpaInet,
+ Posix.Errno,
+ Linux.epoll,
+ {$ELSE}
+ baseunix,
+ unix,
+ linux,
+ syscall,
+ sockets,
+ netdb,
+ cnetdb,
+ DTF.RTL,
+ {$ENDIF DELPHI}
+
+ Net.SocketAPI,
+ Net.CrossSocket.Base,
+
+ Utils.SyncObjs,
+ Utils.ArrayUtils;
+
+type
+ TIoEvent = (ieRead, ieWrite);
+ TIoEvents = set of TIoEvent;
+
+ TEpollListen = class(TCrossListenBase)
+ private
+ FEpollHandle: Integer;
+ FOpCode: Integer;
+
+ function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+ public
+ constructor Create(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
+ const AFamily, ASockType, AProtocol: Integer); override;
+ end;
+
+ PSendItem = ^TSendItem;
+ TSendItem = record
+ Data: PByte;
+ Size: Integer;
+ Callback: TCrossConnectionCallback;
+ end;
+
+ TSendQueue = class(TList)
+ protected
+ procedure Notify(const Value: PSendItem; Action: TCollectionNotification); override;
+ end;
+
+ TEpollConnection = class(TCrossConnectionBase)
+ private
+ FEpollHandle: Integer;
+ FSendQueue: TSendQueue;
+ FEpLock: ILock;
+ FOpCode: Integer;
+ FInPending, FOutPending: Integer;
+
+ function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+ procedure _ClearSendQueue;
+
+ // 为了减少死锁的可能, 不使用父类的 _Lock/_Unlock
+ // 因为父类的 _Lock/_Unlock 主要用于连接事件和接收数据事件
+ // 这里的 _EpLock/_EpUnlock 主要用于发送队列和Epoll事件
+ // 在接收完数据之后马上发送数据, 如果使用同一把锁可能会引起死锁
+ procedure _EpLock; inline;
+ procedure _EpUnlock; inline;
+ protected
+ procedure InternalClose; override;
+ public
+ constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback); override;
+ destructor Destroy; override;
+ end;
+
+ // KQUEUE 与 EPOLL 队列的差异
+ // KQUEUE的队列中, 一个Socket句柄可以有多条记录, 每个事件一条,
+ // 这一点和 EPOLL 不一样, EPOLL中每个Socket句柄只会有一条记录
+ // 要监测多个事件时, 只需要将多个事件做位运算加在一起调用 epoll_ctl 即可
+ //
+ // EPOLLONESHOT 是令 epoll 支持线程池的关键
+ // 该参数可以令事件触发后就立即被禁用, 避免让同一个Socket的同一个事件
+ // 同时被多个工作线程触发, 由于 epoll 中每个 socket 只有一条记录, 所以
+ // 一定要注意带上 EPOLLONESHOT 参数的 epoll_ctl, 在 epoll_wait 之后一定要再次
+ // 调用 epoll_ctl 增加要监视的事件
+ //
+ // EPOLL 发送数据
+ // 最好的做法是将实际发送数据的动作放到 EPOLLOUT 触发时进行, 该
+ // 事件触发表明 Socket 发送缓存有空闲空间了。IOCP 可以直接将待发送的数据及
+ // 回调同时扔给 WSASend, 发送完成后去调用回调即可; EPOLL 机制不一样, 在 EPOLL
+ // 中没有类似 WSASend 的函数, 只能自行维护发送数据及回调的队列
+ // EPOLL要支持多线程并发发送数据必须创建发送队列, 否则同一个 Socket 的并发发送
+ // 极有可能有一部分会被其它发送覆盖掉
+ //
+ // 由于 EPOLL 中每个套接字在队列中只有一条记录, 也就是说改写套接字的监视事件时
+ // 后一次修改会修改之前的, 这就很难使用接口的引用计数机制来保持连接有效性了
+ // 这里使用连接UID作为 epoll_ctl 的参数, 在事件触发时通过UID查找连接对象, 这样
+ // 同样可以保证事件触发时访问到有效的连接对象, 而且不需要引用计数保证
+ TEpollCrossSocket = class(TCrossSocketBase)
+ private const
+ MAX_EVENT_COUNT = 2048;
+ SHUTDOWN_FLAG = UInt64(-1);
+ private class threadvar
+ FEventList: array [0..MAX_EVENT_COUNT-1] of TEPoll_Event;
+ private
+ FEpollHandle: Integer;
+ FIoThreads: TArray;
+ FIdleHandle, FStopHandle: Integer;
+ FIdleLock: ILock;
+
+ // 利用 eventfd 唤醒并退出IO线程
+ procedure _OpenStopHandle;
+ procedure _PostStopCommand;
+ procedure _CloseStopHandle;
+
+ procedure _OpenIdleHandle;
+ procedure _CloseIdleHandle;
+
+ procedure _HandleAccept(const AListen: ICrossListen);
+ procedure _HandleConnect(const AConnection: ICrossConnection);
+ procedure _HandleRead(const AConnection: ICrossConnection);
+ procedure _HandleWrite(const AConnection: ICrossConnection);
+ protected
+ function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
+ function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
+ const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
+
+ procedure StartLoop; override;
+ procedure StopLoop; override;
+
+ procedure Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback = nil); override;
+
+ procedure Connect(const AHost: string; const APort, ALocalPort: Word;
+ const ACallback: TCrossConnectionCallback = nil); override;
+
+ procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer;
+ const ACallback: TCrossConnectionCallback = nil); override;
+
+ function ProcessIoEvent: Boolean; override;
+ public
+ constructor Create(const AIoThreads: Integer); override;
+ destructor Destroy; override;
+ end;
+
+implementation
+
+{ create a file descriptor for event notification }
+{$IFDEF DELPHI}
+function eventfd(initval: Cardinal; flags: Integer): Integer; cdecl;
+ external libc name 'eventfd';
+{$ELSE}
+function eventfd(initval: Cardinal; flags: Integer): Integer;
+begin
+ Result := do_syscall(syscall_nr_eventfd2, TSysParam(initval), TSysParam(flags));
+end;
+{$ENDIF}
+
+{ TEpollListen }
+
+constructor TEpollListen.Create(const AOwner: TCrossSocketBase;
+ const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer);
+begin
+ inherited;
+
+ FOpCode := EPOLL_CTL_ADD;
+ FEpollHandle := TEpollCrossSocket(Owner).FEpollHandle;
+end;
+
+function TEpollListen._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+var
+ LEvent: TEPoll_Event;
+begin
+ if (AIoEvents = []) or IsClosed then Exit(False);
+
+ LEvent.Events := EPOLLET or EPOLLONESHOT;
+ LEvent.Data.u64 := Self.UID;
+
+ if (ieRead in AIoEvents) then
+ LEvent.Events := LEvent.Events or EPOLLIN;
+
+ Result := (epoll_ctl(FEpollHandle, FOpCode, Socket, @LEvent) >= 0);
+ FOpCode := EPOLL_CTL_MOD;
+
+ if not Result then
+ _LogLastOsError('listen epoll_ctl, %s', [Self.DebugInfo]);
+end;
+
+{ TSendQueue }
+
+procedure TSendQueue.Notify(const Value: PSendItem;
+ Action: TCollectionNotification);
+begin
+ if (Action = TCollectionNotification.cnRemoved) then
+ begin
+ if (Value <> nil) then
+ begin
+ Value.Callback := nil;
+ System.Dispose(Value);
+ end;
+ end;
+
+ inherited;
+end;
+
+{ TEpollConnection }
+
+constructor TEpollConnection.Create(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback);
+begin
+ inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
+
+ FEpLock := TLock.Create;
+ FSendQueue := TSendQueue.Create;
+
+ FEpollHandle := TEpollCrossSocket(Owner).FEpollHandle;
+ FOpCode := EPOLL_CTL_ADD;
+end;
+
+destructor TEpollConnection.Destroy;
+begin
+ _ClearSendQueue;
+
+ FreeAndNil(FSendQueue);
+
+ inherited;
+end;
+
+procedure TEpollConnection.InternalClose;
+begin
+ _ClearSendQueue;
+
+ _EpLock;
+ try
+ epoll_ctl(FEpollHandle, EPOLL_CTL_DEL, Socket, nil);
+ finally
+ _EpUnlock;
+ end;
+
+ inherited InternalClose;
+end;
+
+procedure TEpollConnection._ClearSendQueue;
+var
+ LConnection: ICrossConnection;
+ LSendItem: PSendItem;
+ LCallbacks: TArray;
+ LCallback: TCrossConnectionCallback;
+begin
+ LConnection := Self;
+ LCallbacks := [];
+
+ _EpLock;
+ try
+ // 连接释放时, 先收集所有回调, 然后在锁外执行
+ // 避免回调中再次发送数据导致死锁
+ if (FSendQueue.Count > 0) then
+ begin
+ for LSendItem in FSendQueue do
+ if Assigned(LSendItem.Callback) then
+ TArrayUtils.Append(LCallbacks, LSendItem.Callback);
+
+ FSendQueue.Clear;
+ end;
+ finally
+ _EpUnlock;
+ end;
+
+ // 在锁外执行回调, 告知发送失败
+ for LCallback in LCallbacks do
+ LCallback(LConnection, False);
+end;
+
+procedure TEpollConnection._EpLock;
+begin
+ FEpLock.Enter;
+end;
+
+procedure TEpollConnection._EpUnlock;
+begin
+ FEpLock.Leave;
+end;
+
+function TEpollConnection._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+var
+ LEvent: TEPoll_Event;
+begin
+ if (AIoEvents = []) or IsClosed then Exit(False);
+
+ LEvent.Events := 0;
+
+ if (ieRead in AIoEvents) and (AtomicCmpExchange(FInPending, 0, 0) = 0) then
+ LEvent.Events := LEvent.Events or EPOLLIN;
+
+ if (ieWrite in AIoEvents) and (AtomicCmpExchange(FOutPending, 0, 0) = 0) then
+ LEvent.Events := LEvent.Events or EPOLLOUT;
+
+ if (LEvent.Events = 0) then Exit(False);
+
+ LEvent.Events := LEvent.Events or EPOLLET or EPOLLONESHOT or EPOLLERR or EPOLLHUP;
+ LEvent.Data.u64 := Self.UID;
+
+ Result := (epoll_ctl(FEpollHandle, FOpCode, Socket, @LEvent) >= 0);
+ FOpCode := EPOLL_CTL_MOD;
+
+ if not Result then
+ begin
+ _LogLastOsError('connection epoll_ctl, %s, events=0x%.8x',
+ [Self.DebugInfo, LEvent.Events]);
+ Close;
+ end;
+end;
+
+{ TEpollCrossSocket }
+
+constructor TEpollCrossSocket.Create(const AIoThreads: Integer);
+begin
+ inherited;
+
+ FIdleLock := TLock.Create;
+end;
+
+destructor TEpollCrossSocket.Destroy;
+begin
+ inherited;
+end;
+
+procedure TEpollCrossSocket._CloseIdleHandle;
+begin
+ FileClose(FIdleHandle);
+end;
+
+procedure TEpollCrossSocket._CloseStopHandle;
+begin
+ FileClose(FStopHandle);
+end;
+
+procedure TEpollCrossSocket._HandleAccept(const AListen: ICrossListen);
+var
+ LListen: ICrossListen;
+ LConnection: ICrossConnection;
+ LEpConnection: TEpollConnection;
+ LError: Integer;
+ LSocket, LListenSocket, LClientSocket: TSocket;
+ LSuccess: Boolean;
+begin
+ LListen := AListen;
+ LListenSocket := LListen.Socket;
+
+ while True do
+ begin
+ LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
+
+ // Accept失败
+ // EAGAIN 所有就绪的连接都已处理完毕
+ // EMFILE 进程的文件句柄已经用完了
+ if (LSocket < 0) then
+ begin
+ LError := GetLastError;
+
+ if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ begin
+ end else
+ // 当句柄用完了的时候, 释放事先占用的临时句柄
+ // 然后再次 accept, 然后将 accept 的句柄关掉
+ // 这样可以保证在文件句柄耗尽的时候依然能响应连接请求
+ // 并立即将新到的连接关闭
+ if (LError = EMFILE) then
+ begin
+ FIdleLock.Enter;
+ try
+ _CloseIdleHandle;
+ LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
+ TSocketAPI.CloseSocket(LSocket);
+ _OpenIdleHandle;
+ finally
+ FIdleLock.Leave;
+ end;
+ end else
+ _LogLastOsError('Accept');
+
+ Break;
+ end;
+
+ LClientSocket := LSocket;
+ TSocketAPI.SetNonBlock(LClientSocket, True);
+ SetKeepAlive(LClientSocket);
+
+ LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
+ TriggerConnecting(LConnection);
+ TriggerConnected(LConnection);
+
+ // 连接建立后监视Socket的读事件
+ LEpConnection := LConnection as TEpollConnection;
+ LEpConnection._EpLock;
+ try
+ LSuccess := LEpConnection._UpdateIoEvent([ieRead]);
+ finally
+ LEpConnection._EpUnlock;
+ end;
+
+ if not LSuccess then
+ begin
+ _Log('_HandleAccept._UpdateIoEvent failed, %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ end;
+ end;
+end;
+
+procedure TEpollCrossSocket._HandleConnect(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LSockErr: Integer;
+begin
+ LConnection := AConnection;
+
+ // Connect失败
+ LSockErr := TSocketAPI.GetError(LConnection.Socket);
+ if (LSockErr <> 0) then
+ begin
+ LConnection.LastNetError := LSockErr;
+ _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
+ LConnection.Close;
+ Exit;
+ end;
+
+ TriggerConnected(LConnection);
+end;
+
+procedure TEpollCrossSocket._HandleRead(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LEpConnection: TEpollConnection;
+ LRcvd, LError: Integer;
+begin
+ LConnection := AConnection;
+ LEpConnection := LConnection as TEpollConnection;
+
+ AtomicIncrement(LEpConnection.FInPending);
+ try
+ while True do
+ begin
+ LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
+
+ // 对方主动断开连接
+ if (LRcvd = 0) then
+ begin
+ _Log('Recv=0(Close), %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Break;
+ end;
+
+ if (LRcvd < 0) then
+ begin
+ LError := GetLastError;
+
+ // 被系统信号中断, 可以重新recv
+ if (LError = EINTR) then
+ begin
+ _LogLastOsError('Recv=EINTR, %s', [LConnection.DebugInfo]);
+ Continue
+ end else
+ // 接收缓冲区中数据已经被取完了
+ if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ Break
+ else
+ // 接收出错
+ begin
+ _LogLastOsError('Recv<0, %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Break;
+ end;
+ end;
+
+ TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
+
+ // 回调中可能关闭了连接, 需要检查状态
+ if LConnection.IsClosed then Break;
+
+ if (LRcvd < RCV_BUF_SIZE) then Break;
+ end;
+ finally
+ AtomicDecrement(LEpConnection.FInPending);
+ end;
+end;
+
+procedure TEpollCrossSocket._HandleWrite(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LEpConnection: TEpollConnection;
+ LSendItem: PSendItem;
+ LSent, LError: Integer;
+ LSendCbArr: TArray;
+ LSendCb: TCrossConnectionCallback;
+begin
+ LConnection := AConnection;
+ LEpConnection := LConnection as TEpollConnection;
+ LSendCbArr := [];
+
+ AtomicIncrement(LEpConnection.FOutPending);
+ LEpConnection._EpLock;
+ try
+ while True do
+ begin
+ // 检查队列中有没有数据
+ if (LEpConnection.FSendQueue.Count <= 0) then Break;
+
+ // 获取Socket发送队列中的第一条数据
+ LSendItem := LEpConnection.FSendQueue.Items[0];
+
+ // 发送数据
+ LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size, MSG_NOSIGNAL);
+
+ // 对方主动断开连接
+ if (LSent = 0) then
+ begin
+ _Log('Send=0(Close), %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Break;
+ end;
+
+ // 连接断开或发送错误
+ if (LSent < 0) then
+ begin
+ LError := GetLastError;
+
+ // 被系统信号中断, 可以重新send
+ if (LError = EINTR) then
+ begin
+ _LogLastOsError('Send=EINTR, %s', [LConnection.DebugInfo]);
+ Continue;
+ end else
+ // 发送缓冲区已被填满了, 需要等下次唤醒发送线程再继续发送
+ if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ Break
+ // 发送出错
+ else
+ begin
+ _LogLastOsError('Send<0, %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Break;
+ end;
+ end;
+
+ // 全部发送完成
+ if (LSent >= LSendItem.Size) then
+ begin
+ TArrayUtils.Append(LSendCbArr, LSendItem.Callback);
+
+ // 发送成功, 移除已发送成功的数据
+ // 必须先从队列移除已发完的数据项, 然后再执行发送成功的回调
+ // 因为回调里可能还会发送新的数据, 如果先执行回调再去移除,
+ // 就会错误的将回调中放到队列里的新数据移除
+ if (LEpConnection.FSendQueue.Count > 0) then
+ LEpConnection.FSendQueue.Delete(0);
+ end else
+ begin
+ // 部分发送成功, 在下一次唤醒发送线程时继续处理剩余部分
+ Dec(LSendItem.Size, LSent);
+ Inc(LSendItem.Data, LSent);
+ end;
+ end;
+ finally
+ LEpConnection._EpUnlock;
+ AtomicDecrement(LEpConnection.FOutPending);
+ end;
+
+ // 调用回调
+ for LSendCb in LSendCbArr do
+ LSendCb(LConnection, True);
+end;
+
+procedure TEpollCrossSocket._OpenIdleHandle;
+begin
+ FIdleHandle := FileOpen('/dev/null', fmOpenRead);
+end;
+
+procedure TEpollCrossSocket._OpenStopHandle;
+var
+ LEvent: TEPoll_Event;
+begin
+ FStopHandle := eventfd(0, 0);
+ // 这里不使用 EPOLLET
+ // 这样可以保证通知退出的命令发出后, 所有IO线程都会收到
+ LEvent.Events := EPOLLIN;
+ LEvent.Data.u64 := SHUTDOWN_FLAG;
+ epoll_ctl(FEpollHandle, EPOLL_CTL_ADD, FStopHandle, @LEvent);
+end;
+
+procedure TEpollCrossSocket._PostStopCommand;
+var
+ LStuff: UInt64;
+begin
+ LStuff := 1;
+ // 往 FStopHandle 写入任意数据, 唤醒工作线程
+ FileWrite(FStopHandle, LStuff, SizeOf(LStuff));
+end;
+
+procedure TEpollCrossSocket.StartLoop;
+var
+ I: Integer;
+begin
+ if (FIoThreads <> nil) then Exit;
+
+ _OpenIdleHandle;
+
+ // epoll_create(size)
+ // 这个 size 只要传递大于0的任何值都可以
+ // 并不是说队列的大小会受限于该值
+ // http://man7.org/linux/man-pages/man2/epoll_create.2.html
+ FEpollHandle := epoll_create(MAX_EVENT_COUNT);
+ SetLength(FIoThreads, GetIoThreads);
+ for I := 0 to Length(FIoThreads) - 1 do
+ FIoThreads[I] := TIoEventThread.Create(Self);
+
+ _OpenStopHandle;
+end;
+
+procedure TEpollCrossSocket.StopLoop;
+var
+ I: Integer;
+ LCurrentThreadID: TThreadID;
+begin
+ if (FIoThreads = nil) then Exit;
+
+ CloseAll;
+
+ while (FListensCount > 0) or (FConnectionsCount > 0) do Sleep(1);
+
+ _PostStopCommand;
+
+ LCurrentThreadID := GetCurrentThreadId;
+ for I := 0 to Length(FIoThreads) - 1 do
+ begin
+ if (FIoThreads[I].ThreadID = LCurrentThreadID) then
+ raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
+
+ FIoThreads[I].WaitFor;
+ FreeAndNil(FIoThreads[I]);
+ end;
+ FIoThreads := nil;
+
+ FileClose(FEpollHandle);
+ _CloseIdleHandle;
+ _CloseStopHandle;
+end;
+
+procedure TEpollCrossSocket.Connect(const AHost: string;
+ const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
+
+ procedure _Failed1;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ end;
+
+ function _Connect(ASocket: TSocket; AAddr: PRawAddrInfo): Boolean;
+ procedure _Failed2;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ TSocketAPI.CloseSocket(ASocket);
+ end;
+ var
+ LSockAddr: TRawSockAddrIn;
+ LConnection: ICrossConnection;
+ LEpConnection: TEpollConnection;
+ begin
+ FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
+ LSockAddr.AddrLen := AAddr.ai_addrlen;
+ if (AAddr.ai_family = AF_INET6) then
+ begin
+ LSockAddr.Addr6.sin6_family := AAddr.ai_family;
+ LSockAddr.Addr6.sin6_port := htons(ALocalPort);
+ end else
+ begin
+ LSockAddr.Addr.sin_family := AAddr.ai_family;
+ LSockAddr.Addr.sin_port := htons(ALocalPort);
+ end;
+ if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TEpollCrossSocket._Connect.Bind');
+ {$ENDIF}
+ _Failed2;
+ Exit(False);
+ end;
+
+ if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0)
+ or (GetLastError = EINPROGRESS) then
+ begin
+ LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
+ TriggerConnecting(LConnection);
+ LEpConnection := LConnection as TEpollConnection;
+
+ LEpConnection._EpLock;
+ try
+ LEpConnection.ConnectStatus := csConnecting;
+ if not LEpConnection._UpdateIoEvent([ieWrite]) then
+ begin
+ LConnection.Close;
+ Exit(False);
+ end;
+ finally
+ LEpConnection._EpUnlock;
+ end;
+ end else
+ begin
+ _LogLastOsError('Connect');
+
+ _Failed2;
+ Exit(False);
+ end;
+
+ Result := True;
+ end;
+
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LSocket: TSocket;
+begin
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ _Failed1;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol);
+ if (LSocket = INVALID_SOCKET) then
+ begin
+ _LogLastOsError('NewSocket');
+
+ _Failed1;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LSocket, True);
+ SetKeepAlive(LSocket);
+
+ if _Connect(LSocket, LAddrInfo) then Exit;
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+
+ _Failed1;
+end;
+
+function TEpollCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
+begin
+ Result := TEpollConnection.Create(
+ AOwner,
+ AClientSocket,
+ AConnectType,
+ AHost,
+ AConnectCb);
+end;
+
+function TEpollCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
+ const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
+begin
+ Result := TEpollListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
+end;
+
+procedure TEpollCrossSocket.Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback);
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LListenSocket: TSocket;
+ LListen: ICrossListen;
+ LEpListen: TEpollListen;
+ LListenSuccess, LUpdateIoEventSuccess: Boolean;
+
+ procedure _Failed;
+ begin
+ if not LListenSuccess and Assigned(ACallback) then
+ ACallback(LListen, False);
+
+ if (LListen <> nil) then
+ LListen.Close
+ else if (LListenSocket <> INVALID_SOCKET) then
+ TSocketAPI.CloseSocket(LListenSocket);
+ end;
+
+begin
+ LListenSuccess := False;
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+ LHints.ai_flags := AI_PASSIVE;
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TEpollCrossSocket.Listen.GetAddrInfo');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LListen := nil;
+ LListenSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol);
+ if (LListenSocket = INVALID_SOCKET) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TEpollCrossSocket.Listen.NewSocket');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LListenSocket, True);
+ TSocketAPI.SetReUsePort(LListenSocket, True);
+
+ if (LAddrInfo.ai_family = AF_INET6) then
+ TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
+
+ if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0)
+ or (TSocketAPI.Listen(LListenSocket) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TEpollCrossSocket.Listen.Bind');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
+ LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
+ LEpListen := LListen as TEpollListen;
+
+ // 监听套接字的读事件
+ // 读事件到达表明有新连接
+ LEpListen._Lock;
+ try
+ LUpdateIoEventSuccess := LEpListen._UpdateIoEvent([ieRead]);
+ finally
+ LEpListen._Unlock;
+ end;
+
+ if not LUpdateIoEventSuccess then
+ begin
+ _Failed;
+ Exit;
+ end;
+
+ // 监听成功
+ LListenSuccess := True;
+ TriggerListened(LListen);
+ if Assigned(ACallback) then
+ ACallback(LListen, True);
+
+ // 如果端口传入0，让所有地址统一用首个分配到的端口
+ if (APort = 0) and (LAddrInfo.ai_next <> nil) then
+ Psockaddr_in(LAddrInfo.ai_next.ai_addr).sin_port := htons(LListen.LocalPort);
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+end;
+
+procedure TEpollCrossSocket.Send(const AConnection: ICrossConnection;
+ const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
+var
+ LEpConnection: TEpollConnection;
+ LSendItem: PSendItem;
+begin
+ // 测试过先发送, 然后将剩余部分放入发送队列的做法
+ // 发现会引起内存访问异常, 放到队列里到IO线程中发送则不会有问题
+ {$region '放入发送队列'}
+ System.New(LSendItem);
+ FillChar(LSendItem^, SizeOf(TSendItem), 0);
+ LSendItem.Data := ABuf;
+ LSendItem.Size := ALen;
+ LSendItem.Callback := ACallback;
+
+ LEpConnection := AConnection as TEpollConnection;
+
+ LEpConnection._Eplock;
+ try
+ // 将数据放入队列
+ LEpConnection.FSendQueue.Add(LSendItem);
+
+ // 由于epoll队列中每个套接字只有一条记录, 为了避免监视发送数据的时候
+ // 无法接收数据, 这里必须同时监视读和写
+ LEpConnection._UpdateIoEvent([ieRead, ieWrite]);
+ finally
+ LEpConnection._EpUnlock;
+ end;
+ {$endregion}
+end;
+
+function TEpollCrossSocket.ProcessIoEvent: Boolean;
+var
+ LRet, I: Integer;
+ LEvent: TEPoll_Event;
+ LCrossUID: UInt64;
+ LCrossTag: Byte;
+ LListens: TCrossListens;
+ LConnections: TCrossConnections;
+ LListen: ICrossListen;
+ LEpListen: TEpollListen;
+ LConnection: ICrossConnection;
+ LEpConnection: TEpollConnection;
+ LSuccess: Boolean;
+ LIoEvents: TIoEvents;
+begin
+ // 被系统信号打断或者出错会返回-1, 具体需要根据错误代码判断
+ LRet := epoll_wait(FEpollHandle, @FEventList[0], MAX_EVENT_COUNT, -1);
+ if (LRet < 0) then
+ begin
+ _LogLastOsError('epoll_wait');
+ LRet := GetLastError;
+ // EINTR, epoll_wait 调用被系统信号打断, 可以进行重试
+ Exit(LRet = EINTR);
+ end;
+
+ for I := 0 to LRet - 1 do
+ begin
+ LEvent := FEventList[I];
+
+ // 收到退出命令
+ if (LEvent.Data.u64 = SHUTDOWN_FLAG) then Exit(False);
+
+ {$region '获取连接或监听对象'}
+ LCrossUID := LEvent.Data.u64;
+ LCrossTag := GetTagByUID(LCrossUID);
+ LListen := nil;
+ LConnection := nil;
+
+ {$IFDEF DEBUG}
+// _Log('epoll events %.8x, uid %.16x, tag %d', [LEvent.Events, LEvent.Data.u64, LCrossTag]);
+ {$ENDIF}
+ case LCrossTag of
+ UID_LISTEN:
+ begin
+ LListens := LockListens;
+ try
+ if not LListens.TryGetValue(LCrossUID, LListen)
+ or (LListen = nil) then
+ Continue;
+ finally
+ UnlockListens;
+ end;
+ end;
+
+ UID_CONNECTION:
+ begin
+ LConnections := LockConnections;
+ try
+ if not LConnections.TryGetValue(LCrossUID, LConnection)
+ or (LConnection = nil) then
+ Continue;
+ finally
+ UnlockConnections;
+ end;
+ end;
+ else
+ Continue;
+ end;
+ {$endregion}
+
+ {$region 'IO事件处理'}
+ if (LListen <> nil) then
+ begin
+ if (LEvent.Events and EPOLLIN <> 0) then
+ _HandleAccept(LListen);
+
+ // 继续接收新连接
+ LEpListen := LListen as TEpollListen;
+ LEpListen._Lock;
+ LEpListen._UpdateIoEvent([ieRead]);
+ LEpListen._Unlock;
+ end else
+ if (LConnection <> nil) then
+ begin
+ // 连接被断开
+ if (LEvent.Events and EPOLLERR <> 0)
+ or (LEvent.Events and EPOLLHUP <> 0) then
+ begin
+ _Log('epoll_wait, %s, EPOLLERR=%d, EPOLLHUP=%d', [
+ LConnection.DebugInfo,
+ LEvent.Events and EPOLLERR,
+ LEvent.Events and EPOLLHUP
+ ]);
+ LConnection.Close;
+ Continue;
+ end;
+
+ // epoll的读写事件同一时间可能两个同时触发
+ if (LEvent.Events and EPOLLIN <> 0) then
+ _HandleRead(LConnection);
+
+ if (LEvent.Events and EPOLLOUT <> 0) then
+ begin
+ if (LConnection.ConnectStatus = csConnecting) then
+ _HandleConnect(LConnection)
+ else
+ _HandleWrite(LConnection);
+ end;
+
+ // 把更新连接的IO事件放到这里统一处理
+ // 当读写同时触发的情况, 可以节省一次IO事件更新
+ if not LConnection.IsClosed then
+ begin
+ LEpConnection := LConnection as TEpollConnection;
+ LEpConnection._EpLock;
+ try
+ if (LEpConnection.FSendQueue.Count > 0) then
+ LIoEvents := [ieRead, ieWrite]
+ else
+ LIoEvents := [ieRead];
+ LEpConnection._UpdateIoEvent(LIoEvents);
+ finally
+ LEpConnection._EpUnlock;
+ end;
+ end;
+ end;
+ {$endregion}
+ end;
+
+ Result := True;
+end;
+
+end.
diff --git a/Net/Net.CrossSocket.Iocp.pas b/Net/Net.CrossSocket.Iocp.pas
index 1e9523c..47a3ba0 100644
--- a/Net/Net.CrossSocket.Iocp.pas
+++ b/Net/Net.CrossSocket.Iocp.pas
@@ -1,891 +1,891 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossSocket.Iocp;
-
-{$I zLib.inc}
-
-interface
-
-uses
- SysUtils,
- Classes,
- Windows,
-
- Net.Winsock2,
- Net.Wship6,
- Net.SocketAPI,
- Net.CrossSocket.Base;
-
-type
- TIocpListen = class(TCrossListenBase)
- end;
-
- TIocpConnection = class(TCrossConnectionBase)
- end;
-
- TIocpCrossSocket = class(TCrossSocketBase)
- private const
- SHUTDOWN_FLAG = ULONG_PTR(-1);
- SO_UPDATE_CONNECT_CONTEXT = $7010;
- IPV6_V6ONLY = 27;
- ERROR_ABANDONED_WAIT_0 = $02DF;
- private type
- TAddrUnion = record
- case Integer of
- 0: (IPv4: TSockAddrIn);
- 1: (IPv6: TSockAddrIn6);
- end;
-
- TAddrBuffer = record
- Addr: TAddrUnion;
- Extra: array [0..15] of Byte;
- end;
-
- TAcceptExBuffer = array[0..SizeOf(TAddrBuffer) * 2 - 1] of Byte;
-
- TPerIoBufUnion = record
- case Integer of
- 0: (DataBuf: WSABUF);
- // 这个Buffer只用于AcceptEx保存终端地址数据，大小为2倍地址结构
- 1: (AcceptExBuffer: TAcceptExBuffer);
- end;
-
- TIocpAction = (ioAccept, ioConnect, ioRead, ioWrite);
-
- PPerIoData = ^TPerIoData;
- TPerIoData = record
- Overlapped: TWSAOverlapped;
- Buffer: TPerIoBufUnion;
- Action: TIocpAction;
- Socket: TSocket;
- CrossData: ICrossData;
- Callback: TCrossConnectionCallback;
- end;
- private
- FIocpHandle: THandle;
- FIoThreads: TArray;
- FPerIoDataCount: NativeInt;
-
- function _NewIoData: PPerIoData; inline;
- procedure _FreeIoData(const P: PPerIoData); inline;
-
- procedure _NewAccept(const AListen: ICrossListen);
- function _NewReadZero(const AConnection: ICrossConnection): Boolean;
-
- procedure _HandleAccept(const APerIoData: PPerIoData);
- procedure _HandleConnect(const APerIoData: PPerIoData);
- procedure _HandleRead(const APerIoData: PPerIoData);
- procedure _HandleWrite(const APerIoData: PPerIoData);
- protected
- function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
- const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
- function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
-
- procedure StartLoop; override;
- procedure StopLoop; override;
-
- procedure Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback = nil); override;
-
- procedure Connect(const AHost: string; const APort, ALocalPort: Word;
- const ACallback: TCrossConnectionCallback = nil); override;
-
- procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer;
- const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override;
-
- function ProcessIoEvent: Boolean; override;
- end;
-
-implementation
-
-{ TIocpCrossSocket }
-
-function TIocpCrossSocket._NewIoData: PPerIoData;
-begin
- GetMem(Result, SizeOf(TPerIoData));
- FillChar(Result^, SizeOf(TPerIoData), 0);
- System.Initialize(Result^);
-
- AtomicIncrement(FPerIoDataCount);
-end;
-
-procedure TIocpCrossSocket._FreeIoData(const P: PPerIoData);
-begin
- if (P = nil) then Exit;
-
- System.Finalize(P^);
- FreeMem(P, SizeOf(TPerIoData));
-
- AtomicDecrement(FPerIoDataCount);
-end;
-
-procedure TIocpCrossSocket._NewAccept(const AListen: ICrossListen);
-var
- LClientSocket: TSocket;
- LPerIoData: PPerIoData;
- LBytes: Cardinal;
-begin
- LClientSocket := WSASocket(AListen.Family, AListen.SockType, AListen.Protocol,
- nil, 0, WSA_FLAG_OVERLAPPED);
- if (LClientSocket = INVALID_SOCKET) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '._NewAccept.WSASocket, %s', [AListen.DebugInfo]);
- {$ENDIF}
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LClientSocket, True);
- SetKeepAlive(LClientSocket);
-
- LPerIoData := _NewIoData;
- LPerIoData.Action := ioAccept;
- LPerIoData.Socket := LClientSocket;
- LPerIoData.CrossData := AListen;
-
- if (not AcceptEx(AListen.Socket, LClientSocket, @LPerIoData.Buffer.AcceptExBuffer, 0,
- SizeOf(TAddrBuffer), SizeOf(TAddrBuffer), LBytes, POverlapped(LPerIoData)))
- and (WSAGetLastError <> WSA_IO_PENDING) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '._NewAccept.AcceptEx, %s', [AListen.DebugInfo]);
- {$ENDIF}
- TSocketAPI.CloseSocket(LClientSocket);
- _FreeIoData(LPerIoData);
- end;
-end;
-
-function TIocpCrossSocket._NewReadZero(const AConnection: ICrossConnection): Boolean;
-var
- LPerIoData: PPerIoData;
- LBytes, LFlags: Cardinal;
-begin
- LPerIoData := _NewIoData;
- LPerIoData.Buffer.DataBuf.buf := nil;
- LPerIoData.Buffer.DataBuf.len := 0;
- LPerIoData.Action := ioRead;
- LPerIoData.Socket := AConnection.Socket;
- LPerIoData.CrossData := AConnection;
-
- LFlags := 0;
- LBytes := 0;
- if (WSARecv(AConnection.Socket, @LPerIoData.Buffer.DataBuf, 1, LBytes, LFlags, PWSAOverlapped(LPerIoData), nil) < 0)
- and (WSAGetLastError <> WSA_IO_PENDING) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '._NewReadZero.WSARecv, %s', [AConnection.DebugInfo]);
- {$ENDIF}
- _FreeIoData(LPerIoData);
- Exit(False);
- end;
-
- Result := True;
-end;
-
-procedure TIocpCrossSocket._HandleAccept(const APerIoData: PPerIoData);
-var
- LListen: ICrossListen;
- LConnection: ICrossConnection;
- LClientSocket, LListenSocket: TSocket;
-begin
- if (APerIoData.CrossData = nil) then Exit;
-
- LListen := APerIoData.CrossData as ICrossListen;
-
- _NewAccept(LListen);
-
- LClientSocket := APerIoData.Socket;
- LListenSocket := LListen.Socket;
-
- // 不设置该参数, 会导致 getpeername 调用失败
- if (TSocketAPI.SetSockOpt(LClientSocket, SOL_SOCKET,
- SO_UPDATE_ACCEPT_CONTEXT, LListenSocket) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '._HandleAccept.SetSockOpt');
- {$ENDIF}
- TSocketAPI.CloseSocket(LClientSocket);
- Exit;
- end;
-
- if (CreateIoCompletionPort(LClientSocket, FIocpHandle, ULONG_PTR(LClientSocket), 0) = 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '._HandleAccept.CreateIoCompletionPort');
- {$ENDIF}
- TSocketAPI.CloseSocket(LClientSocket);
- Exit;
- end;
-
- LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
- TriggerConnecting(LConnection);
- TriggerConnected(LConnection);
-
- if not _NewReadZero(LConnection) then
- LConnection.Close;
-end;
-
-procedure TIocpCrossSocket._HandleConnect(const APerIoData: PPerIoData);
-var
- LClientSocket: TSocket;
- LConnection: ICrossConnection;
- LSockErr: Integer;
-begin
- LClientSocket := APerIoData.Socket;
- LConnection := APerIoData.CrossData as ICrossConnection;
-
- LSockErr := TSocketAPI.GetError(LClientSocket);
- if (LSockErr <> 0) then
- begin
- if (LConnection <> nil) then
- LConnection.LastNetError := LSockErr;
- _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
- LConnection.Close;
- Exit;
- end;
-
- // 不设置该参数, 会导致 getpeername 调用失败
- if (TSocketAPI.SetSockOpt(LClientSocket, SOL_SOCKET,
- SO_UPDATE_CONNECT_CONTEXT, 1) < 0) then
- begin
- if (LConnection <> nil) then
- LConnection.LastNetError := WSAGetLastError;
- _LogLastOsError(Self.ClassName + '._HandleConnect.SetSockOpt');
- LConnection.Close;
- Exit;
- end;
-
- TriggerConnected(LConnection);
-
- if not _NewReadZero(LConnection) then
- LConnection.Close;
-end;
-
-procedure TIocpCrossSocket._HandleRead(const APerIoData: PPerIoData);
-var
- LConnection: ICrossConnection;
- LRcvd, LError: Integer;
-begin
- if (APerIoData.CrossData = nil) then
- begin
- if Assigned(APerIoData.Callback) then
- APerIoData.Callback(nil, False);
- Exit;
- end;
-
- LConnection := APerIoData.CrossData as ICrossConnection;
-
- while True do
- begin
- LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
-
- // 对方主动断开连接
- if (LRcvd = 0) then
- begin
- _Log(Self.ClassName + '.Recv=0(Close), %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Exit;
- end;
-
- if (LRcvd < 0) then
- begin
- LError := GetLastError;
-
- // 被系统信号中断, 可以重新recv
- if (LError = WSAEINTR) then
- Continue
- // 接收缓冲区中数据已经被取完了
- else if (LError = WSAEWOULDBLOCK) or (LError = WSAEINPROGRESS) then
- Break
- // 接收出错
- else
- begin
- _LogLastOsError(Self.ClassName + '.Recv<0, %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Exit;
- end;
- end;
-
- {$IFDEF DEBUG}
- _Log('[%s]thread%d, _HandleRead.TriggerReceived准备执行, LRcvd=%d', [
- Self.ClassName, TThread.Current.ThreadID, LRcvd
- ]);
- {$ENDIF}
- TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
- {$IFDEF DEBUG}
- _Log('[%s]thread%d, _HandleRead.TriggerReceived执行完成, LRcvd=%d', [
- Self.ClassName, TThread.Current.ThreadID, LRcvd
- ]);
- {$ENDIF}
-
- // 回调中可能关闭了连接, 需要检查状态
- if LConnection.IsClosed then Exit;
-
- if (LRcvd < RCV_BUF_SIZE) then Break;
- end;
-
- if not _NewReadZero(LConnection) then
- LConnection.Close;
-end;
-
-procedure TIocpCrossSocket._HandleWrite(const APerIoData: PPerIoData);
-begin
- if Assigned(APerIoData.Callback) then
- APerIoData.Callback(APerIoData.CrossData as ICrossConnection, True);
-end;
-
-procedure TIocpCrossSocket.StartLoop;
-var
- I: Integer;
-begin
- if (FIoThreads <> nil) then Exit;
-
- FIocpHandle := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
- SetLength(FIoThreads, GetIoThreads);
- for I := 0 to Length(FIoThreads) - 1 do
- FIoThreads[I] := TIoEventThread.Create(Self);
-end;
-
-procedure TIocpCrossSocket.StopLoop;
-
- // IO 线程在收到 SHUTDOWN_FLAG 标记之后就会退出
- // 而这时候有可能还有部分操作未完成, 其对应的 PerIoData 结构就无法释放
- // 只需要在这里再次接收完成端口的消息, 就能等到这部分未完成的操作超时或失败
- // 从而释放其对应的 PerIoData 结构
- //
- // 超时仍未清零时: 输出错误日志诊断遗留, 仍关闭 IOCP handle (避免 OS 句柄泄漏).
- // 因 IO 线程已退出, 此处与 _HandleXxx 路径互斥, 无 PerIoData 重复释放风险.
- procedure _FreeMissingPerIoDatas;
- const
- DEFAULT_DRAIN_TIMEOUT_MS = 3000;
- POLL_STEP_MS = 10;
- var
- LBytes: Cardinal;
- LSocket: TSocket;
- LPerIoData: PPerIoData;
- LConnection: ICrossConnection;
- LMaxWait, LRemaining: Integer;
- begin
- LMaxWait := DEFAULT_DRAIN_TIMEOUT_MS;
- LRemaining := LMaxWait;
-
- while (AtomicCmpExchange(FPerIoDataCount, 0, 0) > 0) and (LRemaining > 0) do
- begin
- GetQueuedCompletionStatus(FIocpHandle, LBytes, ULONG_PTR(LSocket), POverlapped(LPerIoData), POLL_STEP_MS);
-
- if (LPerIoData = nil) then
- begin
- Dec(LRemaining, POLL_STEP_MS);
- Continue;
- end;
-
- try
- TSocketAPI.CloseSocket(LPerIoData.Socket);
-
- if Assigned(LPerIoData.Callback) then
- begin
- if (LPerIoData.CrossData <> nil)
- and (LPerIoData.CrossData is TIocpConnection) then
- LConnection := LPerIoData.CrossData as ICrossConnection
- else
- LConnection := nil;
-
- LPerIoData.Callback(LConnection, False);
- end;
-
- if (LPerIoData.CrossData <> nil) then
- LPerIoData.CrossData.Close;
- finally
- _FreeIoData(LPerIoData);
- end;
- end;
-
- // 超时仍未清零: 不静默, 强制 _Log (受 CrossSocketLogEnabled 全局开关控制)
- if (AtomicCmpExchange(FPerIoDataCount, 0, 0) > 0) then
- _Log('[%s][StopLoop] WARNING: drain 超时 %dms, 仍有 %d 个 PerIoData 未回收, 即将关闭 IOCP handle',
- [Self.ClassName, LMaxWait, AtomicCmpExchange(FPerIoDataCount, 0, 0)]);
- end;
-
-var
- I: Integer;
- LCurrentThreadID: TThreadID;
-begin
- if (FIoThreads = nil) then Exit;
-
- {$IFDEF DEBUG}
- _Log('[%s][StopLoop] 开始停止, 线程数=%d', [
- Self.ClassName, Length(FIoThreads)]);
- {$ENDIF}
- CloseAll;
-
- {$IFDEF DEBUG}
- _Log('[%s][StopLoop] 等待连接关闭, ListensCount=%d, ConnectionsCount=%d', [
- Self.ClassName, ListensCount, ConnectionsCount
- ]);
- {$ENDIF}
- while (ListensCount > 0) or (ConnectionsCount > 0) do Sleep(1);
-
- {$IFDEF DEBUG}
- _Log('[%s][StopLoop] 发送 SHUTDOWN_FLAG 唤醒所有线程', [
- Self.ClassName
- ]);
- {$ENDIF}
- for I := 0 to Length(FIoThreads) - 1 do
- PostQueuedCompletionStatus(FIocpHandle, 0, 0, POverlapped(SHUTDOWN_FLAG));
-
- LCurrentThreadID := GetCurrentThreadId;
- for I := 0 to Length(FIoThreads) - 1 do
- begin
- if (FIoThreads[I].ThreadID = LCurrentThreadID) then
- raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
-
- {$IFDEF DEBUG}
- _Log('[%s]thread%d[StopLoop] 等待线程 %d 退出', [
- Self.ClassName, FIoThreads[I].ThreadID, I
- ]);
- {$ENDIF}
- FIoThreads[I].WaitFor;
- {$IFDEF DEBUG}
- _Log('[%s]thread%d[StopLoop] 线程 %d 已退出', [
- Self.ClassName, FIoThreads[I].ThreadID, I]);
- {$ENDIF}
- FreeAndNil(FIoThreads[I]);
- end;
- FIoThreads := nil;
-
- _FreeMissingPerIoDatas;
- CloseHandle(FIocpHandle);
-end;
-
-procedure TIocpCrossSocket.Connect(const AHost: string;
- const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LSocket: TSocket;
-
- procedure _Failed1;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- end;
-
- function _Connect(ASocket: TSocket; AAddr: PRawAddrInfo): Boolean;
- procedure _Failed2;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- TSocketAPI.CloseSocket(ASocket);
- end;
- var
- LSockAddr: TRawSockAddrIn;
- LPerIoData: PPerIoData;
- LBytes: Cardinal;
- LConnection: ICrossConnection;
- begin
- FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
- LSockAddr.AddrLen := AAddr.ai_addrlen;
- if (AAddr.ai_family = AF_INET6) then
- begin
- LSockAddr.Addr6.sin6_family := AAddr.ai_family;
- LSockAddr.Addr6.sin6_port := htons(ALocalPort);
- end else
- begin
- LSockAddr.Addr.sin_family := AAddr.ai_family;
- LSockAddr.Addr.sin_port := htons(ALocalPort);
- end;
- if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
- begin
- _LogLastOsError(Self.ClassName + '._Connect.Bind');
- _Failed2;
- Exit(False);
- end;
-
- if (CreateIoCompletionPort(ASocket, FIocpHandle, ULONG_PTR(ASocket), 0) = 0) then
- begin
- _LogLastOsError(Self.ClassName + '._Connect.CreateIoCompletionPort');
- _Failed2;
- Exit(False);
- end;
-
- LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
- TriggerConnecting(LConnection);
-
- LPerIoData := _NewIoData;
- LPerIoData.Action := ioConnect;
- LPerIoData.CrossData := LConnection;
- LPerIoData.Socket := ASocket;
- LPerIoData.Callback := nil;
- if not ConnectEx(ASocket, AAddr.ai_addr, AAddr.ai_addrlen, nil, 0, LBytes, PWSAOverlapped(LPerIoData)) and
- (WSAGetLastError <> WSA_IO_PENDING) then
- begin
- // 先保存 WSAGetLastError 再记录日志, 避免后续 API 调用改写 lastError
- if (LConnection <> nil) then
- LConnection.LastNetError := WSAGetLastError;
- _LogLastOsError(Self.ClassName + '._Connect.ConnectEx');
- _FreeIoData(LPerIoData);
- LConnection.Close;
- Exit(False);
- end;
-
- Result := True;
- end;
-
-begin
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- _LogLastOsError(Self.ClassName + '.Connect.GetAddrInfo');
- _Failed1;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LSocket := WSASocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol, nil, 0, WSA_FLAG_OVERLAPPED);
- if (LSocket = INVALID_SOCKET) then
- begin
- _LogLastOsError(Self.ClassName + '.Connect.WSASocket');
- _Failed1;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LSocket, True);
- SetKeepAlive(LSocket);
-
- {$IFDEF DEBUG}
- _Log('TIocpCrossSocket.Connect.WSASocket=%d', [LSocket]);
- {$ENDIF}
-
- if _Connect(LSocket, LAddrInfo) then Exit;
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-
- _LogLastOsError(Self.ClassName + '.Connect.Unknown');
- _Failed1;
-end;
-
-function TIocpCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
-begin
- Result := TIocpConnection.Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
-end;
-
-function TIocpCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
- const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
-begin
- Result := TIocpListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
-end;
-
-procedure TIocpCrossSocket.Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback);
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LListenSocket: TSocket;
- LListen: ICrossListen;
- I: Integer;
- LListenSuccess: Boolean;
-
- procedure _Failed;
- begin
- if not LListenSuccess and Assigned(ACallback) then
- ACallback(LListen, False);
-
- if (LListen <> nil) then
- LListen.Close
- else if (LListenSocket <> INVALID_SOCKET) then
- TSocketAPI.CloseSocket(LListenSocket);
- end;
-
- procedure _Success;
- begin
- TriggerListened(LListen);
-
- if Assigned(ACallback) then
- ACallback(LListen, True);
- end;
-begin
- LListenSuccess := False;
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
-
- LHints.ai_flags := AI_PASSIVE;
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.Listen.GetAddrInfo');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LListen := nil;
- LListenSocket := WSASocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol, nil, 0, WSA_FLAG_OVERLAPPED);
- if (LListenSocket = INVALID_SOCKET) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.Listen.WSASocket');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LListenSocket, True);
- TSocketAPI.SetReUseAddr(LListenSocket, True);
-
- if (LAddrInfo.ai_family = AF_INET6) then
- TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
-
- if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.Listen.Bind');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- if (TSocketAPI.Listen(LListenSocket) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.Listen.Listen');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
- LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
-
- if (CreateIoCompletionPort(LListenSocket, FIocpHandle, ULONG_PTR(LListenSocket), 0) = 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.Listen.CreateIoCompletionPort');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- // 给每个IO线程投递一个AcceptEx
- for I := 1 to GetIoThreads do
- _NewAccept(LListen);
-
- LListenSuccess := True;
- _Success;
-
- // 如果端口传入0，让所有地址统一用首个分配到的端口
- if (APort = 0) and (LAddrInfo.ai_next <> nil) then
- LAddrInfo.ai_next.ai_addr.sin_port := htons(LListen.LocalPort);
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-end;
-
-procedure TIocpCrossSocket.Send(const AConnection: ICrossConnection;
- const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
-var
- LPerIoData: PPerIoData;
- LBytes, LFlags: Cardinal;
-begin
- LPerIoData := _NewIoData;
- LPerIoData.Buffer.DataBuf.buf := ABuf;
- LPerIoData.Buffer.DataBuf.len := ALen;
- LPerIoData.Action := ioWrite;
- LPerIoData.Socket := AConnection.Socket;
- LPerIoData.CrossData := AConnection;
- LPerIoData.Callback := ACallback;
-
- LFlags := 0;
- LBytes := 0;
- // WSASend 不会出现部分发送的情况, 要么全部失败, 要么全部成功
- // 所以不需要像 kqueue 或 epoll 中调用 send 那样调用完之后还得检查实际发送了多少
- // 唯一需要注意的是: WSASend 会将待发送的数据锁定到非页面内存, 非页面内存资源
- // 是非常紧张的, 所以不要无节制的调用 WSASend, 最好通过回调发送完一批数据再继
- // 续发送下一批
- if (WSASend(AConnection.Socket, @LPerIoData.Buffer.DataBuf, 1, LBytes, LFlags, PWSAOverlapped(LPerIoData), nil) < 0)
- and (WSAGetLastError <> WSA_IO_PENDING) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(Self.ClassName + '.WSASend, %s', [AConnection.DebugInfo]);
- {$ENDIF}
-
- // 出错多半是 WSAENOBUFS, 也就是投递的 WSASend 过多, 来不及发送
- // 导致非页面内存资源全部被锁定, 要避免这种情况必须上层发送逻辑
- // 保证不能无节制的调用Send发送大量数据, 最好发送完一个再继续下
- // 一个, 本函数提供了发送结果的回调函数, 在回调函数报告发送成功
- // 之后就可以继续下一块数据发送了
- _FreeIoData(LPerIoData);
-
- if Assigned(ACallback) then
- ACallback(AConnection, False);
-
- if Assigned(AConnection) then
- AConnection.Close;
- end;
-end;
-
-function TIocpCrossSocket.ProcessIoEvent: Boolean;
- procedure _ReleasePerIoData(const APerIoData: PPerIoData; const AShutdown: Boolean);
- var
- LConnection: ICrossConnection;
- begin
- try
- if (APerIoData.CrossData <> nil) then
- begin
- // AcceptEx虽然成功, 但是Socket句柄耗尽了, 再次投递AcceptEx
- if (APerIoData.Action = ioAccept) then
- begin
- // 照理说能执行到这里, 说明Socket分配失败了
- // 但是为了以防万一, 这里还是判断一下并释放掉无效的Socket句柄
- if (APerIoData.Socket <> 0) then
- TSocketAPI.CloseSocket(APerIoData.Socket);
-
- // 关闭监听后会触发该错误, 这种情况不应该继续投递
- if not AShutdown then
- begin
- _Log('[%s]thread%d, _NewAccept', [Self.ClassName, TThread.Current.ThreadID]);
- _NewAccept(APerIoData.CrossData as ICrossListen);
- end;
- end else
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(
- Format(Self.ClassName + '.ProcessIoEvent.GetQueuedCompletionStatus.CrossDataNotNil(socket=%d, action=%d)',
- [APerIoData.Socket, Ord(APerIoData.Action)])
- );
- {$ENDIF}
- if Assigned(APerIoData.Callback) then
- begin
- if (APerIoData.CrossData is TIocpConnection) then
- LConnection := APerIoData.CrossData as ICrossConnection
- else
- LConnection := nil;
-
- APerIoData.Callback(LConnection, False);
- end;
-
- APerIoData.CrossData.Close;
- end;
- end else
- begin
- {$IFDEF DEBUG}
- _LogLastOsError(
- Format(Self.ClassName + '.ProcessIoEvent.GetQueuedCompletionStatus.CrossDataIsNil(socket=%d, action=%d)',
- [APerIoData.Socket, Ord(APerIoData.Action)])
- );
- {$ENDIF}
- if Assigned(APerIoData.Callback) then
- APerIoData.Callback(nil, False);
-
- if (APerIoData.Socket <> 0) then
- TSocketAPI.CloseSocket(APerIoData.Socket);
- end;
- finally
- _FreeIoData(APerIoData);
- end;
- end;
-var
- LBytes: Cardinal;
- LSocket: TSocket;
- LPerIoData: PPerIoData;
- LErrNo: Cardinal;
- LIocpClosed: Boolean;
-begin
- if not GetQueuedCompletionStatus(FIocpHandle, LBytes, ULONG_PTR(LSocket), POverlapped(LPerIoData), INFINITE) then
- begin
- // ERROR_INVALID_HANDLE, 6, IOCP句柄被关闭
- // ERROR_ABANDONED_WAIT_0, $02DF, IOCP句柄被关闭
- // WSA_OPERATION_ABORTED, 995, 监听端口被关闭, 由于线程退出或应用程序请求，已中止 I/O 操作。
- // WSAENOTSOCK, 10038, 在一个非套接字上尝试了一个操作。
- // WSAESHUTDOWN, 10058, 套接字已关闭
- // ERROR_NETNAME_DELETED, 64, 指定的网络名不再可用
- // ERROR_CONNECTION_REFUSED, 1225, 远程计算机拒绝网络连接。
- LErrNo := GetLastError;
-
- // 完成端口被关闭时可能会触发 ERROR_INVALID_HANDLE 和 ERROR_ABANDONED_WAIT_0
- // 监听端口被关闭时会触发 WSA_OPERATION_ABORTED
- LIocpClosed := (LErrNo = ERROR_INVALID_HANDLE)
- or (LErrNo = ERROR_ABANDONED_WAIT_0)
- or (LErrNo = WSA_OPERATION_ABORTED);
- {$IFDEF DEBUG}
- _Log('[%s]thread%d, GetQueuedCompletionStatus:%d, %s', [
- Self.ClassName, TThread.Current.ThreadID, LErrNo, SysErrorMessage(LErrNo)
- ]);
- {$ENDIF}
-
- // 出错了, 并且完成数据也都是空的,
- // 这种情况即便重试, 应该也会继续出错, 最好立即终止IO线程
- if (LPerIoData = nil) then Exit(False);
-
- // 出错了, 回收资源
- _ReleasePerIoData(LPerIoData, LIocpClosed);
-
- // 出错了, 但是完成数据不是空的, 需要重试
- Exit(not LIocpClosed);
- end;
-
- // 主动调用了 StopLoop
- if (LBytes = 0) and (ULONG_PTR(LPerIoData) = SHUTDOWN_FLAG) then Exit(False);
-
- // 由于未知原因未获取到完成数据, 但是返回的错误代码又是正常
- // 这种情况需要进行重试(返回True之后IO线程会再次调用ProcessIoEvent)
- if (LPerIoData = nil) then Exit(True);
-
- try
- {$IFDEF DEBUG}
- _Log('[%s]thread%d, 准备处理IOCP事件 PerIoData=%p, Action=%d, Bytes=%d', [
- Self.ClassName, TThread.Current.ThreadID, Pointer(LPerIoData), Ord(LPerIoData.Action), LBytes
- ]);
- {$ENDIF}
- case LPerIoData.Action of
- ioAccept : _HandleAccept(LPerIoData);
- ioConnect : _HandleConnect(LPerIoData);
- ioRead : _HandleRead(LPerIoData);
- ioWrite : _HandleWrite(LPerIoData);
- end;
- {$IFDEF DEBUG}
- _Log('[%s]thread%d, 处理IOCP事件完成 PerIoData=%p, Action=%d, Bytes=%d', [
- Self.ClassName, TThread.Current.ThreadID, Pointer(LPerIoData), Ord(LPerIoData.Action), LBytes
- ]);
- {$ENDIF}
- finally
- _FreeIoData(LPerIoData);
- end;
-
- Result := True;
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossSocket.Iocp;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ Windows,
+
+ Net.Winsock2,
+ Net.Wship6,
+ Net.SocketAPI,
+ Net.CrossSocket.Base;
+
+type
+ TIocpListen = class(TCrossListenBase)
+ end;
+
+ TIocpConnection = class(TCrossConnectionBase)
+ end;
+
+ TIocpCrossSocket = class(TCrossSocketBase)
+ private const
+ SHUTDOWN_FLAG = ULONG_PTR(-1);
+ SO_UPDATE_CONNECT_CONTEXT = $7010;
+ IPV6_V6ONLY = 27;
+ ERROR_ABANDONED_WAIT_0 = $02DF;
+ private type
+ TAddrUnion = record
+ case Integer of
+ 0: (IPv4: TSockAddrIn);
+ 1: (IPv6: TSockAddrIn6);
+ end;
+
+ TAddrBuffer = record
+ Addr: TAddrUnion;
+ Extra: array [0..15] of Byte;
+ end;
+
+ TAcceptExBuffer = array[0..SizeOf(TAddrBuffer) * 2 - 1] of Byte;
+
+ TPerIoBufUnion = record
+ case Integer of
+ 0: (DataBuf: WSABUF);
+ // 这个Buffer只用于AcceptEx保存终端地址数据，大小为2倍地址结构
+ 1: (AcceptExBuffer: TAcceptExBuffer);
+ end;
+
+ TIocpAction = (ioAccept, ioConnect, ioRead, ioWrite);
+
+ PPerIoData = ^TPerIoData;
+ TPerIoData = record
+ Overlapped: TWSAOverlapped;
+ Buffer: TPerIoBufUnion;
+ Action: TIocpAction;
+ Socket: TSocket;
+ CrossData: ICrossData;
+ Callback: TCrossConnectionCallback;
+ end;
+ private
+ FIocpHandle: THandle;
+ FIoThreads: TArray;
+ FPerIoDataCount: NativeInt;
+
+ function _NewIoData: PPerIoData; inline;
+ procedure _FreeIoData(const P: PPerIoData); inline;
+
+ procedure _NewAccept(const AListen: ICrossListen);
+ function _NewReadZero(const AConnection: ICrossConnection): Boolean;
+
+ procedure _HandleAccept(const APerIoData: PPerIoData);
+ procedure _HandleConnect(const APerIoData: PPerIoData);
+ procedure _HandleRead(const APerIoData: PPerIoData);
+ procedure _HandleWrite(const APerIoData: PPerIoData);
+ protected
+ function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
+ const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
+ function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
+
+ procedure StartLoop; override;
+ procedure StopLoop; override;
+
+ procedure Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback = nil); override;
+
+ procedure Connect(const AHost: string; const APort, ALocalPort: Word;
+ const ACallback: TCrossConnectionCallback = nil); override;
+
+ procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer;
+ const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override;
+
+ function ProcessIoEvent: Boolean; override;
+ end;
+
+implementation
+
+{ TIocpCrossSocket }
+
+function TIocpCrossSocket._NewIoData: PPerIoData;
+begin
+ GetMem(Result, SizeOf(TPerIoData));
+ FillChar(Result^, SizeOf(TPerIoData), 0);
+ System.Initialize(Result^);
+
+ AtomicIncrement(FPerIoDataCount);
+end;
+
+procedure TIocpCrossSocket._FreeIoData(const P: PPerIoData);
+begin
+ if (P = nil) then Exit;
+
+ System.Finalize(P^);
+ FreeMem(P, SizeOf(TPerIoData));
+
+ AtomicDecrement(FPerIoDataCount);
+end;
+
+procedure TIocpCrossSocket._NewAccept(const AListen: ICrossListen);
+var
+ LClientSocket: TSocket;
+ LPerIoData: PPerIoData;
+ LBytes: Cardinal;
+begin
+ LClientSocket := WSASocket(AListen.Family, AListen.SockType, AListen.Protocol,
+ nil, 0, WSA_FLAG_OVERLAPPED);
+ if (LClientSocket = INVALID_SOCKET) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '._NewAccept.WSASocket, %s', [AListen.DebugInfo]);
+ {$ENDIF}
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LClientSocket, True);
+ SetKeepAlive(LClientSocket);
+
+ LPerIoData := _NewIoData;
+ LPerIoData.Action := ioAccept;
+ LPerIoData.Socket := LClientSocket;
+ LPerIoData.CrossData := AListen;
+
+ if (not AcceptEx(AListen.Socket, LClientSocket, @LPerIoData.Buffer.AcceptExBuffer, 0,
+ SizeOf(TAddrBuffer), SizeOf(TAddrBuffer), LBytes, POverlapped(LPerIoData)))
+ and (WSAGetLastError <> WSA_IO_PENDING) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '._NewAccept.AcceptEx, %s', [AListen.DebugInfo]);
+ {$ENDIF}
+ TSocketAPI.CloseSocket(LClientSocket);
+ _FreeIoData(LPerIoData);
+ end;
+end;
+
+function TIocpCrossSocket._NewReadZero(const AConnection: ICrossConnection): Boolean;
+var
+ LPerIoData: PPerIoData;
+ LBytes, LFlags: Cardinal;
+begin
+ LPerIoData := _NewIoData;
+ LPerIoData.Buffer.DataBuf.buf := nil;
+ LPerIoData.Buffer.DataBuf.len := 0;
+ LPerIoData.Action := ioRead;
+ LPerIoData.Socket := AConnection.Socket;
+ LPerIoData.CrossData := AConnection;
+
+ LFlags := 0;
+ LBytes := 0;
+ if (WSARecv(AConnection.Socket, @LPerIoData.Buffer.DataBuf, 1, LBytes, LFlags, PWSAOverlapped(LPerIoData), nil) < 0)
+ and (WSAGetLastError <> WSA_IO_PENDING) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '._NewReadZero.WSARecv, %s', [AConnection.DebugInfo]);
+ {$ENDIF}
+ _FreeIoData(LPerIoData);
+ Exit(False);
+ end;
+
+ Result := True;
+end;
+
+procedure TIocpCrossSocket._HandleAccept(const APerIoData: PPerIoData);
+var
+ LListen: ICrossListen;
+ LConnection: ICrossConnection;
+ LClientSocket, LListenSocket: TSocket;
+begin
+ if (APerIoData.CrossData = nil) then Exit;
+
+ LListen := APerIoData.CrossData as ICrossListen;
+
+ _NewAccept(LListen);
+
+ LClientSocket := APerIoData.Socket;
+ LListenSocket := LListen.Socket;
+
+ // 不设置该参数, 会导致 getpeername 调用失败
+ if (TSocketAPI.SetSockOpt(LClientSocket, SOL_SOCKET,
+ SO_UPDATE_ACCEPT_CONTEXT, LListenSocket) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '._HandleAccept.SetSockOpt');
+ {$ENDIF}
+ TSocketAPI.CloseSocket(LClientSocket);
+ Exit;
+ end;
+
+ if (CreateIoCompletionPort(LClientSocket, FIocpHandle, ULONG_PTR(LClientSocket), 0) = 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '._HandleAccept.CreateIoCompletionPort');
+ {$ENDIF}
+ TSocketAPI.CloseSocket(LClientSocket);
+ Exit;
+ end;
+
+ LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
+ TriggerConnecting(LConnection);
+ TriggerConnected(LConnection);
+
+ if not _NewReadZero(LConnection) then
+ LConnection.Close;
+end;
+
+procedure TIocpCrossSocket._HandleConnect(const APerIoData: PPerIoData);
+var
+ LClientSocket: TSocket;
+ LConnection: ICrossConnection;
+ LSockErr: Integer;
+begin
+ LClientSocket := APerIoData.Socket;
+ LConnection := APerIoData.CrossData as ICrossConnection;
+
+ LSockErr := TSocketAPI.GetError(LClientSocket);
+ if (LSockErr <> 0) then
+ begin
+ if (LConnection <> nil) then
+ LConnection.LastNetError := LSockErr;
+ _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
+ LConnection.Close;
+ Exit;
+ end;
+
+ // 不设置该参数, 会导致 getpeername 调用失败
+ if (TSocketAPI.SetSockOpt(LClientSocket, SOL_SOCKET,
+ SO_UPDATE_CONNECT_CONTEXT, 1) < 0) then
+ begin
+ if (LConnection <> nil) then
+ LConnection.LastNetError := WSAGetLastError;
+ _LogLastOsError(Self.ClassName + '._HandleConnect.SetSockOpt');
+ LConnection.Close;
+ Exit;
+ end;
+
+ TriggerConnected(LConnection);
+
+ if not _NewReadZero(LConnection) then
+ LConnection.Close;
+end;
+
+procedure TIocpCrossSocket._HandleRead(const APerIoData: PPerIoData);
+var
+ LConnection: ICrossConnection;
+ LRcvd, LError: Integer;
+begin
+ if (APerIoData.CrossData = nil) then
+ begin
+ if Assigned(APerIoData.Callback) then
+ APerIoData.Callback(nil, False);
+ Exit;
+ end;
+
+ LConnection := APerIoData.CrossData as ICrossConnection;
+
+ while True do
+ begin
+ LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
+
+ // 对方主动断开连接
+ if (LRcvd = 0) then
+ begin
+ _Log(Self.ClassName + '.Recv=0(Close), %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Exit;
+ end;
+
+ if (LRcvd < 0) then
+ begin
+ LError := GetLastError;
+
+ // 被系统信号中断, 可以重新recv
+ if (LError = WSAEINTR) then
+ Continue
+ // 接收缓冲区中数据已经被取完了
+ else if (LError = WSAEWOULDBLOCK) or (LError = WSAEINPROGRESS) then
+ Break
+ // 接收出错
+ else
+ begin
+ _LogLastOsError(Self.ClassName + '.Recv<0, %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Exit;
+ end;
+ end;
+
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d, _HandleRead.TriggerReceived准备执行, LRcvd=%d', [
+ Self.ClassName, TThread.Current.ThreadID, LRcvd
+ ]);
+ {$ENDIF}
+ TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d, _HandleRead.TriggerReceived执行完成, LRcvd=%d', [
+ Self.ClassName, TThread.Current.ThreadID, LRcvd
+ ]);
+ {$ENDIF}
+
+ // 回调中可能关闭了连接, 需要检查状态
+ if LConnection.IsClosed then Exit;
+
+ if (LRcvd < RCV_BUF_SIZE) then Break;
+ end;
+
+ if not _NewReadZero(LConnection) then
+ LConnection.Close;
+end;
+
+procedure TIocpCrossSocket._HandleWrite(const APerIoData: PPerIoData);
+begin
+ if Assigned(APerIoData.Callback) then
+ APerIoData.Callback(APerIoData.CrossData as ICrossConnection, True);
+end;
+
+procedure TIocpCrossSocket.StartLoop;
+var
+ I: Integer;
+begin
+ if (FIoThreads <> nil) then Exit;
+
+ FIocpHandle := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
+ SetLength(FIoThreads, GetIoThreads);
+ for I := 0 to Length(FIoThreads) - 1 do
+ FIoThreads[I] := TIoEventThread.Create(Self);
+end;
+
+procedure TIocpCrossSocket.StopLoop;
+
+ // IO 线程在收到 SHUTDOWN_FLAG 标记之后就会退出
+ // 而这时候有可能还有部分操作未完成, 其对应的 PerIoData 结构就无法释放
+ // 只需要在这里再次接收完成端口的消息, 就能等到这部分未完成的操作超时或失败
+ // 从而释放其对应的 PerIoData 结构
+ //
+ // 超时仍未清零时: 输出错误日志诊断遗留, 仍关闭 IOCP handle (避免 OS 句柄泄漏).
+ // 因 IO 线程已退出, 此处与 _HandleXxx 路径互斥, 无 PerIoData 重复释放风险.
+ procedure _FreeMissingPerIoDatas;
+ const
+ DEFAULT_DRAIN_TIMEOUT_MS = 3000;
+ POLL_STEP_MS = 10;
+ var
+ LBytes: Cardinal;
+ LSocket: TSocket;
+ LPerIoData: PPerIoData;
+ LConnection: ICrossConnection;
+ LMaxWait, LRemaining: Integer;
+ begin
+ LMaxWait := DEFAULT_DRAIN_TIMEOUT_MS;
+ LRemaining := LMaxWait;
+
+ while (AtomicCmpExchange(FPerIoDataCount, 0, 0) > 0) and (LRemaining > 0) do
+ begin
+ GetQueuedCompletionStatus(FIocpHandle, LBytes, ULONG_PTR(LSocket), POverlapped(LPerIoData), POLL_STEP_MS);
+
+ if (LPerIoData = nil) then
+ begin
+ Dec(LRemaining, POLL_STEP_MS);
+ Continue;
+ end;
+
+ try
+ TSocketAPI.CloseSocket(LPerIoData.Socket);
+
+ if Assigned(LPerIoData.Callback) then
+ begin
+ if (LPerIoData.CrossData <> nil)
+ and (LPerIoData.CrossData is TIocpConnection) then
+ LConnection := LPerIoData.CrossData as ICrossConnection
+ else
+ LConnection := nil;
+
+ LPerIoData.Callback(LConnection, False);
+ end;
+
+ if (LPerIoData.CrossData <> nil) then
+ LPerIoData.CrossData.Close;
+ finally
+ _FreeIoData(LPerIoData);
+ end;
+ end;
+
+ // 超时仍未清零: 不静默, 强制 _Log (受 CrossSocketLogEnabled 全局开关控制)
+ if (AtomicCmpExchange(FPerIoDataCount, 0, 0) > 0) then
+ _Log('[%s][StopLoop] WARNING: drain 超时 %dms, 仍有 %d 个 PerIoData 未回收, 即将关闭 IOCP handle',
+ [Self.ClassName, LMaxWait, AtomicCmpExchange(FPerIoDataCount, 0, 0)]);
+ end;
+
+var
+ I: Integer;
+ LCurrentThreadID: TThreadID;
+begin
+ if (FIoThreads = nil) then Exit;
+
+ {$IFDEF DEBUG}
+ _Log('[%s][StopLoop] 开始停止, 线程数=%d', [
+ Self.ClassName, Length(FIoThreads)]);
+ {$ENDIF}
+ CloseAll;
+
+ {$IFDEF DEBUG}
+ _Log('[%s][StopLoop] 等待连接关闭, ListensCount=%d, ConnectionsCount=%d', [
+ Self.ClassName, ListensCount, ConnectionsCount
+ ]);
+ {$ENDIF}
+ while (ListensCount > 0) or (ConnectionsCount > 0) do Sleep(1);
+
+ {$IFDEF DEBUG}
+ _Log('[%s][StopLoop] 发送 SHUTDOWN_FLAG 唤醒所有线程', [
+ Self.ClassName
+ ]);
+ {$ENDIF}
+ for I := 0 to Length(FIoThreads) - 1 do
+ PostQueuedCompletionStatus(FIocpHandle, 0, 0, POverlapped(SHUTDOWN_FLAG));
+
+ LCurrentThreadID := GetCurrentThreadId;
+ for I := 0 to Length(FIoThreads) - 1 do
+ begin
+ if (FIoThreads[I].ThreadID = LCurrentThreadID) then
+ raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
+
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d[StopLoop] 等待线程 %d 退出', [
+ Self.ClassName, FIoThreads[I].ThreadID, I
+ ]);
+ {$ENDIF}
+ FIoThreads[I].WaitFor;
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d[StopLoop] 线程 %d 已退出', [
+ Self.ClassName, FIoThreads[I].ThreadID, I]);
+ {$ENDIF}
+ FreeAndNil(FIoThreads[I]);
+ end;
+ FIoThreads := nil;
+
+ _FreeMissingPerIoDatas;
+ CloseHandle(FIocpHandle);
+end;
+
+procedure TIocpCrossSocket.Connect(const AHost: string;
+ const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LSocket: TSocket;
+
+ procedure _Failed1;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ end;
+
+ function _Connect(ASocket: TSocket; AAddr: PRawAddrInfo): Boolean;
+ procedure _Failed2;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ TSocketAPI.CloseSocket(ASocket);
+ end;
+ var
+ LSockAddr: TRawSockAddrIn;
+ LPerIoData: PPerIoData;
+ LBytes: Cardinal;
+ LConnection: ICrossConnection;
+ begin
+ FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
+ LSockAddr.AddrLen := AAddr.ai_addrlen;
+ if (AAddr.ai_family = AF_INET6) then
+ begin
+ LSockAddr.Addr6.sin6_family := AAddr.ai_family;
+ LSockAddr.Addr6.sin6_port := htons(ALocalPort);
+ end else
+ begin
+ LSockAddr.Addr.sin_family := AAddr.ai_family;
+ LSockAddr.Addr.sin_port := htons(ALocalPort);
+ end;
+ if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
+ begin
+ _LogLastOsError(Self.ClassName + '._Connect.Bind');
+ _Failed2;
+ Exit(False);
+ end;
+
+ if (CreateIoCompletionPort(ASocket, FIocpHandle, ULONG_PTR(ASocket), 0) = 0) then
+ begin
+ _LogLastOsError(Self.ClassName + '._Connect.CreateIoCompletionPort');
+ _Failed2;
+ Exit(False);
+ end;
+
+ LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
+ TriggerConnecting(LConnection);
+
+ LPerIoData := _NewIoData;
+ LPerIoData.Action := ioConnect;
+ LPerIoData.CrossData := LConnection;
+ LPerIoData.Socket := ASocket;
+ LPerIoData.Callback := nil;
+ if not ConnectEx(ASocket, AAddr.ai_addr, AAddr.ai_addrlen, nil, 0, LBytes, PWSAOverlapped(LPerIoData)) and
+ (WSAGetLastError <> WSA_IO_PENDING) then
+ begin
+ // 先保存 WSAGetLastError 再记录日志, 避免后续 API 调用改写 lastError
+ if (LConnection <> nil) then
+ LConnection.LastNetError := WSAGetLastError;
+ _LogLastOsError(Self.ClassName + '._Connect.ConnectEx');
+ _FreeIoData(LPerIoData);
+ LConnection.Close;
+ Exit(False);
+ end;
+
+ Result := True;
+ end;
+
+begin
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ _LogLastOsError(Self.ClassName + '.Connect.GetAddrInfo');
+ _Failed1;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LSocket := WSASocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol, nil, 0, WSA_FLAG_OVERLAPPED);
+ if (LSocket = INVALID_SOCKET) then
+ begin
+ _LogLastOsError(Self.ClassName + '.Connect.WSASocket');
+ _Failed1;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LSocket, True);
+ SetKeepAlive(LSocket);
+
+ {$IFDEF DEBUG}
+ _Log('TIocpCrossSocket.Connect.WSASocket=%d', [LSocket]);
+ {$ENDIF}
+
+ if _Connect(LSocket, LAddrInfo) then Exit;
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+
+ _LogLastOsError(Self.ClassName + '.Connect.Unknown');
+ _Failed1;
+end;
+
+function TIocpCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
+begin
+ Result := TIocpConnection.Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
+end;
+
+function TIocpCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
+ const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
+begin
+ Result := TIocpListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
+end;
+
+procedure TIocpCrossSocket.Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback);
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LListenSocket: TSocket;
+ LListen: ICrossListen;
+ I: Integer;
+ LListenSuccess: Boolean;
+
+ procedure _Failed;
+ begin
+ if not LListenSuccess and Assigned(ACallback) then
+ ACallback(LListen, False);
+
+ if (LListen <> nil) then
+ LListen.Close
+ else if (LListenSocket <> INVALID_SOCKET) then
+ TSocketAPI.CloseSocket(LListenSocket);
+ end;
+
+ procedure _Success;
+ begin
+ TriggerListened(LListen);
+
+ if Assigned(ACallback) then
+ ACallback(LListen, True);
+ end;
+begin
+ LListenSuccess := False;
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+
+ LHints.ai_flags := AI_PASSIVE;
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.Listen.GetAddrInfo');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LListen := nil;
+ LListenSocket := WSASocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol, nil, 0, WSA_FLAG_OVERLAPPED);
+ if (LListenSocket = INVALID_SOCKET) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.Listen.WSASocket');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LListenSocket, True);
+ TSocketAPI.SetReUseAddr(LListenSocket, True);
+
+ if (LAddrInfo.ai_family = AF_INET6) then
+ TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
+
+ if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.Listen.Bind');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ if (TSocketAPI.Listen(LListenSocket) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.Listen.Listen');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
+ LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
+
+ if (CreateIoCompletionPort(LListenSocket, FIocpHandle, ULONG_PTR(LListenSocket), 0) = 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.Listen.CreateIoCompletionPort');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ // 给每个IO线程投递一个AcceptEx
+ for I := 1 to GetIoThreads do
+ _NewAccept(LListen);
+
+ LListenSuccess := True;
+ _Success;
+
+ // 如果端口传入0，让所有地址统一用首个分配到的端口
+ if (APort = 0) and (LAddrInfo.ai_next <> nil) then
+ LAddrInfo.ai_next.ai_addr.sin_port := htons(LListen.LocalPort);
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+end;
+
+procedure TIocpCrossSocket.Send(const AConnection: ICrossConnection;
+ const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
+var
+ LPerIoData: PPerIoData;
+ LBytes, LFlags: Cardinal;
+begin
+ LPerIoData := _NewIoData;
+ LPerIoData.Buffer.DataBuf.buf := ABuf;
+ LPerIoData.Buffer.DataBuf.len := ALen;
+ LPerIoData.Action := ioWrite;
+ LPerIoData.Socket := AConnection.Socket;
+ LPerIoData.CrossData := AConnection;
+ LPerIoData.Callback := ACallback;
+
+ LFlags := 0;
+ LBytes := 0;
+ // WSASend 不会出现部分发送的情况, 要么全部失败, 要么全部成功
+ // 所以不需要像 kqueue 或 epoll 中调用 send 那样调用完之后还得检查实际发送了多少
+ // 唯一需要注意的是: WSASend 会将待发送的数据锁定到非页面内存, 非页面内存资源
+ // 是非常紧张的, 所以不要无节制的调用 WSASend, 最好通过回调发送完一批数据再继
+ // 续发送下一批
+ if (WSASend(AConnection.Socket, @LPerIoData.Buffer.DataBuf, 1, LBytes, LFlags, PWSAOverlapped(LPerIoData), nil) < 0)
+ and (WSAGetLastError <> WSA_IO_PENDING) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(Self.ClassName + '.WSASend, %s', [AConnection.DebugInfo]);
+ {$ENDIF}
+
+ // 出错多半是 WSAENOBUFS, 也就是投递的 WSASend 过多, 来不及发送
+ // 导致非页面内存资源全部被锁定, 要避免这种情况必须上层发送逻辑
+ // 保证不能无节制的调用Send发送大量数据, 最好发送完一个再继续下
+ // 一个, 本函数提供了发送结果的回调函数, 在回调函数报告发送成功
+ // 之后就可以继续下一块数据发送了
+ _FreeIoData(LPerIoData);
+
+ if Assigned(ACallback) then
+ ACallback(AConnection, False);
+
+ if Assigned(AConnection) then
+ AConnection.Close;
+ end;
+end;
+
+function TIocpCrossSocket.ProcessIoEvent: Boolean;
+ procedure _ReleasePerIoData(const APerIoData: PPerIoData; const AShutdown: Boolean);
+ var
+ LConnection: ICrossConnection;
+ begin
+ try
+ if (APerIoData.CrossData <> nil) then
+ begin
+ // AcceptEx虽然成功, 但是Socket句柄耗尽了, 再次投递AcceptEx
+ if (APerIoData.Action = ioAccept) then
+ begin
+ // 照理说能执行到这里, 说明Socket分配失败了
+ // 但是为了以防万一, 这里还是判断一下并释放掉无效的Socket句柄
+ if (APerIoData.Socket <> 0) then
+ TSocketAPI.CloseSocket(APerIoData.Socket);
+
+ // 关闭监听后会触发该错误, 这种情况不应该继续投递
+ if not AShutdown then
+ begin
+ _Log('[%s]thread%d, _NewAccept', [Self.ClassName, TThread.Current.ThreadID]);
+ _NewAccept(APerIoData.CrossData as ICrossListen);
+ end;
+ end else
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(
+ Format(Self.ClassName + '.ProcessIoEvent.GetQueuedCompletionStatus.CrossDataNotNil(socket=%d, action=%d)',
+ [APerIoData.Socket, Ord(APerIoData.Action)])
+ );
+ {$ENDIF}
+ if Assigned(APerIoData.Callback) then
+ begin
+ if (APerIoData.CrossData is TIocpConnection) then
+ LConnection := APerIoData.CrossData as ICrossConnection
+ else
+ LConnection := nil;
+
+ APerIoData.Callback(LConnection, False);
+ end;
+
+ APerIoData.CrossData.Close;
+ end;
+ end else
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError(
+ Format(Self.ClassName + '.ProcessIoEvent.GetQueuedCompletionStatus.CrossDataIsNil(socket=%d, action=%d)',
+ [APerIoData.Socket, Ord(APerIoData.Action)])
+ );
+ {$ENDIF}
+ if Assigned(APerIoData.Callback) then
+ APerIoData.Callback(nil, False);
+
+ if (APerIoData.Socket <> 0) then
+ TSocketAPI.CloseSocket(APerIoData.Socket);
+ end;
+ finally
+ _FreeIoData(APerIoData);
+ end;
+ end;
+var
+ LBytes: Cardinal;
+ LSocket: TSocket;
+ LPerIoData: PPerIoData;
+ LErrNo: Cardinal;
+ LIocpClosed: Boolean;
+begin
+ if not GetQueuedCompletionStatus(FIocpHandle, LBytes, ULONG_PTR(LSocket), POverlapped(LPerIoData), INFINITE) then
+ begin
+ // ERROR_INVALID_HANDLE, 6, IOCP句柄被关闭
+ // ERROR_ABANDONED_WAIT_0, $02DF, IOCP句柄被关闭
+ // WSA_OPERATION_ABORTED, 995, 监听端口被关闭, 由于线程退出或应用程序请求，已中止 I/O 操作。
+ // WSAENOTSOCK, 10038, 在一个非套接字上尝试了一个操作。
+ // WSAESHUTDOWN, 10058, 套接字已关闭
+ // ERROR_NETNAME_DELETED, 64, 指定的网络名不再可用
+ // ERROR_CONNECTION_REFUSED, 1225, 远程计算机拒绝网络连接。
+ LErrNo := GetLastError;
+
+ // 完成端口被关闭时可能会触发 ERROR_INVALID_HANDLE 和 ERROR_ABANDONED_WAIT_0
+ // 监听端口被关闭时会触发 WSA_OPERATION_ABORTED
+ LIocpClosed := (LErrNo = ERROR_INVALID_HANDLE)
+ or (LErrNo = ERROR_ABANDONED_WAIT_0)
+ or (LErrNo = WSA_OPERATION_ABORTED);
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d, GetQueuedCompletionStatus:%d, %s', [
+ Self.ClassName, TThread.Current.ThreadID, LErrNo, SysErrorMessage(LErrNo)
+ ]);
+ {$ENDIF}
+
+ // 出错了, 并且完成数据也都是空的,
+ // 这种情况即便重试, 应该也会继续出错, 最好立即终止IO线程
+ if (LPerIoData = nil) then Exit(False);
+
+ // 出错了, 回收资源
+ _ReleasePerIoData(LPerIoData, LIocpClosed);
+
+ // 出错了, 但是完成数据不是空的, 需要重试
+ Exit(not LIocpClosed);
+ end;
+
+ // 主动调用了 StopLoop
+ if (LBytes = 0) and (ULONG_PTR(LPerIoData) = SHUTDOWN_FLAG) then Exit(False);
+
+ // 由于未知原因未获取到完成数据, 但是返回的错误代码又是正常
+ // 这种情况需要进行重试(返回True之后IO线程会再次调用ProcessIoEvent)
+ if (LPerIoData = nil) then Exit(True);
+
+ try
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d, 准备处理IOCP事件 PerIoData=%p, Action=%d, Bytes=%d', [
+ Self.ClassName, TThread.Current.ThreadID, Pointer(LPerIoData), Ord(LPerIoData.Action), LBytes
+ ]);
+ {$ENDIF}
+ case LPerIoData.Action of
+ ioAccept : _HandleAccept(LPerIoData);
+ ioConnect : _HandleConnect(LPerIoData);
+ ioRead : _HandleRead(LPerIoData);
+ ioWrite : _HandleWrite(LPerIoData);
+ end;
+ {$IFDEF DEBUG}
+ _Log('[%s]thread%d, 处理IOCP事件完成 PerIoData=%p, Action=%d, Bytes=%d', [
+ Self.ClassName, TThread.Current.ThreadID, Pointer(LPerIoData), Ord(LPerIoData.Action), LBytes
+ ]);
+ {$ENDIF}
+ finally
+ _FreeIoData(LPerIoData);
+ end;
+
+ Result := True;
+end;
+
+end.
diff --git a/Net/Net.CrossSocket.Kqueue.pas b/Net/Net.CrossSocket.Kqueue.pas
index c0f76a7..9c046b5 100644
--- a/Net/Net.CrossSocket.Kqueue.pas
+++ b/Net/Net.CrossSocket.Kqueue.pas
@@ -1,1112 +1,1112 @@
-{******************************************************************************}
-{ }
-{ Delphi cross platform socket library }
-{ }
-{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
-{ }
-{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
-{ }
-{******************************************************************************}
-unit Net.CrossSocket.Kqueue;
-
-{$I zLib.inc}
-
-interface
-
-uses
- SysUtils,
- Classes,
- Generics.Collections,
-
- {$IFDEF DELPHI}
- Posix.SysSocket,
- Posix.NetinetIn,
- Posix.UniStd,
- Posix.NetDB,
- Posix.Pthread,
- Posix.ArpaInet,
- Posix.Errno,
- {$ELSE}
- baseunix,
- unix,
- sockets,
- netdb,
- DTF.RTL,
- {$ENDIF}
-
- BSD.kqueue,
-
- Net.SocketAPI,
- Net.CrossSocket.Base,
-
- Utils.SyncObjs,
- Utils.ArrayUtils;
-
-{$IFDEF BSD}
-const
- IPV6_V6ONLY = 27;
-{$ENDIF}
-
-type
- {$IFDEF FPC}
- TPipeDescriptors = {packed} record
- ReadDes: Integer;
- WriteDes: Integer;
- end;
- PPipeDescriptors = ^TPipeDescriptors;
- {$ENDIF}
-
- TIoEvent = (ieRead, ieWrite);
- TIoEvents = set of TIoEvent;
-
- TKqueueListen = class(TCrossListenBase)
- private
- FKqueueHandle: Integer;
- FIoEvents: TIoEvents;
-
- function _ReadEnabled: Boolean; inline;
- function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
- public
- constructor Create(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
- const AFamily, ASockType, AProtocol: Integer); override;
- end;
-
- PSendItem = ^TSendItem;
- TSendItem = packed record
- Data: PByte;
- Size: Integer;
- Callback: TCrossConnectionCallback;
- end;
-
- TSendQueue = class(TList)
- protected
- procedure Notify(const Value: PSendItem; Action: TCollectionNotification); override;
- end;
-
- TKqueueConnection = class(TCrossConnectionBase)
- private
- FKqueueHandle: Integer;
- FSendQueue: TSendQueue;
- FKqLock: ILock;
- FInPending, FOutPending: Integer;
-
- function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
-
- procedure _ClearSendQueue;
-
- procedure _KqLock; inline;
- procedure _KqUnlock; inline;
- protected
- procedure InternalClose; override;
- public
- constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback); override;
- destructor Destroy; override;
- end;
-
- // KQUEUE 与 EPOLL 队列的差异
- // KQUEUE的队列中, 一个Socket句柄可以有多条记录, 每个事件一条,
- // 这一点和 EPOLL 不一样, EPOLL中每个Socket句柄只会有一条记录
- // 要监测多个事件时, 只需要将多个事件做位运算加在一起调用 epoll_ctl 即可
- //
- // EV_DISPATCH 和 EV_CLEAR 是令 kqueue 支持线程池的关键
- // 该参数组合可以令事件触发后就立即被禁用, 避免让同一个Socket的同一个事件
- // 同时被多个工作线程触发
- //
- // EVFILT_READ
- // 用于监测接收缓冲区是否可读了
- // 对于监听Socket来说,表示有新的连接到来
- // 对于已连接的Socket来说,表示有数据到达接收缓冲区
- // 为了支持线程池, 必须带上参数 EV_CLEAR or EV_DISPATCH
- // 该参数组合表示, 该事件一旦触发立即清除该事件的状态并禁用它
- // 处理完连接或者读取数据之后再投递一次 EVFILT_READ, 带上参数
- // EV_ENABLE or EV_CLEAR or EV_DISPATCH, 让事件继续监测
- //
- // EVFILT_WRITE
- // 用于监测发送缓冲区是否可写了
- // 对于Connect中的Socket,投递EV_ENABLE,等到事件触发时表示连接已建立
- // 对于已连接的Socket,在Send之后立即投递EVFILT_WRITE,等到事件触发时表示发送完成
- // 对于EVFILT_WRITE都应该带上EV_ONESHOT参数,让该事件只会被触发一次
- // 否则,只要发送缓冲区是空的,该事件就会一直触发,这并没有什么意义
- // 我们只需要用EVFILT_WRITE去监测连接或者发送是否成功
- //
- // KQUEUE 发送数据
- // 最好的做法是将实际发送数据的动作放到 EVFILT_WRITE 触发时进行, 该
- // 事件触发表明 Socket 发送缓存有空闲空间了。IOCP可以直接将待发送的数据及
- // 回调同时扔给 WSASend, 发送完成后去调用回调即可; KQUEUE 机制不一样, 在 KQUEUE
- // 中没有类似 WSASend 的函数, 只能自行维护发送数据及回调的队列
- // EPOLL要支持多线程并发发送数据必须创建发送队列, 否则同一个 Socket 的并发发送
- // 极有可能有一部分会被其它发送覆盖掉
- //
- // 由于 KQUEUE 中每个套接字在队列中的 EV_WRITE 和 EV_READ 是分开的两条记录
- // 所以修改套接字的监听事件时不会互相覆盖, 也就是说每个事件都会对应到一次
- // 触发, 这样就可以方便的使用接口的引用计数机制保持连接的有效性, 也不会出现
- // 内存泄漏
- TKqueueCrossSocket = class(TCrossSocketBase)
- private const
- MAX_EVENT_COUNT = 2048;
- SHUTDOWN_FLAG = Pointer(-1);
- private class threadvar
- FEventList: array [0..MAX_EVENT_COUNT-1] of TKEvent;
- private
- FKqueueHandle: Integer;
- FIoThreads: TArray;
- FIdleHandle: THandle;
- FIdleLock: ILock;
- FStopHandle: TPipeDescriptors;
-
- // 利用 pipe 唤醒并退出IO线程
- procedure _OpenStopHandle; inline;
- procedure _PostStopCommand; inline;
- procedure _CloseStopHandle; inline;
-
- procedure _OpenIdleHandle; inline;
- procedure _CloseIdleHandle; inline;
-
- // 在向一个已经关闭的套接字发送数据时系统会直接抛出EPIPE异常导致程序非正常退出
- // LINUX下可以在send时带上MSG_NOSIGNAL参数就能避免这种情况的发生
- // OSX中可以通过设置套接字的SO_NOSIGPIPE参数达到同样的目的
- procedure _SetNoSigPipe(ASocket: TSocket); inline;
-
- procedure _HandleAccept(const AListen: ICrossListen);
- procedure _HandleConnect(const AConnection: ICrossConnection);
- procedure _HandleRead(const AConnection: ICrossConnection);
- procedure _HandleWrite(const AConnection: ICrossConnection);
- protected
- function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
- const AConnectType: TConnectType; const AHost: string;
- const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
- function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
- const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
-
- procedure StartLoop; override;
- procedure StopLoop; override;
-
- procedure Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback = nil); override;
-
- procedure Connect(const AHost: string; const APort, ALocalPort: Word;
- const ACallback: TCrossConnectionCallback = nil); override;
-
- procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer;
- const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override;
-
- function ProcessIoEvent: Boolean; override;
- public
- constructor Create(const AIoThreads: Integer); override;
- destructor Destroy; override;
- end;
-
-implementation
-
-{$IFDEF FPC}
-function pipe(var PipeDes: TPipeDescriptors): Integer; cdecl; external 'c' name 'pipe';
-function __read(Handle: Integer; Buffer: Pointer; Count: size_t): ssize_t; cdecl; external 'c' name 'read';
-function __write(Handle: Integer; Buffer: Pointer; Count: size_t): ssize_t; cdecl; external 'c' name 'write';
-function __close(Handle: Integer): Integer; cdecl; external 'c' name 'close';
-{$ENDIF}
-
-{ TKqueueListen }
-
-constructor TKqueueListen.Create(const AOwner: TCrossSocketBase;
- const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer);
-begin
- inherited;
- FKqueueHandle := TKqueueCrossSocket(AOwner).FKqueueHandle;
-end;
-
-function TKqueueListen._ReadEnabled: Boolean;
-begin
- Result := (ieRead in FIoEvents);
-end;
-
-function TKqueueListen._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
-var
- LCrossData: Pointer;
- LEvents: array [0..1] of TKEvent;
- N: Integer;
-begin
- FIoEvents := AIoEvents;
-
- if (FIoEvents = []) or IsClosed then Exit(False);
-
- LCrossData := Pointer(Self);
- N := 0;
-
- if _ReadEnabled then
- begin
- EV_SET(@LEvents[N], Socket, EVFILT_READ,
- EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
-
- Inc(N);
- end;
-
- if (N <= 0) then Exit(False);
-
- Result := (kevent(FKqueueHandle, @LEvents, N, nil, 0, nil) >= 0);
-
- {$IFDEF DEBUG}
- if not Result then
- _LogLastOsError('listen kevent, %s', [Socket, Self.DebugInfo]);
- {$ENDIF}
-end;
-
-{ TSendQueue }
-
-procedure TSendQueue.Notify(const Value: PSendItem;
- Action: TCollectionNotification);
-begin
- inherited;
-
- if (Action = TCollectionNotification.cnRemoved) then
- begin
- if (Value <> nil) then
- begin
- Value.Callback := nil;
- System.Dispose(Value);
- end;
- end;
-end;
-
-{ TKqueueConnection }
-
-constructor TKqueueConnection.Create(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback);
-begin
- inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
-
- FKqLock := TLock.Create;
- FSendQueue := TSendQueue.Create;
-
- FKqueueHandle := TKqueueCrossSocket(AOwner).FKqueueHandle;
-end;
-
-destructor TKqueueConnection.Destroy;
-begin
- _ClearSendQueue;
- FreeAndNil(FSendQueue);
-
- inherited;
-end;
-
-procedure TKqueueConnection.InternalClose;
-var
- LEvent: TKEvent;
-begin
- _ClearSendQueue;
-
- // 从 kqueue 中删除该 socket 的所有事件，防止 fd 重用后触发错误回调
- EV_SET(@LEvent, Socket, EVFILT_READ, EV_DELETE, 0, 0, nil);
- kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
- EV_SET(@LEvent, Socket, EVFILT_WRITE, EV_DELETE, 0, 0, nil);
- kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
-
- inherited InternalClose;
-end;
-
-procedure TKqueueConnection._ClearSendQueue;
-var
- LConnection: ICrossConnection;
- LSendItem: PSendItem;
- LCallbacks: TArray;
- LCallback: TCrossConnectionCallback;
-begin
- LConnection := Self;
- LCallbacks := [];
-
- _KqLock;
- try
- // 连接释放时, 先收集所有回调, 然后在锁外执行
- // 避免回调中再次发送数据导致死锁
- if (FSendQueue <> nil) and (FSendQueue.Count > 0) then
- begin
- for LSendItem in FSendQueue do
- if Assigned(LSendItem.Callback) then
- TArrayUtils.Append(LCallbacks, LSendItem.Callback);
-
- FSendQueue.Clear;
- end;
- finally
- _KqUnlock;
- end;
-
- // 在锁外执行回调, 告知发送失败
- for LCallback in LCallbacks do
- LCallback(LConnection, False);
-end;
-
-procedure TKqueueConnection._KqLock;
-begin
- FKqLock.Enter;
-end;
-
-procedure TKqueueConnection._KqUnlock;
-begin
- FKqLock.Leave;
-end;
-
-function TKqueueConnection._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
-var
- LCrossData: Pointer;
- LEvents: array [0..1] of TKEvent;
- N: Integer;
-begin
- if (AIoEvents = []) or IsClosed then Exit(False);
-
- LCrossData := Pointer(Self);
- N := 0;
-
- // kqueue中同一个套接字的EVFILT_READ和EVFILT_WRITE事件在队列中会有两条记录
- // 并且可能会在不同的线程中同时被触发, 如果其中一个线程关闭了连接, 在没有
- // 引用计数保护的情况下, 就会导致连接对象被释放, 另一个线程再访问连接对象
- // 就会引起异常, 这里为了保证连接对象的有效性, 在添加事件时手动增加连接对象
- // 的引用计数, 到事件触发时再减少引用计数
- // 注意关闭连接一定要使用shutdown而不能直接close, 否则无法触发kqueue事件,
- // 导致引用计数无法回收
-
- if (ieRead in AIoEvents) and (AtomicCmpExchange(FInPending, 0, 0) = 0) then
- begin
- Self._AddRef;
-
- EV_SET(@LEvents[N], Socket, EVFILT_READ,
- EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
-
- Inc(N);
- end;
-
- if (ieWrite in AIoEvents) and (AtomicCmpExchange(FOutPending, 0, 0) = 0) then
- begin
- Self._AddRef;
-
- EV_SET(@LEvents[N], Socket, EVFILT_WRITE,
- EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
-
- Inc(N);
- end;
-
- if (N <= 0) then Exit(False);
-
- Result := (kevent(FKqueueHandle, @LEvents, N, nil, 0, nil) >= 0);
-
- if not Result then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('connection kevent, %s', [Self.DebugInfo]);
- {$ENDIF}
-
- while (N > 0) do
- begin
- Self._Release;
- Dec(N);
- end;
-
- Self.Close;
- end;
-end;
-
-{ TKqueueCrossSocket }
-
-constructor TKqueueCrossSocket.Create(const AIoThreads: Integer);
-begin
- inherited;
-
- FIdleLock := TLock.Create;
-end;
-
-destructor TKqueueCrossSocket.Destroy;
-begin
- inherited;
-end;
-
-procedure TKqueueCrossSocket._CloseIdleHandle;
-begin
- FileClose(FIdleHandle);
-end;
-
-procedure TKqueueCrossSocket._CloseStopHandle;
-begin
- FileClose(FStopHandle.ReadDes);
- FileClose(FStopHandle.WriteDes);
-end;
-
-procedure TKqueueCrossSocket._HandleAccept(const AListen: ICrossListen);
-var
- LListen: ICrossListen;
- LKqListen: TKqueueListen;
- LConnection: ICrossConnection;
- LKqConnection: TKqueueConnection;
- LError: Integer;
- LSocket, LListenSocket, LClientSocket: TSocket;
- LSuccess: Boolean;
-begin
- LListen := AListen;
- LListenSocket := LListen.Socket;
-
- while True do
- begin
- LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
-
- // Accept失败
- // EAGAIN 所有就绪的连接都已处理完毕
- // EMFILE 进程的文件句柄已经用完了
- if (LSocket < 0) then
- begin
- LError := GetLastError;
-
- // 所有就绪的连接都已处理完毕, 正常情况
- if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- begin
- // 空处理, 仅用于区分 EMFILE 和其他错误
- end else
- // 当句柄用完了的时候, 释放事先占用的临时句柄
- // 然后再次 accept, 然后将 accept 的句柄关掉
- // 这样可以保证在文件句柄耗尽的时候依然能响应连接请求
- // 并立即将新到的连接关闭
- if (LError = EMFILE) then
- begin
- FIdleLock.Enter;
- try
- _CloseIdleHandle;
- LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
- TSocketAPI.CloseSocket(LSocket);
- _OpenIdleHandle;
- finally
- FIdleLock.Leave;
- end;
- end else
- _LogLastOsError('Accept');
-
- Break;
- end;
-
- LClientSocket := LSocket;
- TSocketAPI.SetNonBlock(LClientSocket, True);
- SetKeepAlive(LClientSocket);
- _SetNoSigPipe(LClientSocket);
-
- LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
- TriggerConnecting(LConnection);
- TriggerConnected(LConnection);
-
- // 连接建立后监视Socket的读事件
- LKqConnection := LConnection as TKqueueConnection;
- LKqConnection._KqLock;
- try
- LKqConnection._UpdateIoEvent([ieRead]);
- finally
- LKqConnection._KqUnlock;
- end;
- end;
-
- // 继续接收新连接
- LKqListen := LListen as TKqueueListen;
- LKqListen._Lock;
- LKqListen._UpdateIoEvent([ieRead]);
- LKqListen._Unlock;
-end;
-
-procedure TKqueueCrossSocket._HandleConnect(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LKqConnection: TKqueueConnection;
- LSockErr: Integer;
-begin
- LConnection := AConnection;
-
- // Connect失败
- LSockErr := TSocketAPI.GetError(LConnection.Socket);
- if (LSockErr <> 0) then
- begin
- LConnection.LastNetError := LSockErr;
- _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
- LConnection.Close;
- Exit;
- end;
-
- TriggerConnected(LConnection);
-
- LKqConnection := LConnection as TKqueueConnection;
-
- LKqConnection._KqLock;
- try
- LKqConnection._UpdateIoEvent([ieRead]);
- finally
- LKqConnection._KqUnlock;
- end;
-end;
-
-procedure TKqueueCrossSocket._HandleRead(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LKqConnection: TKqueueConnection;
- LRcvd, LError: Integer;
- LSuccess: Boolean;
-begin
- LConnection := AConnection;
- LKqConnection := LConnection as TKqueueConnection;
-
- AtomicIncrement(LKqConnection.FInPending);
- try
- while True do
- begin
- LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
-
- // 对方主动断开连接
- if (LRcvd = 0) then
- begin
- _Log('Recv=0(Close), %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Exit;
- end;
-
- if (LRcvd < 0) then
- begin
- LError := GetLastError;
-
- // 被系统信号中断, 可以重新recv
- if (LError = EINTR) then
- Continue
- // 接收缓冲区中数据已经被取完了
- else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- Break
- else
- // 接收出错
- begin
- _LogLastOsError('Recv<0, %s', [LConnection.DebugInfo]);
- LConnection.Close;
- Exit;
- end;
- end;
-
- TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
-
- // 回调中可能关闭了连接, 需要检查状态
- if LConnection.IsClosed then Exit;
-
- if (LRcvd < RCV_BUF_SIZE) then Break;
- end;
- finally
- AtomicDecrement(LKqConnection.FInPending);
- end;
-
- LKqConnection._KqLock;
- try
- LKqConnection._UpdateIoEvent([ieRead]);
- finally
- LKqConnection._KqUnlock;
- end;
-end;
-
-procedure TKqueueCrossSocket._HandleWrite(const AConnection: ICrossConnection);
-var
- LConnection: ICrossConnection;
- LKqConnection: TKqueueConnection;
- LSendItem: PSendItem;
- LSent, LError: Integer;
- LSendCbArr: TArray;
- LSendCb: TCrossConnectionCallback;
-begin
- LConnection := AConnection;
- LKqConnection := LConnection as TKqueueConnection;
- LSendCbArr := [];
-
- AtomicIncrement(LKqConnection.FOutPending);
- LKqConnection._KqLock;
- try
- while True do
- begin
- // 检查队列中有没有数据
- if (LKqConnection.FSendQueue = nil) or (LKqConnection.FSendQueue.Count <= 0) then Break;
-
- // 获取Socket发送队列中的第一条数据
- LSendItem := LKqConnection.FSendQueue.Items[0];
-
- // 发送数据
- {$IFNDEF MACOS}
- LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size, MSG_NOSIGNAL);
- {$ELSE}
- LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size);
- {$ENDIF}
-
- // 对方主动断开连接
- if (LSent = 0) then
- begin
- _Log('Send=0(close), %s', [LConnection.DebugInfo]);
-
- LConnection.Close;
- Break;
- end;
-
- // 连接断开或发送错误
- if (LSent < 0) then
- begin
- LError := GetLastError;
-
- // 被系统信号中断, 可以重新send
- if (LError = EINTR) then
- Continue
- // 发送缓冲区已被填满了, 需要等下次唤醒发送线程再继续发送
- else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- Break
- // 发送出错
- else
- begin
- _LogLastOsError('Send<0, %s', [LConnection.DebugInfo]);
-
- LConnection.Close;
- Break;
- end;
- end;
-
- // 全部发送完成
- if (LSent >= LSendItem.Size) then
- begin
- TArrayUtils.Append(LSendCbArr, LSendItem.Callback);
-
- // 发送成功, 移除已发送成功的数据
- // 必须先从队列移除已发完的数据项, 然后再执行发送成功的回调
- // 因为回调里可能还会发送新的数据, 如果先执行回调再去移除,
- // 就会错误的将回调中放到队列里的新数据移除
- if (LKqConnection.FSendQueue.Count > 0) then
- LKqConnection.FSendQueue.Delete(0);
- end else
- begin
- // 部分发送成功, 在下一次唤醒发送线程时继续处理剩余部分
- Dec(LSendItem.Size, LSent);
- Inc(LSendItem.Data, LSent);
- end;
- end;
- finally
- LKqConnection._KqUnlock;
- AtomicDecrement(LKqConnection.FOutPending);
- end;
-
- // 调用回调
- for LSendCb in LSendCbArr do
- LSendCb(LConnection, True);
-
- LKqConnection._KqLock;
- try
- if (LKqConnection.FSendQueue <> nil) and (LKqConnection.FSendQueue.Count > 0) then
- LKqConnection._UpdateIoEvent([ieWrite]);
- finally
- LKqConnection._KqUnlock;
- end;
-end;
-
-procedure TKqueueCrossSocket._OpenIdleHandle;
-begin
- FIdleHandle := FileOpen('/dev/null', fmOpenRead);
-end;
-
-procedure TKqueueCrossSocket._OpenStopHandle;
-var
- LEvent: TKEvent;
-begin
- pipe(FStopHandle);
-
- // 这里不使用 EV_ONESHOT
- // 这样可以保证通知退出的命令发出后, 所有IO线程都会收到
- EV_SET(@LEvent, FStopHandle.ReadDes, EVFILT_READ,
- EV_ADD, 0, 0, SHUTDOWN_FLAG);
- kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
-end;
-
-procedure TKqueueCrossSocket._PostStopCommand;
-var
- LStuff: UInt64;
-begin
- LStuff := 1;
- // 往 FStopHandle.WriteDes 写入任意数据, 唤醒工作线程
- __write(FStopHandle.WriteDes, @LStuff, SizeOf(LStuff));
-end;
-
-procedure TKqueueCrossSocket._SetNoSigPipe(ASocket: TSocket);
-begin
- {$if defined(MACOS) or defined(FREEBSD)}
- TSocketAPI.SetSockOpt(ASocket, SOL_SOCKET, SO_NOSIGPIPE, 1);
- {$endif}
-end;
-
-procedure TKqueueCrossSocket.StartLoop;
-var
- I: Integer;
-begin
- if (FIoThreads <> nil) then Exit;
-
- _OpenIdleHandle;
-
- FKqueueHandle := kqueue();
- SetLength(FIoThreads, GetIoThreads);
- for I := 0 to Length(FIoThreads) - 1 do
- FIoThreads[i] := TIoEventThread.Create(Self);
-
- _OpenStopHandle;
-end;
-
-procedure TKqueueCrossSocket.StopLoop;
-var
- I: Integer;
- LCurrentThreadID: TThreadID;
-begin
- if (FIoThreads = nil) then Exit;
-
- CloseAll;
-
- while (ListensCount > 0) or (ConnectionsCount > 0) do Sleep(1);
-
- _PostStopCommand;
-
- LCurrentThreadID := GetCurrentThreadId;
- for I := 0 to Length(FIoThreads) - 1 do
- begin
- if (FIoThreads[I].ThreadID = LCurrentThreadID) then
- raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
-
- FIoThreads[I].WaitFor;
- FreeAndNil(FIoThreads[I]);
- end;
- FIoThreads := nil;
-
- FileClose(FKqueueHandle);
- _CloseIdleHandle;
- _CloseStopHandle;
-end;
-
-procedure TKqueueCrossSocket.Connect(const AHost: string;
- const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
-
- procedure _Failed1;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- end;
-
- function _Connect(const ASocket: TSocket; const AAddr: PRawAddrInfo): Boolean;
- procedure _Failed2;
- begin
- if Assigned(ACallback) then
- ACallback(nil, False);
- TSocketAPI.CloseSocket(ASocket);
- end;
- var
- LSockAddr: TRawSockAddrIn;
- LConnection: ICrossConnection;
- LKqConnection: TKqueueConnection;
- begin
- FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
- LSockAddr.AddrLen := AAddr.ai_addrlen;
- if (AAddr.ai_family = AF_INET6) then
- begin
- LSockAddr.Addr6.sin6_family := AAddr.ai_family;
- LSockAddr.Addr6.sin6_port := htons(ALocalPort);
- end else
- begin
- LSockAddr.Addr.sin_family := AAddr.ai_family;
- LSockAddr.Addr.sin_port := htons(ALocalPort);
- end;
- if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TKqueueCrossSocket._Connect.Bind');
- {$ENDIF}
- _Failed2;
- Exit(False);
- end;
-
- if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0)
- or (GetLastError = EINPROGRESS) then
- begin
- LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
- TriggerConnecting(LConnection);
- LKqConnection := LConnection as TKqueueConnection;
-
- LKqConnection._KqLock;
- try
- LKqConnection.ConnectStatus := csConnecting;
- if not LKqConnection._UpdateIoEvent([ieWrite]) then
- begin
- LConnection.Close;
- Exit(False);
- end;
- finally
- LKqConnection._KqUnlock;
- end;
- end else
- begin
- _Failed2;
- Exit(False);
- end;
-
- Result := True;
- end;
-
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LSocket: TSocket;
-begin
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- _Failed1;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol);
- if (LSocket = INVALID_SOCKET) then
- begin
- _Failed1;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LSocket, True);
- SetKeepAlive(LSocket);
- _SetNoSigPipe(LSocket);
-
- if _Connect(LSocket, LAddrInfo) then Exit;
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-
- _Failed1;
-end;
-
-function TKqueueCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
- const AClientSocket: TSocket; const AConnectType: TConnectType;
- const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
-begin
- Result := TKqueueConnection.Create(
- AOwner,
- AClientSocket,
- AConnectType,
- AHost,
- AConnectCb);
-end;
-
-function TKqueueCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
- const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
-begin
- Result := TKqueueListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
-end;
-
-procedure TKqueueCrossSocket.Listen(const AHost: string; const APort: Word;
- const ACallback: TCrossListenCallback);
-var
- LHints: TRawAddrInfo;
- P, LAddrInfo: PRawAddrInfo;
- LListenSocket: TSocket;
- LListen: ICrossListen;
- LKqListen: TKqueueListen;
- LListenSuccess, LUpdateIoEventSuccess: Boolean;
-
- procedure _Failed;
- begin
- if not LListenSuccess and Assigned(ACallback) then
- ACallback(LListen, False);
-
- if (LListen <> nil) then
- LListen.Close
- else if (LListenSocket <> INVALID_SOCKET) then
- TSocketAPI.CloseSocket(LListenSocket);
- end;
-
-begin
- LListenSuccess := False;
- FillChar(LHints, SizeOf(TRawAddrInfo), 0);
-
- LHints.ai_flags := AI_PASSIVE;
- LHints.ai_family := AF_UNSPEC;
- LHints.ai_socktype := SOCK_STREAM;
- LHints.ai_protocol := IPPROTO_TCP;
- LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
- if (LAddrInfo = nil) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TKqueueCrossSocket.Listen.GetAddrInfo');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- P := LAddrInfo;
- try
- while (LAddrInfo <> nil) do
- begin
- LListen := nil;
- LListenSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
- LAddrInfo.ai_protocol);
- if (LListenSocket = INVALID_SOCKET) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TKqueueCrossSocket.Listen.NewSocket');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- TSocketAPI.SetNonBlock(LListenSocket, True);
- TSocketAPI.SetReUsePort(LListenSocket, True);
-
- if (LAddrInfo.ai_family = AF_INET6) then
- TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
-
- if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0)
- or (TSocketAPI.Listen(LListenSocket) < 0) then
- begin
- {$IFDEF DEBUG}
- _LogLastOsError('TKqueueCrossSocket.Listen.Bind');
- {$ENDIF}
- _Failed;
- Exit;
- end;
-
- LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
- LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
- LKqListen := LListen as TKqueueListen;
-
- // 监听套接字的读事件
- // 读事件到达表明有新连接
- LKqListen._Lock;
- try
- LUpdateIoEventSuccess := LKqListen._UpdateIoEvent([ieRead]);
- finally
- LKqListen._Unlock;
- end;
-
- if not LUpdateIoEventSuccess then
- begin
- _Failed;
-
- Exit;
- end;
-
- // 监听成功
- LListenSuccess := True;
- TriggerListened(LListen);
- if Assigned(ACallback) then
- ACallback(LListen, True);
-
- // 如果端口传入0，让所有地址统一用首个分配到的端口
- if (APort = 0) and (LAddrInfo.ai_next <> nil) then
- Psockaddr_in(LAddrInfo.ai_next.ai_addr).sin_port := htons(LListen.LocalPort);
-
- LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
- end;
- finally
- TSocketAPI.FreeAddrInfo(P);
- end;
-end;
-
-procedure TKqueueCrossSocket.Send(const AConnection: ICrossConnection;
- const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
-var
- LKqConnection: TKqueueConnection;
- LSendItem: PSendItem;
-begin
- // 测试过先发送, 然后将剩余部分放入发送队列的做法
- // 发现会引起内存访问异常, 放到队列里到IO线程中发送则不会有问题
- {$region '放入发送队列'}
- System.New(LSendItem);
- FillChar(LSendItem^, SizeOf(TSendItem), 0);
- LSendItem.Data := ABuf;
- LSendItem.Size := ALen;
- LSendItem.Callback := ACallback;
-
- LKqConnection := AConnection as TKqueueConnection;
-
- LKqConnection._KqLock;
- try
- // 将数据放入队列
- LKqConnection.FSendQueue.Add(LSendItem);
-
- // 由于 kqueue 队列中每个套接字的读写事件是分开的两条记录
- // 所以发送只需要添加写事件即可, 不用管读事件, 否则反而会引起引用计数异常
- LKqConnection._UpdateIoEvent([ieWrite]);
- finally
- LKqConnection._KqUnlock;
- end;
- {$endregion}
-end;
-
-function TKqueueCrossSocket.ProcessIoEvent: Boolean;
-var
- LRet, I: Integer;
- LEvent: TKEvent;
- LCrossData: TCrossData;
- LListen: ICrossListen;
- LConnection: ICrossConnection;
-begin
- LRet := kevent(FKqueueHandle, nil, 0, @FEventList[0], MAX_EVENT_COUNT, nil);
- if (LRet < 0) then
- begin
- LRet := GetLastError;
- // EINTR, kevent 调用被系统信号打断, 可以进行重试
- Exit(LRet = EINTR);
- end;
-
- for I := 0 to LRet - 1 do
- begin
- LEvent := FEventList[I];
-
- // 收到退出命令
- if (LEvent.uData = SHUTDOWN_FLAG) then Exit(False);
-
- if (LEvent.uData = nil) then Continue;
-
- {$region '获取连接或监听对象'}
- LCrossData := TCrossData(LEvent.uData);
-
- if (LCrossData is TKqueueListen) then
- LListen := LCrossData as ICrossListen
- else
- LListen := nil;
-
- if (LCrossData is TKqueueConnection) then
- LConnection := LCrossData as ICrossConnection
- else
- LConnection := nil;
- {$endregion}
-
- {$region 'IO事件处理'}
- if (LListen <> nil) then
- begin
- if (LEvent.Filter = EVFILT_READ) then
- _HandleAccept(LListen);
- end else
- if (LConnection <> nil) then
- begin
- LConnection._Release;
-
- // kqueue的读写事件同一时间只可能触发一个
- if (LEvent.Filter = EVFILT_READ) then
- _HandleRead(LConnection)
- else if (LEvent.Filter = EVFILT_WRITE) then
- begin
- if (LConnection.ConnectStatus = csConnecting) then
- _HandleConnect(LConnection)
- else
- _HandleWrite(LConnection);
- end;
- end;
- {$endregion}
- end;
-
- Result := True;
-end;
-
-end.
+{******************************************************************************}
+{ }
+{ Delphi cross platform socket library }
+{ }
+{ Copyright (c) 2017 WiNDDRiVER(soulawing@gmail.com) }
+{ }
+{ Homepage: https://github.com/winddriver/Delphi-Cross-Socket }
+{ }
+{******************************************************************************}
+unit Net.CrossSocket.Kqueue;
+
+{$I zLib.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ Generics.Collections,
+
+ {$IFDEF DELPHI}
+ Posix.SysSocket,
+ Posix.NetinetIn,
+ Posix.UniStd,
+ Posix.NetDB,
+ Posix.Pthread,
+ Posix.ArpaInet,
+ Posix.Errno,
+ {$ELSE}
+ baseunix,
+ unix,
+ sockets,
+ netdb,
+ DTF.RTL,
+ {$ENDIF}
+
+ BSD.kqueue,
+
+ Net.SocketAPI,
+ Net.CrossSocket.Base,
+
+ Utils.SyncObjs,
+ Utils.ArrayUtils;
+
+{$IFDEF BSD}
+const
+ IPV6_V6ONLY = 27;
+{$ENDIF}
+
+type
+ {$IFDEF FPC}
+ TPipeDescriptors = {packed} record
+ ReadDes: Integer;
+ WriteDes: Integer;
+ end;
+ PPipeDescriptors = ^TPipeDescriptors;
+ {$ENDIF}
+
+ TIoEvent = (ieRead, ieWrite);
+ TIoEvents = set of TIoEvent;
+
+ TKqueueListen = class(TCrossListenBase)
+ private
+ FKqueueHandle: Integer;
+ FIoEvents: TIoEvents;
+
+ function _ReadEnabled: Boolean; inline;
+ function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+ public
+ constructor Create(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
+ const AFamily, ASockType, AProtocol: Integer); override;
+ end;
+
+ PSendItem = ^TSendItem;
+ TSendItem = packed record
+ Data: PByte;
+ Size: Integer;
+ Callback: TCrossConnectionCallback;
+ end;
+
+ TSendQueue = class(TList)
+ protected
+ procedure Notify(const Value: PSendItem; Action: TCollectionNotification); override;
+ end;
+
+ TKqueueConnection = class(TCrossConnectionBase)
+ private
+ FKqueueHandle: Integer;
+ FSendQueue: TSendQueue;
+ FKqLock: ILock;
+ FInPending, FOutPending: Integer;
+
+ function _UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+
+ procedure _ClearSendQueue;
+
+ procedure _KqLock; inline;
+ procedure _KqUnlock; inline;
+ protected
+ procedure InternalClose; override;
+ public
+ constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback); override;
+ destructor Destroy; override;
+ end;
+
+ // KQUEUE 与 EPOLL 队列的差异
+ // KQUEUE的队列中, 一个Socket句柄可以有多条记录, 每个事件一条,
+ // 这一点和 EPOLL 不一样, EPOLL中每个Socket句柄只会有一条记录
+ // 要监测多个事件时, 只需要将多个事件做位运算加在一起调用 epoll_ctl 即可
+ //
+ // EV_DISPATCH 和 EV_CLEAR 是令 kqueue 支持线程池的关键
+ // 该参数组合可以令事件触发后就立即被禁用, 避免让同一个Socket的同一个事件
+ // 同时被多个工作线程触发
+ //
+ // EVFILT_READ
+ // 用于监测接收缓冲区是否可读了
+ // 对于监听Socket来说,表示有新的连接到来
+ // 对于已连接的Socket来说,表示有数据到达接收缓冲区
+ // 为了支持线程池, 必须带上参数 EV_CLEAR or EV_DISPATCH
+ // 该参数组合表示, 该事件一旦触发立即清除该事件的状态并禁用它
+ // 处理完连接或者读取数据之后再投递一次 EVFILT_READ, 带上参数
+ // EV_ENABLE or EV_CLEAR or EV_DISPATCH, 让事件继续监测
+ //
+ // EVFILT_WRITE
+ // 用于监测发送缓冲区是否可写了
+ // 对于Connect中的Socket,投递EV_ENABLE,等到事件触发时表示连接已建立
+ // 对于已连接的Socket,在Send之后立即投递EVFILT_WRITE,等到事件触发时表示发送完成
+ // 对于EVFILT_WRITE都应该带上EV_ONESHOT参数,让该事件只会被触发一次
+ // 否则,只要发送缓冲区是空的,该事件就会一直触发,这并没有什么意义
+ // 我们只需要用EVFILT_WRITE去监测连接或者发送是否成功
+ //
+ // KQUEUE 发送数据
+ // 最好的做法是将实际发送数据的动作放到 EVFILT_WRITE 触发时进行, 该
+ // 事件触发表明 Socket 发送缓存有空闲空间了。IOCP可以直接将待发送的数据及
+ // 回调同时扔给 WSASend, 发送完成后去调用回调即可; KQUEUE 机制不一样, 在 KQUEUE
+ // 中没有类似 WSASend 的函数, 只能自行维护发送数据及回调的队列
+ // EPOLL要支持多线程并发发送数据必须创建发送队列, 否则同一个 Socket 的并发发送
+ // 极有可能有一部分会被其它发送覆盖掉
+ //
+ // 由于 KQUEUE 中每个套接字在队列中的 EV_WRITE 和 EV_READ 是分开的两条记录
+ // 所以修改套接字的监听事件时不会互相覆盖, 也就是说每个事件都会对应到一次
+ // 触发, 这样就可以方便的使用接口的引用计数机制保持连接的有效性, 也不会出现
+ // 内存泄漏
+ TKqueueCrossSocket = class(TCrossSocketBase)
+ private const
+ MAX_EVENT_COUNT = 2048;
+ SHUTDOWN_FLAG = Pointer(-1);
+ private class threadvar
+ FEventList: array [0..MAX_EVENT_COUNT-1] of TKEvent;
+ private
+ FKqueueHandle: Integer;
+ FIoThreads: TArray;
+ FIdleHandle: THandle;
+ FIdleLock: ILock;
+ FStopHandle: TPipeDescriptors;
+
+ // 利用 pipe 唤醒并退出IO线程
+ procedure _OpenStopHandle; inline;
+ procedure _PostStopCommand; inline;
+ procedure _CloseStopHandle; inline;
+
+ procedure _OpenIdleHandle; inline;
+ procedure _CloseIdleHandle; inline;
+
+ // 在向一个已经关闭的套接字发送数据时系统会直接抛出EPIPE异常导致程序非正常退出
+ // LINUX下可以在send时带上MSG_NOSIGNAL参数就能避免这种情况的发生
+ // OSX中可以通过设置套接字的SO_NOSIGPIPE参数达到同样的目的
+ procedure _SetNoSigPipe(ASocket: TSocket); inline;
+
+ procedure _HandleAccept(const AListen: ICrossListen);
+ procedure _HandleConnect(const AConnection: ICrossConnection);
+ procedure _HandleRead(const AConnection: ICrossConnection);
+ procedure _HandleWrite(const AConnection: ICrossConnection);
+ protected
+ function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket;
+ const AConnectType: TConnectType; const AHost: string;
+ const AConnectCb: TCrossConnectionCallback): ICrossConnection; override;
+ function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket;
+ const AFamily, ASockType, AProtocol: Integer): ICrossListen; override;
+
+ procedure StartLoop; override;
+ procedure StopLoop; override;
+
+ procedure Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback = nil); override;
+
+ procedure Connect(const AHost: string; const APort, ALocalPort: Word;
+ const ACallback: TCrossConnectionCallback = nil); override;
+
+ procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer;
+ const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override;
+
+ function ProcessIoEvent: Boolean; override;
+ public
+ constructor Create(const AIoThreads: Integer); override;
+ destructor Destroy; override;
+ end;
+
+implementation
+
+{$IFDEF FPC}
+function pipe(var PipeDes: TPipeDescriptors): Integer; cdecl; external 'c' name 'pipe';
+function __read(Handle: Integer; Buffer: Pointer; Count: size_t): ssize_t; cdecl; external 'c' name 'read';
+function __write(Handle: Integer; Buffer: Pointer; Count: size_t): ssize_t; cdecl; external 'c' name 'write';
+function __close(Handle: Integer): Integer; cdecl; external 'c' name 'close';
+{$ENDIF}
+
+{ TKqueueListen }
+
+constructor TKqueueListen.Create(const AOwner: TCrossSocketBase;
+ const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer);
+begin
+ inherited;
+ FKqueueHandle := TKqueueCrossSocket(AOwner).FKqueueHandle;
+end;
+
+function TKqueueListen._ReadEnabled: Boolean;
+begin
+ Result := (ieRead in FIoEvents);
+end;
+
+function TKqueueListen._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+var
+ LCrossData: Pointer;
+ LEvents: array [0..1] of TKEvent;
+ N: Integer;
+begin
+ FIoEvents := AIoEvents;
+
+ if (FIoEvents = []) or IsClosed then Exit(False);
+
+ LCrossData := Pointer(Self);
+ N := 0;
+
+ if _ReadEnabled then
+ begin
+ EV_SET(@LEvents[N], Socket, EVFILT_READ,
+ EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
+
+ Inc(N);
+ end;
+
+ if (N <= 0) then Exit(False);
+
+ Result := (kevent(FKqueueHandle, @LEvents, N, nil, 0, nil) >= 0);
+
+ {$IFDEF DEBUG}
+ if not Result then
+ _LogLastOsError('listen kevent, %s', [Socket, Self.DebugInfo]);
+ {$ENDIF}
+end;
+
+{ TSendQueue }
+
+procedure TSendQueue.Notify(const Value: PSendItem;
+ Action: TCollectionNotification);
+begin
+ inherited;
+
+ if (Action = TCollectionNotification.cnRemoved) then
+ begin
+ if (Value <> nil) then
+ begin
+ Value.Callback := nil;
+ System.Dispose(Value);
+ end;
+ end;
+end;
+
+{ TKqueueConnection }
+
+constructor TKqueueConnection.Create(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback);
+begin
+ inherited Create(AOwner, AClientSocket, AConnectType, AHost, AConnectCb);
+
+ FKqLock := TLock.Create;
+ FSendQueue := TSendQueue.Create;
+
+ FKqueueHandle := TKqueueCrossSocket(AOwner).FKqueueHandle;
+end;
+
+destructor TKqueueConnection.Destroy;
+begin
+ _ClearSendQueue;
+ FreeAndNil(FSendQueue);
+
+ inherited;
+end;
+
+procedure TKqueueConnection.InternalClose;
+var
+ LEvent: TKEvent;
+begin
+ _ClearSendQueue;
+
+ // 从 kqueue 中删除该 socket 的所有事件，防止 fd 重用后触发错误回调
+ EV_SET(@LEvent, Socket, EVFILT_READ, EV_DELETE, 0, 0, nil);
+ kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
+ EV_SET(@LEvent, Socket, EVFILT_WRITE, EV_DELETE, 0, 0, nil);
+ kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
+
+ inherited InternalClose;
+end;
+
+procedure TKqueueConnection._ClearSendQueue;
+var
+ LConnection: ICrossConnection;
+ LSendItem: PSendItem;
+ LCallbacks: TArray;
+ LCallback: TCrossConnectionCallback;
+begin
+ LConnection := Self;
+ LCallbacks := [];
+
+ _KqLock;
+ try
+ // 连接释放时, 先收集所有回调, 然后在锁外执行
+ // 避免回调中再次发送数据导致死锁
+ if (FSendQueue <> nil) and (FSendQueue.Count > 0) then
+ begin
+ for LSendItem in FSendQueue do
+ if Assigned(LSendItem.Callback) then
+ TArrayUtils.Append(LCallbacks, LSendItem.Callback);
+
+ FSendQueue.Clear;
+ end;
+ finally
+ _KqUnlock;
+ end;
+
+ // 在锁外执行回调, 告知发送失败
+ for LCallback in LCallbacks do
+ LCallback(LConnection, False);
+end;
+
+procedure TKqueueConnection._KqLock;
+begin
+ FKqLock.Enter;
+end;
+
+procedure TKqueueConnection._KqUnlock;
+begin
+ FKqLock.Leave;
+end;
+
+function TKqueueConnection._UpdateIoEvent(const AIoEvents: TIoEvents): Boolean;
+var
+ LCrossData: Pointer;
+ LEvents: array [0..1] of TKEvent;
+ N: Integer;
+begin
+ if (AIoEvents = []) or IsClosed then Exit(False);
+
+ LCrossData := Pointer(Self);
+ N := 0;
+
+ // kqueue中同一个套接字的EVFILT_READ和EVFILT_WRITE事件在队列中会有两条记录
+ // 并且可能会在不同的线程中同时被触发, 如果其中一个线程关闭了连接, 在没有
+ // 引用计数保护的情况下, 就会导致连接对象被释放, 另一个线程再访问连接对象
+ // 就会引起异常, 这里为了保证连接对象的有效性, 在添加事件时手动增加连接对象
+ // 的引用计数, 到事件触发时再减少引用计数
+ // 注意关闭连接一定要使用shutdown而不能直接close, 否则无法触发kqueue事件,
+ // 导致引用计数无法回收
+
+ if (ieRead in AIoEvents) and (AtomicCmpExchange(FInPending, 0, 0) = 0) then
+ begin
+ Self._AddRef;
+
+ EV_SET(@LEvents[N], Socket, EVFILT_READ,
+ EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
+
+ Inc(N);
+ end;
+
+ if (ieWrite in AIoEvents) and (AtomicCmpExchange(FOutPending, 0, 0) = 0) then
+ begin
+ Self._AddRef;
+
+ EV_SET(@LEvents[N], Socket, EVFILT_WRITE,
+ EV_ADD or EV_ONESHOT or EV_CLEAR or EV_DISPATCH, 0, 0, Pointer(LCrossData));
+
+ Inc(N);
+ end;
+
+ if (N <= 0) then Exit(False);
+
+ Result := (kevent(FKqueueHandle, @LEvents, N, nil, 0, nil) >= 0);
+
+ if not Result then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('connection kevent, %s', [Self.DebugInfo]);
+ {$ENDIF}
+
+ while (N > 0) do
+ begin
+ Self._Release;
+ Dec(N);
+ end;
+
+ Self.Close;
+ end;
+end;
+
+{ TKqueueCrossSocket }
+
+constructor TKqueueCrossSocket.Create(const AIoThreads: Integer);
+begin
+ inherited;
+
+ FIdleLock := TLock.Create;
+end;
+
+destructor TKqueueCrossSocket.Destroy;
+begin
+ inherited;
+end;
+
+procedure TKqueueCrossSocket._CloseIdleHandle;
+begin
+ FileClose(FIdleHandle);
+end;
+
+procedure TKqueueCrossSocket._CloseStopHandle;
+begin
+ FileClose(FStopHandle.ReadDes);
+ FileClose(FStopHandle.WriteDes);
+end;
+
+procedure TKqueueCrossSocket._HandleAccept(const AListen: ICrossListen);
+var
+ LListen: ICrossListen;
+ LKqListen: TKqueueListen;
+ LConnection: ICrossConnection;
+ LKqConnection: TKqueueConnection;
+ LError: Integer;
+ LSocket, LListenSocket, LClientSocket: TSocket;
+ LSuccess: Boolean;
+begin
+ LListen := AListen;
+ LListenSocket := LListen.Socket;
+
+ while True do
+ begin
+ LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
+
+ // Accept失败
+ // EAGAIN 所有就绪的连接都已处理完毕
+ // EMFILE 进程的文件句柄已经用完了
+ if (LSocket < 0) then
+ begin
+ LError := GetLastError;
+
+ // 所有就绪的连接都已处理完毕, 正常情况
+ if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ begin
+ // 空处理, 仅用于区分 EMFILE 和其他错误
+ end else
+ // 当句柄用完了的时候, 释放事先占用的临时句柄
+ // 然后再次 accept, 然后将 accept 的句柄关掉
+ // 这样可以保证在文件句柄耗尽的时候依然能响应连接请求
+ // 并立即将新到的连接关闭
+ if (LError = EMFILE) then
+ begin
+ FIdleLock.Enter;
+ try
+ _CloseIdleHandle;
+ LSocket := TSocketAPI.Accept(LListenSocket, nil, nil);
+ TSocketAPI.CloseSocket(LSocket);
+ _OpenIdleHandle;
+ finally
+ FIdleLock.Leave;
+ end;
+ end else
+ _LogLastOsError('Accept');
+
+ Break;
+ end;
+
+ LClientSocket := LSocket;
+ TSocketAPI.SetNonBlock(LClientSocket, True);
+ SetKeepAlive(LClientSocket);
+ _SetNoSigPipe(LClientSocket);
+
+ LConnection := CreateConnection(Self, LClientSocket, ctAccept, '');
+ TriggerConnecting(LConnection);
+ TriggerConnected(LConnection);
+
+ // 连接建立后监视Socket的读事件
+ LKqConnection := LConnection as TKqueueConnection;
+ LKqConnection._KqLock;
+ try
+ LKqConnection._UpdateIoEvent([ieRead]);
+ finally
+ LKqConnection._KqUnlock;
+ end;
+ end;
+
+ // 继续接收新连接
+ LKqListen := LListen as TKqueueListen;
+ LKqListen._Lock;
+ LKqListen._UpdateIoEvent([ieRead]);
+ LKqListen._Unlock;
+end;
+
+procedure TKqueueCrossSocket._HandleConnect(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LKqConnection: TKqueueConnection;
+ LSockErr: Integer;
+begin
+ LConnection := AConnection;
+
+ // Connect失败
+ LSockErr := TSocketAPI.GetError(LConnection.Socket);
+ if (LSockErr <> 0) then
+ begin
+ LConnection.LastNetError := LSockErr;
+ _LogLastOsError(Self.ClassName + '._HandleConnect.GetError');
+ LConnection.Close;
+ Exit;
+ end;
+
+ TriggerConnected(LConnection);
+
+ LKqConnection := LConnection as TKqueueConnection;
+
+ LKqConnection._KqLock;
+ try
+ LKqConnection._UpdateIoEvent([ieRead]);
+ finally
+ LKqConnection._KqUnlock;
+ end;
+end;
+
+procedure TKqueueCrossSocket._HandleRead(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LKqConnection: TKqueueConnection;
+ LRcvd, LError: Integer;
+ LSuccess: Boolean;
+begin
+ LConnection := AConnection;
+ LKqConnection := LConnection as TKqueueConnection;
+
+ AtomicIncrement(LKqConnection.FInPending);
+ try
+ while True do
+ begin
+ LRcvd := TSocketAPI.Recv(LConnection.Socket, FRecvBuf[0], RCV_BUF_SIZE);
+
+ // 对方主动断开连接
+ if (LRcvd = 0) then
+ begin
+ _Log('Recv=0(Close), %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Exit;
+ end;
+
+ if (LRcvd < 0) then
+ begin
+ LError := GetLastError;
+
+ // 被系统信号中断, 可以重新recv
+ if (LError = EINTR) then
+ Continue
+ // 接收缓冲区中数据已经被取完了
+ else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ Break
+ else
+ // 接收出错
+ begin
+ _LogLastOsError('Recv<0, %s', [LConnection.DebugInfo]);
+ LConnection.Close;
+ Exit;
+ end;
+ end;
+
+ TriggerReceived(LConnection, @FRecvBuf[0], LRcvd);
+
+ // 回调中可能关闭了连接, 需要检查状态
+ if LConnection.IsClosed then Exit;
+
+ if (LRcvd < RCV_BUF_SIZE) then Break;
+ end;
+ finally
+ AtomicDecrement(LKqConnection.FInPending);
+ end;
+
+ LKqConnection._KqLock;
+ try
+ LKqConnection._UpdateIoEvent([ieRead]);
+ finally
+ LKqConnection._KqUnlock;
+ end;
+end;
+
+procedure TKqueueCrossSocket._HandleWrite(const AConnection: ICrossConnection);
+var
+ LConnection: ICrossConnection;
+ LKqConnection: TKqueueConnection;
+ LSendItem: PSendItem;
+ LSent, LError: Integer;
+ LSendCbArr: TArray;
+ LSendCb: TCrossConnectionCallback;
+begin
+ LConnection := AConnection;
+ LKqConnection := LConnection as TKqueueConnection;
+ LSendCbArr := [];
+
+ AtomicIncrement(LKqConnection.FOutPending);
+ LKqConnection._KqLock;
+ try
+ while True do
+ begin
+ // 检查队列中有没有数据
+ if (LKqConnection.FSendQueue = nil) or (LKqConnection.FSendQueue.Count <= 0) then Break;
+
+ // 获取Socket发送队列中的第一条数据
+ LSendItem := LKqConnection.FSendQueue.Items[0];
+
+ // 发送数据
+ {$IFNDEF MACOS}
+ LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size, MSG_NOSIGNAL);
+ {$ELSE}
+ LSent := TSocketAPI.Send(LConnection.Socket, LSendItem.Data^, LSendItem.Size);
+ {$ENDIF}
+
+ // 对方主动断开连接
+ if (LSent = 0) then
+ begin
+ _Log('Send=0(close), %s', [LConnection.DebugInfo]);
+
+ LConnection.Close;
+ Break;
+ end;
+
+ // 连接断开或发送错误
+ if (LSent < 0) then
+ begin
+ LError := GetLastError;
+
+ // 被系统信号中断, 可以重新send
+ if (LError = EINTR) then
+ Continue
+ // 发送缓冲区已被填满了, 需要等下次唤醒发送线程再继续发送
+ else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ Break
+ // 发送出错
+ else
+ begin
+ _LogLastOsError('Send<0, %s', [LConnection.DebugInfo]);
+
+ LConnection.Close;
+ Break;
+ end;
+ end;
+
+ // 全部发送完成
+ if (LSent >= LSendItem.Size) then
+ begin
+ TArrayUtils.Append(LSendCbArr, LSendItem.Callback);
+
+ // 发送成功, 移除已发送成功的数据
+ // 必须先从队列移除已发完的数据项, 然后再执行发送成功的回调
+ // 因为回调里可能还会发送新的数据, 如果先执行回调再去移除,
+ // 就会错误的将回调中放到队列里的新数据移除
+ if (LKqConnection.FSendQueue.Count > 0) then
+ LKqConnection.FSendQueue.Delete(0);
+ end else
+ begin
+ // 部分发送成功, 在下一次唤醒发送线程时继续处理剩余部分
+ Dec(LSendItem.Size, LSent);
+ Inc(LSendItem.Data, LSent);
+ end;
+ end;
+ finally
+ LKqConnection._KqUnlock;
+ AtomicDecrement(LKqConnection.FOutPending);
+ end;
+
+ // 调用回调
+ for LSendCb in LSendCbArr do
+ LSendCb(LConnection, True);
+
+ LKqConnection._KqLock;
+ try
+ if (LKqConnection.FSendQueue <> nil) and (LKqConnection.FSendQueue.Count > 0) then
+ LKqConnection._UpdateIoEvent([ieWrite]);
+ finally
+ LKqConnection._KqUnlock;
+ end;
+end;
+
+procedure TKqueueCrossSocket._OpenIdleHandle;
+begin
+ FIdleHandle := FileOpen('/dev/null', fmOpenRead);
+end;
+
+procedure TKqueueCrossSocket._OpenStopHandle;
+var
+ LEvent: TKEvent;
+begin
+ pipe(FStopHandle);
+
+ // 这里不使用 EV_ONESHOT
+ // 这样可以保证通知退出的命令发出后, 所有IO线程都会收到
+ EV_SET(@LEvent, FStopHandle.ReadDes, EVFILT_READ,
+ EV_ADD, 0, 0, SHUTDOWN_FLAG);
+ kevent(FKqueueHandle, @LEvent, 1, nil, 0, nil);
+end;
+
+procedure TKqueueCrossSocket._PostStopCommand;
+var
+ LStuff: UInt64;
+begin
+ LStuff := 1;
+ // 往 FStopHandle.WriteDes 写入任意数据, 唤醒工作线程
+ __write(FStopHandle.WriteDes, @LStuff, SizeOf(LStuff));
+end;
+
+procedure TKqueueCrossSocket._SetNoSigPipe(ASocket: TSocket);
+begin
+ {$if defined(MACOS) or defined(FREEBSD)}
+ TSocketAPI.SetSockOpt(ASocket, SOL_SOCKET, SO_NOSIGPIPE, 1);
+ {$endif}
+end;
+
+procedure TKqueueCrossSocket.StartLoop;
+var
+ I: Integer;
+begin
+ if (FIoThreads <> nil) then Exit;
+
+ _OpenIdleHandle;
+
+ FKqueueHandle := kqueue();
+ SetLength(FIoThreads, GetIoThreads);
+ for I := 0 to Length(FIoThreads) - 1 do
+ FIoThreads[i] := TIoEventThread.Create(Self);
+
+ _OpenStopHandle;
+end;
+
+procedure TKqueueCrossSocket.StopLoop;
+var
+ I: Integer;
+ LCurrentThreadID: TThreadID;
+begin
+ if (FIoThreads = nil) then Exit;
+
+ CloseAll;
+
+ while (ListensCount > 0) or (ConnectionsCount > 0) do Sleep(1);
+
+ _PostStopCommand;
+
+ LCurrentThreadID := GetCurrentThreadId;
+ for I := 0 to Length(FIoThreads) - 1 do
+ begin
+ if (FIoThreads[I].ThreadID = LCurrentThreadID) then
+ raise ECrossSocket.Create('不能在IO线程中执行StopLoop!');
+
+ FIoThreads[I].WaitFor;
+ FreeAndNil(FIoThreads[I]);
+ end;
+ FIoThreads := nil;
+
+ FileClose(FKqueueHandle);
+ _CloseIdleHandle;
+ _CloseStopHandle;
+end;
+
+procedure TKqueueCrossSocket.Connect(const AHost: string;
+ const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback);
+
+ procedure _Failed1;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ end;
+
+ function _Connect(const ASocket: TSocket; const AAddr: PRawAddrInfo): Boolean;
+ procedure _Failed2;
+ begin
+ if Assigned(ACallback) then
+ ACallback(nil, False);
+ TSocketAPI.CloseSocket(ASocket);
+ end;
+ var
+ LSockAddr: TRawSockAddrIn;
+ LConnection: ICrossConnection;
+ LKqConnection: TKqueueConnection;
+ begin
+ FillChar(LSockAddr, SizeOf(TRawSockAddrIn), 0);
+ LSockAddr.AddrLen := AAddr.ai_addrlen;
+ if (AAddr.ai_family = AF_INET6) then
+ begin
+ LSockAddr.Addr6.sin6_family := AAddr.ai_family;
+ LSockAddr.Addr6.sin6_port := htons(ALocalPort);
+ end else
+ begin
+ LSockAddr.Addr.sin_family := AAddr.ai_family;
+ LSockAddr.Addr.sin_port := htons(ALocalPort);
+ end;
+ if (TSocketAPI.Bind(ASocket, @LSockAddr.Addr, LSockAddr.AddrLen) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TKqueueCrossSocket._Connect.Bind');
+ {$ENDIF}
+ _Failed2;
+ Exit(False);
+ end;
+
+ if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0)
+ or (GetLastError = EINPROGRESS) then
+ begin
+ LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback);
+ TriggerConnecting(LConnection);
+ LKqConnection := LConnection as TKqueueConnection;
+
+ LKqConnection._KqLock;
+ try
+ LKqConnection.ConnectStatus := csConnecting;
+ if not LKqConnection._UpdateIoEvent([ieWrite]) then
+ begin
+ LConnection.Close;
+ Exit(False);
+ end;
+ finally
+ LKqConnection._KqUnlock;
+ end;
+ end else
+ begin
+ _Failed2;
+ Exit(False);
+ end;
+
+ Result := True;
+ end;
+
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LSocket: TSocket;
+begin
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ _Failed1;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol);
+ if (LSocket = INVALID_SOCKET) then
+ begin
+ _Failed1;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LSocket, True);
+ SetKeepAlive(LSocket);
+ _SetNoSigPipe(LSocket);
+
+ if _Connect(LSocket, LAddrInfo) then Exit;
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+
+ _Failed1;
+end;
+
+function TKqueueCrossSocket.CreateConnection(const AOwner: TCrossSocketBase;
+ const AClientSocket: TSocket; const AConnectType: TConnectType;
+ const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection;
+begin
+ Result := TKqueueConnection.Create(
+ AOwner,
+ AClientSocket,
+ AConnectType,
+ AHost,
+ AConnectCb);
+end;
+
+function TKqueueCrossSocket.CreateListen(const AOwner: TCrossSocketBase;
+ const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen;
+begin
+ Result := TKqueueListen.Create(AOwner, AListenSocket, AFamily, ASockType, AProtocol);
+end;
+
+procedure TKqueueCrossSocket.Listen(const AHost: string; const APort: Word;
+ const ACallback: TCrossListenCallback);
+var
+ LHints: TRawAddrInfo;
+ P, LAddrInfo: PRawAddrInfo;
+ LListenSocket: TSocket;
+ LListen: ICrossListen;
+ LKqListen: TKqueueListen;
+ LListenSuccess, LUpdateIoEventSuccess: Boolean;
+
+ procedure _Failed;
+ begin
+ if not LListenSuccess and Assigned(ACallback) then
+ ACallback(LListen, False);
+
+ if (LListen <> nil) then
+ LListen.Close
+ else if (LListenSocket <> INVALID_SOCKET) then
+ TSocketAPI.CloseSocket(LListenSocket);
+ end;
+
+begin
+ LListenSuccess := False;
+ FillChar(LHints, SizeOf(TRawAddrInfo), 0);
+
+ LHints.ai_flags := AI_PASSIVE;
+ LHints.ai_family := AF_UNSPEC;
+ LHints.ai_socktype := SOCK_STREAM;
+ LHints.ai_protocol := IPPROTO_TCP;
+ LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints);
+ if (LAddrInfo = nil) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TKqueueCrossSocket.Listen.GetAddrInfo');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ P := LAddrInfo;
+ try
+ while (LAddrInfo <> nil) do
+ begin
+ LListen := nil;
+ LListenSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, LAddrInfo.ai_socktype,
+ LAddrInfo.ai_protocol);
+ if (LListenSocket = INVALID_SOCKET) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TKqueueCrossSocket.Listen.NewSocket');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ TSocketAPI.SetNonBlock(LListenSocket, True);
+ TSocketAPI.SetReUsePort(LListenSocket, True);
+
+ if (LAddrInfo.ai_family = AF_INET6) then
+ TSocketAPI.SetSockOpt(LListenSocket, IPPROTO_IPV6, IPV6_V6ONLY, 1);
+
+ if (TSocketAPI.Bind(LListenSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) < 0)
+ or (TSocketAPI.Listen(LListenSocket) < 0) then
+ begin
+ {$IFDEF DEBUG}
+ _LogLastOsError('TKqueueCrossSocket.Listen.Bind');
+ {$ENDIF}
+ _Failed;
+ Exit;
+ end;
+
+ LListen := CreateListen(Self, LListenSocket, LAddrInfo.ai_family,
+ LAddrInfo.ai_socktype, LAddrInfo.ai_protocol);
+ LKqListen := LListen as TKqueueListen;
+
+ // 监听套接字的读事件
+ // 读事件到达表明有新连接
+ LKqListen._Lock;
+ try
+ LUpdateIoEventSuccess := LKqListen._UpdateIoEvent([ieRead]);
+ finally
+ LKqListen._Unlock;
+ end;
+
+ if not LUpdateIoEventSuccess then
+ begin
+ _Failed;
+
+ Exit;
+ end;
+
+ // 监听成功
+ LListenSuccess := True;
+ TriggerListened(LListen);
+ if Assigned(ACallback) then
+ ACallback(LListen, True);
+
+ // 如果端口传入0，让所有地址统一用首个分配到的端口
+ if (APort = 0) and (LAddrInfo.ai_next <> nil) then
+ Psockaddr_in(LAddrInfo.ai_next.ai_addr).sin_port := htons(LListen.LocalPort);
+
+ LAddrInfo := PRawAddrInfo(LAddrInfo.ai_next);
+ end;
+ finally
+ TSocketAPI.FreeAddrInfo(P);
+ end;
+end;
+
+procedure TKqueueCrossSocket.Send(const AConnection: ICrossConnection;
+ const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback);
+var
+ LKqConnection: TKqueueConnection;
+ LSendItem: PSendItem;
+begin
+ // 测试过先发送, 然后将剩余部分放入发送队列的做法
+ // 发现会引起内存访问异常, 放到队列里到IO线程中发送则不会有问题
+ {$region '放入发送队列'}
+ System.New(LSendItem);
+ FillChar(LSendItem^, SizeOf(TSendItem), 0);
+ LSendItem.Data := ABuf;
+ LSendItem.Size := ALen;
+ LSendItem.Callback := ACallback;
+
+ LKqConnection := AConnection as TKqueueConnection;
+
+ LKqConnection._KqLock;
+ try
+ // 将数据放入队列
+ LKqConnection.FSendQueue.Add(LSendItem);
+
+ // 由于 kqueue 队列中每个套接字的读写事件是分开的两条记录
+ // 所以发送只需要添加写事件即可, 不用管读事件, 否则反而会引起引用计数异常
+ LKqConnection._UpdateIoEvent([ieWrite]);
+ finally
+ LKqConnection._KqUnlock;
+ end;
+ {$endregion}
+end;
+
+function TKqueueCrossSocket.ProcessIoEvent: Boolean;
+var
+ LRet, I: Integer;
+ LEvent: TKEvent;
+ LCrossData: TCrossData;
+ LListen: ICrossListen;
+ LConnection: ICrossConnection;
+begin
+ LRet := kevent(FKqueueHandle, nil, 0, @FEventList[0], MAX_EVENT_COUNT, nil);
+ if (LRet < 0) then
+ begin
+ LRet := GetLastError;
+ // EINTR, kevent 调用被系统信号打断, 可以进行重试
+ Exit(LRet = EINTR);
+ end;
+
+ for I := 0 to LRet - 1 do
+ begin
+ LEvent := FEventList[I];
+
+ // 收到退出命令
+ if (LEvent.uData = SHUTDOWN_FLAG) then Exit(False);
+
+ if (LEvent.uData = nil) then Continue;
+
+ {$region '获取连接或监听对象'}
+ LCrossData := TCrossData(LEvent.uData);
+
+ if (LCrossData is TKqueueListen) then
+ LListen := LCrossData as ICrossListen
+ else
+ LListen := nil;
+
+ if (LCrossData is TKqueueConnection) then
+ LConnection := LCrossData as ICrossConnection
+ else
+ LConnection := nil;
+ {$endregion}
+
+ {$region 'IO事件处理'}
+ if (LListen <> nil) then
+ begin
+ if (LEvent.Filter = EVFILT_READ) then
+ _HandleAccept(LListen);
+ end else
+ if (LConnection <> nil) then
+ begin
+ LConnection._Release;
+
+ // kqueue的读写事件同一时间只可能触发一个
+ if (LEvent.Filter = EVFILT_READ) then
+ _HandleRead(LConnection)
+ else if (LEvent.Filter = EVFILT_WRITE) then
+ begin
+ if (LConnection.ConnectStatus = csConnecting) then
+ _HandleConnect(LConnection)
+ else
+ _HandleWrite(LConnection);
+ end;
+ end;
+ {$endregion}
+ end;
+
+ Result := True;
+end;
+
+end.
diff --git a/Net/Net.CrossSslSocket.Base.pas b/Net/Net.CrossSslSocket.Base.pas
index 040a520..982f428 100644
--- a/Net/Net.CrossSslSocket.Base.pas
+++ b/Net/Net.CrossSslSocket.Base.pas
@@ -186,6 +186,43 @@ TCrossSslSocketBase = class(TCrossSocket, ICrossSslSocket)
procedure SetPrivateKey(const APKeyStr: string); overload; virtual;
procedure SetPrivateKeyFile(const APKeyFile: string); virtual;
+ { ── MTLS-1: CA certificate loading for client-certificate verification ──
+ Loads a CA certificate that the server will use to verify presented
+ client certificates during the TLS handshake (mutual TLS). Mirrors
+ the SetCertificate overload family above so consumers have the same
+ file/string/bytes/buffer surface they're already used to.
+
+ Concrete implementation in TCrossOpenSslSocket calls
+ SSL_CTX_add_client_CA + X509_STORE_add_cert to register the cert in
+ both the CertificateRequest CA list (sent to clients during the
+ handshake) and the trust store used to verify the presented chain. }
+ procedure SetCACertificate(const ACACertBuf: Pointer; const ACACertBufSize: Integer); overload; virtual; abstract;
+ procedure SetCACertificate(const ACACertBytes: TBytes); overload; virtual;
+ procedure SetCACertificate(const ACACertStr: string); overload; virtual;
+ procedure SetCACertificateFile(const ACACertFile: string); virtual;
+
+ { ── MTLS-2: enable / disable peer (client) certificate verification ──
+ When AVerify=True the server sets SSL_VERIFY_PEER |
+ SSL_VERIFY_FAIL_IF_NO_PEER_CERT — the handshake fails if the client
+ does not present a certificate signed by one of the CAs registered
+ above. When False, reverts to SSL_VERIFY_NONE (the default).
+ Must be called AFTER SetCACertificate so the trust store is
+ populated before verify mode is enabled. }
+ procedure SetVerifyPeer(const AVerify: Boolean); virtual; abstract;
+
+ { ── TLSOPT-1: passphrase for an encrypted PEM private key ──
+ Set the password OpenSSL uses to decrypt an encrypted PEM private key.
+ Must be called BEFORE SetPrivateKey / SetPrivateKeyFile so the key is
+ parsed with the passphrase available. Passing '' (the default) leaves the
+ unencrypted-key code path unchanged — a no-op for plain keys. }
+ procedure SetPrivateKeyPassword(const APassword: string); virtual; abstract;
+
+ { ── TLSOPT-2: override the negotiated cipher list (TLS 1.2 and below) ──
+ ACipherList is an OpenSSL cipher-list string (e.g.
+ 'ECDHE-RSA-AES256-GCM-SHA384:...'). Empty leaves the built-in default
+ list set in _InitSslCtx. TLS 1.3 cipher suites are not affected. }
+ procedure SetCipherList(const ACipherList: string); virtual; abstract;
+
property Ssl: Boolean read GetSsl;
property SslMaxPendingWriteBytes: Int64 read GetSslMaxPendingWriteBytes write SetSslMaxPendingWriteBytes;
@@ -262,6 +299,23 @@ procedure TCrossSslSocketBase.SetPrivateKeyFile(const APKeyFile: string);
SetPrivateKey(TFileUtils.ReadAllBytes(APKeyFile));
end;
+{ ── MTLS-1: SetCACertificate overload chain (file → string → bytes → buffer) ── }
+
+procedure TCrossSslSocketBase.SetCACertificate(const ACACertBytes: TBytes);
+begin
+ SetCACertificate(Pointer(ACACertBytes), Length(ACACertBytes));
+end;
+
+procedure TCrossSslSocketBase.SetCACertificate(const ACACertStr: string);
+begin
+ SetCACertificate(TEncoding.ANSI.GetBytes(ACACertStr));
+end;
+
+procedure TCrossSslSocketBase.SetCACertificateFile(const ACACertFile: string);
+begin
+ SetCACertificate(TFileUtils.ReadAllBytes(ACACertFile));
+end;
+
{ TCrossSslConnectionBase }
function TCrossSslConnectionBase.GetSsl: Boolean;
diff --git a/Net/Net.CrossSslSocket.OpenSSL.pas b/Net/Net.CrossSslSocket.OpenSSL.pas
index 5f357c6..ac7001c 100644
--- a/Net/Net.CrossSslSocket.OpenSSL.pas
+++ b/Net/Net.CrossSslSocket.OpenSSL.pas
@@ -19,6 +19,35 @@
传输层安全协议:
https://zh.wikipedia.org/wiki/%E5%82%B3%E8%BC%B8%E5%B1%A4%E5%AE%89%E5%85%A8%E5%8D%94%E8%AD%B0
+
+ ── mTLS additions ───────────────────────────────────────────────────────────
+ [MTLS-1] SetCACertificate(Pointer, Integer) override added.
+ Loads a CA certificate from a memory buffer and registers it with
+ the SSL context for client-certificate verification (mTLS server
+ mode). Uses BIO_new_mem_buf + PEM_read_bio_X509 to parse the PEM
+ data, then calls SSL_CTX_add_client_CA (populates the CA list sent
+ to clients in the CertificateRequest handshake message) and
+ X509_STORE_add_cert (adds the cert to the trust store used to
+ verify the presented certificate chain).
+ Companion overloads (TBytes / string / file) inherited from the
+ base class (Net.CrossSslSocket.Base) mirror the SetCertificate
+ overload family.
+
+ [MTLS-2] SetVerifyPeer(Boolean) override added.
+ When AVerify=True, sets SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT
+ so the server demands a valid client certificate.
+ When AVerify=False, reverts to SSL_VERIFY_NONE (default).
+ Must be called AFTER SetCACertificate — the trust store must be
+ populated before verify mode is enabled.
+
+ ── TLS-option additions ─────────────────────────────────────────────────────
+ [TLSOPT-1] SetPrivateKeyPassword(string) override + password-aware SetPrivateKey.
+ Stores a passphrase; the next SetPrivateKey parses an encrypted PEM
+ key with PEM_read_bio_PrivateKey + a password callback, then
+ SSL_CTX_use_PrivateKey. Empty passphrase keeps the unencrypted path.
+ [TLSOPT-2] SetCipherList(string) override.
+ Calls SSL_CTX_set_cipher_list to override the TLS 1.2 cipher list;
+ raises if the string selects no ciphers. TLS 1.3 suites unchanged.
}
interface
@@ -140,6 +169,7 @@ TPendingWrite = record
TCrossOpenSslSocket = class(TCrossSslSocketBase)
private
FSslCtx: PSSL_CTX;
+ FPKeyPassword: AnsiString; // [TLSOPT-1] passphrase for an encrypted key
procedure _InitSslCtx;
procedure _FreeSslCtx;
@@ -166,6 +196,25 @@ TCrossOpenSslSocket = class(TCrossSslSocketBase)
procedure SetCertificate(const ACertBuf: Pointer; const ACertBufSize: Integer); overload; override;
procedure SetPrivateKey(const APKeyBuf: Pointer; const APKeyBufSize: Integer); overload; override;
+
+ { ── MTLS-1: load a CA certificate (PEM buffer) for client-cert verification.
+ Calls SSL_CTX_add_client_CA to register the CA name in the
+ CertificateRequest list the server sends to clients during the
+ handshake, and X509_STORE_add_cert to populate the trust store used to
+ verify the certificate chain presented by the client. }
+ procedure SetCACertificate(const ACACertBuf: Pointer; const ACACertBufSize: Integer); overload; override;
+
+ { ── MTLS-2: enable / disable client-certificate verification.
+ AVerify=True → SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT
+ (handshake fails without a valid client cert)
+ AVerify=False → SSL_VERIFY_NONE (default) }
+ procedure SetVerifyPeer(const AVerify: Boolean); override;
+ { ── TLSOPT-1: store the passphrase used to decrypt an encrypted PEM private
+ key. Applied by the next SetPrivateKey call. }
+ procedure SetPrivateKeyPassword(const APassword: string); override;
+
+ { ── TLSOPT-2: override the TLS 1.2 cipher list via SSL_CTX_set_cipher_list. }
+ procedure SetCipherList(const ACipherList: string); override;
end;
{$IFDEF CROSS_OPENSSL_SELFTEST}
@@ -1108,11 +1157,151 @@ procedure TCrossOpenSslSocket.SetCertificate(const ACertBuf: Pointer;
TSSLTools.SetCertificate(FSslCtx, ACertBuf, ACertBufSize);
end;
+{ ── TLSOPT-1: OpenSSL PEM password callback ──────────────────────────────────
+ OpenSSL calls this to obtain the passphrase for an encrypted PEM key. AUserData
+ points to a null-terminated copy of the passphrase (PAnsiChar of an AnsiString).
+ Copies up to ASize bytes into ABuf and returns the length. No RTL dependency
+ (manual null-scan) so the unit stays dual-compile (Delphi + FPC). }
+function _IcsHorsePemPasswdCb(ABuf: Pointer; ASize, ARWFlag: Integer;
+ AUserData: Pointer): Integer; cdecl;
+var
+ P: PAnsiChar;
+ LLen: Integer;
+begin
+ Result := 0;
+ if (AUserData = nil) or (ASize <= 0) then Exit;
+ P := PAnsiChar(AUserData);
+ LLen := 0;
+ while (P[LLen] <> #0) and (LLen < ASize) do
+ Inc(LLen);
+ if LLen > 0 then
+ Move(P^, ABuf^, LLen);
+ Result := LLen;
+end;
+
procedure TCrossOpenSslSocket.SetPrivateKey(const APKeyBuf: Pointer;
const APKeyBufSize: Integer);
+var
+ LBio: PBIO;
+ LPKey: PEVP_PKEY;
begin
- if Ssl then
+ if not Ssl or (FSslCtx = nil) then Exit;
+
+ // Unencrypted key (no passphrase set) — unchanged upstream behaviour.
+ if FPKeyPassword = '' then
+ begin
TSSLTools.SetPrivateKey(FSslCtx, APKeyBuf, APKeyBufSize);
+ Exit;
+ end;
+
+ // [TLSOPT-1] Encrypted PEM key — parse with the passphrase callback (mirrors
+ // the SetCACertificate BIO + PEM_read pattern), then install into the context.
+ LBio := BIO_new_mem_buf(APKeyBuf, APKeyBufSize);
+ if LBio = nil then
+ raise ESsl.Create('SetPrivateKey: BIO_new_mem_buf failed');
+ try
+ LPKey := PEM_read_bio_PrivateKey(LBio, nil, @_IcsHorsePemPasswdCb,
+ PAnsiChar(FPKeyPassword));
+ if LPKey = nil then
+ raise ESsl.Create(
+ 'SetPrivateKey: PEM_read_bio_PrivateKey failed — wrong passphrase or ' +
+ 'the buffer is not a valid PEM private key');
+ try
+ if SSL_CTX_use_PrivateKey(FSslCtx, LPKey) <> 1 then
+ raise ESsl.Create('SetPrivateKey: SSL_CTX_use_PrivateKey failed');
+ finally
+ EVP_PKEY_free(LPKey);
+ end;
+ finally
+ BIO_free(LBio);
+ end;
+end;
+
+{ ── TLSOPT-1: store the passphrase for the next SetPrivateKey call. ────────── }
+procedure TCrossOpenSslSocket.SetPrivateKeyPassword(const APassword: string);
+begin
+ FPKeyPassword := AnsiString(APassword);
+end;
+
+{ ── TLSOPT-2: override the TLS 1.2 cipher list. SSL_CTX_set_cipher_list returns
+ 1 on success; a string that selects no ciphers returns 0. TLS 1.3 suites are
+ left at the _InitSslCtx defaults (they use a different naming/API). }
+procedure TCrossOpenSslSocket.SetCipherList(const ACipherList: string);
+var
+ LAnsi: AnsiString;
+begin
+ if not Ssl or (FSslCtx = nil) or (ACipherList = '') then Exit;
+ LAnsi := AnsiString(ACipherList);
+ // MarshaledAString = PAnsiChar; pass the AnsiString's buffer directly
+ // (mirrors the literal calls in _InitSslCtx).
+ if SSL_CTX_set_cipher_list(FSslCtx, PAnsiChar(LAnsi)) <> 1 then
+ raise ESsl.Create(
+ 'SetCipherList: SSL_CTX_set_cipher_list rejected "' + ACipherList +
+ '" (no matching ciphers)');
+end;
+
+{ ── MTLS-1: load a CA certificate (PEM buffer) into the SSL context ──────────
+ Registers the certificate with both the CertificateRequest CA list (sent to
+ clients in the TLS handshake to indicate which CAs the server trusts) and
+ the X509 trust store (used to verify the certificate chain presented by the
+ client). Must be called before SetVerifyPeer(True). }
+procedure TCrossOpenSslSocket.SetCACertificate(const ACACertBuf: Pointer;
+ const ACACertBufSize: Integer);
+var
+ LBio: PBIO;
+ LCACert: PX509;
+ LStore: PX509_STORE;
+begin
+ if not Ssl or (FSslCtx = nil) then Exit;
+
+ // Wrap the caller's buffer in a read-only memory BIO — no copy is made.
+ LBio := BIO_new_mem_buf(ACACertBuf, ACACertBufSize);
+ if LBio = nil then
+ raise ESsl.Create('SetCACertificate: BIO_new_mem_buf failed');
+ try
+ // Parse the PEM-encoded X.509 certificate.
+ LCACert := PEM_read_bio_X509(LBio, nil, nil, nil);
+ if LCACert = nil then
+ raise ESsl.Create(
+ 'SetCACertificate: PEM_read_bio_X509 failed — ' +
+ 'ensure the buffer contains a valid PEM certificate');
+ try
+ // Register the CA name in the CertificateRequest list.
+ SSL_CTX_add_client_CA(FSslCtx, LCACert);
+
+ // Add the cert to the trust store for chain verification.
+ LStore := SSL_CTX_get_cert_store(FSslCtx);
+ if Assigned(LStore) then
+ X509_STORE_add_cert(LStore, LCACert);
+ // X509_STORE_add_cert returns 0 if the cert is already in the store
+ // (duplicate) — this is benign, so we do not raise on <= 0 here.
+ finally
+ // Decrement our local ref-count. The context and store hold their own.
+ X509_free(LCACert);
+ end;
+ finally
+ BIO_free(LBio);
+ end;
+end;
+
+{ ── MTLS-2: enable or disable mandatory client-certificate verification ──────
+ SSL_VERIFY_NONE — no client certificate is requested (default).
+ SSL_VERIFY_PEER — request and verify, but allow connections
+ without a cert (or with an invalid cert).
+ SSL_VERIFY_FAIL_IF_NO_PEER_CERT — combined with PEER, requires the client
+ to present a valid cert; handshake fails
+ otherwise.
+ This implementation uses PEER | FAIL_IF_NO_PEER_CERT for AVerify=True so
+ the server demands a valid mTLS handshake. }
+procedure TCrossOpenSslSocket.SetVerifyPeer(const AVerify: Boolean);
+begin
+ if not Ssl or (FSslCtx = nil) then Exit;
+
+ if AVerify then
+ SSL_CTX_set_verify(FSslCtx,
+ SSL_VERIFY_PEER or SSL_VERIFY_FAIL_IF_NO_PEER_CERT, nil)
+ else
+ SSL_CTX_set_verify(FSslCtx, SSL_VERIFY_NONE, nil);
end;
procedure TCrossOpenSslSocket.TriggerConnected(const AConnection: ICrossConnection);
diff --git a/Net/Net.Posix.inc b/Net/Net.Posix.inc
index e422935..44d6910 100644
--- a/Net/Net.Posix.inc
+++ b/Net/Net.Posix.inc
@@ -1,43 +1,43 @@
-function PosixSend(ASocket: THandle; ABuf: Pointer;
- ALen: Integer): Integer;
-var
- LBuf: PByte;
- LSent, LError: Integer;
- LFlags: Integer;
-begin
- Result := 0;
-
- // һѾرյַʱϵͳֱ׳EPIPE쳣³˳
- // LINUX¿sendʱMSG_NOSIGNALܱķ
- // OSXпֵͨSO_NOSIGPIPEﵽͬĿ
- //{$IF defined(LINUX) or defined(ANDROID) or defined(FREEBSD)}
- {$IFNDEF MACOS}
- LFlags := MSG_NOSIGNAL;
- {$ELSE}
- LFlags := 0;
- {$ENDIF}
-
- LBuf := ABuf;
- while (Result < ALen) do
- begin
- LSent := TSocketAPI.Send(ASocket, LBuf^, ALen - Result, LFlags);
-
- if (LSent < 0) then
- begin
- LError := GetLastError;
-
- // ϵͳźж, send
- if (LError = EINTR) then
- Continue
- // ͻѱ
- else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
- Break
- // ͳ
- else
- Exit(-1);
- end;
-
- Inc(Result, LSent);
- Inc(LBuf, LSent);
- end;
-end;
+function PosixSend(ASocket: THandle; ABuf: Pointer;
+ ALen: Integer): Integer;
+var
+ LBuf: PByte;
+ LSent, LError: Integer;
+ LFlags: Integer;
+begin
+ Result := 0;
+
+ // һѾرյַʱϵͳֱ׳EPIPE쳣³˳
+ // LINUX¿sendʱMSG_NOSIGNALܱķ
+ // OSXпֵͨSO_NOSIGPIPEﵽͬĿ
+ //{$IF defined(LINUX) or defined(ANDROID) or defined(FREEBSD)}
+ {$IFNDEF MACOS}
+ LFlags := MSG_NOSIGNAL;
+ {$ELSE}
+ LFlags := 0;
+ {$ENDIF}
+
+ LBuf := ABuf;
+ while (Result < ALen) do
+ begin
+ LSent := TSocketAPI.Send(ASocket, LBuf^, ALen - Result, LFlags);
+
+ if (LSent < 0) then
+ begin
+ LError := GetLastError;
+
+ // ϵͳźж, send
+ if (LError = EINTR) then
+ Continue
+ // ͻѱ
+ else if (LError = EAGAIN) or (LError = EWOULDBLOCK) then
+ Break
+ // ͳ
+ else
+ Exit(-1);
+ end;
+
+ Inc(Result, LSent);
+ Inc(LBuf, LSent);
+ end;
+end;
diff --git a/boss.json b/boss.json
new file mode 100644
index 0000000..aac5229
--- /dev/null
+++ b/boss.json
@@ -0,0 +1,11 @@
+{
+ "name": "delphi-cross-socket",
+ "description": "Delphi cross-platform async socket library (IOCP/epoll/kqueue) with HTTP server and OpenSSL 3.x support. Fork of winddriver/Delphi-Cross-Socket — adds Boss package manifest only. Zero source changes.",
+ "version": "1.0.4",
+ "homepage": "https://github.com/freitasjca/Delphi-Cross-Socket",
+ "license": "MIT",
+ "mainsrc": "Net/",
+ "browsingpath": "Net/;Utils/;CnPack/Common/;CnPack/Crypto/",
+ "projects": [],
+ "dependencies": {}
+}
\ No newline at end of file