Autor
|
Tema: Copiar todo el contenido de un CD a una carpeta (Leído 2,116 veces)
|
c0c0_w3y_s0ftwar3
|
gracias....
|
|
« Última modificación: 2 Julio 2010, 08:43 am por c0c0_w3y_s0ftwar3 »
|
En línea
|
No Te equivoques Bro... Las cosas son como tienen que ser...
|
|
|
Kizar
Desconectado
Mensajes: 1.325
kizar_net
|
No hay diferencia entre que el archivo este en un discoduro o en un cd. Este código sacado de Api-Guide es para listar archivos, solo tienes que irles copiando según se van listando... 'Create a form with a command button (command1), a list box (list1) 'and four text boxes (text1, text2, text3 and text4). 'Type in the first textbox a startingpath like c:\ 'and in the second textbox you put a pattern like *.* or *.txt
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
Const MAX_PATH = 260 Const MAXDWORD = &HFFFF Const INVALID_HANDLE_VALUE = -1 Const FILE_ATTRIBUTE_ARCHIVE = &H20 Const FILE_ATTRIBUTE_DIRECTORY = &H10 Const FILE_ATTRIBUTE_HIDDEN = &H2 Const FILE_ATTRIBUTE_NORMAL = &H80 Const FILE_ATTRIBUTE_READONLY = &H1 Const FILE_ATTRIBUTE_SYSTEM = &H4 Const FILE_ATTRIBUTE_TEMPORARY = &H100
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 Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = OriginalStr End Function
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer) 'KPD-Team 1999 'E-Mail: KPDTeam@Allapi.net 'URL: http://www.allapi.net/
Dim FileName As String ' Walking filename variable... Dim DirName As String ' SubDirectory Name Dim dirNames() As String ' Buffer for directory name entries Dim nDir As Integer ' Number of directories in this path Dim i As Integer ' For-loop counter... Dim hSearch As Long ' Search Handle Dim WFD As WIN32_FIND_DATA Dim Cont As Integer If Right(path, 1) <> "\" Then path = path & "\" ' Search for subdirectories. nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = StripNulls(WFD.cFileName) ' Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ' Check for directory with bitwise comparison. If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) End If End If Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory. Loop Cont = FindClose(hSearch) End If ' Walk through this directory and sum file sizes. hSearch = FindFirstFile(path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = StripNulls(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow FileCount = FileCount + 1 List1.AddItem path & FileName End If Cont = FindNextFile(hSearch, WFD) ' Get next file Wend Cont = FindClose(hSearch) End If ' If there are sub-directories... If nDir > 0 Then ' Recursively walk into them... For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount) Next i End If End Function Sub Command1_Click() Dim SearchPath As String, FindStr As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass List1.Clear SearchPath = Text1.Text FindStr = Text2.Text FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs) Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories" Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" Screen.MousePointer = vbDefault End Sub
|
|
|
En línea
|
|
|
|
c0c0_w3y_s0ftwar3
|
Graxias....KiZar Ya pude Obtener lo que keria solo le agregue esta parte al code Private Sub Command2_Click() On Error Resume Next Dim i As Integer Dim fso As FileSystemObject
Set fso = New FileSystemObject For i = 0 To List1.ListCount Path = List1.List(i) fso.CopyFile Path, "C:\Copy\", True Next i Set fso = Nothing List1.Clear MsgBox "Sus archivos fueron copiados satisfactoriamente", vbInformation, "c0c0_w3y_s0ftwar3" End Sub Tenia este code guardado por ahi solo que en esta parte del code fso.CopyFile Path, "C:\Copy\", True lo tenia para borrar todos los archivos encontrados en el List Box que era este code fso.DeleteFile Path, True Gracias ,,, KiZar y Gracias ,,,Sancho.Mazorka por su ayuda Salu2...
|
|
|
En línea
|
No Te equivoques Bro... Las cosas son como tienen que ser...
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
descargar todo el contenido de una carpeta web
Desarrollo Web
|
YHOMER
|
1
|
9,443
|
5 Enero 2013, 01:17 am
por Vadtar
|
|
|
Al copiar datos, solo reemplasar lo ya existente, y todo en una sola carpeta!!
Scripting
|
Abathar
|
6
|
3,937
|
10 Noviembre 2013, 06:22 am
por Abathar
|
|
|
[Batch] Ayuda eliminar contenido de carpeta
Scripting
|
zZsamuelZz4
|
4
|
5,086
|
5 Septiembre 2014, 19:41 pm
por Eleкtro
|
|
|
[SOLUCIONADO] Copiar carpeta de archivos con progresbar
Programación Visual Basic
|
e500
|
4
|
5,284
|
30 Diciembre 2014, 22:14 pm
por e500
|
|
|
Denunciado HDFury, el sistema que permite copiar contenido 4K de Netflix y ...
Noticias
|
wolfbcn
|
1
|
1,401
|
4 Enero 2016, 20:21 pm
por Orubatosu
|
|