VBS – Delete Old Accounts


‘********************************************************************
‘* File: DELOLD.VBS
‘* Created: February 2003 – Baris Eris
‘* Version: 1.0
‘* Main Function: Displays accounts older than n days and prompts for permanent deletion.
‘* Usage: DELOLD.VBS /N:Days [/U:username] [/W:password] [/D:domain] [/S:server] [/C:] [/F:file name] [/Q]
‘* Copyright (C) 2002 Microsoft Corporation
‘*
‘********************************************************************

OPTION EXPLICIT
‘ON ERROR RESUME NEXT

‘Define constants
CONST CONST_STRING_NOT_FOUND = -1
CONST CONST_ERROR = 0
CONST CONST_WSCRIPT = 1
CONST CONST_CSCRIPT = 2
CONST CONST_SHOW_USAGE = 3
CONST CONST_PROCEED = 4

CONST ForWriting = 2
CONST ForAppending = 8

CONST ADS_OBJECT_NOTFOUND = &H80072030
CONST ADS_ATTRIBUTE_NOTFOUND = &H8007000A

‘Declare variables
Dim strFile, strCurrentUser, strPassword, blnQuiet, intOpMode, i
Dim strArgumentArray, strServer, strDomain, strClass, iDays
Dim ObjOU_1
Dim Hilmi
ReDim strArgumentArray(0)

‘Initialize variables
intOpMode = 0
blnQuiet = False
Hilmi=""
strFile = ""
strCurrentUser = ""
strPassword = ""
strServer = ""
strDomain = ""
strClass = ""
strArgumentArray(0) = ""
iDays = 0

‘Get the command line arguments
For i = 0 to Wscript.arguments.count – 1
ReDim Preserve strArgumentArray(i)
strArgumentArray(i) = Wscript.arguments.item(i)
Next

‘Check whether the script is run using CScript
Select Case intChkProgram()
Case CONST_CSCRIPT
‘Do Nothing
Case CONST_WSCRIPT
WScript.Echo "Please run this script using CScript." & vbCRLF & _
"This can be achieved by" & vbCRLF & _
"1. Using ""CScript DISPLAYOLD.VBS arguments"" for Windows 95/98 or" & vbCRLF & _
"2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
" using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
" ""DISPLAYOLD.VBS arguments"" for Windows NT."
WScript.Quit
Case Else
WScript.Quit
End Select

‘Parse the command line
intOpMode = intParseCmdLine(strArgumentArray, strCurrentUser, strPassword, blnQuiet, strServer, strFile, strClass, iDays)
If Err.Number Then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
If Err.Description <> "" Then Print "Error description: " & Err.Description
WScript.quit
End If

Select Case intOpMode
Case CONST_SHOW_USAGE
Call ShowUsage()
Case CONST_PROCEED
Call DISPLAYOLD(strServer, strDomain, strCurrentUser, strPassword, blnQuiet, strFile, strClass, iDays)
Case CONST_ERROR
‘Do nothing.
Case Else
Wscript.Echo "Error occurred in passing parameters."
End Select

WScript.Quit

‘********************************************************************
‘*
‘* Function intChkProgram()
‘* Purpose: Determines which program is used to run this script.
‘* Input: None
‘* Output: intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
‘* and CONST_CSCRIPT.
‘*
‘********************************************************************

Private Function intChkProgram()

‘ON ERROR RESUME NEXT

Dim strFullName, strCommand, i, j

‘strFullName should be something like C:WINDOWSCOMMANDCSCRIPT.EXE
strFullName = WScript.FullName
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
If Err.Description <> "" Then Print "Error description: " & Err.Description
intChkProgram = CONST_ERROR
Exit Function
End If

i = InStr(1, strFullName, ".exe", 1)
If i = 0 Then
intChkProgram = CONST_ERROR
Exit Function
Else
j = InStrRev(strFullName, "", i, 1)
If j = 0 Then
intChkProgram = CONST_ERROR
Exit Function
Else
strCommand = Mid(strFullName, j+1, i-j-1)
Select Case LCase(strCommand)
Case "cscript"
intChkProgram = CONST_CSCRIPT
Case "wscript"
intChkProgram = CONST_WSCRIPT
Case Else ‘should never happen
Print "An unexpected program is used to run this script."
Print "Only CScript.Exe or WScript.Exe can be used to run this script."
intChkProgram = CONST_ERROR
End Select
End If
End If

