vwin32fhW.pkg

// 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.
//
//
// *** Windows 32bit file handling wrapper class ***
// Unicode variant

Use vWin32fhW.h       // Header file with WinAPI Unicode declarations



// Does the directory exist? - No = false, Yes = True
// This also works with UNC path encoding and wildcards
Function vFolderExists Global String sFolderName Returns Boolean
    Boolean bFolderExists
    Boolean bStop
    String  sFolder sTmp
    Integer iCh

    If (sFolderName = "") Begin
        Function_Return False
    End

    Move True  to bFolderExists
    Move False to bStop
    Move "dir:" to sFolder
    Append sFolder sFolderName
    Get Seq_New_Channel to iCh  // get free channel for input
    If (iCh = DF_SEQ_CHANNEL_NOT_AVAILABLE) Begin
        Error DFERR_PROGRAM "No I/O channel available for process (vFolderExists)"
        Function_Return False
    End
    Direct_Input channel iCh sFolder
    Repeat
        Readln channel iCh sTmp
        Move (SeqEof) to bStop
        If (Trim(sTmp)="") Begin
            Move False to bFolderExists
        End
        Else Begin
            Move True to bFolderExists
            Move True to bStop
        End
    Until (bStop)
    Close_Input channel iCh
    Send Seq_Release_Channel iCh
    Function_Return bFolderExists
End_Function

// returns folder name if a folder was selected, otherwise returns ""
Function vSHBrowseForFolder Global String sDialogTitle Returns String
    String  sPath
    WString sFolder sTitle
    Pointer lpItemIdList
    Integer iFolderSelected iRetval
    tvBrowseInfo BrowseInfo

    Move "" to sPath
    If (sDialogTitle<>"") Begin
        Move sDialogTitle to sTitle
        // Torben Lund suggested converting the string with toansi. Doing it like that
        // disables showing some commonly used ascii characters like ascii 137 (‰)
        // These chars are correctly shown if no toansi is used.
        // I can imagine that he wanted to path to be ANSI, but as long as it isa just
        // selected it will always be valid.
        Move (AddressOf(sTitle)) to BrowseInfo.lpszTitle
    End

    Move vBIF_RETURNONLYFSDIRS to BrowseInfo.ulFlags

    // Torben Lund added line below. Move handle of focus object to structure before
    // calling function. Otherwise, the folderdialog will be started as a seperate task.
    Move (window_handle(focus(desktop))) to BrowseInfo.hWndOwner

    // null 128 chars into var (make space)
    Move (Repeat(Character(0), vMAX_PATH)) to sFolder

    // select folder
    Move (vWin32_SHBrowseForFolder(AddressOf(BrowseInfo))) to lpItemIdList
    // get selected folder name
    Move (vWin32_SHGetPathFromIDList(lpItemIdList, AddressOf(sFolder))) to iFolderSelected

    // release memory resources that are used by the ItemIdList
    Move (vWin32_CoTaskMemFree(lpItemIdList)) to iRetval

    If (iFolderSelected<>0) Begin
        Move (CString(sFolder)) to sPath
    End
    Function_Return  sPath
End_Function

// returns 0 if the folder is created.
//         1 if the API-call returned an error.
Function vCreateDirectory Global String sNewFolder Returns Integer
    Integer  iRetval bFolderCreated
    WString  sFolder
    tvSecurity_attributes SA

    Move False to bFolderCreated
    If (sNewFolder <> "") Begin
        Move (SizeOfType(tvSecurity_attributes)) to SA.nLength
        Move  0                                  to SA.lpDescriptor
        Move  1                                  to SA.bInheritHandle
        Move (sNewFolder+Character(0)) to sFolder
        Move (vWin32_CreateDirectory(sFolder, AddressOf(SA))) to bFolderCreated
    End

    If (bFolderCreated=false) Begin
        Move 1 to iRetVal
    End
    Function_Return iRetVal
End_Function

// **WvA: 03-02-2002 Function created.
// With this function one can remove a directory.
// returns 0 if the folder is removed.
//         1 if the API-call returned an error (Use GetLastError API to get the details)
//         2 if the folder did not exist
//         3 if the sFolder parameter passed is equal to ""
Function vRemoveDirectory Global String sFolder Returns Integer
    Boolean bRemoved
    WString sPath
    Integer iRetval

    Move 0     to iRetVal
    Move False to bRemoved
    Move (Trim(sFolder)) to sFolder
    If (sFolder="") Begin
        Move 3 to iRetVal
    End
    If (vFolderExists(sFolder)=False) Begin
        Move 2 to iRetVal
    End
    If (iRetVal=0) Begin
        // null MAX_PATH chars into var (make space)
        Move (Repeat(Character(0), vMAX_PATH)) to sPath
        //
        Move (Insert(sFolder,sPath,1)) to sPath
        Move (vWin32_RemoveDirectory(sPath)) to bRemoved
    End

    If (iRetVal=0 And bRemoved=False) Begin
        Move 1 to iRetVal
    End
    Function_Return iRetVal
