2013-08-20 12:34

'
' ============================================================================
' QDIR   RAPIDQ EXTENDED COMPONENT       April 2004        By Jacques Philippe
'
'    SEARCH FOR MATCHING FILES IN DIRECTORY AND SUBDIRECTORIES
'    FILTERS ON EXTENSION, MUST_ATTRIBUTES and REJECTED_ATTRIBUTES
'
' COMPONENT CODE                                                 Version 1.0.4
' ============================================================================
'
' $TYPECHECK ON
'
' -------------------------------------------------------------
' CONSTANTES DEFINITIONS
' ----------------------
     CONST QDIR_RQCR = CHR$(10)      ' avoid using $ESCAPECHARS ON IN COMPONENT
     CONST QDIR_BACKSLASH = CHR$(92)
'
     CONST QDIR_MAXWORD = &HFFFF
     CONST QDIR_INVALID_HANDLE_VALUE = -1
     CONST QDIR_FILE_ATTRIBUTE_ARCHIVE = &H20        ' "A"
     CONST QDIR_FILE_ATTRIBUTE_DIRECTORY = &H10      ' "D"
     CONST QDIR_FILE_ATTRIBUTE_HIDDEN = &H2          ' "H"
     CONST QDIR_FILE_ATTRIBUTE_NORMAL = &H80         ' "N"
     CONST QDIR_FILE_ATTRIBUTE_READONLY = &H1        ' "R"
     CONST QDIR_FILE_ATTRIBUTE_SYSTEM = &H4          ' "S"
     CONST QDIR_FILE_ATTRIBUTE_TEMPORARY = &H100     ' "T"
     CONST QDIR_FILE_ATTRIBUTE_COMPRESSED = &H800    ' "C"
'    NO ATTRIBUTE SET                      ' "0"  ' zero

' TYPE DEFINITIONS
' ----------------
     TYPE QDIR_FILETIME
      lowDateTime AS LONG
      highDateTime AS LONG
     END TYPE

     TYPE QDIR_WIN32_FIND_DATA                            '   WIN32 NAMES
      attributes AS LONG                          '   dwFileAttributes As Long
                                                '   ftCreationTime As FILETIME
                                                '   ftLastAccessTime As FILETIME
                                                '   ftLastWriteTime As FILETIME
                                                '   RAPIDQ BUGS WITH NESTED TYPES so REPLACED BY ! No Differences
      creationLowDateTime AS LONG                 '   ftCreationTime.dwLowDateTime As Long
      creationHighDateTime AS LONG                '   ftCreationTime.dwHighDateTime As Long
      lastAccessLowDateTime AS LONG               '   ftLastAccessTime.dwLowDateTime As Long
      lastAccessHighDateTime AS LONG              '   ftLastAccessTime.dwHighDateTime As Long
      lastWriteLowDateTime AS LONG                '   ftLastWriteTime.dwLowDateTime As Long
      lastWriteHighDateTime AS LONG               '   ftLastWriteTime.dwHighDateTime As Long
      fileSizeHigh AS LONG                        '   nFileSizeHigh As Long
      fileSizeLow AS LONG                         '   nFileSizeLow As Long
      dwReserved0 AS LONG
      dwReserved1 AS LONG
      cFileName AS STRING * 260
      cAlternate AS STRING * 14
     END TYPE

     TYPE QDIR_SYSTEMTIME
      year AS SHORT  ' VB integer = RQ Short
      month AS SHORT
      dayOfWeek AS SHORT
      day AS SHORT
      hour AS SHORT
      minute AS SHORT
      second AS SHORT
      milliseconds AS SHORT
    ' Extended
      DateTime AS DOUBLE            ' The DateTime As A Number
      date AS STRING * 10           ' Date as a String  mm/dd/yyyy
      dateEU AS STRING * 10         ' EU date Foramt dd/mm/yyyy
      dateAlpha AS STRING * 16      ' "ddd" "mmm" DD, yyyy
      dateAlphaEU AS STRING * 15    ' "ddd" DD "mmm" yyyy
      time AS STRING * 8            ' without ms  HH:MM:SS
      timems AS STRING * 12         ' Time As a String  HH:MM:SS.iii
      strDayOfWeek AS STRING * 3    ' day of the week as in Day(0 To 6) : "Mon", "Tue", "Wed", ... "Sun"
      nWeekDay AS STRING * 1        ' "0", "1", "2", ... "6"
      strMonthOfYear AS STRING * 3  ' day of the week as in Months(1 To 12) : "Jan", "Feb", ... "Dec"
     END TYPE

