Newsgroup: it.comp.lang.visual-basic
Titolo: [VB6] Detect e lista SOUND CARD

La seguente routine mi da il numero 6 delle 6 schede audio inserite nel PC.
---cut---
    Dim i As Long
    i = waveOutGetNumDevs()
    MsgBox i
    If i > 0 Then
        MsgBox "Your system can play sound files.", vbInformation, "Sound 
Card Test"
    Else
        MsgBox "Your system can not play sound Files.", vbInformation, 
"Sound Card Test"
    End If
--cut---
Come si può a trovare ed aggiungervi il nome di corrispondenza di ognuna 
delle schede col suo numerino di riferemento tipo
1 SOUND BLASTER LIVE!
2 SOUNDMAX
3 USB 1
4 VIRTUAL SAM 1
5 USB AUDIO CARD
6 ...
grazie
Ciao
----== Posted via Pronews.Com - Unlimited-Unrestricted-Secure Usenet News==----
http://www.pronews.com
 The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= - Total Privacy via Encryption =---

 ---= - Total Privacy via Encryption =---
Magari dicci cosa c'è scritto in waveOutGetNumDevs()
Ciao

> Ciao
Ciao, grazie per la risposta, come scritto sopra mi da il numero 6 cioè I = 
6.... le sei schede... mi da solo il numero non so se riesco a dedurne anche 
il nome della periferica...
mancava questo:
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
ciao
----== Posted via Pronews.Com - Unlimited-Unrestricted-Secure Usenet News==----
http://www.pronews.com
 The #1 Newsgroup Service in the World! >100,000 Newsgroups


 6 ...
Così:
'Metti su un modulo e avvia da Main
Private Const CALLBACK_WINDOW = &H10000
Private Const MAXPNAMELEN& = 32
Private Type MIXERCAPS
     wMid As Integer
     wPid As Integer
     vDriverVersion As Long
     szPname As String * MAXPNAMELEN
     fdwSupport As Long
     cDestinations As Long
End Type
Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal 
uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal 
fdwOpen As Long) As Long
Private Declare Function mixerGetDevCaps Lib "winmm.dll" Alias 
"mixerGetDevCapsA" (ByVal uMxId As Long, pmxcaps As MIXERCAPS, ByVal 
cbmxcaps As Long) As Long
Sub Main()
    Dim lMixer As Long
    Dim mc As MIXERCAPS
    lMixerCnt = mixerGetNumDevs
    If lMixerCnt Then
        For lLoop = 0 To lMixerCnt - 1
            lRtn = mixerOpen(lMixer, lLoop, hWnd, 0&, CALLBACK_WINDOW)
            If lRtn = 0 Then
                lRtn = mixerGetDevCaps(lMixer, mc, Len(mc))
                If lRtn = MMSYSERR_NOERROR Then
                    With mc
                         m_Destinations = .cDestinations
                         m_DeviceID = lLoop
                         m_DriverVersion = CStr(HiByte(mc.vDriverVersion) & 
"." & LoByte(mc.vDriverVersion))
                         m_hMixer = lMixer
                         m_ManufacturerID = .wMid
                         m_ProductID = .wPid
                         m_ProductName = TrimNulls(mc.szPname)
                    End With
                    s = s & m_DeviceID & ") - " & m_ProductName & vbCrLf
                End If
            End If
        Next lLoop
        MsgBox s
    End If
End Sub
Private Function HiByte(ByVal wParam As Integer) As Byte
     HiByte = (wParam And &HFF00&) \ (&H100)
End Function
Private Function LoByte(ByVal wParam As Integer) As Byte
     LoByte = wParam And &HFF&
End Function
Private Function TrimNulls(sString As String) As String
     TrimNulls = Left(sString, InStr(1, sString, Chr(0)) - 1)
End Function
-- 
Ciao Fede
By Chicco Production
http://bcp.freetools.it

 Ciao Fede
Ciao Fede grazie mille provo subito in serata appena rientro!


m_DriverVersion = CStr(HiByte(mc.vDriverVersion) & "." & 
LoByte(mc.vDriverVersion))
Alura... ringraziandoti ancora per l'aiuto nell'attesa che il msgbox mi dia 
la lista "s"
fino a qui va poi qui dice:
HiByte variabile o sub NON definita.... più avanti non sono potuto andare ma 
forse anche LoByte mi dirà la stessa cosa?
non saprei....
grazie ancora...


 non saprei....
Impossibile l'ho testato di persona prima di inviartelo,
il codice è integro.
Può darsi che l'abbia copiato male!
Comunque le funzioni che non trova (ma che ci sono) sono:
Private Function HiByte(ByVal wParam As Integer) As Byte
     HiByte = (wParam And &HFF00&) \ (&H100)
End Function
Private Function LoByte(ByVal wParam As Integer) As Byte
     LoByte = wParam And &HFF&
End Function
Il codice che ti ho fornito ti serve tutto e non solo una parte,
eventualmente...


 Private Function[CUT]
"Private"... se l'ha messo in un modulo ovviamente non va.
ApipApip, prova a cambiarlo in Public.
Bye, G. 

Paperino ha scritto...

Il bello è che tutto il codice che gli ho dato per la prova,
andava messo su un modulo!
Colpa mia che ho dato alcune cose per scontate!


 Colpa mia che ho dato alcune cose per scontate!
no no... colpa mia!!!! :-))) mea culpa!
M'erano sfuggite le ultime due linee.... nel copia incolla.... eppure avevo 
anche controllato ma ormai....ormai vado sempre in ... "Personal Limited 
Edition"... :-))))
DA DIO! grazie..
Finalmente evitare di sempre cambiare SB... a mano e ricompilare... avendone 
6 dentro sto povero PC...
Grazie mille!
Anto
