* big variant from Thorsten Engler, fixes and improves several variant stuff

git-svn-id: trunk@6747 -

rtl/objpas/cvarutil.inc

@@ -13,6 +13,15 @@
 
  **********************************************************************}
 
+{$UNDEF RANGECHECKINGOFF}
+{$IFOPT R-} {$DEFINE RANGECHECKINGOFF}    {$ENDIF}
+{R+}
+
+{$UNDEF OVERFLOWCHECKINGOFF}
+{$IFOPT Q-} {$DEFINE OVERFLOWCHECKINGOFF} {$ENDIF}
+{Q+}
+
+
 Resourcestring
 
   SNoWidestrings = 'No widestrings supported';
@@ -30,12 +39,18 @@ begin
   Raise Exception.Create(SNoInterfaces);
 end;
 
-Procedure VariantTypeMismatch;
+Procedure VariantTypeMismatch; overload;
+begin
+  Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
+end;
 
+Procedure VariantTypeMismatch(const SourceType, DestType: TVarType);
 begin
+  { ignore the types for now ... }
   Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
 end;
 
+
 Function ExceptionToVariantError (E : Exception): HResult;
 
 begin
@@ -49,617 +64,1347 @@ end;
     OS-independent functions not present in Windows
   ---------------------------------------------------------------------}
 
-Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
+{--- SmallInt ---}
+
+Function WStrToSmallInt(p: Pointer) : SmallInt;
 var
-  l : longint;
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=Round(VSingle);
-      VarDouble  : Result:=Round(VDouble);
-      VarCurrency: Result:=Round(VCurrency);
-      VarDate    : Result:=Round(VDate);
-      VarBoolean : Result:=SmallInt(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-      VarOleStr  :
-        begin
-          if not(TryStrToInt(WideCharToString(vOleStr),l)) then
-            VariantTypeMismatch;
-          result:=l;
-        end;
-      VarString  :
-        begin
-          if not(TryStrToInt(ansistring(vString),l)) then
-            VariantTypeMismatch;
-          result:=l;
-        end;
-  else
-    VariantTypeMismatch;
-  end;
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varSmallInt);
 end;
 
-Function VariantToShortInt(Const VargSrc : TVarData) : ShortInt;
+Function LStrToSmallInt(p: Pointer) : SmallInt;
 var
-  l : longint;
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=Round(VSingle);
-      VarDouble  : Result:=Round(VDouble);
-      VarCurrency: Result:=Round(VCurrency);
-      VarDate    : Result:=Round(VDate);
-      VarBoolean : Result:=SmallInt(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-      VarOleStr  :
-        begin
-          if not(TryStrToInt(WideCharToString(vOleStr),l)) then
-            VariantTypeMismatch;
-          result:=l;
-        end;
-      VarString  :
-        begin
-          if not(TryStrToInt(ansistring(vString),l)) then
-            VariantTypeMismatch;
-          result:=l;
-        end;
-  else
-    VariantTypeMismatch;
-  end;
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varSmallInt);
 end;
 
+Function VariantToSmallInt(const VargSrc : TVarData) : SmallInt;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToSmallInt', VargSrc);
+  end; {$ENDIF}
 
-Function VariantToLongint(Const VargSrc : TVarData) : Longint;
-  begin
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=Round(VSingle);
-        VarDouble  : Result:=Round(VDouble);
-        VarCurrency: Result:=Round(VCurrency);
-        VarDate    : Result:=Round(VDate);
-        VarOleStr  :
-          if not(TryStrToInt(WideCharToString(vOleStr),Result)) then
-            VariantTypeMismatch;
-        VarString  :
-          if not(TryStrToInt(ansistring(vString),Result)) then
-            VariantTypeMismatch;
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-    else
-      VariantTypeMismatch;
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToSmallInt(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToSmallInt(vOleStr);
+        varString   : Result := LStrToSmallInt(vString);
+      else
+        VariantTypeMismatch(vType, varSmallInt);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToSmallInt(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToSmallInt(PPointer(vPointer)^);
+        varString   : Result := LStrToSmallInt(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varSmallInt);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varSmallInt);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varSmallInt);
     end;
-  end;
 
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToSmallInt -> ', Result);
+  end; {$ENDIF}
+end;
 
-Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
-  var
-    l : longint;
-  begin
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=Round(VSingle);
-        VarDouble  : Result:=Round(VDouble);
-        VarCurrency: Result:=Round(VCurrency);
-        VarDate    : Result:=Round(VDate);
-        VarOleStr  :
-          begin
-            if not(TryStrToInt(WideCharToString(vOleStr),l)) then
-              VariantTypeMismatch;
-            result:=l;
-          end;
-        VarString  :
-          begin
-            if not(TryStrToInt(ansistring(vString),l)) then
-              VariantTypeMismatch;
-            result:=l;
-          end;
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-    else
-      VariantTypeMismatch;
-    end;
-  end;
+{--- ShortInt ---}
 
+Function WStrToShortInt(p: Pointer) : ShortInt;
+var
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varShortInt);
+end;
 
-Function VariantToSingle(Const VargSrc : TVarData) : Single;
-  begin
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=VSingle;
-        VarDouble  : Result:=VDouble;
-        VarCurrency: Result:=VCurrency;
-        VarDate    : Result:=VDate;
-        VarOleStr  :
-          begin
-            if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
-              VariantTypeMismatch;
-          end;
-        VarString  :
-          begin
-            if not(TryStrToFloat(ansistring(vString),Result)) then
-              VariantTypeMismatch;
-          end;
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-    else
-      VariantTypeMismatch;
+Function LStrToShortInt(p: Pointer) : ShortInt;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varShortInt);
+end;
+
+Function VariantToShortInt(const VargSrc : TVarData) : ShortInt;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToShortInt', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToShortInt(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToShortInt(vOleStr);
+        varString   : Result := LStrToShortInt(vString);
+      else
+        VariantTypeMismatch(vType, varShortInt);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToShortInt(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToShortInt(PPointer(vPointer)^);
+        varString   : Result := LStrToShortInt(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varShortInt);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varShortInt);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varShortInt);
     end;
-  end;
 
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToShortInt -> ', Result);
+  end; {$ENDIF}
+end;
 
