Dom Ene 30, 2011 2:27 pm
File manager en vb6,creditos al autor,ojala les sirva.
- Código:
'***************************************************
'** Source Drinky Rat v0.1 **
'** File Manager **
'** Programado por Drinky94 **
'** 17-1-2011 **
'***************************************************
Option Explicit
Private
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA"
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime 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 * MAX_PATH
cAlternate As String * 14
End Type
Public Function Unidades() As String
Dim Retorno As Long
Dim i As Long
Dim Discos As String
Retorno = GetLogicalDrives
For i = 0 To 25
If (Retorno And 2 ^ i) <> 0 Then
Discos = Discos & "%%%%" & Chr$(65 + i)
End If
Next i
Unidades = Discos
End Function
Public Function Nulos(Cadena As String) As String
If InStr(Cadena, Chr(0)) <> 0 Then
Cadena = Left(Cadena, InStr(Cadena, Chr(0)) - 1)
End If
Nulos = Cadena
End Function
Public Function Archivos(Ruta As String) As String
Dim WFD As WIN32_FIND_DATA
Dim Inicio As Long
Dim Seguimos As Long
Dim ListaArchivos As String
Inicio = FindFirstFile(Ruta & "*", WFD)
If Inicio = INVALID_HANDLE_VALUE Then
Exit Function
End If
Seguimos = True
Do While Seguimos
If GetFileAttributes(Ruta & WFD.cFileName) = FILE_ATTRIBUTE_DIRECTORY Then
ListaArchivos = ListaArchivos & Nulos(WFD.cFileName)
ListaArchivos = ListaArchivos & "$$$$DIREC####"
Else
ListaArchivos = ListaArchivos & Nulos(WFD.cFileName)
ListaArchivos = ListaArchivos & "####"
End If
Seguimos = FindNextFile(Inicio, WFD)
Loop
FindClose Inicio
Archivos = ListaArchivos
End Function