Hessian2序列化

[code]
unit Hessian2Output;

{
title: hessian 2.0 序列化
author: Xiao Chun
email: cnxiaochun#gmail.com
version: draft
reference: http://hessian.caucho.com/
}

interface
uses Classes;
const
BUFFER_SIZE = 4096;

INT_DIRECT_MIN = -$10;
INT_DIRECT_MAX = $2F;
INT_ZERO = $90;

INT_BYTE_MIN = -$800;
INT_BYTE_MAX = $7FF;
INT_BYTE_ZERO = $C8;

INT_SHORT_MIN = -$40000;
INT_SHORT_MAX = $3FFFF;
INT_SHORT_ZERO = $D4;

LONG_DIRECT_MIN = -$08;
LONG_DIRECT_MAX = $0F;
LONG_ZERO = $E0;

LONG_BYTE_MIN = -$800;
LONG_BYTE_MAX = $7FF;
LONG_BYTE_ZERO = $F8;

LONG_SHORT_MIN = -$40000;
LONG_SHORT_MAX = $3FFFF;
LONG_SHORT_ZERO = $3C;

LONG_INT_MIN = -$7FFFFFFF - 1;
LONG_INT_MAX = $7FFFFFFF;
LONG_INT_ZERO = $77;

STRING_DIRECT_MAX = $1F;
STRING_DIRECT = $00;

BYTES_DIRECT_MAX = $0F;
BYTES_DIRECT = $20;

DOUBLE_ZERO = $67;
DOUBLE_ONE = $68;
DOUBLE_BYTE = $69;
DOUBLE_SHORT = $6A;
DOUBLE_FLOAT = $6B;

LENGTH_BYTE = $6E;
LIST_FIXED = $76; // 'v'

REF_BYTE = $4A;
REF_SHORT = $4B;

TYPE_REF = $75;
type
THessian2Output = class(TObject)
private
FBuffer: array[0..BUFFER_SIZE - 1] of Byte;
FOffset: integer;
FStream: TStream;
FFreeStreamOnDestroy: boolean;
_typeRefs: TStringList;
procedure PrintString(const AValue: WideString; AOffset, ACount: integer);
procedure WriteType(const AType: WideString);
procedure _WriteString(const AValue: WideString; AOffset, ACount: integer);
public
constructor Create(AStream: TStream);
destructor Destroy; override;
public
procedure StartCall(const AMethodName: WideString);
procedure CompleteCall;
procedure Flush;
procedure WriteInt(AValue: integer);
procedure WriteLong(AValue: Int64);
procedure WriteDouble(AValue: Double);
procedure WriteBoolean(AValue: boolean);
procedure WriteNull;
procedure WriteString(const AValue: WideString);
procedure WriteUTCDate(AValue: TDateTime);
procedure WriteBytes(ASourceStream: TStream); overload;
procedure WriteBytes(ASourceStream: TStream; AOffset, ACount: integer); overload;
procedure WriteMapBegin; overload;
procedure WriteMapBegin(const AType: WideString); overload;
procedure WriteMapEnd;
function WriteListBegin(ALength: integer; const AType: WideString): boolean; overload;
function WriteListBegin(ALength: integer): boolean; overload;
procedure WriteListEnd;
end;

implementation
uses JavaDate;

constructor THessian2Output.Create(AStream: TStream);
begin
inherited Create;
FOffset := 0;
if Assigned(AStream) then
begin
FFreeStreamOnDestroy := false;
FStream := AStream;
end
else begin
FFreeStreamOnDestroy := true;
FStream := TMemoryStream.Create;
end;
end;

destructor THessian2Output.Destroy;
begin
if FFreeStreamOnDestroy then FStream.Free;
if Assigned(_typeRefs) then _typeRefs.Free;
inherited;
end;

procedure THessian2Output.StartCall(const AMethodName: WideString);
var
Len: Integer;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('c'); Inc(FOffset);
FBuffer[FOffset] := Byte(2); Inc(FOffset);
FBuffer[FOffset] := Byte(0); Inc(FOffset);
FBuffer[FOffset] := Byte('m'); Inc(FOffset);

