Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge commit 'f3eaad34c01a78db24102dba0aecbfc0a4f4aa37' as 'lib/msgpack'

Browse Source
This commit is contained in:
Daniele Teti 2024-03-28 16:35:03 +01:00
commit a5cb0074b3
11 changed files with 4013 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lib/msgpack/.gitignore vendored Normal file
View File

@ -0,0 +1,52 @@
# Uncomment these types if you want even more clean repository. But be careful.
# It can make harm to an existing project source. Read explanations below.
#
# Resource files are binaries containing manifest, project icon and version info.
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
#*.res
#
# Type library file (binary). In old Delphi versions it should be stored.
# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
#*.tlb
#
# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
# Uncomment this if you are not using diagrams or use newer Delphi version.
#*.ddp
#
# Visual LiveBindings file. Added in Delphi XE2.
# Uncomment this if you are not using LiveBindings Designer.
#*.vlb
#
# Deployment Manager configuration file for your project. Added in Delphi XE2.
# Uncomment this if it is not mobile development and you do not use remote debug feature.
#*.deployproj
#
# Delphi compiler-generated binaries (safe to delete)
*.exe
*.dll
*.bpl
*.bpi
*.dcp
*.so
*.apk
*.drc
*.map
*.dres
*.rsm
*.tds
# Delphi autogenerated files (duplicated info)
*.cfg
*Resource.rc
# Delphi local files (user-specific info)
*.local
*.identcache
*.projdata
*.tvsconfig
*.dsk
# Delphi history and backups
__history/
*.~*

831
lib/msgpack/DMsgPackHelper.pas Normal file
View File

