* Reverted the merge of r6747

git-svn-id: branches/fixes_2_2@6894 -

rtl/objpas/cvarutil.inc

@@ -13,15 +13,6 @@
 
  **********************************************************************}
 
-{$UNDEF RANGECHECKINGOFF}
-{$IFOPT R-} {$DEFINE RANGECHECKINGOFF}    {$ENDIF}
-{R+}
-
-{$UNDEF OVERFLOWCHECKINGOFF}
-{$IFOPT Q-} {$DEFINE OVERFLOWCHECKINGOFF} {$ENDIF}
-{Q+}
-
-
 Resourcestring
 
   SNoWidestrings = 'No widestrings supported';
@@ -39,18 +30,12 @@ begin
   Raise Exception.Create(SNoInterfaces);
 end;
 
-Procedure VariantTypeMismatch; overload;
-begin
-  Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
-end;
+Procedure VariantTypeMismatch;
 
-Procedure VariantTypeMismatch(const SourceType, DestType: TVarType);
 begin
-  { ignore the types for now ... }
   Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
 end;
 
-
 Function ExceptionToVariantError (E : Exception): HResult;
 
 begin
@@ -64,1347 +49,617 @@ end;
     OS-independent functions not present in Windows
   ---------------------------------------------------------------------}
 
-{--- SmallInt ---}
-
-Function WStrToSmallInt(p: Pointer) : SmallInt;
+Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
 var
-  Error : Word;
-begin
-  Val(WideString(p), Result, Error);
-  if Error <> 0 then
-    VariantTypeMismatch(varOleStr, varSmallInt);
+  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;
 end;
 
-Function LStrToSmallInt(p: Pointer) : SmallInt;
+Function VariantToShortInt(Const VargSrc : TVarData) : ShortInt;
 var
-  Error : Word;
-begin
-  Val(AnsiString(p), Result, Error);
-  if Error <> 0 then
-    VariantTypeMismatch(varString, varSmallInt);
+  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;
 end;
 
-Function VariantToSmallInt(const VargSrc : TVarData) : SmallInt;
-begin
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  DumpVariant('VariantToSmallInt', 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 := 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);
+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;
     end;
+  end;
 
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToSmallInt -> ', Result);
-  end; {$ENDIF}
-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 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);
+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;
 
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToShortInt -> ', Result);
-  end; {$ENDIF}
-end;
-
-{--- 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);
+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;
     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}
 
-  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(vType, varLongWord);
-      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 := 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
-        s[j] := s[i];
-      Inc(j);
+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;
     end;
-  SetLength(s, Pred(j));
-end;
-
-{--- Single ---}
-
-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;
+  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);
+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;
       else
-        VariantTypeMismatch(vType, varSingle);
+        VariantTypeMismatch;
       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);
+    except
+      On EConvertError do
+        VariantTypeMismatch;
+      else
+        Raise;
     end;
+  end;
 
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToSingle -> ', Result);
-  end; {$ENDIF}
-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 LStrToDouble(p: Pointer) : Double;
-var
-  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);
+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;
     end;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToDouble -> ', Result);
-  end; {$ENDIF}
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 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);
+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;
 end;
 
-Function LStrToCurrency(p: Pointer) : Currency;
+Function VariantToByte(Const VargSrc : TVarData) : Byte;
 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;
+  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;
         end;
-        varDouble   : begin
-          if (vDouble > MaxCurrency) or (vDouble < MinCurrency) then
-            VariantTypeMismatch(vType, varCurrency);
-          Result := vDouble;
+      VarString  :
+        begin
+          if not(TryStrToInt(ansistring(vString),l)) then
+            VariantTypeMismatch;
+          result:=l;
         end;
-        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;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToCurrency -> ', Result);
-  end; {$ENDIF}
-end;
-
-{--- 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;
-  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);
+    else
+      VariantTypeMismatch;
     end;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToBoolean -> ', Result);
-  end; {$ENDIF}
-end;
-
-{--- Byte ---}
-
-Function WStrToByte(p: Pointer) : Byte;
-var
-  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);
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 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);
+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;
     end;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToByte -> ', Result);
-  end; {$ENDIF}
-end;
-
-{--- Int64 ---}
-
-Function WStrToInt64(p: Pointer) : Int64;
-var
-  Error : Word;
-begin
-  Val(WideString(p), Result, Error);
-  if Error <> 0 then
-    VariantTypeMismatch(varOleStr, varInt64);
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 end;
 
-Function LStrToInt64(p: Pointer) : Int64;
+Function VariantToQWord(Const VargSrc : TVarData) : QWord;
 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);
+  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;
     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);
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 end;
 
-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(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);
+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;
     end;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToQWord -> ', Result);
-  end; {$ENDIF}
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 end;
 
-{--- WideString ---}
-
-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);
+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);
       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);
+        VariantTypeMismatch;
     end;
-
-  {$IFDEF DEBUG_VARUTILS} if __DEBUG_VARUTILS then begin
-  WriteLn('VariantToWideString -> ', Result);
-  end; {$ENDIF}
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
 end;
 
-{--- AnsiString ---}
-
-Function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
-begin
-  {$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;
 
+Var
+  S : AnsiString;
 
-Function VariantToShortString(const VargSrc : TVarData) : ShortString;
 begin
-  Result:=VariantToAnsiString(VargSrc);
+  S:=VariantToAnsiString(VArgSrc);
+  Result:=S;
 end;
 
-{$IFDEF RANGECHECKINGOFF}    {R-} {$ENDIF}
-{$IFDEF OVERFLOWCHECKINGOFF} {Q-} {$ENDIF}
-
-
 { ---------------------------------------------------------------------
     Some debug routines
   ---------------------------------------------------------------------}
 
 
-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;
-
-Procedure DumpVariant(Var F : Text; const VSrc : Variant);
-begin
-  DumpVariant(F, '', TVarData(VSrc));
-end;
-
-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(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(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 }
+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 aName: string; const VargSrc : TVarData);
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
 
 Var
-  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;
+  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;
     end;
-
-    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');
+  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);
       end;
-      WriteLn(F, ']');
-    end;
-  end;
-
-  Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
-  Writeln(F);
 end;
 
 
-

rtl/objpas/fmtbcd.pp

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

rtl/objpas/sysconst.pp

@@ -70,8 +70,6 @@ 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,39 +48,25 @@ 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 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}
+Procedure DumpVariant(Const VArgSrc : TVarData);
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
 
 
 {$i varerror.inc}
@@ -93,7 +79,4 @@ 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 do ugly things with tvararray here }
+{ we so ugly things with tvararray here }
 {$RANGECHECKS OFF}
 
 Procedure SetUnlockResult (P : PVarArray; Res : HResult);
@@ -759,5 +759,3 @@ begin
     Result:=psa^.ElementSize;
 end;
 
-
-