david
0e3448cd2f
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@25 05c56307-c608-d34a-929d-697000501d7a
1201 lines
31 KiB
ObjectPascal
1201 lines
31 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressDataController }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL }
|
|
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{********************************************************************}
|
|
|
|
unit cxVariants;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes{$IFDEF DELPHI6}, Variants{$ENDIF};
|
|
|
|
type
|
|
LargeInt = Int64;
|
|
{$IFNDEF DELPHI6}
|
|
TVarType = Word;
|
|
{$ENDIF}
|
|
TVariantArray = array of Variant;
|
|
|
|
{ Read/Write }
|
|
|
|
TcxFiler = class
|
|
private
|
|
FStream: TStream;
|
|
public
|
|
constructor Create(AStream: TStream);
|
|
property Stream: TStream read FStream;
|
|
end;
|
|
|
|
TcxReader = class(TcxFiler)
|
|
public
|
|
function ReadBoolean: Boolean;
|
|
function ReadByte: Byte;
|
|
function ReadCardinal: Cardinal;
|
|
function ReadChar: Char;
|
|
function ReadCurrency: Currency;
|
|
function ReadDateTime: TDateTime;
|
|
function ReadFloat: Extended;
|
|
function ReadInteger: Integer;
|
|
function ReadLargeInt: LargeInt;
|
|
function ReadShortInt: ShortInt;
|
|
function ReadSingle: Single;
|
|
function ReadSmallInt: SmallInt;
|
|
function ReadString: string;
|
|
function ReadVariant: Variant;
|
|
function ReadWideString: WideString;
|
|
function ReadWord: Word;
|
|
end;
|
|
|
|
TcxWriter = class(TcxFiler)
|
|
public
|
|
procedure WriteBoolean(AValue: Boolean);
|
|
procedure WriteByte(AValue: Byte);
|
|
procedure WriteCardinal(AValue: Cardinal);
|
|
procedure WriteChar(AValue: Char);
|
|
procedure WriteCurrency(AValue: Currency);
|
|
procedure WriteDateTime(AValue: TDateTime);
|
|
procedure WriteFloat(AValue: Extended);
|
|
procedure WriteInteger(AValue: Integer);
|
|
procedure WriteLargeInt(AValue: LargeInt);
|
|
procedure WriteShortInt(AValue: ShortInt);
|
|
procedure WriteSingle(AValue: Single);
|
|
procedure WriteSmallInt(AValue: SmallInt);
|
|
procedure WriteString(const S: string);
|
|
procedure WriteVariant(const AValue: Variant);
|
|
procedure WriteWideString(const S: WideString);
|
|
procedure WriteWord(AValue: Word);
|
|
end;
|
|
|
|
function VarCompare(const V1, V2: Variant): Integer;
|
|
function VarEquals(const V1, V2: Variant): Boolean;
|
|
function VarEqualsExact(const V1, V2: Variant): Boolean;
|
|
function VarEqualsSoft(const V1, V2: Variant): Boolean;
|
|
function VarIndex(const AList: TVariantArray; const AValue: Variant): Integer;
|
|
function VarIsDate(const AValue: Variant): Boolean;
|
|
function VarIsNumericEx(const AValue: Variant): Boolean;
|
|
function VarIsSoftNull(const AValue: Variant): Boolean;
|
|
function VarToStrEx(const V: Variant): string;
|
|
function VarTypeIsCurrency(AVarType: TVarType): Boolean;
|
|
{$IFNDEF DELPHI6}
|
|
function FindVarData(const V: Variant): PVarData;
|
|
function VarIsFloat(const AValue: Variant): Boolean;
|
|
function VarIsNumeric(const AValue: Variant): Boolean;
|
|
function VarIsOrdinal(const AValue: Variant): Boolean;
|
|
function VarIsStr(const AValue: Variant): Boolean;
|
|
function VarIsType(const AValue: Variant; AVarType: TVarType): Boolean;
|
|
function VarSameValue(const V1, V2: Variant): Boolean;
|
|
{$ENDIF}
|
|
function VarBetweenArrayCreate(const AValue1, AValue2: Variant): Variant;
|
|
function VarListArrayCreate(const AValue: Variant): Variant;
|
|
procedure VarListArrayAddValue(var Value: Variant; const AValue: Variant);
|
|
|
|
function ReadStringFunc(AStream: TStream): string;
|
|
procedure ReadStringProc(AStream: TStream; var S: string);
|
|
procedure WriteStringProc(AStream: TStream; const S: string);
|
|
|
|
function ReadWideStringFunc(AStream: TStream): WideString;
|
|
procedure ReadWideStringProc(AStream: TStream; var S: WideString);
|
|
procedure WriteWideStringProc(AStream: TStream; const S: WideString);
|
|
|
|
function ReadVariantFunc(AStream: TStream): Variant;
|
|
procedure ReadVariantProc(AStream: TStream; var Value: Variant);
|
|
procedure WriteVariantProc(AStream: TStream; const AValue: Variant);
|
|
|
|
function ReadBooleanFunc(AStream: TStream): Boolean;
|
|
procedure ReadBooleanProc(AStream: TStream; var Value: Boolean);
|
|
procedure WriteBooleanProc(AStream: TStream; AValue: Boolean);
|
|
|
|
function ReadCharFunc(AStream: TStream): Char;
|
|
procedure ReadCharProc(AStream: TStream; var Value: Char);
|
|
procedure WriteCharProc(AStream: TStream; AValue: Char);
|
|
|
|
function ReadFloatFunc(AStream: TStream): Extended;
|
|
procedure ReadFloatProc(AStream: TStream; var Value: Extended);
|
|
procedure WriteFloatProc(AStream: TStream; AValue: Extended);
|
|
|
|
function ReadSingleFunc(AStream: TStream): Single;
|
|
procedure ReadSingleProc(AStream: TStream; var Value: Single);
|
|
procedure WriteSingleProc(AStream: TStream; AValue: Single);
|
|
|
|
function ReadCurrencyFunc(AStream: TStream): Currency;
|
|
procedure ReadCurrencyProc(AStream: TStream; var Value: Currency);
|
|
procedure WriteCurrencyProc(AStream: TStream; AValue: Currency);
|
|
|
|
function ReadDateTimeFunc(AStream: TStream): TDateTime;
|
|
procedure ReadDateTimeProc(AStream: TStream; var Value: TDateTime);
|
|
procedure WriteDateTimeProc(AStream: TStream; AValue: TDateTime);
|
|
|
|
function ReadIntegerFunc(AStream: TStream): Integer;
|
|
procedure ReadIntegerProc(AStream: TStream; var Value: Integer);
|
|
procedure WriteIntegerProc(AStream: TStream; AValue: Integer);
|
|
|
|
function ReadLargeIntFunc(AStream: TStream): LargeInt;
|
|
procedure ReadLargeIntProc(AStream: TStream; var Value: LargeInt);
|
|
procedure WriteLargeIntProc(AStream: TStream; AValue: LargeInt);
|
|
|
|
function ReadByteFunc(AStream: TStream): Byte;
|
|
procedure ReadByteProc(AStream: TStream; var Value: Byte);
|
|
procedure WriteByteProc(AStream: TStream; AValue: Byte);
|
|
|
|
function ReadSmallIntFunc(AStream: TStream): SmallInt;
|
|
procedure ReadSmallIntProc(AStream: TStream; var Value: SmallInt);
|
|
procedure WriteSmallIntProc(AStream: TStream; AValue: SmallInt);
|
|
|
|
function ReadCardinalFunc(AStream: TStream): Cardinal;
|
|
procedure ReadCardinalProc(AStream: TStream; var Value: Cardinal);
|
|
procedure WriteCardinalProc(AStream: TStream; AValue: Cardinal);
|
|
|
|
function ReadShortIntFunc(AStream: TStream): ShortInt;
|
|
procedure ReadShortIntProc(AStream: TStream; var Value: ShortInt);
|
|
procedure WriteShortIntProc(AStream: TStream; AValue: ShortInt);
|
|
|
|
function ReadWordFunc(AStream: TStream): Word;
|
|
procedure ReadWordProc(AStream: TStream; var Value: Word);
|
|
procedure WriteWordProc(AStream: TStream; AValue: Word);
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFNDEF NONDB}
|
|
{$IFDEF DELPHI6}
|
|
FMTBcd, SqlTimSt,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Windows, cxDataConsts;
|
|
|
|
function VarArrayCompare(const V1, V2: Variant): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if VarIsArray(V1) and VarIsArray(V2) then
|
|
begin
|
|
Result := VarArrayHighBound(V1, 1) - VarArrayHighBound(V2, 1);
|
|
if Result = 0 then
|
|
begin
|
|
for I := 0 to VarArrayHighBound(V1, 1) do
|
|
begin
|
|
Result := VarCompare(V1[I], V2[I]);
|
|
if Result <> 0 then
|
|
Break;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if VarIsArray(V1) then
|
|
Result := 1
|
|
else
|
|
if VarIsArray(V2) then
|
|
Result := -1
|
|
else
|
|
Result := VarCompare(V1, V2);
|
|
end;
|
|
|
|
function VarCompare(const V1, V2: Variant): Integer;
|
|
|
|
function CompareValues(const V1, V2: Variant): Integer;
|
|
begin
|
|
try
|
|
if VarIsEmpty(V1) then
|
|
if VarIsEmpty(V2) then
|
|
Result := 0
|
|
else
|
|
Result := -1
|
|
else
|
|
if VarIsEmpty(V2) then
|
|
Result := 1
|
|
else
|
|
if V1 = V2 then
|
|
Result := 0
|
|
else
|
|
{$IFDEF DELPHI6}
|
|
if VarIsNull(V1) then
|
|
Result := -1
|
|
else
|
|
if VarIsNull(V2) then
|
|
Result := 1
|
|
else
|
|
{$ENDIF}
|
|
if V1 < V2 then
|
|
Result := -1
|
|
else
|
|
Result := 1;
|
|
except
|
|
on EVariantError do
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{$IFDEF DELPHI6}
|
|
{$IFNDEF DELPHI7}
|
|
if (VarType(V1) = varString) and (VarType(V2) = varString) then
|
|
Result := CompareStr(V1, V2)
|
|
else
|
|
if (VarType(V1) = varDate) and (VarType(V2) = varDate) then
|
|
Result := CompareValues(Double(V1), Double(V2))
|
|
else
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
if VarIsArray(V1) or VarIsArray(V2) then
|
|
Result := VarArrayCompare(V1, V2)
|
|
else
|
|
Result := CompareValues(V1, V2);
|
|
end;
|
|
|
|
function VarEquals(const V1, V2: Variant): Boolean;
|
|
begin
|
|
Result := VarCompare(V1, V2) = 0;
|
|
end;
|
|
|
|
function VarEqualsExact(const V1, V2: Variant): Boolean;
|
|
var
|
|
AVarType1, AVarType2: Integer;
|
|
AValue1, AValue2: Variant;
|
|
begin
|
|
AVarType1 := VarType(V1);
|
|
AVarType2 := VarType(V2);
|
|
if (AVarType1 = varNull) or (AVarType2 = varNull) or
|
|
((AVarType1 <> varBoolean) and (AVarType2 <> varBoolean)) then
|
|
Result := VarEquals(V1, V2)
|
|
else
|
|
try
|
|
VarCast(AValue1, V1, varString);
|
|
VarCast(AValue2, V2, varString);
|
|
Result := AValue1 = AValue2;
|
|
except
|
|
on EVariantError do
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function VarEqualsSoft(const V1, V2: Variant): Boolean;
|
|
begin
|
|
Result := VarEquals(V1, V2) or (VarIsSoftNull(V1) and VarIsSoftNull(V2));
|
|
end;
|
|
|
|
function VarIndex(const AList: TVariantArray; const AValue: Variant): Integer;
|
|
begin
|
|
for Result := 0 to Length(AList) - 1 do
|
|
if VarEquals(AList[Result], AValue) then Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
function FindVarData(const V: Variant): PVarData;
|
|
begin
|
|
Result := @TVarData(V);
|
|
while Result.VType = varByRef or varVariant do
|
|
Result := PVarData(Result.VPointer);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function VarIsDate(const AValue: Variant): Boolean;
|
|
|
|
function VarTypeIsDate(const AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := (AVarType = varDate)
|
|
{$IFNDEF NONDB}{$IFDEF DELPHI6} or (AVarType = VarSQLTimeStamp){$ENDIF}{$ENDIF};
|
|
end;
|
|
|
|
begin
|
|
Result := VarTypeIsDate(FindVarData(AValue)^.VType);
|
|
end;
|
|
|
|
function VarIsNumericEx(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarIsNumeric(AValue)
|
|
{$IFNDEF NONDB}{$IFDEF DELPHI6} or
|
|
(FindVarData(AValue)^.VType = VarFMTBcd)
|
|
{$ENDIF}{$ENDIF};
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
function VarIsType(const AValue: Variant; AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := FindVarData(AValue)^.VType = AVarType;
|
|
end;
|
|
|
|
function VarTypeIsOrdinal(const AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := AVarType in [varSmallInt, varInteger, varBoolean, varByte];
|
|
end;
|
|
|
|
function VarIsOrdinal(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarTypeIsOrdinal(FindVarData(AValue)^.VType);
|
|
end;
|
|
|
|
function VarTypeIsFloat(const AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := AVarType in [varSingle, varDouble, varCurrency];
|
|
end;
|
|
|
|
function VarIsFloat(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarTypeIsFloat(FindVarData(AValue)^.VType);
|
|
end;
|
|
|
|
function VarTypeIsNumeric(const AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := VarTypeIsOrdinal(AVarType) or VarTypeIsFloat(AVarType);
|
|
end;
|
|
|
|
function VarIsNumeric(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarTypeIsNumeric(FindVarData(AValue)^.VType);
|
|
end;
|
|
|
|
function VarTypeIsStr(const AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := (AVarType = varString) or (AVarType = varOleStr);
|
|
end;
|
|
|
|
function VarIsStr(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarTypeIsStr(FindVarData(AValue)^.VType);
|
|
end;
|
|
|
|
function VarSameValue(const V1, V2: Variant): Boolean;
|
|
var
|
|
D1, D2: TVarData;
|
|
begin
|
|
D1 := FindVarData(V1)^;
|
|
D2 := FindVarData(V2)^;
|
|
if D1.VType = varEmpty then
|
|
Result := D2.VType = varEmpty
|
|
else
|
|
if D1.VType = varNull then
|
|
Result := D2.VType = varNull
|
|
else
|
|
if D2.VType in [varEmpty, varNull] then
|
|
Result := False
|
|
else
|
|
Result := V1 = V2;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function VarIsSoftNull(const AValue: Variant): Boolean;
|
|
begin
|
|
Result := VarIsNull(AValue) or
|
|
({(VarType(AValue) = varString)}VarIsStr(AValue) and (AValue = ''));
|
|
end;
|
|
|
|
function VarToStrEx(const V: Variant): string;
|
|
begin
|
|
Result := VarToStr(V);
|
|
{$IFNDEF DELPHI6}
|
|
if VarType(V) = varDouble then
|
|
Result := StringReplace(Result, GetLocaleChar(GetThreadLocale, LOCALE_SDECIMAL, '.'),
|
|
DecimalSeparator, []);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function VarTypeIsCurrency(AVarType: TVarType): Boolean;
|
|
begin
|
|
Result := (AVarType = varCurrency)
|
|
{$IFNDEF NONDB}
|
|
{$IFDEF DELPHI6} or (AVarType = VarFMTBcd){$ENDIF}
|
|
{$ENDIF};
|
|
end;
|
|
|
|
function VarBetweenArrayCreate(const AValue1, AValue2: Variant): Variant;
|
|
begin
|
|
Result := VarArrayCreate([0, 1], varVariant);
|
|
Result[0] := AValue1;
|
|
Result[1] := AValue2;
|
|
end;
|
|
|
|
function VarListArrayCreate(const AValue: Variant): Variant;
|
|
begin
|
|
Result := VarArrayCreate([0, 0], varVariant);
|
|
Result[0] := AValue;
|
|
end;
|
|
|
|
procedure VarListArrayAddValue(var Value: Variant; const AValue: Variant);
|
|
var
|
|
V: Variant;
|
|
I, C: Integer;
|
|
begin
|
|
C := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 2;
|
|
V := VarArrayCreate([0, C - 1], varVariant);
|
|
for I := VarArrayLowBound(Value, 1) to VarArrayHighBound(Value, 1) do
|
|
V[I] := Value[I];
|
|
V[C - 1] := AValue;
|
|
Value := V;
|
|
end;
|
|
|
|
// Stream routines
|
|
|
|
function ReadStringFunc(AStream: TStream): string;
|
|
begin
|
|
ReadStringProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadStringProc(AStream: TStream; var S: string);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
AStream.ReadBuffer(L, SizeOf(L));
|
|
SetLength(S, L);
|
|
AStream.ReadBuffer(Pointer(S)^, L);
|
|
end;
|
|
|
|
procedure WriteStringProc(AStream: TStream; const S: string);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
L := Length(S);
|
|
AStream.WriteBuffer(L, SizeOf(L));
|
|
AStream.WriteBuffer(S[1], L);
|
|
end;
|
|
|
|
function ReadWideStringFunc(AStream: TStream): WideString;
|
|
begin
|
|
ReadWideStringProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadWideStringProc(AStream: TStream; var S: WideString);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
AStream.ReadBuffer(L, SizeOf(L));
|
|
SetLength(S, L);
|
|
AStream.ReadBuffer(Pointer(S)^, L * 2);
|
|
end;
|
|
|
|
procedure WriteWideStringProc(AStream: TStream; const S: WideString);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
L := Length(S);
|
|
AStream.WriteBuffer(L, SizeOf(L));
|
|
AStream.WriteBuffer(Pointer(S)^, L * 2);
|
|
end;
|
|
|
|
function ReadVariantFunc(AStream: TStream): Variant;
|
|
begin
|
|
ReadVariantProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadVariantProc(AStream: TStream; var Value: Variant);
|
|
const
|
|
ValTtoVarT: array[TValueType] of Integer = (varNull, varError,
|
|
{$IFNDEF DELPHI6}varByte{$ELSE}varShortInt{$ENDIF},
|
|
varSmallInt, varInteger, varDouble, varString, varError, varBoolean,
|
|
varBoolean, varError, varError, varString, varEmpty, varError, varSingle,
|
|
varCurrency, varDate, varOleStr,
|
|
{$IFDEF DELPHI6}varInt64{$ELSE}varError{$ENDIF}
|
|
{$IFDEF DELPHI6}, varError {$IFDEF DELPHI8}, varDouble{$ENDIF}{$ENDIF});
|
|
var
|
|
ValType: TValueType;
|
|
|
|
function ReadValue: TValueType;
|
|
var
|
|
B: Byte;
|
|
begin
|
|
AStream.ReadBuffer(B, SizeOf(Byte));
|
|
Result := TValueType(B);
|
|
end;
|
|
|
|
function ReadInteger: LargeInt;
|
|
var
|
|
SH: Shortint;
|
|
SM: Smallint;
|
|
I: Integer;
|
|
begin
|
|
case ValType of
|
|
vaInt8:
|
|
begin
|
|
AStream.ReadBuffer(SH, SizeOf(SH));
|
|
Result := SH;
|
|
end;
|
|
vaInt16:
|
|
begin
|
|
AStream.ReadBuffer(SM, SizeOf(SM));
|
|
Result := SM;
|
|
end;
|
|
{$IFDEF DELPHI6}
|
|
vaInt32:
|
|
{$ELSE}
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
AStream.ReadBuffer(I, SizeOf(I));
|
|
Result := I;
|
|
end
|
|
{$IFDEF DELPHI6}
|
|
else // vaInt64
|
|
AStream.ReadBuffer(Result, SizeOf(Result));
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function ReadFloat: Extended;
|
|
begin
|
|
AStream.ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function ReadSingle: Single;
|
|
begin
|
|
AStream.ReadBuffer(Result, SizeOf(Result));
|
|
end;
|
|
|
|
function ReadCurrency: Currency;
|
|
begin
|
|
ReadCurrencyProc(AStream, Result);
|
|
end;
|
|
|
|
function ReadDate: TDateTime;
|
|
begin
|
|
ReadDateTimeProc(AStream, Result);
|
|
end;
|
|
|
|
function ReadString: string;
|
|
var
|
|
L: Integer;
|
|
begin
|
|
L := 0;
|
|
case ValType of
|
|
vaString:
|
|
AStream.ReadBuffer(L, SizeOf(Byte));
|
|
else {vaLString}
|
|
AStream.ReadBuffer(L, SizeOf(Integer));
|
|
end;
|
|
SetString(Result, PChar(nil), L);
|
|
AStream.ReadBuffer(Pointer(Result)^, L);
|
|
end;
|
|
|
|
function ReadWideString: WideString;
|
|
begin
|
|
ReadWideStringProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadArrayProc(var Value: Variant);
|
|
var
|
|
I, C: Integer;
|
|
V: Variant;
|
|
begin
|
|
// read size
|
|
ValType := ReadValue; // len
|
|
C := ReadInteger;
|
|
// read values
|
|
Value := VarArrayCreate([0, C - 1], varVariant);
|
|
for I := 0 to C - 1 do
|
|
begin
|
|
ReadVariantProc(AStream, V);
|
|
Value[I] := V;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ValType := ReadValue;
|
|
if ValType = vaList then
|
|
begin
|
|
ReadArrayProc(Value);
|
|
Exit;
|
|
end;
|
|
case ValType of
|
|
vaNil:
|
|
VarClear(Value);
|
|
vaNull:
|
|
Value := Null;
|
|
vaInt8:
|
|
{$IFNDEF DELPHI6}
|
|
TVarData(Value).VByte := Byte(ReadInteger);
|
|
{$ELSE}
|
|
TVarData(Value).VShortInt := ShortInt(ReadInteger);
|
|
{$ENDIF}
|
|
vaInt16:
|
|
TVarData(Value).VSmallint := Smallint(ReadInteger);
|
|
vaInt32:
|
|
TVarData(Value).VInteger := ReadInteger;
|
|
{$IFDEF DELPHI6}
|
|
vaInt64:
|
|
TVarData(Value).VInt64 := ReadInteger;
|
|
{$ENDIF}
|
|
vaExtended:
|
|
TVarData(Value).VDouble := ReadFloat;
|
|
vaString, vaLString:
|
|
Value := ReadString;
|
|
vaFalse, vaTrue:
|
|
TVarData(Value).VBoolean := ValType = vaTrue;
|
|
vaWString:
|
|
Value := ReadWideString;
|
|
vaSingle:
|
|
TVarData(Value).VSingle := ReadSingle;
|
|
vaCurrency:
|
|
TVarData(Value).VCurrency := ReadCurrency;
|
|
vaDate:
|
|
TVarData(Value).VDate := ReadDate;
|
|
else
|
|
raise EReadError.Create(cxSDataReadError);
|
|
end;
|
|
TVarData(Value).VType := ValTtoVarT[ValType];
|
|
end;
|
|
|
|
procedure WriteVariantProc(AStream: TStream; const AValue: Variant);
|
|
|
|
procedure WriteValue(Value: TValueType);
|
|
begin
|
|
AStream.WriteBuffer(Byte(Value), SizeOf(Byte));
|
|
end;
|
|
|
|
procedure WriteInteger(Value: {$IFDEF DELPHI6}LargeInt{$ELSE}Integer{$ENDIF});
|
|
var
|
|
SH: Shortint;
|
|
SM: Smallint;
|
|
I: Integer;
|
|
begin
|
|
if (Value >= Low(ShortInt)) and (Value <= High(ShortInt)) then
|
|
begin
|
|
WriteValue(vaInt8);
|
|
SH := Value;
|
|
AStream.WriteBuffer(SH, SizeOf(SH));
|
|
end
|
|
else
|
|
if (Value >= Low(SmallInt)) and (Value <= High(SmallInt)) then
|
|
begin
|
|
WriteValue(vaInt16);
|
|
SM := Value;
|
|
AStream.WriteBuffer(SM, SizeOf(SM));
|
|
end
|
|
else
|
|
{$IFDEF DELPHI6}
|
|
if (Value >= Low(Integer)) and (Value <= High(Integer)) then
|
|
{$ENDIF}
|
|
begin
|
|
WriteValue(vaInt32);
|
|
I := Value;
|
|
AStream.WriteBuffer(I, SizeOf(I));
|
|
end
|
|
{$IFDEF DELPHI6}
|
|
else
|
|
begin
|
|
WriteValue(vaInt64);
|
|
AStream.WriteBuffer(Value, SizeOf(Value));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure WriteString(const Value: string);
|
|
var
|
|
B: Byte;
|
|
L: Integer;
|
|
begin
|
|
L := Length(Value);
|
|
if L <= 255 then
|
|
begin
|
|
WriteValue(vaString);
|
|
B := L;
|
|
AStream.WriteBuffer(B, SizeOf(B));
|
|
end
|
|
else
|
|
begin
|
|
WriteValue(vaLString);
|
|
AStream.WriteBuffer(L, SizeOf(L));
|
|
end;
|
|
AStream.WriteBuffer(Pointer(Value)^, L);
|
|
end;
|
|
|
|
procedure WriteFloat(const Value: Extended);
|
|
begin
|
|
WriteValue(vaExtended);
|
|
AStream.WriteBuffer(Value, SizeOf(Extended));
|
|
end;
|
|
|
|
procedure WriteSingle(const Value: Single);
|
|
begin
|
|
WriteValue(vaSingle);
|
|
AStream.WriteBuffer(Value, SizeOf(Single));
|
|
end;
|
|
|
|
procedure WriteCurrency(const Value: Currency);
|
|
begin
|
|
WriteValue(vaCurrency);
|
|
WriteCurrencyProc(AStream, Value);
|
|
end;
|
|
|
|
procedure WriteDate(const Value: TDateTime);
|
|
begin
|
|
WriteValue(vaDate);
|
|
WriteDateTimeProc(AStream, Value);
|
|
end;
|
|
|
|
procedure WriteWideString(const Value: WideString);
|
|
begin
|
|
WriteValue(vaWString);
|
|
WriteWideStringProc(AStream, Value);
|
|
end;
|
|
|
|
procedure WriteArrayProc(const Value: Variant);
|
|
var
|
|
I, L, H: Integer;
|
|
begin
|
|
if VarArrayDimCount(Value) <> 1 then
|
|
raise EWriteError.Create(cxSDataWriteError);
|
|
L := VarArrayLowBound(Value, 1);
|
|
H := VarArrayHighBound(Value, 1);
|
|
WriteValue(vaList);
|
|
WriteInteger(H - L + 1);
|
|
for I := L to H do
|
|
WriteVariantProc(AStream, Value[I]);
|
|
end;
|
|
|
|
var
|
|
VType: Integer;
|
|
begin
|
|
if VarIsArray(AValue) then
|
|
begin
|
|
WriteArrayProc(AValue);
|
|
Exit;
|
|
end;
|
|
VType := VarType(AValue);
|
|
case VType and varTypeMask of
|
|
varEmpty:
|
|
WriteValue(vaNil);
|
|
varNull:
|
|
WriteValue(vaNull);
|
|
varString:
|
|
WriteString(AValue);
|
|
{$IFDEF DELPHI6}
|
|
varShortInt, varWord, varLongWord, varInt64,
|
|
{$ENDIF}
|
|
varByte, varSmallInt, varInteger:
|
|
WriteInteger(AValue);
|
|
varDouble:
|
|
WriteFloat(AValue);
|
|
varBoolean:
|
|
if AValue then
|
|
WriteValue(vaTrue)
|
|
else
|
|
WriteValue(vaFalse);
|
|
{$IFDEF DELPHI4}
|
|
varOleStr:
|
|
WriteWideString(AValue);
|
|
varSingle:
|
|
WriteSingle(AValue);
|
|
varCurrency:
|
|
WriteCurrency(AValue);
|
|
varDate:
|
|
WriteDate(AValue);
|
|
{$ENDIF}
|
|
else
|
|
{$IFDEF DELPHI6}
|
|
{$IFNDEF NONDB}
|
|
if VType = VarSQLTimeStamp then
|
|
WriteVariantProc(AStream, TDateTime(AValue))
|
|
else
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
try
|
|
WriteString(AValue);
|
|
except
|
|
raise EWriteError.Create(cxSDataWriteError);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ReadBooleanFunc(AStream: TStream): Boolean;
|
|
begin
|
|
ReadBooleanProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadBooleanProc(AStream: TStream; var Value: Boolean);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteBooleanProc(AStream: TStream; AValue: Boolean);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadCharFunc(AStream: TStream): Char;
|
|
begin
|
|
ReadCharProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadCharProc(AStream: TStream; var Value: Char);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteCharProc(AStream: TStream; AValue: Char);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadFloatFunc(AStream: TStream): Extended;
|
|
begin
|
|
ReadFloatProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadFloatProc(AStream: TStream; var Value: Extended);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteFloatProc(AStream: TStream; AValue: Extended);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadSingleFunc(AStream: TStream): Single;
|
|
begin
|
|
ReadSingleProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadSingleProc(AStream: TStream; var Value: Single);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteSingleProc(AStream: TStream; AValue: Single);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadCurrencyFunc(AStream: TStream): Currency;
|
|
begin
|
|
ReadCurrencyProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadCurrencyProc(AStream: TStream; var Value: Currency);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteCurrencyProc(AStream: TStream; AValue: Currency);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadDateTimeFunc(AStream: TStream): TDateTime;
|
|
begin
|
|
ReadDateTimeProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadDateTimeProc(AStream: TStream; var Value: TDateTime);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteDateTimeProc(AStream: TStream; AValue: TDateTime);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadIntegerFunc(AStream: TStream): Integer;
|
|
begin
|
|
ReadIntegerProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadIntegerProc(AStream: TStream; var Value: Integer);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteIntegerProc(AStream: TStream; AValue: Integer);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadLargeIntFunc(AStream: TStream): LargeInt;
|
|
begin
|
|
ReadLargeIntProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadLargeIntProc(AStream: TStream; var Value: LargeInt);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteLargeIntProc(AStream: TStream; AValue: LargeInt);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadByteFunc(AStream: TStream): Byte;
|
|
begin
|
|
ReadByteProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadByteProc(AStream: TStream; var Value: Byte);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteByteProc(AStream: TStream; AValue: Byte);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadSmallIntFunc(AStream: TStream): SmallInt;
|
|
begin
|
|
ReadSmallIntProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadSmallIntProc(AStream: TStream; var Value: SmallInt);
|
|
begin
|
|
AStream.ReadBuffer(Value, SizeOf(Value));
|
|
end;
|
|
|
|
procedure WriteSmallIntProc(AStream: TStream; AValue: SmallInt);
|
|
begin
|
|
AStream.WriteBuffer(AValue, SizeOf(AValue));
|
|
end;
|
|
|
|
function ReadCardinalFunc(AStream: TStream): Cardinal;
|
|
begin
|
|
ReadCardinalProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadCardinalProc(AStream: TStream; var Value: Cardinal);
|
|
begin
|
|
Value := ReadIntegerFunc(AStream);
|
|
end;
|
|
|
|
procedure WriteCardinalProc(AStream: TStream; AValue: Cardinal);
|
|
begin
|
|
WriteIntegerProc(AStream, AValue);
|
|
end;
|
|
|
|
function ReadShortIntFunc(AStream: TStream): ShortInt;
|
|
begin
|
|
ReadShortIntProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadShortIntProc(AStream: TStream; var Value: ShortInt);
|
|
begin
|
|
Value := ReadByteFunc(AStream);
|
|
end;
|
|
|
|
procedure WriteShortIntProc(AStream: TStream; AValue: ShortInt);
|
|
begin
|
|
WriteByteProc(AStream, AValue);
|
|
end;
|
|
|
|
function ReadWordFunc(AStream: TStream): Word;
|
|
begin
|
|
ReadWordProc(AStream, Result);
|
|
end;
|
|
|
|
procedure ReadWordProc(AStream: TStream; var Value: Word);
|
|
begin
|
|
Value := ReadSmallIntFunc(AStream);
|
|
end;
|
|
|
|
procedure WriteWordProc(AStream: TStream; AValue: Word);
|
|
begin
|
|
WriteSmallIntProc(AStream, AValue);
|
|
end;
|
|
|
|
{ TcxFiler }
|
|
|
|
constructor TcxFiler.Create(AStream: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStream := AStream;
|
|
end;
|
|
|
|
{ TcxReader }
|
|
|
|
function TcxReader.ReadBoolean: Boolean;
|
|
begin
|
|
ReadBooleanProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadByte: Byte;
|
|
begin
|
|
ReadByteProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadCardinal: Cardinal;
|
|
begin
|
|
ReadCardinalProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadChar: Char;
|
|
begin
|
|
ReadCharProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadCurrency: Currency;
|
|
begin
|
|
ReadCurrencyProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadDateTime: TDateTime;
|
|
begin
|
|
ReadDateTimeProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadFloat: Extended;
|
|
begin
|
|
ReadFloatProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadInteger: Integer;
|
|
begin
|
|
ReadIntegerProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadLargeInt: LargeInt;
|
|
begin
|
|
ReadLargeIntProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadShortInt: ShortInt;
|
|
begin
|
|
ReadShortIntProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadSingle: Single;
|
|
begin
|
|
ReadSingleProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadSmallInt: SmallInt;
|
|
begin
|
|
ReadSmallIntProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadString: string;
|
|
begin
|
|
ReadStringProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadVariant: Variant;
|
|
begin
|
|
ReadVariantProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadWideString: WideString;
|
|
begin
|
|
ReadWideStringProc(Stream, Result);
|
|
end;
|
|
|
|
function TcxReader.ReadWord: Word;
|
|
begin
|
|
ReadWordProc(Stream, Result);
|
|
end;
|
|
|
|
{ TcxWriter }
|
|
|
|
procedure TcxWriter.WriteBoolean(AValue: Boolean);
|
|
begin
|
|
WriteBooleanProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteByte(AValue: Byte);
|
|
begin
|
|
WriteByteProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteCardinal(AValue: Cardinal);
|
|
begin
|
|
WriteCardinalProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteChar(AValue: Char);
|
|
begin
|
|
WriteCharProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteCurrency(AValue: Currency);
|
|
begin
|
|
WriteCurrencyProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteDateTime(AValue: TDateTime);
|
|
begin
|
|
WriteDateTimeProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteFloat(AValue: Extended);
|
|
begin
|
|
WriteFloatProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteInteger(AValue: Integer);
|
|
begin
|
|
WriteIntegerProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteLargeInt(AValue: LargeInt);
|
|
begin
|
|
WriteLargeIntProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteShortInt(AValue: ShortInt);
|
|
begin
|
|
WriteShortIntProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteSingle(AValue: Single);
|
|
begin
|
|
WriteSingleProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteSmallInt(AValue: SmallInt);
|
|
begin
|
|
WriteSmallIntProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteString(const S: string);
|
|
begin
|
|
WriteStringProc(Stream, S);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteVariant(const AValue: Variant);
|
|
begin
|
|
WriteVariantProc(Stream, AValue);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteWideString(const S: WideString);
|
|
begin
|
|
WriteWideStringProc(Stream, S);
|
|
end;
|
|
|
|
procedure TcxWriter.WriteWord(AValue: Word);
|
|
begin
|
|
WriteWordProc(Stream, AValue);
|
|
end;
|
|
|
|
end.
|