// This code is part of VDF GUIdance
// Visit us @ http://www.vdf-guidance.com
// e-Mail us @ info@vdf-guidance.com
// VDF GUIdance is a mutual project of
// Frank Vandervelpen - Vandervelpen Systems and
// Wil van Antwerpen  - Antwise Solutions
// All software source code should be used <<AS IS>> without any warranty.
//
//
// *** cFolderSet package ***
// This package enables you to enumerate thru files and folders on a windows box.
// It works with the windows API and creates a object oriented interface to work with
// the data.
// There is no userface attached anywhere, so that you can safely use this from both
// VDF as well as WebApp
//
// Supported are:
//   - enumeration of a folder based on a searchpath
//   - renaming of files and folders in the search-criteria
//
//
// Not supported for the moment:
//   - recursive folders
//   - Security info such as ACL and owners
//   - FileCreation
//   - non windows environments
//
// **WvA: November 17, 2001
// I would like to dedicate this code to a relative of mine that passed away earlier
// this week.
// Harry Stokkermans, God bless, hope you will find some peace now.
//
//
//
Use vWin32fh.pkg
Use Parsefn.pkg

Enum_list // Constant File Properties
  Define CFP_LONG_FILENAME
  Define CFP_SHORT_FILENAME
  Define CFP_FILE_ATTRIBUTES
  Define CFP_FILE_SIZE          // in bytes
  Define CFP_CREATION_DATETIME
  Define CFP_LASTACCESS_DATETIME
  Define CFP_LASTWRITE_DATETIME
  Define CFP_RECORDSIZE         // Keep this field as the last one in your struct
End_enum_list

// Constant File Attributes
  define CFA_READONLY   for |CI$00000001
  define CFA_HIDDEN     for |CI$00000002
  define CFA_SYSTEM     for |CI$00000004
  define CFA_DIRECTORY  for |CI$00000010
  define CFA_ARCHIVE    for |CI$00000020
  define CFA_ENCRYPTED  for |CI$00000040
  define CFA_NORMAL     for |CI$00000080
  define CFA_TEMPORARY  for |CI$00000100


Class cFileProperties Is A Array
  Procedure Construct_Object
    Forward Send Construct_Object
    Property Integer phoFolderSet   Public 0
  End_Procedure // Construct_Object
End_Class // cFileProperties


