Implementing SmartCopy

The following program implements sort of a smart copy in Visual FoxPro. When something is selected, the selected text is copied. Otherwise the entire current line. So far, only Ctrl+C is implemented.

*==========================================================
* Implements SmartCopy. When nothing is highlighted, the
* entire line is copied.
*==========================================================

  *--------------------------------------------------------
  * Remove existing keyboard short cut
  *--------------------------------------------------------
  Release Bar _med_copy of _medit
  DEFINE BAR _med_copy OF _medit PROMPT "\<Copy" ;
    After _med_cut ;
    PICTRES _med_copy ;
    MESSAGE "Copies the selection onto the Clipboard"

  *--------------------------------------------------------
  * Invisible popup to capture short cut key.
  *--------------------------------------------------------
  Local lcFile
  lcFile = Sys(16)
  Define Popup SmartCopy
  Define Bar 1 of SmartCopy prompt "Copy" Key Ctrl+C
  On Selection Bar 1 of SmartCopy ;
    do HandleCopy in "&lcFile"


*==========================================================
* Copies the entire line if nothing is selected, default
* behavior otherwise.
*==========================================================
Procedure HandleCopy

  *--------------------------------------------------------
  * Check if we need to execute the default behavior
  *--------------------------------------------------------
  Local llDefault
  _Cliptext = ""
  Sys(1500,"_med_copy","_medit")
  Doevents
  llDefault = not Empty(_Cliptext)

  *--------------------------------------------------------
  * Make sure, FoxTools.Fll is loaded.
  *--------------------------------------------------------
  If not "FOXTOOLS.FLL" $ Upper(Set("Library"))
    Set Library to (Home()+"FoxTools.Fll") Additive
  Endif

  *--------------------------------------------------------
  * Find current window handle
  *--------------------------------------------------------
  Local lnWHandle, laEnv[25]
  If not m.llDefault
    lnWHandle = _WOnTop()
    If m.lnWHandle <= 0
      llDefault = .T.
    Else
      Try
        _EdGetEnv( m.lnWHandle, @laEnv )
        llDefault = (laEnv[25] < 0)
      Catch
        llDefault = .T.
      EndTry
    EndIf
  EndIf

  *--------------------------------------------------------
  * Get the current line content
  *--------------------------------------------------------
  Local lnCurPos, lnLineNo, lnStart, lnEnd
  If not m.llDefault
    lnCurPos = _EdGetPos( m.lnWHandle )
    lnLineNo = _EdGetLNum( m.lnWHandle, m.lnCurPos )
    lnStart = _EdGetLPos( m.lnWHandle, m.lnLineNo )
    lnEnd = _EdGetLPos( m.lnWHandle, m.lnLineNo+1 )
    If m.lnStart < m.lnEnd
      lnEnd = m.lnEnd - 1
      _Cliptext = _EdGetStr(m.lnWHandle,m.lnStart,m.lnEnd)
    Endif
    _EdSetPos(m.lnWHandle, m.lnCurPos)
  EndIf

EndProc

Locking done quickly

LOCAL llLock
SET REPROCESS TO 0 SECONDS
llLock = RLOCK()
UNLOCK

The only possible approach for finding out whether you can lock a record is to actually lock it. Aside from editing records there can be various reasons why you need to lock records. For instance, one application I'm working on, uses locks in a table to validate the number of seats that the application is licensed to. Every instance tries to find an unlocked record, then locks the record and updates it with some more details. If there's no unlocked record, the user ran out of licenses. Another module determines all locked records and displays all recorded information. This allows administrators and supporters to find out who is still in the application.

A straight forward approach would be to scan through the table, lock each record and continue until RLOCK() returns .T. Problems arise when the number of work stations and licenses grows. The first record is way more likely to be locked than the last one. Hence, the more users are logged on the longer it takes to launch the application for new users.

One approach I implemented in the past to get around this is to check for random record numbers instead of scanning through the table. Just generate a random number between 1 and RECCOUNT(). Navigate to the record, attempt to lock it, repeat with a new record. Probably you want to limit the number of attempts to something like two or three times the total number of records before exiting the application. This approach distributes locked records equally in the table. It's still slow, though.

