'*** v8.3 *** www.dieseyer.de ******************************* 

' 

' Datei:  icq6-verlauflesen.vbs 

' Autor:  mike-winxp@gmx.de 

' Auf:    www.dieseyer.de 

' 

' Skript zum Lesen einer Verlaufsdatei (von icq6; ICQ v6.x). 

' Dazu einfach die "Messages.mdb"-Datei auf das Script ziehen 

' und fallen lassen. Die Datei befindet sich (unter WinXP): 

' C:\Dokumente und Einstellungen\[UserName]\Anwendungsdaten\ICQ\[ICQ Nummer]\Messages.mdb 

' %APPDATA%\ICQ\[Ihre ICQ Nummer]\Messages.mdb 

' 

'************************************************************ 

 

Option Explicit 

 

Dim shell, db, ie, objArgs, x, pfad, dok, i, antwort, userid, history, messenge, Title, Nummer, Farbe, zahl, Icq_killen ,prozess 

 

Set shell = CreateObject("WScript.Shell") 

Set db    = CreateObject("ADODB.Connection") 

Set ie    = CreateObject("InternetExplorer.Application") 

Set objArgs = WScript.Arguments 

 

For x = 0 To objArgs.Count - 1 

    pfad = objArgs(I)  

Next 

 

If pfad = "" Then 

   pfad = shell.SpecialFolders("AppData") & "\ICQ\[Ihre ICQ Nummer]\Messages.mdb"           ' Bitte tragen sie ihre ICQ-Nummer ein 

   If instr(1, pfad, "[Ihre ICQ Nummer]", 1) > 1 Then Msgbox "Bitte passen Sie den Pfad an",16,"Error" : Wscript.Quit  

End If  

 

For Each prozess In GetObject("winmgmts:{impersonationLevel=impersonate,(Debug)}").ExecQuery ("SELECT * FROM Win32_Process") 

If Instr("ICQ.exe",prozess.Name) > 0 Then  

	Icq_killen = Msgbox ("Anscheinend läuft ICQ noch. Um auf die Datenbank zugreifen zu können muss ICQ beendet werden" &_ 

	 vbCr & vbCr & "Wollen sie Icq jetzt beenden?" & vbCr &_ 

	"Wählen Sie 'Ja' um ICQ jetzt zu beenden (ACHTUNG: Dadurch wird der Task ICQ.exe ""gekillt"")" & vbCr &_ 

	"Wählen Sie 'Nein' um mit dem Script fortzufahren (Beenden Sie vorher ICQ manuell)" & vbCr &_ 

	"Wählen Sie 'Abbrechen' um das Script abzubrechen" , 563 ,"ICQ läuft noch. Wie möchten sie fortfahren?") 

	If Icq_killen = 7 Then Msgbox "Bitte beenden Sie ICQ jetzt!",64, "ICQ jetzt beenden" 

	If Icq_killen = 2 Then wscript.Quit 

	If Icq_killen = 6 Then prozess.Terminate(0) 

End If 

Next 

 

zahl = InputBox("Bitte geben Sie an, wieviele Nachrichten angezeigt werden sollen.", "Icq6 Verlauf", "500")  

If zahl = 0 Then Wscript.Quit 

 

ie.Navigate "about:blank" 

While ie.Busy 

Wend 

 

Set dok = ie.Document 

dok.Open 

dok.Writeln "<Title>Verlauf Icq6</Title><B>Datenbank wird gelesen. Bitte warten . . . </b>" 

dok.Close 

ie.Visible = True 

 

wscript.sleep 100 

shell.AppActivate("Verlauf Icq6") 

shell.SendKeys "% x" 

 

db.Open("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & pfad) 

   

Set antwort = db.Execute("SELECT * FROM Messages" & " ORDER BY date DESC") 

Set userid  = db.Execute("SELECT * FROM Users") 

Set history = db.Execute("SELECT * FROM ChatHistory") 

   

For i = 0 To zahl  

      If antwort.EOF = True Then Exit For 

	x = x + 1 : If x = 10 Then Wscript.Sleep 3 : x = 0  ' Soll für geringere Prozessorauslastung sorgen 

	 

	If "" & antwort(1) = "" Then 

		Farbe = "red" 

	Else  ' black; maroon; green; olive; navy; purple; teal; gray; silver; red; lime; yellow; blue; fuchsia; aqua 

		Farbe = "blue"  

	End If 

	messenge = "<tr><td>" & Left(antwort(6),6) & Mid(antwort(6),9,8) & "</td><td> " &_ 

      antwort(2) & "</td><td> " & antwort(1) & " </td><td><font color='" & Farbe & "'> " &_ 

      antwort(8) & "</font></td></tr>" & messenge  ' Damit die neueste Nachricht ganz oben steht muss es 'messenge = messenge & "....'  

      antwort.MoveNext 

Next 

 

Title = "<Title>Verlauf Icq6</Title><u><B>Gespräch mit:</b></u><BR>" 

Nummer = "<u><B>User haben folgende Nummern:</b></u><BR>" 

 

x = 0 

Do Until userid.EOF 

    x = x + 1 

    messenge = Replace(messenge,userid(0),userid(1)) 

    messenge = Replace(messenge, history(0), x) 

     

    Title = Title  & userid(1) & " = " & x & ";   " 

    Nummer = Nummer & userid(1) & " = " & userid(0) & ";   " 

    userid.MoveNext 

    history.MoveNext 

Loop 

 

Title = Title & "<BR><BR><u><B>Verlauf:</b></u><BR>Die letzten " & zahl & " Nachrichten werden angezeitg<BR><table border='1' cellpadding='0' cellspacing='0' width='99%'>" &_ 

 "<tr><td><B><center>Datum/Uhrzeit</center></td><td><B><center>ID</center></td><td><B><center>Name</center></td><td><B><center>Nachricht</center></td>" 

 

dok.Open 

dok.Write(Nummer & "<BR><BR>" & Title & "<BR><center><font color='blue'>eingehende Nachrichten</font>      " &_ 

 "<font color='red'>ausgehende Nachrichten</font></center><BR> " & messenge) 

dok.Close