[Amin_Mansouri]

درود
من یه مدت اینترنت نداشتم بخاطر این نتونستم بیام پروژه ای که خواستید نوشته شد اما نه دقیقا همون (بقیشو باید زحمتشون خودتون بکشید چون وقت کافی ندارم )
البته براتون قسمت اینکه فلش رو اتومات باز کنه نوشتم
مشکل پسوند فایل ها حل کردم
فرم هم مخفی کردم
و اینکه گفتید اینکه همه فولدر ها بگرده داخلشون فایل های که گفتید پاک کنه خیلی طول میکشه و نیاز به کد نویسی داره که وقتشو ندارم و معمولا هم این جور پروژه ها با شکست مواجه میشن
یه فلش 32 گیگابایتی به صورت مثلا 8 گیگش پر اهنگ و تکست و .... باشه کاربرو کلافه میکنه !


سورس کد :

کد:

'CODER : Www.ParsiCoders.com By Amin Mansouri
'version 1.1


Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long

Const DRIVE_CDROM = 5

Const DRIVE_FIXED = 3

Const DRIVE_RAMDISK = 6

Const DRIVE_REMOTE = 4

Const DRIVE_REMOVABLE = 2

Dim NameDrive As String

Public Function GetUsb() As String
Dim WMIService As Object, USBDrives As Object, USBFound As Object, USB As String, USBCount As String
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 'Open WMIService
Set USBDrives = WMIService.ExecQuery("Select * from Win32_LogicalDisk") 'Look For Computer Drives drives
For Each USBFound In USBDrives 'Look for all our drives
If USBFound.drivetype = 2 Then 'If drivetype is USB
USB = USBFound.Name 'Set USB as New USB-name
USBCount = USBCount & " - " & USBFound.Name 'Add USB name to USB-count
End If
If USB = "" Then GoTo volgende  'If its not an USB-Drive then goto Next
volgende: 'Next
Next 'Search for more USB drives
GetUsb = USB
End Function

Public Function StripNulls(OriginalStr As String) As String
     If (InStr(OriginalStr, Chr(0)) > 0) Then
         OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
     End If
     StripNulls = OriginalStr
End Function
Public Function DeleteFile()
On Error Resume Next
File1.Path = GetUsb
File1.Refresh
If GetDriveType(GetUsb) = 3 Then Exit Function
    If File1.ListCount = "1" Then
For i = 0 To File1.ListCount - 1
Path = StripNulls(GetUsb + File1.List(i))
SetAttr Path, vbNormal
Kill Path
eXP.Enabled = True
Next
End If
End Function
Private Sub Drive1_Change()
File1.Path = Drive1.Drive
End Sub


Private Sub eXP_Timer()
eXP.Enabled = False
Shell ("explorer " + GetUsb), vbNormalFocus
End Sub

Private Sub Form_Load()
'Me.Hide
File1.Pattern = "*.dll;*.exe;*.pry;*.sys;*.inf;*.bat;*.sys;*.ovl*.com*.ocx"
File1.System = True
File1.Hidden = True
End Sub

Private Sub Timer1_Timer()
DeleteFile
End Sub

دانلود سورس به همراه فایل اجرایی :


  Proje Anti 1.1 .zip (اندازه 8.1 KB / تعداد دانلود: 2)