Visual FoxPro never tries to lock a record just once (let me know if you disagree with this statement). Instead Visual FoxPro uses the value of SET REPROCESS TO for a number of attempts. There are various options such as locking for a number of seconds, a number of attempts or eternally until the user cancels out. In the end, though, it all boils down to Visual FoxPro repeatedly trying to lock the record until a termination condition is met.

SYS(3051) controls the interval between attempts. Possible values for this function are limited, though. The interval can be anything between 100 ms and one second. The default is 333 ms meaning that a value of 3 for SET REPROCESS makes the app wait up to one second before RLOCK() returns .F.

If you want to check a huge number of records, you want to minimize this time. The fastest possible setting in Visual FoxPro is

SET REPROCESS TO 1
SYS(3051,100)

When you attempt to lock a record that is already locked, you will know after 100 ms, more or less. Sufficient when all you want is to save a record, way to slow if you need to check 100 records to find an unlocked one. Even with this fast configuration, Visual FoxPro still performs two attempts to lock the record. One that fails right away putting VFP into a wait state. The second one occurs after the specified interval.

When I needed to process potentially more than 100 records recently, this approach was unusable. Therefore I searched my blog for a solution and came across the description of how locking works in Visual FoxPro.

Obviously, the problem in Visual FoxPro is not the attempt to lock the record, but the interval between the two attempts that you can't make shorter than 100 ms. Therefore my solution works on the API level to only make a single locking attempt. Either it fails, or doesn't. Calculating the locking position is fairly easy to do. It's 0x7FFFFFFE-Recno(). For the LockFile function you need a handle to the DBF file. Lacking an easy way of obtaining a file handle to a table opened by VFP, I opted for the API solution of opening the file a second time in shared mode. Having said this the code is really straight forward.

*==========================================================
* Attempts to lock a record exactly once. If the record
* cannot be locked for whatever reason, .F. is returned.
* The record does not remain locked.
*
* There's no guarantee that a subsequent RLOCK() command
* works. It might fail even when isLocked() returns .T.
* when another machine locked the record in the meantime.
* It might had worked, if you tried to lock the record as
* the other machine released the lock already.
*
* This method is for code that needs to quickly scan a
* larger number of records to find a locked or unlocked
* one, for instance, when you need to clean certain
* records, or when you use locked records in a license
* tables to limit the number of instances.
*==========================================================
Procedure LockingPossible()

  *--------------------------------------------------------
  * If this instance has locked the record, we return
  * immediately.
  *--------------------------------------------------------
  If IsRLocked()
    Return .T.
  EndIf

  *--------------------------------------------------------
  * We can't check exclusively opened files. But then there
  * shouldn't be a problem obtaining a lock.
  *--------------------------------------------------------
  If IsExclusive()
    Return .T.
  EndIf

  *--------------------------------------------------------
  * API declarations
  *
  * source: http://www.news2news.com
  *--------------------------------------------------------
  DECLARE INTEGER LockFile IN kernel32;
      INTEGER hFile, INTEGER dwFileOffsetLow,;
      INTEGER dwFileOffsetHigh,;
      INTEGER nNumberOfBytesToLockLow,;
      INTEGER nNumberOfBytesToLockHigh
  DECLARE INTEGER OpenFile IN kernel32;
      STRING   lpFileName,;
      STRING @ lpReOpenBuff,;
      INTEGER  wStyle
  DECLARE INTEGER CloseHandle IN kernel32;
      INTEGER hObject

  *--------------------------------------------------------
  * Open the table a second time and attempt to lock the
  * record using low level access.
  *--------------------------------------------------------
  Local lcBuffer, lnFile, llLock
  #DEFINE GENERIC_READ 0x80000000
  llLock = .F.
  lcBuffer = Replicate(Chr(0), 250)
  lnFile = OpenFile(Dbf(), @lcBuffer, GENERIC_READ)
  If m.lnFile > 0
    If LockFile(m.lnFile, 0x7FFFFFFE-Recno(), 0, 1, 0) <> 0
      llLock = .T.
    EndIf
    CloseHandle(m.lnFile)
  EndIf

Return m.llLock