Find Model Number VBS

**marcusj0015** · April 1, 2011

this code finds the manufacturer of the computer


'-> Varibles And Objects
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Wmi :Set Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Dim Chk, Col, I, Obj, Reg
  Chk = False
  Reg = Act.ExpandEnvironmentStrings("%Systemroot%\OOBE\OEM\")
'-> Array To Hold Manufacture Name
 Col = Array("Acer","Apple","ASUS","eMachine","Gateway","HP","Toshiba")
'-> Wmi Querry For Computer Manufacture
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
     For Each I In Col
       If InStr(1,Obj.Manufacturer,I,1) Then
        RegFileAdd(I)
        Chk = True
      End If
     Next
    Next
'-> If There Was No Matching Manufacture
    If Chk = False Then
     MsgBox "Can Not Determine The Computer Model", 4128,"Undetermine Computer Model"
    End If
'-> Function To Add The Registry File
   Function RegFileAdd(Name)
     Reg = Reg & Name & "\" & Name & ".reg"
     If Fso.FileExists(Reg) Then
      Act.Run("Regedit /S " & Reg),1,True
     Else
      MsgBox "Error Can Not Find This File" & vbCrLf & _
              Reg, 4128,"Reg File Missing"
     End If
   End Function

but i have 3 acer computers, so i need the script to find the manufacturer & model number, then load the correct reg file (for computer branding purposes)

but i want it to me autmatic, so it can find the manufacturer & model number and install that info , so if i get another computer, i can use the same disc, without having to add more custom brainding, basically is there a way for the vbs file to install the manufactor and model number on it's own, without seperate reg files?

**IcemanND** · April 2, 2011

strComputer = inputbox("Type a computer name","Enter computer name") 
if strComputer = "" then strComputer = "." 
On Error Resume Next 
Const wbemFlagReturnImmediately = &h10 
Const wbemFlagForwardOnly = &h20 
WScript.Echo 
WScript.Echo "==========================================" 
WScript.Echo "Computer: " & strComputer 
WScript.Echo "==========================================" 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set colItems = objWMIService.ExecQuery("SELECT * FROM " _  & "Win32_ComputerSystem", "WQL", wbemFlagReturnImmediately _  + wbemFlagForwardOnly)
For Each objItem In colItems
   WScript.Echo "Manufacturer: " & objItem.Manufacturer   
   WScript.Echo "Model: " & objItem.Model 
Next

**marcusj0015** · April 2, 2011

IcemanND

can you fix the formating?

i have no clue what goes on each line

**IcemanND** · April 2, 2011

Grr. Sorry about that. Looked fine when I hit submit, didn't look at it after that.

**marcusj0015** · April 2, 2011

thanks!

is there any way to print the output to a file or the console window? so i can see exactly what it says? preferabbly a log file

it says error code 1, line 11 char 60

Edited April 2, 2011 by marcusj0015

**gunsmokingman** · April 2, 2011

Here I wrote this script

1:\ Run in Cscript and all output in cmd window.

2:\ Gets User Input For IP Address Or Computer Name

3:\ Ping Computer

4:\ Ask to save the results.

Save As PingScan.vbs


Option Explicit 
 Dim L, Obj, Report, Str, Wmi
 L = "----------------------------------------------"
'-> Check To Make Sure It Run Under Cscript Only
  For Each Obj In GetObject("winmgmts:\\.\root\cimv2").ExecQuery( _
  "SELECT * FROM Win32_Process WHERE Name='cscript.exe' OR Name='wscript.exe'")
   If InStr(1,Obj.CommandLine,"cscript",1) And _
      InStr(1,Obj.CommandLine,WScript.ScriptFullName,1) Then
    GetUserInput()
   Else
    MsgBox Chr(187) & _
      Space(3) & "ERROR : Wrong Script Engine" & vbCrLf & _
      "Script Was Ment To Be Run Under" & vbCrLf & _
      "Cscript Engine. Right Click This" & vbCrLf & _
      "Script Select Cmd Prompt",4128,"Error Wrong Script Engine" 
   End If 
  Next
'-> Get The Ip Address Or Computer Name
   Function GetUserInput()
    Wscript.StdOut.Write _
    Chr(187) & " Type Exit Or Quit To Do Nothing" & vbCrLf & _
    Chr(187) & " Type In The Computer Name Or Ip " & vbCrLf & _
               "Address,That You Want To Connect : " & vbCrLf
     Str = Wscript.StdIn.ReadLine
    If InStr(1,Str,"exit",1) Or _
       InStr(1,Str,"quit",1) Then
       WScript.Quit 
    ElseIf Len(Str) = 0 Then
     WScript.StdOut.WriteBlankLines(25)
     Wscript.StdOut.Write _
     "User Input Required" & vbCrLf & _
     "This Will Reload User Input In 3 Seconds"
     WScript.Sleep 3000
     WScript.StdOut.WriteBlankLines(25)
     GetUserInput()
    Else
     PingComputer(Str)
    End If
   End Function
'-> Ping Computer Run On XP And Up
   Function PingComputer(Ping)
    For Each Obj In GetObject("winmgmts:\\.\root\cimv2").ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & Ping & "'")
     If IsNull(Obj.StatusCode) Or Obj.StatusCode <> 0 Then 