End_Function

// This will perform an operation on a file (e.g. open) with the application
// registered in the Windows Registry to open that type of file (via its extension)
// sOperation would be "OPEN" (it could also be "PRINT" etc).
Procedure vShellExecute Global String sOperation String sDocument String sParameters String sPath
    Handle  hInstance hWnd
    // remove any leading/trailing spaces in the string
    Move (Trim(sDocument)) to sDocument
    Move (Trim(sPath))     to sPath
    // Make the strings readable for windows API, by converting them to null-terminated
    Append sOperation   (Character(0))
    Append sDocument    (Character(0))
    Append sParameters  (Character(0))
    Append sPath        (Character(0))

    Get Window_Handle to hWnd
    Move (vWin32_ShellExecute (hWnd, sOperation, sDocument, sParameters, sPath, 1)) to hInstance
    If (hInstance <= 32) Begin
        Send vDDE_Error_Handler hInstance
    End
End_Procedure

Class cShellFileOperations is a Array

    Procedure Construct_Object
        Forward Send Construct_Object
        Property Integer piDeleteFlags        0
        Property Integer piCopyFlags          0
        Property Integer piMoveFlags          0
        Property Integer piRenameFlags        0

        Set piDeleteFlags to (vFOF_SILENT Ior vFOF_NOCONFIRMATION)
        Set piCopyFlags   to (vFOF_SILENT iOr vFOF_NOCONFIRMMKDIR Ior vFOF_NOCONFIRMATION)
        Set piMoveFlags   to (vFOF_SILENT iOr vFOF_NOCONFIRMMKDIR iOr vFOF_NOCONFIRMATION)
        Set piRenameFlags to (vFOF_SILENT Ior vFOF_NOCONFIRMATION)
    End_Procedure

    // This function uses the shell API to perform a file operation on the
    // files supplied.
    //
    Function FileOperation String sSource String sDestination Integer eOperation Integer iFlags Returns Integer
        Integer  iRetVal
        Integer  iUserAbort
        WString  wsSource wsDestination
        tvShFileOpStruct FOS

        Move (sSource+Character(0)+Character(0))      to wsSource
        Move (sDestination+Character(0)+Character(0)) to wsDestination

        If (eOperation <> vFO_DELETE) Begin
            Move (AddressOf(wsDestination)) to FOS.pTo
        End

        Move eOperation            to FOS.wFunc
        Move (AddressOf(wsSource)) to FOS.pFrom
        Move iFlags                to FOS.fFlags

        Move (vWin32_SHFileOperation(AddressOf(FOS))) to iRetVal
        Move FOS.fAnyOperationsAborted to iUserAbort
        If (iUserAbort <> 0) Begin
            Move 80 to iRetVal  // file Operation Aborted by USER
        End
        Function_Return (iRetVal)
    End_Function

    Function sfoDeleteFile String sFileName Returns Integer
        Integer  iRetVal
        Integer  iFlags

        Get piDeleteFlags to iFlags
        Get FileOperation sFileName "" vFO_DELETE iFlags to iRetVal
        Function_Return iRetVal
    End_Function

    Function sfoCopyFile String sSource String sDestination Returns Integer
        Integer  iRetVal
        Integer  iFlags

        Get piCopyFlags to iFlags
        Get FileOperation sSource sDestination vFO_COPY iFlags to iRetVal
        Function_Return iRetVal
    End_Function

    Function sfoMoveFile String sSource String sDestination Returns Integer
        Integer  iRetVal
        Integer  iFlags

        Get piMoveFlags to iFlags
        Get FileOperation sSource sDestination vFO_MOVE iFlags to iRetVal
        Function_Return iRetVal
    End_Function

    // Rename a file or folder
    // Returns a nonzero value if the operation failed.
    Function sfoRenameFile String sSource String sDestination Returns Integer
        Integer  iRetVal
        Integer  iFlags

        Get piRenameFlags to iFlags
        Get FileOperation sSource sDestination vFO_RENAME iFlags to iRetVal
        Function_Return iRetVal
    End_Function


    //Example:
    // Get sfoFormatDisk 'A' 0 To dReturnVal    // Formats drive A in QuickFormat
    //                                          mode.

End_Class

