+ Initial implementation of varutils

rtl/linux/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v1.00 [2000/08/14]
+# Makefile generated by fpcmake v1.00 [2000/07/11]
 #
 
 defaultrule: all
@@ -202,7 +202,7 @@ endif
 # Targets
 
 override LOADEROBJECTS+=prt0 cprt0 gprt0 cprt21 gprt21
-override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings linux ports initc dos crt objects printer graph ggigraph sysutils typinfo math cpu mmx getopts heaptrc lineinfo errors sockets gpm ipc serial dl dynlibs
+override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings linux ports initc dos crt objects printer graph ggigraph sysutils typinfo math cpu mmx getopts heaptrc lineinfo errors sockets gpm ipc serial dl dynlibs varutils
 override RSTOBJECTS+=math
 
 # Clean
@@ -230,7 +230,7 @@ endif
 
 LIBNAME=libfprtl.so
 LIBVERSION=1.0
-SHAREDLIBUNITOBJECTS=$(SYSTEMUNIT) objpas strings linux ports dos crt objects printer sysutils typinfo math cpu mmx getopts heaptrc errors sockets ipc dl dynlibs
+SHAREDLIBUNITOBJECTS=$(SYSTEMUNIT) objpas strings linux ports dos crt objects printer sysutils typinfo math cpu mmx getopts heaptrc errors sockets ipc dl dynlibs varutils
 
 # Info
 
@@ -928,7 +928,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
 endif
 endif
 
@@ -1093,7 +1093,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
 endif
 endif
 
@@ -1298,6 +1298,9 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/gettext.pp $(REDIR)
 
+varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp $(OBJPASDIR)/varutils.inc
+	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
+
 #
 # Other system-independent RTL Units
 #

rtl/linux/Makefile.fpc

@@ -9,7 +9,7 @@ units=$(SYSTEMUNIT) objpas strings \
       dos crt objects printer graph ggigraph \
       sysutils typinfo math \
       cpu mmx getopts heaptrc lineinfo \
-      errors sockets gpm ipc serial dl dynlibs
+      errors sockets gpm ipc serial dl dynlibs varutils
 
 rst=math
 
@@ -36,7 +36,7 @@ libunits=$(SYSTEMUNIT) objpas strings \
       dos crt objects printer \
       sysutils typinfo math \
       cpu mmx getopts heaptrc \
-      errors sockets ipc dl dynlibs
+      errors sockets ipc dl dynlibs varutils
 
 
 [presettings]
@@ -179,6 +179,9 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/gettext.pp $(REDIR)
 
+varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp $(OBJPASDIR)/varutils.inc
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
+
 #
 # Other system-independent RTL Units
 #

rtl/objpas/makefile.op

@@ -11,4 +11,3 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 
 math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
-

rtl/objpas/varutils.inc

