// 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 <> 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