Index: run/JvInterpreter.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvInterpreter.pas,v
retrieving revision 1.71
diff -u -r1.71 JvInterpreter.pas
--- run/JvInterpreter.pas	17 Jan 2006 20:40:36 -0000	1.71
+++ run/JvInterpreter.pas	18 Mar 2006 07:11:42 -0000
@@ -1033,6 +1033,8 @@
     procedure Clear(var V: TVarData); override;
     procedure Copy(var Dest: TVarData; const Source: TVarData;
       const Indirect: Boolean); override;
+    procedure CastTo(var Dest: TVarData; const Source: TVarData;
+      const AVarType: TVarType); override;
   end;
 
   TJvRecordVariantType = class(TJvSimpleVariantType);
@@ -1350,6 +1352,14 @@
 
 //=== { TJvSimpleVariantType } ===============================================
 
+procedure TJvSimpleVariantType.CastTo(var Dest: TVarData;
+  const Source: TVarData; const AVarType: TVarType);
+begin
+  //support only inherited classes
+  Dest.VPointer := Source.VPointer;
+  //inherited;
+end;
+
 procedure TJvSimpleVariantType.Clear(var V: TVarData);
 begin
   SimplisticClear(V);
@@ -1566,7 +1576,7 @@
       Result := SizeOf(Smallint);
     varDate:
       Result := SizeOf(Double);
-    varEmpty:
+    varEmpty, varVariant, varOleStr, varDispatch, varUnknown:
       Result := SizeOf(TVarData);
   else
     if ATyp = varObject then
@@ -1574,6 +1584,74 @@
   end;
 end;
 
+{$IFNDEF COMPILER6_UP}
+function VarArrayOffset(const A: Variant; const Indices: array of Integer):integer;
+var DimValue,h,l,Dim:integer;
+begin
+  for Dim:=1 to VarArrayDimCount(A) do begin
+    l:=VarArrayLowBound(A,Dim);
+    h:=VarArrayHighBound(A,Dim);
+    if Dim=1 then begin
+      result:=Indices[Dim-1]-l;
+      DimValue:=h-l+1;
+    end
+    else begin
+      result:=result+(Indices[Dim-1]-l)*DimValue;
+      DimValue:=(h-l+1)*DimValue;
+    end;
+  end;
+end;
+
+function VarArrayGet(const A: Variant; Indices: array of Integer): Variant;
+var
+  p,p1:pointer;
+  aVarType: Integer;
+begin
+  P:=VarArrayLock(A);
+  try
+    aVarType := VarType(A) and varTypeMask;
+    P1:=pointer(dword(P)+Typ2Size(aVarType)*VarArrayOffset(A,Indices));
+    if aVarType = varVariant then
+      result:=PVariant(p1)^
+    else begin
+      TVarData(result).VType:=aVarType;
+      Move(p1^,TVarData(result).VInteger,Typ2Size(aVarType));
+    end;
+  finally
+    VarArrayUnlock(A);
+  end;
+end;
+
+procedure VarArrayPut(const A: Variant; const Value: Variant; const Indices: array of Integer);
+var
+  p,p1:pointer;
+  aVarType: Integer;
+  Temp:TVarData;
+begin
+  P:=VarArrayLock(A);
+  try
+    aVarType := VarType(A) and varTypeMask;
+    P1:=pointer(dword(P)+Typ2Size(aVarType)*VarArrayOffset(A,Indices));
+
+    if aVarType = varVariant then
+      PVariant(P1)^ := Value
+    else
+    begin
+      VarCast(Variant(Temp), Value, aVarType);
+      case aVarType of
+        varOleStr, varDispatch, varUnknown:
+          P := Temp.VPointer;
+      else
+        P := @Temp.VPointer;
+      end;
+      Move(p^,P1^,Typ2Size(aVarType));
+    end;
+  finally
+    VarArrayUnlock(A);
+  end;
+end;
+{$ENDIF}
+
 function TypeName2VarTyp(const TypeName: string): Word;
 begin
   // (rom) reimplemented for speed
@@ -5600,9 +5678,7 @@
   VV: TJvInterpreterArrayValues;
   PP: PJvInterpreterArrayRec;
   Bound: Integer;
-  {$IFDEF COMPILER6_UP}
   AI: array of Integer;
-  {$ENDIF COMPILER6_UP}
 begin
   Result := False;
   if Args.Count <> 0 then
@@ -5648,8 +5724,7 @@
         Result := FSharedAdapter.GetElement(Self, Variable, Value, Args);
     end
     { for Variant Arrays }
-    {$IFDEF COMPILER6_UP}
-    // No support for variant arrays on Delphi 5 yet, sorry
+    // No support for variant arrays on Delphi 5 too :)
     else
     if VarIsArray(Variable) then
     begin
@@ -5672,7 +5747,6 @@
       Value := VarArrayGet(Variable, AI);
       Result := True;
     end
-    {$ENDIF COMPILER6_UP}
     else
       { problem }
       JvInterpreterError(ieArrayRequired, CurPos);
@@ -5686,9 +5760,7 @@
   VV: TJvInterpreterArrayValues;
   PP: PJvInterpreterArrayRec;
   Bound: Integer;
-  {$IFDEF COMPILER6_UP}
   AI: array of Integer;
-  {$ENDIF COMPILER6_UP}
 begin
   Result := False;
   if Args.Count <> 0 then
@@ -5732,8 +5804,7 @@
         Result := FSharedAdapter.SetElement(Self, Variable, Value, Args);
     end
     { for Variant Array }
-    {$IFDEF COMPILER6_UP}
-    // No support for variant arrays on Delphi 5 yet, sorry
+    // No support for variant arrays on Delphi 5 too :)
     else
     if VarIsArray(Variable) then
     begin
@@ -5756,7 +5827,6 @@
       VarArrayPut(Variable, Value, AI);
       Result := True;
     end
-    {$ENDIF COMPILER6_UP}
     else
       { problem }
       JvInterpreterError(ieArrayRequired, CurPos);
@@ -7005,36 +7075,43 @@
   end;
 
   procedure DoFinallyExcept(E: Exception);
+  var OldExit:boolean;
   begin
-    case TTyp of
-      ttFinally:
-        { do statements up to 'end' }
-        begin
-          InterpretBegin;
-          if E <> nil then
+    OldExit:=FExit;
+    try
+      FExit:=false;
+      case TTyp of
+        ttFinally:
+          { do statements up to 'end' }
           begin
-            ReRaiseException := True;
+            InterpretBegin;
+            if E <> nil then
+            begin
+              ReRaiseException := True;
+            end;
           end;
-        end;
-      ttExcept:
-        begin
-          if E = nil then
-            { skip except section }
-            SkipToEnd
-          else
-          { except section }
+        ttExcept:
           begin
-            try
-              InterpretExcept(E);
-            except
-              on E1: EJvInterpreterError do
-                if E1.ErrCode = ieRaise then
-                  ReRaiseException := True;
+            if E = nil then
+              { skip except section }
+              SkipToEnd
             else
-              raise;
+            { except section }
+            begin
+              try
+                InterpretExcept(E);
+              except
+                on E1: EJvInterpreterError do
+                  if E1.ErrCode = ieRaise then
+                    ReRaiseException := True;
+              else
+                raise;
+              end;
             end;
           end;
-        end;
+      end;
+    finally
+      FExit:=FExit or OldExit;
     end;
   end;