'-> Code Here If Computer Does Not Replies
     Report = L & vbCrLf & _ 
      "No Reply : " & Ping & vbCrLf & _
      "Date     : " & Date & vbCrLf & _
      "Time     : " & Time
      TheReport()
     Else
'-> Code Here If Computer Replies
    Set Wmi = GetObject("winmgmts:\\" & Ping & "\root\cimv2") 
      MakeModel(Ping)
     End If
    Next
   End Function
'-> Computer Name Make Model
   Function MakeModel(Computer)
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
     Report = L & vbCrLf & _     
      "Name  : " & Obj.Name & vbCrLf & _
      "Make  : " & Obj.Model & vbCrLf & _
      "Model : " & Obj.Manufacturer & vbCrLf & _
      "Date  : " & Date & vbCrLf & _
      "Time  : " & Time
      TheReport()
    Next
   End Function
'-> Save Information
   Function TheReport()
    WScript.StdOut.WriteLine Report & vbCrLf & L 
    Wscript.StdOut.WriteLine _
    "Did You Want To Save This To A Text File?" & vbCrLf & _
    "Yes To Save The Information No To Close" & vbCrLf & _
    "Or Press Enter To Close And Not Save" & vbCrLf & L & vbCrLf 
     Str = Wscript.StdIn.ReadLine
    If InStr(1,Str,"No",1) Then WScript.Quit 
    If Len(Str) = 0 Then WScript.Quit
    If InStr(1,Str,"yes",1) Then
     Dim Act :Set Act = CreateObject("Wscript.Shell")
     Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
     Dim F, Ts
     F = Act.SpecialFolders("DeskTop") & "\Result.txt"
     Set Ts = Fso.CreateTextFile(F)
     Ts.WriteLine Report
     Ts.Close
     Act.Run("Notepad.exe " & Chr(34) & F & Chr(34)),1,False 
     WScript.Quit 
    End If 
   End Function

Just rename the file from PingScan.vbs.txt to PingScan.vbs to make active script.

PingScan.vbs.txt

**Yzöwl** · April 2, 2011

thanks!
is there any way to print the output to a file or the console window? so i can see exactly what it says? preferabbly a log file
it says error code 1, line 11 char 60

Thats because there was still a formatting problem, here it is again fixed.

strComputer = inputbox("Type a computer name","Enter computer name") 
if strComputer = "" then strComputer = "." 
On Error Resume Next 
Const wbemFlagReturnImmediately = &h10 
Const wbemFlagForwardOnly = &h20 
WScript.Echo 
WScript.Echo "==========================================" 
WScript.Echo "Computer: " & strComputer 
WScript.Echo "==========================================" 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set colItems = _
	objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _
	wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
	WScript.Echo "Manufacturer: " & objItem.Manufacturer   
	WScript.Echo "Model: " & objItem.Model 
Next

**gunsmokingman** · April 2, 2011

I re did the original script, I made it a few lines smaller

PingScan_1.vbs


Option Explicit 
Dim L, Obj, Rpt, Str, Wmi
 L = "----------------------------------------------"
'-> Make Sure Correct Engine Cscript Is Active
    If InStr(1,WScript.FullName,"cscript",1) Then
    CorrectEng(WScript.FullName)
    ElseIf InStr(1,WScript.FullName,"wscript",1) Then
     WrongEng("Wscript.exe")
    End If
'-> Wrong Script Engine Wscript
   Function WrongEng(Wrong)
    Dim E :E = " Error : Wrong Scripting Engine"
    MsgBox Space(3) & Chr(187) & E & vbCrLf & _
    "This " & Wrong & " Is Not The Correct Engine" & vbCrLf & _
    vbCrLf & "To Run This Script, Right Click And Select" & _
    vbCrLf & "The Cmd Prompt As The Script Engine",4128,E    
   End Function
'-> Correct Script Engine Wscript
   Function CorrectEng(Correct)
    Do While Str = ""
     WScript.StdOut.WriteLine L
     WScript.StdOut.WriteLine "Type In The Computer Name Or Ip Address"
     WScript.StdOut.WriteLine "That You Want To Connect To. Type Either" 
     WScript.StdOut.WriteLine "Exit Or Quit To Do Nothing"
     WScript.StdOut.WriteLine L & vbCrLf 
     Str = Wscript.StdIn.ReadLine
     If InStr(1,Str,"Exit",1) Or InStr(1,Str,"quit",1) Then WScript.Quit 
     If Len(Str) >= 1 Then PingComputer(Str)
    Loop
   End Function
'-> Ping Computer For XP And Up 
   Function PingComputer(Ping)
    For Each Obj In GetObject("winmgmts:\\.\root\cimv2").ExecQuery _
    ("Select * From Win32_PingStatus where Address = '" & Ping & "'")
     If IsNull(Obj.StatusCode) Or Obj.StatusCode <> 0 Then