End Function

‘********************************************************************
‘*
‘* Function intParseCmdLine()
‘* Purpose: Parses the command line.
‘* Input: strArgumentArray an array containing input from the command line
‘* Output: strPolicy the name of the policy object
‘* strFile the input file name including the path
‘* strCurrentUser the name or cn of the current user
‘* strPassword the current user password
‘* blnQuiet specifies whether to suppress messages
‘* strServer server name
‘* strFile the name of the output file
‘* iDays the number of days to search for old objects
‘* intParseCmdLine is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
‘*
‘********************************************************************

Private Function intParseCmdLine(strArgumentArray, strCurrentUser,strPassword, blnQuiet, strServer, strFile, strClass, iDays)

‘ON ERROR RESUME NEXT

Dim i, j, strFlag

intParseCmdLine = CONST_ERROR

strFlag = strArgumentArray(0)
If strFlag = "" then ‘No arguments have been received
Print "Number of days omitted from command line."
intParseCmdLine = CONST_SHOW_USAGE
Exit Function
End If

‘online help was requested
If (strFlag="/help") OR (strFlag="/HELP") OR (strFlag="/h") OR (strFlag="h") OR (strFlag="-h") _
OR (strFlag = "?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
intParseCmdLine = CONST_SHOW_USAGE
Exit Function
End If

j = 0
For i = 0 to UBound(strArgumentArray)
strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
If Err.Number Then ‘An error occurs if there is no : in the string
Err.Clear
Select Case LCase(strArgumentArray(i))
Case "/q"
blnQuiet = True
Case Else
Print strArgumentArray(i) & " is NOT recognized as a valid input."
intParseCmdLine = CONST_ERROR
Exit Function
End Select ‘end processing args that have no params

Else
Select Case LCase(strFlag)
Case "/u"
strCurrentUser = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/w"
strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/s"
strServer = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/d"
strDomain = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/f"
strFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/n"
iDays = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/c"
strClass = LCase(Right(strArgumentArray(i), Len(strArgumentArray(i))-3))
Case else
Print strArgumentArray(i) & " is not recognized as a valid input."
intParseCmdLine = CONST_ERROR
Exit Function
End Select
End If
Next

If Not(IsNumeric(iDays)) Then
Print "Number of days must be an integer."
intParseCmdLine = CONST_SHOW_USAGE
Else
intParseCmdLine = CONST_PROCEED
End If

If Len(strClass) > 0 Then

If ( (StrComp(strClass,"user") <> 0) And (strComp(strClass,"computer") <> 0 )) Then
Print "The object class must be either user or computer"
Print "For both classes, omit the /C switch altogether"
intParseCmdLine = CONST_SHOW_USAGE
End If

End If

End Function

‘********************************************************************
‘*
‘* Sub ShowUsage()
‘* Purpose: Shows the correct usage to the user.
‘* Input: None
‘* Output: Help messages are displayed on screen.
‘*
‘********************************************************************

Sub ShowUsage()

Wscript.echo ""
Wscript.echo "DELOLD.VBS Displays accounts older than n days and prompts for deletion." & vbCRLF
Wscript.echo "DELOLD.VBS /N:Number of days [/U:username] [/W:password] [/S:server] [/D:domain] [/Q]"
Wscript.echo " command line switches:"
Wscript.echo " /? /H /HELP Displays this help message."
Wscript.echo " command line parameters:"
WScript.echo " /N:Days Search for accounts older than n days."
WScript.echo " /C:Class Either User or computer (omit for both)"
Wscript.echo " /U:Username Username."
Wscript.echo " /W:Password Password."
WScript.echo " /S:Server Name of domain controller."
WScript.echo " /D:Domain Name of domain in either NetBIOS, DN or DNS format."
WScript.echo ""
Wscript.echo "EXAMPLE:"
WScript.echo ""
Wscript.echo "CSCRIPT DELOLD.VBS /N:60 /C:computer"
WScript.echo " Search for computer accounts older than 60 days in current domain"
End Sub

‘********************************************************************
‘* Sub DISPLAYOLD()
‘* Purpose queries domain controllers for objects older than x days
‘* Input strServer Name of the domain controller
‘* strDomain Name of the domain
‘* strCurrentUser User credentials
‘* strPassword User password
‘* blnQuiet
‘* strFile Name of output file
‘* strClass Filter string
‘* iDays Number of days
‘* Output None
‘* Displays number of objects of the class older than iDays
‘* Optionally writes output to strFile
‘*
‘********************************************************************
Sub DisplayOld(strServer, strDomain, strCurrentUser, strPassword, blnQuiet, strFile, strClass, iDays)

‘ON ERROR RESUME NEXT

Dim iSeconds, dDate, objConfig, objRoot, objFileSystem, objFile, strConfig, objProvider
Dim objADO, objADOCommand, strFilter, strResults, strSearch, rsADO, iCount, arrTemp

If strFile = "" Then
objFile = ""
Else
‘Create a filesystem object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
If Err.Number Then
Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
Err.Clear
Else

‘Open the file for output
Set objFile = objFileSystem.OpenTextFile(strFile, 2, True)
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strFile
If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
Err.Clear
End If
End If
End If

If Len(strServer) > 0 Then strServer = strServer & "/"

WScript.Echo "Debug, Server: " & strServer

Set objRoot = GetObject("LDAP://" & strServer & "RootDSE")
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in binding to RootDSE."
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

strServer = objRoot.Get("dnsHostName") & "/"

WScript.Echo "Debug RootDSE: " & objRoot.ADSPath
WScript.Echo "Debug, Server FQDN: " & strServer

‘get configuration naming context object

strConfig = objRoot.Get("configurationNamingContext")

WSCript.Echo "Debug, Config NC: " & strConfig

If strCurrentUser = "" Then ‘no user credential is passed
Set objConfig = GetObject("LDAP://" & strServer & strConfig)
Else
Set objProvider = GetObject("LDAP:")
‘Use user authentication

WScript.Echo "Debug, NC bind string: " & "LDAP://" & strServer & strConfig

Set objConfig = objProvider.OpenDsObject("LDAP://" & strServer & strConfig, strCurrentUser, strPassword,1)
End If
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in binding to Configuration NC. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

WSCript.Echo "Debug, Config Obj: " & objConfig.ADSPath

If strDomain = "" Then
strDomain = objRoot.Get("defaultNamingContext")
WScript.Echo "Debug, domain string: " & strDomain
Else
strDomain = strGetDomainName(objConfig,strDomain)
If strDomain = "" Then
WScript.Echo "Unable to find domain"
Exit Sub
End If
End If

WScript.Echo "Debug, Domain: " & strDomain

dDate = DateAdd("d",- iDays,Now())
iSeconds = 10000000 * (DateDiff("s","1/1/1601",dDate))

wscript.Echo "**********************************************"
WScript.Echo "Accounts that have not logged in since " & dDate
wscript.Echo "which is calculated as, accounts that have not had there password changed since that date which is equivalent to " & iSeconds & " 10,000,000 of a second since 1/1/1601 for the pwdLastSet attribute. This assumes that users/computers change there password periodically."
wscript.echo ""
wscript.echo ""

If IsObject(objFile) Then
objFile.WriteLine "# Accounts that have not logged in since " & dDate
objFile.WriteLine "# Searching domain " & strDomain
End If

Set objADO = CreateObject("ADODB.Connection")
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating ADO Connection. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

objADO.Provider = "ADsDSOObject"

If Len(strCurrentUser) > 0 Then
objADO.Properties("User ID") = strCurrentUser
objADO.Properties("Password") = strPassword
objADO.Properties("Encrypt Password") = True
End If

objADO.Open "STUFF"
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in opening ADO Connection. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

Set objADOCommand = CreateObject("ADODB.Command")
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating ADO Command. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

Set objADOCommand.ActiveConnection = objADO
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in opening ADO Connection. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

objADOCommand.Properties("Timeout")=0
objADOCommand.Properties("Time Limit")=0
objADOCommand.Properties("Page Size")=100
objADOCommand.Properties("Chase Referrals") = True

‘Format the date criteria into UTC format.
Dim tmpString, tmpMonth,tmpDay,tmpHour,tmpMinute,tmpSecond

tmpMonth = Month(dDate)
if (tmpMonth < 10) Then tmpMonth ="0" & tmpMonth

tmpDay = Day(dDate)
if (tmpDay < 10) Then tmpDay ="0" & tmpDay

tmpHour = Hour(dDate)
if (tmpHour < 10) Then tmpHour ="0" & tmpHour

tmpMinute = Minute(dDate)
if (tmpMinute < 10) Then tmpMinute ="0" & tmpMinute

tmpSecond = Second(dDate)
if (tmpSecond < 10) Then tmpSecond="0" & tmpSecond

tmpString = Year(dDate) & tmpMonth & tmpDay & tmpHour & tmpMinute & tmpSecond & ".0Z"

‘Format the date criteria into ? format

if StrComp(strClass,"user") = 0 Then strFilter = "(&(objectCategory=User)(cn=*)(!samAccountType=805306370)(pwdLastSet<=" & FormatNumber(iSeconds,0,,,0) & "))"

if StrComp(strClass,"computer") = 0 Then strFilter = "(&(!(serviceprincipalname=MSClusterVirtualServer/*))(objectCategory=computer)(cn=*)(!samAccountType=805306370)(pwdLastSet<=" & FormatNumber(iSeconds,0,,,0) & "))"

If strClass = "" Then strFilter ="(|(&(objectCategory=User)(cn=*)(!samAccountType=805306370)(pwdLastSet<=" & FormatNumber(iSeconds,0,,,0) & "))(& (objectCategory=computer)(cn=*)(whenCreated<=19991001060749.0Z)(!samAccountType=805306370)(pwdLastSet<=" & FormatNumber(iSeconds,0,,,0) & ")))"

‘MyStr = FormatNumber(iSeconds*10000000,0,,,0)

WScript.Echo "Debug, Filter: " & strFilter

strResults = "cn,lastLogon,samAccountName,whenChanged,objectClass,distinguishedName,pwdLastSet"
strSearch = " objADOCommand.CommandText = strSearch & ";" & strFilter & ";" & strResults & ";subtree"
Set rsADO = objADOCommand.Execute
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in executing ADO Query. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Sub
End If

iCount = 0
If rsADO.RecordCount > 0 Then

WScript.Echo sprintf(Array("%20s %15s %15s","Common Name","Logon Name","Last Logon"))

‘###########################################
‘### MODIFIED BY BARIS ERIS on 1/21/2003 ###
‘###########################################

While Not rsADO.EOF

WScript.Echo sprintf(Array("%20s %15s %15s",CStr(rsADO.Fields(0).Value),CStr(rsADO.Fields(2).Value),ShowDSDate(rsADO.Fields(1).Value)))
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in printing results. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear

End If
if isObject(objFile) then
objFile.WriteLine "# "
objFile.WriteLine "# name=" + rsADO.Fields(2).Value + " lastLogon=" + rsADO.Fields(1) + " pswChg=" + ShowDSDate(rsADO.Fields(6))
wscript.Echo "adding to file: " & CStr(rsADO.Fields(5).Value)
objFile.WriteLine "dn: " & CStr(rsADO.Fields(5).Value)
objFile.writeLine "Changetype: delete"
End If
iCount = iCount + 1

Hilmi = ""

wscript.echo "Delete this computer account? (y/n) (ctrl-break to exit)"
hilmi=WScript.StdIn.Readline

if rtrim(ltrim(hilmi))="Y" or rtrim(ltrim(hilmi))="y" then

wscript.echo "DN:" & CStr(rsADO.Fields(5).Value)
wscript.echo "CN=" & CStr(rsADO.Fields(0).Value)

Set ObjOU_1 = GetObject("LDAP://" & CStr(rsADO.Fields(5).Value))
ObjOU_1.deleteObject 0

wscript.echo "===========================[ABOVE OBJECT DELETED]==========================="
Else
wscript.echo "===========================[ABOVE OBJECT NOT DELETED]======================="
End If

rsADO.MoveNext
Wend

‘########################
‘### END MODIFICATION ###
‘########################

WScript.Echo iCount & " records found"
WScript.Echo
If isObject(objFile) Then
objFile.WriteLine
objFile.WriteLine "# " & iCount & " records found"
WScript.Echo "Records may be deleted by using the output file " & strFile & " and the export utility LDIFDE"
WScript.Echo "The command would be: LDIFDE -i -f " & strFile & " -s " & Left(strServer,Len(strServer)-1)

End If

Else
WScript.Echo "No records found"
If isObject(objFile) Then objFile.WriteLine "# No records found"

End If

If isObject(objFile) Then objFile.Close

End Sub

‘********************************************************************
‘* Function ShowDSDate(objDate)
‘*
‘* Purpose: Enumerate Sites and find servers for specified domain
‘* Input: objDate An object which is the date part
‘*
‘* Output: None
‘* Returns the date in string format
‘*
‘* DS Dates are stored as number of tenths of milliseconds since 1/1/1601
‘* Because VB Script overflows, perform date additions from 1/1/1990
‘* using 12275625600 as the number of seconds from 1/1/1601 to 1/1/1990
‘********************************************************************
Public Function ShowDSDate(DateObj)

Dim objDate, NumSeconds

‘On Error Resume Next
ShowDsDate = "Error"
Set objDate=DateObj

NumSeconds = (objDate.LowPART + (objDate.HighPart* (2^32)))/10000000

If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in ShowDSDate. "
if Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
NumSeconds = 0 ‘ KL ADDED.
End If

If NumSeconds = 0 Then
ShowDSDate = "Never"
Else
ShowDSDate = DateAdd("s",NumSeconds – 12275625600, "1/1/1990")
End If
End Function

‘********************************************************************
‘* Function intListServersInDomain(strDomain, objConfig, arrServers,arrSites)
‘*
‘* Purpose: Enumerate Sites and find servers for specified domain
‘* Input: strDomain Domain name
‘* objConfig Configuration naming context
‘*
‘*
‘* Output: arrServer Array of server ADSPaths
‘* arrSites Array of corresponding Sites
‘* Returns number of servers in selected domain
‘********************************************************************
Private Function intListServersInDomain(strDomain, objConfig, arrServers, arrSites)

‘ON ERROR RESUME NEXT

Dim objSites, objSite, objServers, objServer, objNTDSA
Dim strMasterNCs, i, j

intListServersInDomain = 0

Set objSites = objConfig.GetObject("sitesContainer","cn=Sites")
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in binding to sites container. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Function
End If

objSites.Filter = Array("site")

j = 0

For Each objSite in objSites

Set objServers = objSite.GetObject("serversContainer","cn=Servers")
objServers.Filter = Array("server")

For Each objServer in objServers

If ((objServer.Class = "server") And (Not IsEmpty(objServer.ServerReference))) Then

Set objNTDSA = objServer.getObject("nTDSDSA","cn=NTDS Settings")
strMasterNCs = objNTDSA.GetEx("hasMasterNCs")

For i = LBound(strMasterNCs) to UBound(strMasterNCs)

If LCase(strMasterNCs(i)) =LCase(strDomain) Then
j = j + 1

Redim Preserve arrServers(j-1)
Redim Preserve arrSites(j-1)
arrServers(j-1) = objServer.ServerReference
arrSites(j-1) = objSite.cn
End If
Next

End If
Next
Next

intListServersInDomain = j

End Function

‘********************************************************************
‘* Function strGetDomainName(objConfig,strDomain)
‘*
‘* Purpose: Returns the distinguished name of the domain
‘* Input: objConfig ADSI object for configuration NC
‘* strDomain Domain name either FDN, NetBIOS or dotted DNS form
‘*
‘* Output: Either an empty string if no matching domain is found or
‘* a string containing the dn of the domain
‘********************************************************************
Private Function strGetDomainName(objConfig,strDomain)

‘ON ERROR RESUME NEXT

Dim objPartition,objDomain
Dim strMasterNCs

strGetDomainName = ""

Set objPartition = objConfig.GetObject("crossRefContainer","CN=Partitions")
If Err.Number Then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in binding to partitions container. "
If Err.Description <> "" Then Print "Error description: " & Err.Description
Err.Clear
Exit Function
End If

objPartition.Filter=Array("crossRef")
For Each objDomain in objPartition
If ((objDomain.systemFlags And 3)= 3) Then
If ( (LCase(objDomain.nCName) = LCase(strDomain)) or (LCase(objDomain.nETBIOSName) = LCase(strDomain)) or (LCase(objDomain.dnsRoot) = LCase(strDomain))) Then

strGetDomainName = objDomain.ncName

Exit For
End If
End If
Next

End Function

‘********************************************************************
‘*
‘* Function intSearchArray()
‘* Purpose: Searches an array for a given string.
‘* Input: strTarget the string to look for
‘* strArray an array of strings to search against
‘* Output: If a match is found intSearchArray is set to the index of the element,
‘* otherwise it is set to CONST_STRING_NOT_FOUND.
‘*
‘********************************************************************

Function intSearchArray(ByVal strTarget, ByVal strArray)

‘ON ERROR RESUME NEXT

Dim i, j

intSearchArray = CONST_STRING_NOT_FOUND

If Not IsArray(strArray) Then
Print "Argument is not an array!"
Exit Function
End If

strTarget = LCase(strTarget)
For i = 0 To UBound(strArray)
j = InStr(1, strArray(i), strTarget, 1)
If j > 0 Then
intSearchArray = i
End If
Next
End Function

‘********************************************************************
‘*
‘* Sub Print()
‘* Purpose: Prints a message on screen if blnQuiet = False.
‘* Input: strMessage the string to print
‘* Output: strMessage is printed on screen if blnQuiet = False.
‘*
‘********************************************************************

Sub Print(ByRef strMessage)
‘If Not blnQuiet then
Wscript.Echo strMessage
‘End If
End Sub

‘********************************************************************
‘*
‘* Funcion sprintf()
‘* Purpose: formats a string simlar to C runtime sprintf function
‘* Input: VarArg variable length array of strings
‘* Output: formatted string
‘*
‘********************************************************************
Public Function sprintf(VarArg())
Dim iIndex
Dim iArg
Dim iCountArgs
Dim sTemp
Dim cChar
Dim cNextChar
Dim bFound
Dim sVal

iArg = 1
iCountArgs = UBound(VarArg) + 1

For iIndex = 1 to Len(VarArg(0))
cChar = Mid(VarArg(0),iIndex,1)
Select Case cChar
Case "%"
bFound = False
sVal = 0
Do While bFound=False
cNextChar=Mid(VarArg(0),iIndex+1,1)
iIndex=iIndex+1
Select Case cNextChar
Case "d","s"
bFound=True
Case Else
If sVal > 0 Then sVal = sVal * 10
sVal = sVal + cNextChar
End Select
Loop
If iArg < iCountArgs Then
If Len(VarArg(iArg)) > sVal Then
sTemp = sTemp & Left(VarArg(iArg),sVal)
Else
sTemp = sTemp & VarArg(iArg) & Space(sVal-Len(VarArg(iArg)))
End If
End If
iArg = iArg +1
Case Else
sTemp = sTemp & cChar
End Select
Next
sprintf = sTemp
End Function

‘********************************************************************
‘* *
‘* End of File *
‘* *
‘********************************************************************

‘********************************************************************
‘*
‘* Procedures calling sequence: DELOLD.VBS
‘*
‘* intChkProgram
‘* intParseCmdLine
‘* ShowUsage
‘* ShowRID
‘*
‘********************************************************************

Advertisements
This entry was posted in Scripts. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s