Script sharing

Get help on programming - C++, Java, Delphi, etc.
Post Reply
DeeVeeDee
Registered User
Posts: 172
Joined: 09 Apr 2010, 15:18

Script sharing

Post by DeeVeeDee »

Hi Have you got some handy vbs scripts to share ?

The following creates a CSV file with the [username],[modelname],[serial],[manufacturer],[computername]
in C:\systeminfo.csv from there you can copy it to a network location using a batch file or logon script.
Ive tested this in a bunch of HPs and DELLs, works fine , except for one hp computer.

Very useful for asset management

Code: Select all

Dim txtData, myFSO, WriteStuff
Dim MyModelName
Dim MySerial
Dim MyManufacturer
Dim MyComputername
Dim StrUserName
strComputer = "127.0.0.1"
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings 
'Wscript.Echo "System Manufacturer: " & objComputer.Manufacturer
	MyManufacturer = objComputer.Manufacturer
    'Wscript.Echo "System Model: " & objComputer.Model
	
    MyModelName = objComputer.Model
	'Wscript.Echo "System Name: " & objComputer.Name
   MyComputername = objComputer.Name
Next
strComputer = "127.0.0.1"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSMBIOS = objWMIService.ExecQuery _
("Select * from Win32_SystemEnclosure")
For Each objSMBIOS in colSMBIOS
'Wscript.Echo "Serial Number: " & objSMBIOS.SerialNumber
MySerial = objSMBIOS.SerialNumber
Next
Set objNetwork = WScript.CreateObject("WScript.Network")
strUserName = objNetwork.UserName 
'Open up the path to save the information into a text file
'Write information to Text File
txtData =  strUserName & "," & MyModelName & "," & MySerial & "," & MyManufacturer & "," & MyComputername
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set WriteStuff = myFSO.OpenTextFile("C:\systeminfo.csv", 8, True)
WriteStuff.WriteLine(txtData)
WriteStuff.Close
SET WriteStuff = NOTHING
SET myFSO = NOTHING
_̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡
User avatar
hamin_aus
Forum Moderator
Posts: 18363
Joined: 28 Aug 2003, 02:00
Processor: Intel i7 3770K
Motherboard: GA-Z77X-UP4 TH
Graphics card: Galax GTX1080
Memory: 32GB G.Skill Ripjaws
Location: Where beer does flow and men chunder
Contact:

Re: Script sharing

Post by hamin_aus »

Nice idea!

The following script will send an email with an attachment - you must have a mail server set up for anonymous relay

Code: Select all

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "EMAIL"
objMessage.From = "yourname@yourdomain.co.za"
objMessage.To = "jamin_za@pcf.co.za;DeeVeeDee@pcf.co.za;"
objMessage.TextBody = "Please see attachment"
objMessage.AddAttachment "C:\attachment.txt"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "127.0.0.1"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update
objMessage.Send
The following script will output a list of all users in a specific OU in AD to a CSV file

Code: Select all


Dim arrNames()
Dim intSize 
intSize = 0

Dim oFilesys, oFiletxt, sFilename, sPath

Set oFilesys = CreateObject("Scripting.FileSystemObject")
'Set your file location
Set oFiletxt = oFilesys.CreateTextFile("C:\Names.csv", True)
sPath = oFilesys.GetAbsolutePathName("C:\Names.csv")
sFilename = oFilesys.GetFileName(sPath) 

'Set your AD path here: this will vary depending on your set up
'The sample code blow is for an OU named "YOUR-OU" sitting 
'in "Security Groups" on the "YOURDOMAIN.root" network

Set objGroup = GetObject("LDAP://CN=YOUR-OU,OU=Security Groups,DC=YOURDOMAIN,dc=root")

For Each strUser in objGroup.Member
    Set objUser =  GetObject("LDAP://" & strUser)
    ReDim Preserve arrNames(intSize)
    arrNames(intSize) = objUser.CN
    intSize = intSize + 1
Next

For i = (UBound(arrNames) - 1) to 0 Step -1
    For j= 0 to i
        If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
            strHolder = arrNames(j+1)
            arrNames(j+1) = arrNames(j)
            arrNames(j) = strHolder
        End If
    Next
Next 

For Each strName in arrNames
    oFiletxt.WriteLine(strName)
    
    'Wscript.Echo strName
Next

oFiletxt.Close
This script will tell you the last login date for every user account in AD.
The origional script is not mine, but I edited it to output the list as a CSV file to a location of your choosing.

Code: Select all

