' BadTrans remover for WinNT, Win2000 & WinXP
' Release: 1.0


testo = testo & "Gli autori non si assumono alcuna responsabilità "
testo = testo & "riguardo a possibili danni causati da uso proprio o improprio di questo script"
MsgBox (testo)
Msgbox "ATTENZIONE! Eseguire solo con permessi di ROOT! (Così possiamo fare più danni ;-))",16
scelta = MsgBox ("Se non sei ROOT clicca su ANNULLA, altrimenti clicca su OK per continuare", 17, "ATTENZIONE") 
If scelta = 2 Then Wscript.quit

main
Sub main()
rem i trans non sono un problema, quelli Bad però si :)
On Error Resume Next
dim ind

K1 = "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\RUN"
K2 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce\kernel32"
Ks = "HKEY_LOCAL_MACHINE\Software\"
Ku = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\"
Kr = "HKEY_CLASSES_ROOT\exefile\shell\open\command\"
k = "[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager]"
reg = "REGEDIT4" & vbCrLf & k & vbCrLf & chr(34) & "PendingFileRenameOperations" & chr(34) & "=hex(7):"

Set Vlade = CreateObject("Scripting.FileSystemObject")

'andiamo a vedere dove sono i vari folder
winfolder = Vlade.GetSpecialFolder(0)
sysfolder = Vlade.GetSpecialFolder(1)

rem ind indica se si è operato già qualche intervento
set ind = 0

rem segnamo i file da cancellare
call deleteFile (winfolder & "\INETD.exe", reg, ind)
call deleteFile (winfolder & "\HKK32.exe", reg, ind)
call deleteFile (sysfolder & "\KERN32.exe", reg, ind)
call deleteFile (sysfolder & "\KERNEL32.exe", reg, ind)
call deleteFile (winfolder & "\KERNEL32.exe", reg, ind)
call deleteFile (sysfolder & "\HKSDLL.DLL", reg, ind)
call deleteFile (sysfolder & "\KDLL.DLL", reg, ind)
call deleteFile (sysfolder & "\CP_23421.nls", reg, ind)
call deleteFile (sysfolder & "\CP_25389.nls", reg,ind)
call deleteFile (sysfolder & "\protocol.dll", reg, ind)

rem eliminiamo la chiamata dalla WINDOWS NT
valore = "C:\WINDOWS\INETD.EXE"
lettura = Rg(K1)
If (valore = lettura) Then
  Rd K1
  ind = ind + 1
  call report (K1, "", "deleted", "", ind)
End If

rem eliminiamo la chiamata dalla RunOnce
valore = "kernel32.exe"
lettura = Rg(K2)
If (lettura <> "") Then
  Rd K2
  ind = ind + 1
  call report (K2, "", "deleted", "", ind)
End If

