• Announcements

    • xper

      MSFN Sponsorship and AdBlockers!   07/10/2016

      Dear members, MSFN is made available via subscriptions, donations and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, become a site sponsor and ads will be disabled automatically and by subscribing you get other sponsor benefits.
marcusj0015

Find Model Number VBS

12 posts in this topic

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?

0

Share this post


Link to post
Share on other sites
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

0

Share this post


Link to post
Share on other sites

IcemanND

can you fix the formating?

i have no clue what goes on each line

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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 by marcusj0015
0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

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

0

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!


Register a new account

Sign in

Already have an account? Sign in here.


Sign In Now

  • Recently Browsing   0 members

    No registered users viewing this page.