Len := Length(AMethodName);
FBuffer[FOffset] := Byte(len shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(len); Inc(FOffset);
PrintString(AMethodName, 0, Len);
end;

procedure THessian2Output.CompleteCall;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('z'); Inc(FOffset);
end;

procedure THessian2Output.WriteInt(AValue: integer);
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

if (INT_DIRECT_MIN <= AValue) and (AValue <= INT_DIRECT_MAX) then
begin
FBuffer[FOffset] := Byte(AValue + INT_ZERO); Inc(FOffset);
end
else if (INT_BYTE_MIN <= AValue) and (AValue <= INT_BYTE_MAX) then
begin
FBuffer[FOffset] := Byte(INT_BYTE_ZERO + (AValue shr 8 )); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
else if (INT_SHORT_MIN <= AValue) and (AValue <= INT_SHORT_MAX) then
begin
FBuffer[FOffset] := Byte(INT_SHORT_ZERO + (AValue shr 16 )); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('I'); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
end;

procedure THessian2Output.WriteLong(AValue: int64);
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

if (LONG_DIRECT_MIN <= AValue) and (AValue <= LONG_DIRECT_MAX) then
begin
FBuffer[FOffset] := Byte(AValue + LONG_ZERO); Inc(FOffset);
end
else if (LONG_BYTE_MIN <= AValue) and (AValue <= LONG_BYTE_MAX) then
begin
FBuffer[FOffset] := Byte(LONG_BYTE_ZERO + (AValue shr 8 )); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
else if (LONG_SHORT_MIN <= AValue) and (AValue <= LONG_SHORT_MAX) then
begin
FBuffer[FOffset] := Byte(LONG_SHORT_ZERO + (AValue shr 16)); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
else if (LONG_INT_MIN <= AValue) and (AValue <= LONG_INT_MAX) then
begin
FBuffer[FOffset] := Byte(LONG_INT_ZERO); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('L'); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 56); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 48); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 40); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 32); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(AValue); Inc(FOffset);
end
end;

procedure THessian2Output.WriteDouble(AValue: Double);
var
intValue: integer;
longValue: int64;
floatValue: single;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

if Int(AValue) = AValue then
begin // 只有整数部分
intValue := Round(AValue);
if intValue = 0 then
begin
FBuffer[FOffset] := Byte(DOUBLE_ZERO); Inc(FOffset);
exit;
end
else if intValue = 1 then
begin
FBuffer[FOffset] := Byte(DOUBLE_ONE); Inc(FOffset);
exit;
end
else if (-$80 <= intValue) and (intValue < $80) then
begin
FBuffer[FOffset] := Byte(DOUBLE_BYTE); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue); Inc(FOffset);
exit;
end
else if ($8000 <= intValue) and (intValue < $8000) then
begin
FBuffer[FOffset] := Byte(DOUBLE_SHORT); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue); Inc(FOffset);
exit;
end;
end;

floatValue := AValue;
if floatValue = AValue then
begin
FBuffer[FOffset] := Byte(DOUBLE_FLOAT); Inc(FOffset);
intValue := PInteger(@floatValue)^;
FBuffer[FOffset] := Byte(intValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(intValue); Inc(FOffset);
exit;
end;

FBuffer[FOffset] := Byte('D'); Inc(FOffset);
longValue := PInt64(@AValue)^;
FBuffer[FOffset] := Byte(longValue shr 56); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 48); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 40); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 32); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(longValue); Inc(FOffset);
end;

procedure THessian2Output.WriteBoolean(AValue: boolean);
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

if AValue then
begin
FBuffer[FOffset] := Byte('T'); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('F'); Inc(FOffset);
end
end;

procedure THessian2Output.WriteString(const AValue: WideString);
begin
_WriteString(AValue, 0, Length(AValue));
end;

procedure THessian2Output.WriteUTCDate(AValue: TDateTime);
var
UTCValue: int64;
begin
UTCValue := DateTimeToJavaDate(AValue);

if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('d'); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 56); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 48); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 40); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 32); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(UTCValue); Inc(FOffset);
end;

procedure THessian2Output.WriteNull;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('N'); Inc(FOffset);
end;

procedure THessian2Output.WriteBytes(ASourceStream: TStream);
begin
if ASourceStream = nil then
begin
WriteNull;
end
else begin
WriteBytes(ASourceStream, 0, ASourceStream.Size);
end;
end;

procedure THessian2Output.WriteBytes(ASourceStream: TStream; AOffset, ACount: integer);
var
sublen: integer;
N: integer;
begin
if ASourceStream = nil then
begin
WriteNull;
end
else begin
if AOffset > 0 then
begin
ASourceStream.Position := AOffset;
end
else begin
ASourceStream.Position := 0;
end;

if BUFFER_SIZE < FOffset + 16 then Flush;

