vWin32fh.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 ***
//

// 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
// 10-02-2011 **WvA: Added vCSIDL_SYSTEMX86, courtesy of Ola Eldoy for pointing this out and providing the define statement.
// 20-12-2012 **WvA: Default behavior on copy/move is now to autocreate subfolders, tip by Frank Cheng
// 29-09-2014 **WvA: Added function vFolderFileCount to count the number of files in a folder, add vCSIDL_PROGRAM_FILESx86
// 04-10-2014 **WvA: Added extra checks on vFilePathExists and vFolderExists courtesy of Nils Svedmyr

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

  // 2013-09-29 NGS Check for empty folder name and convert to ANSI
  Move (ToANSI(Trim(sFolderName))) to sFolderName
  If (sFolderName = "") Begin
    Function_Return False
  End

  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_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 // 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 <object>
  //          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
  Integer iVoid

  ZeroString vMAX_PATH To sDirectory
  Move (vWin32_GetWindowsDirectory(AddressOf(sDirectory), vMAX_PATH)) To iVoid
  Function_Return (CString(sDirectory))
End_Function // vGetWindowsDirectory

Function vGetTempPath Returns String
  Integer iRetval
  String  sTempPath

  ZeroString vMAX_PATH to sTempPath
  Move (vWin32_GetTempPath (vMAX_PATH, AddressOf(sTempPath))) to iRetVal
  Function_Return (Cstring(sTempPath))
End_Function // vGetTempPath


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

    Get vGetTempPath to sTempPath
    If (sTempPath = "") Begin
      Get vGetWindowsDirectory to sTempPath  // first fallback
      If (sTempPath<>"") Move (sTempPath+"\Temp\") to sTempPath
    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

    ZeroString vMax_Path to sTempFileName
    Move ("tmp"+character(0)) to sPrefixString // **WvA: 28-04-2005 Added a null
    Move (vWin32_GetTempFileName (AddressOf(sTempPath), AddressOf(sPrefixString), 0, AddressOf(sTempFileName))) to iRetval
    If (iRetval = 0) Begin  // **WvA: 28-04-2005 Changed condition, the api call returns 0 if an error occurs
      //Get ShowLastError to iRetval
      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  sDirSep
  Pointer lpsFilePathMask lpsWin32FindData
  Handle  hFindFile
  Integer iVoid

  Move vINVALID_HANDLE_VALUE To hFindFile
  Move (ToANSI(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
    
    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
  End
  Function_Return (hFindFile <> vINVALID_HANDLE_VALUE)
End_Function // vFilePathExists

//
// WideChar version of the function, do not use, it's an experiment
//
Function vWFilePathExists Global String sFilePathMask Returns Integer
  String  sWin32FindData
  String  sDirSep
  Pointer lpsFilePathMask lpsWin32FindData
  Handle  hFindFile
  Integer iVoid

  Move vINVALID_HANDLE_VALUE To hFindFile
  
  If (length(sFilePathMask)>0) Begin
    
    GetAddress Of sFilePathMask To lpsFilePathMask
    ZeroType vWin32_Find_Data To sWin32FindData
    GetAddress Of sWin32FindData To lpswin32FindData
    Move (vWin32W_FindFirstFile (lpsFilePathMask, lpsWin32FindData)) To hFindFile
    Move (vWin32_FindClose (hFindFile)) To iVoid
  End
  Function_Return (hFindFile <> vINVALID_HANDLE_VALUE)
End_Function // vWFilePathExists



// **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
//
// 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
  Pointer lpsFolderName lpsWin32FindData
  String  sWin32FindData
  String  sFileName
  
  Move -1 To iCount
  Get vFolderFormat sFolderName To sFolderName
  Move (sFolderName+"*") To sFolderName // match any filename in the folder
  GetAddress Of sFolderName To lpsFolderName
  ZeroType vWin32_Find_Data To sWin32FindData
  GetAddress Of sWin32FindData To lpswin32FindData
  Move (vWin32_FindFirstFile (lpsFolderName, lpsWin32FindData)) To hFindFile
  Move (hFindFile<>vINVALID_HANDLE_VALUE) To bFound
  If (bFound) Move 0 To iCount
  While (bFound)
    Increment iCount
    GetBuff_String From sWin32FindData At vWin32_Find_Data.cFileName To sFileName
    If (sFileName="." or sFileName="..") Decrement iCount
    Move (vWin32_FindNextFile(hFindFile, lpsWin32FindData)) To iSuccess
    Move (iSuccess<>0) To bFound
  Loop
  Move (vWin32_FindClose (hFindFile)) To iVoid
  Function_Return iCount
End_Function // vFolderFileCount
   

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