@ -0,0 +1,831 @@
unit DMsgPackHelper;
interface
uses
Classes, SysUtils;
type
// copy from qmsgPack
TMsgPackValue= packed record
ValueType:Byte;
case Integer of
0:(U8Val:Byte);
1:(I8Val:Shortint);
2:(U16Val:Word);
3:(I16Val:Smallint);
4:(U32Val:Cardinal);
5:(I32Val:Integer);
6:(U64Val:UInt64);
7:(I64Val:Int64);
//8:(F32Val:Single);
//9:(F64Val:Double);
10:(BArray:array[0..16] of Byte);
end;
{$IF RTLVersion<25}
IntPtr=Integer;
{$IFEND IntPtr}
{$if CompilerVersion < 18} //before delphi 2007
TBytes = array of Byte;
{$ifend}
/// <summary>
/// 按照msgPack协议
/// 1.将数据写入到Stream
/// 2.从流中读取出数据
/// </summary>
TDMsgPackHelper = class(TObject)
public
/// <summary>
/// MsgPack协议方式写入一个字符串
/// </summary>
class procedure Write(pvStream: TStream; pvValue: string); overload;
/// <summary>
/// 按照MsgPack协议 写入一个二进制数据
/// </summary>
class procedure Write(pvStream: TStream; pvBuf:Pointer; pvLen:Cardinal); overload;
/// <summary>
/// 按照MsgPack协议 读取一个二进制数据
/// </summary>
class function ReadBinary(pvStream: TStream): TBytes; overload;
/// <summary>
/// 按照MsgPack协议 读取一个二进制数据,写入到另外一个流
/// </summary>
class procedure ReadBinary(pvSourceStream, pvDestStream: TStream); overload;
/// <summary>
/// MsgPack协议读取一个字符串， 如果是null值会返回''
/// </summary>
class function ReadString(pvStream:TStream):String;
/// <summary>
/// MsgPack协议方式写入一个整形数据
/// copy from qmsgPack
/// 2015-09-30 12:57:02
/// 未全面测试
/// </summary>
class procedure Write(pvStream: TStream; pvValue: Int64); overload;
/// <summary>
/// MsgPack协议读取一个整形， 如果是null值会返回0
/// 2015-09-30 12:57:02
/// 未全面测试
/// </summary>
class function ReadInt(pvStream:TStream): Int64;
/// <summary>
/// MsgPack协议方式写入一个浮点数据
/// 2015-09-30 12:57:02
/// 未全面测试
/// </summary>
class procedure Write(pvStream: TStream; pvValue: Double); overload;
/// <summary>
/// MsgPack协议读取一个浮点， 如果是null值会返回0
/// 2015-09-30 12:57:02
/// 未全面测试
/// </summary>
class function ReadFloat(pvStream:TStream): Double;
end;
implementation
resourcestring
strErrorStringData = '[%d]非法的字符串协议格式数据';
strErrorBinaryData = '[%d]非法的二进制协议格式数据';
strErrorIntData = '[%d]非法的整数协议格式数据';
strErrorFloatData = '[%d]非法的浮点格式数据';
function swap16(const v): Word;
begin
// FF, EE : EE->1, FF->2
PByte(@result)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@result) + 1)^ := PByte(@v)^;
end;
function swap32(const v): Cardinal;
begin
// FF, EE, DD, CC : CC->1, DD->2, EE->3, FF->4
PByte(@result)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@result) + 1)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@result) + 2)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@result) + 3)^ := PByte(@v)^;
end;
function swap64(const v): Int64;
begin
// FF, EE, DD, CC, BB, AA, 99, 88 : 88->1 ,99->2 ....
PByte(@result)^ := PByte(IntPtr(@v) + 7)^;
PByte(IntPtr(@result) + 1)^ := PByte(IntPtr(@v) + 6)^;
PByte(IntPtr(@result) + 2)^ := PByte(IntPtr(@v) + 5)^;
PByte(IntPtr(@result) + 3)^ := PByte(IntPtr(@v) + 4)^;
PByte(IntPtr(@result) + 4)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@result) + 5)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@result) + 6)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@result) + 7)^ := PByte(@v)^;
end;
// v and outVal is can't the same value
procedure swap64Ex(const v; out outVal);
begin
// FF, EE, DD, CC, BB, AA, 99, 88 : 88->1 ,99->2 ....
PByte(@outVal)^ := PByte(IntPtr(@v) + 7)^;
PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@v) + 6)^;
PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@v) + 5)^;
PByte(IntPtr(@outVal) + 3)^ := PByte(IntPtr(@v) + 4)^;
PByte(IntPtr(@outVal) + 4)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@outVal) + 5)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@outVal) + 6)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@outVal) + 7)^ := PByte(@v)^;
end;
// v and outVal is can't the same value
procedure swap32Ex(const v; out outVal);
begin
// FF, EE, DD, CC : CC->1, DD->2, EE->3, FF->4
PByte(@outVal)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@outVal) + 3)^ := PByte(@v)^;
end;
// v and outVal is can't the same value
procedure swap16Ex(const v; out outVal);
begin
// FF, EE : EE->1, FF->2
PByte(@outVal)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@outVal) + 1)^ := PByte(@v)^;
end;
// overload swap, result type is integer, because single maybe NaN
function swap(v:Single): Integer; overload;
begin
swap32Ex(v, Result);
end;
// overload swap
function swap(v:word): Word; overload;
begin
swap16Ex(v, Result);
end;
// overload swap
function swap(v:Cardinal):Cardinal; overload;
begin
swap32Ex(v, Result);
end;
// swap , result type is Int64, because Double maybe NaN
function swap(v:Double): Int64; overload;
begin
swap64Ex(v, Result);
end;
// copy from qstring
function BinToHex(p: Pointer; l: Integer; ALowerCase: Boolean): string;
const
B2HConvert: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6',
'7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
B2HConvertL: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6',
'7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
pd: PChar;
pb: PByte;
begin
if SizeOf(Char) = 2 then
begin
SetLength(Result, l shl 1);
end else
begin
SetLength(Result, l);
end;
pd := PChar(Result);
pb := p;
if ALowerCase then
begin
while l > 0 do
begin
pd^ := B2HConvertL[pb^ shr 4];
Inc(pd);
pd^ := B2HConvertL[pb^ and $0F];
Inc(pd);
Inc(pb);
Dec(l);
end;
end
else
begin
while l > 0 do
begin
pd^ := B2HConvert[pb^ shr 4];
Inc(pd);
pd^ := B2HConvert[pb^ and $0F];
Inc(pd);
Inc(pb);
Dec(l);
end;
end;
end;
function Utf8DecodeEx(pvValue:{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF}; len:Cardinal):string;
{$IFDEF UNICODE}
var
lvBytes:TBytes;
{$ENDIF}
begin
{$IFDEF UNICODE}
lvBytes := TEncoding.Convert(TEncoding.UTF8, TEncoding.Unicode, pvValue);
SetLength(Result, Length(lvBytes) shr 1);
Move(lvBytes[0], PChar(Result)^, Length(lvBytes));
{$ELSE}
result:= UTF8Decode(pvValue);
{$ENDIF}
end;
function Utf8EncodeEx(pvValue:string):{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
{$IFDEF UNICODE}
var
lvBytes:TBytes;
len:Cardinal;
{$ENDIF}
begin
{$IFDEF UNICODE}
len := length(pvValue) shl 1;
SetLength(lvBytes, len);
Move(PChar(pvValue)^, lvBytes[0], len);
Result := TEncoding.Convert(TEncoding.Unicode, TEncoding.UTF8, lvBytes);
{$ELSE}
result:= UTF8Encode(pvValue);
{$ENDIF}
end;
class function TDMsgPackHelper.ReadBinary(pvStream: TStream): TBytes;
var
lvByte:Byte;
l:Cardinal;
lvSavePosition:Int64;
begin
lvSavePosition := pvStream.Position;
pvStream.Read(lvByte, 1);
case lvByte of
$C0: // null
begin
SetLength(Result, 0);
end;
$C4: // 短二进制，最长255字节
begin
l := 0; // fill zero
pvStream.Read(l, 1);
SetLength(Result, l);
pvStream.Read(Result[0], l);
end;
$C5: // 二进制，16位，最长65535B
begin
l := 0; // fill zero
pvStream.Read(l, 2);
l := swap16(l);
SetLength(Result, l);
pvStream.Read(Result[0], l);
end;
$C6: // 二进制，32位，最长2^32-1
begin
l := 0; // fill zero
pvStream.Read(l, 4);
l := swap32(l);
SetLength(Result, l);
pvStream.Read(Result[0], l);
end;
else
begin
pvStream.Position := lvSavePosition;
raise Exception.CreateFmt(strErrorStringData, [lvByte]);
end;
end;
end;
class procedure TDMsgPackHelper.ReadBinary(pvSourceStream, pvDestStream:
TStream);
var
lvByte:Byte;
l:Cardinal;
lvSavePosition:Int64;
begin
lvSavePosition := pvSourceStream.Position;
pvSourceStream.Read(lvByte, 1);
case lvByte of
$C4: // 短二进制，最长255字节
begin
l := 0; // fill zero
pvSourceStream.Read(l, 1);
pvDestStream.CopyFrom(pvSourceStream, l);
end;
$C5: // 二进制，16位，最长65535B
begin
l := 0; // fill zero
pvSourceStream.Read(l, 2);
l := swap16(l);
pvDestStream.CopyFrom(pvSourceStream, l);
end;
$C6: // 二进制，32位，最长2^32-1
begin
l := 0; // fill zero
pvSourceStream.Read(l, 4);
l := swap32(l);
pvDestStream.CopyFrom(pvSourceStream, l);
end;
else
begin
pvSourceStream.Position := lvSavePosition;
raise Exception.CreateFmt(strErrorStringData, [lvByte]);
end;
end;
end;
class function TDMsgPackHelper.ReadFloat(pvStream:TStream): Double;
var
lvByte:Byte;
l:Cardinal;
lvSavePosition:Int64;
lvBData: array[0..15] of Byte;
lvSwapData: array[0..15] of Byte;
begin
lvSavePosition := pvStream.Position;
pvStream.Read(lvByte, 1);
case lvByte of
$C0: // null
begin
Result := 0;
end;
$CA: // float 32
begin
pvStream.Read(lvBData[0], 4);
swap32Ex(lvBData[0], lvSwapData[0]);
Result := PSingle(@lvSwapData[0])^;
end;
$cb: // Float 64
begin
pvStream.Read(lvBData[0], 8);
swap64Ex(lvBData[0], lvSwapData[0]);
Result := PDouble(@lvSwapData[0])^;
end;
else
begin
pvStream.Position := lvSavePosition;
raise Exception.CreateFmt(strErrorFloatData, [lvByte]);
end;
end;
end;
class function TDMsgPackHelper.ReadInt(pvStream:TStream): Int64;
var
lvByte:Byte;
l:Cardinal;
lvSavePosition, i64:Int64;
begin
lvSavePosition := pvStream.Position;
pvStream.Read(lvByte, 1);
if lvByte in [$00 .. $7F] then //positive fixint 0xxxxxxx 0x00 - 0x7f
begin
Result := lvByte;
end else if lvByte in [$E0 .. $FF] then
begin
// negative fixnum stores 5-bit negative integer
// +--------+
// |111YYYYY|
// +--------+
Result := Shortint(lvByte);
end else
begin
case lvByte of
$C0: // null
begin
Result := 0;
end;
$cc: // UInt8
begin
// uint 8 stores a 8-bit unsigned integer
// +--------+--------+
// | 0xcc |ZZZZZZZZ|
// +--------+--------+
l := 0;
pvStream.Read(l, 1);
Result := l;
end;
$cd:
begin
// uint 16 stores a 16-bit big-endian unsigned integer
// +--------+--------+--------+
// | 0xcd |ZZZZZZZZ|ZZZZZZZZ|
// +--------+--------+--------+
l := 0;
pvStream.Read(l, 2);
l := swap16(l);
Result := Word(l);
end;
$ce:
begin
// uint 32 stores a 32-bit big-endian unsigned integer
// +--------+--------+--------+--------+--------+
// | 0xce |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ
// +--------+--------+--------+--------+--------+
l := 0;
pvStream.Read(l, 4);
l := swap32(l);
Result := Cardinal(l);
end;
$cf:
begin
// uint 64 stores a 64-bit big-endian unsigned integer
// +--------+--------+--------+--------+--------+--------+--------+--------+--------+
// | 0xcf |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
// +--------+--------+--------+--------+--------+--------+--------+--------+--------+
i64 := 0;
pvStream.Read(i64, 8);
i64 := swap64(i64);
Result :=UInt64(i64);
end;
$d0: //int 8
begin
// int 8 stores a 8-bit signed integer
// +--------+--------+
// | 0xd0 |ZZZZZZZZ|
// +--------+--------+
l := 0;
pvStream.Read(l, 1);
Result := ShortInt(l);
end;
$d1:
begin
// int 16 stores a 16-bit big-endian signed integer
// +--------+--------+--------+
// | 0xd1 |ZZZZZZZZ|ZZZZZZZZ|
// +--------+--------+--------+
l := 0;
pvStream.Read(l, 2);
l := swap16(l);
Result := SmallInt(l);
end;
$d2:
begin
// int 32 stores a 32-bit big-endian signed integer
// +--------+--------+--------+--------+--------+
// | 0xd2 |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
// +--------+--------+--------+--------+--------+
l := 0;
pvStream.Read(l, 4);
l := swap32(l);
Result := Integer(l);
end;
$d3:
begin
// int 64 stores a 64-bit big-endian signed integer
// +--------+--------+--------+--------+--------+--------+--------+--------+--------+
// | 0xd3 |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
// +--------+--------+--------+--------+--------+--------+--------+--------+--------+
i64 := 0;
pvStream.Read(i64, 8);
i64 := swap64(i64);
Result := Int64(i64);
end;
else
begin
pvStream.Position := lvSavePosition;
raise Exception.CreateFmt(strErrorIntData, [lvByte]);
end;
end;
end;
end;
class function TDMsgPackHelper.ReadString(pvStream: TStream): String;
var
lvByte:Byte;
lvAnsiStr:{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
l:Cardinal;
lvSavePosition:Int64;
begin
lvSavePosition := pvStream.Position;
pvStream.Read(lvByte, 1);
if lvByte in [$A0 .. $BF] then //fixstr 101xxxxx 0xa0 - 0xbf
begin
l := lvByte - $A0; // str len
if l > 0 then
begin
SetLength(lvAnsiStr, l);
pvStream.Read(PByte(lvAnsiStr)^, l);
Result :=UTF8DecodeEx(lvAnsiStr, l);
end else
begin
Result :='';
end;
end else
begin
case lvByte of
$C0: // null
begin
Result := '';
end;
$d9: //str 8 , 255
begin
// str 8 stores a byte array whose length is upto (2^8)-1 bytes:
// +--------+--------+========+
// | 0xd9 |YYYYYYYY| data |
// +--------+--------+========+
l := 0;
pvStream.Read(l, 1);
if l > 0 then // check is empty ele
begin
SetLength(lvAnsiStr, l);
pvStream.Read(PByte(lvAnsiStr)^, l);
Result :=UTF8DecodeEx(lvAnsiStr, l);
end else
begin
Result :='';
end;
end;
$da: // str 16
begin
// str 16 stores a byte array whose length is upto (2^16)-1 bytes:
// +--------+--------+--------+========+
// | 0xda |ZZZZZZZZ|ZZZZZZZZ| data |
// +--------+--------+--------+========+
l := 0; // fill zero
pvStream.Read(l, 2);
l := swap16(l);
if l > 0 then // check is empty ele
begin
SetLength(lvAnsiStr, l);
pvStream.Read(PByte(lvAnsiStr)^, l);
Result :=UTF8DecodeEx(lvAnsiStr, l);
end else
begin
Result :='';
end;
// SetLength(lvBytes, l + 1);
// lvBytes[l] := 0;
// pvStream.Read(lvBytes[0], l);
// setAsString(UTF8Decode(PAnsiChar(@lvBytes[0])));
end;
$db: // str 16
begin
// str 32 stores a byte array whose length is upto (2^32)-1 bytes:
// +--------+--------+--------+--------+--------+========+
// | 0xdb |AAAAAAAA|AAAAAAAA|AAAAAAAA|AAAAAAAA| data |
// +--------+--------+--------+--------+--------+========+
l := 0; // fill zero
pvStream.Read(l, 4);
l := swap32(l);
if l > 0 then // check is empty ele
begin
SetLength(lvAnsiStr, l);
pvStream.Read(PByte(lvAnsiStr)^, l);
Result :=UTF8DecodeEx(lvAnsiStr, l);
end else
begin
Result :='';
end;
end;
else
begin
pvStream.Position := lvSavePosition;
raise Exception.CreateFmt(strErrorBinaryData, [lvByte]);
end;
end;
end;
end;
class procedure TDMsgPackHelper.Write(pvStream: TStream; pvValue: string);
var
lvRawData:{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
l:Integer;
lvValue:TMsgPackValue;
begin
lvRawData := Utf8EncodeEx(pvValue);
l:=Length(lvRawData);
//
//fixstr stores a byte array whose length is upto 31 bytes:
//+--------+========+
//|101XXXXX| data |
//+--------+========+
//
//str 8 stores a byte array whose length is upto (2^8)-1 bytes:
//+--------+--------+========+
//| 0xd9 |YYYYYYYY| data |
//+--------+--------+========+
//
//str 16 stores a byte array whose length is upto (2^16)-1 bytes:
//+--------+--------+--------+========+
//| 0xda |ZZZZZZZZ|ZZZZZZZZ| data |
//+--------+--------+--------+========+
//
//str 32 stores a byte array whose length is upto (2^32)-1 bytes:
//+--------+--------+--------+--------+--------+========+
//| 0xdb |AAAAAAAA|AAAAAAAA|AAAAAAAA|AAAAAAAA| data |
//+--------+--------+--------+--------+--------+========+
//
//where
//* XXXXX is a 5-bit unsigned integer which represents N
//* YYYYYYYY is a 8-bit unsigned integer which represents N
//* ZZZZZZZZ_ZZZZZZZZ is a 16-bit big-endian unsigned integer which represents N
//* AAAAAAAA_AAAAAAAA_AAAAAAAA_AAAAAAAA is a 32-bit big-endian unsigned integer which represents N
//* N is the length of data
if L<=31 then
begin
lvValue.ValueType:=$A0+Byte(L);
pvStream.WriteBuffer(lvValue.ValueType,1);
end
else if L<=255 then
begin
lvValue.ValueType:=$d9;
lvValue.U8Val:=Byte(L);
pvStream.WriteBuffer(lvValue,2);
end
else if L<=65535 then
begin
lvValue.ValueType:=$da;
lvValue.U16Val:=((L shr 8) and $FF) or ((L shl 8) and $FF00);
pvStream.Write(lvValue,3);
end else
begin
lvValue.ValueType:=$db;
lvValue.BArray[0]:=(L shr 24) and $FF;
lvValue.BArray[1]:=(L shr 16) and $FF;
lvValue.BArray[2]:=(L shr 8) and $FF;
lvValue.BArray[3]:=L and $FF;
pvStream.WriteBuffer(lvValue,5);
end;
pvStream.Write(PByte(lvRawData)^, l);
end;
class procedure TDMsgPackHelper.Write(pvStream: TStream; pvBuf:Pointer;
pvLen:Cardinal);
var
lvValue:TMsgPackValue;
begin
if pvLen <= 255 then
begin
lvValue.ValueType := $C4;
lvValue.U8Val := Byte(pvLen);
pvStream.WriteBuffer(lvValue, 2);
end
else if pvLen <= 65535 then
begin
lvValue.ValueType := $C5;
lvValue.BArray[0] := (pvLen shr 8) and $FF;
lvValue.BArray[1] := pvLen and $FF;
pvStream.WriteBuffer(lvValue, 3);
end
else
begin
lvValue.ValueType := $C6;
lvValue.BArray[0] := (pvLen shr 24) and $FF;
lvValue.BArray[1] := (pvLen shr 16) and $FF;
lvValue.BArray[2] := (pvLen shr 8) and $FF;
lvValue.BArray[3] := pvLen and $FF;
pvStream.WriteBuffer(lvValue, 5);
end;
if pvLen > 0 then
begin
pvStream.WriteBuffer(pvBuf^, pvLen);
end;
end;
class procedure TDMsgPackHelper.Write(pvStream: TStream; pvValue: Int64);
var
lvValue:TMsgPackValue;
begin
if pvValue>=0 then
begin
if pvValue<=127 then
begin
lvValue.U8Val:=Byte(pvValue);
pvStream.WriteBuffer(lvValue.U8Val,1);
end
else if pvValue<=255 then//UInt8
begin
lvValue.ValueType:=$cc;
lvValue.U8Val:=Byte(pvValue);
pvStream.WriteBuffer(lvValue,2);
end
else if pvValue<=65535 then
begin
lvValue.ValueType:=$cd;
lvValue.BArray[0]:=(pvValue shr 8);
lvValue.BArray[1]:=(pvValue and $FF);
pvStream.WriteBuffer(lvValue,3);
end
else if pvValue<=Cardinal($FFFFFFFF) then
begin
lvValue.ValueType:=$ce;
lvValue.BArray[0]:=(pvValue shr 24) and $FF;
lvValue.BArray[1]:=(pvValue shr 16) and $FF;
lvValue.BArray[2]:=(pvValue shr 8) and $FF;
lvValue.BArray[3]:=pvValue and $FF;
pvStream.WriteBuffer(lvValue,5);
end
else
begin
lvValue.ValueType:=$cf;
lvValue.BArray[0]:=(pvValue shr 56) and $FF;
lvValue.BArray[1]:=(pvValue shr 48) and $FF;
lvValue.BArray[2]:=(pvValue shr 40) and $FF;
lvValue.BArray[3]:=(pvValue shr 32) and $FF;
lvValue.BArray[4]:=(pvValue shr 24) and $FF;
lvValue.BArray[5]:=(pvValue shr 16) and $FF;
lvValue.BArray[6]:=(pvValue shr 8) and $FF;
lvValue.BArray[7]:=pvValue and $FF;
pvStream.WriteBuffer(lvValue,9);
end;
end
else//<0
begin
if pvValue<=Low(Integer) then //-2147483648 // 64 bit
begin
lvValue.ValueType:=$d3;
lvValue.BArray[0]:=(pvValue shr 56) and $FF;
lvValue.BArray[1]:=(pvValue shr 48) and $FF;
lvValue.BArray[2]:=(pvValue shr 40) and $FF;
lvValue.BArray[3]:=(pvValue shr 32) and $FF;
lvValue.BArray[4]:=(pvValue shr 24) and $FF;
lvValue.BArray[5]:=(pvValue shr 16) and $FF;
lvValue.BArray[6]:=(pvValue shr 8) and $FF;
lvValue.BArray[7]:=pvValue and $FF;
pvStream.WriteBuffer(lvValue,9);
end
else if pvValue<=Low(SmallInt) then // -32768 // 32 bit
begin
lvValue.ValueType:=$d2;
lvValue.BArray[0]:=(pvValue shr 24) and $FF;
lvValue.BArray[1]:=(pvValue shr 16) and $FF;
lvValue.BArray[2]:=(pvValue shr 8) and $FF;
lvValue.BArray[3]:=pvValue and $FF;
pvStream.WriteBuffer(lvValue,5);
end
else if pvValue<=-128 then
begin
lvValue.ValueType:=$d1;
lvValue.BArray[0]:=(pvValue shr 8);
lvValue.BArray[1]:=(pvValue and $FF);
pvStream.WriteBuffer(lvValue,3);
end
else if pvValue<-32 then
begin
lvValue.ValueType:=$d0;
lvValue.I8Val:=pvValue;
pvStream.WriteBuffer(lvValue,2);
end
else
begin
lvValue.I8Val:=pvValue;
pvStream.Write(lvValue.I8Val,1);
end;
end;//End <0
end;
class procedure TDMsgPackHelper.Write(pvStream: TStream; pvValue: Double);
var
lvValue:TMsgPackValue;
begin
lvValue.i64Val := swap(pvValue);
lvValue.ValueType := $CB;
pvStream.WriteBuffer(lvValue, 9);
end;
end.

24
lib/msgpack/LICENSE Normal file
View File

@ -0,0 +1,24 @@
Copyright (c) 2014, ymofen
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

90
lib/msgpack/README.md Normal file
View File

@ -0,0 +1,90 @@
# Msgpack for Delphi
It's like JSON but small and fast.
```
unit Owner: D10.Mofen, qdac.swish
contact:
qq:185511468,
email:185511468@qq.com
welcome to report bug
```
Works with
--------
* Delphi 7 (tested)
* Delphi 2007 (tested)
* XE5, XE6, XE7, FMX (tested)
changes:
--------
+ first release
2014-08-15 13:05:13
+ add array support
2014-08-19 12:18:47
+ add andriod support
2014-09-08 00:45:27
* fixed int32, int64 parse bug< integer, int64 parse zero>
2014-11-09 22:35:27
+ add EncodeToFile/DecodeFromFile
2014-11-13 12:30:58
* fix asVariant = null (thanks for cyw(26890954))
2014-11-14 09:05:52
* fix AsInteger = -1 bug (thanks for cyw(26890954))
2014-11-14 12:15:52
* fix AsInteger = -127 bug
check int64/integer/cardinal/word/shortint/smallint/byte assign, encode,decode, read
2014-11-14 12:30:38
* fix AsFloat = 2.507182 bug
thanks fo [珠海]-芒果 1939331207
2014-11-21 12:37:04
* add AddArrayChild func
2015-03-25 17:47:28
* add remove/removeFromParent/Delete function
2015-08-29 22:37:48
### Code Example
```Pascal
var
lvMsg, lvMsg2:TSimpleMsgPack;
lvBytes:TBytes;
s:string;
begin
lvMsg := TSimpleMsgPack.Create;
lvMsg.S['key.obj'] := '汉字,ascii';
if dlgOpen.Execute then
begin
lvMsg.S['key.image.name'] := ExtractFileName(dlgOpen.FileName);
// file binary data
lvMsg.ForcePathObject('key.image.data').LoadBinaryFromFile(dlgOpen.FileName);
end;
//
lvBytes := lvMsg.EncodeToBytes;
lvMsg2 := TSimpleMsgPack.Create;
lvMsg2.DecodeFromBytes(lvBytes);
//
Memo1.Lines.Add(lvMsg2.S['key.obj']);
if lvMsg2.S['key.image.name'] <> '' then
begin
s := ExtractFilePath(ParamStr(0)) + lvMsg2.S['key.image.name'];
Memo1.Lines.Add('file saved');
Memo1.Lines.Add(s);
lvMsg2.ForcePathObject('key.image.data').SaveBinaryToFile(s);
end;
```

18
lib/msgpack/Samples/PackAndUnPack/prjPackAndUnPack.dpr Normal file
View File

@ -0,0 +1,18 @@
program prjPackAndUnPack;
uses
Forms,
ufrmMain in 'ufrmMain.pas' {Form2},
SimpleMsgPack in '..\..\SimpleMsgPack.pas',
uByteTools in 'uByteTools.pas',
DMsgPackHelper in '..\..\DMsgPackHelper.pas';
{$R *.res}
begin
ReportMemoryLeaksOnShutdown := true;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm2, Form2);
Application.Run;
end.

165
lib/msgpack/Samples/PackAndUnPack/uByteTools.pas Normal file
View File

@ -0,0 +1,165 @@
unit uByteTools;
interface
uses
SysUtils;
type
{$IF RTLVersion<25}
IntPtr=Integer;
{$IFEND IntPtr}
TByteTools = class(TObject)
public
class function varToByteString(const v; len: Cardinal; Split: string = ' '):
String;
class function varToHexString(const v; len: Cardinal; Split: string = ' '):
String;
/// <summary>
/// 16进制转 二进制
/// </summary>
class function HexToBin(pvHexStr:String; buf:Pointer):Integer;
/// <summary>
/// 16进制字符到二进制
/// </summary>
class function HexValue(c: Char): Integer;
/// <summary>
/// 是否16进制字符
/// </summary>
class function IsHexChar(c: Char): Boolean;
/// <summary>
/// 高低位进行交换
/// </summary>
class function swap32(v:Integer):Integer;
/// <summary>
/// 高低位进行交换
/// </summary>
class function swap64(v:int64):Int64;
/// <summary>
/// 高低位进行交换
/// </summary>
class function swap16(const v):Word;
end;
implementation
class function TByteTools.HexToBin(pvHexStr: String;
buf: Pointer): Integer;
var
l: Integer;
p, ps: PChar;
pd: PByte;
begin
l := Length(pvHexStr);
p := PChar(pvHexStr);
ps := p;
pd := PByte(buf);
Result := 0;
while p - ps < l do
begin
if IsHexChar(p[0]) and IsHexChar(p[1]) then
begin
pd^ := (HexValue(p[0]) shl 4) + HexValue(p[1]);
inc(Result);
Inc(pd);
Inc(p, 2);
end
else
begin
Exit;
end;
end;
end;
class function TByteTools.HexValue(c: Char): Integer;
begin
if (c >= '0') and (c <= '9') then
Result := Ord(c) - Ord('0')
else if (c >= 'a') and (c <= 'f') then
Result := 10 + Ord(c) - Ord('a')
else
Result := 10 + Ord(c) - Ord('A');
end;
class function TByteTools.IsHexChar(c: Char): Boolean;
begin
Result := ((c >= '0') and (c <= '9')) or ((c >= 'a') and (c <= 'f')) or ((c >= 'A') and (c <= 'F'));
end;
class function TByteTools.swap16(const v): Word;
begin
// FF, EE : EE->1, FF->2
PByte(@result)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@result) + 1)^ := PByte(@v)^;
end;
class function TByteTools.swap32(v: Integer): Integer;
var
lvPByte : PByte;
begin
result := v;
lvPByte := PByte(@result);
PByte(lvPByte)^ := byte(v shr 24);
PByte(IntPtr(lvPByte) + 1)^ := byte(v shr 16);
PByte(IntPtr(lvPByte) + 2)^ := byte(v shr 8);
PByte(IntPtr(lvPByte) + 3)^ := byte(v);
end;
class function TByteTools.swap64(v: int64): Int64;
var
lvPByte : PByte;
begin
result := v;
lvPByte := PByte(@result);
PByte(lvPByte)^ := byte(v shr 56); //8 * 7
PByte(IntPtr(lvPByte) + 1)^ := byte(v shr 48); //6
PByte(IntPtr(lvPByte) + 2)^ := byte(v shr 40); //5
PByte(IntPtr(lvPByte) + 3)^ := byte(v shr 32); //4
PByte(IntPtr(lvPByte) + 4)^ := byte(v shr 24); //3
PByte(IntPtr(lvPByte) + 5)^ := byte(v shr 16); //2
PByte(IntPtr(lvPByte) + 6)^ := byte(v shr 8); //2
PByte(IntPtr(lvPByte) + 7)^ := byte(v); //1
end;
class function TByteTools.varToByteString(const v; len: Cardinal; Split: string
= ' '): String;
var
lvSource:PByte;
i: Integer;
begin
lvSource := PByte(@v);
for i := 1 to len do
begin
Result := Result + IntToStr(lvSource^) + Split;
Inc(lvSource);
end;
end;
class function TByteTools.varToHexString(const v; len: Cardinal; Split: string
= ' '): String;
var
lvSource:PByte;
i: Integer;
begin
lvSource := PByte(@v);
for i := 1 to len do
begin
Result := Result + IntToHex(lvSource^, 2) + Split;
Inc(lvSource);
end;
end;
end.