-Function VariantToDouble(Const VargSrc : TVarData) : Double;
-  begin
-    With VargSrc do
-      Case (VType and VarTypeMask)  of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=VSingle;
-        VarDouble  : Result:=VDouble;
-        VarCurrency: Result:=VCurrency;
-        VarDate    : Result:=VDate;
-        VarOleStr  :
-          begin
-            if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
-              VariantTypeMismatch;
-          end;
-        VarString  :
-          begin
-            if not(TryStrToFloat(ansistring(vString),Result)) then
-              VariantTypeMismatch;
-          end;
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-    else
-      VariantTypeMismatch;
+{--- LongInt ---}
+
+Function WStrToLongInt(p: Pointer) : LongInt;
+var
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varInteger);
+end;
+
+Function LStrToLongInt(p: Pointer) : LongInt;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varInteger);
+end;
+
+Function VariantToLongInt(const VargSrc : TVarData) : LongInt;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToLongInt', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToLongInt(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToLongInt(vOleStr);
+        varString   : Result := LStrToLongInt(vString);
+      else
+        VariantTypeMismatch(vType, varInteger);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToLongInt(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToLongInt(PPointer(vPointer)^);
+        varString   : Result := LStrToLongInt(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varInteger);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varInteger);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varInteger);
     end;
-  end;
 
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToLongInt -> ', Result);
+  end; {$ENDIF}
+end;
+
+{--- Cardinal ---}
+
+Function WStrToCardinal(p: Pointer) : Cardinal;
+var
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varLongWord);
+end;
+
+Function LStrToCardinal(p: Pointer) : Cardinal;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varLongWord);
+end;
+
+Function VariantToCardinal(const VargSrc : TVarData) : Cardinal;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToCardinal', VargSrc);
+  end; {$ENDIF}
 
-Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
-  begin
-    Try
-      With VargSrc do
-        Case (VType and VarTypeMask) of
-          VarSmallInt: Result:=VSmallInt;
-          VarShortInt: Result:=VShortInt;
-          VarInteger : Result:=VInteger;
-          VarSingle  : Result:=FloatToCurr(VSingle);
-          VarDouble  : Result:=FloatToCurr(VDouble);
-          VarCurrency: Result:=VCurrency;
-          VarDate    : Result:=FloatToCurr(VDate);
-          VarOleStr  :
-            if not(TryStrToCurr(WideCharToString(vOleStr),Result)) then
-              VariantTypeMismatch;
-          VarString  :
-            if not(TryStrToCurr(ansistring(vString),Result)) then
-              VariantTypeMismatch;
-          VarBoolean : Result:=Longint(VBoolean);
-          VarByte    : Result:=VByte;
-          VarWord    : Result:=VWord;
-          VarLongWord   : Result:=VLongWord;
-          VarInt64   : Result:=VInt64;
-          VarQword   : Result:=VQWord;
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToCardinal(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToCardinal(vOleStr);
+        varString   : Result := LStrToCardinal(vString);
       else
-        VariantTypeMismatch;
+        VariantTypeMismatch(vType, varLongWord);
       end;
-    except
-      On EConvertError do
-        VariantTypeMismatch;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToCardinal(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToCardinal(PPointer(vPointer)^);
+        varString   : Result := LStrToCardinal(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varLongWord);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varLongWord);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varLongWord);
+    end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToCardinal -> ', Result);
+  end; {$ENDIF}
+end;
+
+procedure PrepareFloatStr(var s: ShortString);
+var
+  i, j  : Byte;
+begin
+  j := 1;
+  for i := 1 to Length(s) do
+    if s[i] <> ThousandSeparator then begin
+      if s[i] = DecimalSeparator then
+        s[j] := '.'
       else
-        Raise;
+        s[j] := s[i];
+      Inc(j);
     end;
-  end;
+  SetLength(s, Pred(j));
+end;
 
+{--- Single ---}
 
-Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
-
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=FloatToDateTime(VSmallInt);
-        VarShortInt: Result:=FloatToDateTime(VShortInt);
-        VarInteger : Result:=FloatToDateTime(VInteger);
-        VarSingle  : Result:=FloatToDateTime(VSingle);
-        VarDouble  : Result:=FloatToDateTime(VDouble);
-        VarCurrency: Result:=FloatToDateTime(VCurrency);
-        VarDate    : Result:=VDate;
-        VarOleStr  : NoWideStrings;
-        VarBoolean : Result:=FloatToDateTime(Longint(VBoolean));
-        VarByte    : Result:=FloatToDateTime(VByte);
-        VarWord    : Result:=FloatToDateTime(VWord);
-        VarLongWord    : Result:=FloatToDateTime(VLongWord);
-        VarInt64   : Result:=FloatToDateTime(VInt64);
-        VarQWord   : Result:=FloatToDateTime(VQword);
-    else
-      VariantTypeMismatch;
+Function WStrToSingle(p: Pointer) : Single;
+var
+  s     : ShortString;
+  Error : Word;
+begin
+  if Length(WideString(p)) > 255 then
+    VariantTypeMismatch(varOleStr, varSingle);
+
+  s := WideString(p);
+  PrepareFloatStr(s);
+
+  Val(s, Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varSingle);
+end;
+
+Function LStrToSingle(p: Pointer) : Single;
+var
+  s     : ShortString;
+  Error : Word;
+begin
+  if Length(AnsiString(p)) > 255 then
+    VariantTypeMismatch(varString, varSingle);
+
+  s := AnsiString(p);
+  PrepareFloatStr(s);
+
+  Val(s, Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varSingle);
+end;
+
+Function VariantToSingle(const VargSrc : TVarData) : Single;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToSingle', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := vSingle;
+        varDouble   : Result := vDouble;
+        varCurrency : Result := vCurrency;
+        varDate     : Result := vDate;
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToSingle(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToSingle(vOleStr);
+        varString   : Result := LStrToSingle(vString);
+      else
+        VariantTypeMismatch(vType, varSingle);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := PSingle(vPointer)^;
+        varDouble   : Result := PDouble(vPointer)^;
+        varCurrency : Result := PCurrency(vPointer)^;
+        varDate     : Result := PDate(vPointer)^;
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToSingle(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToSingle(PPointer(vPointer)^);
+        varString   : Result := LStrToSingle(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varSingle);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varSingle);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varSingle);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToSingle -> ', Result);
+  end; {$ENDIF}
 end;
 
-Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
-
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt<>0;
-      VarShortInt: Result:=VShortInt<>0;
-      VarInteger : Result:=VInteger<>0;
-      VarSingle  : Result:=VSingle<>0;
-      VarDouble  : Result:=VDouble<>0;
-      VarCurrency: Result:=VCurrency<>0;
-      VarDate    : Result:=VDate<>0;
-      VarOleStr  : NoWideStrings;
-      VarBoolean : Result:=VBoolean;
-      VarByte    : Result:=VByte<>0;
-      VarWord    : Result:=VWord<>0;
-      VarLongWord   : Result:=VLongWord<>0;
-      VarInt64   : Result:=Vint64<>0;
-      VarQword   : Result:=VQWord<>0;
-  else
-    VariantTypeMismatch;
-  end;
+{--- Double ---}
+
+Function WStrToDouble(p: Pointer) : Double;
+var
+  s     : ShortString;
+  Error : Word;
+begin
+  if Length(WideString(p)) > 255 then
+    VariantTypeMismatch(varOleStr, varDouble);
+
+  s := WideString(p);
+  PrepareFloatStr(s);
+
+  Val(s, Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varDouble);
 end;
 
-Function VariantToByte(Const VargSrc : TVarData) : Byte;
+Function LStrToDouble(p: Pointer) : Double;
 var