' -------------------------------------------------------------
' API DECLARATIONS
' ----------------
'
     DECLARE FUNCTION QDIR_FindFirstFile LIB "kernel32" ALIAS "FindFirstFileA" (ByRef lpFileName AS STRING, _
      ByRef lpFindFileData AS QDIR_WIN32_FIND_DATA) AS LONG
     DECLARE FUNCTION QDIR_FindClose LIB "kernel32" ALIAS "FindClose" (BYVAL hFindFile AS LONG) AS LONG
     DECLARE FUNCTION QDIR_FindNextFile LIB "kernel32" ALIAS "FindNextFileA" (BYVAL hFindFile AS LONG, _
      lpFindFileData AS QDIR_WIN32_FIND_DATA) AS LONG
     DECLARE FUNCTION QDIR_FileTimeToLocalFileTime LIB "kernel32" ALIAS "FileTimeToLocalFileTime" _
      (lpFileTime AS QDIR_FILETIME, lpLocalFileTime AS QDIR_FILETIME) AS LONG
     DECLARE FUNCTION QDIR_FileTimeToSystemTime LIB "kernel32" ALIAS "FileTimeToSystemTime" _
      (lpFileTime AS QDIR_FILETIME, lpSystemTime AS QDIR_SYSTEMTIME) AS LONG

' ------------------------------------------------------------------------------------
' API, CONSTANTES & TYPES DECLARATIONS FOR ChangeFileDateTime And ChangeFileAttributes
' ------------------------------------------------------------------------------------
'
' cft for Change_File_Time and to prevent double declaration of type ...
'
     TYPE T_FILETIMEcft
      dwLowDateTime AS LONG
      dwHighDateTime AS LONG
     END TYPE
'
     TYPE T_SYSTEMTIMEcft
      wYear AS SHORT  ' VB INTEGER ARE RQ SHORT
      wMonth AS SHORT
      wDayOfWeek AS SHORT
      wDay AS SHORT
      wHour AS SHORT
      wMinute AS SHORT
      wSecond AS SHORT
      wMilliseconds AS SHORT
     END TYPE
'
     CONST QDIR_GENERIC_WRITE = &H40000000
     CONST QDIR_OPEN_EXISTING = 3
     CONST QDIR_FILE_SHARE_READ = &H1
     CONST QDIR_FILE_SHARE_WRITE = &H2
'
     DECLARE FUNCTION QDIR_SetFileTime LIB "kernel32" ALIAS "SetFileTime" (BYVAL hFile AS LONG, _
      lpCreationTime AS T_FILETIMEcft, lpLastAccessTime AS T_FILETIMEcft, _
      lpLastWriteTime AS T_FILETIMEcft) AS LONG
     DECLARE FUNCTION QDIR_SystemTimeToFileTime LIB "kernel32" ALIAS "SystemTimeToFileTime" _
      (lpSystemTime AS T_SYSTEMTIMEcft, lpFileTime AS T_FILETIMEcft) AS LONG
     DECLARE FUNCTION QDIR_CreateFile LIB "kernel32" ALIAS "CreateFileA" (ByRef lpFileName AS STRING, _
      BYVAL dwDesiredAccess AS LONG, BYVAL dwShareMode AS LONG, _
      BYVAL lpSecurityAttributes AS LONG, BYVAL dwCreationDisposition AS LONG, _
      BYVAL dwFlagsAndAttributes AS LONG, BYVAL hTemplateFile AS LONG) AS LONG
     DECLARE FUNCTION QDIR_CloseHandle LIB "kernel32" ALIAS "CloseHandle" (BYVAL hObject AS LONG) AS LONG
     DECLARE FUNCTION QDIR_SetFileAttributes LIB "kernel32" ALIAS "SetFileAttributesA" _
      (ByRef lpFileName AS STRING, BYVAL dwFileAttributes AS LONG) AS LONG'
'
' -------------------------------------------------------------
' Template required for creating an Event ... HTML DOC CHAPTER 10-9
'
     DECLARE SUB OnFileFound_EventTemplate '(Sender As QDir)
'
' -------------------------------------------------------------
' QOBJECT CREATION
' ----------------
'
     TYPE QDir EXTENDS QOBJECT
PUBLIC:
        ' Event - Truely Read Write
      OnFileFound AS EVENT (OnFileFound_EventTemplate)  ' RW
        ' Find Files Pärameters - Should Be Read Only
      fileName AS STRING
      dosFileName AS STRING
      path AS STRING
      pathFileName AS STRING
      size AS DOUBLE
      WithDotsDirs AS LONG
        ' File Times - Should Be Read Only
      dateTime AS DOUBLE    ' ???
      time AS STRING
      timems AS STRING
      date AS STRING
      dateEU AS STRING
      dateAlpha AS STRING
      dateAlphaEU AS STRING
      strDayOfWeek AS STRING
      strMonthOfYear AS STRING
        ' Attibutes - Should Be Read Only
      attributes AS LONG
      attributesAsString AS STRING
        ' Text Month, WeekDay - Truely Read Write
      days(0 TO 6) AS STRING     ' RW
      months(1 TO 12) AS STRING  ' RW
        ' Date and Time Variable - Should Be Read Only
      creation AS QDIR_SYSTEMTIME
      lastAccess AS QDIR_SYSTEMTIME
      lastWrite AS QDIR_SYSTEMTIME
      flagStop AS LONG
      flagShowFormStopDir AS LONG
      frmDirStop AS QFORM
      lblDirStop AS QLABEL
PRIVATE:
      hSearch AS LONG   ' will be used to get file recursively with GetNextFile
      applicationPath AS STRING   ' "As String" Added on 21oct2002, was missing
      filter AS STRING        ' Ex *.Bas
      busy AS LONG
      fileStruct AS QDIR_WIN32_FIND_DATA
        ' Attributes Parameters
      rejectedAttributes AS STRING
      mustAttributes AS STRING
        ' Date Time Variables
      fileTime AS QDIR_FILETIME
      fileLocalTime AS QDIR_FILETIME
      lstDir AS QSTRINGLIST
'
      SUB OnClic_frmDirStop
       QDir.flagStop = 1
      END SUB
'
      CONSTRUCTOR
       flagShowFormStopDir = 1
       flagStop = 0
       applicationPath = COMMAND$(0) - Application.exeName
       OnFileFound = 0
       busy = 0
       WithDotsDirs = 1
       rejectedAttributes = ""
       mustAttributes = ""
       days(0) = "Sunday"     '"Dim"   ' May Be Changed days(0 To 6) is Public
       days(1) = "Monday"     '"Lun"
       days(2) = "Tuesday"    '"Mar"
       days(3) = "Wednesday"  '"Mer"
       days(4) = "Thursday"   '"Jeu"
       days(5) = "Friday"     '"Ven"
       days(6) = "Saturday"   '"Sam"
       months(1) = "January"           ' May be Changed  months(1 To 12) is Public
       months(2) = "February"
       months(3) = "March"
       months(4) = "April"
       months(5) = "May"
       months(6) = "June"
       months(7) = "July"
       months(8) = "August"
       months(9) = "September"
       months(10) = "October"
       months(11) = "November"
       months(12) = "December"
       frmDirStop.top = 40
       frmDirStop.Left = 40
       frmDirStop.Width = 400
       frmDirStop.Height = 200
       frmDirStop.COLOR = 0
       frmDirStop.Visible = 0
       frmDirStop.BorderStyle = 0 ' 0 bsNone, 1-4 bsSingle
'
       lblDirStop.Align = 5
       lblDirStop.Autosize = 0
       lblDirStop.Alignment = 2   ' taCenter
       lblDirStop.LabelStyle = 1  ' IsRaised
       lblDirStop.Layout = 2      ' tlCenter
       lblDirStop.PARENT = QDir.frmDirStop
       lblDirStop.OnClick = QDir.OnClic_frmDirStop
       lblDirStop.Font.COLOR = &H60FF60
       lblDirStop.Font.Size = 16
       lblDirStop.Font.Bold = True
       lblDirStop.CAPTION = CHR$(10) & "CLIC  ME  TO  ABORT" & CHR$(10) & CHR$(10) & "  DIRECTORY  SCANNING"
      END CONSTRUCTOR

' -------- PRIVATE TOOL FUNCTION---------------------------------------------

' *****************
      WITH QDir '*******  to the bottom of the file
' *****************

PRIVATE:
' ---------------------------------------------------------------------------
       FUNCTION CheckAttributes AS LONG        ' return 1 if file is Accepted
        IF .rejectedAttributes <> "" THEN
                        ' NO ATTRIBUTE SET                             "0"
         IF (INSTR(.rejectedAttributes, "0") AND .fileStruct.attributes = 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_QDIR_FILE_ATTRIBUTE_ARCHIVE = &H20        ' "A"
         IF (INSTR(.rejectedAttributes, "A") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_ARCHIVE) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_DIRECTORY = &H10      ' "D"
         IF (INSTR(.rejectedAttributes, "D") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_DIRECTORY) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_HIDDEN = &H2          ' "H"
         IF (INSTR(.rejectedAttributes, "H") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_HIDDEN) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_NORMAL = &H80         ' "N"
         IF (INSTR(.rejectedAttributes, "N") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_NORMAL) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_READONLY = &H1        ' "R"
         IF (INSTR(.rejectedAttributes, "R") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_READONLY) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_SYSTEM = &H4          ' "S"
         IF (INSTR(.rejectedAttributes, "S") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_SYSTEM) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_TEMPORARY = &H100     ' "T"
         IF (INSTR(.rejectedAttributes, "T") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_TEMPORARY) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
                        ' Const QDIR_FILE_ATTRIBUTE_COMPRESSED = &H800    ' "C"
         IF (INSTR(.rejectedAttributes, "C") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_COMPRESSED) > 0) THEN _
          Result = 0:EXIT FUNCTION ' False
        END IF
