Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

ShortcutRemover: To automatically delete shortcuts infected with Virus

Status
Not open for further replies.

crackoo

Programmer
Feb 17, 2011
132
TN
Hi ! Hope that this Tool help somebody !
There are a lot of virus and its variants that have been shed much these days. and have these symptoms: they hide their files and they turn into shortcuts that have targeted to their virus.exe
I too was a victim of this type of virus for a week. I have a virus that converts files shortcuts. In fact as soon as you plug a USB drive virus activates. It puts the files in hidden attribute and creates shortcuts with the name of the folder that when clicked launches an application created by the virus that saturates the CPU.
So I thought to do this vbscript to automatically delete infected shortcuts and the virus itself.
Code:
Call checkUSB ' Appelle a la procédure checkUSB
Dim MsgTitre,fso,Ws,NomFichierLog,NBfichier,ListVirus
ListVirus = array("ntde1ect.com","semo2x.exe","avpo.exe","ntdelect.com.txt","ntdeiect.com","amvo.exe","rtlip.exe","x.exe","ert.dll",_
"help.exe","copy.exe")
MsgTitre="Les Raccourcis Infectés dans le Flash © Hackoo Crackoo"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("Wscript.Shell")
Set dc = fso.Drives
	For Each d in dc
	If d.IsReady  and d.DriveType = 1 Then
		racine = d.Driveletter
		MsgBox "Votre Lecteur Flash est le " &racine&":\",64,MsgTitre
		end if
	Next	
 Ws.Run "%comspec% /c attrib -s -h -r "&racine&":\*.* /D /S",0,True
 Ws.Run "%comspec% /c dir "&racine&":\ > Resultat.txt",0,True
 Quest = MsgBox ("Voulez-vous Voir un Aperçu sur le contenu de votre Flash disk ?",VBYesNO+VbQuestion,MsgTitre)
 If Quest = VbYes then
 Ws.Run "Resultat.txt"
 end if
 
 Wscript.Sleep 10000

NomFichierLog = "LOGFILE.html"
Set OutPut = fso.CreateTextFile(NomFichierLog,2)

