Web Browser

[culd]

No esta Re optimo, pero sirve

Código:

Dim PaginasVisitadas(1 To 10000) As String
Dim TotalPaginasVisitadas As Integer
Dim PaginaAnterior As String

Private Sub BAdelante_Click()
On Error Resume Next
WebBrowser1.GoForward
End Sub

Private Sub BAtras_Click()
On Error Resume Next
WebBrowser1.GoBack
End Sub

Private Sub BInicio_Click()
On Error Resume Next
WebBrowser1.GoHome
End Sub

Private Sub BParar_Click()
On Error Resume Next
WebBrowser1.Stop
End Sub

Private Sub CDirecciones_Click()
If UCase(CDirecciones.Text) <> UCase(PaginaActual) Then
    If ExistePagina(CDirecciones.Text) = False Then
        Call AgregarPagina(CDirecciones.Text)
        Call GuardarTXT(CDirecciones.Text)
        CDirecciones.AddItem CDirecciones.Text
    End If
    WebBrowser1.Navigate CDirecciones.Text
End If
End Sub

Private Sub CDirecciones_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If UCase(Left(CDirecciones.Text, 7)) <> "HTTP://" Then
        CDirecciones.Text = "http://" & CDirecciones.Text
    End If
    If UCase(CDirecciones.Text) <> UCase(PaginaAnterior) Then
        If ExistePagina(CDirecciones.Text) = False Then
            Call AgregarPagina(CDirecciones.Text)
            Call GuardarTXT(CDirecciones.Text)
            CDirecciones.AddItem CDirecciones.Text
        End If
        WebBrowser1.Navigate CDirecciones.Text
        PaginaAnterior = CDirecciones.Text
    End If
End If
End Sub

Private Sub Form_Load()
Call CargarPaginas
WebBrowser1.Navigate ("http://www.google.com.ar/")
PaginaAnterior = "http://www.google.com.ar/"
End Sub

Private Sub Timer1_Timer()
Dim PaginaActual As String
Me.Caption = WebBrowser1.LocationURL
PaginaActual = WebBrowser1.LocationURL
If UCase(PaginaActual) <> UCase(PaginaAnterior) Then
    If ExistePagina(PaginaActual) = False Then
        Call AgregarPagina(PaginaActual)
        CDirecciones.AddItem PaginaActual
        CDirecciones.Text = PaginaActual
        Call GuardarTXT(PaginaActual)
        PaginaAnterior = WebBrowser1.LocationURL
    End If
End If
End Sub

Private Function ExistePagina(Direccion As String) As Boolean
ExistePagina = False

Dim X As Integer

For X = 1 To TotalPaginasVisitadas
    If UCase(Direccion) = UCase(PaginasVisitadas(X)) Then
        ExistePagina = True
        Exit Function
    End If
Next X
End Function

Private Sub GuardarTXT(Direccion As String)
Dim Archivo As Integer
Archivo = FreeFile
Open "C:\direccionesweb.txt" For Append Shared As #Archivo
    Print #Archivo, Direccion
Close #Archivo
End Sub

Private Sub AgregarPagina(Direccion As String)
TotalPaginasVisitadas = TotalPaginasVisitadas + 1
PaginasVisitadas(TotalPaginasVisitadas) = Direccion
End Sub
Private Sub CargarPaginas()
On Error Resume Next
TotalPaginasVisitadas = 0
Dim Archivo As Integer
Dim Linea As String
Archivo = FreeFile
Open "C:\direccionesweb.txt" For Input As #Archivo
    While Not EOF(Archivo)
        Line Input #Archivo, Linea
        CDirecciones.AddItem Linea
        TotalPaginasVisitadas = TotalPaginasVisitadas + 1
    Wend
Close #Archivo
End Sub