while ACount > $8000 do
begin
FBuffer[FOffset] := Byte('b'); Inc(FOffset);
FBuffer[FOffset] := Byte($8000 shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte($8000); Inc(FOffset);

sublen := $8000;
while sublen > 0 do
begin
if sublen > (BUFFER_SIZE - FOffset) then N := BUFFER_SIZE - FOffset else N := sublen;
ASourceStream.ReadBuffer(FBuffer, N); Inc(FOffset, N);

// Flush
FStream.WriteBuffer(FBuffer, FOffset);
FOffset := 0;

Dec(sublen, N);
end;
ACount := ACount - $8000;
//AOffset := AOffset + $80000;
end;

if ACount < $10 then
begin
FBuffer[FOffset] := Byte(BYTES_DIRECT + ACount); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('B'); Inc(FOffset);
FBuffer[FOffset] := Byte(ACount shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(ACount); Inc(FOffset);
end;

while ACount > 0 do
begin
if ACount > (BUFFER_SIZE - FOffset) then N := BUFFER_SIZE - FOffset else N := ACount;
ASourceStream.ReadBuffer(FBuffer, N); Inc(FOffset, N);

// Flush
FStream.WriteBuffer(FBuffer, FOffset);
FOffset := 0;

Dec(ACount, N);
end;
end
end;

procedure THessian2Output.WriteMapBegin;
begin
WriteMapBegin('');
end;

procedure THessian2Output.WriteMapBegin(const AType: WideString);
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('M'); Inc(FOffset);
WriteType(AType);
end;

procedure THessian2Output.WriteMapEnd;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('z'); Inc(FOffset);
end;

function THessian2Output.WriteListBegin(ALength: integer): boolean;
begin
result := WriteListBegin(ALength, '');
end;

function THessian2Output.WriteListBegin(ALength: integer; const AType: WideString): boolean;
var
refV: integer;
begin
if _typeRefs <> nil then
begin
refV := _typeRefs.IndexOf(AType);
if refV >= 0 then
begin
refV := Integer(_typeRefs.Objects[refV]);

if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte(LIST_FIXED); Inc(FOffset);

WriteInt(refV);
WriteInt(ALength);

result := false;
exit;
end
end;

if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('V'); Inc(FOffset);
WriteType(AType);

if BUFFER_SIZE < FOffset + 16 then Flush;

if ALength < 0 then
begin
end
else if ALength < $100 then
begin
FBuffer[FOffset] := Byte(LENGTH_BYTE); Inc(FOffset);
FBuffer[FOffset] := Byte(ALength); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('l'); Inc(FOffset);
FBuffer[FOffset] := Byte(ALength shr 24); Inc(FOffset);
FBuffer[FOffset] := Byte(ALength shr 16); Inc(FOffset);
FBuffer[FOffset] := Byte(ALength shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(ALength); Inc(FOffset);
end;
result := True;
end;

procedure THessian2Output.WriteListEnd;
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('z'); Inc(FOffset);
end;

procedure THessian2Output._WriteString(const AValue: WideString; AOffset, ACount: integer);
var
sublen: integer;
tail: integer;
begin
while ACount > $8000 do
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

sublen := $8000;
// chunk can't end in high surrogate
tail := Integer(AValue[AOffset + sublen - 1]);
if ($D800 <= tail) and (tail <= $DBFF) then dec(sublen);

FBuffer[FOffset] := Byte('s'); Inc(FOffset);
FBuffer[FOffset] := Byte(sublen shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(sublen); Inc(FOffset);

PrintString(AValue, AOffset, sublen);

ACount := ACount - sublen;
AOffset := AOffset + sublen;
end;

if BUFFER_SIZE < FOffset + 16 then Flush;

if ACount <= STRING_DIRECT_MAX then
begin
FBuffer[FOffset] := Byte(STRING_DIRECT + ACount); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte('S'); Inc(FOffset);
FBuffer[FOffset] := Byte(ACount shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(ACount); Inc(FOffset);
end;
PrintString(AValue, AOffset, ACount);
end;

procedure THessian2Output.WriteType(const AType: WideString);
var
Len: integer;
typeRefV: integer;
begin
Len := Length(AType);
if Len = 0 then exit;

if _typeRefs = nil then
begin
_typeRefs := TStringList.Create;
end;

typeRefV := _typeRefs.IndexOf(AType);
if typeRefV >= 0 then
begin
typeRefV := Integer(_typeRefs.Objects[typeRefV]);

if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte(TYPE_REF); Inc(FOffset);

writeInt(typeRefV);
end
else begin
_typeRefs.AddObject(AType, TObject(_typeRefs.Count));

if BUFFER_SIZE < FOffset + 16 then Flush;

FBuffer[FOffset] := Byte('t'); Inc(FOffset);
FBuffer[FOffset] := Byte(Len shr 8 ); Inc(FOffset);
FBuffer[FOffset] := Byte(Len); Inc(FOffset);
PrintString(AType, 0, Len);
end
end;

procedure THessian2Output.PrintString(const AValue: WideString; AOffset, ACount: integer);
var
I: integer;
ch: integer;
begin
for i := 1 to ACount do
begin
if BUFFER_SIZE < FOffset + 16 then Flush;

// encoded as UTF-8
ch := Integer(AValue[i + AOffset]);
if ch < $80 then
begin
FBuffer[FOffset] := Byte(ch); Inc(FOffset);
end
else if ch < $800 then
begin
FBuffer[FOffset] := Byte($C0 + ((ch shr 6) and $1F)); Inc(FOffset);
FBuffer[FOffset] := Byte($80 + (ch and $3F)); Inc(FOffset);
end
else begin
FBuffer[FOffset] := Byte($E0 + ((ch shr 12) and $F)); Inc(FOffset);
FBuffer[FOffset] := Byte($80 + ((ch shr 6) and $3F)); Inc(FOffset);
FBuffer[FOffset] := Byte($80 + (ch and $3F)); Inc(FOffset);
end
end
end;

procedure THessian2Output.Flush;
var
offset: integer;
begin
offset := FOffset;
if offset > 0 then
begin
FOffset := 0;
FStream.WriteBuffer(FBuffer, offset);
end
end;
end.
[/code]