Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic ipuçları » Bilgisayarınızda bulunan Sürücüleri Ad, Etiket, SeriNo ve yolları ile listeler.. Network dahil.
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

VB.NET TE Process.start ile shell işlemleri

Yazar: LENIN
bu yazımda sizlere Process.start ın kullanılışını anlatıcam


Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 1153
Yayın Tar:19.10.2004
Yazar : magna
Hit :3945

Bu Yazarın Yazıları Sadece bu yazarın  göster
Bu Yazıyı Tavsiye Et

4 tane modülünüz olacak...
DeclareModule.bas
FunctionModule.bas
SubModule.bas
Main.bas
Bunlar sırasıyla aşağıdadır.
Startup'ı SubMain olarak ayarlalamalısınız.
-----------------------------------------------------------
API Guide dan aldığım (kopyaladığım) kodları bir düzen içinde değerlendirmek ve toplamak için yeniden düzenledim.

SurucuListesi = sListAllDrives satırı ile ile Sub Main de çağırdığımız fonsiyonun döndürdüğü değer (biliyorsunuz bu değer kendine yüklenmiştir) Variant olarak tanımladığımız SurucuListesi değişkenine aynı şekilde değeri geçirmemizi sağlamakadır.
Sonuçları Degub.Print ile Immediate Window dan gözleyiniz.
Sonuçları içeren SurucuListesi dizinini bir çok uygulamada kullanabilirsiniz.
Sorularınız varsa bildiriniz.
-----------------------------------------------------------
Buna aslında XP görüntüsünde bir Klasör içeriği gösteren TreeView (ocx) yapmak için başladım.
Hazırını veya püfünü bilen varsa gösterirse memnun olurum...Ben bulamadım çünkü.
Saygılar
Şenol Ateş
ates@magnaidea.com

-----------------------------------------------------------

' "DeclareModule" adındaki bir olarak modüle atın

Option Explicit

'Sürücülerin Listesi
Public Const DRIVE_UNKNOWN = 0
Public Const DRIVE_ABSENT = 1
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Public Const ERROR_BAD_DEVICE = 1200&
Public Const ERROR_CONNECTION_UNAVAIL = 1201&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_NOT_SUPPORTED = 50&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_NOT_CONNECTED = 2250&
Public Const NO_ERROR = 0

Public Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" ( _
ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" ( _
ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

'Sürücü Etiket, Dosya Sistemi,Seri Numarası
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _
ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Public Suruculer() As String
'-------------------------------------------------------

' "FunctionModule" adındaki bir olarak modüle atın
Option Explicit

Public Function fDriveType(strDriveName As String) As String
Dim lngRet As Long
Dim strDrive As String
lngRet = GetDriveType(strDriveName)
Select Case lngRet
Case DRIVE_UNKNOWN 'The drive type cannot be determined.
strDrive = "Diğer Sürücüler"
Case DRIVE_ABSENT 'The root directory does not exist.
strDrive = "Sürücü Şu Anda Yok"
Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
strDrive = "Çıkarılabilir Depolama Birimli Sürücü"
Case DRIVE_FIXED 'The disk cannot be removed from the drive.
strDrive = "Sabit Disk Sürücüsü"
Case DRIVE_REMOTE 'The drive is a remote (network) drive.
strDrive = "Ağ Sürücüsü"
Case DRIVE_CDROM 'The drive is a CD-ROM drive.
strDrive = "CD Sürücüsü"
Case DRIVE_RAMDISK 'The drive is a RAM disk.
strDrive = "RAM Disk"
End Select
fDriveType = strDrive
End Function

Public Function fGetUNCPath(strDriveLetter As String) As String
On Local Error GoTo fGetUNCPath_Err