-  l : longint;
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=Round(VSingle);
-        VarDouble  : Result:=Round(VDouble);
-        VarCurrency: Result:=Round(VCurrency);
-        VarDate    : Result:=Round(VDate);
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=Vint64;
-        VarQword   : Result:=VQWord;
-      VarOleStr  :
-        begin
-          if not(TryStrToInt(WideCharToString(vOleStr),l)) then
-            VariantTypeMismatch;
-          result:=l;
+  s     : ShortString;
+  Error : Word;
+begin
+  if Length(AnsiString(p)) > 255 then
+    VariantTypeMismatch(varString, varDouble);
+
+  s := AnsiString(p);
+  PrepareFloatStr(s);
+
+  Val(s, Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varDouble);
+end;
+
+Function VariantToDouble(const VargSrc : TVarData) : Double;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToDouble', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := vSingle;
+        varDouble   : Result := vDouble;
+        varCurrency : Result := vCurrency;
+        varDate     : Result := vDate;
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToDouble(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToDouble(vOleStr);
+        varString   : Result := LStrToDouble(vString);
+      else
+        VariantTypeMismatch(vType, varDouble);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := PSingle(vPointer)^;
+        varDouble   : Result := PDouble(vPointer)^;
+        varCurrency : Result := PCurrency(vPointer)^;
+        varDate     : Result := PDate(vPointer)^;
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToDouble(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToDouble(PPointer(vPointer)^);
+        varString   : Result := LStrToDouble(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varDouble);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varDouble);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varDouble);
+    end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToDouble -> ', Result);
+  end; {$ENDIF}
+end;
+
+{--- Currency ---}
+
+Function WStrToCurrency(p: Pointer) : Currency;
+var
+  s     : ShortString;
+  Error : Word;
+  {$IFNDEF FPC_HAS_STR_CURRENCY}
+  Temp  : Extended;
+  {$ENDIF FPC_HAS_STR_CURRENCY}
+begin
+  if Length(WideString(p)) > 255 then
+    VariantTypeMismatch(varOleStr, varCurrency);
+
+  s := WideString(p);
+  PrepareFloatStr(s);
+
+  {$IFDEF FPC_HAS_STR_CURRENCY}
+  Val(s, Result, Error);
+  {$ELSE FPC_HAS_STR_CURRENCY} { needed for platforms where Currency = Int64 }
+  Val(s, Temp, Error);
+  Result := Temp;
+  {$ENDIF FPC_HAS_STR_CURRENCY}
+
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varCurrency);
+end;
+
+Function LStrToCurrency(p: Pointer) : Currency;
+var
+  s     : ShortString;
+  Error : Word;
+  {$IFNDEF FPC_HAS_STR_CURRENCY}
+  Temp  : Extended;
+  {$ENDIF FPC_HAS_STR_CURRENCY}
+begin
+  if Length(AnsiString(p)) > 255 then
+    VariantTypeMismatch(varString, varCurrency);
+
+  s := AnsiString(p);
+  PrepareFloatStr(s);
+
+  {$IFDEF FPC_HAS_STR_CURRENCY}
+  Val(s, Result, Error);
+  {$ELSE FPC_HAS_STR_CURRENCY} { needed for platforms where Currency = Int64 }
+  Val(s, Temp, Error);
+  Result := Temp;
+  {$ENDIF FPC_HAS_STR_CURRENCY}
+
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varCurrency);
+end;
+
+Function VariantToCurrency(const VargSrc : TVarData) : Currency;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToCurrency', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : begin
+          if (vSingle > MaxCurrency) or (vSingle < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := vSingle;
         end;
-      VarString  :
-        begin
-          if not(TryStrToInt(ansistring(vString),l)) then
-            VariantTypeMismatch;
-          result:=l;
+        varDouble   : begin
+          if (vDouble > MaxCurrency) or (vDouble < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := vDouble;
         end;
-    else
-      VariantTypeMismatch;
+        varCurrency : Result := vCurrency;
+        varDate     : begin
+          if (varDate > MaxCurrency) or (varDate < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := vDate;
+        end;
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToCurrency(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToCurrency(vOleStr);
+        varString   : Result := LStrToCurrency(vString);
+      else
+        VariantTypeMismatch(vType, varCurrency);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : begin
+          if (PSingle(vPointer)^ > MaxCurrency) or (PSingle(vPointer)^ < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := PSingle(vPointer)^;
+        end;
+        varDouble   : begin
+          if (PDouble(vPointer)^ > MaxCurrency) or (PDouble(vPointer)^ < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := PDouble(vPointer)^;
+        end;
+        varCurrency : Result := PCurrency(vPointer)^;
+        varDate     : begin
+          if (PDate(vPointer)^ > MaxCurrency) or (PDate(vPointer)^ < MinCurrency) then
+            VariantTypeMismatch(vType, varCurrency);
+          Result := PDate(vPointer)^;
+        end;
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToCurrency(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToCurrency(PPointer(vPointer)^);
+        varString   : Result := LStrToCurrency(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varCurrency);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varCurrency);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varCurrency);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToCurrency -> ', Result);
+  end; {$ENDIF}
 end;
 
-Function VariantToInt64(Const VargSrc : TVarData) : Int64;
-
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallInt;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=Trunc(VSingle);
-        VarDouble  : Result:=Trunc(VDouble);
-        VarCurrency: Result:=Trunc(VCurrency);
-        VarDate    : Result:=Trunc(VDate);
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-        VarOleStr  :
-          if not(TryStrToInt64(WideCharToString(vOleStr),Result)) then
-            VariantTypeMismatch;
-        VarString  :
-          if not(TryStrToInt64(ansistring(vString),Result)) then
-            VariantTypeMismatch;
-    else
-      VariantTypeMismatch;
+{--- Date ---}
+
+Function WStrToDate(p: Pointer) : TDateTime;
+var
+  s: string;
+begin
+  s := WideString(p);
+
+  if not (TryStrToDateTime(s, Result) or
+    TryStrToDate(s, Result) or
+    TryStrToTime(s, Result)) then
+    VariantTypeMismatch(varOleStr, varDate);
+end;
+
+Function LStrToDate(p: Pointer) : TDateTime;
+begin
+  if not (TryStrToDateTime(AnsiString(p), Result) or
+    TryStrToDate(AnsiString(p), Result) or
+    TryStrToTime(AnsiString(p), Result)) then
+    VariantTypeMismatch(varString, varDate);
+end;
+
+Function VariantToDate(const VargSrc : TVarData) : TDateTime;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToDate', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := vSingle;
+        varDouble   : Result := vDouble;
+        varCurrency : Result := vCurrency;
+        varDate     : Result := vDate;
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToDate(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToDate(vOleStr);
+        varString   : Result := LStrToDate(vString);
+      else
+        VariantTypeMismatch(vType, varDate);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := PSingle(vPointer)^;
+        varDouble   : Result := PDouble(vPointer)^;
+        varCurrency : Result := PCurrency(vPointer)^;
+        varDate     : Result := PDate(vPointer)^;
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToDate(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToDate(PPointer(vPointer)^);
+        varString   : Result := LStrToDate(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varDate);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varDate);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varDate);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+  if (Result < MinDateTime) or (Result > MaxDateTime) then
+    VariantTypeMismatch(VargSrc.vType, varDate);
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToDate -> ', Result);
+  end; {$ENDIF}
+end;
+
+{--- Boolean ---}
+
+Function WStrToBoolean(p: Pointer) : Boolean;
+begin
+  if not TryStrToBool(WideString(p), Result) then
+    VariantTypeMismatch(varOleStr, varBoolean);
+end;
+
+Function LStrToBoolean(p: Pointer) : Boolean;
+begin
+  if not TryStrToBool(AnsiString(p), Result) then
+    VariantTypeMismatch(varString, varBoolean);
+end;
+
+Function VariantToBoolean(const VargSrc : TVarData) : Boolean;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToBoolean', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := False;
+        varSmallInt : Result := vSmallInt <> 0;
+        varShortInt : Result := vShortInt <> 0;
+        varInteger  : Result := vInteger <> 0;
+        varSingle   : Result := vSingle <> 0;
+        varDouble   : Result := vDouble <> 0;
+        varCurrency : Result := vCurrency <> 0;
+        varDate     : Result := vDate <> 0;
+        varBoolean  : Result := vBoolean;
+        varVariant  : Result := VariantToBoolean(PVarData(vPointer)^);
+        varByte     : Result := vByte <> 0;
+        varWord     : Result := vWord <> 0;
+        varLongWord : Result := vLongWord <> 0;
+        varInt64    : Result := vInt64 <> 0;
+        varQword    : Result := vQWord <> 0;
+        varOleStr   : Result := WStrToBoolean(vOleStr);
+        varString   : Result := LStrToBoolean(vString);
+      else
+        VariantTypeMismatch(vType, varBoolean);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^ <> 0;
+        varShortInt : Result := PShortInt(vPointer)^ <> 0;
+        varInteger  : Result := PInteger(vPointer)^ <> 0;
+        varSingle   : Result := PSingle(vPointer)^ <> 0;
+        varDouble   : Result := PDouble(vPointer)^ <> 0;
+        varCurrency : Result := PCurrency(vPointer)^ <> 0;
+        varDate     : Result := PDate(vPointer)^ <> 0;
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^) <> 0;
+        varVariant  : Result := VariantToBoolean(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^ <> 0;
+        varWord     : Result := PWord(vPointer)^ <> 0;
+        varLongWord : Result := PLongWord(vPointer)^ <> 0;
+        varInt64    : Result := PInt64(vPointer)^ <> 0;
+        varQword    : Result := PQWord(vPointer)^ <> 0;
+        varOleStr   : Result := WStrToBoolean(PPointer(vPointer)^);
+        varString   : Result := LStrToBoolean(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varBoolean);
+      end else { pointer is nil }
+        Result := False;
+    else { array or something like that }
+      VariantTypeMismatch(vType, varBoolean);
+    end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToBoolean -> ', Result);
+  end; {$ENDIF}
 end;
 
-Function VariantToQWord(Const VargSrc : TVarData) : QWord;
+{--- Byte ---}
+
+Function WStrToByte(p: Pointer) : Byte;
 var
-  l : int64;
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt: Result:=VSmallint;
-        VarShortInt: Result:=VShortInt;
-        VarInteger : Result:=VInteger;
-        VarSingle  : Result:=Trunc(VSingle);
-        VarDouble  : Result:=Trunc(VDouble);
-        VarCurrency: Result:=Trunc(VCurrency);
-        VarDate    : Result:=Trunc(VDate);
-        VarBoolean : Result:=Longint(VBoolean);
-        VarByte    : Result:=VByte;
-        VarWord    : Result:=VWord;
-        VarLongWord   : Result:=VLongWord;
-        VarInt64   : Result:=VInt64;
-        VarQword   : Result:=VQWord;
-        VarOleStr  :
-          begin
-            if not(TryStrToInt64(WideCharToString(vOleStr),l)) then
-              VariantTypeMismatch;
-            result:=l;
-          end;
-        VarString  :
-          begin
-            if not(TryStrToInt64(ansistring(vString),l)) then
-              VariantTypeMismatch;
-            result:=l;
-          end;
-    else
-      VariantTypeMismatch;
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varByte);
+end;
+
+Function LStrToByte(p: Pointer) : Byte;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varByte);
+end;
+
+Function VariantToByte(const VargSrc : TVarData) : Byte;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToByte', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToByte(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToByte(vOleStr);
+        varString   : Result := LStrToByte(vString);
+      else
+        VariantTypeMismatch(vType, varByte);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToByte(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToByte(PPointer(vPointer)^);
+        varString   : Result := LStrToByte(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varByte);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varByte);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varByte);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToByte -> ', Result);
+  end; {$ENDIF}
 end;
 
-Function VariantToWideString(Const VargSrc : TVarData) : WideString;
-
-Const
- BS : Array[Boolean] of WideString = ('False','True');
-
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt : Result:=IntTostr(VSmallint);
-        VarShortInt : Result:=IntToStr(VShortInt);
-        VarInteger  : Result:=IntToStr(VInteger);
-        VarSingle   : Result:=FloatToStr(VSingle);
-        VarDouble   : Result:=FloatToStr(VDouble);
-        VarCurrency : Result:=FloatToStr(VCurrency);
-        VarDate     : Result:=DateTimeToStr(VDate);
-        VarOleStr   : Result:=WideString(Pointer(VOleStr));
-        VarBoolean  : Result:=BS[VBoolean];
-        VarByte     : Result:=IntToStr(VByte);
-        VarWord     : Result:=IntToStr(VWord);
-        VarLongWord : Result:=IntToStr(VLongWord);
-        VarInt64    : Result:=IntToStr(VInt64);
-        VarQword    : Result:=IntToStr(VQWord);
-    else
-      VariantTypeMismatch;
+{--- Int64 ---}
+
+Function WStrToInt64(p: Pointer) : Int64;
+var
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varInt64);
+end;
+
+Function LStrToInt64(p: Pointer) : Int64;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varInt64);
+end;
+
+Function VariantToInt64(const VargSrc : TVarData) : Int64;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToInt64', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToInt64(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToInt64(vOleStr);
+        varString   : Result := LStrToInt64(vString);
+      else
+        VariantTypeMismatch(vType, varInt64);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToInt64(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToInt64(PPointer(vPointer)^);
+        varString   : Result := LStrToInt64(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varInt64);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varInt64);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varInt64);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToInt64 -> ', Result);
+  end; {$ENDIF}
+end;
+
+{--- QWord ---}
+
+Function WStrToQWord(p: Pointer) : QWord;
+var
+  Error : Word;
+begin
+  Val(WideString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varOleStr, varQWord);
+end;
+
+Function LStrToQWord(p: Pointer) : QWord;
+var
+  Error : Word;
+begin
+  Val(AnsiString(p), Result, Error);
+  if Error <> 0 then
+    VariantTypeMismatch(varString, varQWord);
 end;
 
-Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
-
-Const
- BS : Array[Boolean] of AnsiString = ('False','True');
-
-begin
-  Try
-    With VargSrc do
-      Case (VType and VarTypeMask) of
-        VarSmallInt : Result:=IntTostr(VSmallint);
-        VarShortInt : Result:=IntToStr(VShortInt);
-        VarInteger  : Result:=IntToStr(VInteger);
-        VarSingle   : Result:=FloatToStr(VSingle);
-        VarDouble   : Result:=FloatToStr(VDouble);
-        VarCurrency : Result:=FloatToStr(VCurrency);
-        VarDate     : Result:=DateTimeToStr(VDate);
-        VarOleStr   : Result:=WideCharToString(VOleStr);
-        VarBoolean  : Result:=BS[VBoolean];
-        VarByte     : Result:=IntToStr(VByte);
-        VarWord     : Result:=IntToStr(VWord);
-        VarLongWord : Result:=IntToStr(VLongWord);
-        VarInt64    : Result:=IntToStr(VInt64);
-        VarQword    : Result:=IntToStr(VQWord);
-        VarString   : Result:=ansistring(VString);
+Function VariantToQWord(const VargSrc : TVarData) : QWord;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToQWord', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := 0;
+        varSmallInt : Result := vSmallInt;
+        varShortInt : Result := vShortInt;
+        varInteger  : Result := vInteger;
+        varSingle   : Result := Round(vSingle);
+        varDouble   : Result := Round(vDouble);
+        varCurrency : Result := Round(vCurrency);
+        varDate     : Result := Round(vDate);
+        varBoolean  : Result := SmallInt(vBoolean);
+        varVariant  : Result := VariantToQWord(PVarData(vPointer)^);
+        varByte     : Result := vByte;
+        varWord     : Result := vWord;
+        varLongWord : Result := vLongWord;
+        varInt64    : Result := vInt64;
+        varQword    : Result := vQWord;
+        varOleStr   : Result := WStrToQWord(vOleStr);
+        varString   : Result := LStrToQWord(vString);
       else
-        VariantTypeMismatch;
+        VariantTypeMismatch(vType, varQWord);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := PSmallInt(vPointer)^;
+        varShortInt : Result := PShortInt(vPointer)^;
+        varInteger  : Result := PInteger(vPointer)^;
+        varSingle   : Result := Round(PSingle(vPointer)^);
+        varDouble   : Result := Round(PDouble(vPointer)^);
+        varCurrency : Result := Round(PCurrency(vPointer)^);
+        varDate     : Result := Round(PDate(vPointer)^);
+        varBoolean  : Result := SmallInt(PWordBool(vPointer)^);
+        varVariant  : Result := VariantToQWord(PVarData(vPointer)^);
+        varByte     : Result := PByte(vPointer)^;
+        varWord     : Result := PWord(vPointer)^;
+        varLongWord : Result := PLongWord(vPointer)^;
+        varInt64    : Result := PInt64(vPointer)^;
+        varQword    : Result := PQWord(vPointer)^;
+        varOleStr   : Result := WStrToQWord(PPointer(vPointer)^);
+        varString   : Result := LStrToQWord(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varQWord);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varQWord);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varQWord);
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
-  end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToQWord -> ', Result);
+  end; {$ENDIF}
 end;
 
-Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
+{--- WideString ---}
 
