📄 superstream.pas
字号:
readFixed(ptr^, sizeof(Char) * counts[i]);
vtExtended:
readFixed(ptr^, sizeof(Extended) * counts[i]);
ssvtSingle:
readFixed(ptr^, sizeof(Single) * counts[i]);
ssvtDouble:
readFixed(ptr^, sizeof(Double) * counts[i]);
vtString:
begin
psa := PStringArray(ptr);
for item := 1 to counts[i] do
begin
readFixed(psa^[item][0], sizeof(psa^[item][0]));
if Ord(psa^[item][0]) > 0 then
readFixed(psa^[item][1], Ord(psa^[item][0]));
end;
end;
vtPointer:
raise TObjStreamException.Create('Can''t stream raw pointers.');
vtPChar:
begin
// We're going to assume this is a pointer to a null-terminated string.
for item := 1 to counts[i] do
begin
pptr := PPChar(ptr);
readFixed(len, sizeof(len));
pptr^[0] := chr(len);
readFixed(pptr^[1], len);
ptr := ptr + sizeof(ShortString);
end;
end;
vtObject:
begin
for item := 1 to counts[i] do
begin
PObject(ptr)^ := ReadObject;
ptr := ptr + sizeof(Pointer);
end;
end;
vtClass:
raise TObjStreamException.Create('Can''t write class objects.');
vtWideChar:
readFixed(ptr^, sizeof(WideChar) * counts[i]);
vtPWideChar:
raise TObjStreamException.Create('Pointers to wide char not supported yet.');
vtAnsiString:
begin
pasa := PAnsiStringArray(ptr);
for item := 1 to counts[i] do
begin
readFixed(len, sizeof(len));
SetLength(pasa^[item], len);
UniqueString(pasa^[item]);
if len > 0 then
readFixed(pasa^[item][1], len);
end;
end;
vtCurrency:
readFixed(ptr^, sizeof(Currency) * counts[i]);
vtVariant:
raise TObjStreamException.Create('Variant not supported yet.');
vtInterface:
raise TObjStreamException.Create('Interface not supported yet.');
vtWideString:
begin
raise TObjStreamException.Create('Wide string not supported yet.');
end;
{$IFDEF DELPHI4}
vtInt64:
begin
readfixed(ptr^, sizeof(int64) * counts[i]);
end;
{$ENDIF}
end;
end;
end;
end;
procedure TObjStream.TransferItems(
items : array of const;
itemAddresses : array of pointer;
direction : TObjIODirection;
var version : Integer);
var
i: integer;
begin
DoHeaderTransfer;
assert(High(itemAddresses) = High(items), 'The number of addresses must match the number of items');
for i := Low(items) to High(items) do with items[i] do
TransferItem(items[i], itemAddresses[i], direction);
end;
procedure TObjStream.TransferVarRec(var item : TVarRec; direction : TObjIODirection);
var _type : SmallInt;
begin
if direction = iodirRead then
begin
item.vtype := 0;
item.vinteger := 0;
with item do
begin
read(_type, Sizeof(_type));
item.Vtype := _type;
case _type of
vtInteger:
TransferItem(item, @VInteger, direction);
vtBoolean:
TransferItem(item, @VBoolean, direction);
vtChar:
TransferItem(item, @VChar, direction);
vtExtended:
begin
GetMem(VExtended, sizeof(extended));
TransferItem(item, VExtended, direction);
end;
vtString:
TransferItem(item, @VString, direction);
vtPointer:
raise TObjStreamException.Create('Can''t stream raw pointers.');
vtPChar:
TransferItem(item, @VPChar, direction);
vtObject:
TransferItem(item, @VObject, direction);
vtClass:
raise TObjStreamException.Create('Can''t write class objects.');
vtWideChar:
TransferItem(item, @VWideChar, direction);
vtPWideChar:
raise TObjStreamException.Create('Pointers to wide char not supported yet.');
vtAnsiString:
TransferItem(item, @VAnsiString, direction);
vtCurrency:
begin
GetMem(VCurrency, sizeof(currency));
TransferItem(item, VCurrency, direction);
end;
vtVariant:
raise TObjStreamException.Create('Variant not supported yet.');
vtInterface:
raise TObjStreamException.Create('Interface not supported yet.');
vtWideString:
begin
TransferItem(item, @VWideString, direction);
end;
{$IFDEF DELPHI4}
vtInt64:
begin
Getmem(VInt64, sizeof(int64));
TransferItem(item, vint64, direction);
end;
{$ENDIF}
end;
end;
end
else
begin
_type := item.VType;
write(_type, sizeof(_type));
TransferItem(item, nil, direction);
end;
end;
procedure TObjStream.TransferItem(const item : TVarRec; itemAddress : Pointer; direction : TObjIODirection);
begin
TransferItemEx(item, itemAddress, item.VType, direction);
end;
procedure TObjStream.TransferItemEx(const item : TVarRec; itemAddress : Pointer; ItemType : Integer; direction : TObjIODirection);
type
PShortString = ^ShortString;
PString = ^String;
PPChar = ^PChar;
PObject = ^TObject;
PCurrency = ^Currency;
PInteger = ^Integer;
var len : Integer;
ss : PShortString;
pc : PPChar;
po : PObject;
ps : PString;
ptr : PChar;
pi : PInteger;
begin
with item do
if direction = iodirWrite then
begin
case itemType of
vtInteger:
write(VInteger, sizeof(VInteger));
vtBoolean:
write(VBoolean, sizeof(VBoolean));
vtChar:
write(VChar, sizeof(VChar));
vtExtended:
write(VExtended^, sizeof(VExtended^));
ssvtSingle:
begin
ptr := PChar(itemAddress);
write(ptr^, sizeof(Single));
end;
ssvtDouble:
begin
ptr := PChar(itemAddress);
write(ptr^, sizeof(Double));
end;
vtString:
begin
write(VString^[0], sizeof(VString^[0]));
if Length(VString^) > 0 then
write(VString^[1], Ord(VString^[0]));
end;
vtPointer:
raise TObjStreamException.Create('Can''t stream raw pointers.');
vtPChar:
begin
// We're going to assume this is a pointer to a null-terminated string.
len := StrLen(VPChar);
write(len, sizeof(len));
write(VPChar^, len);
end;
vtObject:
WriteObject(VObject);
vtClass:
raise TObjStreamException.Create('Can''t write class objects.');
vtWideChar:
write(VWideChar, sizeof(VWideChar));
vtPWideChar:
raise TObjStreamException.Create('Pointers to wide char not supported yet.');
vtAnsiString:
begin
if VAnsiString = nil then
len := 0
else
len := Length(String(VAnsiString));
write(len, sizeof(len));
if len > 0 then
write(String(VAnsiString)[1], len);
end;
vtCurrency:
write(VCurrency, sizeof(VCurrency));
vtVariant:
raise TObjStreamException.Create('Variant not supported yet.');
vtInterface:
raise TObjStreamException.Create('Interface not supported yet.');
vtWideString:
begin
len := Length(WideString(VWideString)) * 2;
write(len, sizeof(len));
if len > 0 then write(WideString(VWideString)[1], len);
end;
{$IFDEF DELPHI4}
vtInt64:
write(VInt64, sizeof(int64));
{$ENDIF}
end;
end
else
begin
case itemType of
vtInteger:
readFixed(PChar(itemAddress)^, sizeof(VInteger));
vtBoolean:
readFixed(PChar(itemAddress)^, sizeof(VBoolean));
vtChar:
readFixed(PChar(itemAddress)^, sizeof(VChar));
vtExtended:
readFixed(PChar(itemAddress)^, sizeof(VExtended^));
ssvtSingle:
readFixed(PChar(itemAddress)^, sizeof(Single));
ssvtDouble:
readFixed(PChar(itemAddress)^, sizeof(Double));
vtString:
begin
ss := PShortString(itemAddress);
readFixed(ss^[0], 1);
readFixed(ss^[1], Ord(ss^[0]));
end;
vtPointer:
raise TObjStreamException.Create('Can''t read in pointers.');
vtPChar:
begin
// we'll allocate a pointer to a null terminated string.
pc := PPChar(itemAddress);
readFixed(len, sizeof(len)); // get length
pc^ := StrAlloc(len + 1); // allocate space
readFixed(pc^^, len); // read data
(pc^ + len)^ := chr(0); // add null terminator
end;
vtObject:
begin
po := PObject(itemAddress);
po^ := readObject;
end;
vtClass:
raise TObjStreamException.Create('Can''t read in class objects.');
vtWideChar:
readFixed(PWideChar(itemAddress)^, sizeof(WideChar));
vtPWideChar:
raise TObjStreamException.Create('Can''t read in pointers to wide char.');
vtAnsiString:
begin
readFixed(len, sizeof(len));
ps := PString(itemAddress);
pi := PInteger(itemAddress);
if len > 0 then
begin
UniqueString(ps^);
SetLength(ps^, len);
readFixed(ps^[1], len);
end
else
pi^ := 0;
end;
vtCurrency:
readFixed(PCurrency(itemAddress)^, sizeof(Currency));
vtVariant:
raise TObjStreamException.Create('Can''t read in variants.');
vtInterface:
raise TObjStreamException.Create('Can''t read in interfaces.');
vtWideString:
raise TObjStreamException.Create('Can''t read in wide strings.');
{$IFDEF DELPHI4}
vtInt64:
readFixed(PInt64(itemAddress)^, sizeof(int64));
{$ENDIF}
end;
end;
end;
procedure TObjStream.TransferItemsEx(
items : array of const;
itemAddresses : array of pointer;
itemTypes : array of Integer;
direction : TObjIODirection;
var version : Integer);
type
PShortString = ^ShortString;
PString = ^String;
PPChar = ^PChar;
PObject = ^TObject;
PCurrency = ^Currency;
var i : Integer;
itemType : Integer;
begin
DoHeaderTransfer;
assert(High(itemAddresses) = High(items), 'Number of addresses must match number of items');
for i := Low(items) to High(items) do
begin
if (i <= High(itemTypes)) and (itemTypes[i] <> ssvtNone) then
itemType := itemTypes[i]
else
itemType := items[i].VType;
TransferItemEx(items[i], itemAddresses[i], itemType, direction);
end;
end;
constructor TObjStream.Create(stream : TStream; owned : Boolean; options : TObjStreamOptions);
begin
inherited Create(stream, owned);
FHeaderTransferred := false;
FOptions := options;
if osoGraph in options then
FObjList := TList.Create
else
FObjList := nil;
end;
constructor TObjStream.CreateOnFile(const fn : String; options : TObjStreamOptions; dir : TObjIODirection);
var fs : TFileStream;
bi : TBufferedInputStream;
bo : TBufferedOutputStream;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -