// 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 *** // // 05-09-2000 **WvA: Changed namingconvention of all classes and methods to new standard // This may be painfull for some of you, but it was really needed as it was // getting messy. The "vs" -prefix we used before was confusing and could // unintentionally have been interpreted as "Vdf-GUIdance String". // // The used naming-convention is: // - a prefix of "vWin32_" for every external function declaration // - a prefix of the letter "v" for the full API name for the vdf-wrapper function. // // By using this we are guarding ourselves for conflicts with variable declarations // of DataAccess in the future. // Or at least almost as the letter "v" is now also synonym for variant (duh~!) // // mm-dd-yyyy Author Description // // vSHGetFolderPath added to retrieve the new shell folders // vGetWindowsDirectory // // vGetTempFileName // vGetTempPath // 11-17-2001 **WvA: Removed User Interface Error popups such as Error handling. // This is an absolute need for WebApp. We expect you to handle the // error in your application anyways. Changed this for: // vDeleteFile, vCopyFile, vMoveFile and vRenameFile // 03-02-2002 **WvA: vRemoveDirectory added // 03-11-2002 **WvA: The parameter lpdword in the external function declaration for // vWin32_SHBrowsForFolder can cause compiler errors. // It is renamed too avoid this. // 11-11-2002 **WvA: Codecleanup, vcSelectFile_Dialog is now cvSelectFile_Dialog, its // function vSelectedFileName is now just SelectedFileName // Removed the local keyword in the variable declarations // 10-17-2003 **WvA: Cleaned up function vSelect_File and added code to destroy the dynamically // created file-open dialog // 02-12-2004 **WvA: Allan Ankerstjeme pointed me into a bug for the vCreateTempFileInPath // in that it didn't exactly return the correct filename of the file created. // This has now been taken care of. // 02-19-2004 **WvA: Removed all API declarations from the package itself to improve readability // These declarations are now included from the vWin32fh header file. // 02-19-2004 **WvA: Changed the default way in which the standard file handling works // Before today one could always undo the operation, as of now you cannot as // the default was a silly one using unnecessary resources (mainly diskspace) // Since i don't really expect someone to use that feature it has been removed. // One can however restore to the old way of handling by simply calling the // vWin32fhCompatibilityMode procedure ONE time before accessing any of the // filehandling operations // 02-19-2004 **WvA: The functions ParseFolderName, ParseFileName and ParseFileExtenstion added // as well as the StringFromRightOfChar function. // 02-19-2004 **WvA: sfoFormatDisk function added which can use to format a floppydisk // DISABLED now as testing shows that it does not work as advertised... // 02-20-2004 **WvA: The function vDDE_Error_Handler didn't pass the errornumber on to the DDE_Error_To_String function // Moved the hardcoded strings from vDDE_Error_Handler to define declarations for easier translation later on. // 09-10-2004 **WvA: Added the ToAnsi function to the fileoperations method so that // extended characters are treated ok too. // Reported by Flemming from // 12-17-2004 **WvA: Changed vFilePathExists to be global, reported by Peter van Mil // 12-28-2004 **WvA: WebApp compatibility added by introducing compiler directives // 03-10-2006 **WvA: Added more CSIDL types to our header file for use with the vSHGetFolderPath function // 01-02-2007 **WvA: Set NoChangeDir_State on vSelect_File and vSelectSaveFile to True but changed it back due to side effects. // Added vSelectSavefile function to create a file save dialog // Fixed ParseFolderName which was horribly broken (thanks for the reports) // Added vParentPath function to retrieve the parent "node" of a path // 01-04-2008 **WvA: Fixed vCreateTempFileInPath as the function wasn't working // 10-04-2009 **WvA: Added vshCreateDirectoryEx from Micheal Mullan, moved filedialogs to cvFileDialogs.pkg // 01-11-2010 **WvA: Added vWin32_APIFilesize as supplied by Renato Villa, to get the filesize of the specified file. See http://support.dataaccess.com/forums/showthread.php?t=41982 Use Case.mac #IFNDEF Is$WebApp Use File_Dlg.pkg // Contains OpenDialog class definition Use cvFileDialogs.pkg #ENDIF Use Seq_chnl.pkg Use windows Use Dferror Use Dll Use vWin32fh.h // Header file with WinAPI declarations // // Gets the string from the right of the last sStopChar in sFrom // If sStopChar has no occurences in the string an empty string is // returned. Function StringFromRightOfChar Global String sFrom String sStopChar Returns String String sRetVal String sChar Integer iLength Integer iPos Boolean bStopChar Move "" To sRetval Move (Length(sFrom)) To iLength If ((iLength>0) And (Pos(sStopChar,sFrom) <> 0)) Begin Move iLength To iPos Move (False) To bStopChar While Not bStopChar Move (Mid(sFrom,1,iPos)) To sChar Decrement iPos If ((sChar=sStopChar) Or (iPos<1)) Begin Move (True) To bStopChar End Else Begin Move (sChar+sRetVal) To sRetVal End Loop End Function_Return sRetVal End_Function // StringFromRightOfChar // Pre: sFileName contains the complete path of the file. // Post: returns the complete path of the file. // This function is inspired on function SEQ_ExtractPathFromFileName of Sture Andersen. Function ParseFolderName Global String sFileName Returns String String sFile String sFolderName String sDirSep // this is "\" for windows, or "/" for unix MOve "" To sFolderName Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep If sDirSep In sFileName Begin Move (StringFromRightOfChar(sFileName,sDirSep)) To sFile Move (Replace(sFile,sFileName,"")) To sFolderName End Else If ":" In sFileName Begin Move (StringFromRightOfChar(sFileName,":")) To sFile Move (Replace(sFile,sFileName,"")) To sFolderName End Function_Return sFolderName End_Function // ParseFolderName // Pre: sFileName contains the complete path of the file. // post: The returned filename has it's path removed, but will have a extension Function ParseFileName Global String sFileName Returns String String sFolderName String sDirSep // this is "\" for windows, or "/" for unix Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep Get ParseFolderName sFileName To sFolderName If (sFolderName <> "") Move (Replace(sFolderName,sFileName,"")) To sFileName Move (Replace(sDirSep,sFileName,"")) To sFileName Function_Return sFilename End_Function // ParseFileName // Pre: sFileName may contain the complete path of the file. // or contain multiple dots in the filename, so temp.gif.bak will // return "bak" as the extension and not "gif" // Post: returns the extension only, this extension can be a valid unixlike extension // such as "html" or "java" Function ParseFileExtension Global String sFileName Returns String String sFileExtension Get StringFromRightOfChar sFileName "." To sFileExtension Function_Return sFileExtension End_Function // ParseFileExtension Define CS_DDE_ERR_UNKNOWN_LINE2 For ".\n" Function DDE_Error_To_String Integer iErrorID Returns String String sMessage Case Begin Case (iErrorID = vERROR_FILE_NOT_FOUND) Move CS_DDE_ERR_FILE_NOT_FOUND To sMessage Case Break Case (iErrorID = vERROR_PATH_NOT_FOUND) Move CS_DDE_ERR_PATH_NOT_FOUND To sMessage Case Break Case (iErrorID = vERROR_BAD_FORMAT) Move CS_DDE_ERR_BAD_FORMAT To sMessage Case Break Case (iErrorID = vSE_ERR_ACCESSDENIED) Move CS_DDE_ERR_ACCESSDENIED To sMessage Case Break Case (iErrorID = vSE_ERR_ASSOCINCOMPLETE) Move CS_DDE_ERR_ASSOCINCOMPLETE To sMessage Case Break Case (iErrorID = vSE_ERR_DDEBUSY) Move CS_DDE_ERR_DDEBUSY To sMessage Case Break Case (iErrorID = vSE_ERR_DDEFAIL) Move CS_DDE_ERR_DDEFAIL To sMessage Case Break Case (iErrorID = vSE_ERR_DDETIMEOUT) Move CS_DDE_ERR_DDETIMEOUT To sMessage Case Break Case (iErrorID = vSE_ERR_DLLNOTFOUND) Move CS_DDE_ERR_DLLNOTFOUND To sMessage Case Break Case (iErrorID = vSE_ERR_NOASSOC) Move CS_DDE_ERR_NOASSOC To sMessage Case Break Case ((iErrorID = vSE_ERR_OOM) Or (iErrorID = 0)) Move CS_DDE_ERR_OOM To sMessage Case Break Case (iErrorID = vSE_ERR_PNF) Move CS_DDE_ERR_PNF To sMessage Case Break Case (iErrorID = vSE_ERR_SHARE) Move CS_DDE_ERR_SHARE To sMessage Case Break Case Else Move CS_DDE_ERR_UNKNOWN_LINE1 To sMessage Move (sMessage*Trim(iErrorID)*CS_DDE_ERR_UNKNOWN_LINE2) To sMessage Case Break Case End Function_Return sMessage End_Function // DDE_Error_To_String Procedure vDDE_Error_Handler Integer iErrorID String sMessage Get DDE_Error_To_String iErrorID To sMessage Append sMessage CS_DDE_ERR_HANDL_PAKTC // "Press a key to continue..." Send Stop_Box sMessage CS_DDE_ERR_HANDL_CAPTION End_Procedure // vDDE_Error_Handler hInstance // Does the directory exist? - No = 0, Yes = 1 // This also works with UNC path encoding and wildcards Function vFolderExists Global String sFolderName Returns Integer String sFolder sTmp Integer bFolderExists iCh Move dfTrue To bFolderExists Move "dir:" To sFolder Append sFolder sFolderName Get Seq_New_Channel To iCh // get free channel for input Direct_Input Channel iCh sFolder Repeat Readln Channel iCh sTmp If (Trim(sTmp)="") Move dfFalse To bFolderExists Else Begin Move dfTrue To bFolderExists Indicate seqeof True // end loop End Until (seqeof) Close_Input Channel iCh Send Seq_Release_Channel iCh Function_Return bFolderExists End_Function // vFolderExists // returns folder name if a folder was selected, otherwise returns "" Function vSHBrowseForFolder Global String sDialogTitle Returns String String sFolder sBrowseInfo sTitle Pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle Integer iFolderSelected iRetval // fill string variable with null characters ZeroType vtBrowseInfo To sBrowseInfo 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. GetAddress Of sTitle To lpsTitle Put lpsTitle To sBrowseInfo At vtBrowseInfo.lpszTitle End Put vBIF_RETURNONLYFSDIRS To sBrowseInfo At vtBrowseInfo.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. Put (window_handle(focus(desktop))) To sBrowseInfo At vtBrowseInfo.hWndOwner GetAddress Of sBrowseInfo To lpsBrowseInfo // null 128 chars into var (make space) Move (Repeat(Character(0), vMAX_PATH)) To sFolder GetAddress Of sFolder To lpsFolder // select folder Move (vWin32_SHBrowseForFolder(lpsBrowseInfo)) To lpItemIdList // get selected folder name Move (vWin32_SHGetPathFromIDList(lpItemIdList, lpsFolder)) To iFolderSelected // release memory resources that are used by the ItemIdList Move (vWin32_CoTaskMemFree(lpItemIdList)) To iRetval If (iFolderSelected<>0) Function_Return (CString(sFolder)) Else Function_Return "" End_Function // vSHBrowseForFolder // returns 0 if the folder is created. // 1 if the API-call returned an error. Function vCreateDirectory Global String sNewFolder Returns Integer String sFolder sSA Pointer lpsFolder lpsSecurity_Attributes lpDescriptor Integer iRetval bFolderCreated bInheritHandle Move (False) To bFolderCreated // fill string variable with null characters ZeroType vtSecurity_attributes To sSA // null MAX_PATH chars into var (make space) Move (Repeat(Character(0), vMAX_PATH)) To sFolder If (sNewFolder <> "") Begin Move dfTrue To bInheritHandle // Setting this to NULL is already done by the zerotype command // Move NULL To lpDescriptor Put (length(sSA)) To sSA At vtSecurity_attributes.nLength //Put lpDescriptor To sSA at vtSecurity_attributes.lpDescriptor Put bInheritHandle To sSA At vtSecurity_attributes.bInheritHandle GetAddress Of sSA To lpsSecurity_Attributes // Move sNewFolder To sFolder GetAddress Of sFolder To lpsFolder Move (vWin32_CreateDirectory(lpsFolder, lpsSecurity_Attributes)) To bFolderCreated End Ifnot bFolderCreated Move 1 To iRetVal Function_Return iRetVal End_Function // vCreateDirectory // **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 String sPath Pointer lpsPath Integer iRetval bRemoved bExists Move (False) To bRemoved Move 0 To iRetVal 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 GetAddress Of sPath To lpsPath Move (vWin32_RemoveDirectory(lpsPath)) To bRemoved End If ((iRetVal=0) And (bRemoved=False)) Begin Move 1 To iRetVal End Function_Return iRetVal End_Function // vRemoveDirectory // This function informs the user that he entered a yet unknown folder and // asks if he/she wants to create the folder (Yes/No) // Choice: "Yes" - this creates the folder // if successful, the function returns false // else it will be true. // Choice: "No" - returns TRUE, This allows the programmer to take action // For example: to stop a save // Precondition: A foldername must be entered. We do not check for empty paths // This function returns a non-zero value if the folder isn't created afterwards Function vVerifyNewFolder Global String sFolderName Returns Integer Integer bIsNotValid Integer iUsers_Choice String sMessage If (vFolderExists(sFolderName) Eq 0) Begin Move "The folder '" To sMessage Append sMessage sFolderName Append sMessage "' does not yet exist,\n" Append sMessage "Do you want to create it now?" Get YesNo_Box sMessage "Confirm" MB_DefButton1 To iUsers_Choice Case Begin Case (iUsers_Choice = MBR_Yes) Move (vCreateDirectory(sFolderName)) To bIsNotValid If bIsNotValid Begin Move "An error occurred while trying to create folder '" To sMessage Append sMessage sFolderName "'.\n\n" Send Info_Box sMessage "Info" End Case Break Case (iUsers_Choice = MBR_No) Move dfTrue To bIsNotValid // Cancel the save Case Break Case End End Function_Return bIsNotValid End_Function // vVerifyNewFolder // 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 Pointer lpsOperation Pointer lpsDocument Pointer lpsParameters Pointer lpsPath // 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)) // Connect the corresponding pointers to the strings GetAddress Of sOperation To lpsOperation GetAddress Of sDocument To lpsDocument GetAddress Of sParameters To lpsParameters GetAddress Of sPath To lpsPath Get Window_Handle To hWnd Move (vWin32_ShellExecute (hWnd, lpsOperation, lpsDocument, lpsParameters, lpsPath, 1)) To hInstance If (hInstance <= 32) Begin Send vDDE_Error_Handler hInstance End End_Procedure // vShellExecute Class cShellFileOperations Is a Array Procedure Construct_Object Forward Send Construct_Object Property Integer piDeleteFlags Public 0 Property Integer piCopyFlags Public 0 Property Integer piMoveFlags Public 0 Property Integer piRenameFlags Public 0 Set piDeleteFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) Set piCopyFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) Set piMoveFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) Set piRenameFlags To (vFOF_SILENT Ior vFOF_NOCONFIRMATION) End_Procedure // Construct_Object // This function uses the shell API to perform a file operation on the // files supplied. // Function FileOperation String sSource String sDestination Integer iOperation Integer iFlags Returns Integer String sShFileOp Pointer lpShFileOp Pointer lpsSource Pointer lpsDestination Integer iRetVal Integer bUserAbort ZeroType vtShFileOpStruct To sShFileOp Move (ToAnsi(sSource)+Character(0)+Character(0)) To sSource Move (ToAnsi(sDestination)+Character(0)+Character(0)) To sDestination GetAddress Of sSource To lpsSource If iOperation Ne vFO_DELETE Begin GetAddress Of sDestination To lpsDestination Put lpsDestination To sShFileOp At vtShFileOpStruct.pTo End Put iOperation To sShFileOp At vtShFileOpStruct.wFunc Put lpsSource To sShFileOp At vtShFileOpStruct.pFrom Put iFlags To sShFileOp At vtShFileOpStruct.fFlags GetAddress Of sShFileOp To lpShFileOp Move (vWin32_SHFileOperation(lpShFileOp)) To iRetVal GetBuff From sShFileOp At vtShFileOpStruct.fAnyOperationsAborted To bUserAbort If (bUserAbort <> 0) Begin Move 80 To iRetVal // file Operation Aborted by USER End Function_Return (iRetVal) End_Function // FileOperation 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 // sfoDeleteFile 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 // sfoCopyFile 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 // sfoMoveFile // 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 // sfoRenameFile // Courtesy Of Steve Walter // Requires Windows 2000 and up according to msdn but it was // in fact available before that as an unpublished API call // a little google search shows that this was already available // in windows 95 and NT // // The format is controlled by the dialog interface. // That is, the user must click the OK button To actually Begin the format // the format cannot be started programmatically. // An alternative to this functionality would be to use a controlpanel // http://www.vdf-guidance.com/ContribPage.asp?Page=PKGCLSDFCPLAPP&ContribRecId=93 // // hWnd = The windows handle of the object from which the format Function // is called. // To Get this, // use: Get Window_Handle Of // For instance, in this app, we're going to use the Report_Panel: // Get Window_Handle Of (Report_Panel(Main(Self))) To hWind // // sDrive = The drive letter. At this moment only A and B are valid // // iOptions = Format options. // SHFMT_OPT_DEFAULT = Quick format // SHFMT_OPT_FULL = Full Format // SHFMT_OPT_SYSONLY = System only // 3 = Full format with system. (unsupported) // // Return Values: // SHFMT_ERROR = Error on format or no drive specified. // SHFMT_CANCEL = Format cancelled by user. // SHFMT_NOFORMAT = Drive is not formatable. // // // *** ATTENTION: This function has been disabled as it doesn't // seem to work, i must have made a silly mistake // somewhere. // Function sfoFormatDisk String sDrive Integer iOptions Returns DWORD Handle hWnd Integer iObj DWORD dwReturnVal Integer iDrive Function_Return (1) // STOP HERE Move (Trim(sDrive)) To sDrive If ( sDrive <> '' ) Begin If ( sDrive Contains ':' ) Move (Replace(':',sDrive,'')) To sDrive If (Not( 'AB' Contains sDrive )) Function_Return (SHFMT_NOFORMAT) If ( sDrive = 'A' ) Move 0 To iDrive Else If ( sDrive = 'B' ) Move 1 To iDrive // Window_Handle Of Desktop equals to 0 Get focus Of desktop To iObj If (iObj>desktop) ; Get Container_Handle Of iObj To hWnd While (hWnd=0 And iObj<>Desktop) Get Parent Of iObj To iObj Get Container_Handle Of iObj To hWnd End //Showln "hWnd = " hWnd " iDrive " iDrive " iOptions " iOptions Move (vWin32_ShFormatDrive(hWnd, iDrive, SHFMT_ID_DEFAULT, iOptions)) To dwReturnVal End Else Begin Move (SHFMT_ERROR) To dwReturnVal End Function_Return dwReturnVal End_Function // sfoFormatDisk //Example: // Get sfoFormatDisk 'A' 0 To dReturnVal // Formats drive A in QuickFormat // mode. End_Class // cShellFileOperations Object oShellFileOperations Is a cShellFileOperations End_Object // oShellFileOperations // 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 // vWin32fhCompatibilityMode Function vDeleteFile Global String sFileName Returns Integer Integer iRetVal Get sfoDeleteFile Of (oShellFileOperations(Self)) sFileName To iRetVal Function_Return iRetVal End_Function // vDeleteFile 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 // vCopyFile 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 // vMoveFile // 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 // vRenameFile Function vGetWindowsDirectory Returns String String sDirectory Pointer lpDirectory Integer iVoid ZeroString vMAX_PATH To sDirectory GetAddress Of sDirectory To lpDirectory Move (vWin32_GetWindowsDirectory(lpDirectory, vMAX_PATH)) To iVoid Function_Return (CString(sDirectory)) // **WvA: Changed to CString() End_Function // vGetWindowsDirectory // Courtesy of Marco Kuipers Function vMakeTempFile Returns String Integer iRetval String sTempPath sTempFileName sPrefixString Pointer lpTempPath lpTempFileName lpPrefixString Move (Repeat (Character (0), 255)) To sTempPath GetAddress Of sTempPath To lpTempPath Move (vWin32_GetTempPath (255, lpTempPath)) To iRetVal If (sTempPath = "") Begin Get_Current_Directory To sTempPath End Move (pad(sTempPath,vMax_Path-14)) To sTempPath // *WvA: 28-04-2005 Quote from msdn: The string cannot be longer than MAX_PATH-14 characters. Move (Repeat (Character (0), 255)) To sTempFileName GetAddress Of sTempFileName To lpTempFileName Move ("tmp"+character(0)) To sPrefixString // **WvA: 28-04-2005 Added a null GetAddress Of sPrefixString To lpPrefixString GetAddress Of sTempPath To lpTempPath Move (vWin32_GetTempFileName (lpTempPath, lpPrefixString, 0, lpTempFileName)) To iRetval If (iRetval = 0) Begin // **WvA: 28-04-2005 Changed condition, the api call returns 0 if an error occurs Move "" To sTempFileName End Function_Return (Cstring(sTempFileName)) // **WvA: 28-04-2005 Cstring added End_Function // vMakeTempFile // 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 String sTempFileName Integer iCnt iRetVal Pointer lpTempFileName Pointer lpPath Pointer lpPrefix Move (ToAnsi(sPath)+Character(0)) To sPath Move (ToAnsi(sPrefix)+Character(0)) To sPrefix Move (pad("", vMAX_PATH)) To sTempFileName GetAddress Of sTempFileName To lpTempFileName GetAddress Of sPath To lpPath GetAddress Of sPrefix To lpPrefix Move (vWin32_GetTempFileName(lpPath, lpPrefix, 0, lpTempFileName)) To iRetVal Move (Trim(Cstring(sTempFileName))) To sTempFileName Function_Return sTempFileName End_Function // vCreateTempFileInPath // // 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 String sFolder Integer iVoid Pointer lpsFolder Handle hWnd Move (Window_Handle(focus(desktop))) To hWnd Move (Repeat(Character(0), vMAX_PATH)) To sFolder GetAddress Of sFolder To lpsFolder Move (vWin32_SHGetFolderPath(hWnd,eFolder, 0, 0,lpsFolder)) To iVoid Function_Return (CString(sFolder)) End_Function // vSHGetFolderPath // Courtesy Of Vincent Oorsprong Function vConvertFileDateTime Global Dword dwLowDateTime Dword dwHighDateTime Returns String String sftTime sSystemTime sFormattedTime sFormattedDate Pointer lpsftTime lpsSystemTime lpsFormattedTime lpsFormattedDate Integer iSuccess iLenCcTime iDataLength iLenCcDate ZeroType vFileTime To sftTime Put dwLowDateTime To sftTime At vFileTime.dwLowDateTime Put dwHighDateTime To sftTime At vFileTime.dwHighDateTime GetAddress Of sftTime To lpsftTime ZeroType vSystemTime To sSystemTime GetAddress Of sSystemTime To lpsSystemTime Moveint (vWin32_FileTimeToSystemTime (lpsftTime, lpsSystemTime)) To iSuccess If iSuccess Eq DfTrue Begin ZeroString 255 To sFormattedTime GetAddress Of sFormattedTime To lpsFormattedTime Length sFormattedTime To iLenCcTime Moveint (vWin32_GetTimeFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; lpsFormattedTime, iLenCcTime)) To iDataLength ZeroString 255 To sFormattedDate GetAddress Of sFormattedDate To lpsFormattedDate Length sFormattedDate To iLenCcDate Moveint (vWin32_GetDateFormat (LOCALE_USER_DEFAULT, 0, lpsSystemTime, 0, ; lpsFormattedDate, iLenCcDate)) To iDataLength Function_Return (Cstring (sFormattedDate) * Cstring (sFormattedTime)) End // iSuccess End_Function // vConvertFileDateTime // **WvA Removed, See the cFileSet class for an alternative //Procedure DoBrowseDir String sFilePath //End_Procedure // DoBrowseDir // **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 sWin32FindData String sLongFileName Pointer lpsFilePathMask lpsWin32FindData Handle hFindFile Integer iVoid iRetval bFound GetAddress Of sFilePathMask To lpsFilePathMask ZeroType vWin32_Find_Data To sWin32FindData GetAddress Of sWin32FindData To lpswin32FindData Move (vWin32_FindFirstFile (lpsFilePathMask, lpsWin32FindData)) To hFindFile Move (vWin32_FindClose (hFindFile)) To iVoid Function_Return (hFindFile <> vINVALID_HANDLE_VALUE) End_Function // vFilePathExists // **WvA // Formats a foldername by first trimming it and after that by sticking a // directory separator (/\) to the end if it doesn't have one there already. // The folder may contain a drive letter or UNC encoding. Function vFolderFormat Global String sFolderName Returns String String sDirSep Move (sysconf(SYSCONF_DIR_SEPARATOR)) To sDirSep // normally \ (backslash) Move (Trim(sFolderName)) To sFolderName If (Right(sFolderName,1)<>sDirSep) Begin Move (sFolderName+sDirSep) To sFolderName End Function_Return sFolderName End_Function // vFolderFormat // // Gets the parent path of the currently supplied path // Returns "" when we are at the root folder. // Function vParentPath Global String sPath Returns String String sStrip If (Right(sPath,1)="\") Begin Move (Left(sPath,Length(sPath)-1)) To sPath End If (Pos("\",sPath)) Begin Move (StringFromRightOfChar(sPath,"\")) To sStrip Move (Replace(sStrip,sPath,"")) To sPath End Else Begin Move "" To sPath End Function_Return sPath End_Function // vParentPath // 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 sSA Pointer lpsFolder lpsSecurity_Attributes Integer iRetval bFolderCreated bInheritHandle Move (False) to bFolderCreated // fill string variable with null characters ZeroType vtSecurity_attributes to sSA // null MAX_PATH chars into var (make space) Move (Repeat(Character(0), vMAX_PATH)) to sFolder If (sNewFolder <> "") Begin Move dfTrue to bInheritHandle // Setting this to NULL is already done by the zerotype command // Move NULL To lpDescriptor Put (length(sSA)) to sSA At vtSecurity_attributes.nLength //Put lpDescriptor To sSA at vtSecurity_attributes.lpDescriptor Put bInheritHandle to sSA At vtSecurity_attributes.bInheritHandle GetAddress of sSA to lpsSecurity_Attributes // Move sNewFolder to sFolder GetAddress of sFolder to lpsFolder Move (vWin32_SHCreateDirectoryEx(0,lpsFolder, lpsSecurity_Attributes)) to bFolderCreated End If (bFolderCreated <> 0) Begin Move 1 to iRetVal If (bFolderCreated = 161 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_BAD_PATHNAME)") Else If (bFolderCreated = 206 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_FILENAME_EXCED_RANGE)") Else If (bFolderCreated = 3 ) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_PATH_NOT_FOUND)") Else If (bFolderCreated = 80 ) Move 0 to iRetval // "ERROR_FILE_EXISTS" not really an error Else If (bFolderCreated = 183 ) Move 0 to iRetval // "ERROR_ALREADY_EXISTS" not really an error Else If (bFolderCreated = 1223) Error DFERR_OPERATOR ("Path " + sNewFolder + " is Not Valid (ERROR_CANCELLED)") Else Error DFERR_OPERATOR ("Folder Creation Error # " + String(bfoldercreated) + "\n" + sNewFolder + "(FILE_CREATION_ERROR)") End Function_Return iRetVal End_Function // vshCreateDirectoryEX Function vWin32_APIFileSize Global string sFileName returns integer dWord dwFileSizeHigh dwFileSizeLow integer iFileSize iVoid handle hFindFile pointer lpsFilePath lpsWin32FindData string sWin32FindData GetAddress of sFileName to lpsFilePath ZeroType vWin32_Find_Data to sWin32FindData GetAddress of sWin32FindData to lpsWin32FindData move (vWin32_FindFirstFile (lpsFilePath, lpsWin32FindData)) to hFindFile if (hFindFile<>INVALID_HANDLE_VALUE) begin GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeHigh To dwFileSizeHigh GetBuff From sWin32FindData At vWin32_Find_Data.nFileSizeLow To dwFileSizeLow end move (vWin32_FindClose (hFindFile)) to iVoid moveInt ((dwFileSizeHigh * vMaxDword) + dwFileSizeLow) to iFileSize function_return iFileSize End_Function // vWin32_APIFileSize