Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Vbs-Script läuft nicht mehr unter Windows 7 x64

Frage Entwicklung VB for Applications

Mitglied: tytn-tytn

tytn-tytn (Level 1) - Jetzt verbinden

05.08.2010 um 14:52 Uhr, 6606 Aufrufe

Ich habe ein VBS-Script, welches den Verlauf des IE archiviert und durchsuchbar macht. Unter XP lief es und unter Windows 7 (x64) nur noch Fehler.

Ich habe ein VBS-Script, welches den Verlauf des IE archiviert und durchsuchbar macht. Unter XP lief es und unter Windows 7 (x64) nur noch Fehler.
Fehler sind u.a. "Verzeichnis schon vorhanden". Wenn ich das Verzeichnis lösche oder umbenenne, dann ein anderer Fehler.
Leider habe ich keine große Ahnung von VB-Script, darum wende ich mich an euch in der freudigen Erwartung ....

Hier das Script:


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:\Tools\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
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
VB for Applications
VBS Script zum versenden mehrerer Verknüpfungen zu Dateien per Lotus Notes

Frage von Sentinel87 zum Thema VB for Applications ...

Batch & Shell
gelöst VBS Script in eine Textdatei ausgeben (VBS mit Batch zusammenführen) (5)

Frage von Luuke257 zum Thema Batch & Shell ...

Windows Installation
Solid Edge V20 unter Windows 7 x64 per PDQ Deploy (free) verteilen

Frage von TheM-Man zum Thema Windows Installation ...

Heiß diskutierte Inhalte
Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (17)

Frage von JayyyH zum Thema Switche und Hubs ...

Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

DSL, VDSL
DSL-Signal bewerten (14)

Frage von SarekHL zum Thema DSL, VDSL ...