'*** 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>&nbsp;" &_
      antwort(2) & "</td><td>&nbsp;" & antwort(1) & "&nbsp;</td><td><font color='" & Farbe & "'>&nbsp;" &_
      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 & ";&nbsp;&nbsp;&nbsp;"
    Nummer = Nummer & userid(1) & " = " & userid(0) & ";&nbsp;&nbsp;&nbsp;"
    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>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" &_
 "<font color='red'>ausgehende Nachrichten</font></center><BR>&nbsp;" & messenge)
dok.Close