cxvariants.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,201 行 · 第 1/3 页

      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: