verlauf-suche_pcw.vbs - Verlaufsarchiv mit PC-WELT-Skript durchforsten

Hi, vor Jahren gab es mal bei der PC-Welt ein Skript, mit dem man seinen Verlauf im IE sichern und durchsuchen konnte (verlauf-suche_pcw.vbs - Verlaufsarchiv mit PC-WELT-Skript durchforsten).
Unter XP & IE8 verrichtet es auch noch seinen Dienst, aber unter Windows 7 funktioniert es leider nicht mehr.
Da ich nicht die Ahnung von VB-Skript habe, währe ich dankbar, wenn mir jemand helfen könnte, es wieder zum laufen zu kriegen.

Hier der Code (verlauf-suche_pcw.vbs)

'********begin****************************
Dim VerlaufPfad
Dim VerlPfad
Dim KopierPfad
Set Myshell = WScript.CreateObject("WScript.Shell")
Set MyFolder = CreateObject("Scripting.FileSystemObject")

VerlaufPfad = MyShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\History") & "\"

'Geben Sie hier bitte den gewünschten Pfad für Ihren Archivordner an
'*************************************************************************************
VerlPfad="C:\Programme\Verlauf-Suche\"
'*************************************************************************************

slash = Mid(VerlPfad, Len(VerlPfad), 1)

If slash = "\" Then
KopierPfad=VerlPfad & "TempVerlauf\"
Else
VerlPfad = VerlPfad & "\"
KopierPfad=VerlPfad & "TempVerlauf\"
End If

Nutzung = MsgBox("Wollen Sie die vorhandene Verlauf-Datenbank durchsuchen (ja) oder die Datenbank aktualisieren (Nein)?", 35, "Verlauf-Datenbank")

If Nutzung = 7 Then
Aktualisieren
ElseIf Nutzung = 6 Then
Suchen
ElseIf Nutzung = 2 Then
Wscript.quit
End if

'------------------------------------------------------------------------------------

Sub Aktualisieren ()