Class cFolderSet Is A Array
  Procedure Construct_Object
    Forward Send Construct_Object
    Property String  psCurrentSearchPath   Public "" // contains values such as "C:\*.s??"
    Property String  psCurrentFolderName   Public "" // This property will always end with a backslash, Ex. "C:\"
    Property Integer piCurrentFile         Public 0
    Property Integer phoParentFolderSet    Public 0
    Property Integer pbRecursive           Public False // Set to true to retrieve all underlying folders
  End_Procedure // Construct_Object

  Procedure Set LongFileName Integer iItem String sFileName
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_LONG_FILENAME To sFileName
      End
    End
  End_Procedure // Set LongFileName

  Function LongFileName Integer iItem Returns String
    String  sFileName
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_LONG_FILENAME To sFileName
      End
    End
    Function_Return sFileName
  End_Function // LongFileName

  Procedure Set AlternateFileName Integer iItem String sFileName
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_SHORT_FILENAME To sFileName
      End
    End
  End_Procedure // Set AlternateFileName

  Function AlternateFileName Integer iItem Returns String
    String  sFileName
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_SHORT_FILENAME To sFileName
      End
    End
    Function_Return sFileName
  End_Function // AlternateFileName

  Procedure Set FileAttributes Integer iItem Dword dwFileAttributes
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_FILE_ATTRIBUTES To dwFileAttributes
      End
    End
  End_Procedure // Set FileAttributes

  Function FileAttributes Integer iItem Returns Dword
    Dword   dwFileAttributes
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_FILE_ATTRIBUTES To dwFileAttributes
      End
    End
    Function_Return dwFileAttributes
  End_Function // FileAttributes

  Function IsAttributeReadOnly Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_READONLY)
  End_Function // IsAttributeReadOnly


  Function IsAttributeHidden Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_HIDDEN)
  End_Function // IsAttributeHidden


  Function IsAttributeSystem Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_SYSTEM)
  End_Function // IsAttributeSystem


  Function IsAttributeDirectory Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_DIRECTORY)
  End_Function // IsAttributeDirectory


  Function IsAttributeArchive Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_ARCHIVE)
  End_Function // IsAttributeArchive


  Function IsAttributeEncrypted Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_ENCRYPTED)
  End_Function // IsAttributeEncrypted


  Function IsAttributeNormal Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_NORMAL)
  End_Function // IsAttributeNormal


  Function IsAttributeTemporary Integer iFile Returns Integer
    Dword dwFileAttributes
    Get FileAttributes Item iFile To dwFileAttributes
    Function_Return (dwFileAttributes iAnd CFA_TEMPORARY)
  End_Function // IsAttributeTemporary

  // THis will return current attributes as a string much like the one you can see
  // in windows explorer, or when using the dos attrib command
  // We denominate the setting ot the attribute by returning its value Capitalized.
  // ADSHR =  Archive Directory System Hidden Readonly all set.
  // adshr =  None of the queried attributes are set.
  Function FileAttributeString Integer iFile Returns String
    Dword  dwFileAttributes
    String sAttrib
    Get FileAttributes Item iFile To dwFileAttributes
    Move (if ( dwFileAttributes iAnd CFA_ARCHIVE , "A", "a")) To sAttrib
    Move (sAttrib+if ( dwFileAttributes iAnd CFA_DIRECTORY , "D", "d")) To sAttrib
    Move (sAttrib+if ( dwFileAttributes iAnd CFA_SYSTEM , "S", "s")) To sAttrib
    Move (sAttrib+if ( dwFileAttributes iAnd CFA_HIDDEN , "H", "h")) To sAttrib
    Move (sAttrib+if ( dwFileAttributes iAnd CFA_READONLY , "R", "r")) To sAttrib
    Function_Return sAttrib
  End_Function // FileAttributeString


  Procedure Set FileSizeBytes Integer iItem String sSize
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_FILE_SIZE To sSize
      End
    End
  End_Procedure // Set FileSizeBytes

  Function FileSizeBytes Integer iItem Returns String
    String  sSize
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_FILE_SIZE To sSize
      End
    End
    Function_Return sSize
  End_Function // FileSizeBytes

  // Max filesize that we can return is 2,147,483,647 KB which seems large enough
  // for a single file for the next few years or so.
  Function FileSizekBytes Integer iItem Returns Integer
    String  sSize
    Integer hoFileProps
    Number  nSize
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_FILE_SIZE To sSize
        Move ((sSize/1024.0)+0.5) To nSize
      End
    End
    Function_Return nSize
  End_Function // FileSizekBytes


  Procedure Set CreationDateTime Integer iItem String sCreationDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_CREATION_DATETIME To sCreationDateTime
      End
    End
  End_Procedure // Set CreationDateTime


  Function CreationDateTime Integer iItem Returns String
    String  sCreationDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_CREATION_DATETIME To sCreationDateTime
      End
    End
    Function_Return sCreationDateTime
  End_Function // CreationDateTime


  Procedure Set LastAccessDateTime Integer iItem String sLastAccessDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_LASTACCESS_DATETIME To sLastAccessDateTime
      End
    End
  End_Procedure // Set LastAccessDateTime


  Function LastAccessDateTime Integer iItem Returns String
    String  sLastAccessDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_LASTACCESS_DATETIME To sLastAccessDateTime
      End
    End
    Function_Return sLastAccessDateTime
  End_Function // LastAccessDateTime


  Procedure Set LastWriteDateTime Integer iItem String sLastWriteDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Set Value Of hoFileProps Item CFP_LASTWRITE_DATETIME To sLastWriteDateTime
      End
    End
  End_Procedure // Set LastWriteDateTime


  Function LastWriteDateTime Integer iItem Returns String
    String  sLastWriteDateTime
    Integer hoFileProps
    If (iItem < (Item_Count(Self))) Begin
      Get Value Item iItem To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_LASTWRITE_DATETIME To sLastWriteDateTime
      End
    End
    Function_Return sLastWriteDateTime
  End_Function // LastWriteDateTime


  // Create a new file properties object
  //
  Function CreateFileObject Returns Handle
    Handle hoFileProperties
    Object oFileProperties Is A cFileProperties
      Move Self To hoFileProperties
    End_Object // oFileProperties
    Function_Return hoFileProperties
  End_Function // CreateFileObject

  //  Adds a new slot for the file at the end in the buffer.
  //  Returns the itemnumber of the file in the array if succesfull,
  //  otherwise a value of -1 is returned.
  Function AddFile String sFileName Returns Integer
    Integer iRowCount hoFile
    Get Item_Count To iRowCount
    Get CreateFileObject To hoFile
    If (hoFile > Desktop) Begin
      Set Array_Value Item iRowCount To hoFile
      Set piCurrentFile To iRowCount
      Set LongFileName Item iRowCount To sFileName
      Set Name Of hoFile To (("oFileProps_")+sFileName)
    End
    Else Move -1 To iRowCount
    Function_Return iRowCount
  End_Function // AddFile


  // Read the folder at sSearchPath into the buffer
  // The searchpath may contain wildcard characters such as ? and *
  // If you want to list the contents of a folder
  //
  Procedure LoadBuffer String sSearchPath
    String  sWin32FindData sPath
    String  sAlternateFileName sLongFileName sFileMask
    Integer lpsSearchPath lpsWin32FindData
    Integer hFindFile bIsFolder
    Integer iVoid iRetval iFile
    Dword   dwFileAttributes
    Dword   dwFileSizeHigh
    Dword   dwFileSizeLow
    Dword   dwLowDateTime
    Dword   dwHighDateTime

    Move (trim(sSearchPath)) To sSearchPath
    Get vFolderExists sSearchPath To bIsFolder
    If (bIsFolder) Begin // vFolderexists also supports wildcards, this is not what we
      Move (If( Pos("?",sSearchPath) <> 0,False,True)) To bIsFolder // expect for a true
      If (bIsFolder) Begin                   // folder, so we reset the status
        Move (If( Pos("*",sSearchPath) <> 0,False,True)) To bIsFolder
      End
    End
    If (bIsFolder) Begin
      Move (sysconf(SYSCONF_FILE_MASK)) To sFileMask    // normally *.*
      Move (vFolderFormat(sSearchPath)) To sSearchPath
      Move (sSearchPath+sFileMask) To sSearchPath
    End
    Set psCurrentSearchPath To sSearchPath

    Move (Parse_Drive(sSearchPath)+":"+Parse_Path(sSearchPath)) To sPath
    Move (vFolderFormat(sPath)) To sPath    // psCurrentFolderName should always end with
    Set psCurrentFolderName To sPath        // a directory separator (a backslash)

    GetAddress Of sSearchPath To lpsSearchPath

    Zerotype vWin32_Find_Data To sWin32FindData

    GetAddress Of sWin32FindData To lpswin32FindData

    Move (vWin32_FindFirstFile (lpsSearchPath, lpsWin32FindData)) To hFindFile
    If (hFindFile <> vINVALID_HANDLE_VALUE) Begin
      Repeat
        GetBuff_String From sWin32FindData At vWin32_Find_Data.cFileName To sLongFileName
        Get AddFile sLongFileName To iFile
        If (iFile <> -1) Begin
          GetBuff_String From swin32FindData At vWin32_Find_Data.cAlternateFileName To sAlternateFileName
          If (sAlternateFileName = "") Begin
            // Use GetShortPathName winAPI
          End
          Set AlternateFileName Item iFile To sAlternateFileName

          GetBuff From sWin32FindData At vWin32_Find_Data.dwFileAttributes To dwFileAttributes
          // These are the file_attributes that can be matched wioth the above defines
          Set FileAttributes Item iFile To dwFileAttributes

          GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeHigh To dwFileSizeHigh
          GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeLow  To dwFileSizeLow
          Set FileSizeBytes Item iFile To (String((dwFileSizeHigh * vMaxDword) + dwFileSizeLow))

          GetBuff From sWin32FindData At vWin32_Find_Data.ftCreationLowDateTime  To dwLowDateTime
          GetBuff From sWin32FindData At vWin32_Find_Data.ftCreationHighDateTime To dwHighDateTime
          Set CreationDateTime Item iFile To (vConvertFileDateTime (dwLowDateTime, dwHighDateTime))

          GetBuff From sWin32FindData At vWin32_Find_Data.ftLastAccessLowDateTime  To dwLowDateTime
          GetBuff From sWin32FindData At vWin32_Find_Data.ftLastAccessHighDateTime To dwHighDateTime
          Set LastAccessDateTime Item iFile To (vConvertFileDateTime (dwLowDateTime, dwHighDateTime))

          GetBuff From sWin32FindData At vWin32_Find_Data.ftLastWriteLowDateTime  To dwLowDateTime
          GetBuff From sWin32FindData At vWin32_Find_Data.ftLastWriteHighDateTime To dwHighDateTime
          Set LastWriteDateTime Item iFile To (vConvertFileDateTime (dwLowDateTime, dwHighDateTime))

          Moveint (vWin32_FindNextFile (hFindFile, lpsWin32FindData)) To iRetval
        End
        Else Begin
          Move dfFalse To iRetVal
        End

        // If iRetval = false the function call fails but GetLastError
        // fails to tell me if this was because we do not find any files
        //  anymore.
        // Actually the returnValue is vERROR_NO_MORE_FILES
        Until iRetval Eq dfFalse
      Moveint (vWin32_FindClose (hFindFile)) To ivoid
      End // hFindFile
  End_Procedure // LoadBuffer


  Procedure DeleteAllProperties
    Integer iCount iIndex hoFileProperties hoFolderSet
    Get Item_Count To iCount
    For iIndex From 0 To (iCount-1)
      Get Value Item iIndex To hoFileProperties
      If (hoFileProperties <> 0) Begin
        Get phoFolderSet of hoFileProperties To hoFolderSet
        If (hoFolderSet <> 0) Begin
          Send DeleteAllProperties To hoFolderSet
        End
        Send Delete_Data To hoFileProperties
        Send Destroy_Object To hoFileProperties
        Set Value Item iIndex To 0
      End
    Loop
    Send Delete_Data
  End_Procedure // DeleteAllProperties

  // Refreshes the contents of the current data in the folderset
  // This is a non-recursive operation.
  Procedure Refresh
    String  sSearchPath
    Integer bRecursive
    Send DeleteAllProperties
    Get psCurrentSearchPath To sSearchPath
    Send LoadBuffer sSearchPath
  End_Procedure // Refresh


  // This function will rename the file at slot iFile to its new filename sNewFileName
  // The Current folder will be refreshed immediately after this process completes
  // Returns a nonzero integer if the renaming process fails.
  Function RenameFileItem Integer iFile String sNewFileName Returns Integer
    String  sOldFileName sFolderName
    Integer hoFileProps iRetVal
    If (iFile < (Item_Count(Self))) Begin
      Get Value Item iFile To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_LONG_FILENAME To sOldFileName
        Get psCurrentFolderName To sFolderName
        Get vRenameFile (sFolderName+sOldFileName) (sFolderName+sNewFileName) To iRetVal
        If (iRetVal = 0) Begin
          Send Refresh
        End
      End
    End
    Else Begin
      Move 1 To iRetVal
    End
    Function_Return iRetVal
  End_Function // RenameFileItem


  // This function will rename the file at slot iFile to its new filename sNewFileName
  // The Current folder will be refreshed immediately after this process completes
  // Returns a nonzero integer if the renaming process fails.
  Function DeleteFileItem Integer iFile Returns Integer
    String  sFileName sFolderName
    Integer hoFileProps iRetVal
    If (iFile < (Item_Count(Self))) Begin
      Get Value Item iFile To hoFileProps
      If (hoFileProps > Desktop) Begin
        Get Value Of hoFileProps Item CFP_LONG_FILENAME To sFileName
        Get psCurrentFolderName To sFolderName
        Get vDeleteFile (sFolderName+sFileName) To iRetVal
        If (iRetVal = 0) Begin
          Send Refresh
        End
      End
    End
    Else Begin
      Move 1 To iRetVal
    End
    Function_Return iRetVal
  End_Function // RenameFileItem


End_Class // cFolderSet


Object oFileBrowser Is A cFolderSet
End_Object // oFileBrowser