The Hammer » VDF Splat

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

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

  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