'
'            IF (Len(.mustAttributes) And (.fileStruct.attributes And QDIR_FILE_ATTRIBUTE_DIRECTORY) = 0)Then ' No Must Attributes For Directories
        IF .mustAttributes <> "" THEN
         IF (INSTR(.mustAttributes, "0") AND .fileStruct.attributes <> 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "A") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_ARCHIVE) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "D") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_DIRECTORY) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "H") AND (.fileStruct.attributes AND  QDIR_FILE_ATTRIBUTE_HIDDEN) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "N") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_NORMAL) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "R") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_READONLY) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "S") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_SYSTEM) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "T") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_TEMPORARY) = 0) THEN _
          Result = 0:EXIT FUNCTION
         IF (INSTR(.mustAttributes, "C") AND (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_COMPRESSED) = 0) THEN _
          Result = 0:EXIT FUNCTION
        END IF
        Result = 1 ' true  File Accepted
       END FUNCTION
' ---------------------------------------------------------------------------
        ' Convert a Dw To A Double
        ' ------------------------
       FUNCTION  DwToDbl (iDw AS LONG) AS DOUBLE
        DEFDBL dwTmp, dbl2exp31
        dwTmp = iDw
        dbl2exp31 = 2147483648   ' 2^31
        IF dwTmp < 0 THEN        ' Bit 31, Integer bit sign is set
         dwTmp = dwTmp SHL 1  ' get rid of bit 31
         dwTmp = dwTmp SHR 1
         Result = dbl2exp31  +  dwTmp  ' add the value of bit 31
        ELSE
         Result = dwTmp
        END IF
       END FUNCTION

        ' multiplie a dw x dw in a Double   dw x dw = dbl
        ' -----------------------------------------------
       FUNCTION RQdwXdw (dwHigh AS LONG, dwLow AS LONG) AS DOUBLE
        DEFDBL dbl2exp32
        dbl2exp32 = 4294967296   ' 2^32
        Result = .dwToDbl(dwLow) + (dbl2exp32 * .dwToDbl(dwHigh))
       END FUNCTION
' ---------------------------------------------------------------------------
        ' Extract The FileName From the FileStructure
        ' -------------------------------------------
       FUNCTION ExtractFilename AS STRING
        DEFINT iPtr
        iPtr = INSTR (.fileStruct.cFilename, CHR$(0))
        Result = LEFT$(.fileStruct.cFilename, iPtr - 1)
       END FUNCTION

        ' Extract the DOS FileName From the FileStructure
        ' -----------------------------------------------
       FUNCTION ExtractDosFilename AS STRING
        DEFINT iPtr
        iPtr = INSTR (.fileStruct.cAlternate, CHR$(0))
        Result = LEFT$(.fileStruct.cAlternate, iPtr - 1)
       END FUNCTION
' ---------------------------------------------------------------------------
        ' Format Elements of Date and Time
        ' --------------------------------
       FUNCTION ElementDateTimeFormat (DATA AS SHORT) AS STRING  ' "1/1/2001  1:1:1.1" > "01/01/2001 01:01:01.1"
        IF DATA < 10 THEN  Result = "0" & STR$(DATA):EXIT FUNCTION
        Result = STR$(DATA)
       END FUNCTION

       FUNCTION MsFormat (DATA AS SHORT) AS STRING
        IF DATA < 10 THEN Result = "00" & STR$(DATA):EXIT FUNCTION
        IF DATA < 100 THEN Result = "0" & STR$(DATA):EXIT FUNCTION
        Result = STR$(DATA)
       END FUNCTION

       FUNCTION YearFormat (DATA AS SHORT) AS STRING
        IF DATA < 10 THEN Result = "000" & STR$(DATA):EXIT FUNCTION
        IF DATA < 100 THEN Result = "00" & STR$(DATA):EXIT FUNCTION
        IF DATA < 1000 THEN Result = "0" & STR$(DATA):EXIT FUNCTION
        Result = STR$(DATA)
       END FUNCTION