Object oShellFileOperations is a cShellFileOperations
End_Object

// Restore to the old way of working with the shell file operations.
// or.. to put lay man terms, allow any of the operations vDeleteFile
// vCopyFile/vMoveFile/vRenameFile to have an UNDO
Procedure vWin32fhCompatibilityMode
    Integer hoSFO
    Integer iFlags

    Move (vFOF_SILENT Ior vFOF_NOCONFIRMATION Ior vFOF_ALLOWUNDO) to iFlags
    Move (oShellFileOperations(Self)) to hoSFO

    Set piDeleteFlags of hoSFO to iFlags
    Set piCopyFlags   of hoSFO to iFlags
    Set piMoveFlags   of hoSFO to iFlags
    Set piRenameFlags of hoSFO to iFlags
End_Procedure

// Delete a file or folder
// Returns a nonzero value if the operation failed.
Function vDeleteFile Global String sFileName Returns Integer
    Integer  iRetVal

    Get sfoDeleteFile of (oShellFileOperations(Self)) sFileName to iRetVal
    Function_Return iRetVal
End_Function

// Copy a file or folder
// Returns a nonzero value if the operation failed.
Function vCopyFile Global String sSource String sDestination Returns Integer
    Integer  iRetVal

    Get sfoCopyFile of (oShellFileOperations(Self)) sSource sDestination to iRetVal
    Function_Return iRetVal
End_Function

// Move a file or folder
// Returns a nonzero value if the operation failed.
Function vMoveFile Global String sSource String sDestination Returns Integer
    Integer  iRetVal

    Get sfoMoveFile of (oShellFileOperations(Self)) sSource sDestination to iRetVal
    Function_Return iRetVal
End_Function

// Rename a file or folder
// Returns a nonzero value if the operation failed.
Function vRenameFile Global String sSource String sDestination Returns Integer
    Integer  iRetVal

    Get sfoRenameFile of (oShellFileOperations(Self)) sSource sDestination to iRetVal
    Function_Return iRetVal
End_Function

Function vGetWindowsDirectory Returns String
    WString wDirectory
    Integer iRetVal

    Move (ZeroString(vMAX_PATH)) to wDirectory
    Move (vWin32_GetWindowsDirectory(AddressOf(wDirectory), vMAX_PATH)) to iRetVal
    If (iRetVal > vMAX_PATH) Begin
        Move (ZeroString(iRetval)) to wDirectory
        Move (vWin32_GetWindowsDirectory(AddressOf(wDirectory), iRetVal)) to iRetVal
    End
    Function_Return (CString(wDirectory))
End_Function

Function vGetTempPath Returns String
    Integer iRetVal
    WString wTempPath

    Move (ZeroString(vMAX_PATH)) to wTempPath
    Move (vWin32_GetTempPath(vMAX_PATH, AddressOf(wTempPath))) to iRetVal
    If (iRetVal > vMAX_PATH) Begin
        Move (ZeroString(iRetval)) to wTempPath
        Move (vWin32_GetTempPath(iRetVal, AddressOf(wTempPath))) to iRetVal
    End
    Function_Return (CString(wTempPath))
End_Function

// Courtesy of Marco Kuipers
Function vMakeTempFile Returns String
    Integer iRetval
    String  sTempPath
    String  sTempFileName
    String  sPrefixString
    WString wsTempFileName

    Get vGetTempPath to sTempPath
    If (sTempPath = "") Begin
        Get vGetWindowsDirectory to sTempPath  // first fallback
        If (sTempPath<>"") Begin
            Move (sTempPath+"\Temp\") to sTempPath
        End
    End

    If (sTempPath = "") Begin
        // second fallback we really do not want to get here as to be fair using current folder as temp
        // makes little sense. Leaving this in as it was old behavior.
        Get_Current_Directory to sTempPath
    End

    Move (Trim(sTempPath)+Character(0)) to sTempPath
    If (Length(sTempPath)>(vMax_Path-14)) Begin
        Error DFERR_PROGRAM ("Temporary path"+sTempPath+"is too long, cannot create temporary files.")
    End

    Move (ZeroString(vMax_Path)) to wsTempFileName
    Move ("tmp"+Character(0))    to sPrefixString
    Move (vWin32_GetTempFileName (sTempPath, sPrefixString, 0, AddressOf(wsTempFileName))) to iRetval
    If (iRetval = 0) Begin  // The api call returns 0 if an error occurs
    //Get ShowLastError to iRetval
        Move "" to sTempFileName
    End
    Move (Cstring(wsTempFileName)) to sTempFileName
    Function_Return sTempFileName
End_Function

// This function creates a uniquely named temporary file in folder sPath
// The file created will have a prefix based on the first 3 characters in sPrefix
// Note that you will have to cleanup the tempfile yourself as the function
// does not take care of that.
Function vCreateTempFileInPath String sPath String sPrefix Returns String
    Integer iRetVal
    String  sTempFileName
    WString wTempFileName

    Move (sPath+Character(0))   to sPath
    Move (sPrefix+Character(0)) to sPrefix
    Move (Pad("", vMAX_PATH))   to wTempFileName

    Move (vWin32_GetTempFileName(sPath, sPrefix, 0, AddressOf(wTempFileName))) to iRetVal
    Move (Trim(Cstring(wTempFileName))) to sTempFileName
    Function_Return sTempFileName
End_Function

//
// Get a specific shell folder for example to get the desktop folder
// simply call this function and pass it vCSIDL_DESKTOP
//
Function vSHGetFolderPath Integer eFolder Returns String
    Integer iVoid
    Handle  hWnd
    String  sFolder
    WString wFolder

    Move (Window_Handle(focus(desktop))) to hWnd
    Move (Repeat(Character(0), vMAX_PATH)) to wFolder
    Move (vWin32_SHGetFolderPath(hWnd,eFolder, 0, 0,AddressOf(wFolder))) To iVoid
    Move (CString(wFolder)) to sFolder
    Function_Return sFolder
End_Function

// Courtesy Of Vincent Oorsprong
Function vConvertFileDateTime Global DWord dwLowDateTime DWord dwHighDateTime Returns String
    String  sFileDateTime
    WString wFormattedTime wFormattedDate
    Integer iSuccess iLenCcTime iDataLength iLenCcDate
    tvFileTime   FileTime
    tvSystemTime SystemTime

    Move "" to sFileDateTime
    Move dwLowDateTime  to FileTime.dwLowDateTime
    Move dwHighDateTime to FileTime.dwHighDateTime

    Move 0 to SystemTime.wYear

    Move (vWin32_FileTimeToSystemTime (AddressOf(FileTime), AddressOf(SystemTime))) to iSuccess
    If (iSuccess = 1) Begin
        Move (ZeroString(255))               to wFormattedTime
        Move (SizeOfWString(wFormattedTime)) to iLenCcTime
        Move (vWin32_GetTimeFormat (LOCALE_USER_DEFAULT, 0, AddressOf(SystemTime), 0, AddressOf(wFormattedTime), iLenCcTime)) to iDataLength
        Move (ZeroString(255))               to wFormattedDate
        Move (SizeOfWString(wFormattedDate)) to iLenCcDate
        Move (vWin32_GetDateFormat (LOCALE_USER_DEFAULT, 0, AddressOf(SystemTime), 0, AddressOf(wFormattedDate), iLenCcDate)) to iDataLength
        Move (Cstring (wFormattedDate)  * Cstring (wFormattedTime)) to sFileDateTime
    End
    Function_Return sFileDateTime
End_Function

// **WvA:
// A windows replacement for the standard function FileExists.
// This version will also return (true) for a file when it is open by an application.
// Note that you can apply normal windows mask-signs in the filename such as * and ?
// Example: Get vFilePathExists "C:\config.sy?"
// This will return true if you have a file matching these conditions. (aka config.sys)
Function vFilePathExists Global String sFilePathMask Returns Integer
    String  sDirSep
    Handle  hFindFile
    Integer iVoid
    tvWin32FindData FindData

    Move vINVALID_HANDLE_VALUE to hFindFile
    Move (Trim(sFilePathMask)) to sFilePathMask

    If (Length(sFilePathMask)>0) Begin
        // 2014-09-29 NGS Remove any trailing dir separators, as they make the function fail.
        Move (sysconf(SYSCONF_DIR_SEPARATOR)) to sDirSep
        While (Right(sFilePathMask, 1) = sDirSep)
            Move (Left(sFilePathMask, Length(sFilePathMask) -1)) to sFilePathMask
        Loop

        Move 0 to FindData.dwReserved0        // initialize the variable so we can get an address from it.
        Move (vWin32_FindFirstFile (sFilePathMask, AddressOf(FindData))) to hFindFile
        Move (vWin32_FindClose (hFindFile)) to iVoid
    End
    Function_Return (hFindFile <> vINVALID_HANDLE_VALUE)
End_Function


//
// Returns the amount of files in the folder (if it exists)
// Returns -1 if folder doesn't exist.
// The files "." and ".." are not counted.
//
Function vFolderFileCount Global String sFolderName Returns Integer
    Boolean bFound
    Handle  hFindFile
    Integer iCount  iVoid
    Integer iSuccess
    String  sFileName
    tvWin32FindData FindData

    Move -1 to iCount
    Get vFolderFormat sFolderName to sFolderName
    Move (sFolderName+"*") to sFolderName // match any filename in the folder
    Move 0 to FindData.dwReserved0        // initialize the variable so we can get an address from it.
    Move (vWin32_FindFirstFile (sFolderName, AddressOf(FindData))) to hFindFile
    Move (hFindFile<>vINVALID_HANDLE_VALUE) to bFound
    If (bFound) Begin
        Move 0 to iCount
    End
    While (bFound)
        Increment iCount
        Move (PointerToWString(AddressOf(FindData.cFileName))) to sFileName
        If (sFileName="." or sFileName="..") Begin
            Decrement iCount
        End
        Move (vWin32_FindNextFile(hFindFile, AddressOf(FindData))) to iSuccess
        Move (iSuccess<>0) to bFound
    Loop
    Move (vWin32_FindClose (hFindFile)) to iVoid
    Function_Return iCount
End_Function

// Create the folder, including intermediate directories.
// Don't panic if the folder already exists.
// Michael Mullan June 2009.
Function vshCreateDirectoryEX Global String sNewFolder Returns Integer
    String  sFolder
    Integer iRetval iFolderCreated
    tvSecurity_attributes SA

    Move 0 to iFolderCreated

    // null MAX_PATH chars into var (make space)
    Move (Repeat(Character(0), vMAX_PATH)) to sFolder
    If (sNewFolder <> "") Begin

        Move (SizeOfType(tvSecurity_attributes)) to SA.nLength
        Move  0  to SA.lpDescriptor
        Move  1  to SA.bInheritHandle

        //
        Move (sNewFolder+"") to sFolder
        Move (vWin32_SHCreateDirectoryEx(0,sFolder, AddressOf(SA))) to iFolderCreated
    End

    If (iFolderCreated <> 0) Begin
        Move 1 to iRetVal
        Case Begin
            Case (iFolderCreated = 161)
                Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_BAD_PATHNAME)")
                Case Break
            Case (iFolderCreated = 206)
                Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_FILENAME_EXCED_RANGE)")
                Case Break
            Case (iFolderCreated = 3)
                Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_PATH_NOT_FOUND)")
                Case Break
            Case (iFolderCreated = 80)
                Move 0 to iRetval // "ERROR_FILE_EXISTS"     not really an error
                Case Break
            Case (iFolderCreated = 183)
                Move 0 to iRetval //  "ERROR_ALREADY_EXISTS"     not really an error
                Case Break
            Case (iFolderCreated = 1223)
                Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_CANCELLED)")
                Case Break
            Case Else
                Error DFERR_OPERATOR ("Folder Creation Error # " + String(ifoldercreated) + "\n" + sNewFolder + "(FILE_CREATION_ERROR)")
        Case End
    End
    Function_Return iRetVal
