http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** v8.8 *** www.dieseyer.de ******************************
'
' Datei: pc-analyse.vbs
' Autor: W.Schmelz
' Auf: www.dieseyer.de
'
'Kleine " PC-Analyse.vbs ", nur für das Wichtigste !
'Alles wurde bisher nur für Windows XP programmiert!
'In Vista fehlen z.Zt. Gesamt-Ram-Größe, Grafikkarte!
'In Me kommen nur Win-Version, Ort und Eigentümer, da
'sich das Programm in dieser Form sonst festfrisst!
'
'Analysiert Festplatten, auch USB, die DVD-Laufwerke,
'Laufwerksbelegungen, aktuelle und gesamte RAM-Größe,
'Wichtiges zur CPU, die Win - Version, ihren Ort, den
'registrierten Eigentümer, zum Schluss wird noch die
'Grafikkarte nachgesehen.
'Es wird alles in " PC-Analyse.vbs.txt " geschrieben,
'die Datei geöffnet und anschließend wieder gelöscht!
'***********************************************************

'Copyright W. Schmelz, 01.05.2008


'Die Objekte bereit stellen:
'***************************
Set Wss=WScript.CreateObject("WScript.Shell")
Set Fso=CreateObject("Scripting.FileSystemObject")
Set Lwk=Fso.Drives
Set Wmg=GetObject ("Winmgmts:").ExecQuery("Select"&_
" * from Win32_OperatingSystem")
Set CpuSet=GetObject("Winmgmts:").InstancesOf("Win32_Processor")
UV=VbCR&VbCR


'Evtle. Fehler übergehen, damit Programm durchläuft:
'***************************************************
On Error Resume next 'Fehlermeldungen abschalten


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


'Windows-Version, Ort und Eigentümer ermitteln:
'**********************************************

CheckKey="HKLM\Software\Microsoft\Windows NT\"&_
"CurrentVersion\ProductName"
Version=Wss.RegRead(CheckKey)

CheckKey="HKLM\Software\Microsoft\Windows NT\"&_
"CurrentVersion\SystemRoot"
Ort=Wss.RegRead(CheckKey)

CheckKey="HKLM\Software\Microsoft\Windows NT\"&_
"CurrentVersion\RegisteredOwner"
Name=Wss.RegRead(CheckKey)


'Falls keine Version gefunden, mit ME versuchen:
If Version="" then
CheckKey="HKLM\Software\Microsoft\Windows\"&_
"CurrentVersion\Productname"
Version=Wss.RegRead(CheckKey)
End If


'Windows - Version festlegen:
'****************************
Win=LCase(Mid(Version,19,2))' me, xp, vi ist möglich!

If Win="me" then

CheckKey="HKLM\Software\Microsoft\Windows\"&_
"CurrentVersion\SystemRoot"
Ort=Wss.RegRead(CheckKey)

CheckKey="HKLM\Software\Microsoft\Windows\"&_
"CurrentVersion\RegisteredOwner"
Name=Wss.RegRead(CheckKey)

'Bei Windows ME Schluss - Meldung und Abbruch:
'*********************************************
MsgBox UV&VbTab&_
Version&" / "&Ort&" / "&Name&UV&VbTab&"Da Windows ME "&_
"vorliegt, wird hier abgebrochen! "&_
UV,," Geht leider nicht weiter !"
Wscript.Quit
End If

'Es liegt nicht Windows XP oder Vista vor, dann Abbruch:
'*******************************************************
If not (Win="xp" or Win="vi") then
MsgBox UV&VbTab&_
"Es liegt nicht Windows XP oder Vista vor ,"&UV&VbTab&_
"daher muss hier abgebrochen werden ! "&_
UV,," Geht leider nicht weiter !"
Wscript.Quit
End If


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


'Festplatten ermitteln, CD/DVD:
'******************************

'Festplatten ermitteln, auch USB:
i=0
Do until (i=8 or Ende="1")
ReDim Preserve Platte(i)
Key="HKLM\System\ControlSet001\Services\Disk\Enum\"&i
Platte(i)=Wss.RegRead(Key)

'Name auf Wesentliches beschränken, "___ .." abschneiden:
If Platte(i)="" then Ende="1"

Schluss="0"
a=1
Do until (a=Len(Platte(i))-2 or Schluss="1" or Ende="1")

If Mid(Platte(i),a,3)="___" then
Platte(i)=Left(Platte(i),a-1)
Schluss="1"
End If

a=a+1
Loop

i=i+1
Loop


'DVD-Laufwerke ermitteln:
CheckKey="HKLM\System\CurrentControlSet\Services\Cdrom\Enum\0"
CDR1=Wss.RegRead(CheckKey)

'Name auf Wesentliches beschränken, "___ ..." abschneiden:
Schluss="0"
a=1
Do until (a=Len(CDR1)-2 or Schluss="1")

If Mid(CDR1,a,3)="___" then
CDR1=Left(CDR1,a-1)
Schluss="1"
End If

a=a+1
Loop


