Implement INDEXSEEK() function

Author: Irwin1985

src/Runtime/XSharp.VFP.Tests/CommandTests.prg

@@ -167,6 +167,60 @@ BEGIN NAMESPACE XSharp.VFP.Tests
                 END TRY
             END TRY
         END METHOD
+
+        [Fact];
+        METHOD TestIndexSeek() AS VOID
+            VAR cOldDir := System.IO.Directory.GetCurrentDirectory()
+            VAR oDir := System.IO.Directory.CreateDirectory(Path.Combine(Path.GetTempPath(), ;
+                "IndexSeekTest_" + Guid.NewGuid():ToString("N")))
+            VAR cTempPath := oDir:FullName
+            TRY
+                SET DEFAULT TO (cTempPath)
+                CREATE TABLE SeekTest (Id INT, Name C(10))
+                INSERT INTO SeekTest VALUES(1, "Alpha")
+                INSERT INTO SeekTest VALUES(2, "Beta")
+                INSERT INTO SeekTest VALUES(3, "Gamma")
+                INDEX ON Name TAG NameIdx
+                // Found -> pointer must not move.
+                GO TOP
+                VAR nRec := RecNo()
+                Assert.True(IndexSeek("Beta"))
+                Assert.Equal((INT)nRec, (INT) RecNo())
+
+                // Not found -> pointer must not move
+                nRec := RecNo()
+                Assert.False(IndexSeek("Zeta"))
+                Assert.Equal((INT)nRec, (INT) RecNo())
+
+                // Found -> pointer must move
+                GO TOP
+                Assert.True(IndexSeek("Beta", .T.))
+                Assert.Equal("Beta", ALLTRIM(SeekTest.Name))
+
+                // Not found with lMovePointer = .T.
+                Assert.False(IndexSeek("Zeta", .T.))
+
+                // With alias string -> pointer must not move
+                GO TOP
+                nRec := RecNo()
+                Assert.True(IndexSeek("Gamma", .F., "SeekTest"))
+                Assert.Equal((INT)nRec, (INT) RecNo())
+
+                // With workarea number -> pointer must not move
+                GO TOP
+                nRec := RecNo()
+                Assert.True(IndexSeek("Alpha", .F., Select()))
+                Assert.Equal((INT)nRec, (INT) RecNo())
+
+                // Non-existent area -> must return false
+                Assert.False(IndexSeek("Alpha", .F., "NonExistent"))
+            FINALLY
+                XSharp.CoreDb.CloseAll()
+                SET DEFAULT TO (cOldDir)
+                System.IO.Directory.SetCurrentDirectory(cOldDir)
+                TRY ; System.IO.Directory.Delete(cTempPath, TRUE) ; CATCH ; END TRY
+            END TRY
+        END METHOD
     END CLASS
 
 END NAMESPACE

src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg

@@ -212,3 +212,68 @@ FUNCTION Target( nRelationshipNumber , uArea ) AS STRING CLIPPER
 [FoxProFunction("UNIQUE", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.Medium)];
 FUNCTION Unique(uArea ) AS LOGIC CLIPPER
     RETURN _DoInArea(uArea, { => (LOGIC) DbOrderInfo(DBOI_UNIQUE , NIL, NIL) } , FALSE,__FUNCTION__,1)
+
+/// <include file="VFPDocs.xml" path="Runtimefunctions/indexseek/*" />
+[FoxProFunction("INDEXSEEK", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.High)];
+FUNCTION IndexSeek( eExpression , lMovePointer , uArea, uIndex) AS LOGIC CLIPPER
+    @@Default(@lMovePointer, FALSE)
+
+    LOCAL nArea AS DWORD
+    IF IsNil(uArea)
+        nArea := RuntimeState.CurrentWorkarea
+    ELSEIF IsString(uArea)
+        nArea := RuntimeState.Workareas.FindAlias((STRING) uArea)
+    ELSEIF IsNumeric(uArea)
+        nArea := (DWORD) uArea
+    ELSE
+        RETURN FALSE
+    ENDIF
+    IF nArea == 0
+        RETURN FALSE
+    ENDIF
+
+    VAR nOldArea := RuntimeState.CurrentWorkarea
+    VAR lResult := FALSE
+    RuntimeState.CurrentWorkarea := nOldArea
+    TRY
+        VAR cOldOrder := ""
+        VAR cOldBag := ""
+        VAR lChangeOrder := FALSE
+
+        IF !IsNil(uIndex)
+            cOldOrder := OrdName()
+            cOldBag := ""
+            OrdSetFocus(uIndex)
+            lChangeOrder := TRUE
+        ENDIF
+
+        LOCAL nOldRecno := 0 AS DWORD
+        VAR lWasBof := FALSE
+
+        IF !lMovePointer
+            nOldRecno := RecNo()
+            lWasBof := Bof()
+        ENDIF
+
+        lResult := DbSeek(eExpression)
+
+        IF !lMovePointer
+            IF lWasBof
+                DbGoTop()
+                IF RecCount() > 0
+                    DbSkip(-1)
+                ENDIF
+            ELSE
+                DbGoto(nOldRecno)
+            ENDIF
+        ENDIF
+
+        IF lChangeOrder
+            OrdSetFocus(cOldOrder, cOldBag)
+        ENDIF
+    FINALLY
+        RuntimeState.CurrentWorkarea := nOldArea
+    END TRY
+
+    RETURN lResult
+

src/Runtime/XSharp.VFP/ToDo-HI.prg

@@ -12,13 +12,6 @@ FUNCTION InDbc( cDatabaseObjectName, cType ) AS LOGIC
     THROW NotImplementedException{}
     // RETURN FALSE
 
-/// <summary>-- todo --</summary>
-/// <include file="VFPDocs.xml" path="Runtimefunctions/indexseek/*" />
-[FoxProFunction("INDEXSEEK", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)];
-FUNCTION IndexSeek( eExpression , lMovePointer , uArea, uIndex) AS LOGIC
-    THROW NotImplementedException{}
-    // RETURN FALSE
-
 /// <summary>-- todo --</summary>
 /// <include file="VFPDocs.xml" path="Runtimefunctions/inputbox/*" />
 [FoxProFunction("INPUTBOX", FoxFunctionCategory.UIAndWindow, FoxEngine.UI, FoxFunctionStatus.Stub, FoxCriticality.High)];