LiveWire Network Peer Answers Peer Support Teen Forums Tech Forums College Forums 376 users online 225312 members 494 active today Advertise Here Sign In
TeenCollegeTechPhotos | Quizzes | LiveSecret | Memberlist | Dictionary | News | FAQ
Member Spotlight
Muffinman
Favs: Spiderman dies when hit by semitruck.
Mood: Screwed
You have 1 new message.
Emergency Help
Until you sign up you can't do much. Yes, it's free.

Sign Up Now
Membername:
Password:
Already have an account?
Invite Friends
Active Members
Groups
Contests
Moderators
1 online / 64 MPM
Fresh Topics
  LiveWire / Technical Forums / Programming & Application Development / Adding Reply

Adding Reply
Archived Topic: It will not be bumped to the top of the forum.
Topic VBScript
Membername   Not a member? Sign Up Free (takes 20 seconds)
Password   Forgotten your password?
Post

Font:   Size:   Color:

FAQ Keyword Search:
Post Options
Favorites Manager
Notify me of new replies to this topic by email
Notify me of new replies to this topic by private message
Original Post
mary21 Posted at 9:26 am on April 5, 2005
Hi,

I really do not have a clue how VBScript works and I have this program that does something similar to what I want to do and I'm sure if I could understand the code I could use bits and pieces, I am on the tightest deadline and do not have time to try to figure out VBScript so I would be eternally grateful if someone could convert it to either VB.net 2003 or C/C++

The following is the VBScript code to list all the programs installed on a PC:

Option Explicit

Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
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

Replies
yourbrainonsaget Posted at 9:33 am on April 5, 2005
Quote: from pleaseremove at 12:30 pm on April 5, 2005

how much spare time do you think we have...

really!
pleaseremove Posted at 9:30 am on April 5, 2005
how much spare time do you think we have...
All 2 previous replies displayed.