@@ -0,0 +1,724 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Variant routines for non-windows oses.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ ---------------------------------------------------------------------
+    Some general stuff: Error handling and so on.
+  ---------------------------------------------------------------------}
+  
+
+Resourcestring
+
+  SNoWidestrings = 'No widestrings supported';
+  SNoInterfaces  = 'No interfaces supported';
+
+Procedure NoWidestrings;
+
+begin
+  Raise Exception.Create(SNoWideStrings);
+end;
+
+Procedure NoInterfaces;
+
+begin
+  Raise Exception.Create(SNoInterfaces);
+end;
+
+Constructor EVariantError.CreateCode (Code : longint);
+
+begin
+  ErrCode:=Code;
+end;
+  
+Procedure VariantTypeMismatch;
+  
+begin
+  Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
+end;
+
+Function ExceptionToVariantError (E : Exception): HResult;
+
+begin
+  If E is EoutOfMemory then
+    Result:=VAR_OUTOFMEMORY
+  else
+    Result:=VAR_EXCEPTION;
+end;
+
+Procedure SetUnlockResult (P : PVarArray; Res : HResult);
+
+begin
+  If Res=VAR_OK then
+    Res:=SafeArrayUnlock(P)
+  else
+    SafeArrayUnlock(P);
+end;
+
+{ ---------------------------------------------------------------------
+    Basic variant handling.
+  ---------------------------------------------------------------------}
+
+function VariantInit(var Varg: TVarData): HRESULT;stdcall;
+begin
+  With Varg do 
+    begin
+    VType:=varEmpty;
+    FillChar(VBytes, SizeOf(VBytes), 0);
+    end;
+  Result:=VAR_OK;
+end;
+
+function VariantClear(var Varg: TVarData): HRESULT;stdcall;
+begin
+  With Varg do
+    if (VType and varArray) <> 0 then
+      Exit(SafeArrayDestroy(VArray))
+    else
+      begin
+      if (VType and varByRef) = 0 then
+        case VType of
+          varEmpty, varNull, varSmallint, varInteger, varSingle, varDouble,
+          varCurrency, varDate, varError, varBoolean, varByte:;
+          varOleStr:
+            NoWideStrings;
+          varDispatch,
+          varUnknown:
+            NoInterfaces;
+        else
+          exit(VAR_BADVARTYPE)
+        end;
+    end;
+  Result:=VariantInit(Varg);
+end;
+
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT;stdcall;
+begin
+  if @VargSrc = @VargDest then
+    Exit(VAR_OK);
+  Result:=VariantClear(VargDest);
+  if Result<>VAR_OK then
+    exit;
+  With VargSrc do
+    begin   
+    if (VType and varArray) <> 0 then
+      Result:=SafeArrayCopy(VArray,VargDest.VArray)
+    else
+      begin
+      if (VType and varByRef) <> 0 then
+        VArgDest.VPointer:=VPointer
+      else
+        case (VType and varTypeMask) of
+          varEmpty, varNull:;
+          varSmallint, varInteger, varSingle, varDouble, varCurrency,
+          varDate, varError, varBoolean, varByte:
+            Move(VBytes, VargDest.VBytes, SizeOf(VargDest.VBytes));
+          varOleStr:
+            NoWideStrings; // We should copy here...
+          varDispatch,
+          varUnknown:
+            NoInterfaces; // We should bump up reference count here (Addref)
+          else
+            Exit(VAR_BADVARTYPE);
+          end;
+        end;
+    VargDest.VType:=VType;
+    end;
+end;
+
+function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT;stdcall;
+
+begin
+  if (VargSrc.VType and varByRef) = 0 then 
+    Exit(VariantCopy(VargDest, VargSrc));
+  With VargSrc do   
+    begin
+    if (VType and varArray) <> 0 then
+      Exit(VAR_INVALIDARG);
+    case (VType and varTypeMask) of
+      varEmpty, varNull:;
+      varSmallint : VargDest.VSmallInt:=PSmallInt(VPointer)^;
+      varInteger  : VargDest.VInteger:=PLongint(VPointer)^;
+      varSingle   : VargDest.VSingle:=PSingle(VPointer)^;
+      varDouble   : VargDest.VDouble:=PDouble(VPointer)^;
+      varCurrency : VargDest.VCurrency:=PCurrency(VPointer)^;
+      varDate     : VargDest.VDate:=PDate(VPointer)^;
+      varBoolean  : VargDest.VBoolean:=PWordBool(VPointer)^;
+      varError    : VargDest.VError:=PError(VPointer)^;
+      varByte     : VargDest.VByte:=PByte(VPointer)^;
+      varVariant  : // Variant(VargDest):=PVariant(VPointer)^
+        ; 
+      varOleStr   : NoWideStrings;
+      varDispatch,
+      varUnknown  : NoInterfaces;
+      else
+        Exit(VAR_BADVARTYPE);
+      end;
+    VargDest.VType:=VType and VarTypeMask; 
+    end;
+  Result:=VAR_OK;
+end;
+
+  
+
+
+Function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData;
+  LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
+var
+  Tmp : TVarData;
+begin
+  if ((VarType and varArray) <> 0) or 
+     ((VargSrc.VType and varArray) <> 0) or
+     ((VarType and varByRef) <> 0) then
+    Exit(VAR_INVALIDARG);
+  Result:=VariantCopyInd(Tmp, VargSrc);
+  if Result = VAR_OK then
+    try
+    Result:=VariantClear(VargDest);
+    {$RANGECHECKS ON}
+    if Result = VAR_OK then
+      try
+        case Vartype of
+          varSmallInt : VargDest.VSmallInt:=VariantToSmallInt(Tmp);
+          varInteger  : VargDest.VInteger:=VariantToLongint(Tmp);  
+          varSingle   : VargDest.VSingle:=VariantToSingle(Tmp);
+          varDouble   : VargDest.VDouble:=VariantToDouble(Tmp);
+          varCurrency : VargDest.VCurrency:=VariantToCurrency(Tmp);
+          varDate     : VargDest.VDate:=VariantToDate(tmp);
+          varOleStr   : NoWidestrings;  
+          varDispatch : Result:=VAR_TYPEMISMATCH;
+          varUnknown  : Result:=VAR_TYPEMISMATCH;
+          varBoolean  : VargDest.VBoolean:=VariantToBoolean(Tmp);
+          varByte     : VargDest.VByte:=VariantToByte(Tmp);
+       else
+          Result:=VAR_BADVARTYPE;
+       end;
+       If Result = VAR_OK then
+         VargDest.VType:=VarType;
+      except
+        On E : EVariantError do
+          Result:=E.ErrCode;
+        else
+          Result:=VAR_INVALIDARG;
+      end;
+    finally
+      VariantClear(Tmp);
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+    Variant array support
+  ---------------------------------------------------------------------}
+  
+Function CheckArrayUnlocked (psa : PVarArray) : HResult;
+
+begin
+  If psa^.LockCount = 0 Then
+    Result:=VAR_OK
+  else
+    Result:=VAR_ARRAYISLOCKED;
+end;
+
+Function CheckVarArray(psa: PVarArray ): HRESULT;
+
+begin
+  If psa=nil then
+    Result:=VAR_INVALIDARG
+  else
+    Result:=VAR_OK;
+end;
+
+Function SafeArrayCalculateElementAddress(psa: PVarArray; aElement: Integer): Pointer;
+
+begin
+  Result:=Pointer(Integer(psa^.Data)+(aElement*psa^.ElementSize));
+end;
+
+Function CheckVarArrayAndCalculateAddress(psa: PVarArray;
+  Indices: PVarArrayCoorArray; var Address: Pointer; Lockit: Boolean): HRESULT;
+
+  Function CountElements(D: Longint): Longint;
+  begin                        
+    if (D<psa^.DimCount) then
+      Result:=CountElements(D+1)+psa^.Bounds[D-1].ElementCount
+    else  
+      Result:=1;
+  end;
+
+var
+  LB,HB,I,Count : LongInt;
+
+begin
+  Result:=CheckVarArray(psa);
+  Address:=nil;
+  Count:=0;
+  If Result<>VAR_OK then 
+    exit;
+  for I:=1 to psa^.DimCount do
+    begin
+    LB:=psa^.Bounds[I-1].LowBound;
+    HB:=LB+psa^.Bounds[I-1].ElementCount;
+    if (LB=HB) or ((Indices^[I-1]< LB) or(Indices^[I-1]>HB)) then
+      Exit(VAR_BADINDEX);
+    Count:=Count+(Indices^[I-1]-LB)*CountElements(I+1);
+  end;
+  Address:=SafeArrayCalculateElementAddress(psa, Count);
+  if LockIt then
+    Result:=SafeArrayLock(psa);
+end;
+
+Function SafeArrayElementTotal(psa: PVarArray): Integer;
+
+var
+  I: Integer;
+
+begin
+  Result:=1;
+  With psa^ do
+   for I:=0 to DimCount - 1 do
+     Result:=Result*Bounds[I].ElementCount;
+end;
+
+type
+  TVariantArrayType = (vatNormal, varInterface, varWideString);
+
+Function VariantArrayType(psa: PVarArray): TVariantArrayType;
+
+begin
+  if ((psa^.Flags and ARR_DISPATCH) <> 0) or
+     ((psa^.Flags and ARR_UNKNOWN) <> 0) then
+    Result:=varInterface
+  else if (psa^.Flags AND ARR_OLESTR) <> 0 then
+    Result:=varWideString
+  else
+    Result:=vatNormal;
+end;
+
+Function SafeArrayClearDataSpace(psa: PVarArray; WipeBytes: Boolean {= True}): HRESULT;
+
+var
+  I :  Integer;
+  vat: TVariantArrayType;
+  
+begin
+  try
+    vat:=VariantArrayType(psa);
+    case vat of
+      vatNormal     : FillChar(psa^.Data^,
+                         SafeArrayElementTotal(psa)*psa^.ElementSize, 
+                         0);
+      varInterface  : NoInterfaces;
+      varWideString : NoWidestrings;
+    end;
+    Result:=VAR_OK;
+  except
+    On E : Exception do 
+      Result:=ExceptionToVariantError (E);
+  end;
+end;
+
+Function SafeArrayCopyDataSpace(psa, psaOut: PVarArray): HRESULT;
+var
+  I : Integer;
+  vVargSrc, vTarget: Pointer;
+  vat: TVariantArrayType;
+begin
+  try
+    vat:=VariantArrayType(psa);
+    case vat of
+      vatNormal: Move(psa^.Data^, 
+                      psaOut^.Data^, 
+                      SafeArrayElementTotal(psa)*psa^.ElementSize);
+      varInterface : NoInterfaces; // Copy element per element...
+      varWideString: NoWideStrings; // here also...
+    end;
+    Result:=VAR_OK;
+  except
+    On E : Exception do
+      Result:=ExceptionToVariantError(E);
+  end;
+end;
+
+Type 
+  TVartypes = varEmpty..varByte;
+  
+Const   
+  Supportedpsas : set of TVarTypes = 
+    [varSmallint,varInteger,varSingle,varDouble,varCurrency,varDate,varOleStr,
+     varDispatch,varError,varBoolean,varVariant,varUnknown,varByte];
+  psaElementSizes : Array [varEmpty..varByte] of Byte = 
+    (0,0,2,4,4,8,8,8,4,4,4,2,16,4,0,0,0,1);
+  psaElementFlags : Array [varEmpty..varByte] of Longint = 
+    (ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,
+     ARR_OLESTR,ARR_DISPATCH,ARR_NONE,ARR_NONE,ARR_NONE,ARR_UNKNOWN,
+     ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE);        
+
+Function SafeArrayCreate(VarType, Dims: Integer; const Bounds: TVarArrayBoundArray): PVarArray;stdcall;
+var
+  res : HRESULT;
+  I   : Longint;
+begin
+  Result:=nil;
+  if Not (VarType in Supportedpsas) Then
+    exit;
+  Res:=SafeArrayAllocDescriptor(Dims, Result);
+  if Res<>VAR_OK then
+    exit;
+  With Result^ do
+    begin
+    DimCount:=Dims;
+    Flags:=psaElementFlags[VarType];
+    ElementSize:=psaElementSizes[VarType];
+    for i:=0 to Dims-1 do
+      begin
+      Bounds[i].LowBound:=Bounds[Dims-I-1].LowBound;
+      Bounds[I].ElementCount:=Bounds[Dims-I-1].ElementCount;
+      end;
+    end;
+  res:=SafeArrayAllocData(Result);
+  if res<>VAR_OK then
+    begin
+    SafeArrayDestroyDescriptor(Result);
+    Result:=nil;
+    end;
+end;
+
+Function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT;stdcall;
+begin
+  try
+    psa:=GetMem(SizeOf(TVarArray) + SizeOf(TVarArrayBound) * (DimCount - 1));
+    Result:=VAR_OK;
+  except
+    On E : Exception do 
+      Result:=ExceptionToVariantError(E);
+  end;
+end;
+
+Function SafeArrayAllocData(psa: PVarArray): HRESULT;stdcall;
+begin
+  try
+    With psa^ do 
+      Data:=GetMem(SafeArrayElementTotal(psa)*ElementSize);
+    Result:=VAR_OK;
+  except
+    On E : Exception do 
+      Result:=ExceptionToVariantError(E);
+  end;
+end;
+
+Function SafeArrayDestroy(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<> VAR_OK then
+    exit;
+  Result:=CheckArrayUnlocked(psa);  
+  if Result<> VAR_OK then
+    exit;
+  Result:=SafeArrayDestroyData(psa);
+  if Result<>VAR_OK then
+    exit;
+  Result:=SafeArrayDestroyDescriptor(psa);
+end;
+
+Function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  Result:=CheckArrayUnlocked(psa);  
+  if Result<> VAR_OK then
+    exit;
+  try
+    FreeMem(psa);
+  except
+    On E : Exception do 
+      Result:=ExceptionToVariantError(E);
+  end;
+end;
+
+Function SafeArrayDestroyData(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  Result:=CheckArrayUnlocked(psa);  
+  if Result<> VAR_OK then
+    exit;
+  try
+    Result:=SafeArrayClearDataSpace(psa, False);
+    if (Result=VAR_OK) and ((psa^.Flags and ARR_FIXEDSIZE)=0) then
+      begin
+      FreeMem(psa^.Data);
+      psa^.Data:=nil;
+      end;
+  except
+    On E : Exception do
+      Result:=ExceptionToVariantError(E);
+  end;
+end;
+
+Function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT;stdcall;
+
+var
+  vat: TVariantArrayType;
+  i, D,j,count : Integer;
+  P : Pointer;
+  
+begin
+  Result:=CheckVarArray(psa);
+  if Result <> VAR_OK then
+    exit;
+  if (psa^.Flags and ARR_FIXEDSIZE) <> 0 then
+    Exit(VAR_INVALIDARG);
+  Result:=SafeArrayLock(psa);
+  if Result<>VAR_OK then
+    exit;
+  try
+    D:=NewBound.ElementCount - psa^.Bounds[0].ElementCount;
+    for i:=1 to psa^.DimCount - 1 do
+      D:=D*psa^.Bounds[i].ElementCount;
+    if D<>0 then
+      begin
+      Count:=SafeArrayElementTotal(psa);
+      if D<0 then
+        begin
+        vat:=VariantArrayType(psa);
+        for j:=Count-1 downto Count+D do 
+          begin
+          P:=SafeArrayCalculateElementAddress(psa,j);
+          if vat = varInterface then
+            NoInterfaces // Set to nil 
+          else 
+            NoWideStrings; // Set to empty...
+          end;
+        end;
+      ReAllocMem(psa^.Data,Count+D);
+      end;
+    psa^.Bounds[0].ElementCount:=NewBound.ElementCount;
+    psa^.Bounds[0].LowBound:=NewBound.LowBound;
+  except
+    On E : Exception do 
+      Result:=ExceptionToVariantError(E);
+  end;
+  SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayCopy(psa: PVarArray; var psaOut: PVarArray): HRESULT;stdcall;
+
+var
+  i : Integer;
+  
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  Result:=SafeArrayLock(psa);
+  if Result<>VAR_OK then
+    exit;
+  try
+    Result:=SafeArrayAllocDescriptor(psa^.DimCount,psaOut);
+    if Result<>VAR_OK then
+      Exit;
+    try
+      With psaOut^ do 
+        begin
+        Flags:=psa^.Flags;
+        ElementSize:=psa^.ElementSize;
+        DimCount:=psa^.DimCount;
+        for i:=0 to DimCount-1 do
+          begin
+          Bounds[i].ElementCount:=psa^.Bounds[i].ElementCount;
+          Bounds[i].LowBound:=psa^.Bounds[i].LowBound;
+          end;
+        end;  
+      Result:=SafeArrayAllocData(psaOut);
+      if Result<>VAR_OK then
+        exit;
+      Result:=SafeArrayCopyDataSpace(psa, psaOut);
+    finally
+      if Result<>VAR_OK then
+        begin
+        SafeArrayDestroyDescriptor(psaOut);
+        psaOut:=nil;
+        end;
+    end;
+  except
+    On E : Exception do
+      Result:=ExceptionToVariantError(E)
+  end;    
+  SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT;stdcall;
+var
+  i : Integer;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  Result:=CheckVarArray(psaOut);
+  if Result<>VAR_OK then
+    exit;
+  Result:=SafeArrayLock(psaOut);
+  if Result<>VAR_OK then
+    exit;
+  try
+    Result:=SafeArrayLock(psa);
+    if Result<>VAR_OK then
+     exit;
+    try
+      With psaOut^ do 
+        begin
+        if (psa^.Flags<>Flags) or
+           (psa^.ElementSize<>ElementSize) or 
+           (psa^.DimCount<>DimCount) then
+          Exit(VAR_INVALIDARG);
+        for i:=0 to psa^.DimCount - 1 do
+          if (psa^.Bounds[i].LowBound<>Bounds[i].LowBound) or
+             (psa^.Bounds[i].ElementCount<>Bounds[i].ElementCount) then
+            exit(VAR_INVALIDARG);
+        end;  
+      Result:=SafeArrayClearDataSpace(psaOut,True);
+      if Result<> VAR_OK then
+        exit;
+      Result:=SafeArrayCopyDataSpace(psa, psaOut);
+    finally
+      SetUnlockResult(psa,Result);
+    end;
+  finally
+    SetUnlockResult(psaOut,Result);
+  end;  
+end;
+
+Function SafeArrayGetLBound(psa: PVarArray; Dim: Integer; var LBound: Integer): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  if (Dim>0) and (Dim<=psa^.DimCount) then
+    LBound:=psa^.Bounds[Dim-1].LowBound
+  else  
+    Result:=VAR_BADINDEX;
+end;
+
+Function SafeArrayGetUBound(psa: PVarArray; Dim: Integer; var UBound: Integer): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  if (Dim>0) and (Dim<=psa^.DimCount) then
+    UBound:=psa^.Bounds[Dim-1].LowBound +
+            psa^.Bounds[Dim-1].ElementCount-1
+  else
+    Result:=VAR_BADINDEX
+end;
+
+Function SafeArrayGetDim(psa: PVarArray): Integer;stdcall;
+begin
+  if CheckVarArray(psa)<>VAR_OK then
+    Result:=0
+  else
+    Result:=psa^.DimCount;
+end;
+
+Function SafeArrayAccessData(psa: PVarArray; var ppvData: Pointer): HRESULT;stdcall;
+begin
+  Result:=SafeArrayLock(psa);
+  if Result<>VAR_OK then
+    ppvData:=nil
+  else
+    ppvData:=psa^.Data;
+end;
+
+Function SafeArrayUnaccessData(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=SafeArrayUnlock(psa);
+end;
+
+Function SafeArrayLock(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if Result<>VAR_OK then
+    exit;
+  Inc(psa^.LockCount);
+end;
+
+Function SafeArrayUnlock(psa: PVarArray): HRESULT;stdcall;
+begin
+  Result:=CheckVarArray(psa);
+  if (Result<>VAR_OK) then
+    exit;
+  If (psa^.LockCount>0) then
+    Dec(psa^.LockCount);
+end;
+
+Function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray;
+  Data: Pointer): HRESULT;stdcall;
+var
+  P: Pointer;
+begin
+  Result:=CheckVarArrayAndCalculateAddress(psa, Indices, P, True);
+  if Result<>VAR_OK then
+    exit;
+  try
+    case VariantArrayType(psa) of
+      vatNormal:
+        Move(P^, Data^, psa^.ElementSize);
+      varInterface:
+        NoInterfaces; // Just assign...
+      varWideString:
+        NoWideStrings; // Just assign...
+    end;
+  except
+    On E : Exception do
+      Result:=ExceptionToVariantError(E);
+  end;
+  SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray;
+  const Data: Pointer): HRESULT;stdcall;
+var
+  P: Pointer;
+begin
+  Result:=CheckVarArrayAndCalculateAddress(psa,Indices,P,True);
+  if Result<>VAR_OK then
+    exit;
+  try
+    case VariantArrayType(psa) of
+      vatNormal: Move(Data^,P^,psa^.ElementSize);
+      varInterface: NoInterfaces;
+      varWideString: NoWideStrings;
+    end;
+  except
+    On E : Exception do
+      Result:=ExceptionToVariantError(E);
+  end;
+  SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray;
+  var Address: Pointer): HRESULT;stdcall;
+begin
+  Result:=CheckVarArrayAndCalculateAddress(psa,Indices,Address,False);
+end;
+
+Function SafeArrayGetElemSize(psa: PVarArray): LongWord;stdcall;
+begin
+  if CheckVarArray(psa)<>VAR_OK then
+    Result:=0
+  else
+    Result:=psa^.ElementSize;
+end;

rtl/objpas/varutils.pp

@@ -0,0 +1,347 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Interface and OS-independent part of variant support
+       
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+Type
+
+  // Types needed to make this work. These should be moved to the system unit.
+  
+  currency            = int64;
+  HRESULT             = Longint;
+  PSmallInt           = ^Smallint;
+  PLongint            = ^Longint;
+  PSingle             = ^Single;
+  PDouble             = ^Double;    
+  PCurrency           = ^Currency;
+  TDateTime           = Double;
+  PDate               = ^TDateTime;
+  PPWideChar          = ^PWideChar;    
+  Error               = Longint;  
+  PError              = ^Error;
+  PWordBool           = ^WordBool;
+  PByte               = ^Byte;
+ 
+  EVarianterror = Class(Exception)
+    ErrCode : longint;
+    Constructor CreateCode(Code : Longint);
+  end;
+  
+  TVarArrayBound = packed record
+    ElementCount: Longint;
+    LowBound: Longint;
+  end;
+  TVarArrayBoundArray = Array [0..0] of TVarArrayBound;
+  PVarArrayBoundArray = ^TVarArrayBoundArray;
+  TVarArrayCoorArray  = Array [0..0] of Longint;
+  PVarArrayCoorArray  = ^TVarArrayCoorArray;
+
+  PVarArray = ^TVarArray;
+  TVarArray = packed record
+    DimCount: Word;
+    Flags: Word;
+    ElementSize: Longint;
+  LockCount: Integer;
+    Data: Pointer;
+    Bounds: TVarArrayBoundArray;
+  end;
+      
+  TVarType = Word;
+  PVarData = ^TVarData;
+  TVarData = packed record
+    VType: TVarType;
+    case Integer of
+      0: (Reserved1: Word;
+          case Integer of
+            0: (Reserved2, Reserved3: Word;
+                case Integer of
+                  varSmallInt: (VSmallInt: SmallInt);
+                  varInteger:  (VInteger: Longint);
+                  varSingle:   (VSingle: Single);
+                  varDouble:   (VDouble: Double);
+                  varCurrency: (VCurrency: Currency);
+                  varDate:     (VDate: Double);
+                  varOleStr:   (VOleStr: PWideChar);
+                  varDispatch: (VDispatch: Pointer);
+                  varError:    (VError: LongWord);
+                  varBoolean:  (VBoolean: WordBool);
+                  varUnknown:  (VUnknown: Pointer);
+                  varByte:     (VByte: Byte);
+                  varString:   (VString: Pointer);
+                  varAny:      (VAny: Pointer);
+                  varArray:    (VArray: PVarArray);
+                  varByRef:    (VPointer: Pointer);
+         );
+            1: (VLongs: array[0..2] of LongInt);
+         );
+      2: (VWords: array [0..6] of Word);
+      3: (VBytes: array [0..13] of Byte);
+  end;
+  Variant = TVarData;
+  PVariant = ^Variant;
+
+{ Variant functions }  
+
+function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
+function VariantClear(var Varg: TVarData): HRESULT; stdcall;
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
+function VariantCopyInd(var VargDest: TVarData;  const VargSrc: TVarData): HRESULT; stdcall;
+function VariantInit(var Varg: TVarData): HRESULT; stdcall;
+
+{  Variant array functions }
+
+function SafeArrayAccessData(psa: PVarArray; var ppvdata: Pointer): HRESULT; stdcall;
+function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;
+function SafeArrayCopy(psa: PVarArray; var psaout: PVarArray): HRESULT; stdcall;
+function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;
+function SafeArrayCreate(VarType, Dim: Integer; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;
+function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayGetDim(psa: PVarArray): Integer; stdcall;
+function SafeArrayGetElemSize(psa: PVarArray): LongWord; stdcall;
+function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray;  Data: Pointer): HRESULT; stdcall;
+function SafeArrayGetLBound(psa: PVarArray; Dim: Integer;  var LBound: Integer): HRESULT; stdcall;
+function SafeArrayGetUBound(psa: PVarArray; Dim: Integer;  var UBound: Integer): HRESULT; stdcall;
+function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray;  var Address: Pointer): HRESULT; stdcall;
+function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray;  const Data: Pointer): HRESULT; stdcall;
+function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;
+function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;
+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 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;
+
+
+// Names match the ones in Borland varutils unit.
+
+const
+  VAR_OK            = HRESULT($00000000); 
+  VAR_TYPEMISMATCH  = HRESULT($80020005); 
+  VAR_BADVARTYPE    = HRESULT($80020008); 
+  VAR_EXCEPTION     = HRESULT($80020009); 
+  VAR_OVERFLOW      = HRESULT($8002000A); 
+  VAR_BADINDEX      = HRESULT($8002000B); 
+  VAR_ARRAYISLOCKED = HRESULT($8002000D); 
+  VAR_NOTIMPL       = HRESULT($80004001); 
+  VAR_OUTOFMEMORY   = HRESULT($8007000E); 
+  VAR_INVALIDARG    = HRESULT($80070057); 
+  VAR_UNEXPECTED    = HRESULT($8000FFFF); 
+
+  ARR_NONE          = $0000;  
+  ARR_FIXEDSIZE     = $0010;  
+  ARR_OLESTR        = $0100;
+  ARR_UNKNOWN       = $0200; 
+  ARR_DISPATCH      = $0400;
+  ARR_VARIANT       = $0800; 
+
+Implementation
+
+{$i varutils.inc}
+
+{ ---------------------------------------------------------------------
+    OS-independent functions not present in Windows
+  ---------------------------------------------------------------------}
+  
+Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=Round(VSingle);
+      VarDouble  : Result:=Round(VDouble);
+      VarCurrency: Result:=Round(VCurrency);
+      VarDate    : Result:=Round(VDate);
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=SmallInt(VBoolean);
+      VarByte    : Result:=VByte;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToLongint(Const VargSrc : TVarData) : Longint;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=Round(VSingle);
+      VarDouble  : Result:=Round(VDouble);
+      VarCurrency: Result:=Round(VCurrency);
+      VarDate    : Result:=Round(VDate);
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=Longint(VBoolean);
+      VarByte    : Result:=VByte;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToSingle(Const VargSrc : TVarData) : Single;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=VSingle;
+      VarDouble  : Result:=VDouble;
+      VarCurrency: Result:=VCurrency;
+      VarDate    : Result:=VDate;
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=Longint(VBoolean);
+      VarByte    : Result:=VByte;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToDouble(Const VargSrc : TVarData) : Double;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask)  of
+      VarSmallInt: Result:=VSmallInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=VSingle;
+      VarDouble  : Result:=VDouble;
+      VarCurrency: Result:=VCurrency;
+      VarDate    : Result:=VDate;
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=Longint(VBoolean);
+      VarByte    : Result:=VByte;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
+
+begin
+  Try 
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=FloatToCurr(VSingle);
+        VarDouble  : Result:=FloatToCurr(VDouble);
+        VarCurrency: Result:=VCurrency;
+        VarDate    : Result:=FloatToCurr(VDate);
+        VarOleStr  : NoWideStrings;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+    else
+      VariantTypeMismatch;
+    end;
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else  
+      Raise;  
+  end;   
+end;
+
+Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
+
+begin
+  Try 
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=FloatToDateTime(VSmallInt);
+        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);
+    else
+      VariantTypeMismatch;
+    end;
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;   
+end;
+
+Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt<>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;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToByte(Const VargSrc : TVarData) : Byte;
+
+begin
+  Try 
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=Round(VSingle);
+        VarDouble  : Result:=Round(VDouble);
+        VarCurrency: Result:=Round(VCurrency);
+        VarDate    : Result:=Round(VDate);
+        VarOleStr  : NoWideStrings;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+    else
+      VariantTypeMismatch;
+    end;
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else  
+      Raise;
+  end;   
+end;
+
+end.