' ---------------------------------------------------------------------------
        ' Build Date And Time
        ' -------------------
       SUB ConvertTimeToStrings (iSystemTime AS QDIR_SYSTEMTIME)
        iSystemTime.dateEU = .ElementDateTimeFormat(iSystemTime.Day) & "/" _
         & .ElementDateTimeFormat(iSystemTime.Month) & "/" _
         & .YearFormat(iSystemTime.Year)               ' dd/mm/yyyy
        iSystemTime.date = .ElementDateTimeFormat(iSystemTime.Month) & "/" _
         & .ElementDateTimeFormat(iSystemTime.Day) & "/" _
         & .YearFormat(iSystemTime.Year)                         ' mm/dd/yyyy
        iSystemTime.timems = .ElementDateTimeFormat(iSystemTime.Hour) & ":" _
         & .ElementDateTimeFormat(iSystemTime.Minute) & ":" _
         & .ElementDateTimeFormat(iSystemTime.Second)  & "." _
         & .MsFormat(iSystemTime.Milliseconds)
        iSystemTime.Time = LEFT$(iSystemTime.timems, 8)
        iSystemTime.nWeekDay = STR$(iSystemTime.DayOfWeek)
        iSystemTime.strDayOfWeek = LEFT$(.days(iSystemTime.DayOfWeek), 3)
        iSystemTime.strMonthOfYear = LEFT$(.months(iSystemTime.Month), 3)
        iSystemTime.dateAlphaEU = iSystemTime.strDayOfWeek & " " _
         & .ElementDateTimeFormat(iSystemTime.Day) & " "  _
         & iSystemTime.strMonthOfYear & " " _
         & .YearFormat(iSystemTime.Year)
        iSystemTime.dateAlpha = iSystemTime.strDayOfWeek & " " _
         & iSystemTime.strMonthOfYear & " "_
         & .ElementDateTimeFormat(iSystemTime.Day) & ", "  _
         & .YearFormat(iSystemTime.Year)
       END SUB
' ---------------------------------------------------------------------------
        ' Get Times, Size, Names, Attributes of File
        ' ------------------------------------------
       SUB GetFileDatas
        DEFSTR sTmp
        .fileName = .ExtractFileName
        .dosFileName = .ExtractDosFileName
        .pathFileName = .path & .fileName
            ' file size
        .size = .RQdwXdw(.fileStruct.fileSizeHigh, .fileStruct.fileSizeLow)
            ' GET AND COMPUTE VARIOUS FILE TIMES
            ' ----------------------------------
            ' FILE CREATION TIME
            ' ------------------
        .creation.DateTime = .RQdwXdw(.fileStruct.creationHighDateTime, _
         .fileStruct.creationLowDateTime)
            ' Copy Time LONGS in a QDIR_FILETIME  Type
        .fileTime.lowDateTime = .fileStruct.creationLowDateTime
        .fileTime.highDateTime = .fileStruct.creationHighDateTime

        QDIR_FileTimeToLocalFileTime(.fileTime, .fileLocalTime)
        QDIR_FileTimeToSystemTime(.fileLocalTime, .creation)

        .ConvertTimeToStrings (QDir.creation)

            ' FILE LAST ACCESS TIME
            ' ---------------------
        .lastAccess.DateTime = .RQdwXdw(.fileStruct.lastAccessHighDateTime, _
         .fileStruct.lastAccessLowDateTime)
            ' Copy Time LONGS in a QDIR_FILETIME  Type
        .fileTime.lowDateTime = .fileStruct.lastAccessLowDateTime
        .fileTime.highDateTime = .fileStruct.lastAccessHighDateTime

        QDIR_FileTimeToLocalFileTime(.fileTime, .fileLocalTime)
        QDIR_FileTimeToSystemTime(.fileLocalTime, .lastAccess)

        .ConvertTimeToStrings (QDir.lastAccess)

            ' FILE LAST WRITE TIME
            ' --------------------
        .lastWrite.DateTime = .RQdwXdw(.fileStruct.lastWriteHighDateTime, _
         .fileStruct.lastWriteLowDateTime)
            ' Copy Time LONGS in a QDIR_FILETIME  Type
        .fileTime.lowDateTime = .fileStruct.lastWriteLowDateTime
        .fileTime.highDateTime = .fileStruct.lastWriteHighDateTime

        QDIR_FileTimeToLocalFileTime(.fileTime, .fileLocalTime)
        QDIR_FileTimeToSystemTime(.fileLocalTime, .lastWrite)

        .ConvertTimeToStrings (QDir.lastWrite)

            ' Set Component FILE TIME propreties for to last write time
            ' ----------------------------------------------------------
        .dateTime = .lastWrite.DateTime
        .date = .lastWrite.date
        .dateEU = .lastWrite.dateEU
        .dateAlpha = .lastWrite.dateAlpha
        .dateAlphaEU = .lastWrite.dateAlphaEU
        .time = .lastWrite.time
        .timems = .lastWrite.timems
        .strDayOfWeek = .lastWrite.strDayOfWeek
        .strMonthOfYear = .lastWrite.strMonthOfYear

            ' file attributes
            ' ---------------
        .attributes = .fileStruct.Attributes
            'Const QDIR_FILE_ATTRIBUTE_ARCHIVE = &H20        ' "A"
            'Const QDIR_FILE_ATTRIBUTE_DIRECTORY = &H10      ' "D"
            'Const QDIR_FILE_ATTRIBUTE_HIDDEN = &H2          ' "H"
            'Const QDIR_FILE_ATTRIBUTE_NORMAL = &H80         ' "N"
            'Const QDIR_FILE_ATTRIBUTE_READONLY = &H1        ' "R"
            'Const QDIR_FILE_ATTRIBUTE_SYSTEM = &H4          ' "S"
            'Const QDIR_FILE_ATTRIBUTE_TEMPORARY = &H100     ' "T"
            'Const QDIR_FILE_ATTRIBUTE_COMPRESSED = &H800    ' "C"
            '  NO ATTRIBUTE SET                         ' "0"
        sTmp = ""
        IF .attributes AND QDIR_FILE_ATTRIBUTE_ARCHIVE    THEN sTmp = sTmp & "A"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_DIRECTORY  THEN sTmp = sTmp & "D"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_HIDDEN     THEN sTmp = sTmp & "H"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_NORMAL     THEN sTmp = sTmp & "N"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_READONLY   THEN sTmp = sTmp & "R"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_SYSTEM     THEN sTmp = sTmp & "S"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_TEMPORARY  THEN sTmp = sTmp & "T"
        IF .attributes AND QDIR_FILE_ATTRIBUTE_COMPRESSED THEN sTmp = sTmp & "C"
        IF sTmp = "" THEN sTmp = "0"
        .attributesAsString = sTmp
       END SUB