-Var
-  S : AnsiString;
+Function VariantToWideString(const VargSrc : TVarData) : WideString;
+begin
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToWideString', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := '';
+        varSmallInt : Result := IntToStr(vSmallInt);
+        varShortInt : Result := IntToStr(vShortInt);
+        varInteger  : Result := IntToStr(vInteger);
+        varSingle   : Result := FloatToStr(vSingle);
+        varDouble   : Result := FloatToStr(vDouble);
+        varCurrency : Result := FloatToStr(vCurrency);
+        varDate     : Result := FloatToStr(vDate);
+        varBoolean  : Result := BoolToStr(vBoolean, True);
+        varVariant  : Result := VariantToWideString(PVarData(vPointer)^);
+        varByte     : Result := IntToStr(vByte);
+        varWord     : Result := IntToStr(vWord);
+        varLongWord : Result := IntToStr(vLongWord);
+        varInt64    : Result := IntToStr(vInt64);
+        varQword    : Result := IntToStr(vQWord);
+        varOleStr   : Result := WideString(Pointer(vOleStr));
+        varString   : Result := AnsiString(vString);
+      else
+        VariantTypeMismatch(vType, varOleStr);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := IntToStr(PSmallInt(vPointer)^);
+        varShortInt : Result := IntToStr(PShortInt(vPointer)^);
+        varInteger  : Result := IntToStr(PInteger(vPointer)^);
+        varSingle   : Result := FloatToStr(PSingle(vPointer)^);
+        varDouble   : Result := FloatToStr(PDouble(vPointer)^);
+        varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
+        varDate     : Result := FloatToStr(PDate(vPointer)^);
+        varBoolean  : Result := BoolToStr(PWordBool(vPointer)^, True);
+        varVariant  : Result := VariantToWideString(PVarData(vPointer)^);
+        varByte     : Result := IntToStr(PByte(vPointer)^);
+        varWord     : Result := IntToStr(PWord(vPointer)^);
+        varLongWord : Result := IntToStr(PLongWord(vPointer)^);
+        varInt64    : Result := IntToStr(PInt64(vPointer)^);
+        varQword    : Result := IntToStr(PQWord(vPointer)^);
+        varOleStr   : Result := WideString(PPointer(vPointer)^);
+        varString   : Result := AnsiString(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varOleStr);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varOleStr);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varOleStr);
+    end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToWideString -> ', Result);
+  end; {$ENDIF}
+end;
+
+{--- AnsiString ---}
 
+Function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
 begin
-  S:=VariantToAnsiString(VArgSrc);
-  Result:=S;
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  DumpVariant('VariantToAnsiString', VargSrc);
+  end; {$ENDIF}
+
+  with VargSrc do
+    case vType and not varTypeMask of
+      0: case vType of
+        varEmpty    : Result := '';
+        varSmallInt : Result := IntToStr(vSmallInt);
+        varShortInt : Result := IntToStr(vShortInt);
+        varInteger  : Result := IntToStr(vInteger);
+        varSingle   : Result := FloatToStr(vSingle);
+        varDouble   : Result := FloatToStr(vDouble);
+        varCurrency : Result := FloatToStr(vCurrency);
+        varDate     : Result := FloatToStr(vDate);
+        varBoolean  : Result := BoolToStr(vBoolean, True);
+        varVariant  : Result := VariantToAnsiString(PVarData(vPointer)^);
+        varByte     : Result := IntToStr(vByte);
+        varWord     : Result := IntToStr(vWord);
+        varLongWord : Result := IntToStr(vLongWord);
+        varInt64    : Result := IntToStr(vInt64);
+        varQword    : Result := IntToStr(vQWord);
+        varOleStr   : Result := WideString(Pointer(vOleStr));
+        varString   : Result := AnsiString(vString);
+      else
+        VariantTypeMismatch(vType, varString);
+      end;
+      varByRef: if Assigned(vPointer) then case vType of
+        varSmallInt : Result := IntToStr(PSmallInt(vPointer)^);
+        varShortInt : Result := IntToStr(PShortInt(vPointer)^);
+        varInteger  : Result := IntToStr(PInteger(vPointer)^);
+        varSingle   : Result := FloatToStr(PSingle(vPointer)^);
+        varDouble   : Result := FloatToStr(PDouble(vPointer)^);
+        varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
+        varDate     : Result := FloatToStr(PDate(vPointer)^);
+        varBoolean  : Result := BoolToStr(PWordBool(vPointer)^, True);
+        varVariant  : Result := VariantToAnsiString(PVarData(vPointer)^);
+        varByte     : Result := IntToStr(PByte(vPointer)^);
+        varWord     : Result := IntToStr(PWord(vPointer)^);
+        varLongWord : Result := IntToStr(PLongWord(vPointer)^);
+        varInt64    : Result := IntToStr(PInt64(vPointer)^);
+        varQword    : Result := IntToStr(PQWord(vPointer)^);
+        varOleStr   : Result := WideString(PPointer(vPointer)^);
+        varString   : Result := AnsiString(PPointer(vPointer)^);
+      else { other vtype }
+        VariantTypeMismatch(vType, varString);
+      end else { pointer is nil }
+        VariantTypeMismatch(vType, varString);
+    else { array or something like that }
+      VariantTypeMismatch(vType, varString);
+    end;
+
+  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
+  WriteLn('VariantToAnsiString -> ', Result);
+  end; {$ENDIF}
+end;
+
+
+Function VariantToShortString(const VargSrc : TVarData) : ShortString;
+begin
+  Result:=VariantToAnsiString(VargSrc);
 end;
 
+{$IFDEF RANGECHECKINGOFF}    {R-} {$ENDIF}
+{$IFDEF OVERFLOWCHECKINGOFF} {Q-} {$ENDIF}
+
+
 { ---------------------------------------------------------------------
     Some debug routines
   ---------------------------------------------------------------------}
 
 
-Procedure DumpVariant(Const VArgSrc : TVarData);
-
-begin
-  DumpVariant(Output,VArgSrc);
-end;
-
-(*
-   tvardata = packed record
-      vtype : tvartype;
-      case integer of
-         0:(res1 : word;
-            case integer of
-               0:
-                 (res2,res3 : word;
-                  case word of
-                     varsmallint : (vsmallint : smallint);
-                     varinteger : (vinteger : longint);
-                     varsingle : (vsingle : single);
-                     vardouble : (vdouble : double);
-                     varcurrency : (vcurrency : currency);
-                     vardate : (vdate : tdatetime);
-                     varolestr : (volestr : pwidechar);
-                     vardispatch : (vdispatch : pointer);
-                     varerror : (verror : dword);
-                     varboolean : (vboolean : wordbool);
-                     varunknown : (vunknown : pointer);
-                     // vardecimal : ( : );
-                     varshortint : (vshortint : shortint);
-                     varbyte : (vbyte : byte);
-                     varword : (vword : word);
-                     varlongword : (vlongword : dword);
-                     varint64 : (vint64 : int64);
-                     varqword : (vqword : qword);
-                     varword64 : (vword64 : qword);
-                     varstring : (vstring : pointer);
-                     varany :  (vany : pointer);
-                     vararray : (varray : pvararray);
-                     varbyref : (vpointer : pointer);
-                 );
-               1:
-                 (vlongs : array[0..2] of longint);
-           );
-         1:(vwords : array[0..6] of word);
-         2:(vbytes : array[0..13] of byte);
-      end;
+Procedure DumpVariant(const VSrc : Variant);
+begin
+  DumpVariant(Output, '', TVarData(VSrc));
+end;
 
-*)
+Procedure DumpVariant(const aName: string; const VSrc : Variant);
+begin
+  DumpVariant(Output, aName, TVarData(VSrc));
+end;
 