rtl/win32/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v1.00 [2000/08/14]
+# Makefile generated by fpcmake v1.00 [2000/07/11]
 #
 
 defaultrule: all
@@ -198,7 +198,7 @@ endif
 # Targets
 
 override LOADEROBJECTS+=wprt0 wdllprt0
-override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings windows ole2 opengl32 os_types winsock initc dos crt objects graph sysutils typinfo math cpu mmx getopts heaptrc lineinfo wincrt winmouse sockets printer dynlibs
+override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings windows ole2 opengl32 os_types winsock initc dos crt objects graph sysutils typinfo math cpu mmx getopts heaptrc lineinfo wincrt winmouse sockets printer dynlibs varutils
 override RSTOBJECTS+=math
 
 # Clean
@@ -921,7 +921,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
 endif
 endif
 
@@ -1086,7 +1086,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
 endif
 endif
 
@@ -1286,6 +1286,9 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
 
+varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp varutils.inc
+	$(COMPILER) -I. -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
+
 #
 # Other system-independent RTL Units
 #

rtl/win32/Makefile.fpc

@@ -9,7 +9,7 @@ units=$(SYSTEMUNIT) objpas strings \
       dos crt objects graph \
       sysutils typinfo math \
       cpu mmx getopts heaptrc lineinfo \