Dim Msg As String, lngReturn As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName = strDriveLetter
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName)
Select Case lngReturn
Case ERROR_BAD_DEVICE
Msg = "Error: Bad Device"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Error: Connection Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "Error: Extended Error"
Case ERROR_MORE_DATA
Msg = "Error: More Data"
Case ERROR_NOT_SUPPORTED
Msg = "Error: Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "Error: No Network Available or Bad Path"
Case ERROR_NO_NETWORK
Msg = "Error: No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Error: Not Connected"
Case NO_ERROR
' all is successful...
End Select
If Len(Msg) Then
MsgBox Msg, vbInformation
Else
fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
End If
fGetUNCPath_End:
Exit Function
fGetUNCPath_Err:
MsgBox Err.Description, vbInformation
Resume fGetUNCPath_End
End Function

Public Function fGetDrives() As String
'Returns all mapped drives
Dim lngRet As Long
Dim strDrives As String * 255
Dim lngTmp As Long
lngTmp = Len(strDrives)
lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
fGetDrives = Left(strDrives, lngRet)

End Function

Public Function SurucuEtiketBilgileri(ByVal GSurucu As String, GPublicSayac As Integer)

Dim Serial As Long, VName As String, FSName As String

'Create buffers
VName = String$(255, Chr$(0))
FSName = String$(255, Chr$(0))
'Get the volume information
GetVolumeInformation GSurucu, VName, 255, Serial, 0, 0, FSName, 255
'Strip the extra chr$(0)'s
VName = Left$(VName, InStr(1, VName, Chr$(0)) - 1)
FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)

Suruculer(2, GPublicSayac) = VName
Suruculer(3, GPublicSayac) = FSName
Suruculer(5, GPublicSayac) = Trim(Str$(Serial))

End Function
'-------------------------------------------------------


' "SubModule" adındaki bir olarak modüle atın
Option Explicit

Public Function sListAllDrives() As Variant
Dim strAllDrives As String
Dim strTmp As String
Dim SurucuTipi As String
Dim PublicSayac As Integer
PublicSayac = 0
strAllDrives = fGetDrives
If strAllDrives <> "" Then

Do
ReDim Preserve Suruculer(5, PublicSayac)
strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
SurucuTipi = fDriveType(strTmp)
Suruculer(0, PublicSayac) = SurucuTipi 'Tipi
Suruculer(1, PublicSayac) = strTmp 'Adı
SurucuEtiketBilgileri strTmp, PublicSayac
If SurucuTipi = "Ağ Sürücüsü" Then
Suruculer(4, PublicSayac) = Trim(fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))) 'Yolu
End If
PublicSayac = PublicSayac + 1
Loop While strAllDrives <> ""

End If

sListAllDrives = Suruculer

End Function
'-------------------------------------------------------

' BUNU DA main.bas olarak atın

Sub Main()

Dim xA, xB As Integer
Dim SurucuListesi As Variant
Dim Zaman, TabSay, TabAt, xTab As Integer

Zaman = Time
SurucuListesi = sListAllDrives
Zaman = Time
Debug.Print vbCrLf & Time, "Bilgisayarınızdaki Sürücüler Listeleniyor..."
Debug.Print "Sürücü Tipi", , , "Sürücü Tanımı", "Sürücü Etiket", "Dosya Sistemi", "UNC Yolu", "Seri Numarası"
Debug.Print "----------------------", , "-----------", "-------------", "-----------", "-----------", "-----------"

For xA = LBound(Suruculer, 2) To UBound(Suruculer, 2)
For xB = 0 To 5
TabSay = 3 - Int(Len(Suruculer(xB, xA)) / 15)
If Suruculer(xB, xA) = Empty Then
Debug.Print "Yok",
Else
Debug.Print Suruculer(xB, xA),
If xB = 0 And TabSay > 0 Then
For xTab = 1 To TabSay - 1
Debug.Print , ;
Next xTab
End If
End If
Next xB
Debug.Print
Next xA

Debug.Print Time, "Listeleme bitmiştir. " & Zaman & " milisaniye sürmüştür." & vbCrLf
End

End Sub




Bu sayfa için henüz yorum eklenmemiş.

© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin