参考了Yang杨。老师的代码，原来是delphi代码，因为个人转到lazarus，所以进行移植了。
方法如下：下载最新的CNVCL，CnNative,要修改一下，其它引用单元注释掉
{.$I CnPack.inc} //加个点
CnNative，加个定义{$DEFine SUPPORT_UINT64}
其它可以参考原文：https://www.cnblogs.com/Yang-YaChao/p/16351961.html
{******************************************************************************}
{ CnPack For Delphi/C++Builder }
{ 中国人自己的开放源码第三方开发包 }
{ (C)Copyright 2001-2024 CnPack 开发组 }
{ ------------------------------------ }
{ }
{ 本开发包是开源的自由软件，您可以遵照 CnPack 的发布协议来修 }
{ 改和重新发布这一程序。 }
{ }
{ 发布这一开发包的目的是希望它有用，但没有任何担保。甚至没有 }
{ 适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。 }
{ }
{ 您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果 }
{ 还没有，可访问我们的网站： }
{ }
{ 网站地址：http://www.cnpack.org }
{ 电子邮件：master@cnpack.org }
{ }
{******************************************************************************}
unit CnSM4;
{* |<PRE>
================================================================================
* 软件名称：开发包基础库
* 单元名称：国产分组密码算法 SM4 单元
* 单元作者：刘啸（liuxiao@cnpack.org)
* 备 注：参考国密算法公开文档 SM4 Encryption alogrithm
* 并参考移植 goldboar 的 C 代码*
* 本单元未处理对齐方式，默认只在末尾补 0，
* 如需要 PKCS 之类的支持，，请在外部调用CnPemUtils 中的 PKCS 处理函数
* 另外高版本 Delphi 中请尽量避免使用 AnsiString 参数版本的函数（十六进制除外），
* 避免不可视字符出现乱码影响加解密结果。
* 开发平台：Windows 7 + Delphi 5.0
* 兼容测试：PWin9X/2000/XP/7 + Delphi 5/6 + MaxOS 64
* 本 地 化：该单元中的字符串均符合本地化处理方式
* 修改记录：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
* 移植并创建单元
================================================================================
|</PRE>}
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
TCnSM4Key = array[0..CN_SM4_KEYSIZE - 1] of Byte;
{* SM4 的加密 Key}
TCnSM4Buffer = array[0..CN_SM4_BLOCKSIZE - 1] of Byte;
{* SM4 的加密块}
TCnSM4Iv = array[0..CN_SM4_BLOCKSIZE - 1] of Byte;
{* SM4 的 CBC/CFB/OFB 等的初始化向量}
TCnSM4Nonce = array[0..CN_SM4_NONCESIZE - 1] of Byte;
{* SM4 的 CTR 模式下的初始化向量，与一个八字节计数器拼在一起作为真正的 Iv}
TCnSM4Context = packed record
Mode: Integer; {!< encrypt/decrypt }
Sk: array[0..CN_SM4_KEYSIZE * 2 - 1] of Cardinal; {!< SM4 subkeys }
end;
procedure SM4Encrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; Len: Integer);
{* 原始的 SM4 加密数据块，ECB 模式，将 Input 内的明文内容加密搁到 Output 中
调用者自行保证 Key 指向内容至少 16 字节，Input 和 Output 指向内容长相等并且都为 Len 字节
且 Len 必须被 16 整除}
procedure SM4Decrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; Len: Integer);
{* 原始的 SM4 解密数据块，ECB 模式，将 Input 内的密文内容解密搁到 Output 中
调用者自行保证 Key 指向内容至少需 16 字节，Input 和 Output 指向内容长相等并且都为 Len 字节
且 Len 必须被 16 整除}
// ============== 明文字符串与密文十六进制字符串之间的加解密 ===================
procedure SM4EncryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
{* SM4-ECB 封装好的针对 AnsiString 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Input 原始待加密字符串，其长度如不是 16 倍数，计算时会被填充 #0 至长度达到 16 的倍数
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4DecryptEcbStr(Key: AnsiString; const Input: AnsiString; Output: PAnsiChar);
{* SM4-ECB 封装好的针对 AnsiString 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Input 原始待解密字符串，其长度如不是 16 倍数，计算时会被填充 #0 至长度达到 16 的倍数
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4EncryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-CBC 封装好的针对 AnsiString 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待加密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4DecryptCbcStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-CBC 封装好的针对 AnsiString 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待解密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4EncryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-CFB 封装好的针对 AnsiString 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待加密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4DecryptCfbStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-CFB 封装好的针对 AnsiString 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待解密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4EncryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-OFB 封装好的针对 AnsiString 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待加密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4DecryptOfbStr(Key: AnsiString; Iv: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-OFB 封装好的针对 AnsiString 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Iv 不短于 16 字节的初始化向量，太长则超出部分忽略
Input 原始待解密字符串
Output Output 输出区，其长度必须大于或等于 (((Length(Input) - 1) div 16) + 1) * 16
|</PRE>}
procedure SM4EncryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-OFB 封装好的针对 AnsiString 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Nonce 不短于 8 字节的初始化向量，太长则超出部分忽略
Input 原始待加密字符串
Output Output 输出区，其长度必须大于或等于 Length(Input)
|</PRE>}
procedure SM4DecryptCtrStr(Key: AnsiString; Nonce: PAnsiChar;
const Input: AnsiString; Output: PAnsiChar);
{* SM4-OFB 封装好的针对 AnsiString 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 #0
Nonce 不短于 8 字节的初始化向量，太长则超出部分忽略
Input 原始待解密字符串
Output Output 输出区，其长度必须大于或等于 Length(Input)
|</PRE>}
// ================= 明文字节数组与密文字节数组之间的加解密 ====================
function SM4EncryptEcbBytes(Key: TBytes; const Input: TBytes): TBytes;
{* SM4-ECB 封装好的针对 TBytes 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Input 原始待加密内容，其长度如不是 16 倍数，计算时会被填充 0 至长度达到 16 的倍数
返回值 加密内容
|</PRE>}
function SM4DecryptEcbBytes(Key: TBytes; const Input: TBytes): TBytes;
{* SM4-ECB 封装好的针对 TBytes 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Input 原始待加密内容，其长度如不是 16 倍数，计算时会被填充 0 至长度达到 16 的倍数
返回值 解密内容
|</PRE>}
function SM4EncryptCbcBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-CBC 封装好的针对 TBytes 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCbcBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-CBC 封装好的针对 TBytes 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input input 密文
返回值 解密内容
|</PRE>}
function SM4EncryptCfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-CFB 封装好的针对 TBytes 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-CFB 封装好的针对 TBytes 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input input 密文
返回值 解密内容
|</PRE>}
function SM4EncryptOfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-OFB 封装好的针对 TBytes 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptOfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
{* SM4-OFB 封装好的针对 TBytes 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input input 密文
返回值 解密内容
|</PRE>}
function SM4EncryptCtrBytes(Key, Nonce: TBytes; const Input: TBytes): TBytes;
{* SM4-CTR 封装好的针对 TBytes 的加密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Nonce 8 字节初始化向量，太长则超出部分忽略，不足则在 Nonce 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCtrBytes(Key, Nonce: TBytes; const Input: TBytes): TBytes;
{* SM4-CTR 封装好的针对 TBytes 的解密方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Nonce 8 字节初始化向量，太长则超出部分忽略，不足则在 Nonce 后补 0
Input input 密文
返回值 解密内容
|</PRE>}
// ============== 明文字节数组与密文十六进制字符串之间的加解密 =================
function SM4EncryptEcbBytesToHex(Key: TBytes; const Input: TBytes): AnsiString;
{* SM4-ECB 封装好的针对 TBytes 的加密并转换成十六进制字符串的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Input 原始待加密内容，其长度如不是 16 倍数，计算时会被填充 0 至长度达到 16 的倍数
返回值 加密内容
|</PRE>}
function SM4DecryptEcbBytesFromHex(Key: TBytes; const Input: AnsiString): TBytes;
{* SM4-ECB 封装好的针对十六进制字符串解密成 TBytes 的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Input 十六进制密文，其解码后的长度如不是 16 倍数，计算时会被填充 0 至长度达到 16 的倍数
返回值 解密内容
|</PRE>}
function SM4EncryptCbcBytesToHex(Key, Iv: TBytes; const Input: TBytes): AnsiString;
{* SM4-CBC 封装好的针对 TBytes 的加密并转换成十六进制字符串的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCbcBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
{* SM4-CBC 封装好的针对十六进制字符串解密成 TBytes 的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 十六进制密文
返回值 解密内容
|</PRE>}
function SM4EncryptCfbBytesToHex(Key, Iv: TBytes; const Input: TBytes): AnsiString;
{* SM4-CFB 封装好的针对 TBytes 的加密并转换成十六进制字符串的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCfbBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
{* SM4-CFB 封装好的针对十六进制字符串解密成 TBytes 的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 十六进制密文
返回值 解密内容
|</PRE>}
function SM4EncryptOfbBytesToHex(Key, Iv: TBytes; const Input: TBytes): AnsiString;
{* SM4-OFB 封装好的针对 TBytes 的加密并转换成十六进制字符串的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptOfbBytesFromHex(Key, Iv: TBytes; const Input: AnsiString): TBytes;
{* SM4-OFB 封装好的针对十六进制字符串解密成 TBytes 的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Iv 16 字节初始化向量，太长则超出部分忽略，不足则在 Iv 后补 0
Input 十六进制密文
返回值 解密内容
|</PRE>}
function SM4EncryptCtrBytesToHex(Key, Nonce: TBytes; const Input: TBytes): AnsiString;
{* SM4-CTR 封装好的针对 TBytes 的加密并转换成十六进制字符串的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Nonce 8 字节初始化向量，太长则超出部分忽略，不足则在 Nonce 后补 0
Input 原始待加密内容
返回值 加密内容
|</PRE>}
function SM4DecryptCtrBytesFromHex(Key, Nonce: TBytes; const Input: AnsiString): TBytes;
{* SM4-CTR 封装好的针对十六进制字符串解密成 TBytes 的方法
|<PRE>
Key 16 字节密码，太长则截断，不足则补 0
Nonce 8 字节初始化向量，太长则超出部分忽略，不足则在 Nonce 后补 0
Input 十六进制密文
返回值 解密内容
|</PRE>}
// ======================= 明文流与密文流之间的加解密 ==========================
procedure SM4EncryptStreamECB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; Dest: TStream); overload;
{* SM4-ECB 流加密，Count 为 0 表示从头加密整个流，否则只加密 Stream 当前位置起 Count 的字节数}
procedure SM4DecryptStreamECB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; Dest: TStream); overload;
{* SM4-ECB 流解密，Count 为 0 表示从头解密整个流，否则只解密 Stream 当前位置起 Count 的字节数}
procedure SM4EncryptStreamCBC(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-CBC 流加密，Count 为 0 表示从头加密整个流，否则只加密 Stream 当前位置起 Count 的字节数}
procedure SM4DecryptStreamCBC(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-CBC 流解密，Count 为 0 表示从头解密整个流，否则只解密 Stream 当前位置起 Count 的字节数}
procedure SM4EncryptStreamCFB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-CFB 流加密，Count 为 0 表示从头加密整个流，否则只加密 Stream 当前位置起 Count 的字节数}
procedure SM4DecryptStreamCFB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-CFB 流解密，Count 为 0 表示从头解密整个流，否则只解密 Stream 当前位置起 Count 的字节数}
procedure SM4EncryptStreamOFB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-OFB 流加密，Count 为 0 表示从头加密整个流，否则只加密 Stream 当前位置起 Count 的字节数}
procedure SM4DecryptStreamOFB(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Iv; Dest: TStream);
{* SM4-OFB 流解密，Count 为 0 表示从头解密整个流，否则只解密 Stream 当前位置起 Count 的字节数}
procedure SM4EncryptStreamCTR(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Nonce; Dest: TStream);
{* SM4-CTR 流加密，Count 为 0 表示从头加密整个流，否则只加密 Stream 当前位置起 Count 的字节数}
procedure SM4DecryptStreamCTR(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: TCnSM4Nonce; Dest: TStream);
{* SM4-CTR 流解密，Count 为 0 表示从头解密整个流，否则只解密 Stream 当前位置起 Count 的字节数}
// 以下仨函数为底层加密函数，开放出来供外部挨块加密使用
procedure SM4SetKeyEnc(var Ctx: TCnSM4Context; Key: PAnsiChar);
{* 将 16 字节 Key 塞进 Context 并设置为加密模式}
procedure SM4SetKeyDec(var Ctx: TCnSM4Context; Key: PAnsiChar);
{* 将 16 字节 Key 塞进 Context 并设置为解密模式}
procedure SM4OneRound(SK: PCardinal; Input: PAnsiChar; Output: PAnsiChar);
{* 加解密一个块，内容从 Input 至 Output，长度 16 字节，两者可以是同一个区域
SK是 TSM4Context 的 Sk，加还是解由其决定}
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);
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);
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;
begin
Result := (X and $FFFFFFFF) shl N;
end;
function ROTL(X: Cardinal; N: Integer): Cardinal;
begin
Result := SM4Shl(X, N) or (X shr (32 - N));
end;
procedure Swap(var A: Cardinal; var B: Cardinal);
var
T: Cardinal;
begin
T := A;
A := B;
B := T;
end;
function SM4SBox(Inch: Byte): Byte;
var
PTable: Pointer;
begin
PTable := @(SboxTable[0][0]);
Result := PByte(TCnNativeInt(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;
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(TCnNativeInt(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; Length: 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 Length > 0 do
begin
if Length >= CN_SM4_BLOCKSIZE then
begin
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(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], Length);
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(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(Length, CN_SM4_BLOCKSIZE);
end;
end
else if Mode = SM4_DECRYPT then
begin
while Length > 0 do
begin
if Length >= CN_SM4_BLOCKSIZE then
begin
SM4OneRound(@(Ctx.Sk[0]), Input, Output);
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(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], Length);
SM4OneRound(@(Ctx.Sk[0]), @(EndBuf[0]), Output);
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(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(Length, CN_SM4_BLOCKSIZE);
end;
end;
end;
procedure SM4CryptCfb(var Ctx: TCnSM4Context; Mode: Integer; Length: Integer;
Iv: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
var
I: Integer;
LocalIv: TCnSM4Iv;
begin
Move(Iv^, LocalIv[0], CN_SM4_BLOCKSIZE);
if Mode = SM4_ENCRYPT then
begin
while Length > 0 do
begin
if Length >= CN_SM4_BLOCKSIZE then
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // 先加密 Iv
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Input) + I))^
xor (PByte(TCnNativeInt(Output) + I))^; // 加密结果与明文异或作为输出密文
Move(Output[0], LocalIv[0], CN_SM4_BLOCKSIZE); // 密文取代 Iv 以备下一轮
end
else
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output);
for I := 0 to Length - 1 do // 只需异或剩余长度，无需处理完整的 16 字节
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Input) + I))^
xor (PByte(TCnNativeInt(Output) + I))^;
end;
Inc(Input, CN_SM4_BLOCKSIZE);
Inc(Output, CN_SM4_BLOCKSIZE);
Dec(Length, CN_SM4_BLOCKSIZE);
end;
end
else if Mode = SM4_DECRYPT then
begin
while Length > 0 do
begin
if Length >= CN_SM4_BLOCKSIZE then
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // 先加密 Iv
for I := 0 to CN_SM4_BLOCKSIZE - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Output) + I))^
xor (PByte(TCnNativeInt(Input) + I))^; // 加密结果与密文异或得到明文
Move(Input[0], LocalIv[0], CN_SM4_BLOCKSIZE); // 密文取代 Iv 再拿去下一轮加密
end
else
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output);
for I := 0 to Length - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Output) + I))^
xor (PByte(TCnNativeInt(Input) + I))^;
end;
Inc(Input, CN_SM4_BLOCKSIZE);
Inc(Output, CN_SM4_BLOCKSIZE);
Dec(Length, CN_SM4_BLOCKSIZE);
end;
end;
end;
procedure SM4CryptOfb(var Ctx: TCnSM4Context; Mode: Integer; Length: Integer;
Iv: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
var
I: Integer;
LocalIv: TCnSM4Iv;
begin
Move(Iv^, LocalIv[0], CN_SM4_BLOCKSIZE);
if Mode = SM4_ENCRYPT then
begin
while Length > 0 do
begin
if Length >= 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(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Input) + I))^
xor (PByte(TCnNativeInt(Output) + I))^;
end
else
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // 先加密 Iv
for I := 0 to Length - 1 do // 无需完整 16 字节
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Input) + I))^
xor (PByte(TCnNativeInt(Output) + I))^;
end;
Inc(Input, CN_SM4_BLOCKSIZE);
Inc(Output, CN_SM4_BLOCKSIZE);
Dec(Length, CN_SM4_BLOCKSIZE);
end;
end
else if Mode = SM4_DECRYPT then
begin
while Length > 0 do
begin
if Length >= 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(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Output) + I))^
xor (PByte(TCnNativeInt(Input) + I))^;
end
else
begin
SM4OneRound(@(Ctx.Sk[0]), @LocalIv[0], Output); // 先加密 Iv
for I := 0 to Length - 1 do
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Output) + I))^
xor (PByte(TCnNativeInt(Input) + I))^;
end;
Inc(Input, CN_SM4_BLOCKSIZE);
Inc(Output, CN_SM4_BLOCKSIZE);
Dec(Length, CN_SM4_BLOCKSIZE);
end;
end;
end;
// CTR 模式加密数据块。Output 长度可以和 Input 一样，不必向上取整
procedure SM4CryptCtr(var Ctx: TCnSM4Context; Mode: Integer; Length: Integer;
Nonce: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar);
var
I: Integer;
LocalIv: TCnSM4Iv;
Cnt, T: Int64;
begin
Cnt := 1;
// 不区分加解密
while Length > 0 do
begin
if Length >= 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(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(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 Length - 1 do // 无需完整 16 字节
(PByte(TCnNativeInt(Output) + I))^ := (PByte(TCnNativeInt(Input) + I))^
xor LocalIv[I];
end;
Inc(Input, CN_SM4_BLOCKSIZE);
Inc(Output, CN_SM4_BLOCKSIZE);
Dec(Length, 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 会自动忽略后面的部分
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;
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 会自动忽略后面的部分
Len := Length(Iv);
if Len < CN_SM4_BLOCKSIZE then // Iv 长度小于 16 字节补 0
begin
SetLength(Iv, CN_SM4_BLOCKSIZE);
for I := Len to CN_SM4_BLOCKSIZE - 1 do
Iv[I] := 0;
end;
if Mode = SM4_ENCRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0]));
SM4CryptCbc(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end
else if Mode = SM4_DECRYPT then
begin
SM4SetKeyDec(Ctx, @(Key[0]));
SM4CryptCbc(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end;
end;
function SM4CryptCfbBytes(Mode: Integer; Key, Iv: 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 会自动忽略后面的部分
Len := Length(Iv);
if Len < CN_SM4_BLOCKSIZE then // Iv 长度小于 16 字节补 0
begin
SetLength(Iv, CN_SM4_BLOCKSIZE);
for I := Len to CN_SM4_BLOCKSIZE - 1 do
Iv[I] := 0;
end;
if Mode = SM4_ENCRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0]));
SM4CryptCfb(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end
else if Mode = SM4_DECRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0])); // 注意 CFB 的解密也用的是加密！
SM4CryptCfb(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end;
end;
function SM4CryptOfbBytes(Mode: Integer; Key, Iv: 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 会自动忽略后面的部分
Len := Length(Iv);
if Len < CN_SM4_BLOCKSIZE then // Iv 长度小于 16 字节补 0
begin
SetLength(Iv, CN_SM4_BLOCKSIZE);
for I := Len to CN_SM4_BLOCKSIZE - 1 do
Iv[I] := 0;
end;
if Mode = SM4_ENCRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0]));
SM4CryptOfb(Ctx, SM4_ENCRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end
else if Mode = SM4_DECRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0])); // 注意 OFB 的解密也用的是加密！
SM4CryptOfb(Ctx, SM4_DECRYPT, Length(Input), @(Iv[0]), @(Input[0]), @(Result[0]));
end;
end;
function SM4CryptCtrBytes(Mode: Integer; Key, Nonce: 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);
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 会自动忽略后面的部分
Len := Length(Nonce);
if Len < CN_SM4_NONCESIZE then // Nonce 长度小于 16 字节补 0
begin
SetLength(Nonce, CN_SM4_NONCESIZE);
for I := Len to CN_SM4_NONCESIZE - 1 do
Nonce[I] := 0;
end;
if Mode = SM4_ENCRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0]));
SM4CryptCtr(Ctx, SM4_ENCRYPT, Length(Input), @(Nonce[0]), @(Input[0]), @(Result[0]));
end
else if Mode = SM4_DECRYPT then
begin
SM4SetKeyEnc(Ctx, @(Key[0])); // 注意 CTR 的解密也用的是加密！
SM4CryptCtr(Ctx, SM4_DECRYPT, Length(Input), @(Nonce[0]), @(Input[0]), @(Result[0]));
end;
end;
function SM4EncryptEcbBytes(Key: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptEcbBytes(SM4_ENCRYPT, Key, Input);
end;
function SM4DecryptEcbBytes(Key: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptEcbBytes(SM4_DECRYPT, Key, Input);
end;
function SM4EncryptCbcBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCbcBytes(SM4_ENCRYPT, Key, Iv, Input);
end;
function SM4DecryptCbcBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCbcBytes(SM4_DECRYPT, Key, Iv, Input);
end;
function SM4EncryptCfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCfbBytes(SM4_ENCRYPT, Key, Iv, Input);
end;
function SM4DecryptCfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCfbBytes(SM4_DECRYPT, Key, Iv, Input);
end;
function SM4EncryptOfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptOfbBytes(SM4_ENCRYPT, Key, Iv, Input);
end;
function SM4DecryptOfbBytes(Key, Iv: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptOfbBytes(SM4_DECRYPT, Key, Iv, Input);
end;
function SM4EncryptCtrBytes(Key, Nonce: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCtrBytes(SM4_ENCRYPT, Key, Nonce, Input);
end;
function SM4DecryptCtrBytes(Key, Nonce: TBytes; const Input: TBytes): TBytes;
begin
Result := SM4CryptCtrBytes(SM4_DECRYPT, Key, Nonce, Input);
end;
function SM4EncryptEcbBytesToHex(Key: TBytes; const 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; const 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; const 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; const 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; const 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 Exception.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 Exception.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); // 最后写入的只包括密文长度的部分，无需整个块
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); // 最后写入的只包括密文长度的部分，无需整个块
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); // 最后写入的只包括密文长度的部分，无需整个块
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(TempOut, Count); // 最后写入的只包括密文长度的部分，无需整个块
if Done < Count then
raise EStreamError.Create(SCnErrorSM4WriteError);
end;
end;
procedure SM4EncryptStreamCTR(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: 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(InitVector[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(InitVector[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); // 最后写入的只包括密文长度的部分，无需整个块
if Done < Count then
raise EStreamError.Create(SCnErrorSM4WriteError);
end;
end;
procedure SM4DecryptStreamCTR(Source: TStream; Count: Cardinal;
const Key: TCnSM4Key; const InitVector: 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(InitVector[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(InitVector[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); // 最后写入的只包括密文长度的部分，无需整个块
if Done < Count then
raise EStreamError.Create(SCnErrorSM4WriteError);
end;
end;
procedure SM4Encrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; Len: Integer);
var
Ctx: TCnSM4Context;
begin
SM4SetKeyEnc(Ctx, Key);
SM4CryptEcb(Ctx, SM4_ENCRYPT, Len, Input, Output);
end;
procedure SM4Decrypt(Key: PAnsiChar; Input: PAnsiChar; Output: PAnsiChar; Len: Integer);
var
Ctx: TCnSM4Context;
begin
SM4SetKeyDec(Ctx, Key);
SM4CryptEcb(Ctx, SM4_DECRYPT, Len, Input, Output);
end;
end.
{******************************************************************************}
{ CnPack For Delphi/C++Builder }
{ 中国人自己的开放源码第三方开发包 }
{ (C)Copyright 2001-2024 CnPack 开发组 }
{ ------------------------------------ }
{ 本开发包是开源的自由软件，您可以遵照 CnPack 的发布协议来修 }
{ 改和重新发布这一程序。 }
{ 发布这一开发包的目的是希望它有用，但没有任何担保。甚至没有 }
{ 适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。 }
{ 您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果 }
{ 还没有，可访问我们的网站： }
{ 网站地址：http://www.cnpack.org }
{ 电子邮件：master@cnpack.org }
{******************************************************************************}
unit CnNative;
{* |<PRE>
================================================================================
* 软件名称：CnPack 组件包
* 单元名称：32 位和 64 位的一些统一声明以及一堆基础实现
* 单元作者：刘啸 (liuxiao@cnpack.org)
* 备 注：Delphi XE 2 支持 32 和 64 以来，开放出的 NativeInt 和 NativeUInt 随
* 当前是 32 位还是 64 而动态变化，影响到的是 Pointer、Reference等东西。
* 考虑到兼容性，固定长度的 32 位 Cardinal/Integer 等和 Pointer 这些就
* 不能再通用了，即使 32 位下也被编译器禁止。因此本单元声明了几个类型，
* 供同时在低版本和高版本的 Delphi 中使用。
* 后来加入 UInt64 的包装，注意 D567 下不直接支持 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
* 创建单元，实现功能
================================================================================
|</PRE>}
interface
{.$I CnPack.inc}
uses
Classes, SysUtils, SysConst, Math {$IFDEF COMPILER5}, Windows {$ENDIF};
// D5 下需要引用 Windows 中的 PByte
type
{$IFDEF COMPILER5}
PCardinal = ^Cardinal;
{* D5 下 System 单元中未定义，定义上}
PByte = Windows.PByte;
{* D5 下 PByte 定义在 Windows 中，其他版本定义在 System 中，
这里统一一下供外界使用 PByte 时无需 uses Windows，以有利于跨平台}
{$ENDIF}
{$DEFine SUPPORT_UINT64}
{$IFDEF SUPPORT_32_AND_64}
TCnNativeInt = NativeInt;
TCnNativeUInt = NativeUInt;
TCnNativePointer = NativeInt;
TCnNativeIntPtr = PNativeInt;
TCnNativeUIntPtr = PNativeUInt;
{$ELSE}
TCnNativeInt = integer;
TCnNativeUInt = cardinal;
TCnNativePointer = integer;
TCnNativeIntPtr = PInteger;
TCnNativeUIntPtr = PCardinal;
{$ENDIF}
{$IFDEF CPU64BITS}
TCnUInt64 = NativeUInt;
TCnInt64 = NativeInt;
{$ELSE}
{$IFDEF SUPPORT_UINT64}
TCnUInt64 = UInt64;
{$ELSE}
TCnUInt64 = packed record // 只能用这样的结构代替
case boolean of
True: (Value: int64);
False: (Lo32, Hi32: cardinal);
end;
{$ENDIF}
TCnInt64 = int64;
{$ENDIF}
// TUInt64 用于 cnvcl 库中不支持 UInt64 的运算如 div mod 等
{$IFDEF SUPPORT_UINT64}
TUInt64 = UInt64;
{$IFNDEF SUPPORT_PUINT64}
PUInt64 = ^UInt64;
{$ENDIF}
{$ELSE}
TUInt64 = int64;
PUInt64 = ^TUInt64;
{$ENDIF}
{$IFNDEF SUPPORT_INT64ARRAY}
// 如果系统没有定义 Int64Array
Int64Array = array[0..$0FFFFFFE] of int64;
PInt64Array = ^Int64Array;
{$ENDIF}
TUInt64Array = array of TUInt64;
// 这个动态数组声明似乎容易和静态数组声明有冲突
ExtendedArray = array[0..65537] of extended;
PExtendedArray = ^ExtendedArray;
PCnWord16Array = ^TCnWord16Array;
TCnWord16Array = array [0..0] of word;
{$IFDEF POSIX64}
TCnLongWord32 = Cardinal; // Linux64/MacOS64 (or POSIX64?) LongWord is 64 Bits
{$ELSE}
TCnLongWord32 = longword;
{$ENDIF}
PCnLongWord32 = ^TCnLongWord32;
TCnLongWord32Array = array [0..MaxInt div SizeOf(integer) - 1] of TCnLongWord32;
PCnLongWord32Array = ^TCnLongWord32Array;
{$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;
{* 无符号四字节动态数组}
PCnByte = ^byte;
PCnWord = ^word;
TCnBitOperation = (boAnd, boOr, boXor, boNot);
{* 位操作类型}
type
TCnMemSortCompareProc = function(p1, p2: Pointer; ElementByteSize: integer): integer;
{* 内存固定块尺寸的数组排序比较函数原型}
const
CN_MAX_SQRT_INT64: cardinal = 3037000499;
CN_MAX_INT64: int64 = $7FFFFFFFFFFFFFFF;
CN_MIN_INT64: int64 = $8000000000000000;
CN_MAX_UINT16: word = $FFFF;
CN_MAX_UINT32: cardinal = $FFFFFFFF;
CN_MAX_TUINT64: TUInt64 = $FFFFFFFFFFFFFFFF;
CN_MAX_SIGNED_INT64_IN_TUINT64: TUInt64 = $7FFFFFFFFFFFFFFF;
{*
对于 D567 等不支持 UInt64 的编译器，虽然可以用 Int64 代替 UInt64 进行加减、存储
但乘除运算则无法直接完成，这里封装了两个调用 System 库中的 _lludiv 与 _llumod
函数，实现以 Int64 表示的 UInt64 数据的 div 与 mod 功能。
}
function UInt64Mod(a, b: TUInt64): TUInt64;
{* 两个 UInt64 求余}
function UInt64Div(a, b: TUInt64): TUInt64;
{* 两个 UInt64 整除}
function UInt64Mul(a, b: cardinal): TUInt64;
{* 无符号 32 位整数不溢出的相乘，在不支持 UInt64 的平台上，结果以 UInt64 的形式放在 Int64 里，
如果结果直接使用 Int64 计算则有可能溢出}
procedure UInt64AddUInt64(a, b: TUInt64; var ResLo, ResHi: TUInt64);
{* 两个无符号 64 位整数相加，处理溢出的情况，结果放 ResLo 与 ResHi 中
注：内部实现按算法来看较为复杂，实际上如果溢出，ResHi 必然是 1，直接判断溢出并将其设 1 即可}
procedure UInt64MulUInt64(a, b: TUInt64; var ResLo, ResHi: TUInt64);
{* 两个无符号 64 位整数相乘，结果放 ResLo 与 ResHi 中，64 位下用汇编实现，提速约一倍以上}
function UInt64ToHex(N: TUInt64): string;
{* 将 UInt64 转换为十六进制字符串}
function UInt64ToStr(N: TUInt64): string;
{* 将 UInt64 转换为字符串}
function StrToUInt64(const S: string): TUInt64;
{* 将字符串转换为 UInt64}
function UInt64Compare(a, b: TUInt64): integer;
{* 比较两个 UInt64 值，分别根据 > = < 返回 1、0、-1}
function UInt64Sqrt(N: TUInt64): TUInt64;
{* 求 UInt64 的平方根的整数部分}
function UInt32IsNegative(N: cardinal): boolean;
{* 该 Cardinal 被当成 Integer 时是否小于 0}
function UInt64IsNegative(N: TUInt64): boolean;
{* 该 UInt64 被当成 Int64 时是否小于 0}
procedure UInt64SetBit(var b: TUInt64; Index: integer);
{* 给 UInt64 的某一位置 1，位 Index 从 0 开始}
procedure UInt64ClearBit(var b: TUInt64; Index: integer);
{* 给 UInt64 的某一位置 0，位 Index 从 0 开始}
function GetUInt64BitSet(b: TUInt64; Index: integer): boolean;
{* 返回 UInt64 的某一位是否是 1，位 Index 从 0 开始}
function GetUInt64HighBits(b: TUInt64): integer;
{* 返回 UInt64 的是 1 的最高二进制位是第几位，最低位是 0，如果没有 1，返回 -1}
function GetUInt32HighBits(b: cardinal): integer;
{* 返回 Cardinal 的是 1 的最高二进制位是第几位，最低位是 0，如果没有 1，返回 -1}
function GetUInt16HighBits(b: word): integer;
{* 返回 Word 的是 1 的最高二进制位是第几位，最低位是 0，如果没有 1，返回 -1}
function GetUInt8HighBits(b: byte): integer;
{* 返回 Byte 的是 1 的最高二进制位是第几位，最低位是 0，如果没有 1，返回 -1}
function GetUInt64LowBits(b: TUInt64): integer;
{* 返回 Int64 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1}
function GetUInt32LowBits(b: cardinal): integer;
{* 返回 Cardinal 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1}
function GetUInt16LowBits(b: word): integer;
{* 返回 Word 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1}
function GetUInt8LowBits(b: byte): integer;
{* 返回 Byte 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1}
function Int64Mod(M, N: int64): int64;
{* 封装的 Int64 Mod，M 碰到负值时取反求模再模减，但 N 仍要求正数否则结果不靠谱}
function IsUInt32PowerOf2(N: cardinal): boolean;
{* 判断一 32 位无符号整数是否 2 的整数次幂}
function IsUInt64PowerOf2(N: TUInt64): boolean;
{* 判断一 64 位无符号整数是否 2 的整数次幂}
function GetUInt32PowerOf2GreaterEqual(N: cardinal): cardinal;
{* 得到一比指定 32 位无符号整数数大或等的 2 的整数次幂，如溢出则返回 0}
function GetUInt64PowerOf2GreaterEqual(N: TUInt64): TUInt64;
{* 得到一比指定 64 位无符号整数数大或等的 2 的整数次幂，如溢出则返回 0}
function IsInt32AddOverflow(a, b: integer): boolean;
{* 判断两个 32 位有符号数相加是否溢出 32 位有符号上限}
function IsUInt32AddOverflow(a, b: cardinal): boolean;
{* 判断两个 32 位无符号数相加是否溢出 32 位无符号上限}
function IsInt64AddOverflow(a, b: int64): boolean;
{* 判断两个 64 位有符号数相加是否溢出 64 位有符号上限}
function IsUInt64AddOverflow(a, b: TUInt64): boolean;
{* 判断两个 64 位无符号数相加是否溢出 64 位无符号上限}
procedure UInt64Add(var r: TUInt64; a, b: TUInt64; out Carry: integer);
{* 两个 64 位无符号数相加，A + B => R，如果有溢出，则溢出的 1 搁进位标记里，否则清零}
procedure UInt64Sub(var r: TUInt64; a, b: TUInt64; out Carry: integer);
{* 两个 64 位无符号数相减，A - B => R，如果不够减有借位，则借的 1 搁借位标记里，否则清零}
function IsInt32MulOverflow(a, b: integer): boolean;
{* 判断两个 32 位有符号数相乘是否溢出 32 位有符号上限}
function IsUInt32MulOverflow(a, b: cardinal): boolean;
{* 判断两个 32 位无符号数相乘是否溢出 32 位无符号上限}
function IsUInt32MulOverflowInt64(a, b: cardinal; out r: TUInt64): boolean;
{* 判断两个 32 位无符号数相乘是否溢出 64 位有符号数，如未溢出也即返回 False 时，R 中直接返回结果
如溢出也即返回 True，外界需要重新调用 UInt64Mul 才能实施相乘}
function IsInt64MulOverflow(a, b: int64): boolean;
{* 判断两个 64 位有符号数相乘是否溢出 64 位有符号上限}
function PointerToInteger(P: Pointer): integer;
{* 指针类型转换成整型，支持 32/64 位，注意 64 位下可能会丢超出 32 位的内容}
function IntegerToPointer(i: integer): Pointer;
{* 整型转换成指针类型，支持 32/64 位}
function Int64NonNegativeAddMod(a, b, N: int64): int64;
{* 求 Int64 范围内俩加数的和求余，处理溢出的情况，要求 N 大于 0}
function UInt64NonNegativeAddMod(a, b, N: TUInt64): TUInt64;
{* 求 UInt64 范围内俩加数的和求余，处理溢出的情况，要求 N 大于 0}
function Int64NonNegativeMulMod(a, b, N: int64): int64;
{* Int64 范围内的相乘求余，不能直接计算，容易溢出。要求 N 大于 0}
function UInt64NonNegativeMulMod(a, b, N: TUInt64): TUInt64;
{* UInt64 范围内的相乘求余，不能直接计算，容易溢出。}
function Int64NonNegativeMod(N: int64; P: int64): int64;
{* 封装的 Int64 非负求余函数，也就是余数为负时，加个除数变正，调用者需保证 P 大于 0}
function Int64NonNegativPower(N: int64; Exp: integer): int64;
{* Int64 的非负整数指数幂，不考虑溢出的情况}
function Int64NonNegativeRoot(N: int64; Exp: integer): int64;
{* 求 Int64 的非负整数次方根的整数部分，不考虑溢出的情况}
function UInt64NonNegativPower(N: TUInt64; Exp: integer): TUInt64;
{* UInt64 的非负整数指数幂，不考虑溢出的情况}
function UInt64NonNegativeRoot(N: TUInt64; Exp: integer): TUInt64;
{* 求 UInt64 的非负整数次方根的整数部分，不考虑溢出的情况}
function CurrentByteOrderIsBigEndian: boolean;
{* 返回当前运行期环境是否是大端，也就是是否将整数中的高序字节存储在较低的起始地址，符合从左到右的阅读习惯，如部分指定的 ARM 和 MIPS}
function CurrentByteOrderIsLittleEndian: boolean;
{* 返回当前运行期环境是否是小端，也就是是否将整数中的高序字节存储在较高的起始地址，如 x86 与部分默认 arm}
function Int64ToBigEndian(Value: int64): int64;
{* 确保 Int64 值为大端，在小端环境中会进行转换}
function Int32ToBigEndian(Value: integer): integer;
{* 确保 Int32 值为大端，在小端环境中会进行转换}
function Int16ToBigEndian(Value: smallint): smallint;
{* 确保 Int16 值为大端，在小端环境中会进行转换}
function Int64ToLittleEndian(Value: int64): int64;
{* 确保 Int64 值为小端，在大端环境中会进行转换}
function Int32ToLittleEndian(Value: integer): integer;
{* 确保 Int32 值为小端，在大端环境中会进行转换}
function Int16ToLittleEndian(Value: smallint): smallint;
{* 确保 Int16 值为小端，在大端环境中会进行转换}
function UInt64ToBigEndian(Value: TUInt64): TUInt64;
{* 确保 UInt64 值为大端，在小端环境中会进行转换}
function UInt32ToBigEndian(Value: cardinal): cardinal;
{* 确保 UInt32 值为大端，在小端环境中会进行转换}
function UInt16ToBigEndian(Value: word): word;
{* 确保 UInt16 值为大端，在小端环境中会进行转换}
function UInt64ToLittleEndian(Value: TUInt64): TUInt64;
{* 确保 UInt64 值为小端，在大端环境中会进行转换}
function UInt32ToLittleEndian(Value: cardinal): cardinal;
{* 确保 UInt32 值为小端，在大端环境中会进行转换}
function UInt16ToLittleEndian(Value: word): word;
{* 确保 UInt16 值为小端，在大端环境中会进行转换}
function Int64HostToNetwork(Value: int64): int64;
{* 将 Int64 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function Int32HostToNetwork(Value: integer): integer;
{* 将 Int32 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function Int16HostToNetwork(Value: smallint): smallint;
{* 将 Int16 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function Int64NetworkToHost(Value: int64): int64;
{* 将 Int64 值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
function Int32NetworkToHost(Value: integer): integer;
{* 将 Int32值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
function Int16NetworkToHost(Value: smallint): smallint;
{* 将 Int16 值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
function UInt64HostToNetwork(Value: TUInt64): TUInt64;
{* 将 UInt64 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function UInt32HostToNetwork(Value: cardinal): cardinal;
{* 将 UInt32 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function UInt16HostToNetwork(Value: word): word;
{* 将 UInt16 值从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换}
function UInt64NetworkToHost(Value: TUInt64): TUInt64;
{* 将 UInt64 值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
function UInt32NetworkToHost(Value: cardinal): cardinal;
{* 将 UInt32值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
function UInt16NetworkToHost(Value: word): word;
{* 将 UInt16 值从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换}
procedure MemoryNetworkToHost(AMem: Pointer; MemByteLen: integer);
{* 将一片内存区域从网络字节顺序转换为主机字节顺序，在小端环境中会进行转换，
该方法应用场合较少，大多二/四/八字节转换已经足够}
procedure MemoryHostToNetwork(AMem: Pointer; MemByteLen: integer);
{* 将一片内存区域从主机字节顺序转换为网络字节顺序，在小端环境中会进行转换，
该方法应用场合较少，大多二/四/八字节转换已经足够}
procedure ReverseMemory(AMem: Pointer; MemByteLen: integer);
{* 按字节顺序倒置一块内存块，字节内部不变}
function ReverseBitsInInt8(V: byte): byte;
{* 倒置一字节内部的位的内容}
function ReverseBitsInInt16(V: word): word;
{* 倒置二字节及其内部位的内容}
function ReverseBitsInInt32(V: cardinal): cardinal;
{* 倒置四字节及其内部位的内容}
function ReverseBitsInInt64(V: int64): int64;
{* 倒置八字节及其内部位的内容}
procedure ReverseMemoryWithBits(AMem: Pointer; MemByteLen: integer);
{* 按字节顺序倒置一块内存块，并且每个字节也倒过来}
procedure MemoryAnd(AMem, BMem: Pointer; MemByteLen: integer; ResMem: Pointer);
{* 两块长度相同的内存 AMem 和 BMem 按位与，结果放 ResMem 中，三者可相同}
procedure MemoryOr(AMem, BMem: Pointer; MemByteLen: integer; ResMem: Pointer);
{* 两块长度相同的内存 AMem 和 BMem 按位或，结果放 ResMem 中，三者可相同}
procedure MemoryXor(AMem, BMem: Pointer; MemByteLen: integer; ResMem: Pointer);
{* 两块长度相同的内存 AMem 和 BMem 按位异或，结果放 ResMem 中，三者可相同}
procedure MemoryNot(AMem: Pointer; MemByteLen: integer; ResMem: Pointer);
{* 一块内存 AMem 取反，结果放 ResMem 中，两者可相同}
procedure MemoryShiftLeft(AMem, BMem: Pointer; MemByteLen: integer; BitCount: integer);
{* AMem 整块内存左移 BitCount 位至 BMem，往内存地址低位移，空位补 0，两者可相等}
procedure MemoryShiftRight(AMem, BMem: Pointer; MemByteLen: integer; BitCount: integer);
{* AMem 整块内存右移 BitCount 位至 BMem，往内存地址高位移，空位补 0，两者可相等}
function MemoryIsBitSet(AMem: Pointer; N: integer): boolean;
{* 返回内存块某 Bit 位是否置 1，内存地址低位是 0，字节内还是右边为 0}
procedure MemorySetBit(AMem: Pointer; N: integer);
{* 给内存块某 Bit 位置 1，内存地址低位是 0，字节内还是右边为 0}
procedure MemoryClearBit(AMem: Pointer; N: integer);
{* 给内存块某 Bit 位置 0，内存地址低位是 0，字节内还是右边为 0}
function MemoryToBinStr(AMem: Pointer; MemByteLen: integer;
Sep: boolean = False): string;
{* 将一块内存内容从低到高字节顺序输出为二进制字符串，Sep 表示是否空格分隔}
procedure MemorySwap(AMem, BMem: Pointer; MemByteLen: integer);
{* 交换两块相同长度的内存块的内容，如两者是相同的内存块则什么都不做}
function MemoryCompare(AMem, BMem: Pointer; MemByteLen: integer): integer;
{* 以无符号数的方式比较两块内存，返回 1、0、-1，如两者是相同的内存块则直接返回 0}
procedure MemoryQuickSort(Mem: Pointer; ElementByteSize: integer;
ElementCount: integer; CompareProc: TCnMemSortCompareProc = nil);
{* 针对固定大小的元素的数组进行排序}
function UInt8ToBinStr(V: byte): string;
{* 将一无符号字节转换为二进制字符串}
function UInt16ToBinStr(V: word): string;
{* 将一无符号字转换为二进制字符串}
function UInt32ToBinStr(V: cardinal): string;
{* 将一四字节无符号整数转换为二进制字符串}
function UInt32ToStr(V: cardinal): string;
{* 将一四字节无符号整数转换为字符串}
function UInt64ToBinStr(V: TUInt64): string;
{* 将一无符号 64 字节整数转换为二进制字符串}
function HexToInt(const Hex: string): integer; overload;
{* 将一十六进制字符串转换为整型，适合较短尤其是 2 字符的字符串}
function HexToInt(Hex: PChar; CharLen: integer): integer; overload;
{* 将一十六进制字符串指针所指的内容转换为整型，适合较短尤其是 2 字符的字符串}
function IsHexString(const Hex: string): boolean;
{* 判断一字符串是否合法的十六进制字符串，不区分大小写}
function DataToHex(InData: Pointer; ByteLength: integer;
UseUpperCase: boolean = True): string;
{* 内存块转换为十六进制字符串，内存低位的内容出现在字符串左方，相当于网络字节顺序，
UseUpperCase 控制输出内容的大小写}
function HexToData(const Hex: string; OutData: Pointer = nil): integer;
{* 十六进制字符串转换为内存块，字符串左方的内容出现在内存低位，相当于网络字节顺序，
十六进制字符串长度为奇或转换失败时抛出异常。返回转换成功的字节数
注意 OutData 应该指向足够容纳转换内容的区域，长度至少为 Length(Hex) div 2
如果传 nil，则只返回所需的字节长度，不进行正式转换}
function StringToHex(const Data: string; UseUpperCase: boolean = True): string;
{* 字符串转换为十六进制字符串，UseUpperCase 控制输出内容的大小写}
function HexToString(const Hex: string): string;
{* 十六进制字符串转换为字符串，十六进制字符串长度为奇或转换失败时抛出异常}
function HexToAnsiStr(const Hex: ansistring): ansistring;
{* 十六进制字符串转换为字符串，十六进制字符串长度为奇或转换失败时抛出异常}
function AnsiStrToHex(const Data: ansistring; UseUpperCase: boolean = True): ansistring;
{* AnsiString 转换为十六进制字符串，UseUpperCase 控制输出内容的大小写}
function BytesToHex(Data: TBytes; UseUpperCase: boolean = True): string;
{* 字节数组转换为十六进制字符串，下标低位的内容出现在字符串左方，相当于网络字节顺序，
UseUpperCase 控制输出内容的大小写}
function HexToBytes(const Hex: string): TBytes;
{* 十六进制字符串转换为字节数组，字符串左边的内容出现在下标低位，相当于网络字节顺序，
字符串长度为奇或转换失败时抛出异常}
function StreamToHex(Stream: TStream; UseUpperCase: boolean = True): string;
{* 将流中的全部内容从头转换为十六进制字符串}
function HexToStream(const Hex: string; Stream: TStream): integer;
{* 将十六进制字符串内容转换后写入流中，返回写入的字节数}
procedure ReverseBytes(Data: TBytes);
{* 按字节顺序倒置一字节数组}
function StreamToBytes(Stream: TStream): TBytes;
{* 从流从头读入全部内容至字节数组，返回创建的字节数组}
function BytesToStream(Data: TBytes; OutStream: TStream): integer;
{* 字节数组写入整个流，返回写入字节数}
function AnsiToBytes(const str: ansistring): TBytes;
{* 将 AnsiString 的内容转换为字节数组，不处理编码}
function BytesToAnsi(const Data: TBytes): ansistring;
{* 将字节数组的内容转换为 AnsiString，不处理编码}
function BytesToString(const Data: TBytes): string;
{* 将字节数组的内容转换为 string，内部逐个赋值，不处理编码}
function MemoryToString(Mem: Pointer; MemByteLen: integer): string;
{* 将内存块的内容转换为 string，内部逐个赋值，不处理编码}
function ConcatBytes(a, b: TBytes): TBytes;
{* 将 A B 两个字节数组顺序拼好返回一个新字节数组，A B 保持不变}
function NewBytesFromMemory(Data: Pointer; DataByteLen: integer): TBytes;
{* 新建一字节数组，并从一片内存区域复制内容过来。}
function CompareBytes(a, b: TBytes): boolean;
{* 比较两个字节数组内容是否相同}
procedure MoveMost(const Source; var Dest; ByteLen, MostLen: integer);
{* 从 Source 移动 ByteLen 且不超过 MostLen 个字节到 Dest 中，
如 ByteLen 小于 MostLen，则 Dest 填充 0，要求 Dest 容纳至少 MostLen}
// ================ 以下是执行时间固定的无 if 判断的部分逻辑函数 ===============
procedure ConstTimeConditionalSwap8(CanSwap: boolean; var a, b: byte);
{* 针对两个字节变量的执行时间固定的条件交换，CanSwap 为 True 时才实施 A B 交换}
procedure ConstTimeConditionalSwap16(CanSwap: boolean; var a, b: word);
{* 针对两个双字节变量的执行时间固定的条件交换，CanSwap 为 True 时才实施 A B 交换}
procedure ConstTimeConditionalSwap32(CanSwap: boolean; var a, b: cardinal);
{* 针对两个四字节变量的执行时间固定的条件交换，CanSwap 为 True 时才实施 A B 交换}
procedure ConstTimeConditionalSwap64(CanSwap: boolean; var a, b: TUInt64);
{* 针对两个八字节变量的执行时间固定的条件交换，CanSwap 为 True 时才实施 A B 交换}
function ConstTimeEqual8(a, b: byte): boolean;
{* 针对俩单字节的执行时间固定的比较，避免 CPU 指令跳转预测导致的执行时间差异，内容相同时返回 True}
function ConstTimeEqual16(a, b: word): boolean;
{* 针对俩双字节的执行时间固定的比较，避免 CPU 指令跳转预测导致的执行时间差异，内容相同时返回 True}
function ConstTimeEqual32(a, b: cardinal): boolean;
{* 针对俩四字节的执行时间固定的比较，避免 CPU 指令跳转预测导致的执行时间差异，内容相同时返回 True}
function ConstTimeEqual64(a, b: TUInt64): boolean;
{* 针对俩八字节的执行时间固定的比较，避免 CPU 指令跳转预测导致的执行时间差异，内容相同时返回 True}
function ConstTimeBytesEqual(a, b: TBytes): boolean;
{* 针对俩相同长度的字节数组的执行时间固定的比较，内容相同时返回 True}
function ConstTimeExpandBoolean8(V: boolean): byte;
{* 根据 V 的值返回一字节全 1 或全 0}
function ConstTimeExpandBoolean16(V: boolean): word;
{* 根据 V 的值返回俩字节全 1 或全 0}
function ConstTimeExpandBoolean32(V: boolean): cardinal;
{* 根据 V 的值返回四字节全 1 或全 0}
function ConstTimeExpandBoolean64(V: boolean): TUInt64;
{* 根据 V 的值返回八字节全 1 或全 0}
function ConstTimeConditionalSelect8(Condition: boolean; a, b: byte): byte;
{* 针对两个字节变量执行时间固定的判断选择，Condtion 为 True 时返回 A，否则返回 B}
function ConstTimeConditionalSelect16(Condition: boolean; a, b: word): word;
{* 针对两个双字节变量执行时间固定的判断选择，Condtion 为 True 时返回 A，否则返回 B}
function ConstTimeConditionalSelect32(Condition: boolean; a, b: cardinal): cardinal;
{* 针对两个四字节变量执行时间固定的判断选择，Condtion 为 True 时返回 A，否则返回 B}
function ConstTimeConditionalSelect64(Condition: boolean; a, b: TUInt64): TUInt64;
{* 针对两个八字节变量执行时间固定的判断选择，Condtion 为 True 时返回 A，否则返回 B}
// ================ 以上是执行时间固定的无 if 判断的部分逻辑函数 ===============
{$IFDEF MSWINDOWS}
// 这四个函数因为用了 Intel 汇编，因而只支持 32 位和 64 位的 Intel CPU，照理应该用条件：CPUX86 或 CPUX64
procedure Int64DivInt32Mod(a: int64; b: integer; var DivRes, ModRes: integer);
{* 64 位有符号数除以 32 位有符号数，商放 DivRes，余数放 ModRes
调用者须自行保证商在 32 位范围内，否则会抛溢出异常}
procedure UInt64DivUInt32Mod(a: TUInt64; b: cardinal; var DivRes, ModRes: cardinal);
{* 64 位无符号数除以 32 位无符号数，商放 DivRes，余数放 ModRes
调用者须自行保证商在 32 位范围内，否则会抛溢出异常}
procedure Int128DivInt64Mod(ALo, AHi: int64; b: int64; var DivRes, ModRes: int64);
{* 128 位有符号数除以 64 位有符号数，商放 DivRes，余数放 ModRes
调用者须自行保证商在 64 位范围内，否则会抛溢出异常}
procedure UInt128DivUInt64Mod(ALo, AHi: TUInt64; b: TUInt64;
var DivRes, ModRes: TUInt64);
{* 128 位无符号数除以 64 位无符号数，商放 DivRes，余数放 ModRes
调用者须自行保证商在 64 位范围内，否则会抛溢出异常}
{$ENDIF}
function IsUInt128BitSet(Lo, Hi: TUInt64; N: integer): boolean;
{* 针对两个 Int64 拼成的 128 位数字，返回第 N 位是否为 1，N 从 0 到 127}
procedure SetUInt128Bit(var Lo, Hi: TUInt64; N: integer);
{* 针对两个 Int64 拼成的 128 位数字，设置第 N 位为 1，N 从 0 到 127}
procedure ClearUInt128Bit(var Lo, Hi: TUInt64; N: integer);
{* 针对两个 Int64 拼成的 128 位数字，清掉第 N 位，N 从 0 到 127}
function UnsignedAddWithLimitRadix(a, b, c: cardinal; var r: cardinal;
L, H: cardinal): cardinal;
{* 计算非正常进制的无符号加法，A + B + C，结果放 R 中，返回进位值
结果确保在 L 和 H 的闭区间内，用户须确保 H 大于 L，不考虑溢出的情形
该函数多用于字符分区间计算与映射，其中 C 一般是进位}
{$IFDEF COMPILER5}
function BoolToStr(Value: Boolean; UseBoolStrs: Boolean = False): string;
{* Delphi 5 下没有该函数，补上}
{$ENDIF}
implementation
uses
CnFloat;
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(AMem: Pointer; MemByteLen: integer);
var
i, L: integer;
P: PByteArray;
T: byte;
begin
if (AMem = nil) or (MemByteLen < 2) then
Exit;
L := MemByteLen div 2;
P := PByteArray(AMem);
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(AMem: Pointer; MemByteLen: integer);
var
i: integer;
P: PByteArray;
begin
if (AMem = nil) or (MemByteLen <= 0) then
Exit;
ReverseMemory(AMem, MemByteLen);
P := PByteArray(AMem);
for i := 0 to MemByteLen - 1 do
P^[i] := ReverseBitsInInt8(P^[i]);
end;
procedure MemoryNetworkToHost(AMem: Pointer; MemByteLen: integer);
begin
if not FByteOrderIsBigEndian then
ReverseMemory(AMem, MemByteLen);
end;
procedure MemoryHostToNetwork(AMem: Pointer; MemByteLen: integer);
begin
if not FByteOrderIsBigEndian then
ReverseMemory(AMem, 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(TCnNativeInt(a) + SizeOf(cardinal));
b := PCnLongWord32Array(TCnNativeInt(b) + SizeOf(cardinal));
r := PCnLongWord32Array(TCnNativeInt(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(TCnNativeInt(BA) + SizeOf(byte));
BB := PByteArray(TCnNativeInt(BB) + SizeOf(byte));
BR := PByteArray(TCnNativeInt(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(AMem: Pointer; MemByteLen: integer; ResMem: Pointer);
begin
MemoryBitOperation(AMem, 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(TCnNativeInt(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(TCnNativeInt(PF) + 1);
PT := PByteArray(TCnNativeInt(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(TCnNativeInt(AMem) + L - 1);
PT := PByteArray(TCnNativeInt(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(TCnNativeInt(PF) - 1);
PT^[0] := (PF^[0] shl LB) or PT^[0];
end
else
PF := PByteArray(TCnNativeInt(PF) - 1);
PT := PByteArray(TCnNativeInt(PT) - 1);
end;
// 剩下的最前面的要填 0
if N > 0 then
FillChar(BMem^, N, 0);
end;
end;
function MemoryIsBitSet(AMem: Pointer; N: integer): boolean;
var
P: pbyte;
a, b: integer;
V: byte;
begin
if (AMem = nil) or (N < 0) then
raise Exception.Create(SRangeError);
a := N div 8;
b := N mod 8;
P := pbyte(TCnNativeInt(AMem) + a);
V := byte(1 shl b);
Result := (P^ and V) <> 0;
end;
procedure MemorySetBit(AMem: Pointer; N: integer);
var
P: pbyte;
a, b: integer;
V: byte;
begin
if (AMem = nil) or (N < 0) then
raise Exception.Create(SRangeError);
a := N div 8;
b := N mod 8;
P := pbyte(TCnNativeInt(AMem) + a);
V := byte(1 shl b);
P^ := P^ or V;
end;
procedure MemoryClearBit(AMem: Pointer; N: integer);
var
P: pbyte;
a, b: integer;
V: byte;
begin
if (AMem = nil) or (N < 0) then
raise Exception.Create(SRangeError);
a := N div 8;
b := N mod 8;
P := pbyte(TCnNativeInt(AMem) + a);
V := not byte(1 shl b);
P^ := P^ and V;
end;
function MemoryToBinStr(AMem: 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 (AMem = 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(AMem);
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(TCnNativeInt(a) + SizeOf(cardinal));
b := PCnLongWord32Array(TCnNativeInt(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(TCnNativeInt(BA) + SizeOf(byte));
BB := PByteArray(TCnNativeInt(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(TCnNativeInt(a) + SizeOf(cardinal));
b := PCnLongWord32Array(TCnNativeInt(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(TCnNativeInt(BA) + SizeOf(byte));
BB := PByteArray(TCnNativeInt(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 Exception.Createfmt('Error: not a Hex PChar: %c', [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(TCnNativeInt(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(TCnNativeInt(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 Exception.Createfmt('Error Length %d: not a Hex String', [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(TCnNativeInt(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(TCnNativeInt(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(TCnNativeInt(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 Exception.Createfmt('Error Length %d: not a Hex String', [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 Exception.Createfmt('Error Length %d: not a Hex AnsiString', [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(TCnNativeInt(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(TCnNativeInt(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(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(TCnNativeInt(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(TCnNativeInt(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 Exception.Createfmt('Error Length %d: not a Hex String', [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 Exception.Createfmt('Error Length %d: not a Hex String', [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;
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 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(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 ConcatBytes(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 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;
function CompareBytes(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;
procedure MoveMost(const Source; var Dest; ByteLen, MostLen: integer);
begin
if MostLen <= 0 then
Exit;
if ByteLen > MostLen then
ByteLen := MostLen
else if ByteLen < MostLen then
// TODO: 可优化为只填充不满的部分但后面有空再整
FillChar(Dest, MostLen, 0);
Move(Source, Dest, ByteLen);
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 ConstTimeBytesEqual(a, b: TBytes): boolean;
var
i: integer;
begin
Result := False;
if Length(a) <> Length(b) then
Exit;
Result := True;
for i := 0 to Length(a) - 1 do
// 每个字节都比较，而不是碰到不同就退出
Result := Result and (ConstTimeEqual8(a[i], b[i]));
end;
function ConstTimeExpandBoolean8(V: boolean): byte;
begin
Result := byte(V);
Result := not Result;
// 如果 V 是 True，非 0，则此步 R 非纯 $FF，R 里头有 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 得到 00000000，False 得到 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 在 RCX，AHi 在 RDX，B 在 R8，DivRes 的地址在 R9，
procedure Int128DivInt64Mod(ALo, AHi: Int64; B: Int64; var DivRes, ModRes: Int64); assembler;
asm
MOV RAX, RCX // ALo 放入 RAX，AHi 已经在 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 放入 RAX，AHi 已经在 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 在 EAX，DivRes 地址在 EDX，ModRes 地址在 ECX
procedure Int64DivInt32Mod(a: int64; b: integer; var DivRes, ModRes: integer); {$asmmode intel} 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);
{$asmmode intel} 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 Exception.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;
begin
{$asmmode intel}
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;
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 -> EAX，B -> 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 占 0、1，x+z 是 R1 占 1、2，把 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
// 各项系数都是 UInt64，xz 占 2、3、4，xt+yz 占 1、2、3，yt 占 0、1，然后累加
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; // To avoid warning
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;
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
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
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 (S[i] <> char(#0)) or Empty then
Code := i + 1 - FirstIndex
else
Code := 0;
end;
{$HINTS ON}
function UInt64ToHex(N: TUInt64): 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)));
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 UInt64Compare(a, b: TUInt64): integer;
{$IFNDEF SUPPORT_UINT64}
var
HiA, HiB, LoA, LoB: longword;
{$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 := longword(a and $00000000FFFFFFFF);
LoB := longword(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 的某一位置 1，位 Index 从 0 开始
procedure UInt64SetBit(var b: TUInt64; Index: integer);
begin
b := b or (TUInt64(1) shl Index);
end;
// 给 UInt64 的某一位置 0，位 Index 从 0 开始
procedure UInt64ClearBit(var b: TUInt64; Index: integer);
begin
b := b and not (TUInt64(1) shl Index);
end;
// 返回 UInt64 的第几位是否是 1，0 开始
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;
begin
if b = 0 then
begin
Result := -1;
Exit;
end;
Result := 1;
if b shr 32 = 0 then
begin
Inc(Result, 32);
b := b shl 32;
end;
if b shr 48 = 0 then
begin
Inc(Result, 16);
b := b shl 16;
end;
if b shr 56 = 0 then
begin
Inc(Result, 8);
b := b shl 8;
end;
if b shr 60 = 0 then
begin
Inc(Result, 4);
b := b shl 4;
end;
if b shr 62 = 0 then
begin
Inc(Result, 2);
b := b shl 2;
end;
Result := Result - integer(b shr 63); // 得到前导 0 的数量
Result := 63 - Result;
end;
// 返回 Cardinal 的是 1 的最高二进制位是第几位，最低位是 0，如果没有 1，返回 -1
function GetUInt32HighBits(b: cardinal): integer;
begin
if b = 0 then
begin
Result := -1;
Exit;
end;
Result := 1;
if b shr 16 = 0 then
begin
Inc(Result, 16);
b := b shl 16;
end;
if b shr 24 = 0 then
begin
Inc(Result, 8);
b := b shl 8;
end;
if b shr 28 = 0 then
begin
Inc(Result, 4);
b := b shl 4;
end;
if b shr 30 = 0 then
begin
Inc(Result, 2);
b := b shl 2;
end;
Result := Result - integer(b shr 31); // 得到前导 0 的数量
Result := 31 - Result;
end;
function GetUInt16HighBits(b: word): integer;
begin
if b = 0 then
begin
Result := -1;
Exit;
end;
Result := 1;
if b shr 8 = 0 then
begin
Inc(Result, 8);
b := b shl 8;
end;
if b shr 12 = 0 then
begin
Inc(Result, 4);
b := b shl 4;
end;
if b shr 14 = 0 then
begin
Inc(Result, 2);
b := b shl 2;
end;
Result := Result - integer(b shr 15); // 得到前导 0 的数量
Result := 15 - Result;
end;
function GetUInt8HighBits(b: byte): integer;
begin
if b = 0 then
begin
Result := -1;
Exit;
end;
Result := 1;
if b shr 4 = 0 then
begin
Inc(Result, 4);
b := b shl 4;
end;
if b shr 6 = 0 then
begin
Inc(Result, 2);
b := b shl 2;
end;
Result := Result - integer(b shr 7); // 得到前导 0 的数量
Result := 7 - Result;
end;
// 返回 Int64 的是 1 的最低二进制位是第几位，最低位是 0，如果没有 1，返回 -1
function GetUInt64LowBits(b: TUInt64): integer;
var
y: TUInt64;
N: integer;
begin
Result := -1;
if b = 0 then
Exit;
N := 63;
y := b shl 32;
if y <> 0 then
begin
Dec(N, 32);
b := y;
end;
y := b shl 16;
if y <> 0 then
begin
Dec(N, 16);
b := y;
end;
y := b shl 8;
if y <> 0 then
begin
Dec(N, 8);
b := y;
end;
y := b shl 4;
if y <> 0 then
begin
Dec(N, 4);
b := y;
end;
y := b shl 2;
if y <> 0 then
begin
Dec(N, 2);
b := y;
end;
b := b shl 1;
Result := N - integer(b shr 63);
end;
// 返回 Cardinal 的是 1 的最低二进制位是第几位，最低位是 0，如果没有 1，返回 -1
function GetUInt32LowBits(b: cardinal): integer;
var
y, N: integer;
begin
Result := -1;
if b = 0 then
Exit;
N := 31;
y := b shl 16;
if y <> 0 then
begin
Dec(N, 16);
b := y;
end;
y := b shl 8;
if y <> 0 then
begin
Dec(N, 8);
b := y;
end;
y := b shl 4;
if y <> 0 then
begin
Dec(N, 4);
b := y;
end;
y := b shl 2;
if y <> 0 then
begin
Dec(N, 2);
b := y;
end;
b := b shl 1;
Result := N - integer(b shr 31);
end;
// 返回 Word 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1
function GetUInt16LowBits(b: word): integer;
var
y, N: integer;
begin
Result := -1;
if b = 0 then
Exit;
N := 15;
y := b shl 8;
if y <> 0 then
begin
Dec(N, 8);
b := y;
end;
y := b shl 4;
if y <> 0 then
begin
Dec(N, 4);
b := y;
end;
y := b shl 2;
if y <> 0 then
begin
Dec(N, 2);
b := y;
end;
b := b shl 1;
Result := N - integer(b shr 15);
end;
// 返回 Byte 的是 1 的最低二进制位是第几位，最低位是 0，基本等同于末尾几个 0。如果没有 1，返回 -1
function GetUInt8LowBits(b: byte): integer;
var
N: integer;
begin
Result := -1;
if b = 0 then
Exit;
N := 7;
if b shr 4 = 0 then
begin
Dec(N, 4);
b := b shl 4;
end;
if b shr 6 = 0 then
begin
Dec(N, 2);
b := b shl 2;
end;
b := b shl 1;
Result := N - integer(b shr 7);
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;
// 判断一 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;
// 两个 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^63，N 至少是 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
i: integer;
x: TUInt64;
XN, X0, x1: extended;
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 = 2 then
Result := UInt64Sqrt(N)
else
begin
// 牛顿迭代法求根
i := GetUInt64HighBits(N) + 1; // 得到大约 Log2 N 的值
i := (i div Exp) + 1;
x := 1 shl i; // 得到一个较大的 X0 值作为起始值
X0 := UInt64ToExtended(x);
XN := UInt64ToExtended(N);
x1 := X0 - (Power(X0, Exp) - XN) / (Exp * Power(X0, Exp - 1));
while True do
begin
if (ExtendedToUInt64(X0) = ExtendedToUInt64(x1)) and (Abs(X0 - x1) < 0.001) then
begin
Result := ExtendedToUInt64(x1);
Exit;
end;
X0 := x1;
x1 := X0 - (Power(X0, Exp) - XN) / (Exp * Power(X0, Exp - 1));
end;
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(TCnNativeInt(Mem) + i * ElementByteSize),
Pointer(TCnNativeInt(Mem) + P * ElementByteSize), ElementByteSize) < 0 do
Inc(i);
while CompareProc(Pointer(TCnNativeInt(Mem) + j * ElementByteSize),
Pointer(TCnNativeInt(Mem) + P * ElementByteSize), ElementByteSize) > 0 do
Dec(j);
if i <= j then
begin
MemorySwap(Pointer(TCnNativeInt(Mem) + i * ElementByteSize),
Pointer(TCnNativeInt(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}
initialization
FByteOrderIsBigEndian := CurrentByteOrderIsBigEndian;
end.
标签：function,begin,end,PCardinal,CNSM4,lazarus,Result,CNvcl,integer From： https://www.cnblogs.com/CatDo/p/18032100