Collecting URL(websites) history

Thanks for stopping by :)

How would I collect the recent URL history (websites) of places the user(s) has been and save it to a file?

What are you using? SHDOCVW.DLL(Webbrowser1) or regular IE?

If you are using the dll, than use Webbrowser1.LocationURL to save the history of place you have visited.

No, I was talking about like Internet Explorer or Netscape history. I want to be able to collect their recent URL(websites)from the user(s) and add it to a text file.

Here's an interesting file

WINDOWSDIRECTORY\profiles\USERNAME\history\history.ie5\index.dat

You can't see it in windows or Dos, but you can access the file. It contains most of the sites you've visited whether you've cleared your history or not.

I wrote a program which used the FileSystemObject to make a copy of the file, then read it into a RichTextBox, searched through the textbox for the string "Visited:" and then a Chr$(0), and that returned the site-names.
It's a mess, but here it is.

You need a module and a form with a RichTextBox, and a Listbox, as well as 2 x labels, one in the middle of the form saying something like "Examining IE5 history" and another called Label2 and a reference to Microsoft Scripting Runtime


The form code is:

Code:

---

Private Sub Form_Load()
    Me.Visible = True
    DoEvents
    'Get IE5 history file
    'WINDOWSDIRECTORY\profiles\USERNAME\history\history.ie5\index.dat
    b$ = windowsdirectory & "\profiles\" & UserName & "\history\history.ie5\index.dat"
    'Copy to Tempdirectory
    c$ = TempDir & "index.dat"
    Dim d As New FileSystemObject
    d.CopyFile b$, c$, True
    'Open in RichTextBox
    RichTextBox1.FileName = c$
    'Delete Copy
    Kill c$
   
    DoEvents
    y = 1
    Do
        x = InStr(y, RichTextBox1.Text, "Visited:")
        If x > 0 Then
            X1 = InStr(x, RichTextBox1.Text, Chr$(0))
            y = x + 1
            z$ = Mid$(RichTextBox1.Text, x + 8, X1 - x + 12)
            List1.AddItem (z$)
        End If
        zz = x / Len(RichTextBox1.Text)
        zz = zz * 100
        Label2.Caption = Int(zz) & "%"
        DoEvents
    Loop While x > 0
    List1.Visible = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized Then
        List1.Width = Me.ScaleWidth
        List1.Height = Me.ScaleHeight
    End If
End Sub

---

And the module code is:

Code:

---

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Function UserName() As String
    Dim a$
    a$ = Space(255)
    Call GetUserName(a$, 255)
    UserName = Trim(a$)
    UserName = Left$(UserName, Len(UserName) - 1)
End Function

Function TempDir() As String
    Dim a$
    a$ = Space(255)
    Call GetTempPath(255, a$)
    TempDir = Trim(a$)
    TempDir = Left$(TempDir, Len(TempDir) - 1)
End Function

Function windowsdirectory() As String
    Dim WinPath As String
    WinPath = String(145, Chr(0))
    windowsdirectory = Left(WinPath, GetWindowsDirectory(WinPath, Len(WinPath)))
End Function

---

I am using Win98 and I think you gave me WindowsNT codes...would it be possible if you can make it work with Windows95/98? Thanks

[Edited by vbsmm97 on 07-05-2000 at 02:01 AM]

you suggested using the

FileSystemObject

I guess its a componet (?) but I can't see where its located

thanks