130
lib/msgpack/Samples/PackAndUnPack/ufrmMain.dfm Normal file
View File

@ -0,0 +1,130 @@
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 341
ClientWidth = 721
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnTester: TButton
Left = 8
Top = 16
Width = 75
Height = 25
Caption = 'btnTester'
TabOrder = 0
OnClick = btnTesterClick
end
object edtData: TEdit
Left = 112
Top = 18
Width = 425
Height = 21
TabOrder = 1
Text = 'msgPack?1f123Abcd<FE>?FM?/></f>F/></></f?>'
end
object mmoOutPut: TMemo
Left = 8
Top = 72
Width = 529
Height = 249
TabOrder = 2
end
object btnDelete: TButton
Left = 568
Top = 64
Width = 75
Height = 25
Caption = 'btnDelete'
TabOrder = 3
OnClick = btnDeleteClick
end
object Button1: TButton
Left = 568
Top = 95
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 4
OnClick = Button1Click
end
object Button2: TButton
Left = 568
Top = 16
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 5
OnClick = Button2Click
end
object Button3: TButton
Left = 568
Top = 151
Width = 75
Height = 25
Caption = 'Button3'
TabOrder = 6
OnClick = Button3Click
end
object btnCheckInteger: TButton
Left = 568
Top = 182
Width = 105
Height = 25
Caption = 'btnCheckInteger'
TabOrder = 7
OnClick = btnCheckIntegerClick
end
object Button4: TButton
Left = 568
Top = 255
Width = 75
Height = 25
Caption = 'Button4'
TabOrder = 8
OnClick = Button4Click
end
object btnFile: TButton
Left = 112
Top = 41
Width = 75
Height = 25
Caption = 'btnFile'
TabOrder = 9
OnClick = btnFileClick
end
object Button5: TButton
Left = 568
Top = 296
Width = 75
Height = 25
Caption = 'Button5'
TabOrder = 10
OnClick = Button5Click
end
object btnDMsgPacker: TButton
Left = 248
Top = 41
Width = 113
Height = 25
Caption = 'btnDMsgPackHelper'
TabOrder = 11
OnClick = btnDMsgPackerClick
end
object btnCheckInt2: TButton
Left = 568
Top = 213
Width = 105
Height = 25
Caption = 'btnCheckInteger2'
TabOrder = 12
OnClick = btnCheckInt2Click
end
end

