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, 6643 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
Ähnliche Inhalte
Batch & Shell
gelöst Hilfe Bei einem vbs Script (19)

Frage von Hattori-Hanzo zum Thema Batch & Shell ...

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
gelöst Nach Austausch SSD - Problem mit Windows 7 x64 Installation (5)

Frage von BigSnakeye zum Thema Windows Installation ...

Neue Wissensbeiträge
Windows Update

Microsoft Update KB4034664 verursacht Probleme mit Multimonitor-Systemen

(2)

Tipp von beidermachtvongreyscull zum Thema Windows Update ...

Viren und Trojaner

CNC-Fräsen von MECANUMERIC werden (ggf.) mit Viren, Trojanern, Würmern ausgeliefert

(4)

Erfahrungsbericht von anteNope zum Thema Viren und Trojaner ...

Windows 10

Windows 10: Erste Anmeldung Animation deaktivieren

(3)

Anleitung von alemanne21 zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Netzwerkprotokolle
Leiten "dumme" Switches VLAN-Tags mit durch? (23)

Frage von coltseavers zum Thema Netzwerkprotokolle ...

Windows Server
gelöst Neues KB für W10 1607 und W2K16 wieder mal nicht im WSUS 3.0, hat das noch jemand? (15)

Frage von departure69 zum Thema Windows Server ...

Batch & Shell
Batch zum suchen und verschieben von Verknüpfungen (12)

Frage von zeroblue2005 zum Thema Batch & Shell ...

Router & Routing
FTTH bzw FTTB Router (11)

Frage von ukulele-7 zum Thema Router & Routing ...