' wierdware protection script
On Error Resume Next

function GetProfiles()
	
	Const HKEY_LOCAL_MACHINE = &H80000002
	Set userProfileList = CreateObject( "Scripting.Dictionary" )

	Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
	strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
	oRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys

	i = 0
	For Each oSubkey In arrSubkeys
		If oSubkey <> "S-1-5-18" And oSubkey <> "S-1-5-19" And oSubkey <> "S-1-5-20" Then
			strValueName = "ProfileImagePath"
			strSubPath = strKeyPath & "\" & oSubkey
			oRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
			userProfileList.add i, strValue
			i = i + 1
		End If
	Next
	Set GetProfiles = userProfileList

end function

function ProcessProfile(Profile)
	
	Dim SuspiciousFolders
	SuspiciousFolders = Array("Mail.Ru", "MailRu", "Unity", "Amigo", "Yandex", "Programs", "ICQ")

	If oFSO.FolderExists(Profile) Then
		For Each Location In Array("Local", "Roaming")
			For Each Folder In SuspiciousFolders
				FolderPath = Profile & "\AppData\" & Location & "\" & Folder
				ok = false
				
				'Wscript.Echo FolderPath
				If oFSO.FolderExists(FolderPath) Then
					Set oFolder = oFSO.GetFolder(FolderPath)
					If(oFolder.SubFolders.Count + oFolder.Files.Count > 0) Then
						'Wscript.Echo "wiping " & FolderPath
						oShell.run "takeown /r /f " & FolderPath, 0, True
						oShell.run "robocopy /mir /NFL /NDL /NJH /NJS /nc /ns /np " & sFullPathEmpty & " " & FolderPath, 0, True					
					else
						ok = true
					End If	
				Else 
					'Wscript.Echo "creating " & FolderPath
					oFSO.CreateFolder(FolderPath)
				End If
				
				if not OK then
					'Wscript.Echo "seizing permissions " & FolderPath
					oShell.run "takeown /r /f " & FolderPath, 0, True
					oShell.run "icacls " & FolderPath &" /reset /T /C", 0, True
					oShell.run "icacls " & FolderPath &" /inheritance:r /grant:r " & sOwner & ":(OI)(CI)F /grant:r SYSTEM:(OI)(CI)F /T /C", 0, True
				end if
			Next
		Next
	End If
end function

Dim oFSO, oShell, sTempPath
Set oShell = CreateObject ("WScript.Shell") 
Set oFSO = CreateObject("Scripting.FileSystemObject")  
Const TemporaryFolder = 2
Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set oAccount = oWMIService.Get("Win32_SID.SID='S-1-5-32-544'") ' "BUILTIN\Administrators" local name
sOwner = oAccount.AccountName 

sTempPath = oFSO.GetSpecialFolder(TemporaryFolder)
sTempFileName = oFSO.GetTempName
sFullPathEmpty = sTempPath & "\" & sTempFileName
Set oFolder = oFSO.CreateFolder(sFullPathEmpty)

set arr = GetProfiles()
'oShell.LogEvent 4, "Agent protector started for " & join(arr.Items, " ,")

For Each process in array("magent.exe", "TamTam.exe", "icq.exe")
	oShell.run "taskkill.exe /F /IM " & process, 0 , True
Next

For Each Profile In arr.Items
	ProcessProfile(Profile)
Next

oFSO.DeleteFolder(sFullPathEmpty)
'oShell.LogEvent 4, "Agent protector finished"