Check File Rights in Visual Foxpro

A VFP program to check the access permissions of a file. This returns OK when the file has both Write and Delete permissions. This returns RIGHTS when the file does not have Write or Delete permissions. This returns READONLY when the file is marked Read Only. Author: Tracy Pearson  Freeware 0.9K Last updated: 2011.09.02

LPARAMETERS cFile

DECLARE Integer CreateFile IN WIN32API ;
   String lpFilename, ;
   Integer dwDesiredAccess, ;
   Integer dwShareMode, ;
   Integer lpSecurityAttributes_optional, ;
   Integer dwCreateDisposition, ;
   Integer dwFlagsAndAttributes, ;
   Integer hTemplateFile_option

DECLARE INTEGER CloseHandle IN WIN32API ;
   Integer hHandle

DECLARE INTEGER GetLastError IN kernel32.DLL

DECLARE INTEGER FormatMessage IN kernel32.dll INTEGER, STRING, INTEGER, INTEGER, STRING@, INTEGER, STRING

#DEFINE WIN98_DELETE      0x00010000
#DEFINE WIN98_WRITE       0x40000000

#DEFINE FILE_SHARE_DELETE 0X00000004
#DEFINE FILE_SHARE_READ   0X00000001
#DEFINE FILE_SHARE_WRITE  0X00000002

#DEFINE CREATE_NEW        0X00000001
#DEFINE CREATE_ALWAYS     0X00000002
#DEFINE OPEN_EXISTING     0X00000003
#DEFINE OPEN_ALWAYS       0X00000004
#DEFINE TRUNCATE_EXISTING 0X00000005

LOCAL nHandle, cReturn, lFile[1], nSize

*-- WinME,98,95 do not support File_Share_Delete access.
nHandle = CreateFile(cFile, IIF(VAL(OS(3)) < 5, WIN98_DELETE + WIN98_WRITE, FILE_SHARE_DELETE + FILE_SHARE_WRITE),  ;
   0, ;
   0, OPEN_EXISTING, 0, 0)

IF nHandle <> -1
   cReturn = "OK"
   CloseHandle(nHandle)
ELSE
   nErr = GetLastError()
   DO CASE
   CASE nErr = 32
      *-- File is in use by another
      *-- We still have access rights to modify/delete the file,
      *-- otherwise we'd get 5 - Access Denied
      cReturn = "OK"
   CASE nErr = 5
      cReturn = "RIGHTS"
      IF ADIR(lFile, cFile) > 0
         IF lFile[1,5] = "R"
            cReturn = "READONLY"
         ENDIF
      ENDIF
   OTHERWISE
      cReturn = REPLICATE(CHR(0),200)
      nSize = FormatMessage(0x00001000, CHR(0), nErr, 0, @cReturn, 200, "")
      cReturn = LEFT(cReturn, nSize)
   ENDCASE
ENDIF
RETURN cReturn