End_Function

Function vWin32_APIFileSize Global String sFileName Returns Integer
    DWord   dwFileSizeHigh dwFileSizeLow
    Integer iFileSize iVoid
    Handle  hFindFile
    tvWin32FindData FindData

    Move (sFileName+"") to sFileName
    Move 0 to FindData.dwReserved0        // initialize the variable so we can get an address from it.
    Move (vWin32_FindFirstFile (sFileName, AddressOf(FindData))) to hFindFile
    If (hFindFile<>vINVALID_HANDLE_VALUE) Begin
        Move FindData.nFileSizeHigh to dwFileSizeHigh
        Move FindData.nFileSizeLow  to dwFileSizeLow
    End
    Move (vWin32_FindClose (hFindFile)) to iVoid
    Move ((dwFileSizeHigh * vMaxDword) + dwFileSizeLow) to iFileSize

    Function_Return iFileSize
End_Function

//
// Based on code in Peter Crook's Browse folder workspace
// http://support.dataaccess.com/Forums/showthread.php?54383-Browse-for-Folder-package&p=282249#post282249
//
//=============================================================================
// Verifies that a path is a valid directory.
//
// Returns TRUE if the path is a valid directory, or FALSE otherwise.
//
// Parameters:
//      sPath - Address of the path to verify.
//=============================================================================
Function vPathIsDirectory Global String sPath Returns Boolean
    Integer iResult
    Boolean bRetVal

    Move false to bRetVal
    Move (sPath - Character (0)) to sPath
    Move (vWin32_PathIsDirectory (sPath)) to iResult
    If (iResult<>0) Begin
        Move True to bRetVal
    End

    Function_Return bRetVal
End_Function