CheckKey="HKLM\System\CurrentControlSet\Services\Cdrom\Enum\1"
CDR2=Wss.RegRead(CheckKey)

'Name beschränken:
If CDR2="" then Ende="1"

Schluss="0"
a=1
Do until (a=Len(CDR2)-2 or Schluss="1" or Ende="1")

If Mid(CDR2,a,3)="___" then
CDR2=Left(CDR2,a-1)
Schluss="1"
End If

a=a+1
Loop


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


'Ergebnisse in Datei schreiben, evtl. erst anlegen und öffnen!
'*************************************************************
'(Datei wird am Ende nach den Eintragungen wieder geschlossen!)

Set Data=Fso.CreateTextFile(WScript.ScriptName&".txt",8,true)

Data.WriteLine("")
Data.WriteLine("")
Data.Write(" **************************************")
Data.WriteLine("*****************************")
Data.Write(" Diese vom Programm geschriebene Datei wurde ")
Data.WriteLine("sofort wieder gelöscht!")
Data.Write(" Wenn sie aufbewahrt werden soll, ")
Data.WriteLine("einfach erneut speichern!")
Data.Write(" **************************************")
Data.WriteLine("*****************************")

'Kopf der Analyse-Datei:
'***********************
Data.WriteLine("")
Data.WriteLine(" Kleinere Analyse des PC von :")
Data.WriteLine(" *****************************")
Data.WriteLine(" "&Name)
Data.WriteLine("")
Data.WriteLine("")


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


'Name und Ort der Windows - Version eintragen:
'*********************************************
Data.WriteLine("")
Data.WriteLine(" Name und Ort der Windows - Version:")
Data.WriteLine(" ***********************************")
Data.WriteLine(" "&Version&" in "" "&Ort&" """)
Data.WriteLine("")


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


'Die CD / DVD - Laufwerke im PC:
'*******************************
Data.WriteLine("")
Data.WriteLine(" CD / DVD - Laufwerke im PC heißt(en):")
Data.WriteLine(" *************************************")
If Len(CDR1)<40 then Data.WriteLine(" "&CDR1)
If Len(CDR1)>=40 then Data.WriteLine(" "&CDR1)

If not CDR2="" then
Data.WriteLine("")
If Len(CDR2)<40 then Data.WriteLine(" "&CDR2)
If Len(CDR2)>=40 then Data.WriteLine(" "&CDR2)
End If


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


'Alle vorhandenen Laufwerke aufschreiben, ggf. USB:
'**************************************************
Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine(" Die Festplatte(n) im PC heißt(en) :")
Data.WriteLine(" ***********************************")

'Platten aufschreiben, ca. mittig setzen
k=0
Do until Platte(k)=""

If Len(Platte(k))<40 then
Data.WriteLine(" "&Platte(k))
End If

If Len(Platte(k))>=40 then Data.WriteLine(" "&Platte(k))

Data.WriteLine("")
k=k+1
Loop


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


'Die Belegungen der Laufwerke ermitteln und notieren:
'****************************************************
Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine(" ****************************************")
Data.Write(" ")
Data.WriteLine("Die Belegungen der PC - Laufwerke sind :")
Data.WriteLine(" ****************************************")
Data.WriteLine("")


For each i in Lwk ' <===== Anfang der Schleife!!!

Txt=""
Txt1=""
Txt2=""
Proz=""

If i.DriveType=1 then Txt=" Wechsel-Lw. "&i.DriveLetter&": "
If i.DriveType=2 then Txt=" Festplatte "&i.DriveLetter&": "

If i.DriveType=4 then ' Keine "Voll!" - Warnung bei CD o.ä.
Txt=" CD-Laufwerk "&i.DriveLetter&": "
Achtng="CDLwk"
End If

Txt1=" Es sind "&FormatNumber(i.FreeSpace,0)&" Bytes "&_
"("&FormatNumber(i.FreeSpace/2^30,6)&" GB) von "
Txt2=" "&FormatNumber(i.TotalSize,0)&" Bytes ("&_
FormatNumber(i.TotalSize/2^30,6)&" GB) noch übrig !"

Proz=Left(FormatNumber(i.FreeSpace)*100/FormatNumber(i.TotalSize),4)


'Warnung, wenn weniger als 10 % Rest geblieben:
'**********************************************
If not Proz="" then
If (Proz<10 and not Achtng="CDLwk") then
MsgBox VbCR&VbCR&"Das Speichermedium "&i&" hat nur noch "&Proz&_
" % Restanteil ! ! ! "&VbCR&VbCR,VbCritical, _
" PC - Analyse"
End If
End If


'Sinnvolle Ergebnisse aufschreiben:
'**********************************
If not Proz="" then

Data.Write(Txt)
Data.WriteLine(Txt1)
Data.WriteLine(Txt2)
Data.WriteLine("")
Data.Write(" Damit sind ")
Data.Write(Proz)
Data.WriteLine(" % des Laufwerkes frei !")
Data.WriteLine("")