'-> No Reply
      Rpt = L & vbCrLf & _ 
      "No Reply : " & Ping & vbCrLf & _
      "Date     : " & Date & vbCrLf & _
      "Time     : " & Time & vbCrLf & L
      TheReport()
     Else
'-> Yes Reply
      Set Wmi = GetObject( _
      "winmgmts:{impersonationLevel=impersonate}!\\" & Ping & "\root\cimv2")
      MakeModel(Ping) 
     End If
    Next
   End Function
'-> Computer Name Make Model
   Function MakeModel(Computer)
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
     Rpt = L & vbCrLf & _     
      "Name  : " & Obj.Name & vbCrLf & _
      "Make  : " & Obj.Model & vbCrLf & _
      "Model : " & Obj.Manufacturer & vbCrLf & _
      "Date  : " & Date & vbCrLf & _
      "Time  : " & Time & vbCrLf & L
     TheReport()
    Next
   End Function
'-> Save Information
   Function TheReport()
    WScript.StdOut.WriteLine Rpt & vbCrLf & L 
    Wscript.StdOut.WriteLine _
    "Did You Want To Save This To A Text File?" & vbCrLf & _
    "Yes To Save The Information No To Close" & vbCrLf & _
    "Or Press Enter To Close And Not Save" & vbCrLf & L & vbCrLf 
     Str = Wscript.StdIn.ReadLine
    If InStr(1,Str,"No",1) Then WScript.Quit 
    If Len(Str) = 0 Then WScript.Quit
    If InStr(1,Str,"yes",1) Then
     Dim Act :Set Act = CreateObject("Wscript.Shell")
     Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
     Dim F, Ts
     F = Act.SpecialFolders("DeskTop") & "\Result.txt"
     Set Ts = Fso.CreateTextFile(F)
     Ts.WriteLine Rpt
     Ts.Close
     Act.Run("Notepad.exe " & Chr(34) & F & Chr(34)),1,False 
     WScript.Quit 
    End If 
   End Function

Rename PingScan_1.vbs.txt to PingScan_1.vbs to make active

PingScan_1.vbs.txt

**marcusj0015** · April 4, 2011

i'm not going to be using this scriopt over a network, it will just run straight from DVD, is there anyway to remove the enter computer name part?

i want this to be automatic, and i want it to write the results to a log file

**gunsmokingman** · April 4, 2011

i'm not going to be using this scriopt over a network, it will just run straight from DVD, is there anyway to remove the enter computer name part?
i want this to be automatic, and i want it to write the results to a log file

Scan.vbs

Dim L, Obj, Rpt, Str, Wmi
 L = "----------------------------------------------"
'-> Make Sure Correct Engine Cscript Is Active
  If InStr(1,WScript.FullName,"cscript",1) Then
   CorrectEng(WScript.FullName)
  ElseIf InStr(1,WScript.FullName,"wscript",1) Then
   WrongEng("Wscript.exe")
  End If
'-> Wrong Script Engine Wscript
   Function WrongEng(Wrong)
    Dim E :E = " Error : Wrong Scripting Engine"
    MsgBox Space(3) & Chr(187) & E & vbCrLf & _
    "This " & Wrong & " Is Not The Correct Engine" & vbCrLf & _
    vbCrLf & "To Run This Script, Right Click And Select" & _
    vbCrLf & "The Cmd Prompt As The Script Engine",4128,E    
   End Function
'-> Correct Script Engine Wscript
   Function CorrectEng(Correct)
    Set Wmi = GetObject("winmgmts:" & _
              "{impersonationLevel=impersonate}!\\.\root\cimv2")   
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
     Rpt = L & vbCrLf & _     
      "Computer Name  : " & Obj.Name & vbCrLf & _
      "Computer Make  : " & Obj.Model & vbCrLf & _
      "Computer Model : " & Obj.Manufacturer & vbCrLf & _
      "Scan Date      : " & Date & vbCrLf & _
      "Scan Time      : " & Time & vbCrLf & L
     TheReport(Obj.Name)
    Next
   End Function
'-> Save Information
   Function TheReport(Cmp)
    Dim Act :Set Act = CreateObject("Wscript.Shell")
    Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
    Dim F, Ts
     F = Act.SpecialFolders("DeskTop") & "\" & Cmp & "_Result.txt"
    Set Ts = Fso.CreateTextFile(F)
     Ts.WriteLine Rpt
     Ts.Close
     Act.Run("Notepad.exe " & Chr(34) & F & Chr(34)),1,False 
    WScript.Quit 
   End Function

Change Scan.vbs.txt to Scan.vbs ro maje active script

Scan.vbs.txt

**marcusj0015** · April 8, 2011

Thanks! i really appreciate you going the extra mile to perfect your script, thanks man!

**gunsmokingman** · April 8, 2011

You are welcome and glad to help.

Sign In

Find Model Number VBS

Recommended Posts

marcusj0015

IcemanND

marcusj0015

IcemanND

marcusj0015

gunsmokingman

Yzöwl

gunsmokingman

marcusj0015

gunsmokingman

marcusj0015

gunsmokingman

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members

Activity

Browse