Set folder = fso.getFolder(racine&":\")
For X=0 to UBound(ListVirus)
If fso.fileExists(racine &":\"& ListVirus(X)) Then 
Attr = Ws.Run("cmd /C attrib -s -h -r "&racine&":\"&ListVirus(X)&"",0,TRUE)
Supp = Ws.Run("cmd /C cd \ & del "&racine&":\" &ListVirus(X)& "/f /q /a",0,TRUE)
OutPut.WriteLine "<hr> le Virus <B><font color=red>"& ListVirus(X)& "</B></font> à été Supprimé avec Succés !"
else
OutPut.WriteLine " <hr> le Virus <B><font color=Yellow>"& ListVirus(X)& "</B></font>  n'est pas contenu dans le FlashDisk !"
end if
Next

NBfichier=0
For Each Fichier in folder.Files
If UCase(FSO.GetExtensionName(Fichier.Path)) = "LNK" Then
NBfichier=NBfichier+1
OutPut.WriteLine "<br><hr>Le raccourci infecté <B><font color=red>"& Fichier.Path & "</B></font> a été supprimé avec succés !"
fso.DeleteFile(Fichier)
end if
Next
If NBfichier > 0 then
MsgBox NBfichier& " Fichiers Raccourcis Infectés Contenu dans le FlashDisk ont été supprimés avec Succés ! ",64,MsgTitre
else
MsgBox "Il n'y a aucun Raccourcis Infectés Contenu dans le FlashDisk",64,MsgTitre
end if
OutPut.WriteLine vbNewLine & "<hr><B><font color=red> "& NBfichier& " </B></font> Fichiers Raccourcis Infectés ont été supprimés ! © Hackoo Crackoo"
OutPut.Close

strHTML="<html><body bgcolor=#1234568 text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style></body></html>"
strHTML = strHTML & "<center><font size=5 FACE=Comic sans MS style=font-weight:bold  Color=Violet>Rapport de Nettoyage de votre FlashDisk "&racine&":\"&"</font><br><br>"&_
"<img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img></center>"
Set ReadOutPut = fso.OpenTextFile(NomFichierLog,1)
st = ReadOutPut.ReadAll
tb = split(st,vbcrlf)
For i = lbound(tb) to ubound(tb)
  strHTML=strHTML & tb(i) & "<br>" 
next
Set WriteOutPut = fso.OpenTextFile(NomFichierLog,2)
WriteOutPut.WriteLine strHTML
AffichLog = MsgBox ("Voulez-vous consulter le Rapport de Nettoyage ?",VBYesNO+VbQuestion,MsgTitre)
 If AffichLog = VbYes then
 Explorer(NomFichierLog)
 end if

Wscript.Sleep 15000

Question = MsgBox ("Voulez-vous Consulter le contenu de votre Flash disk",VbYesNO+VbQuestion,MsgTitre)
if Question = VbYes then
Explorer_Folder ""&racine&":"
end if

Function Explorer_Folder(Dir)
    Set ws=CreateObject("wscript.shell")
    ws.run "Explorer.exe "& Dir & "\"
	'ws.Run "explorer /n,/e,/select," & Dir & "\nul"
end Function

'------------------------------checkUSB----------------------------
Sub checkUSB
strComputer = "."
On Error Resume Next
Set WshShell = CreateObject("Wscript.Shell")
beep = chr(007)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
intCount = 0
For Each drive In colItems
    If drive.mediaType <> "" Then
        intCount = intCount + 1
    End If
Next
If intCount > 0 Then
    MsgBox "Votre Clé USB Personnelle est bien Connectée !",64,"Flash Drive Check © Hackoo Crackoo!"
	Call NumSerie_Usb() ' Appelle a la procédure NumSerie_Usb()
else
	WshShell.Run "cmd /c @echo " & beep, 0
	wscript.sleep 1000
	MsgBox "Votre Clé USB Personnelle n'est pas Connectée !" &VbCrlf&_
	"Veuillez SVP la brancher puis réexécuter ce VBScript de nouveau !"&VbCrlf&_
	"Merci !",48,"Flash Drive Check © Hackoo Crackoo !"
	wscript.Quit
End If
End Sub
'---------------------------Fin du checkUSB----------------------------

'----------------------------NumSerie_Usb.vbs--------------------------
  Sub NumSerie_Usb()
  Dim NumSerie
  'Retrouver la clé Usb et son numéro de série
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb © Hackoo Crackoo"
  end if
  End If
  Next
  End Sub
  'Les éléments à démarrage automatique + ListProcessCmdLine.vbs © Hackoo Crackoo © 2011
Set fso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("WScript.Shell")
Set ProcessEnv = Ws.Environment("Process")
NomMachine = ProcessEnv("COMPUTERNAME") 
NomUtilisateur = ProcessEnv("USERNAME") 
NomFichierLog="Liste_Processus.txt"
NomFichierLogHTML= "Liste_Processus.html"
temp = Ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
PathNomFichierLogHTML = temp & "\" & NomFichierLogHTML
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,2)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _ 
& strComputer & "\root\cimv2") 
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process")
count=0 

Call Infosys
OutPut.WriteLine String(14,"*")& "Liste des Processus en cours d'exécution le " & date & " à " & time & " sur Le PC "& NomMachine &" connecté en tant que " & NomUtilisateur & String(14,"*")& vbNewline & String(143,"*")
For Each objProcess in colProcesses
ProcessName = objProcess.Name
ProcessID = objProcess.ProcessID
CommandLine = objProcess.CommandLine	
count=count+1
Texte = "Numéro PID = "& objProcess.ProcessID & VbNewLine & "Nom du Processus = " & objProcess.Name & VbNewLine &"Ligne de Commande = "& objProcess.CommandLine &_
VbNewLine & String(120,"*")
OutPut.WriteLine Texte
Next
 
OutPut.WriteLine  "Il y a "& Count &" Processus en cours d'exécution le " & date & " à " & time & " sur Le PC "& NomMachine &" connecté en tant que " & NomUtilisateur & vbNewline
Call StartupCommand

Convert2HTML NomFichierLog,NomFichierLogHTML
Wscript.Sleep 10000
If MsgBox ("Voulez-vous consulter les éléments à démarrage automatique avec la Liste Processus : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode HTML Cliquer sur NON ",VbYesNo+VbQuestion ,MsgTitre ) = VbYes Then
'ws.Run "Notepad "  & PathNomFichierLog,0,True
Explorer(PathNomFichierLog)
else
Explorer(PathNomFichierLogHTML)
end if

Function StartupCommand()
strComputer = "."
resultat=""
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colStartupCommands = objWMIService.ExecQuery ("Select * from Win32_StartupCommand")
 
For Each objStartupCommand in colStartupCommands
resultat=resultat & "Nom: " & objStartupCommand.Name & vbNewline
resultat=resultat & "Description: " & objStartupCommand.Description & vbNewline
resultat=resultat & "Emplacement: " & objStartupCommand.Location & vbNewline
resultat=resultat & "Commande: " & objStartupCommand.Command & vbNewline
resultat=resultat & "Utilisateur: " & objStartupCommand.User & vbNewline
resultat=resultat & String(120,"*") & vbNewline 
Next
OutPut.WriteLine String(50,"*") &" Les éléments à démarrage automatique "& String(50,"*")
OutPut.WriteLine resultat
end Function
 
Function Explorer(File)
    Set ws=CreateObject("wscript.shell")
    ws.run "Explorer "& File,0,True
end Function
 
Function InfoSys
strComputer = "."
strMessage=""
Set objWMIService = GetObject("winmgmts:"  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery  ("Select * from Win32_ComputerSystem")
Set colSettings2 = objWMIService.ExecQuery ("Select * from Win32_BIOS")
Set colSettings3 = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objBIOS in colSettings2 
      strMessage=strMessage & "BIOS " & objBIOS.Version & vbNewline & vbNewline
Next
For Each objComputer in colSettings 
      strMessage=strMessage & "Nom de l'ordinateur : " & objComputer.Name & vbNewline & "Fabriquant: " & objComputer.Manufacturer & vbNewline & "Modèle : " & objComputer.Model & vbNewline & vbNewline
 
Next
For Each objOperatingSystem in colSettings3
      strMessage=strMessage &  objOperatingSystem.Name & vbNewline
      strMessage=strMessage &  "Version " & objOperatingSystem.Version & vbNewline
      strMessage=strMessage &  "Service Pack " & objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion &vbNewline
      strMessage=strMessage &  "Dossier de Windows: " & objOperatingSystem.WindowsDirectory &vbNewline
Next
OutPut.WriteLine strMessage
end Function

Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
 strHTML="<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
StrHTML = StrHTML & "<center><font size=4 color=Red><B> Les éléments à démarrage automatique + ListProcessCmdLine.vbs © Hackoo Crackoo © 2011 ! </B></font><hr>"&_
"<img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img><hr></center>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = "<center>"& StrHTML &"</center>"
StrHTML = Replace(StrHTML,String(120,"*"),"<hr>")
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
OutPutHTML.writeLine StrHTML
End Function

Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top