• Viernes 8 de Noviembre de 2024, 16:34

Autor Tema:  Tamano De Un Directorio  (Leído 1279 veces)

ryanortegarios

  • Nuevo Miembro
  • *
  • Mensajes: 15
    • Ver Perfil
Tamano De Un Directorio
« en: Lunes 20 de Junio de 2005, 16:43 »
0
Que tal.
Estoy realizando un codigo que mantenga limitado el tamano de un directorio. Para ello necesito saber cual es el tamano de un directorio y como saber la fecha de creación de un archivo. La idea es limitar el tamano del directorio borrando los mas viejos.

Saludos... :hola:
RYAN

ryanortegarios

  • Nuevo Miembro
  • *
  • Mensajes: 15
    • Ver Perfil
Re: Tamano De Un Directorio
« Respuesta #1 en: Martes 28 de Junio de 2005, 15:35 »
0
:hola:

Aca les coloco lo que he podido encontrar para la realización del proyecto de control de tamano de un directorio.




Public Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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 * MAX_PATH
cAlternate As String * 14
End Type
Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long



'Esta rutina aroja el tamano de un directorio.

Public Function SizeOf(ByVal DirPath As String) As Double
Dim hFind As Long
Dim fdata As WIN32_FIND_DATA
Dim dblSize As Double
Dim sName As String
Dim x As Long
On Error Resume Next
x = GetAttr(DirPath)
If Err Then SizeOf = 0: Exit Function
If (x And vbDirectory) = vbDirectory Then
dblSize = 0
Err.Clear
sName = Dir$(endSlash(DirPath) & "*.*", vbSystem Or vbHidden Or vbDirectory)
If Err.Number = 0 Then
hFind = FindFirstFile(endSlash(DirPath) & "*.*", fdata)
If hFind = 0 Then Exit Function
Do
If (fdata.dwFileAttributes And vbDirectory) = vbDirectory Then
sName = Left$(fdata.cFileName, InStr(fdata.cFileName, vbNullChar) - 1)
If sName <> "." And sName <> ".." Then
dblSize = dblSize + SizeOf(endSlash(DirPath) & sName)
End If
Else
dblSize = dblSize + fdata.nFileSizeHigh * 65536 + fdata.nFileSizeLow
End If
DoEvents
Loop While FindNextFile(hFind, fdata) <> 0
hFind = FindClose(hFind)
End If
Else
On Error Resume Next
dblSize = FileLen(DirPath)
End If
SizeOf = dblSize
End Function
'To delete the file press the button.
'Insert the following code to your form:
'Esta rutina borra un archivo.
Public Function deleteFile(directory As String) As Boolean
Dim Arch As String
Dim AuxStr1 As String
directory = Form1.Text1
Arch = Form1.Text2.Text
AuxStr1 = endSlash(directory) + Arch
If (askForFile(AuxStr1)) Then
Kill (AuxStr1)
deleteFile = True
'Form1.Text3.Text = Arch
Else
deleteFile = False
'Form1.Text3.Text = Arch + " does not exist"
End If
End Function
'Esta función verifica que el string termine en un Slash.
Public Function endSlash(ByVal PathIn As String) As String
If Right$(PathIn, 1) = "\" Then
endSlash = PathIn
Else
endSlash = PathIn & "\"
End If
End Function

'Esta rutina verifica que un archivo exista.
Public Function askForFile(FilePath As String) As Boolean
If Dir$(FilePath) <> "" Then
askForFile = True
'MsgBox ("The file exist")
Else
askForFile = False
'MsgBox ("The file does not exist")
End If
End Function
'Esta rutina aroja la fecha de la última modificación de un archivo.

Public Function fileDate(FilePath As String) As String

' Assume TESTFILE was last modified on February 12, 1993 at 4:35:47 PM.
' Assume English/U.S. locale settings.
If (askForFile(FilePath)) Then
fileDate = FileDateTime(FilePath)   ' Returns "2/12/93 4:35:47 PM".
Else
fileDate = "NULL"
End If

End Function
RYAN