BUSCADOR EN HTML
[by Ciberwalter (VB6.0)]
Fecha: 11 Diciembre 2003 (publicado
13/Dic/2003)
Autor: Walter Martínez O.
waltermilenium@hotmail.com
http://www.geocities.com/gnivel4
Este ejemplo administra las direcciones web de un buscador realizado en javascript, muy útil para la realización de páginas web, sin la necesidad de utilizar PHP, CGI u otros archivos similares, ya que muchos servidores gratuitos no los admiten.
Bueno Amigos, ésta es la solución.
Un Buscador BBB (Bueno, Bonito y Barato).
Muchos se preguntarán, Por qué utilizo nombres de variables tan raras, bueno yo también me lo pregunto...
Para agregar una nueva dirección completa los siguientes campos:
- Hipervinculo: Página Vinculada
- Tipo de Ventana: Ventana en que se abrirá el Vínculo.
- Título: Nombre de la Página vinculada
- Palabras Clave: Palabras que se buscarán.
- Descripción: Pequeño resumen del contenido de la página.
en las palabras clave de este Item deberías poner entre otras "Guille"
Y al Buscar la Palabra "Guille". El Item se verá de esta forma:
______________________________________________________________________
La Web Del Guille (Título)
En esta web encontrarán todo acerca de Visual Basic y Mucho Más.
(Descripción)
http://www.mundoprogramacion.com/indice.asp (Vínculo)
______________________________________________________________________
A continuación sigue el código en Visual Basic 6.0 (Completo):
Option Explicit
Dim Linea As String
Dim NoVermas As Boolean
Private Sub Command1_Click()
' Como Siempre, Dimensionamos las Variables
Dim Ficha As String
Dim walter As Integer
Dim Linea As String
Dim NameFile As String
Dim i
Dim Vinculo As String
Dim HiperV As String
Dim Vinculo2 As String
Dim HiperV2 As String
i = 0
walter = FreeFile
' NameFile es el archivo que contiene las direcciones
NameFile = App.Path & "\data.js"
' Si Algún Campo no está completo no permite que se cree el nuevo Item
If Reference <> "" And Title <> "" And KeyWords <> "" And Descriptions <> "" Then
Ficha = "add(" & Chr$(34) & "<a href='" & Reference & "' target='" & Target & "'>" & Title & "</a>" & Chr$(34) & "," & Chr$(34) & KeyWords & Chr$(34) & "," & Chr$(34) & Descriptions & Chr$(34) & ")"
' Aquí agrega a List1 una nueva ficha y avanza 1 en el contador
List1.AddItem Ficha
NumberLista = NumberLista + 1
' Aquí Resetea los campos para que queden neutros
Reference = "http://"
Option2_Click
Option2.Value = True
Title = ""
KeyWords = ""
Descriptions = ""
List2.Clear
' Abrimos el archivo con los datos y le agregamos los Items
Open NameFile For Output As #walter
Do While i < NumberLista
Print #walter, List1.List(i)
Linea = List1.List(i)
HiperV = InStr(Linea, "'")
Vinculo = Mid$(Linea, HiperV + 1)
HiperV2 = InStr(Vinculo, "'")
Vinculo2 = Mid$(Vinculo, 1, HiperV2 - 1)
List2.AddItem Vinculo2
i = i + 1
Loop
Close #walter
' Una Vez Guardado el Item, Avisamos este suceso
MsgBox "Item Guardado", vbInformation, "Guardado"
Else
' Pero si no has completado todos los casilleros...
' Caerá sobre tí una maldición China... ¿?.. no!, sólo te saldrá un error
MsgBox "Debes completar todos los casilleros", vbExclamation, "Error"
End If
End Sub
Private Sub Descriptions_Change()
' Al Cambiar el casillero Descriptions mostrará la previsualización
EjDesc.Caption = Descriptions.Text
End Sub
Private Sub Form_Load()
Dim Vinculo As String
Dim HiperV As String
Dim Vinculo2 As String
Dim HiperV2 As String
Dim walter As Integer
Dim NameFile As String
NoVermas = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
walter = FreeFile
NameFile = App.Path & "\data.js"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Al comenzar el programa carga los items previamente guardados al List1
Open NameFile For Input As #walter
Do While Not EOF(walter)
Line Input #walter, Linea
List1.AddItem Linea
HiperV = InStr(Linea, "'")
Vinculo = Mid$(Linea, HiperV + 1)
HiperV2 = InStr(Vinculo, "'")
Vinculo2 = Mid$(Vinculo, 1, HiperV2 - 1)
List2.AddItem Vinculo2
Loop
Close #walter
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
NumberLista = List1.ListCount
End Sub
Private Sub KeyWords_Change()
' Al Cambiar el casillero KeyWords mostrará la previsualización
KeyToFind.Caption = KeyWords.Text
End Sub
Private Sub Label15_Click()
If NoVermas = True Then
Label15.Caption = "Previsualización: <<"
Me.Height = Me.Height - 1890
NoVermas = False
ElseIf NoVermas = False Then
Label15.Caption = "Previsualización: >>"
Me.Height = Me.Height + 1890
NoVermas = True
End If
End Sub
Private Sub List2_KeyPress(KeyAscii As Integer)
Dim EliminarItem
' Para eliminar un Item debes seleccionarlo y pulsar la tecla Retroceso
EliminarItem = MsgBox("Desea Eliminar este Item", vbYesNo, "Eliminar Item")
If EliminarItem = vbYes Then
If KeyAscii = 8 Then
If List2.ListIndex >= 0 Then
List1.RemoveItem List2.ListIndex
List2.RemoveItem List2.ListIndex
Dim i
Dim walter
Dim NameFile
walter = FreeFile
NameFile = App.Path & "\data.js"
i = 0
' Aquí Abrimos el data.js para eliminar algún Item
Open NameFile For Output As #walter
Do While i < NumberLista - 1
Print #walter, List1.List(i)
i = i + 1
Loop
Close #walter
NumberLista = NumberLista - 1
End If
End If
Else
Exit Sub
End If
End Sub
Private Sub Option1_Click()
Otra.Visible = False
Target = Option1.Caption
End Sub
Private Sub Option2_Click()
Otra.Visible = False
Target = Option2.Caption
End Sub
Private Sub Option3_Click()
Otra.Visible = False
Target = Option3.Caption
End Sub
Private Sub Option4_Click()
Otra.Visible = False
Target = Option4.Caption
End Sub
Private Sub Option5_Click()
Otra.Visible = True
End Sub
Private Sub Otra_Change()
Target = Otra
End Sub
' Parte de la Previsualización
Private Sub Reference_Change()
Linker.Caption = Reference.Text
End Sub
Private Sub Title_Change()
EjTitle.Caption = Title.Text
End Sub
Si Tienen algún comentario o queja haganmela saber a mi e-mail.
Instrucciones de Utilización.
Instrucciones: todo programador de HTML sabe o al menos intuye cómo se publican los archivos con extensión .htm, .js, .jpg, etc. Pero para aquellos que no lo tienen tan claro les vamos a explicar:
Primero que nada, deben contar con un sitio donde hospedar sus páginas (Obviamente). los archivos necesarios para que este buscador funcione correctamente son:
Search.htm
back_file.gif - next_file.gif
db.js - data.js - code.js
Es Decir, deben subir al directorio web que poseen todos estos archivos (Obligación).
Además de los numeros que se encuentran en la carpeta "numeros" para ello debes crear una carpeta en el servidor de internet que poseas y darle el nombre "numeros" y dentro de ella debes colocar todas las imagenes correspondiente a los números del 1 al 100.
Por el contrario, si no quieres que aparezcan estos números, borra el archivo code.js y renombra el archivo code2.js con el nombre code.js, (este otro archivo no incluye las imágenes de los números sino que utiliza letras).
ADBuscador by Ciberwalter (Ciberwalter_buscador.zip - Tamaño 162 KB)