rem ... e adesso mani al win.ini e rimuovimamo la chiamata
call editfile (winfolder & "\" , "win.ini", "run=C:\WINDOWS\INETD.EXE", "run=", ind)

rem commiati e disposizioni finali
If ind <> 0 Then
    call modifyReg(reg)
    testo = "Nel file " & Root() & "nuccia.vir troverai il log delle operazioni eseguite" & Chr (13)
    testo = testo & "Inside the file " & Root() & "nuccia.vir you can find the disinfection report "
    MsgBox (testo)
    testo = "Ho fatto del mio meglio . Riavvia e lancia l'Antivirus" & Chr (13)
    testo = testo & "I did my best! Restart and run a complete antivirus scan"
    MsgBox (testo)
    testo = "Auguri ... e sostieni l'UNICEF" & Chr (13)
    testo = testo & "Luck ... and support UNICEF" 
    MsgBox (testo)
else
    testo = "Non ho rilevato elementi di Badtrans" & Chr (13)
    testo = testo & "No Badtrans elements detected"
    MsgBox (testo)
    Vlade.DeleteFile (Root() & "nuccia.vir")
End If
End Sub


' ------------------------------ zona librerie ----------------------------------------------

Function Esa(ByVal file)
' Converte file in forma esadecimale e aggiunge in fondo uno 00
On Error Resume Next
For i=1 To len(file)
    esa = esa & Hex(Asc(Mid(file, i, 1))) & ","
Next
esa = esa & "00,"
End Function

Sub deleteFile(ByVal file, ByRef reg, ByRef ind)
' Cancella il file
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
If marcolfa.FileExists(file) Then
    reg = reg & Esa("\??\" & file) & "00,"
    ind = ind + 1
    call report (file, "", "deleted" , "", ind)
End IF
End Sub

Sub substituteFile(ByVal file1, ByVal file2, ByRef reg, ByRef ind)
' Sposta file1 nella posizione file2 sovrascrivendo
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
If marcolfa.FileExists(file1) Then
    reg = reg & esa("\??\" & file1) & esa("!\??\" & file2)
    ind = ind + 1
    call report (file2, "", "substituited", file1, ind)
End If
End Sub

Sub moveFile(ByVal file1, ByVal file2, ByRef reg, ByRef ind)
' Sposta file1 nella posizione file2 ma senza sovrascrivere
' Non genera un report perchè in questo script non serve
' E' stato aggiunto solo per completezza e per eventuali riutilizzi futuri
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
If marcolfa.FileExists(file1) Then
    reg = reg & esa("\??\" & file1) & esa("\??\" & file2)
    ind = ind + 1
End If
End Sub

Sub modifyReg (ByVal reg)
' Eseguiamo le modifiche al registro
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
If (NOT marcolfa.FolderExists(Root() & "trans")) Then
    marcolfa.createFolder(Root() & "trans")
End If
Set trans=marcolfa.CreateTextFile(Root() & "trans\trans.reg",True)
reg = reg & "00"
trans.Write reg
trans.close
Set W=CreateObject("WScript.Shell")
W.Run ("regedit /s " & Root() & "trans\trans.reg")
rw "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\trans", "deltree /y " & Root() & "trans"
End Sub

Function Rg(v)
rem legge un valore nel file di registro
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
Rg = R.RegRead(v)
End Function

Sub Rw(k, v)
rem scrive nel file di registro
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
R.RegWrite k, v
End Sub

Sub Rd(v)
rem cancella dal registro
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
R.RegDelete(v)
End Sub

Sub findFile(ByVal folder, ByVal estensioni, ByVal str, ByRef ind)
' Cerca ricorsivamente tutti i files contenuti in folder e nelle sottodirectory con estensione ext e ne cancella la stringa str
Dim Shell
On Error Resume Next
Set Shell = CreateObject("Shell.Application")
Set marcolfa = CreateObject("Scripting.FileSystemObject")
For Each ext In estensioni
'   element assume il nome di ogni file o cartella contenuto in folder
    For Each element In Shell.NameSpace(folder).Items
        If element.IsFolder Then
            call findFile(element.Path & "\", estensioni, str, ind)
        Else
            If Right(element, len(ext)) =  ext Then
                call editFile (folder, marcolfa.GetFileName(element), str, ind)
            End If
        End If
    Next
Next
End Sub

Sub editFile (folder, file, stri, subst, ind)
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
If marcolfa.FileExists(folder & file) Then
    Set vecchio = marcolfa.GetFile (folder & file)
    nuovonome = marcolfa.GetBaseName(folder & file) & ".vir"
    vecchio.Copy (folder & nuovonome)
    marcolfa.DeleteFile (folder & file)
    Set lella = marcolfa.OpenTextFile(folder & nuovonome , 1, False)
    Set vipera = marcolfa.OpenTextFile(folder & file, 2, True)
    Do While lella.AtEndOfStream <> True
        lettura = lella.ReadLine
        If lettura <> stri Then
            vipera.Writeline (lettura)
        else
            If ind = 0 Then  
                ind = ind +1 
                call report (folder & file, "" , " saved as: " , folder & nuovonome, ind)
            End If
            vipera.Writeline (subst)
            ind = ind +1
            call report (folder & file, "  instruction : " & stri , " deleted" , "", ind)
        End If
    Loop
    lella.close
    vipera.close
    If ind = 0 Then marcolfa.DeleteFile (folder & nuovonome)
End If
End Sub

Sub report (posizione, voce, azione, sostituto, ind)
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
if ind = 1 then marcolfa.DeleteFile (Root() & "nuccia.vir")
set nuccia = marcolfa.OpenTextFile(Root() & "nuccia.vir", 8, True)
If ind = 1 Then
   nuccia.Write "[My name is Marcolfa.]"
   nuccia.Write VbCrLf & "Your system is infected : This is what i did:"
   nuccia.Write VbCrLf & VbCrLf
End If
If sostituto <> "" Then 
   add = " by "
Else
   add =""
End If
nuccia.Write VbCrLf & "[action: " & ind & "]"
nuccia.Write VbCrLf & posizione & voce & ": was " & azione & add & sostituto
nuccia.Write VbCrLf
End Sub

Function Root()
' Cerchiamo su quale unita' si trova il S.O.
On Error Resume Next
Set marcolfa = CreateObject("Scripting.FileSystemObject")
Set fold = marcolfa.GetSpecialFolder(0)
Do Until fold.IsRootFolder
    Set fold = fold.ParentFolder
Loop
Root = fold
End Function