' ---------------------------------------------------------------------------
' -------- PUBLIC METHODS ---------------------------------------------------
' ---------------------------------------------------------------------------
PUBLIC:
        '
        ' DIR   SIMPLE DIR
        ' ----------------
       SUB Dir (sPathFilter AS STRING, sRejectedAttributes AS STRING, sMustAttributes AS STRING)
        DEFSTR aPathFilter, pathFilter
        DEFINT iPtr, hTmp, iFileFound
        IF .busy = 0 THEN
         .busy = 1
         .flagStop = 0
         IF .flagShowFormStopDir <> 0 THEN .frmDirStop.Show
         .rejectedAttributes = UCASE$(sRejectedAttributes)   ' "ADHNRSTC0"
         .mustAttributes = UCASE$(sMustAttributes)
                ' format the pathfilter
         pathFilter = sPathFilter
                ' allow "/" as directory separator in the pathFilter
         pathFilter = REPLACESUBSTR$(pathFilter, "/", CHR$(92))
                ' delete a "\" ahead of pathFilter (= error)
         IF LEFT$(pathFilter, 1) = QDIR_BACKSLASH THEN pathFilter = MID$(pathFilter, 2)
                ' Extract or Compose the path
         iPtr = RInstr(pathFilter, QDIR_BACKSLASH)
         .path = LEFT$(pathFilter, iPtr)
         .filter = MID$(pathFilter, iptr + 1)
         IF INSTR(pathFilter, ":") = 0 THEN .path = .applicationPath & .path
                ' Scans the files
         hTmp = QDIR_FindFirstFile (pathFilter, .fileStruct)
         IF hTmp <> -1 THEN   ' pathfilter does not exist
          iFileFound = hTmp
          WHILE iFileFound <> 0
           IF .CheckAttributes <> 0 THEN
            .GetFileDatas
            IF .WithDotsDirs = 1 THEN
             CALLFUNC .OnFileFound
            ELSE
             IF (.fileName <> "." AND .fileName <> "..") THEN CALLFUNC .OnFileFound
            END IF
           END IF
           iFileFound = QDIR_FindNextFile (hTmp, .fileStruct)
           IF .flagStop <> 0 THEN EXIT WHILE
           DOEVENTS
          WEND
                'Else
                '    ShowMessage ("QDIR ERROR : DIRECTORY DOES NOT EXIST\nOR INVALID FILTER")
         END IF
         .frmDirStop.Visible = 0
         QDIR_FindClose (hTmp)
         .busy = 0
        ELSE
         SHOWMESSAGE ("QDIR ERROR : QDIR ALREADY SEARCHING,\nPROGRAMMER SHOULD HAVE CREATE ANOTHER QDIR")
        END IF
       END SUB
