Interesting - Dir throwing up problems on Network Drives
Generally it is unwise to use Dir in 'utilities' - this is becase one
Dir loop can effect another.
That is why we normally recommend the GetAttr method.
However it might be an idea to try the FindFirstFile/FindNextFile API
If you have not already got it then download the API Guide from:
www.AllAPI.net
They have a good example
The FindFirstFile API is a jumped up version of the MSDOS FindFirst
routine - it produces a mass of file information
Here is an implementation - however you'll need to make a minor mod to
get the File Date out correctly.
DrvUtils.bas
Option Explicit
Private Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTtoalNumberOfClusters As Long) As Long ' (sic)
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME ' Win 32 64bit Type
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type TWIN32_FIND_DATA
dwFileAttributes As String * 4
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As Currency
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As TWIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias _
"FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As TWIN32_FIND_DATA) As Long
Private Declare Function FindClose_JF Lib "kernel32" Alias _
"FindClose" _
(ByVal hFindFile As Long) As Long
Private Type TINT64
Lo As Long
Hi As Long
End Type
Private Type TCURRENCY
Value As Currency ' 8 bit / 10000
End Type
'
#########################################################################
'
'
'
Public Function DiskFreeSpaceOld#(Drv$)
Dim S$, Q#, Result&, Secs&, Bytes&, FreeClusters&
S$ = Left(Drv$, 2) + "\" + Chr$(0) ' it needs the "\"
Result = GetDiskFreeSpace(S$, Secs, Bytes, FreeClusters, 0)
If Result = 0 Then
DiskFreeSpaceOld# = -1
GoTo QUIT
End If
Q# = Secs * Bytes ' Cluster Size
Q# = Q# * FreeClusters
DiskFreeSpaceOld# = Q#
QUIT:
End Function
' 7/10/01 JF
Public Function DiskFreeSpace#(Drv$)
S$ = Left(Drv$, 2) + "\" + Chr$(0) ' it needs the "\"
Result = GetDiskFreeSpaceEx(S$, Available, Free, Total)
If Result = 0 Then
DiskFreeSpace = -1
Exit Function
End If
DiskFreeSpace = Free * 10000
End Function
'
#########################################################################
'
'
'
Public Function DiskSizeOld#(Drv$)
Dim S$, Q#, Result&, Secs&, Bytes&, Clusters&
S$ = Left(Drv$, 2) + "\" + Chr$(0) ' it needs the "\"
Result = GetDiskFreeSpace(S$, Secs, Bytes, 0, Clusters)
If Result = 0 Then
DiskSizeOld# = -1
GoTo QUIT
End If
Q# = Secs * Bytes ' Cluster Size
Q# = Q# * Clusters
DiskSizeOld# = Q#
QUIT:
End Function
' 7/10/01 JF
Public Function DiskSize#(Drv$)
S$ = Left(Drv$, 2) + "\" + Chr$(0) ' it needs the "\"
Result = GetDiskFreeSpaceEx(S$, Available, Free, Total)
If Result = 0 Then
DiskSize# = -1
Exit Function
End If
DiskSize# = Total * 10000
QUIT:
End Function
'
#########################################################################
'
'
'
Public Function FindFirst$(FileSpec$, FileSize#, FileAtt%, Handle&)
Dim DTA As TWIN32_FIND_DATA, I64 As TINT64, C As TCURRENCY
Handle& = FindFirstFile(FileSpec$ + Chr$(0), DTA)
If Handle& Then
FindFirst$ = StrExtStr(DTA.cFileName, Chr$(0), 1)
I64.Hi = DTA.nFileSizeHigh
I64.Lo = DTA.nFileSizeLow
LSet C = I64
FileSize# = C.Value * 10000
FileAtt% = Asc(DTA.dwFileAttributes)
End If
End Function
'
#########################################################################
'
'
'
Public Function FindNext$(Handle&, FileSize#, FileAtt%)
Dim DTA As TWIN32_FIND_DATA, I64 As TINT64, C As TCURRENCY
If FindNextFile(Handle&, DTA) Then
FindNext$ = StrExtStr(DTA.cFileName, Chr$(0), 1)
I64.Hi = DTA.nFileSizeHigh
I64.Lo = DTA.nFileSizeLow
LSet C = I64
FileSize# = C.Value * 10000
FileAtt% = Asc(DTA.dwFileAttributes)
End If
End Function
'
#########################################################################
'
'
'
Public Function FindClose&(Handle&)
FindClose& = FindClose_JF(Handle&)
End Function
'
#########################################################################
'
' The FILETIME structure is a 64-bit value representing
' the number of 100-nanosecond intervals since January 1, 1601.
'
' This returns the number of Seconds elapsed
' -1 if file not found
'
Function FileDateTimeSecs#(FileSpec$)
Dim DTA As TWIN32_FIND_DATA, S$, Handle&, Result#
Handle& = FindFirstFile(FileSpec$ + Chr$(0), DTA)
If Handle& Then
Result# = DTA.ftLastWriteTime
' 100 Nano Secs - to Secs 10^-9
Result# = Int(Result# / 1000)
Call FindClose&(Handle&)
End If
FileDateTimeSecs# = -1
If Result# Then
FileDateTimeSecs# = Result#
End If
End Function
'
#########################################################################
'
' Return a 70000 number and Time of a files last altered date
'
Sub FileDateTimeNo(FileSpec$, DateNo&, Hours&, Mins&, Secs&)
Static BaseNo&
Dim dSecs#, dMins#, dHours#, dDays#
dSecs# = FileDateTimeSecs(FileSpec$)
If dSecs# = -1 Then
DateNo = -1
Hours = 0
Mins = 0
Secs = 0
GoTo QUIT
End If
dMins# = Int(dSecs# / 60) ' to Minutes
dHours# = Int(dMins# / 60) ' to Hours
dDays# = Int(dHours# / 24) ' to Days
Secs = dSecs - dMins * 60
Mins = dMins - dHours * 60
Hours = dHours - dDays * 24
' --- You'll need to modify this
If BaseNo = 0 Then
' BaseNo = DateToNo("01-01-1601")
End If
DateNo = dDays + BaseNo + 3
QUIT:
End Sub
<snip>