From 11beaf55afd52224dbaf148bd6836af06fc7c771 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:23:44 +0100 Subject: [PATCH 1/9] Fix build errors --- src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh | 4 ++-- src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg | 3 ++- src/Runtime/XSharp.SQLRdd/Metadata/Database.prg | 4 ++-- src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg | 4 ++-- 4 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh b/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh index 88b5f1926b..d25c3b118b 100644 --- a/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh +++ b/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh @@ -99,11 +99,11 @@ CLASS TestClass IMPLEMENTS IClassFixture Assert.Equal(LastRec(),91U) lOk := DbSeek("ANATR") Assert.Equal(lOk, TRUE) - VAR recno = Recno() + VAR Recno := Recno() Assert.Equal( recno, 2U) lOk := DbSeek("WOLZA") Assert.Equal(lOk, TRUE) - recno = Recno() + recno := Recno() Assert.Equal( recno, 91U) lOk := VODbCloseArea() Assert.Equal(lOk, TRUE) diff --git a/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg b/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg index a1b6e9f145..21d9c5402d 100644 --- a/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg +++ b/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg @@ -10,7 +10,7 @@ USING System USING System.Collections.Generic USING System.Text -NAMESPACE XSharp.RDD.SqlRDD.Providers +BEGIN NAMESPACE XSharp.RDD.SqlRDD.Providers /// /// The SqlMetadataProviderAbstract class. @@ -113,3 +113,4 @@ ABSTRACT CLASS SqlMetadataProviderAbstract IMPLEMENTS ISqlMetadataProvider END METHOD END CLASS +END NAMESPACE diff --git a/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg b/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg index 01a748f6c9..047b17ec1f 100644 --- a/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg +++ b/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg @@ -12,7 +12,7 @@ USING System.Collections.Generic USING System.Text using XSharp.RDD.Support -NAMESPACE XSharp.RDD.SqlRDD.Providers +BEGIN NAMESPACE XSharp.RDD.SqlRDD.Providers /// /// The SqlMetadataProviderDatabase class. Reads Metadata from tables in the database. @@ -578,5 +578,5 @@ end class INTERNAL CONST Ordinal := nameof(Ordinal) as string #endregion END CLASS - +END NAMESPACE diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg index cced23a900..6f2af289e0 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg @@ -16,7 +16,7 @@ using System.Data.Common using XSharp.RDD.SqlRDD.Providers #undef TRACERDD -namespace XSharp.RDD.SqlRDD +begin namespace XSharp.RDD.SqlRDD // Private methods and fields partial class SQLRDD @@ -643,5 +643,5 @@ partial class SQLRDD RETURN TRUE end class - +end namespace From e1d787b145887ad37650a36f05df7b58ec5f0a2d Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:37:09 +0100 Subject: [PATCH 2/9] small fix --- src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh b/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh index d25c3b118b..f5edfb5bf9 100644 --- a/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh +++ b/src/Runtime/XSharp.SQLRdd.Tests/TestClass.xh @@ -99,7 +99,7 @@ CLASS TestClass IMPLEMENTS IClassFixture Assert.Equal(LastRec(),91U) lOk := DbSeek("ANATR") Assert.Equal(lOk, TRUE) - VAR Recno := Recno() + VAR recno := Recno() Assert.Equal( recno, 2U) lOk := DbSeek("WOLZA") Assert.Equal(lOk, TRUE) From a9e89ba9516519517b34298849b89c3f9823c228 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:23:44 +0100 Subject: [PATCH 3/9] Fix build errors From c742f68689546d9c6506e913a28f4af451438430 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:37:09 +0100 Subject: [PATCH 4/9] small fix From 3622254c9ad3addeae4330ac32b42b71aa3f7837 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Mon, 30 Mar 2026 14:07:53 +0200 Subject: [PATCH 5/9] - Create lock table - Implement RLock, FLock and UnLock - Check locks when GoCold() - Refresh and cleanup locks --- .gitignore | 3 + src/Runtime/XSharp.RT/RDD/Db.prg | 6 +- .../XSharp.SQLRdd/Classes/Connection.prg | 88 +++++++++++++ src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg | 2 + src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg | 6 + .../XSharp.SQLRdd/DBMS/IDbProvider.prg | 7 +- src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg | 124 ++++++++++++++++++ .../XSharp.SQLRdd/RDD/SQLRDD-Private.prg | 66 ++++++++++ src/Tests/SqlRDDTests/Program.prg | 24 ++++ 9 files changed, 323 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index a9b6986b51..9458768c47 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,9 @@ bld/ # Visual Studio 2015 cache/options directory .vs/ +# DevExpress +.cr/ + # MSTest test Results [Tt]est[Rr]esult*/ [Bb]uild[Ll]og.* diff --git a/src/Runtime/XSharp.RT/RDD/Db.prg b/src/Runtime/XSharp.RT/RDD/Db.prg index 435ef8cbf5..1464c3192c 100644 --- a/src/Runtime/XSharp.RT/RDD/Db.prg +++ b/src/Runtime/XSharp.RT/RDD/Db.prg @@ -520,12 +520,14 @@ FUNCTION DbRecordInfo(kInfoType, uRecId, uNewValue) AS USUAL CLIPPER VoDb.RecordInfo(kInfoType, uRecId, REF uNewValue) RETURN uNewValue - - /// FUNCTION DbRLock(uRecId) AS USUAL CLIPPER RETURN VoDb.RLock(uRecId) + /// +FUNCTION DbFlock() AS USUAL CLIPPER + RETURN VoDb.Flock() + /// FUNCTION DbRLockList() AS ARRAY STRICT diff --git a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg index c63c0cee9e..ad22bfedce 100644 --- a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg +++ b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg @@ -15,6 +15,7 @@ using System.Data using System.Data.Common using XSharp.RDD.Enums using XSharp.RDD.SqlRDD.Providers +using XSharp.RDD.Support begin namespace XSharp.RDD.SqlRDD /// @@ -89,6 +90,8 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable property QuotedIdentifierCase as System.Data.Common.IdentifierCase auto get private set /// ProductName as returned by the Ado.Net provider in the DataSourceInformation metadata collection. property ProductName as string auto get private set + /// A unique id for each connection + internal property ConnectionId as Guid auto get #endregion @@ -248,6 +251,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable /// (Optional) CallBack constructor(cName as string, cConnectionString as string, @@Callback := null as SqlRDDEventHandler) super(cName) + ConnectionId := Guid.NewGuid() RDDs := List{} Schema := Dictionary{StringComparer.OrdinalIgnoreCase} Provider := SqlDbProvider.Current @@ -281,7 +285,9 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable SELF:_FillMetadataCollections() SELF:_FillDataSourceProperties() SELF:_CheckConnectionTable() + SELF:_CreateLockTable() SELF:_Login() + SELF:InitializeLockTimer() // Todo: Check for # of open users and close the connection when no users are left and then throw an exception return end constructor @@ -844,6 +850,88 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable return logValue endif return oValue + #endregion + + #region lock + internal const LockTableName := "xs_locks" AS STRING + + internal method XsLockColumnList() AS STRING + var sb := StringBuilder{} + foreach var lockFieldInfo in self:LockTableFields() + sb:Append(self:Provider:QuoteIdentifier(lockFieldInfo:ColumnName)) + sb:Append(",") + next + return sb:ToString().TrimEnd(',') + + + private method _CreateLockTable() as void + if self:DoesTableExist(LockTableName) + return + endif + + var sb := StringBuilder{} + foreach var rddFieldInfo in SELF:LockTableFields() + sb:Append(SELF:Provider:GetSqlColumnInfo(rddFieldInfo, SELF)) + sb:AppendLine(",") + next + var fieldList := sb:ToString().Trim().TrimEnd(',') + sb:Clear() + sb:Append(SELF:Provider:CreateTableStatement) + sb:Replace(SqlDbProvider.TableNameMacro, LockTableName) + sb:Replace(SqlDbProvider.FieldDefinitionListMacro, fieldList) + using var cmd := SqlDbCommand{"LockTable", SELF, false} + cmd:CommandText := sb:ToString() + cmd:ExecuteNonQuery() + + return + + private _lockTableFields as List + internal method LockTableFields() as List + if _lockTableFields == null + _lockTableFields := List{} + _lockTableFields:Add(RddFieldInfo{"Station", "C", 50, 0}) + _lockTableFields:Add(RddFieldInfo{"Username", "C", 50, 0}) + _lockTableFields:Add(RddFieldInfo{"ConnectionId", "C", 50, 0}) + _lockTableFields:Add(RddFieldInfo{"Workarea", "N", 0, 0}) + _lockTableFields:Add(RddFieldInfo{"ThreadId", "N", 0, 0}) + _lockTableFields:Add(RddFieldInfo{"LockDateTime", "T", 0, 0}) + _lockTableFields:Add(RddFieldInfo{"TableName", "C", 255, 0}) + _lockTableFields:Add(RddFieldInfo{"RecNo", "N", 0, 0}) + endif + return _lockTableFields + end method + + private method InitializeLockTimer() as void + var timer := System.Timers.Timer{20000} // 120 sec + timer:Elapsed += System.Timers.ElapsedEventHandler{ @@LockTimerElapsedEvent } + timer:AutoReset := true + timer:Enabled := true + return + + method LockTimerElapsedEvent(sender as object, e as System.Timers.ElapsedEventArgs) as void + var parameterName1 := Provider:ParameterPrefix + "p1" + var parameterName2 := Provider:ParameterPrefix + "p2" + + // Refresh my Locks + using var cmdRefresh := SqlDbCommand{"RefreshLockTable", SELF, false} + var updateStatement := Provider:UpdateStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName) + updateStatement := updateStatement:Replace(SqlDbProvider.ColumnsMacro, "lockdatetime = " + parameterName1) + updateStatement := updateStatement:Replace(SqlDbProvider.WhereMacro, "connectionid = " + parameterName2) + cmdRefresh:Parameters := List{} + cmdRefresh:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now}) + cmdRefresh:Parameters:Add(SqlDbParameter{parameterName2, SELF:ConnectionId:ToString()}) + cmdRefresh:CommandText := updateStatement + cmdRefresh:ExecuteNonQuery() + + // Clear all old locks + using var cmdClear := SqlDbCommand{"ClearLockTable", SELF, false} + cmdClear:CommandText := Provider:DeleteStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName):Replace(SqlDbProvider.WhereMacro, "LockDateTime < " + parameterName1) + cmdClear:Parameters := List{} + cmdClear:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now.AddSeconds(-120)}) + cmdClear:ExecuteNonQuery() + return + #endregion + end class end namespace diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg b/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg index 4d9ee64e5d..c676256643 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg @@ -33,6 +33,8 @@ class SqlDbProviderAdvantage inherit SqlDbProvider return end constructor + override property ParameterPrefix as string => ":" + private static aFuncs := null as Dictionary /// override method GetFunctions() as Dictionary diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg b/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg index 4cb187361a..0e74c3a687 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg @@ -331,6 +331,12 @@ abstract class SqlDbProvider inherit SqlDbObject implements ISqlDbProvider /// virtual property FalseLiteral as string => "false" + /// + /// + /// The default implementation returns the value "@" + /// + virtual property ParameterPrefix as string => "@" + #endregion diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg b/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg index 789106da38..cc53c40e22 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg @@ -29,7 +29,7 @@ interface ISqlDbProvider /// Type name of the DbProviderFactory /// property TypeName as string get - + /// /// Syntax for a Statement to calculate the row number /// @@ -93,6 +93,11 @@ interface ISqlDbProvider /// property FalseLiteral as string get + /// + /// Prefix for the SQL statement variable + /// + property ParameterPrefix as string get + /// /// Return a list of function translations for this provider /// diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg index b33ce9a021..15492333d3 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg @@ -376,6 +376,7 @@ partial class SQLRDD inherit Workarea endif return result + /// Write the contents of a work area's memory to the data store (usually a disk). /// override method GoCold() as logic @@ -386,8 +387,31 @@ partial class SQLRDD inherit Workarea var lWasHot := current:RowState != DataRowState.Unchanged local lOk := TRUE as logic if lWasHot .and. self:DataTable != null + + // Check file lock + var dbLockInfo := DbLockInfo{} + dbLockInfo:RecId := 0 + var myLock := false + var otherLock := false + SELF:CheckLock(dbLockInfo, StringBuilder{}, myLock, otherLock) + if (otherLock) + return false + endif + foreach var row in _updatedRows try + // Check row lock + dbLockInfo:RecId := row[_oTd:RecnoColumn] + SELF:CheckLock(dbLockInfo, StringBuilder{}, myLock, otherLock) + if otherLock + lOk := false + loop + endif + + if !myLock + SELF:Lock(ref dbLockInfo) + endif + lOk := true if super:Deleted local wasNew := false as logic @@ -432,6 +456,7 @@ partial class SQLRDD inherit Workarea next if lOk self:DataTable:AcceptChanges() + self:UnLock(0) else self:DataTable:RejectChanges() endif @@ -453,6 +478,7 @@ partial class SQLRDD inherit Workarea foreach var bag in self:OrderBagList bag:Close() next + self:UnLock(0) _connection:UnregisterRdd(self) lOk := super:Close() @@ -796,6 +822,104 @@ partial class SQLRDD inherit Workarea RETURN SUPER:SetFilter(info) end method + #region Lock / Unlock + + public override method Lock(lockInfo ref DbLockInfo) as logic + // TODO thomas: implement Multiple Lock + var sb := StringBuilder{} + var messageLocked := StringBuilder{} + + try + var otherLock := false + var myLock := false + self:CheckLock(lockInfo, messageLocked, ref myLock, ref otherLock) + + if otherLock + lockInfo:Result := false + // TODO: thomas add message to output + return false + endif + + if myLock + lockInfo:Result := true + return true + endif + + // Write Lock + sb:Clear() + sb:Append(self:Connection:Provider:InsertStatement) + sb:Replace(SqlDbProvider.TableNameMacro, SqlDbConnection.LockTableName) + sb:Replace(SqlDbProvider.ColumnsMacro, self:Connection:XsLockColumnList()) + sb:Replace(SqlDbProvider.ValuesMacro, self:Provider:ParameterPrefix+"p1, "+self:Provider:ParameterPrefix+"p2, "+ ; + self:Provider:ParameterPrefix+"p3, "+self:Provider:ParameterPrefix+"p4, "+self:Provider:ParameterPrefix+"p5, "+ ; + self:Provider:ParameterPrefix+"p6, "+self:Provider:ParameterPrefix+"p7, "+self:Provider:ParameterPrefix+"p8") + + using var cmdInsertLock := SqlDbCommand{"InsertLock", self:Connection, false} + cmdInsertLock:CommandText := sb:ToString() + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p1", Environment.MachineName ?? String.Empty) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p2", Environment.UserName ?? String.Empty) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p3", self:Connection:ConnectionId:ToString()) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p4", (int)super:Area) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p5", System.Threading.Thread.CurrentThread.ManagedThreadId) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p6", DateTime.Now) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p7", _oTd:RealName ?? String.Empty) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p8", SELF:LockRecNo(lockInfo)) + + if !cmdInsertLock:ExecuteNonQuery() + messageLocked:AppendLine("Could not create lock") + // TODO: thomas add message to output + lockInfo:Result := false + return false + endif + catch + messageLocked:AppendLine("An error occured while locking") + // TODO: thomas add message to output + lockInfo:Result := false + return false + end try + + lockInfo:Result := true + return true + end method + + public override method UnLock(oRecId as object) as logic + try + var sb := StringBuilder{} + var sbWhere := StringBuilder{} + + sbWhere:AppendLine(" station = "+self:Provider:ParameterPrefix+"p1") + sbWhere:AppendLine(" and username = "+self:Provider:ParameterPrefix+"p2") + sbWhere:AppendLine(" and connectionid = "+self:Provider:ParameterPrefix+"p3") + sbWhere:AppendLine(" and tablename = "+self:Provider:ParameterPrefix+"p4") + sbWhere:AppendLine(" and workarea = "+self:Provider:ParameterPrefix+"p5") + if oRecId != null .and. oRecId is int .and. ((int)oRecId) > 0 + sbWhere:AppendLine(" and recno = "+self:Provider:ParameterPrefix+"p6") + endif + + sb:Append(self:Provider:DeleteStatement) + sb:Replace(SqlDbProvider.TableNameMacro, SqlDbConnection.LockTableName) + sb:Replace(SqlDbProvider.WhereMacro, sbWhere:ToString()) + + using var cmd := SqlDbCommand{"ConnectionCleanupLock", self:Connection, false} + cmd:CommandText := sb:ToString() + cmd:AddParameter(self:Provider:ParameterPrefix+"p1", Environment.MachineName ?? String.Empty) + cmd:AddParameter(self:Provider:ParameterPrefix+"p2", Environment.UserName ?? String.Empty) + cmd:AddParameter(self:Provider:ParameterPrefix+"p3", self:Connection:ConnectionId:ToString()) + cmd:AddParameter(self:Provider:ParameterPrefix+"p4", _oTd:RealName ?? String.Empty) + cmd:AddParameter(self:Provider:ParameterPrefix+"p5", (int)super:Area) + if oRecId != null .and. oRecId is int .and. ((int)oRecId) > 0 + cmd:AddParameter(self:Provider:ParameterPrefix+"p6", (int)oRecId) + endif + cmd:ExecuteNonQuery() + catch + return false + end try + + return true + end method + + #endregion + end class end namespace // XSharp.RDD.SqlRDD diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg index a8fde2d65b..28b043cd8a 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg @@ -644,6 +644,72 @@ partial class SQLRDD SELF:_CheckEofBof() RETURN TRUE + PRIVATE METHOD LockRecNo(lockInfo ref DbLockInfo) AS INT + var lockRecNo := 0 + if lockInfo:Method != XSharp.RDD.Support.DbLockInfo.LockMethod.File + if lockInfo:RecId != null .and. lockInfo:RecId is int + lockRecNo := (int)lockInfo:RecId + else + lockRecNo := (int)self:RecNo + endif + endif + RETURN lockRecNo + + /// + /// Check if someone else (or me) has the lock + /// + /// + /// + /// + /// + PRIVATE METHOD CheckLock(lockInfo AS DbLockInfo, messageLocked AS StringBuilder, myLock REF LOGIC, otherLock REF LOGIC) AS VOID + var sb := StringBuilder{} + sb:AppendLine("select " + self:Connection:XsLockColumnList()) + sb:AppendLine("from " + SqlDbConnection.LockTableName) + sb:AppendLine("where tablename = "+self:Provider:ParameterPrefix+"p1") + if lockInfo:Method != XSharp.RDD.Support.DbLockInfo.LockMethod.File + sb:AppendLine(" AND (recno = "+self:Provider:ParameterPrefix+"p2 OR recno = 0)") + endif + + using var cmdCheckLock := SqlDbCommand{"CheckLock", self:Connection, false} + cmdCheckLock:CommandText := sb:ToString() + cmdCheckLock:AddParameter(self:Provider:ParameterPrefix+"p1",_oTd:RealName) + if lockInfo:Method != XSharp.RDD.Support.DbLockInfo.LockMethod.File + if lockInfo:RecId != null .and. lockInfo:RecId is int + cmdCheckLock:AddParameter(self:Provider:ParameterPrefix+"p2",(int)lockInfo:RecId) + else + lockInfo:RecId := self:RecNo + cmdCheckLock:AddParameter(self:Provider:ParameterPrefix+"p2",(int)self:RecNo) + endif + endif + + using var reader := cmdCheckLock:ExecuteReader() + do while reader:Read() + var recNoTemp := (int)reader["recno"] + var station := reader["station"]:ToString() + var username := reader["username"]:ToString() + var connectionId := reader["connectionid"]:ToString() + var workarea := (int)reader["workarea"] + var threadId := (int)reader["threadid"] + + if (station = (Environment.MachineName ?? String.Empty) .and. ; + username = (Environment.UserName ?? String.Empty) .and. ; + connectionId = self:Connection:ConnectionId:ToString() .and. ; + workarea = (int)super:Area .and. ; + threadId = System.Threading.Thread.CurrentThread.ManagedThreadId) + if (lockInfo:Method = XSharp.RDD.Support.DbLockInfo.LockMethod.File .and. recNoTemp = 0) .or. ; + (lockInfo:Method != XSharp.RDD.Support.DbLockInfo.LockMethod.File .and. recNoTemp = SELF:LockRecNo(lockInfo)) + myLock := true + endif + else + myLock |= false + var lockType := iif(recNoTemp = 0, "file", "record") + messageLocked:AppendLine(i"User {username} on station {station} has the {lockType}lock") + otherLock := true + endif + end do + reader:Dispose() + end class end namespace diff --git a/src/Tests/SqlRDDTests/Program.prg b/src/Tests/SqlRDDTests/Program.prg index a24e886b52..1071b41d40 100644 --- a/src/Tests/SqlRDDTests/Program.prg +++ b/src/Tests/SqlRDDTests/Program.prg @@ -37,6 +37,7 @@ function Start as void //testCreate() //FillGsTutor() //TestGsTutor() + //TestLock() wait return @@ -873,6 +874,29 @@ FUNCTION TestGsTutor() AS VOID END TRY RETURN + function TestLock() as void + SqlDbSetProvider("SQLSERVER") + var handle := SqlDbOpenConnection(SqlConnStr) + var conn := SqlDbGetConnection(handle) + conn:MetadataProvider := SqlMetaDataProviderDatabase{conn} + conn:CallBack += @@EventHandler + ? handle + VoDbUseArea(true, "SQLRDD","Customers","Customers",true, false) + DbGoTo(3) + DbRLock() + FieldPut(2, "New Company1") + //DbCommit() + + System.Console.ReadLine() + + // UBLIC VIRTUAL METHOD RecordInfo(kRecInfoType, nRecordNumber, uRecVal) AS USUAL CLIPPER + //var test := DbRecordInfo(DBRI_LOCKED, 3) + +// DbRLock(4) +// DbFlock() +// DbUnlock(3) + //conn:Clode() + FUNCTION GetGlobal() AS usual CLIPPER From 27d59011059c876a73c3fb9be10fe526162f5976 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Mon, 30 Mar 2026 16:06:32 +0200 Subject: [PATCH 6/9] Use SQL-Server timestamp for lock instead of server-datetime.now --- src/Runtime/XSharp.SQLRdd/Classes/Connection.prg | 16 +++++++--------- src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg | 2 ++ src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg | 5 +++++ src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg | 5 +++++ src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg | 7 +++---- src/Tests/SqlRDDTests/Program.prg | 4 ++-- 6 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg index ad22bfedce..d34472caf7 100644 --- a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg +++ b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg @@ -902,30 +902,28 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable end method private method InitializeLockTimer() as void - var timer := System.Timers.Timer{20000} // 120 sec + var timer := System.Timers.Timer{120000} // 120 sec timer:Elapsed += System.Timers.ElapsedEventHandler{ @@LockTimerElapsedEvent } timer:AutoReset := true timer:Enabled := true return method LockTimerElapsedEvent(sender as object, e as System.Timers.ElapsedEventArgs) as void - var parameterName1 := Provider:ParameterPrefix + "p1" - var parameterName2 := Provider:ParameterPrefix + "p2" + var parameterName1 := SELF:Provider:ParameterPrefix + "p1" // Refresh my Locks using var cmdRefresh := SqlDbCommand{"RefreshLockTable", SELF, false} - var updateStatement := Provider:UpdateStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName) - updateStatement := updateStatement:Replace(SqlDbProvider.ColumnsMacro, "lockdatetime = " + parameterName1) - updateStatement := updateStatement:Replace(SqlDbProvider.WhereMacro, "connectionid = " + parameterName2) + var updateStatement := SELF:Provider:UpdateStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName) + updateStatement := updateStatement:Replace(SqlDbProvider.ColumnsMacro, "lockdatetime = " + SELF:Provider:CurrentDateTime) + updateStatement := updateStatement:Replace(SqlDbProvider.WhereMacro, "connectionid = " + parameterName1) cmdRefresh:Parameters := List{} - cmdRefresh:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now}) - cmdRefresh:Parameters:Add(SqlDbParameter{parameterName2, SELF:ConnectionId:ToString()}) + cmdRefresh:Parameters:Add(SqlDbParameter{parameterName1, SELF:ConnectionId:ToString()}) cmdRefresh:CommandText := updateStatement cmdRefresh:ExecuteNonQuery() // Clear all old locks using var cmdClear := SqlDbCommand{"ClearLockTable", SELF, false} - cmdClear:CommandText := Provider:DeleteStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName):Replace(SqlDbProvider.WhereMacro, "LockDateTime < " + parameterName1) + cmdClear:CommandText := SELF:Provider:DeleteStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName):Replace(SqlDbProvider.WhereMacro, "LockDateTime < " + parameterName1) cmdClear:Parameters := List{} cmdClear:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now.AddSeconds(-120)}) cmdClear:ExecuteNonQuery() diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg b/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg index c676256643..34c4ff04b5 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/Advantage.prg @@ -35,6 +35,8 @@ class SqlDbProviderAdvantage inherit SqlDbProvider override property ParameterPrefix as string => ":" + override property CurrentDateTime as string => "NOW()" + private static aFuncs := null as Dictionary /// override method GetFunctions() as Dictionary diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg b/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg index 0e74c3a687..e7eb0e7a77 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/DbProvider.prg @@ -337,6 +337,11 @@ abstract class SqlDbProvider inherit SqlDbObject implements ISqlDbProvider /// virtual property ParameterPrefix as string => "@" + /// + /// SQL statement to get the current datetime/timestamp + /// + virtual property CurrentDateTime as string => "CURRENT_TIMESTAMP" + #endregion diff --git a/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg b/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg index cc53c40e22..7b8c368d24 100644 --- a/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg +++ b/src/Runtime/XSharp.SQLRdd/DBMS/IDbProvider.prg @@ -98,6 +98,11 @@ interface ISqlDbProvider /// property ParameterPrefix as string get + /// + /// SQL statement to get the current datetime + /// + property CurrentDateTime as string get + /// /// Return a list of function translations for this provider /// diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg index 15492333d3..3927798e28 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg @@ -852,7 +852,7 @@ partial class SQLRDD inherit Workarea sb:Replace(SqlDbProvider.ColumnsMacro, self:Connection:XsLockColumnList()) sb:Replace(SqlDbProvider.ValuesMacro, self:Provider:ParameterPrefix+"p1, "+self:Provider:ParameterPrefix+"p2, "+ ; self:Provider:ParameterPrefix+"p3, "+self:Provider:ParameterPrefix+"p4, "+self:Provider:ParameterPrefix+"p5, "+ ; - self:Provider:ParameterPrefix+"p6, "+self:Provider:ParameterPrefix+"p7, "+self:Provider:ParameterPrefix+"p8") + self:Provider:CurrentDateTime + ", "+self:Provider:ParameterPrefix+"p6, "+self:Provider:ParameterPrefix+"p7") using var cmdInsertLock := SqlDbCommand{"InsertLock", self:Connection, false} cmdInsertLock:CommandText := sb:ToString() @@ -861,9 +861,8 @@ partial class SQLRDD inherit Workarea cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p3", self:Connection:ConnectionId:ToString()) cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p4", (int)super:Area) cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p5", System.Threading.Thread.CurrentThread.ManagedThreadId) - cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p6", DateTime.Now) - cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p7", _oTd:RealName ?? String.Empty) - cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p8", SELF:LockRecNo(lockInfo)) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p6", _oTd:RealName ?? String.Empty) + cmdInsertLock:AddParameter(self:Provider:ParameterPrefix+"p7", SELF:LockRecNo(lockInfo)) if !cmdInsertLock:ExecuteNonQuery() messageLocked:AppendLine("Could not create lock") diff --git a/src/Tests/SqlRDDTests/Program.prg b/src/Tests/SqlRDDTests/Program.prg index 1071b41d40..1ac0429942 100644 --- a/src/Tests/SqlRDDTests/Program.prg +++ b/src/Tests/SqlRDDTests/Program.prg @@ -29,7 +29,7 @@ function Start as void // TestParametersODBC() // TestParametersSQL() // TestParametersOLEDB() - TestTable() + //TestTable() //TestCreateIndex() //TestServerFilter() //TestTableRecno() @@ -37,7 +37,7 @@ function Start as void //testCreate() //FillGsTutor() //TestGsTutor() - //TestLock() + TestLock() wait return From 149895526e9f2e136d58316110d61b1a1cd2e6fb Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:23:44 +0100 Subject: [PATCH 7/9] Fix build errors From 2317defa7cf7a548e297a399fc5172b9b647abd6 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Fri, 13 Mar 2026 09:37:09 +0100 Subject: [PATCH 8/9] small fix From c4a4a2de6b37b6b424f71ab681857d630c80ebd1 Mon Sep 17 00:00:00 2001 From: Thomas Stutz Date: Mon, 4 May 2026 08:54:35 +0200 Subject: [PATCH 9/9] Fix namespace in EnumSet.prg Fix error in Database GetInt when column is int and not decimal Optimize: Remove DB-Roundtrip in SQLRDD.GoToId when we are already on this id Optimize: Remove DB-Roundtrip in SQLRDD._GotoRecord. Only reload data if internal datatable is empty Fix adding double id column name in Order By of SQL-Statement Fix test. Remove not existing enum-value (SqlRDDEventReason.SeekReturnsSubset) --- src/Runtime/XSharp.Core/State/EnumSet.prg | 4 ++- .../XSharp.SQLRdd/Metadata/Database.prg | 2 +- src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg | 7 ++++-- .../XSharp.SQLRdd/RDD/SQLRDD-Private.prg | 25 +++++++++++-------- .../Support/SqlDbTableCommandBuilder.prg | 4 ++- src/Tests/SqlRDDTests/Program.prg | 4 +-- 6 files changed, 28 insertions(+), 18 deletions(-) diff --git a/src/Runtime/XSharp.Core/State/EnumSet.prg b/src/Runtime/XSharp.Core/State/EnumSet.prg index b8daf9bac8..d7ea1043cd 100644 --- a/src/Runtime/XSharp.Core/State/EnumSet.prg +++ b/src/Runtime/XSharp.Core/State/EnumSet.prg @@ -6,7 +6,7 @@ USING XSharp USING XSharp.RDD.Enums USING System.Collections.Generic -NAMESPACE XSharp +BEGIN NAMESPACE XSharp /// ENUM Set @@ -431,6 +431,8 @@ ENUM Set END ENUM +END NAMESPACE + #region Defines /// /// diff --git a/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg b/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg index 0ae77da476..e967942769 100644 --- a/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg +++ b/src/Runtime/XSharp.SQLRdd/Metadata/Database.prg @@ -528,7 +528,7 @@ end class var rdr := (DbDataReader) oPar var pos := SELF:GetPos(rdr, nReason:ToString()) if pos >= 0 - var num := rdr:GetDecimal(pos) + var num := rdr:GetValue(pos) return Convert.ToInt32(num) endif catch diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg index 3927798e28..728aff5956 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg @@ -461,6 +461,7 @@ partial class SQLRDD inherit Workarea self:DataTable:RejectChanges() endif _updatedRows:Clear() + // TODO: thomas optimize. Change reccount when adding or deleting a row above instead of reloading data from DB with _GetRecCount self:_GetRecCount() endif return lOk @@ -641,8 +642,10 @@ partial class SQLRDD inherit Workarea OVERRIDE METHOD GoToId(oRec AS OBJECT) AS LOGIC LOCAL result AS LOGIC TRY - VAR nRec := Convert.ToUInt32( oRec ) - result := SELF:GoTo( (DWORD) nRec ) + VAR nRec := Convert.ToUInt32( oRec ) + if nRec != RowNumber + result := SELF:GoTo( (DWORD) nRec ) + endif CATCH ex AS Exception SELF:_dbfError(ex, Subcodes.EDB_GOTO,Gencode.EG_DATATYPE, "SQLRDD.GoToId",FALSE) result := FALSE diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg index 28b043cd8a..2bc962c12d 100644 --- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg +++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg @@ -601,16 +601,20 @@ partial class SQLRDD return result PRIVATE METHOD _GotoRecord(nRec as DWORD) AS LOGIC - // Brute walk - SELF:_command:CommandText := _builder:BuildRowNumberStatement(nRec) - var result := SELF:_command:ExecuteScalar(SELF:_oTd:Name) - var iResult := Convert.ToInt64(result) - // shouldn't this be ToUInt32? - - // determine correct page - SELF:_currentPageNo := (INT) ((iResult - 1) / SELF:_oTd:PageSize) + 1 - SELF:_ClearTable() - SELF:DataTable := SELF:_ReadTable("") + + if SELF:DataTable:Rows:Count < 1 + // Brute walk + SELF:_command:CommandText := _builder:BuildRowNumberStatement(nRec) + var result := SELF:_command:ExecuteScalar(SELF:_oTd:Name) + var iResult := Convert.ToInt64(result) + // shouldn't this be ToUInt32? + + // determine correct page + SELF:_currentPageNo := (INT) ((iResult - 1) / SELF:_oTd:PageSize) + 1 + SELF:_ClearTable() + SELF:DataTable := SELF:_ReadTable("") + end if + // locate the row in the page SELF:RowNumber := 1 DO WHILE SELF:RowNumber <= SELF:DataTable:Rows:Count @@ -620,6 +624,7 @@ partial class SQLRDD SELF:RowNumber+= 1 ENDDO RETURN FALSE + PRIVATE METHOD _GotoRow(nRow as LONG) AS LOGIC SELF:_Found := FALSE var nCount := SELF:DataTable:Rows:Count diff --git a/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg b/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg index b03be0ea63..8c58e1b76d 100644 --- a/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg +++ b/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg @@ -169,7 +169,9 @@ internal class SqlDbTableCommandBuilder cOrderby := Functions.List2String(CurrentOrder:OrderList) if SELF:_oTable:HasRecnoColumn if ! String.IsNullOrEmpty(cOrderby) - cOrderby := cOrderby + ", " + Provider:QuoteIdentifier(self:_oTable:RecnoColumn) + if !cOrderby.Contains(Provider:QuoteIdentifier(self:_oTable:RecnoColumn)) + cOrderby := cOrderby + ", " + Provider:QuoteIdentifier(self:_oTable:RecnoColumn) + endif else cOrderby := Provider:QuoteIdentifier(self:_oTable:RecnoColumn) endif diff --git a/src/Tests/SqlRDDTests/Program.prg b/src/Tests/SqlRDDTests/Program.prg index 1ac0429942..dc069620ae 100644 --- a/src/Tests/SqlRDDTests/Program.prg +++ b/src/Tests/SqlRDDTests/Program.prg @@ -597,8 +597,6 @@ FUNCTION EventHandler(oSender AS Object, e AS XSharp.RDD.SqlRDD.SqlRddEventArgs) case "Index:Customers" e:Value := "PK,CompanyName,ContactName,Address" end switch - case SqlRDDEventReason.SeekReturnsSubset - e:Value := TRUE end switch if showEvents ? "Event", e:Name, e:Reason:ToString(), e:Value @@ -889,7 +887,7 @@ FUNCTION TestGsTutor() AS VOID System.Console.ReadLine() - // UBLIC VIRTUAL METHOD RecordInfo(kRecInfoType, nRecordNumber, uRecVal) AS USUAL CLIPPER + // PUBLIC VIRTUAL METHOD RecordInfo(kRecInfoType, nRecordNumber, uRecVal) AS USUAL CLIPPER //var test := DbRecordInfo(DBRI_LOCKED, 3) // DbRLock(4)