'
' ---------------------------------------------------------------------------
        '
        ' DIR /S  Recursive DIR
        ' ---------------------
       SUB Dirs (sPathFilter AS STRING, sRejectedAttributes AS STRING, sMustAttributes AS STRING)
        DEFSTR aPathFilter, pathFilter
        DEFINT iPtr, hTmp, iFileFound, iLstDirIndex, N
        IF .busy = 0 THEN
         .busy = 1
         .flagStop = 0
         IF .flagShowFormStopDir <> 0 THEN .frmDirStop.Show
         .rejectedAttributes = UCASE$(sRejectedAttributes)   ' "ADHNRSTC0"
         .mustAttributes = UCASE$(sMustAttributes)
                ' format the pathfilter
         pathFilter = sPathFilter
                ' allow "/" as directory separator in the pathFilter
         pathFilter = REPLACESUBSTR$(pathFilter, "/", CHR$(92))
                ' delete a "\" ahead of pathFilter (= error)
         IF LEFT$(pathFilter, 1) = QDIR_BACKSLASH THEN pathFilter = MID$(pathFilter, 2)
                ' Extract or Compose the path
         iPtr = RInstr(pathFilter, QDIR_BACKSLASH)
         .path = LEFT$(pathFilter, iPtr)
         .filter = MID$(pathFilter, iptr + 1)
         IF INSTR(pathFilter, ":") = 0 THEN .path = .applicationPath & .path
                ' Scans Directories
         .lstDir.Additems (.path)
         iLstDirIndex = 0
         WHILE .lstDir.ItemCount > iLstDirIndex
          .path = .lstDir.Item(iLstDirIndex)
          pathFilter = .path & "*.*"
                    ' Scan Sub Directories To Store them in LstDir
                    ' ---------------------------------------------
          hTmp = QDIR_FindFirstFile (pathFilter, .fileStruct)
          IF hTmp <> -1 THEN   ' pathfilter does not exist
           iFileFound = hTmp
           N = 1
           WHILE iFileFound <> 0
            IF (.fileStruct.attributes AND QDIR_FILE_ATTRIBUTE_DIRECTORY) <> 0 THEN
             iPtr = INSTR (.fileStruct.cFilename, CHR$(0))
             .fileName = LEFT$(.fileStruct.cFilename, iPtr - 1)
             SELECT CASE .fileName
             CASE "."
                                        ' Do Nothing
             CASE ".."
                                        ' Do Nothing
             CASE ELSE
              .lstDir.InsertItem (iLstDirIndex + N, .path & .filename & QDIR_BACKSLASH)
'                                        ShowMessage (.lstDir.Item(iLstDirIndex + N))
              INC (N)
             END SELECT
            END IF
            iFileFound = QDIR_FindNextFile (hTmp, .fileStruct)
            IF .flagStop <> 0 THEN EXIT WHILE
            DOEVENTS
           WEND
          END IF
          QDIR_FindClose (hTmp)
                    ' Scans Files in Directory
                    ' ------------------------
          pathFilter = .path & .filter
          hTmp = QDIR_FindFirstFile (pathFilter, .fileStruct)
          IF (hTmp <> -1 AND .flagStop = 0 ) THEN   ' pathfilter does not exist
           iFileFound = hTmp
           WHILE iFileFound <> 0
            IF .CheckAttributes <> 0 THEN
             .GetFileDatas
             IF .WithDotsDirs = 1 THEN
              CALLFUNC .OnFileFound
             ELSE
              IF (.fileName <> "." AND .fileName <> "..") THEN CALLFUNC .OnFileFound
             END IF
            END IF
            iFileFound = QDIR_FindNextFile (hTmp, .fileStruct)
            DOEVENTS
           WEND
                    'Else
                    '    ShowMessage ("QDIR ERROR : DIRECTORY DOES NOT EXIST\nOR INVALID FILTER")
          END IF
          QDIR_FindClose (hTmp)
          IF .flagStop <> 0 THEN EXIT WHILE
          INC(iLstDirIndex)
          DOEVENTS
         WEND
         .frmDirStop.Visible = 0
         .lstDir.Clear
         .busy = 0
        ELSE
         SHOWMESSAGE ("QDIR ERROR : QDIR ALREADY SEARCHING,\nPROGRAMMER SHOULD HAVE CREATE ANOTHER QDIR")
        END IF
       END SUB