-Const
-  VarTypeStrings : Array [varEmpty..varqword] of string = (
-    'empty',  'null',  'smallint',  'integer',  'single',  'double',
-    'currency',  'date',  'olestr',  'dispatch',  'error',  'boolean',
-    'variant',  'unknown',  'unknown','decimal',  'shortint',  'byte',  'word',
-    'longword',  'int64',  'qword');
+Procedure DumpVariant(Var F : Text; const VSrc : Variant);
+begin
+  DumpVariant(F, '', TVarData(VSrc));
+end;
 
-Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+procedure DumpVariant(var F : Text; const aName: string; const VSrc : Variant); 
+begin
+  DumpVariant(F, aName, TVarData(VSrc));
+end;
+
+Procedure DumpVariant(const VargSrc : TVarData);
+begin
+  DumpVariant(Output, '', VargSrc);
+end;
+
+Procedure DumpVariant(const aName: string; const VargSrc : TVarData);
+begin
+  DumpVariant(Output, aName, VargSrc);
+end;
+
+Procedure DumpVariant(Var F : Text; const VargSrc : TVarData);
+begin
+  DumpVariant(F, '', VargSrc);
+end;
+
+const
+  VarTypeStrings : array [varEmpty..varQword] of string = (
+    'empty',     { varempty    = 0 }
+    'null',      { varnull     = 1 }
+    'smallint',  { varsmallint = 2 }
+    'integer',   { varinteger  = 3 }
+    'single',    { varsingle   = 4 }
+    'double',    { vardouble   = 5 }
+    'currency',  { varcurrency = 6 }
+    'date',      { vardate     = 7 }
+    'olestr',    { varolestr   = 8 }
+    'dispatch',  { vardispatch = 9 }
+    'error',     { varerror    = 10 }
+    'boolean',   { varboolean  = 11 }
+    'variant',   { varvariant  = 12 }
+    'unknown',   { varunknown  = 13 }
+    'decimal',   { vardecimal  = 14 }
+    'undefined',
+    'shortint',  { varshortint = 16 }
+    'byte',      { varbyte     = 17 }
+    'word',      { varword     = 18 }
+    'longword',  { varlongword = 19 }
+    'int64',     { varint64    = 20 }
+    'qword');    { varqword    = 21 }
+
+Procedure DumpVariant(Var F : Text; const aName: string; const VargSrc : TVarData);
 
 Var
