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.