425
lib/msgpack/Samples/PackAndUnPack/ufrmMain.pas Normal file
View File

@ -0,0 +1,425 @@
unit ufrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SimpleMsgPack, uByteTools, DMsgPackHelper;
type
TForm2 = class(TForm)
btnTester: TButton;
edtData: TEdit;
mmoOutPut: TMemo;
btnDelete: TButton;
Button1: TButton;
Button2: TButton;
Button3: TButton;
btnCheckInteger: TButton;
Button4: TButton;
btnFile: TButton;
Button5: TButton;
btnDMsgPacker: TButton;
btnCheckInt2: TButton;
procedure btnCheckInt2Click(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnTesterClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure btnCheckIntegerClick(Sender: TObject);
procedure btnDMsgPackerClick(Sender: TObject);
procedure btnFileClick(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.btnDeleteClick(Sender: TObject);
var
lvmsgPack,lvMsgPack2, lvTempPack:TSimpleMsgPack;
lvBytes:TBytes;
begin
lvmsgPack := TSimpleMsgPack.Create;
lvMsgPack2 := TSimpleMsgPack.Create;
try
lvmsgPack.S['key.obj.name'] := edtData.Text;
lvmsgPack.DeleteObject('key.obj.name');
lvBytes := lvMsgPack.EncodeToBytes;
lvMsgPack2.DecodeFromBytes(lvBytes);
mmoOutPut.Lines.Add(lvMsgPack2.S['key']);
finally
lvMsgPack2.Free;
lvMsgPack.Free;
end;
end;
procedure TForm2.btnTesterClick(Sender: TObject);
var
lvmsgPack,lvMsgPack2, lvTempPack:TSimpleMsgPack;
lvBytes:TBytes;
begin
lvmsgPack := TSimpleMsgPack.Create;
lvMsgPack2 := TSimpleMsgPack.Create;
try
lvmsgPack.I['int'] := High(Integer);
lvmsgPack.I['Cardinal'] := High(Cardinal);
lvmsgPack.I['Int64'] := High(Int64);
//lvmsgPack.I['start'] := lvmsgPack.I['start'] + 600;
lvBytes := lvMsgPack.EncodeToBytes;
lvMsgPack2.clear;
lvMsgPack2.DecodeFromBytes(lvBytes);
mmoOutPut.Lines.Add(lvMsgPack2.S['key.obj']);
mmoOutPut.Lines.Add(IntToStr(lvMsgPack2.I['int']));
mmoOutPut.Lines.Add(IntToStr(lvMsgPack2.I['Cardinal']));
mmoOutPut.Lines.Add(IntToStr(lvMsgPack2.I['Int64']));
finally
lvMsgPack2.Free;
lvMsgPack.Free;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
lvStream:TMemoryStream;
lvmsgPack :TSimpleMsgPack;
begin
lvStream := TMemoryStream.Create;
lvStream.LoadFromFile('C:\msgpack.dat');
lvmsgPack := TSimpleMsgPack.Create;
lvStream.Position := 0;
lvmsgPack.DecodeFromStream(lvStream);
mmoOutPut.Lines.Add(IntToStr(lvmsgPack.I['start']));
end;
procedure TForm2.Button2Click(Sender: TObject);
var
lvmsgPack,lvMsgPack2, lvTempPack:TSimpleMsgPack;
lvBytes:TBytes;
begin
lvmsgPack := TSimpleMsgPack.Create;
lvMsgPack2 := TSimpleMsgPack.Create;
try
lvmsgPack.AsInteger := ShortInt($E0);
lvBytes := lvMsgPack.EncodeToBytes;
mmoOutPut.Lines.Add(TByteTools.varToHexString(lvBytes[0], Length(lvBytes)));
lvMsgPack2.DecodeFromBytes(lvBytes);
ShowMessage(IntToSTr(lvMsgPack2.AsInteger));
// ShowMessage(lvMsgPack2.AsVariant);
finally
lvMsgPack2.Free;
lvMsgPack.Free;
end;
end;
procedure TForm2.Button3Click(Sender: TObject);
var
lvmsgPack, lvMsgPack2: TSimpleMsgPack;
lvStream: TMemoryStream;
begin
lvmsgPack := TSimpleMsgPack.Create;
lvmsgPack2 := TSimpleMsgPack.Create;
lvmsgPack.ForcePathObject('index').AsInteger := -1;
lvStream := TMemoryStream.Create;
try
lvmsgPack.EncodeToStream(lvStream);
lvStream.Position := 0;
lvMsgPack2.DecodeFromStream(lvStream);
//下面一句：结果等于 'index'，而不是预期中的 -1
ShowMessage(lvMsgPack2.ForcePathObject('index').AsString);
finally
FreeAndNil(lvStream);
end;
end;
procedure TForm2.btnCheckIntegerClick(Sender: TObject);
var
lvmsgPack,lvMsgPack2, lvTempPack:TSimpleMsgPack;
lvBytes:TBytes;
i, z, j: Int64;
begin
lvmsgPack := TSimpleMsgPack.Create;
lvMsgPack2 := TSimpleMsgPack.Create;
try
z := High(Int64)- 10000;
j := z + 10000 - 1;
i := z;
while i <= j do
begin
lvmsgPack.I[IntToStr(i)] := i;
i := i + 1;
end;
lvBytes := lvMsgPack.EncodeToBytes;
lvMsgPack2.DecodeFromBytes(lvBytes);
i := z;
while i <= j do
begin
Assert(lvMsgPack2.I[IntToStr(i)] = i, IntToStr(i));
i := i + 1;
end;
finally
lvMsgPack2.Free;
lvMsgPack.Free;
end;
end;
// v and outVal is can't the same value
procedure swap64Ex(const v; out outVal);
begin
// FF, EE, DD, CC, BB, AA, 99, 88 : 88->1 ,99->2 ....
PByte(@outVal)^ := PByte(IntPtr(@v) + 7)^;
PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@v) + 6)^;
PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@v) + 5)^;
PByte(IntPtr(@outVal) + 3)^ := PByte(IntPtr(@v) + 4)^;
PByte(IntPtr(@outVal) + 4)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@outVal) + 5)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@outVal) + 6)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@outVal) + 7)^ := PByte(@v)^;
end;
// v and outVal is can't the same value
procedure swap32Ex(const v; out outVal);
begin
// FF, EE, DD, CC : CC->1, DD->2, EE->3, FF->4
PByte(@outVal)^ := PByte(IntPtr(@v) + 3)^;
PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@v) + 2)^;
PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@v) + 1)^;
PByte(IntPtr(@outVal) + 3)^ := PByte(@v)^;
end;
procedure TForm2.btnCheckInt2Click(Sender: TObject);
var
lvStream:TMemoryStream;
lvBytes:TBytes;
i, z, j, t2: Int64;
t:Cardinal;
begin
t := GetTickCount;
lvStream := TMemoryStream.Create;
try
z := Low(Int64);
j := z + 10000000 - 1;
i := z;
t2 := 0;
while i <= j do
begin
lvStream.Position := 0;
TDMsgPackHelper.Write(lvStream, i);
lvStream.Position := 0;
Assert(i = TDMsgPackHelper.ReadInt(lvStream));
i := i + 1;
inc(t2);
end;
ShowMessage(format('succ[%d: %d]', [t2, getTickcount- t]));
z := Low(Integer);
j := z + 10000000 - 1;
i := z;
t2 := 0;
while i <= j do
begin
lvStream.Position := 0;
TDMsgPackHelper.Write(lvStream, i);
lvStream.Position := 0;
Assert(i = TDMsgPackHelper.ReadInt(lvStream));
i := i + 1;
inc(t2);
end;
ShowMessage(format('succ[%d: %d]', [t2, getTickcount- t]));
z := Low(SmallInt);
j := z + 10000000 - 1;
i := z;
t2 := 0;
while i <= j do
begin
lvStream.Position := 0;
TDMsgPackHelper.Write(lvStream, i);
lvStream.Position := 0;
Assert(i = TDMsgPackHelper.ReadInt(lvStream));
i := i + 1;
inc(t2);
end;
ShowMessage(format('succ[%d: %d]', [t2, getTickcount- t]));
z := High(Int64) - 10000000;
j := High(Int64) - 1; // 必须-1 , i:=i+1的时候会超过时会出现问题
i := z;
t2 := 0;
while i <= j do
begin
lvStream.Position := 0;
TDMsgPackHelper.Write(lvStream, i);
lvStream.Position := 0;
Assert(i = TDMsgPackHelper.ReadInt(lvStream));
i := i + 1;
inc(t2);
end;
ShowMessage(format('succ[%d: %d]', [t2, getTickcount- t]));
finally
lvStream.Free;
end;
end;
procedure TForm2.btnDMsgPackerClick(Sender: TObject);
var
lvStream:TFileStream;
lvBinary, lvReadStream:TMemoryStream;
s:AnsiString;
lvFile:string;
lvBytes:TBytes;
begin
lvFile := 'C:\simplemsgpack.msgpack';
DeleteFile(lvFile);
lvBinary := TMemoryStream.Create;
s :='abc_中国人民解放军';
lvBinary.Write(PAnsiChar(s)^, length(s));
lvReadStream := TMemoryStream.Create;
lvStream := TFileStream.Create(lvFile, fmCreate);
TDMsgPackHelper.Write(lvStream, '中国人民解放军');
TDMsgPackHelper.Write(lvStream, lvBinary.Memory, lvBinary.Size);
lvStream.Position := 0;
mmoOutPut.Lines.Add(TDMsgPackHelper.ReadString(lvStream));
lvBytes := TDMsgPackHelper.ReadBinary(lvStream);
mmoOutPut.Lines.Add(TByteTools.varToHexString(lvBytes[0], Length(lvBytes)));
lvBinary.Free;
lvStream.Free;
lvReadStream.Free;
// P:=TSimpleMsgPack.Create;
// P.I['A']:=234;
// P.EncodeToFile('C:\a.txt');
// P.Free;
//
//
//
// P2:=TSimpleMsgPack.Create;
// P2.DecodeFromFile('C:\a.txt');
// ShowMessage(IntToStr(P2.I['A']));
// P2.Free;
end;
//function swap(v: Double): Double;
//var
// d1:Double;
//begin
// swap64Ex(v, d1);
// Result := d1;
//end;
procedure TForm2.btnFileClick(Sender: TObject);
var
P:TSimpleMsgPack;
var
P2:TSimpleMsgPack;
begin
P:=TSimpleMsgPack.Create;
P.I['A']:=234;
P.EncodeToFile('C:\a.txt');
P.Free;
P2:=TSimpleMsgPack.Create;
P2.DecodeFromFile('C:\a.txt');
ShowMessage(IntToStr(P2.I['A']));
P2.Free;
end;
procedure TForm2.Button4Click(Sender: TObject);
var
d, d1:Double;
s1, s2:Single;
i:Integer;
begin
d := 2.507182;
mmoOutPut.Lines.Add(TByteTools.varToByteString(d, SizeOf(Double)));
swap64Ex(d, d1);
//d1 := swap(d);
mmoOutPut.Lines.Add(TByteTools.varToByteString(d1, SizeOf(Double)));
s1 := 1.1;
mmoOutPut.Lines.Add(TByteTools.varToByteString(s1, SizeOf(Single)));
swap32Ex(s1, i);
mmoOutPut.Lines.Add(TByteTools.varToByteString(i, SizeOf(Integer)));
end;
procedure TForm2.Button5Click(Sender: TObject);
var
d, d2:SmallInt;
//lvBytes:TBytes;
lvBytes : array[0..1024*1024] of Byte;
begin
//SetLength(lvBytes, 1000 * 1000 * 10);
mmoOutPut.Lines.Add(TByteTools.varToHexString(lvBytes[0], 10));
d := -128;
mmoOutPut.Lines.Add(TByteTools.varToHexString(d, SizeOf(SmallInt)));
d2 := Swap(d);
mmoOutPut.Lines.Add(TByteTools.varToHexString(d2, SizeOf(SmallInt)));
end;
end.

2269
lib/msgpack/SimpleMsgPack.pas Normal file
View File

File diff suppressed because it is too large Load Diff

9
lib/msgpack/clean.bat Normal file
View File

@ -0,0 +1,9 @@
Del *.dcu /s
del *.~*~ /s
Del *.~dpr /s
Del *.~ddp /s
Del *.ddp /s
Del *.~pas /s
Del *.~dfm /s
Del *.ddp /s
Del *.log /s

BIN
lib/msgpack/qdac_msgpackviewTools.7z Normal file
View File

Binary file not shown.