' LastLogon.vbs
' VBScript program to determine when each user in the domain last logged
' on.
'
' ----------------------------------------------------------------------
' Copyright (c) 2002 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - December 7, 2002
' Version 1.1 - January 17, 2003 - Account for null value for lastLogon.
' Version 1.2 - January 23, 2003 - Account for DC not available.
' Version 1.3 - February 3, 2003 - Retrieve users but not contacts.
' Version 1.4 - February 19, 2003 - Standardize Hungarian notation.
' Version 1.5 - March 11, 2003 - Remove SearchScope property.
' Version 1.6 - May 9, 2003 - Account for error in IADsLargeInteger
'                             property methods HighPart and LowPart.
' Version 1.7 - January 25, 2004 - Modify error trapping.
' Version 1.8 - July 6, 2007 - Modify how IADsLargeInteger interface
'                              is invoked.
' Version 1.9 - December 29, 2009 - Output "Never" if no date.
'
' Because the lastLogon attribute is not replicated, every Domain
' Controller in the domain must be queried to find the latest lastLogon
' date for each user. The lastest date found is kept in a dictionary
' object. The program first uses ADO to search the domain for all Domain
' Controllers. The AdsPath of each Domain Controller is saved in an
' array. Then, for each Domain Controller, ADO is used to search the
' copy of Active Directory on that Domain Controller for all user
' objects and return the lastLogon attribute. The lastLogon attribute is
' a 64-bit number representing the number of 100 nanosecond intervals
' since 12:00 am January 1, 1601. This value is converted to a date. The
' last logon date is in UTC (Coordinated Univeral Time). It must be
' adjusted by the Time Zone bias in the machine registry to convert to
' local time.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
Dim adoRecordset, objDC
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, objList, strUser
Dim strBase, strFilter, strAttributes, lngHigh, lngLow


'Set your output file location
Dim oFilesys, oFiletxt, sFilename, sPath
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile("C:\Last login.csv", True)
sPath = oFilesys.GetAbsolutePathName("C:\Last login.csv")
sFilename = oFilesys.GetFileName(sPath) 


' Use a dictionary object to track latest lastLogon for each user.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Obtain local Time Zone bias from machine registry.
' This bias changes with Daylight Savings Time.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    & "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    lngBias = 0
    For k = 0 To UBound(lngBiasKey)
        lngBias = lngBias + (lngBiasKey(k) * 256^k)
    Next
End If

' Determine configuration context and DNS domain from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory for ObjectClass nTDSDSA.
' This will identify all Domain Controllers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until adoRecordset.EOF
    Set objDC = _
        GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
    ReDim Preserve arrstrDCs(k)
    arrstrDCs(k) = objDC.DNSHostName
    k = k + 1
    adoRecordset.MoveNext
Loop
adoRecordset.Close

' Retrieve lastLogon attribute for each user on each Domain Controller.
For k = 0 To Ubound(arrstrDCs)
    strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
    strFilter = "(&(objectCategory=person)(objectClass=user))"
    strAttributes = "distinguishedName,lastLogon"
    strQuery = strBase & ";" & strFilter & ";" & strAttributes _
        & ";subtree"
    adoCommand.CommandText = strQuery
    On Error Resume Next
    Set adoRecordset = adoCommand.Execute
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
    Else
        On Error GoTo 0
        Do Until adoRecordset.EOF
            strDN = adoRecordset.Fields("distinguishedName").Value
            On Error Resume Next
            Set objDate = adoRecordset.Fields("lastLogon").Value
            If (Err.Number <> 0) Then
                On Error GoTo 0
                dtmDate = #1/1/1601#
            Else
                On Error GoTo 0
                lngHigh = objDate.HighPart
                lngLow = objDate.LowPart
                If (lngLow < 0) Then
                    lngHigh = lngHigh + 1
                End If
                If (lngHigh = 0) And (lngLow = 0) Then
                    dtmDate = #1/1/1601#
                Else
                    dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
                        + lngLow)/600000000 - lngBias)/1440
                End If
            End If
            If (objList.Exists(strDN) = True) Then
                If (dtmDate > objList(strDN)) Then
                    objList.Item(strDN) = dtmDate
                End If
            Else
                objList.Add strDN, dtmDate
            End If
            adoRecordset.MoveNext
        Loop
        adoRecordset.Close
    End If
Next

' Output latest lastLogon date for each user.
For Each strUser In objList.Keys
       oFiletxt.WriteLine(strUser & "," & objList.Item(strUser))
Next

' Clean up.

oFiletxt.Close

adoConnection.Close
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing
Set adoRecordset = Nothing
Set objDC = Nothing
Set objDate = Nothing
Set objList = Nothing
Set objShell = Nothing
I'll update some more when I have time...
Image
DeeVeeDee
Registered User
Posts: 172
Joined: 09 Apr 2010, 15:18

Re: Script sharing

Post by DeeVeeDee »

Thanks!, I can make use of those.

The below script is something i got off the net but modified it to create a file called installedapps.txt
It takes a snapshot of the applications registered in "add & remove" I have been using this for more than a year and in my environment it has not given me any trouble.
Works well to see if people has illegal software and games installed. unfortunately this does not include portable applications.

Code: Select all

strComputer="."



dim fs
dim fictxt




set fs=createobject("Scripting.FileSystemObject")
set fictxt=fs.opentextfile("C:\InstalldAPPs.txt",2,true)

