Esta es una nueva versión de esta utilidad
para buscar y reemplazar en los ficheros de texto, incluso binarios, (aunque esa
posibilidad no la he probado y por tanto no me responsabilizo de las
consecuencias, tampoco me responsabilizo de lo que pueda ocurrir con ficheros de
texto, pero ese caso si que lo tengo comprobado y requetecomprobado y funciona
al 100%), si ya te bajaste la versión
anterior, verás que hay una serie de cambios, a mejor, ahora se pueden
especificar más de una cosa a buscar y a reemplazar... antes sólo se buscaba
una cosa y se reemplazaba también sólo una...
También se pueden especificar dos cadenas a buscar, y reemplazar las dos por
una nueva o bien, (si se especifican las dos nuevas cadenas), cambiar cada una
de ellas por el nuevo valor indicado.
Otras de las "novedades" que tiene, es que se puede realizar una
búsqueda y posteriormente usar los ficheros hallados para realizar nuevas
sustituciones, con lo cual se acelera el proceso... no debe preocuparte el que
no exista la cadena en cualquiera de esos ficheros, ya que si la cadena buscada
no está, no la sustituye...
Pulsando con el botón derecho en la lista de los ficheros hallados, se puede
especificar el editor de texto a usar para poder abrir el fichero... se permiten
especificar dos editores diferentes, uno para los ficheros de menos de 60 KB y
el otro para los que son más grandes... ya sabes que el Notepad del Windows 9x
sólo permite ficheros de unos 32 KB, en el Windows NT/2000 ese problema no
existe...
Seguramente habrá otras cosillas... pero, como hace tanto tiempo que hice la nueva versión... pues no recuerdo ahora todas las que pueden ser... por eso te dejo el listado del programa... para que cambies lo que no te guste y lo que, (posiblemente), no funcione al 100%
Como "cosa" interesante, decirte que se usa una clase cBuscar, que es la que se encarga de buscar y cambiar las coincidencias halladas, esta clase produce un evento cada vez que se encuentra un fichero o un directorio, en el evento "HayFichero" es donde se realiza la búsqueda/sustitución mediante el método "ProcesarFichero"
También dejo una versión ya compilada, para usar con el runtime del VB6 SP3
Aquí tienes los links para los ficheros ZIP
con:
el código (gsByR2_cod.zip 26.9 KB) y el
ejecutable (gsByR2.zip 20.9 KB)
Un "retratillo" del programa en ejecución:
Este es el código del formulario y la clase cBuscar.
'
'----------------------------------------------------------------------------------
'BuscarReemplazar (23/Nov/96)
'Utilidad para buscar y reemplazar cadenas en ficheros de textos
'
' ©Guillermo Som Cerezo, 1996-99
' Primera versión: Madrugada del Sábado 23 de Noviembre de 1996
'
' Revisión: 1.0.1 (25/Nov/96) Guarda lista de palabras buscadas y puestas
' Revisión: 1.0.2 (26/Nov/96)
' Revisión: 1.0.3 (18/Dic/96)
' Revisión: 1.0.4 (23/Dic/96) Sólo graba los ficheros que se han modificado
' Revisión: 1.0.5 ( 2/Ene/97) Recuerda el último directorio
' Revisión: 1.1.0 (16/Feb/97) Hace una búsqueda recursiva en los
' directorios que cuelgan debajo del especificado.
' Permite que se "suelte" un archivo.
' Revisión: 1.1.1 (27/Mar/97) Nuevo form para seleccionar sólo los directorios
' Revisión: 1.1.2 (27/Mar/97) Con librería OLE para seleccionar directorios
' Revisión: 1.2.0 ( 1/Abr/97) Cambios en la librería y otras asignaciones
' Revisión: 1.2.1 ( 8/Abr/97) Arreglos en SelDir para detectar si se cancela,
' Y poder seleccionar directorios de red tipo:
' \\Equipo\Unidad
'
' Versión: 2.0 (15/Jul/97) Nuevas opciones...
' Revisión: 2.1 (21/Feb/98) Operativa la opción de sólo buscar
'
' Revisión: 2.2.?? ( Añado List para mostrar los ficheros
' con la información buscada.
' Mejoras en SelDir para que informe
' de cada fichero conforme lo encuentra
'
' Revisión: 2.3.10 (30/Mar/98) Totalmente operativo
' Después de un mogollón de pruebas
' usando Threads, etc, para ver si mejoraba
' Revisión: 2.3.13 ( 1/Abr/98) Añado NOT para mostrar los que NO
' tengan lo indicado en Buscar
' Revisión: 2.3.18 ( 2/Abr/98) Varias mejoras y combos para los directorios
' y especificación a buscar...
' Revisión: 2.3.19 ( 6/Abr/98) Se pueden especificar dos editores,
' uno para ficheros pequeños y otro para grandes
'
' Revisiones del (28/Abr/98) 2.3.24 a 2.3.26
' --He puesto AutoRedraw y un DoeVents después de abrir el fichero.
' Aunque eso no evita el "cuelgue" cuando es demasiado grande
' --Permite soltar ficheros en los combos de especificación y
' directorios, también en las listas de ficheros.
' --Se pueden eliminar elementos de las listas de ficheros.
'
' Revisión: 2.3.27 (24/Ago/98) Sincronizar los dos listbox
'
' Revisión: 2.4.00 (24/Nov/98) Arreglado un bug cuando lo que se pone
' contiene lo que se busca
' Revisión: 2.4.01 (11/Ene/99) Cambio de la fecha del copyright y
' recordar la última posición de la ventana
' Revisión: 2.4.02 (12/Ene/99) Agrando el tamaño del form principal
' Revisión: 2.4.03 '' Arreglado bug cuando el nombre del directorio
' no es el mismo que el Drive1 de SelectDir
' Revisión: 2.4.04 '' Muestra un menú emergente para seleccionar
' los editores a usar y el AcercaDe
' Revisión: 2.4.05 '' Mejoras/cambios en SelectDir
' Revisión: 2.4.06 '' Centrar los MsgBox y usar el API de MessageBox
' Revisión: 2.4.07 '' Corregido un problema para hallar la longitud
' ya que FileLen no acepta un fichero entre comillas
' Revisión: 2.4.08 '' Con Threads ahora no funciona...
' Le he quitado la subclasificación y nada...
' Le he quitado el MessageBox y nada de nada...
' De todas formas no era más rápido.
' Revisión: 2.4.09 '' Se puede seleccionar el editor a usar desde el menú
' Revisiones del (13/Ene/99) del 2.4.10 al 2.4.12
' Quitadas las comprobaciones de trabajo con Threads
' Quitado el listbox con la información del tamaño
' ahora se muestra en una etiqueta.
' Arreglado el bug que da error si el path no existe
' Poder buscar/cambiar en los ficheros del listbox
' Revisión: 2.4.13 (14/Ene/99) Un pequeño despiste... de eliminar cSelDir
' Revisión: 2.4.14 (14/Ene/99) Dos opciones para seleccionar y copiar de la lista
' Revisión: 2.5.00 No recuerdo ahora que es lo que hice, pero creo
' que sólo era la compilación con VB6 SP3
' Revisión: 2.5.01 (26/Nov/99) Ninguna novedad, es la publicada en internet
'----------------------------------------------------------------------------------
Option Explicit
Option Compare Text
'
'Constantes para el tipo de editor a usar (12/Ene/99)
Private Enum eTipoEditor
PorTamaño
Pequeño
Grande
End Enum
Private elGuille As String
Dim WithEvents cSelDir As SelDir
Dim numCombo1 As Long
Dim optBinary As Boolean
'Para usar con una cadena hay que agregar el ByVal antes de la cadena final
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Dim nFallos As Long
Dim nCambiados As Long
Dim nProcesados As Long
Dim iTipoComp As eComboOpciones
Dim SoloBuscar As Boolean
'Editor a usar, cuando se pulsa en el fichero... (26/Mar/98)
' Aunque también se podría usar el programa asociado...
' esto para otra versión...
Dim sTxtEditor As String
Dim sTxtEditor2 As String
'
Dim bBuscandoEnCombo As Boolean
'
'ahora es una variable
Dim sFicINI As String
'Número de Items guardados de las últimas búsquedas realizadas
Const NumeroMaximoDeItems = 15 ' 50 '20
'
Private Enum eEstado
cBuscando = True
cIdle = False
End Enum
'
Dim Estado As eEstado
Dim Cancelar As Boolean
'
'Están como enum en la clase cBuscar
'Const cNinguno = 0
'Const cAnd = 1
'Const cOr = 2
'Const cNot = 3
'
Const cBuscar = 0
Const cBuscar2 = 1
Const cPoner = 2
Const cPoner2 = 3
'Usando los combos
Const cExtension = 4
Const cRuta = 5
Dim Buscar As String
Dim Buscar2 As String
Dim Poner As String
Dim Poner2 As String
'Usando los TextBoxes
'Const cExtension = 0
'Const cRuta = 1
'
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" _
(ByVal hWnd As Long, ByVal lpText As String, _
ByVal lpCaption As String, ByVal wType As Long) As Long
Dim Extension As String
Dim Ruta As String
Private Sub cboComp_Click()
Dim bHabilitado As Boolean
Dim lngColor As Long
Dim iListIndex As Long
'Si está seleccionada la primera (sólo uno)
'Deshabilitar el Combo1(cBuscar2)
'lo mismo si está seleccionado Not ( 1/Abr/98)
iListIndex = cboComp.ListIndex
Select Case iListIndex
Case cNinguno, cNot
lngColor = vbButtonFace
bHabilitado = False
If iListIndex = cNot Then
'Deshabilitar la opción cambiar
chkCambiar.Value = vbUnchecked
chkCambiar_Click
Else
'Deshabilitar el Poner2 (13/Ene/99)
Combo1(cPoner2).Enabled = False
Combo1(cPoner2).BackColor = vbButtonFace
End If
Case Else
lngColor = vbWindowBackground
bHabilitado = True
'Si es AND o OR y está marcada la opción de Cambiar, (13/Ene/99)
'habilitar el Poner2
If chkCambiar.Value = vbChecked Then
Combo1(cPoner2).Enabled = bHabilitado
Combo1(cPoner2).BackColor = vbWindowBackground
End If
End Select
Combo1(cBuscar2).Enabled = bHabilitado
Combo1(cBuscar2).BackColor = lngColor
End Sub
Private Sub chkCambiar_Click()
'Habilitar/deshabilitar los combos correspondientes
Dim i&
Dim bHabilitado As Boolean
Dim lngColor As Long
bHabilitado = CBool(chkCambiar.Value)
If bHabilitado Then
lngColor = vbWindowBackground
Else
lngColor = vbButtonFace
End If
For i = cPoner To cPoner2
Combo1(i).Enabled = bHabilitado
Combo1(i).BackColor = lngColor
Next
'Si el tipo de comparación es cNinguno, deshabilitar el Combo1(3) (13/Ene/99)
If bHabilitado Then
'Sólo si está habilitado...
If cboComp.ListIndex = cNinguno Then
Combo1(cPoner2).Enabled = False
Combo1(cPoner2).BackColor = vbButtonFace
End If
End If
End Sub
Private Sub Combo1_Click(Index As Integer)
If Not bBuscandoEnCombo Then
If Combo1(Index).ListIndex > -1 Then
Combo1(Index).Text = Combo1(Index).List(Combo1(Index).ListIndex)
End If
End If
End Sub
Private Sub cmdAceptar_Click()
ActualizarCombo
Estado = cBuscando
'No mejora demasiado al hacerlo invisible
'en las pruebas realizadas siempre variaba 1 segundo
'y la ventaja es que así se pueden editar archivos
'mientras continúa buscando
'Además de que se va "viendo" el progreso...
'lstFicheros.Visible = False
lstFicheros.Tag = lstFicheros.ToolTipText
lstFicheros.ToolTipText = ""
'Deshabilitar los controles
HabilitarControles False
cmdCancelar.ToolTipText = " Pulsa para cancelar la operación de búsqueda "
IniciarBusqueda
cmdCancelar.ToolTipText = " Pulsa este botón para salir del programa "
HabilitarControles True
'lstFicheros.Visible = True
lstFicheros.ToolTipText = lstFicheros.Tag
lstFicheros.Tag = ""
End Sub
Private Sub cmdCancelar_Click()
ActualizarCombo
Cancelar = True
If Estado = cBuscando Then
'Indicar al form que hemos cancelado
SelectDir.Cancelado = True
Else
Unload Me
End
End If
End Sub
Private Sub HabilitarControles(Optional ByVal vHabilitados As Boolean)
Static Habilitados As Boolean
Dim i As Long
If Not IsMissing(vHabilitados) Then
Habilitados = vHabilitados
End If
'For i = cExtension To cRuta
' Combo1(i).Enabled = Habilitados
'Next
For i = 0 To numCombo1
Combo1(i).Enabled = Habilitados
Next
cboComp.Enabled = Habilitados
cmdAceptar.Enabled = Habilitados
CmdExaminar.Enabled = Habilitados
'Nuevos controles habilitados/deshabilitados (26/Mar/98)
For i = 0 To 4
Label1(i).Enabled = Habilitados
Next
chkCambiar.Enabled = Habilitados
If chkCambiar.Value = 0 Then
For i = 2 To 3
Combo1(i).Enabled = False
Next
End If
i = cboComp.ListIndex
If i = cNinguno Or i = cNot Then
Combo1(cBuscar2).Enabled = False
If i = cNot Then
'Deshabilitar la opción cambiar
chkCambiar.Value = vbUnchecked
chkCambiar_Click
End If
End If
chkSubdirs.Enabled = Habilitados
chkTipoAcceso.Enabled = Habilitados
chkUsarLista.Enabled = Habilitados
Habilitados = Not Habilitados
End Sub
Private Sub CmdExaminar_Click()
'Seleccionar el directorio en el que se empezará la Búsqueda
Dim sDir As String 'Directorio seleccionado
sDir = cSelDir.Seleccionar(Trim$(Combo1(cRuta)))
If Len(sDir) = 0 Then
Show
Combo1(cRuta).SetFocus
Else
If Right$(sDir, 1) = "\" Then
sDir = Left$(sDir, Len(sDir) - 1)
End If
Combo1(cRuta) = sDir
End If
End Sub
Private Sub Combo1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
unCombo_KeyDown KeyCode
End Sub
Private Sub Combo1_KeyPress(Index As Integer, KeyAscii As Integer)
unCombo_KeyPress KeyAscii
End Sub
Private Sub Combo1_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Aceptar el nombre del directorio "soltado"
Combo1(Index).Text = Data.Files.Item(1)
End Sub
Private Sub cSelDir_HayDirectorio(ByVal unDirectorio As String)
Label2.Caption = "Procesando el directorio: " & unDirectorio
End Sub
Private Sub cSelDir_HayFichero(ByVal unFichero As String)
'Se creará una nueva instancia de la clase
'Se le asignarán los valores necesarios
'y se realizará la búsqueda
'
#If SinDLL Then
Dim tBuscar As New cBuscar
#Else
Dim tBuscar As New cDLLBuscar
#End If
'Si se cancela, no continuar e indicárselo a la clase
If Cancelar Then
cSelDir.Cancelar = True
Else
nProcesados = nProcesados + 1
With tBuscar
Select Case .ProcesarFichero(unFichero, Buscar, Buscar2, Poner, Poner2, iTipoComp, optBinary, SoloBuscar)
Case eHallado
nCambiados = nCambiados + 1
lstFicheros.AddItem RTrim$(Left$(unFichero, MAX_PATH))
lstInfoFic.AddItem Mid$(unFichero, MAX_PATH + 2)
Case eFallo
nFallos = nFallos + 1
End Select
Label3 = "Procesados: " & nProcesados & ", hallados: " & nCambiados & ", errores: " & nFallos
End With
End If
End Sub
Private Sub Form_Load()
'Leer el fichero de configuración con la última cadena puesta (25/Nov/96)
Dim j As Integer
Dim i As Integer
Dim n As Integer
Dim vTmp As Variant
Dim sTmp As String
Dim sTag As String
'---Para mostrar un Scroll Horizontal en los listbox
Const LB_SETHORIZONTALEXTENT = &H194
Dim ListLen As Long 'Ancho del List Box
Dim ScaleTmp As Integer 'Valor anterior de ScaleMode
ScaleTmp = ScaleMode
ScaleMode = vbPixels 'wParam is in PIXEL(3)
'Longitud en caracteres del scroll horizontal
ListLen = TextWidth(String$(MAX_PATH, "M"))
Call SendMessage(lstFicheros.hWnd, LB_SETHORIZONTALEXTENT, ListLen, ByVal 0&)
'Longitud en caracteres del scroll horizontal
'ListLen = TextWidth(String$(18, "M"))
'Call SendMessage(lstInfoFic.hWnd, LB_SETHORIZONTALEXTENT, ListLen, ByVal 0&)
ScaleMode = ScaleTmp 'Restablecer el valor anterior de ScaleMode
'----------
Set cSelDir = New SelDir
sTmp = "Buscar y Reemplazar v" & App.Major & "." & App.Minor & "." & Format$(App.Revision, "00")
If Year(Now) < 1999 Then
elGuille = "©Guillermo 'guille' Som, 1996-1999"
Else
elGuille = "©Guillermo 'guille' Som, 1996-" & Year(Now)
End If
Caption = sTmp & " - " & elGuille
sFicINI = App.Path & "\BuscarReemplazar.ini"
'Posicionar en el centro de la ventana principal
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
' Leer la posición anterior
Top = Val(LeerIni(sFicINI, "Posicion", "Top", CStr(Top)))
Left = Val(LeerIni(sFicINI, "Posicion", "Left", CStr(Left)))
' Algunas comprobaciones sobre la posición
If Top < 0 Then
Top = 0
' Si el form no se ve completo
ElseIf Top + Height > Screen.Height Then
Top = 0
End If
If Left < 0 Then
Left = 0
' Si el form no se ve completo
ElseIf Left + Width > Screen.Width Then
Left = 0
End If
'El tag lo uso a la hora de guardar el contenido del combo
Combo1(0).Tag = "Buscar"
Combo1(1).Tag = "Buscar2"
Combo1(2).Tag = "Poner"
Combo1(3).Tag = "Poner2"
'
Combo1(4).Tag = "Especificacion"
Combo1(5).Tag = "Directorio"
'Número de combos Combo1
numCombo1 = 5
'Para buscar más de una cosa... (15/Jul/97)
cboComp.AddItem "Sólo uno"
'$010498
'Para que busque los que no tienen eso, no poder cambiar
cboComp.AddItem "No (Not)"
'
cboComp.AddItem "Y (And)"
cboComp.AddItem "O (Or)"
Label1(4) = ""
'Este list se usa para mostrar los ficheros en los que
'se han hecho cambios o se han hallado datos... (26/Mar/98)
lstFicheros.Clear
lstInfoFic.Clear
GuardarIni sFicINI, "Copyright", "Autor", "Guillermo 'guille' Som"
GuardarIni sFicINI, "Copyright", "Última Revisión", App.ProductName
'Para ficheros pequeños
sTxtEditor = ""
sTxtEditor = LeerIni(sFicINI, "Editor de Texto", "Textos Pequeños", "")
If Len(sTxtEditor) = 0 Then
sTxtEditor = "Notepad.exe"
GuardarIni sFicINI, "Editor de Texto", "Textos Pequeños", sTxtEditor
End If
'para ficheros de más de 60000 bytes ( 6/Abr/98)
sTxtEditor2 = ""
sTxtEditor2 = LeerIni(sFicINI, "Editor de Texto", "Textos Grandes", "")
If Len(sTxtEditor2) = 0 Then
sTxtEditor2 = "Notepad.exe"
GuardarIni sFicINI, "Editor de Texto", "Textos Grandes", sTxtEditor2
End If
chkSubdirs.Value = Val(LeerIni(sFicINI, "Opciones", "Incluir SubDirs", "0"))
'Asignar las opciones de cambiar
chkCambiar.Value = Val(LeerIni(sFicINI, "Opciones", "Cambiar", "0"))
chkCambiar_Click
'Asignar la opción de la búsqueda binaria
chkTipoAcceso.Value = Val(LeerIni(sFicINI, "Opciones", "Búsqueda Binaria", "0"))
cboComp.ListIndex = Val(LeerIni(sFicINI, "Opciones", "Comparación", CStr(cNinguno)))
cboComp_Click
'asignar los valores anteriores del combo
For i = 0 To numCombo1
Combo1(i).Clear
sTag = Trim$(Combo1(i).Tag)
n = 0
n = LeerIni(sFicINI, sTag, "NumEntradas", n)
If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems
For j = 0 To n - 1
vTmp = "Entrada" & CStr(j)
sTmp = LeerIni(sFicINI, sTag, vTmp, "")
If Len(sTmp) Then
Combo1(i).AddItem sTmp
End If
Next
Combo1(i).Text = LeerIni(sFicINI, sTag, "Ultimo Item", "")
Next
'Mostrar lo último que se cambió
'For i = 0 To numCombo1
' With Combo1(i)
' If .ListCount Then
' .ListIndex = 0
' End If
' End With
'Next
sTmp = LeerIni(sFicINI, "Directorio", "UltimoDirectorio", "")
Combo1(cRuta) = sTmp
' Hay que usar el asterisco, sino no encuentra nada... (26/Nov/99)
Extension = LeerIni(sFicINI, "Directorio", "UltimaExtension", "*.htm")
Combo1(cExtension) = Extension
If Len(Command$) Then
'Comprobar si hay algún archivo en la línea de comandos
sTmp = Trim$(Command$)
i = InStr(sTmp, Chr$(34))
If i Then
sTmp = Left$(sTmp, i - 1) & Mid$(sTmp, i + 1)
i = InStr(sTmp, Chr$(34))
If i Then
sTmp = Left$(sTmp, i - 1) & Mid$(sTmp, i + 1)
End If
End If
'tomar el path
For i = Len(sTmp) To 1 Step -1
If Mid$(sTmp, i, 1) = "\" Then
Combo1(cRuta) = Left$(sTmp, i - 1)
Exit For
End If
Next
CmdExaminar_Click
End If
End Sub
Private Sub ActualizarCombo()
'Actualizar el contenido del Combo
Dim sTmp As String
Static k As Integer
'
bBuscandoEnCombo = True
For k = 0 To numCombo1
sTmp = Combo1(k).Text
If Len(Trim$(sTmp)) Then
Call ActualizarLista(sTmp, Combo1(k), 0)
End If
Next
bBuscandoEnCombo = False
End Sub
Private Function ActualizarLista(ByVal sTexto As String, _
cList As Control, _
Optional ByVal bTipoBusqueda As Integer = 0, _
Optional ByVal bAddLista As Boolean = True, _
Optional ByVal bAlPrincipio As Boolean = True) As Long
'
'Parámetros:
' sTexto Texto a buscar
' cList List o Combo en el que buscar
' bTipoBusqueda 0=Exacta, 1 y 2=Desde el principio
' (el 2 selecciona el texto hallado)
' Por defecto es búsqueda de palabra completa
' bAddLista Si se añade a la lista en caso de no hallarlo
' Por defecto si se añade
' bAlPrincipio Si se añade al principio o al final
' Por defecto se añade al principio
'
'
'Esta función comprobará si el texto indicado existe en la lista
'Si no es así, lo añadirá, si así se indica...
'El valor devuelto, será la posición dentro de la lista ó -1 si hay "fallos"
'
'Para buscar en el List/combo usaremos una llamada al API
'(si ya hay una forma de hacerlo, ¿para que re-hacerla?)
'
'Constantes para los combos
Const CB_FINDSTRINGEXACT = &H158
Const CB_FINDSTRING = &H14C
Const CB_SELECTSTRING = &H14D
'Constantes para las Listas
Const LB_FINDSTRINGEXACT = &H1A2 'Busca la cadena exactamente igual
Const LB_FINDSTRING = &H18F 'Busca en cualquier parte de la cadena
Const LB_SELECTSTRING = &H18C 'Busca desde el principio de la cadena
'
Dim lTipoBusqueda As Long
Dim L As Long
'Si el control es un Combo
If TypeOf cList Is ComboBox Then
If bTipoBusqueda = 1 Then
lTipoBusqueda = CB_FINDSTRING
ElseIf bTipoBusqueda = 2 Then
lTipoBusqueda = CB_SELECTSTRING
Else
lTipoBusqueda = CB_FINDSTRINGEXACT
End If
'Si el control es un list
ElseIf TypeOf cList Is ListBox Then
If bTipoBusqueda = 1 Then
lTipoBusqueda = LB_FINDSTRING
ElseIf bTipoBusqueda = 2 Then
lTipoBusqueda = LB_SELECTSTRING
Else
lTipoBusqueda = LB_FINDSTRINGEXACT
End If
Else
'no es un control List o Combo, salir
ActualizarLista = -1
Exit Function
End If
If cList.ListCount = 0 Then
'Seguro que no está, así que añadirla, si viene al caso...
L = -1
Else
'L = SendMessageString(cList.hwnd, lTipoBusqueda, -1, ByVal sTexto)
L = SendMessage(cList.hWnd, lTipoBusqueda, -1, ByVal sTexto)
End If
'Si no está, añadirla
If L = -1 Then
If bAddLista Then
'Si hay que añadirla al principio
If bAlPrincipio Then
cList.AddItem sTexto, 0
Else
cList.AddItem sTexto
End If
L = ActualizarLista(sTexto, cList, bTipoBusqueda, bAddLista, bAlPrincipio)
End If
End If
ActualizarLista = L
End Function
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'Si se pulsa el botón derecho del ratón
If Button = vbRightButton Then
'Mostrar el menú de selección de Editores
MenuPopUp
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim n As Integer
Dim vTmp
Dim sTmp As String
Dim i As Integer
Dim j As Integer
Dim sTag As String
' Guardar la posición que tenía antes de cerrar el programa (11/Ene/99)
If WindowState <> vbMinimized Then
GuardarIni sFicINI, "Posicion", "Top", CStr(Top)
GuardarIni sFicINI, "Posicion", "Left", CStr(Left)
End If
GuardarIni sFicINI, "Opciones", "Búsqueda Binaria", CStr(chkTipoAcceso.Value)
GuardarIni sFicINI, "Opciones", "Comparación", CStr(cboComp.ListIndex)
GuardarIni sFicINI, "Opciones", "Cambiar", CStr(chkCambiar.Value)
GuardarIni sFicINI, "Opciones", "Incluir SubDirs", CStr(chkSubdirs.Value)
GuardarIni sFicINI, "Directorio", "UltimoDirectorio", Ruta
GuardarIni sFicINI, "Directorio", "UltimaExtension", Extension
'Comprobar si el texto del combo hay que incluirlo en la lista
ActualizarCombo
For i = 0 To numCombo1
n = Combo1(i).ListCount
sTag = Trim$(Combo1(i).Tag)
If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems
GuardarIni sFicINI, sTag, "NumEntradas", n
GuardarIni sFicINI, sTag, "Ultimo Item", Combo1(i).Text
For j = 0 To n - 1
vTmp = "Entrada" & CStr(j)
sTmp = Combo1(i).List(j)
GuardarIni sFicINI, sTag, vTmp, sTmp
Next
Next
End Sub
Private Sub Form_Resize()
Static YaEstuve As Boolean
' Si ya hemos estado antes, es que se ha mostrado el form (11/Ene/99)
If YaEstuve Then
If WindowState <> vbMinimized Then
' Aunque el form no es dimensionable, recordar la posición para el caso
' de que se minimize y después se restaure
GuardarIni sFicINI, "Posicion", "Top", CStr(Top)
GuardarIni sFicINI, "Posicion", "Left", CStr(Left)
End If
Else
YaEstuve = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set cSelDir = Nothing
Set BuscarReemplazar = Nothing
End Sub
Private Sub IniciarBusqueda()
'Comprobar si hay que buscar o faltan datos...
Dim sTmp As String
Dim sFichero2 As String
Dim i As Long
'Para mostrar el tiempo empleado, asignarlo a True
#Const TiempoEmpleado = True
#If TiempoEmpleado Then
Dim t1 As Date
Dim t2 As Date
#End If
Dim colDir As cNombres
'
'Para centrar los MsgBox
Form_hWnd = Me.hWnd
'
Dim hInst As Long
Dim Thread As Long 'Set up the CBT hook
'
hInst = GetWindowLong(Form_hWnd, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc2, hInst, Thread)
'
Buscar = Combo1(cBuscar).Text
Buscar2 = Combo1(cBuscar2).Text
Poner = Combo1(cPoner).Text
Poner2 = Combo1(cPoner2).Text
'
Extension = Trim$(Combo1(cExtension))
Ruta = Trim$(Combo1(cRuta))
'Si no existe este directorio, dar error o dejarla vacía (13/Ene/99)
On Local Error Resume Next
'Si no hay ficheros en esa ruta,
'En caso de que el path no exista, se producirá un error
If Len(Dir$(cSelDir.AddBackSlash(Ruta) & "*.*")) = 0 Then
Err = 76
End If
If Err Then
'Asignar el path actual
Ruta = CurDir$
Combo1(cRuta).Text = Ruta
End If
Err = 0
On Local Error GoTo 0
iTipoComp = cboComp.ListIndex
'Si sólo es buscar, sin cambiar (21/Feb/98)
SoloBuscar = (chkCambiar.Value = 0)
'Si se realiza una búsqueda en ficheros binarios
optBinary = (chkTipoAcceso.Value = 1)
If Len(Trim$(Buscar) & Trim$(Buscar2)) = 0 Then
'
Call MessageBox(Me.hWnd, "Debes especificar algo en buscar...", vbExclamation, "Buscar y Reemplazar")
'
HabilitarControles True
Combo1(cBuscar).SetFocus
Exit Sub
End If
'Poner se puede dejar en blanco, para quitar lo buscado
'avisar de todos modos
If Not SoloBuscar Then
If Len(Trim$(Poner)) = 0 Then
'
If MessageBox(Me.hWnd, "No se ha especificado nada en poner," & vbCrLf & "se supone que quieres quitar " & Buscar, vbExclamation + vbOKCancel, "Buscar y Reemplazar") = vbCancel Then
'
HabilitarControles True
Combo1(cPoner).SetFocus
Exit Sub
End If
End If
End If
'Crear las clases
Set cSelDir = Nothing
Set cSelDir = New SelDir
Set colDir = New cNombres
'Iniciar la Busqueda
Estado = cBuscando
MousePointer = vbArrowHourglass
Label2 = ""
Label2.Visible = True
Label3 = ""
Label3.Visible = True
cmdCancelar.Caption = "Cancelar"
'Si no hay ficheros en la lista... no se puede buscar en lo que hay en ella
If lstFicheros.ListCount = 0 Then
chkUsarLista.Value = vbUnchecked
End If
Refresh 'DoEvents
nFallos = 0
nProcesados = 0
nCambiados = 0
Cancelar = False
'
'Tiempo empleado
'
#If TiempoEmpleado Then
t1 = Now
#End If
'Comprobar si tiene el punto la extensión (27/Mar/97)
'???
sTmp = Trim$(Extension)
'Si se usan los ficheros de la lista, para agilizar el tema (13/Ene/99)
'en caso de que se busque primero y después se cambie
'
If chkUsarLista Then
Label2 = "Procesando los directorios de la lista..."
'Usar los ficheros de la lista...
For i = 0 To lstFicheros.ListCount - 1
colDir.Nombres(i + 1) = lstFicheros.List(i)
Next
lstFicheros.Clear
lstInfoFic.Clear
'Llamar al evento, como si se hubiese encontrado el fichero (13/Ene/99)
For i = 1 To colDir.Nombres.Count
cSelDir_HayFichero colDir.Nombres(i)
Next
Label2 = ""
Else
lstFicheros.Clear
lstInfoFic.Clear
If chkSubdirs Then
'Si se recorren los directorios, usar la función
Label2 = "Procesando los directorios de " & Ruta
DoEvents
cSelDir.Directorios colDir, Ruta, sTmp
Label2 = ""
Else
If Len(Ruta) Then
'Cambiar al directorio especificado
ChDir Ruta
End If
'Sólo el directorio actual
cSelDir.Directorio colDir, Ruta, sTmp
End If
End If
'
#If TiempoEmpleado Then
t2 = Now
Label3 = "Tiempo empleado " & DateDiff("s", t1, t2) & " segundos " ' & colDir.Nombres.Count
#Else
Label3 = ""
#End If
'===Ya no es necesario, se comprueba en la clase ( 7/Abr/98)
'Comprobar si se ha quedado el fichero temporal
'sFichero2 = Ruta & IIf(Right$(Ruta, 1) = "\", "", "\") & "fichero.tmp"
'If Len(Dir$(sFichero2)) Then
' Kill sFichero2
'End If
'
sTmp = "Se han procesado " & CStr(nProcesados) & " ficheros"
If nCambiados Then
sTmp = sTmp & vbCrLf & " y se han " & IIf(SoloBuscar, "hallado", "cambiado") & " los datos indicados en " & CStr(nCambiados)
Else
sTmp = sTmp & vbCrLf & " y no se ha" & IIf(SoloBuscar, " hallado lo indicado.", "n realizado cambios.")
End If
If nFallos Then
sTmp = sTmp & ", se han producido " & nFallos & " errores."
End If
'
Call MessageBox(Me.hWnd, sTmp, "Buscar y Reemplazar", vbOKOnly)
'
Label2.Caption = sTmp
Salir:
MousePointer = vbDefault
Estado = cIdle
cmdCancelar.Caption = "Salir"
Set colDir = Nothing
'hay que dejar una referencia a esta clase... (14/Ene/99)
Set cSelDir = Nothing
Set cSelDir = New SelDir
End Sub
Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'Si se pulsa el botón derecho del ratón
If Button = vbRightButton Then
'Mostrar el menú de selección de Editores
MenuPopUp
End If
End Sub
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'Si se pulsa el botón derecho del ratón
If Button = vbRightButton Then
'Mostrar el menú de selección de Editores
MenuPopUp
End If
End Sub
Private Sub lstFicheros_KeyDown(KeyCode As Integer, Shift As Integer)
'Poder eleminar ficheros... (28/Abr/98)
'Hay que borrar de la otra lista para que sigan "sincronizados"
'Si se pulsa la tecla de suprimir
If KeyCode = vbKeyDelete Then
'Eliminar los que estén seleccionados
BorrarDeListaFic lstFicheros
End If
End Sub
Private Sub lstFicheros_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'Si se pulsa el botón derecho del ratón
If Button = vbRightButton Then
'Mostrar el menú de selección de Editores
MenuPopUp Editar:=True
End If
End Sub
Private Sub lstFicheros_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Añadir los ficheros soltados
'aunque ahora no permite indicar los ficheros en
'los que se buscarán...
'Además quiero añadirle que se abran con los programas asociados
'o al menos mostrar un PopUp para seleccionar la acción, además
'de los programas asociados...
Dim i As Long
Dim sFic As String
Dim sDateTime As String
On Local Error Resume Next
With Data.Files
For i = 1 To .Count
Err = 0
sFic = .Item(i)
sDateTime = FileLen(sFic) & " " & FileDateTime(sFic)
If Err = 0 Then
lstFicheros.AddItem sFic
lstInfoFic.AddItem sDateTime
End If
Next
End With
Err = 0
End Sub
Private Sub lstFicheros_Click()
'Mostrar el tamaño y fecha del fichero
Label1(4) = lstInfoFic.List(lstFicheros.ListIndex)
End Sub
Private Sub SincListBox(elListOrig As Control, elListDest As Control)
Static EnListBox As Boolean
'Sincronizar el elListDest con el elListOrig
If Not EnListBox Then
EnListBox = True
' 'Desmarcar los elementos seleccionados
' QuitarListSelected elListDest
'
' 'Marcar en el 1º ListBox los seleccionados del 2º
' PonerListSelected elListOrig, elListDest
'Poner en el ListDest los mismos que en ListOrig
ListSelected elListOrig, elListDest
'Posicionar el elemento superior
elListDest.TopIndex = elListOrig.TopIndex
EnListBox = False
End If
End Sub
Private Sub ListSelected(elListOrig As Control, elListDest As Control)
'Marca en el ListDest los elementos seleccionados del ListOrig
'
'Los dos listbox deben tener el mismo número de elementos
'
Dim i&
'Por si no tienen los mismos elementos
On Local Error Resume Next
With elListOrig
For i = 0 To .ListCount - 1
'Si el origen está seleccionado...
If .Selected(i) Then
elListDest.Selected(i) = .Selected(i)
Else
'sino, quitar la posible selección
elListDest.Selected(i) = False
End If
Next
End With
Err = 0
End Sub
Private Sub PonerListSelected(elListOrig As Control, elListDest As Control)
'Marca en el ListDest los elementos seleccionados del ListOrig
'
'Los dos listbox deben tener el mismo número de elementos
'
Dim i&
'Por si no tienen los mismos elementos
On Local Error Resume Next
With elListOrig
For i = 0 To .ListCount - 1
elListDest.Selected(i) = .Selected(i)
Next
End With
Err = 0
End Sub
Private Sub QuitarListSelected(unList As Control)
'Quitar los elementos seleccionados del listbox indicado
'Parámetros:
' unList el List a controlar
'
Dim i&
With unList
'Sólo hacer el bucle si permite multiselección
If .MultiSelect Then
For i = 0 To .ListCount - 1
.Selected(i) = False
Next
End If
End With
End Sub
Private Sub lstFicheros_DblClick()
'Editar el fichero indicado
EditarFichero
End Sub
Private Sub Combo1_Change(Index As Integer)
Static YaEstoy As Boolean
On Local Error Resume Next
If Not YaEstoy Then
YaEstoy = True
unCombo_Change Combo1(Index).Text, Combo1(Index)
If Index = cExtension Then
Extension = Trim$(Combo1(Index))
ElseIf Index = cRuta Then
Ruta = Trim$(Combo1(Index))
End If
YaEstoy = False
End If
Err = 0
End Sub
Private Sub BorrarDeListaFic(unaLista As ListBox)
'Si se pulsa la tecla de suprimir
Dim i As Long
Dim j As Long
Dim OtraLista As ListBox
'Ajustar las listas, para buscar los seleccionados
'en la lista de origen
If unaLista.Name = "lstFicheros" Then
Set OtraLista = lstInfoFic
Else
Set OtraLista = lstFicheros
End If
'borrar los elementos seleccionados
With unaLista
j = .ListCount - 1
For i = j To 0 Step -1
If .Selected(i) Then
.RemoveItem i
OtraLista.RemoveItem i
End If
Next
End With
End Sub
Private Sub MenuPopUp(Optional ByVal Editar As Boolean = False)
'Mostrar el menú de selección de Editores (el menú que hay) (12/Ene/99)
'Si se especifica el parámetro Editar, mostrar los menús de edición
Dim sEditor1 As String
Dim sEditor2 As String
cSelDir.SplitPath sTxtEditor, "", sEditor1
mnuEdPeq.Caption = "Seleccionar Editor para textos &pequeños... (" & sEditor1 & ")"
cSelDir.SplitPath sTxtEditor2, "", sEditor2
mnuEdGran.Caption = "Seleccionar Editor para textos &grandes... (" & sEditor2 & ")"
If Editar Then
mnuEditPeq.Caption = "Editar con " & sEditor1
mnuEditGran.Caption = "Editar con " & sEditor2
End If
mnuEditPeq.Visible = Editar
mnuEditGran.Visible = Editar
mnuSep2.Visible = Editar
mnuSep3.Visible = Editar
mnuCopySel.Visible = Editar
mnuSelTodo.Visible = Editar
PopupMenu mnuFic, , , , mnuAcercaDe
End Sub
Private Sub mnuAcercaDe_Click()
'Mostrar el AcercaDe (12/Ene/99)
Dim sMsg As String
'
'Para centrar los MsgBox
Form_hWnd = Me.hWnd
'
Dim hInst As Long
Dim Thread As Long 'Set up the CBT hook
'
hInst = GetWindowLong(Form_hWnd, GWL_HINSTANCE)
Thread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc2, hInst, Thread)
'
'
sMsg = "Buscar y Reemplazar v" & App.Major & "." & App.Minor & "." & Format$(App.Revision, "00")
sMsg = sMsg & vbCrLf & vbCrLf & "Utilidad para buscar y reemplazar en ficheros"
sMsg = sMsg & vbCrLf & App.ProductName
sMsg = sMsg & vbCrLf & vbCrLf & elGuille
'
Call MessageBox(Me.hWnd, sMsg, "Acerca de Buscar y Reemplazar", vbOKOnly)
End Sub
Private Sub mnuCopySel_Click()
'copiar los elementos seleccionados en el portapapeles
Dim i As Long
Dim sClip As String
sClip = ""
With lstFicheros
For i = 0 To .ListCount - 1
If .Selected(i) Then
sClip = sClip & vbCrLf & .List(i)
End If
Next
End With
If Len(sClip) Then
With Clipboard
.Clear
.SetText sClip
End With
End If
sClip = ""
End Sub
Private Sub mnuEdGran_Click()
'Seleccionar el Editor para ficheros de más de 64KB
sTxtEditor2 = SeleccionarEditor(sTxtEditor2)
'Guardarlo en el fichero INI
GuardarIni sFicINI, "Editor de Texto", "Textos Grandes", sTxtEditor2
End Sub
Private Function SeleccionarEditor(ByVal sEditor As String) As String
Dim sDir As String 'Directorio seleccionado
On Local Error Resume Next
cSelDir.SplitPath sEditor, sDir
If Len(sDir) = 0 Then
sDir = "C:\Windows"
End If
'sDir = cSelDir.Seleccionar(sDir, "*.exe", True)
sDir = cSelDir.Seleccionar(sDir, sEditor, True)
If Len(sDir) Then
If Len(Dir$(sDir)) Then
sEditor = sDir
End If
End If
SeleccionarEditor = sEditor
Err = 0
End Function
Private Sub mnuEditGran_Click()
EditarFichero Grande
End Sub
Private Sub mnuEditPeq_Click()
EditarFichero Pequeño
End Sub
Private Sub mnuEdPeq_Click()
'Seleccionar el Editor para ficheros de menos de 60.000 bytes
sTxtEditor = SeleccionarEditor(sTxtEditor)
'Guardarlo en el fichero INI
GuardarIni sFicINI, "Editor de Texto", "Textos Pequeños", sTxtEditor
End Sub
Private Sub EditarFichero(Optional ByVal queEditor As eTipoEditor = PorTamaño)
'Poder editar el fichero indicado
'Se usará Notepad.exe
'En el fichero INI se podrá especificar otro editor
Dim i As Long
Dim sFichero As String
Dim lenFic As Long
On Local Error Resume Next
i = lstFicheros.ListIndex
If i > -1 Then
sFichero = lstFicheros.List(i)
lenFic = FileLen(sFichero)
'si el nombre del ficheros tiene espacios ( 6/abr/98)
If InStr(sFichero, " ") Then
'pero no tiene comillas...
If InStr(sFichero, Chr$(34)) = 0 Then
'...añadirselas
sFichero = Chr$(34) & sFichero & Chr$(34)
End If
End If
'Para usar el editor indicado o el que corresponda al tamaño
If queEditor = Pequeño Then
lenFic = 1
ElseIf queEditor = Grande Then
lenFic = 65000
End If
If lenFic < 62500 Then
Call Shell(sTxtEditor & " " & sFichero, vbNormalFocus)
Else
Call Shell(sTxtEditor2 & " " & sFichero, vbNormalFocus)
End If
End If
Err = 0
End Sub
Private Sub mnuSelTodo_Click()
'Seleccionar todos los elementos del list
Dim i As Long
With lstFicheros
For i = 0 To .ListCount - 1
.Selected(i) = True
Next
End With
End Sub
Clase cBuscar:
'------------------------------------------------------------------
'cBuscar (28/Mar/98)
'
'Descripción:
' Clase para buscar (y reemplazar) cadenas en ficheros
'
'©Guillermo 'guille' Som, 1998
'
'Esta clase recibirá un fichero a procesar,
'Buscará la paralabra/s indicadas
'y si se indica, efectuará los cambios de esas palabras por otras
'
'Tendrá un sólo punto de entrada, que será la función de búsqueda
'Esa función devolverá TRUE si ha encontrado/cambiado lo indicado
'
'Los parámetros que le indiquen lo que buscar y cambiar,
'se pasarán como parámetros a la función expuesta por la clase.
'
'Si sólo se quiere buscar, indicarlo en el parámetro SoloBuscar
'
'------------------------------------------------------------------
Option Explicit
Option Compare Text
Public Enum eMaxPath
MAX_PATH = 260
End Enum
'Enumeración para el valor devuelto por ProcesarFichero
Public Enum eProcesarFichero
eHallado = True
eNoHallado = False
eFallo = 2
End Enum
'Constantes para el tipo de comparación
'Usando Enum público: ( 1/Abr/98)
Public Enum eComboOpciones
cNinguno = 0
cNot
cAnd
cOr
End Enum
Public Function ProcesarFichero(Fichero As String, _
ByVal Buscar As String, Optional ByVal Buscar2 As String, _
Optional ByVal Poner As String, Optional ByVal Poner2 As String, _
Optional ByVal iTipoComp As eComboOpciones = cNinguno, _
Optional optBinary As Boolean = False, _
Optional ByVal SoloBuscar As Boolean = True) As eProcesarFichero
'------------------------------------------------------------------------------
'Procesa el fichero indicado.
'
'Devuelve True si se ha encontrado algo
'
'En Fichero devuelve el nombre del fichero hasta el tamaño de MAX_PATH
'a continuación muestra la información del tamaño y fecha de modificación
'Fichero = Left$(Fichero & Space$(MAX_PATH), MAX_PATH) & " " &
' Right$(Space$(6) & tamFic, 7) & " " & Format$(vFechaFic, "dd/mm/yy")
'------------------------------------------------------------------------------
'
Dim bProcesarFichero As eProcesarFichero
'Comprobar si hay que buscar o faltan datos...
Dim m As Long
Dim n As Long
Dim n2 As Long
Dim nAnt As Long 'Para comprobar si se encuentra en la misma posición
Dim nAnt2 As Long 'y evitar un bucle sin fin. (16/Feb/97)
'
Dim sTmp As String
Dim nFic As Integer
Dim hallado As Boolean
Dim hallado2 As Boolean
Dim SeCambia As Boolean
'Ficheros donde se guardarán los datos
Dim sFichero2 As String
Dim iFichero2 As Integer
Dim sFichero1 As String
Dim sRuta As String
'$010498
Dim vFechaFic As Date
Dim tamFic As Long
'
Dim tSelDir As SelDir
Dim nRefrescar As Long
'Esta rutina de errores es necesaria
On Local Error Resume Next
bProcesarFichero = eNoHallado
sRuta = ElPath(Fichero)
'Abrir este fichero
nFic = FreeFile
' Antes lo abría como Binary, pero era más lento.
' Ahora se puede abrir de una forma u otra,
' dependiendo que sólo se busque en ficheros de texto o en todo tipo de fichero
If optBinary Then
Open Fichero For Binary As nFic
Else
Open Fichero For Input As nFic
End If
m = LOF(nFic)
hallado = False
hallado2 = False
sTmp = Input$(m, nFic)
'Aquí se puede producir un error,
'si el fichero es binario, por ejemplo
If Err Then
Err = 0
Close nFic
ProcesarFichero = eFallo
Exit Function
End If
'Un pequeño respiro... (28/Abr/98)
DoEvents
If Not SoloBuscar Then
'El uso de IIf me ha dado problemas en alguna ocasión...
'sFichero2 = sRuta & IIf(Right$(sRuta, 1) = "\", "", "\") & "fichero.tmp"
'Crear una referencia a la clase
Set tSelDir = New SelDir
sFichero2 = tSelDir.AddBackSlash(sRuta) & "fichero.tmp"
'Ya no necesitamos la clase
Set tSelDir = Nothing
'Abrir el fichero de destino
iFichero2 = FreeFile
Open sFichero2 For Output As iFichero2
End If
nAnt = 1
nAnt2 = 1
SeCambia = False
sFichero1 = ""
nRefrescar = 0&
Do
'Cada diez veces hacer un DoEvents (14/Ene/99)
If nRefrescar >= 10& Then
DoEvents
nRefrescar = 0&
End If
nRefrescar = nRefrescar + 1&
n = 0
n2 = 0
n = InStr(nAnt, sTmp, Buscar)
'$010498
'si es NOT, invertir el valor de n
If iTipoComp = cNot Then
If n = 0 Then
hallado = True
SeCambia = True
Else
hallado = False
SeCambia = False
End If
'Hay que salir...
Exit Do
End If
'$010498
If iTipoComp > cNot Then
n2 = InStr(nAnt2, sTmp, Buscar2)
End If
If n Then
hallado = True
'Si es AND sólo buscar en caso de haber hallado
'algo en la primera cadena a buscar
If iTipoComp = cAnd Then
If Len(Buscar2) Then
If n2 = 0 Then
hallado = False
n = 0
Else
hallado2 = True
End If
End If
End If
End If
If iTipoComp = cOr Then
If Len(Buscar2) Then
If n2 Then
hallado2 = True
End If
End If
End If
If n Then
'Cambiar
If Not SoloBuscar Then
sTmp = Left$(sTmp, n - 1) & Poner & Mid$(sTmp, n + Len(Buscar))
End If
SeCambia = True
End If
If SoloBuscar Then '(21/Feb/98)
'Con uno que se encuentre es suficiente
If hallado = True Or hallado2 = True Then
SeCambia = True
Exit Do
End If
Else
If n2 Then
'Esto es necesario, ya que al cambiar el primero
'puede que la posición cambie...
n2 = InStr(nAnt2, sTmp, Buscar2)
'Cambiar por lo segundo que se ha puesto...
If Len(Poner2) Then
sTmp = Left$(sTmp, n2 - 1) & Poner2 & Mid$(sTmp, n2 + Len(Buscar2))
SeCambia = True
Else
'Si no se especificó nada en el segundo de poner...
'poner lo que había en el primero
sTmp = Left$(sTmp, n2 - 1) & Poner & Mid$(sTmp, n2 + Len(Buscar2))
SeCambia = True
End If
End If
End If
If hallado = False And hallado2 = False Then
Exit Do
End If
'Esto es para que no se quede "colgado" (16/Feb/97)
'Por si queremos cambiar una palabra y ponerla en otro estado de mayúsculas/minúsculas
If n = 0 And n2 = 0 Then
Exit Do
End If
'nAnt = n + 1
'nAnt2 = n2 + 1
'Por si lo que se pone contiene lo que se busca (24/Nov/98)
nAnt = n + Len(Buscar) + 1
nAnt2 = n2 + Len(Buscar2) + 1
Loop
If SeCambia Then
bProcesarFichero = eHallado
'guardar los cambios
If Not SoloBuscar Then
Print #iFichero2, sTmp
End If
End If
Close nFic
If Not SoloBuscar Then
Close iFichero2
If SeCambia Then
'renombrar el fichero
Kill Fichero
If Err = 0 Then
Name sFichero2 As Fichero
Else
bProcesarFichero = eFallo
End If
End If
'Comprobar si se ha quedado el fichero temporal
If Len(Dir$(sFichero2)) Then
Kill sFichero2
End If
End If
If bProcesarFichero = eHallado Then
vFechaFic = FileDateTime(Fichero)
tamFic = FileLen(Fichero)
Fichero = Left$(Fichero & Space$(MAX_PATH), MAX_PATH) & " " & Right$(Space$(6) & tamFic, 7) & " " & Format$(vFechaFic, "dd/mm/yy")
End If
'Poner a cero el número de error
Err = 0
ProcesarFichero = bProcesarFichero
End Function
Private Function ElPath(ByVal elFichero As String) As String
'Devuelve el path del fichero indicado
Dim i&
For i = Len(elFichero) To 1 Step -1
If Mid$(elFichero, i, 1) = "\" Then
ElPath = Left$(elFichero, i)
Exit For
End If
Next
End Function