' ---------------------------------------------------------------------------
'
        ' CHANGE FILE DATES and TIMES
        ' -------------------------
       FUNCTIONI ChangeFileDateAndTime ( ... ) AS LONG
        DEFINT iHandle, N
        DEFINT dateTime(1 TO 6) = {1985, 8, 23, 22, 10, 12} ' YYYY, MM, DD, hh, mm, ss (08/23/1985 22:10:12)
        DEFSTR pathFileName, whichTimes, cftErr
        DIM bufferFileTime AS T_FILETIMEcft
        DIM systemTime AS T_SYSTEMTIMEcft
            ' Get String Parameters of the Functioni
            ' ---------------------------------
        cftErr = ""
        IF PARAMSTRCOUNT > 0 THEN
         pathFileName = PARAMSTR$(1)
        ELSE
         cftErr = "No FileName Provided"
        END IF
        IF cftErr <> "" THEN GOTO cftError
        IF PARAMSTRCOUNT > 1 THEN whichTimes = PARAMSTR$(2)  ' Optional
            ' Open The File
            ' -------------
        iHandle = QDIR_CreateFile(pathFileName, QDIR_GENERIC_WRITE, (QDIR_FILE_SHARE_READ OR QDIR_FILE_SHARE_WRITE), _
         0, QDIR_OPEN_EXISTING, 0, 0)
        IF iHandle = 0 THEN cftErr = "File Not Found":GOTO cftError
            '
            ' Get Numeric Parameters of the Functioni
            ' ---------------------------------------
        cftErr = ""
        FOR N = 1 TO 6
         IF PARAMVALCOUNT > N - 1 THEN
          dateTime(N) = PARAMVAL(N)
         ELSE
          cftErr = STR$(N - 1) & " Numeric Param(s) Recieved, 6 Awaited"
          EXIT FOR
         END IF
        NEXT N
        IF cftErr <> "" THEN GOTO cftError
            '

        systemTime.wYear = dateTime(1)
        systemTime.wMonth = dateTime(2)
            'systemTime.wDayOfWeek = 0
        systemTime.wDay = dateTime(3)
        systemTime.wHour = dateTime(4)
        systemTime.wMinute = dateTime(5)
        systemTime.wSecond = dateTime(6)
        systemTime.wMilliseconds = 333
            '
            ' set The New File Time On Disk
            ' -----------------------------
        QDIR_SystemTimeToFileTime (systemTime, bufferFileTime)
        IF INSTR(UCASE$(whichTimes), "CRE") THEN
         IF QDIR_SetFileTime (iHandle, bufferFileTime, 0, 0) <> 1 THEN cftErr = "Problem in Writing CreationTime"
        END IF
        IF cftErr <> "" THEN GOTO cftError
            '
        IF INSTR(UCASE$(whichTimes), "ACC") THEN
         IF QDIR_SetFileTime (iHandle, 0, bufferFileTime, 0) <> 1 THEN cftErr = "Problem in Writing lastAccessTime"
        END IF
        IF cftErr <> "" THEN GOTO cftError
            '
        IF (INSTR(UCASE$(whichTimes), "WRI") OR whichTimes = "") THEN
         IF QDIR_SetFileTime (iHandle, 0, 0, bufferFileTime) <> 1 THEN cftErr = "Problem in Writing lastWriteTime"
        END IF
        IF cftErr <> "" THEN GOTO cftError
            '
        IF iHandle THEN QDIR_CloseHandle iHandle
        Result = 1 ' True
        EXIT FUNCTIONI
cftError:
        Result = 0 ' False
        IF iHandle THEN QDIR_CloseHandle iHandle
        SHOWMESSAGE ("While Changing File Date and/or Time : " & QDIR_RQCR & "    " & cftErr)
       END FUNCTIONI
'
' ----------------------------------------------------------------------------
'
        ' CHANGE FILE ATTRIBUTES
        ' ----------------------
       FUNCTION ChangeFileAttributes (sPathFileName AS STRING, attributesAsString AS STRING) AS LONG
        DEFINT iAttributes
        DEFSTR pathFileName
        pathFileName = sPathFileName
        iAttributes = 0
        attributesAsString = UCASE$(AttributesAsString)
        IF INSTR(attributesAsString, "A") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_ARCHIVE
        IF INSTR(attributesAsString, "D") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_DIRECTORY
        IF INSTR(attributesAsString, "H") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_HIDDEN
        IF INSTR(attributesAsString, "N") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_NORMAL
        IF INSTR(attributesAsString, "R") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_READONLY
        IF INSTR(attributesAsString, "S") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_SYSTEM
        IF INSTR(attributesAsString, "T") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_TEMPORARY
        IF INSTR(attributesAsString, "C") THEN iAttributes = iAttributes + QDIR_FILE_ATTRIBUTE_COMPRESSED
        Result = QDIR_SetFileAttributes (pathFileName, iAttributes)
       END FUNCTION
'
' ----------------------------------------------------------------------------
'
' *****************
      END WITH  ' *******
' *****************
     END TYPE
'
' $TYPECHECK OFF
'
' =============================================================================
'

2013-08-20 12:34