End If


Next ' <===== Ende der Schleife !!!


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


'Den freien Speicher ermitteln:
'******************************
For each Objekt in Wmg
FreiRam=Objekt.FreePhysicalMemory
Next

Zahl1=Round(FreiRam/2^10,0)
If Len(Zahl1)=3 then Zahl1=Zahl1&" "
If Len(Zahl1)=2 then Zahl1=Zahl1&" "

'Den Gesamtspeicher ermitteln:
'*****************************
Set Obj=GetObject("Winmgmts:\\"&StrComputer)
Set ObjectSet=Obj.InstancesOf("Win32_LogicalMemoryConfiguration")

For each Object in ObjectSet
Zahl=Object.TotalPhysicalMemory
Next

Zahl2=Round(Zahl/2^10,0)
If Len(Zahl2)=3 then Zahl2=Zahl2&" " 'vierstellig machen

'Prozentuale Anteile des Speichers berechnen, alles schreiben:
'*************************************************************
Zahl3=Round(((Zahl2-Zahl1)/Zahl2)*100,1)
Zahl3=100-Zahl3

If Len(Zahl3)=2 then Zahl3=Zahl3&",0" 'vierstellig machen!
If Len(Zahl3)=1 then Zahl3=Zahl3&",00"

Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine(" *******************************************")
Data.WriteLine(" Die aktuelle Belegung des RAM - Speichers :")
Data.WriteLine(" *******************************************")
Data.WriteLine("")
Data.Write(" Im RAM - Speicher sind ")
Data.WriteLine(Zahl2-Zahl1&" von "&Zahl2&" MB belegt !")
Data.WriteLine("")
Data.Write(" ==> "&Zahl3)
Data.WriteLine(" % des gesamten Speichers sind noch frei !")
Data.WriteLine("")


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


'CPU-Frequenz, ihren Namen in Registry auslesen und schreiben:
'*************************************************************

CheckKey="HKLM\Hardware\Description\"&_
"System\CentralProcessor\0\~MHz"
Wert0=Wss.RegRead(CheckKey)&" MHz"

'Doppel-Prozessor?
CheckKey="HKLM\Hardware\Description\"&_
"System\CentralProcessor\1\~MHz"
Wert1=Wss.RegRead(CheckKey)

CheckKey="HKLM\Hardware\Description\"&_
"System\CentralProcessor\0\ProcessorNameString"
CpuName=Wss.RegRead(CheckKey)

'Falls Doppel-Prozessor vorliegt:
If not Wert1="" then Wert0=" 2 x "&Wert0&" ( Core 2 CPU )"

Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine(" ****************************************************")
Data.WriteLine(" Die CPU-Frequenz, der CPU - Name und die Auslastung:")
Data.WriteLine(" ****************************************************")
Data.WriteLine("")
Data.WriteLine(" "&Wert0)
Data.WriteLine("")
Data.WriteLine(" "&CpuName)


'Momentane Auslastung der CPU in Prozent:
'****************************************
Doppel="0"
For each Cpu in CpuSet
If CpuSet.Count>1 then
Last=Last+Cpu.LoadPercentage 'Doppel-CPU
Doppel="1"
else
Last=Cpu.LoadPercentage 'Einzel-CPU
End If
Next

If Doppel="1" then Last=Last/2


'Ergebnisse ausgeben:
'********************
'(Leerstellen bei Last nötig!?)
If Doppel="0" then
Data.WriteLine("")
Data.WriteLine(" Momentane CPU-Auslastung ist z.Zt.: "& Last &" %")
End If

If Doppel="1" then
Data.WriteLine("")
Data.WriteLine(" Auslastung der Doppel-CPU ist z.Zt.: "& Last &" %")
End If


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


'Die Grafikkarte auslesen und angeben:
'*************************************

If Win="xp" then
CheckKey="HKLM\System\CurrentControlSet\Services\nv\Device0\"&_
"Device Description"
Grafik=Wss.RegRead(CheckKey)
End If


If Win="vi" then
CheckKey="HKLM\System\CurrentControlSet\Services\nv\Device0\"&_
"Device Description" ' ?????????????????????????????
Grafik=Wss.RegRead(CheckKey)
End If


Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine("")
Data.WriteLine(" ********************************")
Data.WriteLine(" Der Name der Grafikkarte lautet:")
Data.WriteLine(" ********************************")
Data.WriteLine("")
Data.WriteLine(" "&Grafik)
Data.WriteLine("")


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

Data.Close 'Analyse-Datei schließen!
On Error GoTo 0 'Fehlermeldungen wieder einschalten

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


'Die Analyse-Datei öffnen:
'*************************
WScript.Sleep 500
Wss.Run WScript.ScriptName&".txt"

'Analyse-Datei zum Schluss löschen:
'**********************************
WScript.Sleep 3000
Fso.DeleteFile WScript.ScriptName&".txt"
WScript.Sleep 500

WScript.Quit


http://dieseyer.de • all rights reserved • © 2011 v11.4