-      wincrt winmouse sockets printer dynlibs
+      wincrt winmouse sockets printer dynlibs varutils
 
 rst=math
 
@@ -160,6 +160,9 @@ typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
 
+varutils$(PPUEXT) : $(OBJPASDIR)/varutils.pp varutils.inc
+        $(COMPILER) -I. -I$(OBJPASDIR) $(OBJPASDIR)/varutils.pp $(REDIR)
+
 #
 # Other system-independent RTL Units
 #

rtl/win32/varutils.inc

@@ -0,0 +1,59 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Windows import statements for variant support.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ ---------------------------------------------------------------------
+    Windows external definitions.
+  ---------------------------------------------------------------------}
+
+const
+  oleaut = 'oleaut32.dll';
+
+{ Variant functions }  
+
+function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;external oleaut;
+function VariantClear(var Varg: TVarData): HRESULT; stdcall;external oleaut;
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;external oleaut;
+function VariantCopyInd(var VargDest: TVarData;  const VargSrc: TVarData): HRESULT; stdcall;external oleaut;
+function VariantInit(var Varg: TVarData): HRESULT; stdcall;external oleaut;
+
+{  Variant array functions }
+
+function SafeArrayAccessData(psa: PVarArray; var Data: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCopy(psa: PVarArray; var psaOut: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCreate(VarType, Dim: Integer; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;external oleaut;
+function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayGetDim(psa: PVarArray): Integer; stdcall;external oleaut;
+function SafeArrayGetElemSize(psa: PVarArray): LongWord; stdcall;external oleaut;
+function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray;  Data: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayGetLBound(psa: PVarArray; Dim: Integer;  var LBound: Integer): HRESULT; stdcall;external oleaut;
+function SafeArrayGetUBound(psa: PVarArray; Dim: Integer;  var UBound: Integer): HRESULT; stdcall;external oleaut;
+function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray;  var Address: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray;  const Data: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;external oleaut;
+function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;external oleaut;
+
+{
+  $Log$
+  Revision 1.1  2000-08-29 08:23:14  michael
+  + Initial implementation of varutils
+
+}