Const BASE_KEY = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
Const HKLM = &H80000002
Dim strDisplayName
Dim strDisplayVersion
Dim strInstallLocation
Dim strDisplayVersionMajor
Dim strDisplayVersionMinor
Dim strInstallDate
Dim strInstallFrom
Dim lngRtn
Dim astrSubKeys
Dim strKey
Dim vntTmp

Dim j
Dim colsoftware
Dim objsoftware

ReDim vntTmp(5)

debTitre = indiceLg
indiceLg = indiceLg + 2

on error resume next
err.clear


'**************** Registry ***********************



on error resume next
err.clear

Set colsoftware = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

lngRtn = colsoftware.EnumKey(HKLM, BASE_KEY, astrSubKeys)

If Err.Number <> 0 Then
fictxt.writeline "Connexion error " & strComputer
on error goto 0
Else
on error goto 0

For Each strKey In astrSubKeys

strDisplayName = vbNullString
strDisplayVersion = vbNullString
strInstallLocation = vbNullString
strDisplayVersionMajor = vbNullString
strDisplayVersionMinor = vbNullString
strInstallDate = vbNullString
strInstallFrom = vbNullString

' ---------------------------------------
' Get the display name
' ---------------------------------------

Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
strUserName = objNetwork.UserName

lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "DisplayName", strDisplayName)

' If blank, try "Quiet Name
If Trim(strDisplayName) = vbNullString Then
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "QuietDisplayName", strDisplayName)
End If

' If other 2 fail, use the key name
If Trim(strDisplayName) = vbNullString Then
strDisplayName = strKey
End If



if isnull(strDisplayName) then vntTmp(1)="" else vntTmp(1) = strUserName & "     " & strDisplayName

' ---------------------------------------
' Get the Display version or alternate
' ---------------------------------------
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "DisplayVersion", strDisplayVersion)

' Else, concatenate the version info
If Trim(strDisplayVersion) = vbNullString Then
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "VersionMajor", strDisplayVersionMajor)
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "VersionMinor", strDisplayVersionMinor)
strDisplayVersion = strDisplayVersionMajor & "." & strDisplayVersionMinor
End If

' If all else fails, try just the "Version" string
If Trim(strDisplayVersionMajor) = vbNullString Then
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "Version", strDisplayVersion)
End If

if isnull(strDisplayVersion) then vntTmp(2)="" else vntTmp(2) = strDisplayVersion

' ---------------------------------------
' Get the installatin location
' ---------------------------------------
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "InstallLocation", strInstallLocation)

If Trim(strInstallLocation) = vbNullString Then
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "UninstallString", strInstallLocation)
End If

if isnull(strInstallLocation) then vntTmp(3)="" else vntTmp(3) = strInstallLocation

' ---------------------------------------
' Get the installation Date
' ---------------------------------------
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "InstallDate", strInstallDate)

If Len(Trim(strInstallDate)) > 0 Then
if isnull(strInstallDate) then vntTmp(4)="" else vntTmp(4)=strInstallDate
End If

' ---------------------------------------
' Get the install-from location
' ---------------------------------------
lngRtn = colsoftware.GetStringValue(HKLM, BASE_KEY & strKey, "InstallSource", strInstallFrom)
if isnull(strInstallFrom) then vntTmp(5) ="" else vntTmp(5)=strInstallFrom

' ---------------------------------------
' Export Excel
' ---------------------------------------
on error resume next


If Trim(vntTmp(1)) <> vbNullString And InStr(vntTmp(1), "{") = 0 Then
fictxt.writeline vntTmp(1) & space(100-len(vntTmp(1))) & _
vntTmp(4) & space(80-len(vntTmp(4))) & _
vntTmp(3) & space(110-len(vntTmp(3))) & _
vntTmp(5) & space(80-len(vntTmp(5))) & _
vntTmp(2) & space(80-len(vntTmp(2)))

End If

Next

End If


Set colsoftware = Nothing
Set objWMIService = Nothing

fictxt.close

set fictxt=nothing
set fs=nothing


By the way this seems like a good idea but wont this thread maybe clutter PCF database ? cus some scripts can be quite long ?
_̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡
User avatar
hamin_aus
Forum Moderator
Posts: 18363
Joined: 28 Aug 2003, 02:00
Processor: Intel i7 3770K
Motherboard: GA-Z77X-UP4 TH
Graphics card: Galax GTX1080
Memory: 32GB G.Skill Ripjaws
Location: Where beer does flow and men chunder
Contact:

Re: Script sharing

Post by hamin_aus »

DeeVeeDee wrote:By the way this seems like a good idea but wont this thread maybe clutter PCF database ? cus some scripts can be quite long ?
Image
Image
DeeVeeDee
Registered User
Posts: 172
Joined: 09 Apr 2010, 15:18

Re: Script sharing

Post by DeeVeeDee »

LOL ok
_̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡
Post Reply