LiveWire Network Peer Answers Peer Support Teen Forums Tech Forums College Forums 290 users online 225528 members 410 active today Advertise Here Sign In
TeenCollegeTechPhotos | Quizzes | LiveSecret | Memberlist | Dictionary | News | FAQ
Member Spotlight
Zac Zack
Interests: Money,Girls,Boys and you
Mood: Lonely
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
3 online / 20 MPM
Fresh Topics
  LiveWire / Technical Forums / Programming & Application Development / Viewing Topic

VBScript
Converting a VBScript program
Replies: 2Last Post April 5, 2005 9:33am by yourbrainonsaget
Welcome to LiveWire!
We're Stronger Together.
Join the Community
Single page for this topic Email Print Favorite
( mary21 )


Novice
Reply
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


9:26 am on April 5, 2005 | Joined: April 2005 | Days Active: 2
Join to learn more about mary21 Ireland | Posts: 2 | Points: 22
LiveWire Humor
pleaseremove


meh

Patron
Tech Support Leader
Reply
how much spare time do you think we have...

-------
Anyone who isn't confused really doesn't understand the situation
http://craigk.org/pictures/
Can you work out the code?

9:30 am on April 5, 2005 | Joined: Feb. 2005 | Days Active: 1,303
Join to learn more about pleaseremove England, United Kingdom | Straight Male | Posts: 5,944 | Points: 38,217
yourbrainonsaget


Soothsayer
Reply
Quote: from pleaseremove at 12:30 pm on April 5, 2005

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

really!

-------
All on top was a bucket and a mop, and an illustrated book about birds

9:33 am on April 5, 2005 | Joined: Oct. 2004 | Days Active: 969
Join to learn more about yourbrainonsaget Ohio, United States | Label Free Male | Posts: 3,392 | Points: 13,124
Single page for this topic Email Print Favorite

Quick Reply

You are signed in as our guest.

Looking for something else?
 

  LiveWire / Technical Forums / Programming & Application Development / Viewing Topic