deakin99
asked on
FileSystem Object Ordering Files By Date 160+ points
Im Writing an application to Zip Up IIS4 Log Files using the winzip command line addon but I need to Move all files in the folder Except The One Were the last modified is the most recent.
Is there a way that i could list all files but exclude the most recent last modified file alone.
I will raise it to 160 point if i get the right answer and code im looking for im in desperate need of this code as i have 24hours to finish building this new web server
Regards
John Deakin
Is there a way that i could list all files but exclude the most recent last modified file alone.
I will raise it to 160 point if i get the right answer and code im looking for im in desperate need of this code as i have 24hours to finish building this new web server
Regards
John Deakin
Option Explicit
' Name: Obtaining Information Of A File (Upgrade Version)
' Author: Chong Long Choo
' Email: chonglongchoo@hotmail.com
' Date: 11 September 1999
'<------------------------ --Disclaim er-------- ---------- ---------- --->
'
'This sample is free. You can use the sample in any form. Use this
'sample at your own risk! I have no warranty for this sample.
'
'<------------------------ --Disclaim er-------- ---------- ---------- --->
'------------------------- ---------- ---------- ---------- ---------- ---------- ------
'How to use
'------------------------- ---------- ---------- ---------- ---------- ---------- ------
'Sub main()
' Dim objFileProp As clsFileProp
' Set objFileProp = New clsFileProp
' With objFileProp
' .FindFileInfo "d:\sspssk\start.htm", True
' '.FindFileInfo "d:\icq\icq.exe",false
' '.FindFileInfo "d:\office 2000\office\winword.exe",f alse
' Debug.Print "Archive = "; .Archive; vbCrLf
' Debug.Print "CompanyName = "; .CompanyName; vbCrLf
' Debug.Print "Compress = "; .Compress; vbCrLf
' Debug.Print "CreationTime = "; .CreationTime; vbCrLf
' Debug.Print "Directory = "; .Directory; vbCrLf
' Debug.Print "FileDescription = "; .FileDescription; vbCrLf
' Debug.Print "FileName = "; .FileName; vbCrLf
' Debug.Print "FileVersion = "; .FileVersion; vbCrLf
' Debug.Print "Hidden = "; .Hidden; vbCrLf
' Debug.Print "InternalName = "; .InternalName; vbCrLf
' Debug.Print "LastAccessTime = "; .LastAccessTime; vbCrLf
' Debug.Print "LastWriteTime = "; .LastWriteTime; vbCrLf
' Debug.Print "LegalCopyright = "; .LegalCopyright; vbCrLf
' Debug.Print "mByte = "; .mByte; vbCrLf
' Debug.Print "Normal = "; .Normal; vbCrLf
' Debug.Print "OriginalFileName = "; .OriginalFileName; vbCrLf
' Debug.Print "ProductName = "; .ProductName; vbCrLf
' Debug.Print "ProductVersion = "; .ProductVersion; vbCrLf
' Debug.Print "ReadOnly = "; .ReadOnly; vbCrLf
' Debug.Print "System = "; .System; vbCrLf
' Debug.Print "Temporary = "; .Temporary; vbCrLf
' Debug.Print "FileType = "; .FileType; vbCrLf
' Debug.Print "IconIndex = "; .IconIndex; vbCrLf
' End With
'End Sub
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260 'MUST be set to 260
cAlternate As String * 14
End Type
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Const SHGFI_ICON = &H100 ' get icon
Private Const SHGFI_DISPLAYNAME = &H200 ' get display name
Private Const SHGFI_TYPENAME = &H400 ' get type name
Private Const SHGFI_ATTRIBUTES = &H800 ' get attributes
Private Const SHGFI_ICONLOCATION = &H1000 ' get icon location
Private Const SHGFI_EXETYPE = &H2000 ' return exe type
Private Const SHGFI_SYSICONINDEX = &H4000 ' get system icon index
Private Const SHGFI_LINKOVERLAY = &H8000 ' put a link overlay on icon
Private Const SHGFI_SELECTED = &H10000 ' show icon in selected state
Private Const SHGFI_LARGEICON = &H0 ' get large icon
Private Const SHGFI_SMALLICON = &H1 ' get small icon
Private Const SHGFI_OPENICON = &H2 ' get open icon
Private Const SHGFI_SHELLICONSIZE = &H4 ' get shell size icon
Private Const SHGFI_PIDL = &H8 ' pszPath is a pidl
Private Const SHGFI_USEFILEATTRIBUTES = &H10 ' use passed dwFileAttribute
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private mvarCompanyName As String
Private mvarFileDescription As String
Private mvarFileVersion As String
Private mvarInternalName As String
Private mvarLegalCopyright As String
Private mvarOriginalFileName As String
Private mvarProductName As String
Private mvarProductVersion As String
Private mvarFileName As String
Private mvarByte As String
Private mvarCreationTime As String
Private mvarLastAccessTime As String
Private mvarLastWriteTime As String
Private mvarReadOnly As Boolean
Private mvarHidden As Boolean
Private mvarSystem As Boolean
Private mvarDirectory As Boolean
Private mvarArchive As Boolean
Private mvarNormal As Boolean
Private mvarTemporary As Boolean
Private mvarCompress As Boolean
Private mvarFileType As String
Private mvarIconIndex As Long
Public Property Get IconIndex() As Long
IconIndex = mvarIconIndex
End Property
Public Property Get FileType() As String
FileType = mvarFileType
End Property
Public Property Get Compress() As Boolean
Compress = mvarCompress
End Property
Public Property Get Temporary() As Boolean
Temporary = mvarTemporary
End Property
Public Property Get Normal() As Boolean
Normal = mvarNormal
End Property
Public Property Get Archive() As Boolean
Archive = mvarArchive
End Property
Public Property Get Directory() As Boolean
Directory = mvarDirectory
End Property
Public Property Get System() As Boolean
System = mvarSystem
End Property
Public Property Get Hidden() As Boolean
Hidden = mvarHidden
End Property
Public Property Get ReadOnly() As Boolean
ReadOnly = mvarReadOnly
End Property
Public Property Get LastWriteTime() As String
LastWriteTime = mvarLastWriteTime
End Property
Public Property Get LastAccessTime() As String
LastAccessTime = mvarLastAccessTime
End Property
Public Property Get CreationTime() As String
CreationTime = mvarCreationTime
End Property
Public Property Get ByteSize() As String
ByteSize = mvarByte
End Property
Public Property Get ProductVersion() As String
ProductVersion = mvarProductVersion
End Property
Public Property Get ProductName() As String
ProductName = mvarProductName
End Property
Public Property Get OriginalFileName() As String
OriginalFileName = mvarOriginalFileName
End Property
Public Property Get LegalCopyright() As String
LegalCopyright = mvarLegalCopyright
End Property
Public Property Get InternalName() As String
InternalName = mvarInternalName
End Property
Public Property Get FileVersion() As String
FileVersion = mvarFileVersion
End Property
Public Property Get FileDescription() As String
FileDescription = mvarFileDescription
End Property
Public Property Get CompanyName() As String
CompanyName = mvarCompanyName
End Property
Public Property Get FileName() As String
FileName = mvarFileName
End Property
Public Function FindFileInfo(strFileName As String, bLargeIcon As Boolean) As Long
'On Error GoTo GetFileVersionData_Error
Dim sInfo As String, lSizeof As Long
Dim lResult As Long, intDel As Integer
Dim lHandle As Long
Dim ftime As SYSTEMTIME
Dim filedata As WIN32_FIND_DATA
Dim intStrip As Integer
Dim SHFI As SHFILEINFO
Dim lSizeSHFI As Long
Dim lFlags As Long
If strFileName <> "" Then
' Get CreationTime, LastWriteTime and LastAccessTime
filedata = Findfile(strFileName)
Call FileTimeToSystemTime(filed ata.ftCrea tionTime, ftime)
mvarCreationTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filed ata.ftLast WriteTime, ftime) ' Determine Last Modified date and time
mvarLastWriteTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filed ata.ftLast AccessTime , ftime) ' Determine Last accessed date (note no time is recorded)
mvarLastAccessTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear
' Get file's attributes
mvarHidden = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN)
mvarSystem = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM)
mvarReadOnly = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY)
mvarArchive = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE)
mvarTemporary = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY)
mvarNormal = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL)
mvarCompress = ((filedata.dwFileAttribute s And FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED)
mvarFileName = UCase$(strFileName)
' Get size of the file
If filedata.nFileSizeHigh = 0 Then
mvarByte = Format$(filedata.nFileSize Low, "###,###,###") & " bytes"
Else
mvarByte = Format$(filedata.nFileSize High, "###,###,###") & " bytes"
End If
' Get CompanyName, FileDescription, FileVersion, InternalName
' LegalCopyright, OriginalFilename, ProductName, ProductVersion
lHandle = 0
lSizeof = GetFileVersionInfoSize(str FileName, lHandle)
If lSizeof > 0 Then
sInfo = String$(lSizeof, 0)
lResult = GetFileVersionInfo(ByVal strFileName, 0&, ByVal lSizeof, ByVal sInfo)
If lResult Then
intDel = InStr(sInfo, "CompanyName")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarCompanyName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "FileDescription")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarFileDescription = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "FileVersion")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarFileVersion = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "InternalName")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarInternalName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "LegalCopyright")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarLegalCopyright = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "OriginalFilename")
If intDel > 0 Then
intDel = intDel + 20
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarOriginalFileName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "ProductName")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarProductName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "ProductVersion")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarProductVersion = Mid$(sInfo, intDel, intStrip - intDel)
End If
End If
End If
' Get file's type and the index of icon of the file
lSizeSHFI = Len(SHFI)
lFlags = SHGFI_SYSICONINDEX Or SHGFI_TYPENAME
If bLargeIcon Then
lFlags = lFlags Or SHGFI_LARGEICON
Else
lFlags = lFlags Or SHGFI_SMALLICON
End If
SHGetFileInfo strFileName, 0&, SHFI, lSizeSHFI, lFlags
mvarFileType = Left$(SHFI.szTypeName, InStr(1, SHFI.szTypeName, vbNullChar) - 1)
mvarIconIndex = SHFI.iIcon
FindFileInfo = 1
Else
FindFileInfo = 0
End If
GetFileVersionData_Error:
FindFileInfo = 0
Exit Function
invalid_file_info_error:
FindFileInfo = 1
Exit Function
End Function
Private Function Findfile(xstrfilename) As WIN32_FIND_DATA
Dim Win32Data As WIN32_FIND_DATA
Dim plngFirstFileHwnd As Long
Dim plngRtn As Long
plngFirstFileHwnd = FindFirstFile(xstrfilename , Win32Data)
' Get information of file using API call
If plngFirstFileHwnd = 0 Then
Findfile.cFileName = "Error" ' If file was not found, return error as name
Else
Findfile = Win32Data ' Else return results
End If
plngRtn = FindClose(plngFirstFileHwn d) ' It is important that you close the handle
'for FindFirstFile
End Function
' Name: Obtaining Information Of A File (Upgrade Version)
' Author: Chong Long Choo
' Email: chonglongchoo@hotmail.com
' Date: 11 September 1999
'<------------------------
'
'This sample is free. You can use the sample in any form. Use this
'sample at your own risk! I have no warranty for this sample.
'
'<------------------------
'-------------------------
'How to use
'-------------------------
'Sub main()
' Dim objFileProp As clsFileProp
' Set objFileProp = New clsFileProp
' With objFileProp
' .FindFileInfo "d:\sspssk\start.htm", True
' '.FindFileInfo "d:\icq\icq.exe",false
' '.FindFileInfo "d:\office 2000\office\winword.exe",f
' Debug.Print "Archive = "; .Archive; vbCrLf
' Debug.Print "CompanyName = "; .CompanyName; vbCrLf
' Debug.Print "Compress = "; .Compress; vbCrLf
' Debug.Print "CreationTime = "; .CreationTime; vbCrLf
' Debug.Print "Directory = "; .Directory; vbCrLf
' Debug.Print "FileDescription = "; .FileDescription; vbCrLf
' Debug.Print "FileName = "; .FileName; vbCrLf
' Debug.Print "FileVersion = "; .FileVersion; vbCrLf
' Debug.Print "Hidden = "; .Hidden; vbCrLf
' Debug.Print "InternalName = "; .InternalName; vbCrLf
' Debug.Print "LastAccessTime = "; .LastAccessTime; vbCrLf
' Debug.Print "LastWriteTime = "; .LastWriteTime; vbCrLf
' Debug.Print "LegalCopyright = "; .LegalCopyright; vbCrLf
' Debug.Print "mByte = "; .mByte; vbCrLf
' Debug.Print "Normal = "; .Normal; vbCrLf
' Debug.Print "OriginalFileName = "; .OriginalFileName; vbCrLf
' Debug.Print "ProductName = "; .ProductName; vbCrLf
' Debug.Print "ProductVersion = "; .ProductVersion; vbCrLf
' Debug.Print "ReadOnly = "; .ReadOnly; vbCrLf
' Debug.Print "System = "; .System; vbCrLf
' Debug.Print "Temporary = "; .Temporary; vbCrLf
' Debug.Print "FileType = "; .FileType; vbCrLf
' Debug.Print "IconIndex = "; .IconIndex; vbCrLf
' End With
'End Sub
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260 'MUST be set to 260
cAlternate As String * 14
End Type
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Const SHGFI_ICON = &H100 ' get icon
Private Const SHGFI_DISPLAYNAME = &H200 ' get display name
Private Const SHGFI_TYPENAME = &H400 ' get type name
Private Const SHGFI_ATTRIBUTES = &H800 ' get attributes
Private Const SHGFI_ICONLOCATION = &H1000 ' get icon location
Private Const SHGFI_EXETYPE = &H2000 ' return exe type
Private Const SHGFI_SYSICONINDEX = &H4000 ' get system icon index
Private Const SHGFI_LINKOVERLAY = &H8000 ' put a link overlay on icon
Private Const SHGFI_SELECTED = &H10000 ' show icon in selected state
Private Const SHGFI_LARGEICON = &H0 ' get large icon
Private Const SHGFI_SMALLICON = &H1 ' get small icon
Private Const SHGFI_OPENICON = &H2 ' get open icon
Private Const SHGFI_SHELLICONSIZE = &H4 ' get shell size icon
Private Const SHGFI_PIDL = &H8 ' pszPath is a pidl
Private Const SHGFI_USEFILEATTRIBUTES = &H10 ' use passed dwFileAttribute
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private mvarCompanyName As String
Private mvarFileDescription As String
Private mvarFileVersion As String
Private mvarInternalName As String
Private mvarLegalCopyright As String
Private mvarOriginalFileName As String
Private mvarProductName As String
Private mvarProductVersion As String
Private mvarFileName As String
Private mvarByte As String
Private mvarCreationTime As String
Private mvarLastAccessTime As String
Private mvarLastWriteTime As String
Private mvarReadOnly As Boolean
Private mvarHidden As Boolean
Private mvarSystem As Boolean
Private mvarDirectory As Boolean
Private mvarArchive As Boolean
Private mvarNormal As Boolean
Private mvarTemporary As Boolean
Private mvarCompress As Boolean
Private mvarFileType As String
Private mvarIconIndex As Long
Public Property Get IconIndex() As Long
IconIndex = mvarIconIndex
End Property
Public Property Get FileType() As String
FileType = mvarFileType
End Property
Public Property Get Compress() As Boolean
Compress = mvarCompress
End Property
Public Property Get Temporary() As Boolean
Temporary = mvarTemporary
End Property
Public Property Get Normal() As Boolean
Normal = mvarNormal
End Property
Public Property Get Archive() As Boolean
Archive = mvarArchive
End Property
Public Property Get Directory() As Boolean
Directory = mvarDirectory
End Property
Public Property Get System() As Boolean
System = mvarSystem
End Property
Public Property Get Hidden() As Boolean
Hidden = mvarHidden
End Property
Public Property Get ReadOnly() As Boolean
ReadOnly = mvarReadOnly
End Property
Public Property Get LastWriteTime() As String
LastWriteTime = mvarLastWriteTime
End Property
Public Property Get LastAccessTime() As String
LastAccessTime = mvarLastAccessTime
End Property
Public Property Get CreationTime() As String
CreationTime = mvarCreationTime
End Property
Public Property Get ByteSize() As String
ByteSize = mvarByte
End Property
Public Property Get ProductVersion() As String
ProductVersion = mvarProductVersion
End Property
Public Property Get ProductName() As String
ProductName = mvarProductName
End Property
Public Property Get OriginalFileName() As String
OriginalFileName = mvarOriginalFileName
End Property
Public Property Get LegalCopyright() As String
LegalCopyright = mvarLegalCopyright
End Property
Public Property Get InternalName() As String
InternalName = mvarInternalName
End Property
Public Property Get FileVersion() As String
FileVersion = mvarFileVersion
End Property
Public Property Get FileDescription() As String
FileDescription = mvarFileDescription
End Property
Public Property Get CompanyName() As String
CompanyName = mvarCompanyName
End Property
Public Property Get FileName() As String
FileName = mvarFileName
End Property
Public Function FindFileInfo(strFileName As String, bLargeIcon As Boolean) As Long
'On Error GoTo GetFileVersionData_Error
Dim sInfo As String, lSizeof As Long
Dim lResult As Long, intDel As Integer
Dim lHandle As Long
Dim ftime As SYSTEMTIME
Dim filedata As WIN32_FIND_DATA
Dim intStrip As Integer
Dim SHFI As SHFILEINFO
Dim lSizeSHFI As Long
Dim lFlags As Long
If strFileName <> "" Then
' Get CreationTime, LastWriteTime and LastAccessTime
filedata = Findfile(strFileName)
Call FileTimeToSystemTime(filed
mvarCreationTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filed
mvarLastWriteTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filed
mvarLastAccessTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear
' Get file's attributes
mvarHidden = ((filedata.dwFileAttribute
mvarSystem = ((filedata.dwFileAttribute
mvarReadOnly = ((filedata.dwFileAttribute
mvarArchive = ((filedata.dwFileAttribute
mvarTemporary = ((filedata.dwFileAttribute
mvarNormal = ((filedata.dwFileAttribute
mvarCompress = ((filedata.dwFileAttribute
mvarFileName = UCase$(strFileName)
' Get size of the file
If filedata.nFileSizeHigh = 0 Then
mvarByte = Format$(filedata.nFileSize
Else
mvarByte = Format$(filedata.nFileSize
End If
' Get CompanyName, FileDescription, FileVersion, InternalName
' LegalCopyright, OriginalFilename, ProductName, ProductVersion
lHandle = 0
lSizeof = GetFileVersionInfoSize(str
If lSizeof > 0 Then
sInfo = String$(lSizeof, 0)
lResult = GetFileVersionInfo(ByVal strFileName, 0&, ByVal lSizeof, ByVal sInfo)
If lResult Then
intDel = InStr(sInfo, "CompanyName")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarCompanyName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "FileDescription")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarFileDescription = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "FileVersion")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarFileVersion = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "InternalName")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarInternalName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "LegalCopyright")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarLegalCopyright = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "OriginalFilename")
If intDel > 0 Then
intDel = intDel + 20
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarOriginalFileName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "ProductName")
If intDel > 0 Then
intDel = intDel + 12
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarProductName = Mid$(sInfo, intDel, intStrip - intDel)
End If
intDel = InStr(sInfo, "ProductVersion")
If intDel > 0 Then
intDel = intDel + 16
intStrip = InStr(intDel, sInfo, vbNullChar)
mvarProductVersion = Mid$(sInfo, intDel, intStrip - intDel)
End If
End If
End If
' Get file's type and the index of icon of the file
lSizeSHFI = Len(SHFI)
lFlags = SHGFI_SYSICONINDEX Or SHGFI_TYPENAME
If bLargeIcon Then
lFlags = lFlags Or SHGFI_LARGEICON
Else
lFlags = lFlags Or SHGFI_SMALLICON
End If
SHGetFileInfo strFileName, 0&, SHFI, lSizeSHFI, lFlags
mvarFileType = Left$(SHFI.szTypeName, InStr(1, SHFI.szTypeName, vbNullChar) - 1)
mvarIconIndex = SHFI.iIcon
FindFileInfo = 1
Else
FindFileInfo = 0
End If
GetFileVersionData_Error:
FindFileInfo = 0
Exit Function
invalid_file_info_error:
FindFileInfo = 1
Exit Function
End Function
Private Function Findfile(xstrfilename) As WIN32_FIND_DATA
Dim Win32Data As WIN32_FIND_DATA
Dim plngFirstFileHwnd As Long
Dim plngRtn As Long
plngFirstFileHwnd = FindFirstFile(xstrfilename
' Get information of file using API call
If plngFirstFileHwnd = 0 Then
Findfile.cFileName = "Error" ' If file was not found, return error as name
Else
Findfile = Win32Data ' Else return results
End If
plngRtn = FindClose(plngFirstFileHwn
'for FindFirstFile
End Function
Yes !
1.To have list of files in your folder you can use the Dir function .
2.To detect file date you can use some API's like in this code :
Private Sub Command1_Click()
Dim ret As Long
Dim FileHandle As Long
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim lpReOpenBuff As OFSTRUCT
Dim FileTime As SYSTEMTIME
FileHandle = OpenFile("c:\autoexec.bat" , lpReOpenBuff, OF_READ)
ret = GetFileInformationByHandle (FileHandl e, FileInfo)
ret = FileTimeToSystemTime(FileI nfo.ftCrea tionTime, FileTime)
Print "File created on " & FileTime.wYear, FileTime.wMonth, FileTime.wDay
ret = FileTimeToSystemTime(FileI nfo.ftLast AccessTime , FileTime)
Print "File last accessed on: " & FileTime.wYear, FileTime.wMonth,
FileTime.wDay
ret = FileTimeToSystemTime(FileI nfo.ftLast WriteTime, FileTime)
Print "File last written to: " & FileTime.wYear, FileTime.wMonth,
FileTime.wDay
Print "File attributes are: " & FileInfo.dwFileAttributes
ret = CloseHandle(FileHandle)
End Sub
In a .bas module
Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String,
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As
Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION ) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As
FileTime, lpSystemTime As SYSTEMTIME) As Long
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME ) As Byte
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
1.To have list of files in your folder you can use the Dir function .
2.To detect file date you can use some API's like in this code :
Private Sub Command1_Click()
Dim ret As Long
Dim FileHandle As Long
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim lpReOpenBuff As OFSTRUCT
Dim FileTime As SYSTEMTIME
FileHandle = OpenFile("c:\autoexec.bat"
ret = GetFileInformationByHandle
ret = FileTimeToSystemTime(FileI
Print "File created on " & FileTime.wYear, FileTime.wMonth, FileTime.wDay
ret = FileTimeToSystemTime(FileI
Print "File last accessed on: " & FileTime.wYear, FileTime.wMonth,
FileTime.wDay
ret = FileTimeToSystemTime(FileI
Print "File last written to: " & FileTime.wYear, FileTime.wMonth,
FileTime.wDay
Print "File attributes are: " & FileInfo.dwFileAttributes
ret = CloseHandle(FileHandle)
End Sub
In a .bas module
Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String,
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function GetFileInformationByHandle
Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As
FileTime, lpSystemTime As SYSTEMTIME) As Long
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
ASKER
The code Im Looking at looks a little too much im looking for a straight answer to this how to order files by data modified or maybe place all the files in an array and order them by most recent modified so i could do a nasty little hack for the moment and do
for I = 1 to somearray
......
Next
The code im using is to list files is
sub ShowFileList(folderspec)
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.Fi leSystemOb ject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
s = s & f1.name
s = s & vbcrlf
s = s & "Created: " & f1.DateCreated & vbcrlf
s = s & "Last Accessed: "& f1.DateLastAccessed & vbcrlf
s = s & "Last Accessed: " & f1.DateLastModified & vbcrlf & vbcrlf
Next
Response.Write(s)
End sub
ShowFileList "C:\"
for I = 1 to somearray
......
Next
The code im using is to list files is
sub ShowFileList(folderspec)
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.Fi
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
s = s & f1.name
s = s & vbcrlf
s = s & "Created: " & f1.DateCreated & vbcrlf
s = s & "Last Accessed: "& f1.DateLastAccessed & vbcrlf
s = s & "Last Accessed: " & f1.DateLastModified & vbcrlf & vbcrlf
Next
Response.Write(s)
End sub
ShowFileList "C:\"
ASKER
The code i've tried was a test i done in asp basically I just wanna list all files minus one were the datamodified is the most recent.
In the vb app im using access 2000 to store my schedules for the IIS logs and vb as the interface but i need the file system to list the files.
I can list the files just not order them by date basically i need to find the lowest modified file and the highest but one and then the winzzip command will just be say the lowestfile is 21/01/2000 and the highestfile is 29/01/2000 and the file before that is the 28/01/2000
I wanna file the 28/01/2000 as the ones to zip up to
wzzip -r{d} 21/01/2000 - 28/01/2000 "C:\winnt\system32\Inetsrv \Logs\w3sc v4\*.*"
In the vb app im using access 2000 to store my schedules for the IIS logs and vb as the interface but i need the file system to list the files.
I can list the files just not order them by date basically i need to find the lowest modified file and the highest but one and then the winzzip command will just be say the lowestfile is 21/01/2000 and the highestfile is 29/01/2000 and the file before that is the 28/01/2000
I wanna file the 28/01/2000 as the ones to zip up to
wzzip -r{d} 21/01/2000 - 28/01/2000 "C:\winnt\system32\Inetsrv
ASKER
Adjusted points to 190
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
emoreau's answer seems to be the best answer. If that doesn't work you can do a datediff on the lastmodified property and sort the files that way.
ASKER
ye i done something similar in asp for deleting files
DeleteFilesInFolder(folder _name,time _interval, time_no,de l_file_ext )
Dim fso, f, f1, fc
Set fso = CreateObject("Scripting.Fi leSystemOb ject")
Set f = fso.GetFolder(server.MapPa th("\") & "\" & folder_name)
Set fc = f.Files
For Each f1 in fc
file_ext = right(f1.name,len(f1.name) - instrrev(f1.name,"."))
if file_ext = del_file_ext then
if datediff(time_interval,f1. datecreate d,now)>tim e_no then
f1.delete
end if
end if
Next
End Function
DeleteFilesInFolder(folder
Dim fso, f, f1, fc
Set fso = CreateObject("Scripting.Fi
Set f = fso.GetFolder(server.MapPa
Set fc = f.Files
For Each f1 in fc
file_ext = right(f1.name,len(f1.name)
if file_ext = del_file_ext then
if datediff(time_interval,f1.
f1.delete
end if
end if
Next
End Function
ASKER
emoreau's Or anyone else tell you what if anyone wants to do some co development on this you can have all my points. for this and maybe even bargain for some of my future points.
John deakin
John deakin
That is not what was asked at the beginning! It is not so common to see co-dev here in exchange of points!
I hope I'm understanding your problem correctly. You need to get the most recent file and the least recent file?
-------------------------- ---------- ---
Dim min As Date
Set fso = CreateObject("scripting.fi lesystemob ject")
Set f = fso.GetFolder(theFoldernam e)
Set fc = f.Files
min = Now
For Each file In fc
If file.datelastmodified < min Then
min = file.datelastmodified
End If
Next
Debug.Print min
-------------------------- ---------- ---
This should get you the least recent. If you change the line "if file.datelastmodified < min then" to "if file.datelastmodified > min then" it should return the most recent. If you need the files between these time intervals then it should be a piece of cake to write code to return them. I hope this is what you're looking for.
--------------------------
Dim min As Date
Set fso = CreateObject("scripting.fi
Set f = fso.GetFolder(theFoldernam
Set fc = f.Files
min = Now
For Each file In fc
If file.datelastmodified < min Then
min = file.datelastmodified
End If
Next
Debug.Print min
--------------------------
This should get you the least recent. If you change the line "if file.datelastmodified < min then" to "if file.datelastmodified > min then" it should return the most recent. If you need the files between these time intervals then it should be a piece of cake to write code to return them. I hope this is what you're looking for.
ASKER
Gebra Kind of what i need is the lowest file and the lowest but one file you see im trying to create an app to compress IIS4 Log files on a schedule you see I need to leave the active log alone and take the rest so it would'nt always = now only 70% of the time.
emoreau Basically Log Files are a common problem for IIS administrators as some sites can generate 100MB a day which in a week gets quite sizable so they either have to be delete or archived incase the logs are analised with something like webtrends 4 like we do. And we have some many sites now generating massive log files it's no longer that easy to archive the logs.
I think it would be a sellable package maybe if it could be developed in the right style if you interested mail me @ john@virtual.co.uk.
emoreau Basically Log Files are a common problem for IIS administrators as some sites can generate 100MB a day which in a week gets quite sizable so they either have to be delete or archived incase the logs are analised with something like webtrends 4 like we do. And we have some many sites now generating massive log files it's no longer that easy to archive the logs.
I think it would be a sellable package maybe if it could be developed in the right style if you interested mail me @ john@virtual.co.uk.
Community Support has reduced points from 190 to 50
ASKER