I need a function that returns a String, using the hardware serial numbers and mixing them together to obtain a single serial number.
I searched try a function like this but I can not find anything similar, this function need to identify a pc with a licensing system.
I only need a same value per computer.
This may not be exactly what you want but if i understand your question correctly, play around with the below code (Don't use the code below with Strict On) not the best of ideas but it works...
Private Function SystemSerialNumber() As String
' Get the Windows Management Instrumentation object.
Dim wmi As Object = GetObject("WinMgmts:")
' Get the "base boards" (mother boards).
Dim serial_numbers As String = ""
Dim mother_boards As Object = _
wmi.InstancesOf("Win32_BaseBoard")
For Each board As Object In mother_boards
serial_numbers &= ", " & board.SerialNumber
Next board
If serial_numbers.Length > 0 Then serial_numbers = _
serial_numbers.Substring(2)
Return serial_numbers
End Function
Private Function CpuId() As String
Dim computer As String = "."
Dim wmi As Object = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
computer & "\root\cimv2")
Dim processors As Object = wmi.ExecQuery("Select * from " & _
"Win32_Processor")
Dim cpu_ids As String = ""
For Each cpu As Object In processors
cpu_ids = cpu_ids & ", " & cpu.ProcessorId
Next cpu
If cpu_ids.Length > 0 Then cpu_ids = _
cpu_ids.Substring(2)
Return cpu_ids
End Function
Source:
http://www.vb-helper.com/howto_net_get_cpu_serial_number_id.html
Related
For processing orders we're using VBScripts to import them into accounting software. There are several suppliers, each with their own file format, mostly CSV and XML. The first step is to extract all the order lines (custom function per supplier), do some additional processing and then write it to the database, which is the same for all suppliers.
One new supplier uses Excel files with all the order lines in one sheet, except for the corresponding VAT percentage value which are available in another sheet. The VAT percentage per item can be looked up using the itemcode from the order sheet.
The company only has LibreOffice Calc and I understand you could do something like this in macro. However, it is a fully automated process and every other file is already handled by VBScript so I'd rather not make an exception or handle just this one order type manually (opening Calc and running the macro). So it has to be VBS and LibreOffice in this case.
Here is the VBScript code I have so far:
Option Explicit
' variables
Dim oSM, oDesk
Dim sFilename
Dim oDoc
Dim oSheet
Dim iLine
Dim sCode, iCount, sDesc, fCost, Perc
Set oSM = WScript.CreateObject("com.sun.star.ServiceManager")
Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
sFilename = "file:///C:/orders/import/supplier_orderlist_08-01-2019.xls"
set oDoc = oDesk.loadComponentFromURL( sFilename, "_blank", 0, Array() )
set oSheet = oDoc.getSheets().getByName("Orderlist")
For iLine = 11 to 12 ' testing first 2 lines
sCode = oSheet.getCellByPosition(1, iLine).getString()
iCount = oSheet.getCellByPosition(2, iLine).getString()
sDesc = oSheet.getCellByPosition(5, iLine).getString()
fCost = oSheet.getCellByPosition(8, iLine).getString()
'lookup doesn't work
Perc = Macro_VLOOKUP(sCode, oDoc)
WScript.Echo sCode & " - " & iCount & "x - " & sDesc & " => " & fCost & ", " & Perc & "%"
Next 'iLine
WScript.Quit 1
Function Macro_VLOOKUP(SearchValue, oDocGlob)
Dim oSheetLook, CellRange
Dim Column, Mode, svc, arg, Value
Set oSheetLook = oDocGlob.getSheets().getByName("Itemlisttotal")
Set CellRange = oSheetLook.getCellRangeByName("A1:B10000")
Column = 1
Mode = 0
svc = createUnoService("com.sun.star.sheet.FunctionAccess") '<- error: variable not defined
arg = Array(SearchValue, CellRange, Column, Mode)
Value = svc.callFunction("VLOOKUP", arg)
Macro_VLOOKUP = Value
End Function
It gives an error on the line with createUnoService:
Variable not defined 'createUnoService'
which is probably a LibreOffice Basic function and needs to be translated to the VBScript equivalent. There isn't much documentation or examples on this, so I can only guess, but Set svc = WScript.CreateObject("com.sun.star.sheet.FunctionAccess") also doesn't work and gives a "class name not found" error.
Is it possible to do a VLOOKUP (or something similar) from VBScript in LibreOffice Calc?
Or is there a way to evaluate a cell formula from a string at runtime?
I am trying to create a registry key and subkey for enabling IE 11 enterprise mode for all users on a machine. This is what I am using for my VBScript currently and it is failing horribly (does not add the key). I could use some assistance in getting this corrected.
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set ObjRegistry = _
GetObject("winmgmts:{impersonationLevel = impersonate}! \\" & _
strComputer & "\root\default:StdRegProv")
strPath = strKeyPath & "\" & strSubPath
strKeyPath = "Software\Policies\Microsoft"
strSubPath = "Internet Explorer\Main\EnterpriseMode"
strName = "Enabled"
ObjRegistry.CreateKey (HKEY_LOCAL_MACHINE, strPath)
ObjRegistry.SetStringValue HKEY_LOCAL_MACHINE, strPath, strName, strValue
MsgBox "Successfully enabled Internet Explorer Enterprise Mode."
End Function
There are several issues with your code, aside from the fact that you posted an incomplete code sample.
"winmgmts:{impersonationLevel = impersonate}! \\" & strComputer & "\root\default:StdRegProv"
The WMI moniker contains a spurious space between security settings and path (...! \\...). Remove it.
As a side note, it's pointless to use a variable for the hostname if that hostname never changes.
strPath = strKeyPath & "\" & strSubPath
You define strPath before you define the variables you build the path from. Also, your path components are defined as string literals, so you could drop the concatenation and the additional variables and simply define strPath as a string literal.
ObjRegistry.CreateKey (HKEY_LOCAL_MACHINE, strPath)
You must not put argument lists in parentheses unless you're calling the function/method/procedure in a subexpression context. See here for more details. However, you may want to check the return value of your method calls to see if they were successful.
And FTR, hungarian notation is pointless code bloat. Don't use it.
Modified code:
Function SetEnterpriseMode(value)
Const HKLM = &h80000002
Set reg = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv")
path = "Software\Policies\Microsoft\Internet Explorer\Main\EnterpriseMode"
name = "Enabled"
rc = reg.CreateKey(HKLM, path)
If rc <> 0 Then
MsgBox "Cannot create key (" & rc & ")."
Exit Function
End If
rc = reg.SetStringValue(HKLM, path, name, value)
If rc = 0 Then
MsgBox "Successfully enabled Internet Explorer Enterprise Mode."
Else
MsgBox "Cannot set value (" & rc & ")."
End If
End Function
I'm trying to get hold of running instances of MS Access 2010+ (on Win10) but the usual tip; GetObject(, "Access.Application") ... for works only for hidden instances started by myself with script, but not any instances started from GUI by the user.
And yes, I've read perhaps ten or more google hits on the subject, both on WMI and GetObject, but I seem to have missed something important.
However, I've tried the code below and I can get hold of any process of running Access instances in this way, and I can even .terminate() them, but, that's not what I want to do. Instead I want to grab the process and assign it to a usable (correct type) Access variable (see "OutInstance" in the code below) :
[Edit: Using WHERE clause, and skipped Exit as to retrieve the last instance]
Public Function GetRunningInstance(sAppName sComputer, ByRef OutInstance)
Dim oWMIService
Dim wProcesses
Dim oPrc
GetRunningInstance = False
Set OutInstance = Nothing
if sComputer = "" then sComputer = "."
Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=" & _
"impersonate}!\\" & sComputer & "\root\cimv2")
Set wProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process " & _
"WHERE Name = '" & sAppName & "'")
For Each oPrc in wProcesses
''' oPrc.Terminate() ''' Works, I can shut down Access...
Set OutInstance = oPrc
GetRunningInstance = True
''' By not exiting we get the last instance.
Next
End Function
Now, after trying to get hold of an instance, how do I "cast" the process to a usable Access application variable in this VBScript?
Sub Test_DoStuff()
Dim InstProc
Dim AccessApp
If GetRunningInstance("msaccess.exe", "127.0.0.1", InstProc) Then
Set AccessApp = ''' cast 'InstProc' to my "Access.Application" somehow?
Else
Set AccessApp = CreateObject("Access.Application")
End If
'''
''' Doing my stuff
'''
AccessApp.CloseCurrentDatabase
AccessApp.DoCmd.Quit
End Sub
Test
I (also) don't understand why GetObject(, "Access.Application") doesn't work in all cases. Permissions? (I understand that it's 'unsafe' to close a database currently being used by a user, but also that can be dealt with).
// Rolf
Hello question answering person of awesomeness!
I am trying to find a way to accurately verify if a Windows 7 machine is currently using an active license and activated. I believe I can initiate a 'cmd.exe' command to run a cscript (slmgr) and parse that information but that seems like an inefficient method.
I have came across an unmanaged windows API called SLGetGenuineInformation ( http://msdn.microsoft.com/en-us/library/windows/desktop/bb648650%28v=vs.85%29.aspx ) however I am not familiar with how to call this in VB.NET or what the variable types should be. I believe VB6 came with some sort of APIViewer that Visual STudio 2010 does not seem to contain.
All relevant Google searches turn up as unrelevant results.
Any suggestions, advice, or guidance on how to proceed or accomplish this goal?
Check this sample vb.net console app, that uses the SLIsGenuineLocal function.
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports SLID = System.Guid
Module Module1
Public Enum SL_GENUINE_STATE
SL_GEN_STATE_IS_GENUINE = 0
SL_GEN_STATE_INVALID_LICENSE = 1
SL_GEN_STATE_TAMPERED = 2
SL_GEN_STATE_LAST = 3
End Enum
<DllImportAttribute("Slwga.dll", EntryPoint:="SLIsGenuineLocal", CharSet:=CharSet.None, ExactSpelling:=False, SetLastError:=False, PreserveSig:=True, CallingConvention:=CallingConvention.Winapi, _
BestFitMapping:=False, ThrowOnUnmappableChar:=False)> _
<PreserveSigAttribute()> _
Friend Function SLIsGenuineLocal(ByRef slid As SLID, <[In](), Out()> ByRef genuineState As SL_GENUINE_STATE, ByVal val3 As IntPtr) As UInteger
End Function
Public Function IsGenuineWindows() As Boolean
Dim _IsGenuineWindows As Boolean = False
Dim ApplicationID As New Guid("55c92734-d682-4d71-983e-d6ec3f16059f")
'Application ID GUID http://technet.microsoft.com/en-us/library/dd772270.aspx
Dim windowsSlid As SLID = CType(ApplicationID, Guid)
Try
Dim genuineState As SL_GENUINE_STATE = SL_GENUINE_STATE.SL_GEN_STATE_LAST
Dim ResultInt As UInteger = SLIsGenuineLocal(windowsSlid, genuineState, IntPtr.Zero)
If ResultInt = 0 Then
_IsGenuineWindows = (genuineState = SL_GENUINE_STATE.SL_GEN_STATE_IS_GENUINE)
Else
Console.WriteLine("Error getting information {0}", ResultInt.ToString())
End If
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
Return _IsGenuineWindows
End Function
Sub Main()
If Environment.OSVersion.Version.Major >= 6 Then
'Version 6 can be Windows Vista, Windows Server 2008, or Windows 7
If IsGenuineWindows() Then
Console.WriteLine("Original Windows")
Else
Console.WriteLine("Not Original Windows")
End If
Else
Console.WriteLine("OS Not supoprted")
End If
Console.ReadLine()
End Sub
End Module
If it helps this is VC++ example
#include <slpublic.h>
#pragma comment(lib,"Slwga.lib")
bool IsWindowsGenuine()
{
GUID uid;
RPC_WSTR rpc=(RPC_WSTR)_T("55c92734-d682-4d71-983e-d6ec3f16059f");
UuidFromString(rpc,&uid);
SL_GENUINE_STATE state;
SLIsGenuineLocal(&uid,&state,NULL);
if(state==SL_GENUINE_STATE::SL_GEN_STATE_IS_GENUINE)
return true;
return false;
}
Here is VB Sript that does it:
trComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colWPA = objWMIService.ExecQuery _
("Select * from Win32_WindowsProductActivation")
For Each objWPA in colWPA
Wscript.Echo "Activation Required: " & objWPA.ActivationRequired
Wscript.Echo "Description: " & objWPA.Description
Wscript.Echo "Product ID: " & objWPA.ProductID
Wscript.Echo "Remaining Evaluation Period: " & _
objWPA.RemainingEvaluationPeriod
Wscript.Echo "Remaining Grace Period: " & objWPA.RemainingGracePeriod
Wscript.Echo "Server Name: " & objWPA.ServerName
Next
Source: How to check if a Windows version is Genuine or not?
If you want to read it directly from OS register you can read upon using VB to work whit register here: http://www.codeproject.com/KB/vb/registry_with_vb.aspx
I am pulling results back from WMI using WQL via VBScript.
In examples, a For Each loop is used to iterate over the results, but in each example, it is assumed that the property names are known. Case in point:
Set colInstalledPrinters = objWMIService.ExecQuery ("Select * from Win32_Printer Where Default = True")
For Each objPrinter in colInstalledPrinters
Wscript.Echo objPrinter.Name
Next
Some of the WMI classes have a very long list of properties associated with them. As an additional complication, some properties cannot be expected to be present (according to various webpages I have read about WMI). Rather than researching each WMI class and hoping that the properties listed are present, I would like to obtain a list of the properties (or columns, if I am thinking in SQL/WQL) present for, say, an objPrinter or any other returned item.
Python is my usual language but I cannot install it on the target machines in this instance; I can perform remote querying of WMI via Python but I am trying to trigger on an local event, hence falling back to VBScript. Although I gather Powershell might be able to do this, I would rather not learn it just this instant.
So, does VBScript support that level of introspection which would allow me to enumerate a list of properties? Or is there something I can do involving a schema I can reference and examine in-script?
Use the .Properties_ collection of the item:
Option Explicit
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Dim objWMIService
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Dim colItems
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_Printer" _
, "WQL" _
, wbemFlagReturnImmediately + wbemFlagForwardOnly _
)
Dim objItem
For Each objItem In colItems
Dim oProp
For Each oProp In objItem.Properties_
WScript.Echo oProp.Name, TypeName( oProp.Value ), ToString( oProp.Value )
Next
WScript.Echo
Next
Function ToString( vX )
ToString = "!! work to do !!"
On Error Resume Next
ToString = CStr( vX )
On Error GoTo 0
End Function
Output:
...
MimeTypesSupported Null !! work to do !!
Name String Auto HP LaserJet 5 on WINXP2
NaturalLanguagesSupported Null !! work to do !!
Network Boolean False
PaperSizesSupported Variant() !! work to do !!
...
Obviously, the ToString() function needs further work.