MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > VisualBasic > Kodlar

CD Sürücüsünü Bulma

Cd-Rom'un hangi sürücü olduğunu bulan program örneği

Kategori : VisualBasic
Gönderen : LonG
Telif :
Tarih : 30 Mayıs 2005
Örnek Dosya : Bulunmamakta
Okunma Sayısı : 9006
Puan
: 10 / 10 (2 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6



Function StripNulls(startStrg$) As String

'Take a string separated by Chr$(0)'s, and split off 1 item, and
'shorten the string so that the next item is ready for removal.

  Dim c%, item$
  c% = 1
  
  Do

    If Mid$(startStrg$, c%, 1) = Chr$(0) Then
      
      item$ = Mid$(startStrg$, 1, c% - 1)
      startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))
      StripNulls$ = item$
      Exit Function
    
    End If

    c% = c% + 1

  Loop

End Function
Private Sub Form_Load()

Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim CDfound As Integer
   
  'pad the string with spaces
   allDrives$ = Space$(64)
  
  'call the API to get the string containing all drives
   r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
  
  'trim off trailing chr$(0)'s.  AllDrives$
  'now contains all the drive letters.
   allDrives$ = Left$(allDrives$, r&)
   
  'begin a loop
   Do
      
     'find the first separating chr$(0)
      pos% = InStr(allDrives$, Chr$(0))
      
     'if there's one, then...
      If pos% Then
        
       'extract the drive up to the chr$(0)
        JustOneDrive$ = Left$(allDrives$, pos%)
        
       'and remove that from the Alldrives string,
       'so it won't be checked again
        allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
      
       'with the one drive, call the API to
       'determine the drive type
        DriveType& = GetDriveType(JustOneDrive$)
        
       'check if it's what we want
        If DriveType& = DRIVE_CDROM Then
          
          'got it (or at least the first one,
          'anyway, if more than one), so set
          'the found flag...
           CDfound% = True

          'we're done, so get out
           Exit Do
        
        End If
      End If
   
  Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
   
 'display the appropriate message
  If CDfound% Then
        Label1 = "The CD-ROM drive on your system is drive " & UCase$(JustOneDrive$)
  Else: Label1 = "No CD-ROM drives were detected on your system."
  End If

End Sub
 
 

CD Sürücüsünü Bulma için yazılan yorumlar

Henüz yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > CD Sürücüsünü Bulma
Kategoriler:


Forum:



Bağlantılar:


En Son Yorumlanan İçerikler:


Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.162.165.158 | 0,12 Saniye
© Copyright 2004-2018 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.