Skip Navigation Links
Novas Tecnologias
Ferramentas Adicionais
Ferramentas Adicionais


Dica No :
234
Assunto : Visual Basic
Titulo: Localizar a letra do drive de CD-ROM

Gostou do texto ? Vote e dê sua opinião! Pontuação atual :

Translate this page now :






Adicione aos Favoritos!
BlogBlogs Rec6 Linkk Ueba Technorati Delicious DiggIt! StumbleUpon



É comum precisarmos descobrir a letra do cd-rom na máquina do usuário, para podermos localizar/utilizar arquivos que estejam no cd da nossa aplicação.

Para fazer isso temos que obter informações sobre os discos da máquina utilizando API's e pesquisar seu tipo. De acordo com o tipo poderemos localizar o CD-ROM.

Precisaremos de duas API's : GetLogicalDriveStrings para obter os drives da máquina e GetDriveType para obter o tipo de cada um e assim localizar o CD-ROM.

A função GetDriveStrings faz o processamento para obter as letras de disco. A função GetLogicalDriveStrings precisa receber uma variável string já com o tamanho correto e irá preencher esta variável com as letras de disco.

Como não sabemos esse tamanho a função é chamada 2 vezes. Na 1a não conclui a tarefa dela, mas devolve (na variável result) o tamanho que precisa na variável. Então preenchemos a variável com vazios (função string) e chamamos novamente.

O código que encontra-se no botão (commandbutton1) chama a função GetDriveStrings e, para cada letra de drive obtida, chama a GetDriveType para verificar o tipo do drive. Se for DRIVE_CDROM (constante definida no inicio do código) então o cd-rom foi localizado.

As funções da API estão definidas como private neste código, para serem colocadas dentro de um form. Isso pode ser mudado para public para que elas sejam inseridas em um módulo

Também é muito útil transformar o command1_click em uma função que devolva a letra do drive de CD.


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

Const DRIVE_CDROM& = 5

Public Function GetDriveStrings() As String
' Wrapper for calling the GetLogicalDriveStrings api

Dim result As Long ' Result of our API calls
Dim strDrives As String ' String to pass to API call
Dim lenStrDrives As Long ' Length of the above string

' Call GetLogicalDriveStrings with a buffer size of zero to
' find out how large our stringbuffer needs to be
result = GetLogicalDriveStrings(0, strDrives)

strDrives = String(result, 0)
lenStrDrives = result

' Call again with our new buffer
result = GetLogicalDriveStrings(lenStrDrives, strDrives)

If result = 0 Then
' There was some error calling the API
' Pass back an empty string
' NOTE - TODO: Implement proper error handling here
GetDriveStrings = ""
Else
GetDriveStrings = strDrives
End If
End Function

Private Sub Command1_Click()
Dim strDrives As String

' Find out what drives we have on this machine
strDrives = GetDriveStrings()

If strDrives = "" Then
' No drives were found
MsgBox "No Drives were found!", vbCritical
Else
' Walk through the string and check the type of each drive
' displaying any cd-rom drives we find
Dim pos As Long
Dim drive As String
Dim drivetype As Long

pos = 1

Do While Not Mid$(strDrives, pos, 1) = Chr(0)
drive = Mid$(strDrives, pos, 3)
pos = pos + 4
drivetype = GetDriveType(drive)
If drivetype = DRIVE_CDROM Then
MsgBox "CD-ROM found at drive " & UCase(drive)
End If
Loop
End If
End Sub

Nome :
E-mail:
Comentarios :
 
 
Os Últimos Comentários
Nenhum comentário foi realizado ainda. Seja o primeiro !
Dicas
Dica do Dia
Receba Dicas Por Email
E-mail :  
 


 (help)
Aceito receber informativos do devASPNet, informações de eventos e treinamentos

Veja Quais Informativos Você Receberá

Pesquisar Dicas
Pesquisar Artigos, Dicas e Noticias

Banco de Dados
Algumas Entrevistas
Links Importantes

Búfalo Informática, Treinamento e Consultoria
R. Alvaro Alvim, 37/920 Centro - Cinelândia - Rio de Janeiro Cep: 20031-010
Tel : (21) 2262-1368 (21) 9240-5134 E-mail : Contato@bufaloinfo.com.br