2# NOTEPAD & VBS script (PART2)

6) Get Useful Information About ur Hard-disk Drives
-------------------------------------------------------------------
Copy this code and paste into notepad and save the file as name.vbs then run the file and watch the result:

Option Explicit
Dim WshShell,FSO,Drv,Dtype,Dfree,Dtot
Dim Dname,Dpct,Dused,Dserial,Dinfo
Set WshShell=WScript.CreateObject("WScript.Shell")
Set FSO=CreateObject("Scripting.FileSystemObject")
For each Drv in FSO.Drives
If Drv.DriveType=0 Then Dtype="Unknown "
If Drv.DriveType=1 Then Dtype="Removable"
If Drv.DriveType=2 Then Dtype="Fixed "
If Drv.DriveType=3 Then Dtype="Network "
If Drv.DriveType=4 Then Dtype="CD-ROM "
If Drv.DriveType=5 Then Dtype="RAM Disk "
If Drv.IsReady Then
If Drv.DriveType=4 Then
Dfree="N/A"
ElseIf Drv.FreeSpace<1024^2 Then
Dfree=FormatNumber(Drv.FreeSpace/1024,0)&" KB"
ElseIf Drv.FreeSpace<10240^2 Then
Dfree=FormatNumber(Drv.FreeSpace/(1024^2),2)&" MB"
Else
Dfree=FormatNumber(Drv.FreeSpace/(1024^2),0)&" MB"
End If
If Drv.TotalSize<1024^2 Then
Dtot=FormatNumber(Drv.TotalSize/1024,0)&" KB"
ElseIf Drv.TotalSize<10240^2 Then
Dtot=FormatNumber(Drv.TotalSize/(1024^2),2)&" MB"
Else
Dtot=FormatNumber(Drv.TotalSize/(1024^2),0)&" MB"
End If
If Drv.VolumeName="" Then
Dname="(None)"
Else
Dname=Drv.VolumeName
End If
Dused=Drv.TotalSize-Drv.FreeSpace
If Dused<1024^2 Then
Dused=FormatNumber(Dused/1024,0)&" KB"
ElseIf Dused<10240^2 Then
Dused=FormatNumber(Dused/(1024^2),2)&" MB"
Else
Dused=FormatNumber(Dused/(1024^2),0)&" MB"
End If
If Drv.DriveType=4 Then
Dpct="N/A"
Else
Dpct=FormatPercent(Drv.FreeSpace/Drv.TotalSize,1)
End If
If Drv.DriveType=5 Then
Dserial="N/A"
Else
Dserial=Hex(Drv.SerialNumber)
End If
Dinfo=Dinfo&"Drive "&Drv.DriveLetter&_
":"&vbTab&vbTab&vbTab&_
"Drive Type: "&Dtype&vbTab&_
"File System: "&Drv.FileSystem&vbCRLF&_
"Total Size: "&Dtot&vbTab&_
"Free Space: "&Dfree&vbTab&_
"Volume Label: "&Dname&vbCRLF&_
"Used Space: "&Dused&vbTab&_
"Percent Free: "&Dpct&vbTab&_
"Serial Number: "&Dserial&vbCRLF&vbCRLF
Else
Dinfo=Dinfo&"Drive "&Drv.DriveLetter&_
":"&vbTab&vbTab&vbTab&_
"Drive Type: "&Dtype&vbTab&_
"(No Media in Drive)"&vbCRLF&vbCRLF
End If
Next
WshShell.popup "Note: A bug in WScript results in " & _
"sizes over 2 GB being misreported." & vbcrlf & _
vbcrlf & Dinfo,,"Information on Available Drives",0
7) Get Information About Installed Programs
----------------------------------------------------------
Copy this code and paste into notepad and save the file as name.vbs then run the file and watch the result:

Option Explicit

Dim sTitle
sTitle = "Computer Tips & Tricks"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
"installed software (leave blank to check " & _
"local system)." & vbcrlf & vbcrlf & "Remote " & _
"checking only from NT type OS to NT type OS " & _
"with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."

'Wscript.Echo GetAddRemove(strComputer)

Dim sCompName : sCompName = GetProbedID(StrComputer)

Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"

Dim s : s = GetAddRemove(strComputer)

If WriteFile(s, sFileName) Then
'optional prompt for display
If MsgBox("Finished processing. Results saved to " & sFileName & _
vbcrlf & vbcrlf & "Do you want to view the results now?", _
4 + 32, sTitle) = 6 Then
WScript.CreateObject("WScript.Shell").Run sFileName, 9
End If
End If

Function GetAddRemove(sComp)
'Function credit to Torgeir Bakken
Dim cnt, oReg, sBaseKey, iRC, aSubKeys
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
sComp & "/root/default:StdRegProv")
sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)

Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay

For Each sKey In aSubKeys
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
If iRC <> 0 Then
oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If
If sValue <> "" Then
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"DisplayVersion", sVersion)
If sVersion <> "" Then
sValue = sValue & vbTab & "Ver: " & sVersion
Else
sValue = sValue & vbTab
End If
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"InstallDate", sDateValue)
If sDateValue <> "" Then
sYr = Left(sDateValue, 4)
sMth = Mid(sDateValue, 5, 2)
sDay = Right(sDateValue, 2)
'some Registry entries have improper date format
On Error Resume Next
sDateValue = DateSerial(sYr, sMth, sDay)
On Error GoTo 0
If sdateValue <> "" Then
sValue = sValue & vbTab & "Installed: " & sDateValue
End If
End If
sTmp = sTmp & sValue & vbcrlf
cnt = cnt + 1
End If
Next
sTmp = BubbleSort(sTmp)
GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
" - " & Now() & vbcrlf & vbcrlf & sTmp
End Function

Function BubbleSort(sTmp)
'cheapo bubble sort
Dim aTmp, i, j, temp
aTmp = Split(sTmp, vbcrlf)
For i = UBound(aTmp) - 1 To 0 Step -1
For j = 0 to i - 1
If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
temp = aTmp(j + 1)
aTmp(j + 1) = aTmp(j)
aTmp(j) = temp
End if
Next
Next
BubbleSort = Join(aTmp, vbcrlf)
End Function

Function GetProbedID(sComp)
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
"Win32_NetworkAdapter",,48)
For Each objItem in colItems
GetProbedID = objItem.SystemName
Next
End Function

Function GetDTFileName()
dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
sNow = Now
sMth = Right("0" & Month(sNow), 2)
sDay = Right("0" & Day(sNow), 2)
sYr = Right("00" & Year(sNow), 4)
sHr = Right("0" & Hour(sNow), 2)
sMin = Right("0" & Minute(sNow), 2)
sSec = Right("0" & Second(sNow), 2)
GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec
End Function

Function WriteFile(sData, sFileName)
Dim fso, OutFile, bWrite
bWrite = True
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set OutFile = fso.OpenTextFile(sFileName, 2, True)
'Possibly need a prompt to close the file and one recursion attempt.
If Err = 70 Then
Wscript.Echo "Could not write to file " & sFileName & ", results " & _
"not saved." & vbcrlf & vbcrlf & "This is probably " & _
"because the file is already open."
bWrite = False
ElseIf Err Then
WScript.Echo err & vbcrlf & err.description
bWrite = False
End If
On Error GoTo 0
If bWrite Then
OutFile.WriteLine(sData)
OutFile.Close
End If
Set fso = Nothing
Set OutFile = Nothing
WriteFile = bWrite
End Function