-  W : WideString;
-
-begin
-  If VArgSrc.vType in [varEmpty..varqword] then
-    Writeln(F,'Variant has type : ',VarTypeStrings[VArgSrc.vType])
-  else if (VArgSrc.vType=VarArray) Then
-    begin
-    Write(F,'Variant is array.');
-    exit;
-    end
-  else if (VargSrc.vType=VarByRef) then
-    begin
-    Writeln(F,'Variant is by reference.');
-    exit;
-    end
-  else
-    begin
-    Writeln(F,'Variant has unknown type: ', VargSrc.vType);
-    Exit;
+  i: Integer;
+
+begin
+  Writeln(F,'---> ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' <----------------');
+  with VargSrc do begin
+
+    if vType and varByRef = varByRef then
+      Writeln(F,'Variant is by reference.');
+
+    if vType and varArray = varArray then
+      Writeln(F,'Variant is an array.');
+
+    if vType and not (varTypeMask or varArray or varByRef) <> 0 then
+      Writeln(F,'Variant has unknown flags set in type: $', IntToHex(vType, 4));
+
+
+    If (vType and varTypeMask) in [varEmpty..varQword] then
+      Writeln(F,'Variant has type : ', VarTypeStrings[vType and varTypeMask])
+    else If (vType and varTypeMask) = varString then
+      Writeln(F,'Variant has type : string')
+    else
+      Writeln(F,'Variant has unknown type : $', IntToHex(vType and varTypeMask, 4));
+
+    Write('Bytes :');
+    for i := 0 to 13 do
+      Write(IntToHex(VBytes[i], 2),' ');
+    WriteLn;
+
+    if vType and varArray = varArray then begin
+      Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+      Writeln(F);
+      Exit;
     end;
-  If VArgSrc.vType<>varEmpty then
-    With VArgSrc do
-      begin
-      Write(F,'Value is: ') ;
-      Case vtype of
-        varnull : Write(F,'Null');
-        varsmallint : Write(F,vsmallint);
-        varinteger : Write(F,vinteger);
-        varsingle : Write(F,vsingle);
-        vardouble : Write(F,vdouble);
-        varcurrency : Write(F,vcurrency) ;
-        vardate : Write(F,vdate) ;
-        varolestr : begin
-                    W:=vOleStr;
-                    Write(F,W) ;
-                    end;
-        vardispatch : Write(F,'Not suppordted') ;
-        varerror : Write(F,'Error') ;
-        varboolean : Write(F,vboolean) ;
-        varvariant : Write(F,'Unsupported') ;
-        varunknown : Write(F,'Unsupported') ;
-        vardecimal : Write(F,'Unsupported') ;
-        varshortint : Write(F,vshortint) ;
-        varbyte : Write(F,vbyte) ;
-        varword : Write(F,vword) ;
-        varlongword : Write(F,vlongword) ;
-        varint64 : Write(F,vint64) ;
-        varqword : Write(F,vqword) ;
-      end;
-      Writeln(f);
+
+    If vType <> varEmpty then begin
+      Write(F,'Value is: [');
+
+      if (vType and varByRef = varByRef) or (vType and varTypeMask = varVariant) then
+        if not Assigned(vPointer) then begin
+          WriteLn(F, 'nil]');
+          Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+          Writeln(F);
+          Exit;
+        end;
+
+      case vType of
+        varNull                 : Write(F, 'Null');
+        varSmallInt             : Write(F, vSmallInt);
+        varInteger              : Write(F, vInteger);
+        varSingle               : Write(F, vSingle);
+        varDouble               : Write(F, vDouble);
+        varCurrency             : Write(F, vCurrency);
+        varDate                 : Write(F, vDate);
+        varOleStr               : Write(F, WideString(Pointer(vOleStr)));
+        varError                : Write(F, IntToHex(Cardinal(vError), 8));
+        varBoolean              : Write(F, vBoolean);
+        varVariant, varVariant or varByRef : begin
+          WriteLn(' dereferencing -> ]');
+          DumpVariant(F, aName+'^', PVarData(vPointer)^);
+          Exit;
+        end;
+        varShortInt             : Write(F, vShortInt);
+        varByte                 : Write(F, vByte);
+        varWord                 : Write(F, vWord);
+        varLongWord             : Write(F, vLongWord);
+        varInt64                : Write(F, vInt64);
+        varQword                : Write(F, vQWord);
+        varString               : Write(F, AnsiString(vString));
+        varNull     or varByRef : Write(F, 'Null');
+        varSmallInt or varByRef : Write(F, PSmallInt(vPointer)^);
+        varInteger  or varByRef : Write(F, PInteger(vPointer)^);
+        varSingle   or varByRef : Write(F, PSingle(vPointer)^);
+        varDouble   or varByRef : Write(F, PDouble(vPointer)^);
+        varCurrency or varByRef : Write(F, PCurrency(vPointer)^);
+        varDate     or varByRef : Write(F, PDate(vPointer)^);
+        varOleStr   or varByRef : Write(F, WideString(PPointer(vPointer)^));
+        varError    or varByRef : Write(F, IntToHex(Cardinal(PLongWord(vPointer)^), 8));
+        varBoolean  or varByRef : Write(F, PWordBool(vPointer)^);
+        varShortInt or varByRef : Write(F, PShortInt(vPointer)^);
+        varByte     or varByRef : Write(F, PByte(vPointer)^);
+        varWord     or varByRef : Write(F, PWord(vPointer)^);
+        varLongWord or varByRef : Write(F, PLongWord(vPointer)^);
+        varInt64    or varByRef : Write(F, PInt64(vPointer)^);
+        varQword    or varByRef : Write(F, PQWord(vPointer)^);
+        varString   or varByRef : Write(F, AnsiString(PPointer(vPointer)^));
+      else
+        Write(F, 'Unsupported');
       end;
+      WriteLn(F, ']');
+    end;
+  end;
+
+  Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+  Writeln(F);
 end;
 
 
+

rtl/objpas/fmtbcd.pp

@@ -1633,9 +1633,10 @@ IMPLEMENTATION
 {$else}
       BCD.Places := 4;
 {$endif}
-      CurrToBCD := False;
-      if Decimals <> 4
-        then NormalizeBCD ( BCD, BCD, Precision, Decimals );
+      if Decimals <> 4 then
+        Result := NormalizeBCD ( BCD, BCD, Precision, Decimals )
+      else
+        CurrToBCD := True;
      end;
 
 {$ifdef comproutines}

rtl/objpas/sysconst.pp

@@ -70,6 +70,8 @@ resourcestring
   SInvalidVarCast        = 'Invalid variant type cast';
   SInvalidVarNullOp      = 'Invalid NULL variant operation';
   SInvalidVarOp          = 'Invalid variant operation';
+  SInvalidBinaryVarOp    = 'Invalid variant operation %s %s %s';
+  SInvalidUnaryVarOp     = 'Invalid variant operation %s %s';
   SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'+LineEnding+'%s';
   SNoError               = 'No error.';
   SNoThreadSupport       = 'Threads not supported. Recompile program with thread driver.';

rtl/objpas/varutilh.inc

@@ -48,25 +48,39 @@ function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
 
 { Conversion routines NOT in windows oleaut }
 
-Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
-Function VariantToLongint(Const VargSrc : TVarData) : Longint;
-Function VariantToShortint(Const VargSrc : TVarData) : ShortInt;
-Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
-Function VariantToSingle(Const VargSrc : TVarData) : Single;
-Function VariantToDouble(Const VargSrc : TVarData) : Double;
-Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
-Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
-Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
-Function VariantToByte(Const VargSrc : TVarData) : Byte;
-Function VariantToInt64(Const VargSrc : TVarData ) : Int64;
-Function VariantToQWord(Const VargSrc : TVarData ) : Qword;
-Function VariantToWideString(Const VargSrc : TVarData) : WideString;
-Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
-Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
+function VariantToSmallInt(const VargSrc : TVarData) : SmallInt;
+function VariantToLongint(const VargSrc : TVarData) : Longint;
+function VariantToShortint(const VargSrc : TVarData) : ShortInt;
+function VariantToCardinal(const VargSrc : TVarData) : Cardinal;
+function VariantToSingle(const VargSrc : TVarData) : Single;
+function VariantToDouble(const VargSrc : TVarData) : Double;
+function VariantToCurrency(const VargSrc : TVarData) : Currency;
+function VariantToDate(const VargSrc : TVarData) : TDateTime;
+function VariantToBoolean(const VargSrc : TVarData) : Boolean;
+function VariantToByte(const VargSrc : TVarData) : Byte;
+function VariantToInt64(const VargSrc : TVarData ) : Int64;
+function VariantToQWord(const VargSrc : TVarData ) : Qword;
+function VariantToWideString(const VargSrc : TVarData) : WideString;
+function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
+function VariantToShortString(const VargSrc : TVarData) : ShortString;
 
 {Debug routines }
-Procedure DumpVariant(Const VArgSrc : TVarData);
-Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+procedure DumpVariant(const VSrc : Variant);
+procedure DumpVariant(const aName: string; const VSrc : Variant);
+procedure DumpVariant(var F : Text; const VSrc : Variant);
+procedure DumpVariant(var F : Text; const aName: string; const VSrc : Variant);
+
+procedure DumpVariant(const VArgSrc : TVarData);
+procedure DumpVariant(const aName: string; const VArgSrc : TVarData);
+procedure DumpVariant(var F : Text; const VArgSrc : TVarData);
+procedure DumpVariant(var F : Text; const aName: string; const VArgSrc : TVarData);
+
+
+
+{$IFDEF DEBUG_VARUTILS}
+var
+  __DEBUG_VARUTILS: Boolean;
+{$ENDIF}
 
 
 {$i varerror.inc}
@@ -79,4 +93,7 @@ const
   ARR_DISPATCH      = $0400;
   ARR_VARIANT       = $0800;
 
+  VAR_LOCALE_USER_DEFAULT = $400; // = Windows.LOCALE_USER_DEFAULT
+
+
 

rtl/objpas/varutils.inc

@@ -17,7 +17,7 @@
     Some general stuff: Error handling and so on.
   ---------------------------------------------------------------------}
 
-{ we so ugly things with tvararray here }
+{ we do ugly things with tvararray here }
 {$RANGECHECKS OFF}
 
 Procedure SetUnlockResult (P : PVarArray; Res : HResult);
@@ -759,3 +759,5 @@ begin
     Result:=psa^.ElementSize;
 end;
 
+
+