If not (MyFolder.FolderExists(VerlPfad)) Then
Set Verl=MyFolder.CreateFolder(Verlpfad)
Set Dind=MyFolder.CreateFolder(Verlpfad & "DateInd\")
End If

Set Kop=Myfolder.CreateFolder(KopierPfad)
Set Verlauf = MyFolder.GetFolder(VerlaufPfad)
Set KopierFold = Myfolder.GetFolder(Kopierpfad)
MyFolder.CopyFolder Verlauf, KopierFold, True

Set His0 = KopierFold.SubFolders
For Each His1 in His0

Pruef = LCase(Mid(His1.name, 1, 6))
If not Pruef = "mshist" Then
Verz = "\" & His1.name & "\"
Else
Verz = "\"
End if
Next

Set History = MyFolder.GetFolder(KopierFold & Verz)

Set Datx = History.SubFolders
For Each Dat2 in Datx
Set Ind0 = MyFolder.GetFile(History & "\" & Dat2.name & "\index.dat")
LetzteAend = Ind0.DateLastModified
Day0=Mid(Dat2.name, 15, 2)
Day1=Mid(Dat2.name, 23, 2)
Month0=Mid(Dat2.name, 13, 2)
Month1=Mid(Dat2.name, 21, 2)
Year0=Mid(Dat2.name, 9, 4)
Year1=Mid(Dat2.name, 17, 4)
Datum = Day0 & "." & Month0 & "." & year0 & " - " & Day1 & "." & Month1 & "." & year1


CheckPoint = 0
If (MyFolder.FileExists(Verlpfad & "DateInd\DateInd.txt")) Then
Set DateInd = MyFolder.OpentextFile(Verlpfad & "DateInd\DateInd.txt", 1, False)
Do while DateInd.AtEndOfStream <> True
Schau = DateInd.Readline
If not schau = "" then
Checkp = InStr(1, Schau, Datum, 1)
If not Checkp = 0 Then
Checkpoint = Int(Mid(Schau, 44, Len(Schau)))
End If
End If
Loop
DateInd.close
End if
Set Ind = Ind0.OpenAsTextStream(1, 0)
Set HTM = Myfolder.OpenTextFile(VerlPfad & Datum & ".txt", 8, True)
IndRead = Ind.Read(Ind0.Size)

EndPos = 1 + CheckPoint
Do
UrlPos = InStr(Endpos, IndRead, "http://", 1)
If not UrlPos = 0 Then
EndPos = InStr(UrlPos, IndRead, Chr(00), 1)
laenge = EndPos-UrlPos+1
URL = Mid(IndRead, UrlPos, laenge)
HTM.Writeline URL
End if
Loop until UrlPos = 0
EndP = 1 + CheckPoint
Do
LocPos = InStr(Endp, IndRead, "file:///", 1)
If not LocPos = 0 Then
EndP = InStr(LocPos, IndRead, Chr(00), 1)
laenge = EndP-LocPos+1
LOC = Mid(IndRead, LocPos, laenge)
HTM.Writeline LOC
End if
Loop until LocPos = 0
Endpo = 1 + CheckPoint
Do
ftpPos = InStr(Endpo, IndRead, "ftp://", 1)
If not ftpPos = 0 Then
EndPo = InStr(ftpPos, IndRead, Chr(00), 1)
laenge = EndPo-ftpPos+1
FTP = Mid(IndRead, ftpPos, laenge)
HTM.Writeline FTP
End if
Loop until ftpPos = 0
If Endpos >= Endpo Then
If Endpo >= Endp Then
EP = Endpos
ElseIf Endpo =< Endp Then
If Endpos >= Endp Then
EP = Endpos
ElseIf Endpos =< Endp Then
EP = Endp
End If
End If
ElseIf Endpo >= Endpos Then
If Endpos >= Endp Then
EP = Endpo
ElseIf Endpos =< Endp Then
If Endpo >= Endp Then
EP = Endpo
ElseIf Endpo =< Endp Then
EP = Endp
End If
End If
ElseIf Endpos = endpo Then
If Endpo = endp Then
EP = Endpos
End If
End If
If (MyFolder.FileExists(Verlpfad & "DateInd\DateInd.txt")) Then
Set DateInd = MyFolder.OpentextFile(Verlpfad & "DateInd\DateInd.txt", 1, False)
Schau0 = DateInd.ReadAll
DateInd.close
End if
Set DateInd = MyFolder.OpentextFile(Verlpfad & "DateInd\DateInd.txt", 8, True)
Schau1 = InStr(1, Schau0, Datum & " " & LetzteAend & " " & EP-1, 1)
If Schau1 = 0 then
DateInd.Writeline Datum & " " & LetzteAend & " " & EP
Dateind.close
End if

Ind.close
htm.Close

Dat2.Delete
Next
KopierFold.Delete
MsgBox "Fertig"
End Sub

'------------------------------------------------------------------------------------

Sub Suchen ()
If not (MyFolder.FolderExists(VerlPfad)) Then
Fehler = MsgBox("Sie müssen zunächst eine Verlauf-Datenbank anlegen" +vbcr & "Starten Sie dazu das Skript erneut und klicken Sie bei der ersten Abfrage auf Nein", 16, "Datenbank nicht vorhanden")
wscript.quit
End if
Anfrage = InputBox("Geben Sie bitte einen Suchbegriff ein", "Suchbegriff")
If Anfrage = "" Then Wscript.quit

Set History = MyFolder.GetFolder(VerlPfad)
Set HTM = MyFolder.OpentextFile(Verlpfad & "DateInd\Sucherg.htm", 2, True)
HTM.writeline "<HTML>"
HTM.writeline "<BODY>"
HTM.writeline "<H4>"
HTM.writeline "<h1>Suchergebniss für die Anfrage " & Chr(34) & Anfrage & Chr(34) & "</h1>"

found = 0
Set Dat0 = History.files
For each Dat1 in Dat0
Set Suche = MyFolder.OpentextFile(Verlpfad & Dat1.name, 1, False)
Do While Suche.AtEndOfStream <> True
Zeile = Suche.Readline
Test = InStr(1, Zeile, Anfrage, 1)
If not test = 0 Then
Datum = Mid(Dat1.name, 1, Len(dat1.name)-4)
Befehl = "<A HREF=" & Chr(34) & Zeile & Chr(34) & ">" & Datum & " - " & Zeile & "</A></br>"
found = Found + 1
htm.Writeline Befehl
End If
Loop
Suche.Close
Next
If Found = 1 Then
Anzahl = Found & " Eintrag gefunden"
ElseIf Found = 0 Then
MsgBox "Keinen Eintrag gefunden"
wscript.quit
Else
Anzahl = Found & " Einträge gefunden"
End If


HTM.writeline "<h3>" & Anzahl & "</h3>"
HTM.writeline "</HTML>"
HTM.writeline "</BODY>"
HTM.writeline "</H4>"
HTM.Close
Erg=myshell.run (chr(34) & Verlpfad & "DateInd\Sucherg.htm" & chr(34))

End Sub
'********end****************************

 

für Win7: die IE8 History(Verlauf) findet sich im Pfad C:\Users\%USERNAME%\AppData\Local\Microsoft\Windows\History
den Ordner kannst du auch verschieben unter den IE 8- Internetoptionen/Allgemein/Browserverlauf/Einstellungen...

 

Die Ordnerstruktur im Verlauf hat sich geändert, darum funktioniert das Script nicht mehr.
Aber ist das Script überhaupt noch notwendig? Das Durchsuchen des Verlaufs funktioniert doch inzwischen im IE einigermaßen gut.

 

Naja, ich kann damit den Verlauf recht komfortabel archivieren, transportieren und durchsuchen. Der Standartverlauf bietet dieses nicht. Ich hatte das Skript mir als Icon in die IE-Menüleiste gelegt und es war somit schnell greifbar.
Ich wär dankbar, wenn es wieder funktionieren würde.