Newsgroup: it.comp.lang.visual-basic
Titolo: Lettore CD in VB5

Vi interessa il codice ? Se si lo posso mettere sul sito comune ?
Post me !
Ciao, Mirko

se hai usato MCI con mciSendString() puoi aiutarmi
io con la stringa "status" non riesco a recuperare niente
Mirko Tebaldi (RealTebo) ha scritto nel messaggio
<01be5f78$2f2c4fe0$e29d0f97@pc-mirko>...


...

Ehi, se vuoi ti spedisco il progetto ! Ho messo la guida dentro !

...


Scusami, ma come ti invio il codice ?
Mandami la tua e-mail.... Ti mando il codice completo..
Ps. come lo metto sul sito comune ?!? (visto che interessa ?)

Sono un villano, lo so che non si mandano nove e-mail all'NG.. però
cuccati questo (PS Vb5 Pro Ita):
1) Il form
2) il progetto
3) il modulo
1) Contenuto di Form1.frm
VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Tebo's Cd Player"
   ClientHeight    =   1320
   ClientLeft      =   1590
   ClientTop       =   1470
   ClientWidth     =   4800
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1320
   ScaleWidth      =   4800
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   960
      Top             =   120
   End
   Begin VB.CommandButton eject
      Caption         =   "ejc"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      TabIndex        =   8
      Top             =   360
      Width           =   495
   End
   Begin VB.CommandButton ff
      Caption         =   ">>"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3720
      TabIndex        =   7
      Top             =   360
      Width           =   495
   End
   Begin VB.CommandButton rew
      Caption         =   "<<"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3240
      TabIndex        =   6
      Top             =   360
      Width           =   495
   End
   Begin VB.CommandButton ftrack
      Caption         =   ">>|"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   5
      Top             =   360
      Width           =   495
   End
   Begin VB.CommandButton btrack
      Caption         =   "|<<"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   360
      Width           =   495
   End
   Begin VB.CommandButton stopbtn
      Caption         =   "x"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      TabIndex        =   3
      Top             =   0
      Width           =   495
   End
   Begin VB.CommandButton pause
      Caption         =   "||"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3720
      TabIndex        =   2
      Top             =   0
      Width           =   495
   End
   Begin VB.CommandButton play
      Caption         =   ">"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2280
      TabIndex        =   1
      Top             =   0
      Width           =   1455
   End
   Begin VB.TextBox timeWindow
      Alignment       =   2  'Center
      BackColor       =   &H80000008&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "Arial"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000000&
      Height          =   735
      Left            =   120
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   2055
   End
   Begin VB.Label tracktime
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   3000
      TabIndex        =   10
      Top             =   960
      Width           =   1815
   End
   Begin VB.Label totalplay
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   960
      Width           =   2655
   End
   Begin VB.Menu options
      Caption         =   "Opzioni"
      Begin VB.Menu ffspeed
         Caption         =   "Turbo"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim fastForwardSpeed As Long    ' secondi per l'avanti / indietro veloce
Dim fPlaying As Boolean         ' true se il CD è in esecuzione
Dim fCDLoaded As Boolean        ' true se le info sul CD sono pervenute
Dim numTracks As Integer        ' numero di traccie
Dim trackLength() As String     ' array delle lunghezze traccia
Dim track As Integer            ' traccia in corso
Dim min As Integer              ' minuto corrente della traccia
Dim sec As Integer              ' secondo corremte della traccia
Dim cmd As String               ' stringa di comando spedita all'esecutore
MCI
' Spedisce le stringhe MCI
' Se fShowError è "true" mostra un messaggio d'errore
Private Function SendMCIString(cmd As String, fShowError As Boolean) As
Boolean
Static rc As Long
Static errStr As String * 200
rc = mciSendString(cmd, 0, 0, hWnd)
If (fShowError And rc <> 0) Then
    mciGetErrorString rc, errStr, Len(errStr)
    MsgBox errStr
End If
SendMCIString = (rc = 0)
End Function
Private Sub Form_Load()
' Vabbè, questo lo capisci da solo, no ?!?!
If (App.PrevInstance = True) Then
    End
End If
Timer1.Enabled = False 'Disabilita per ora l'aggiornamento del display
fastForwardSpeed = 5 'Imposta i secondo per l'avanti/indietro velocce
fCDLoaded = False 'Da per scontato che l'utente è brocco e non ha
                  ' messo dentro il cd
' Chide a Windows: "scusa, posso sfruttare il canale MCI per leggere
'                   i cd audio ?!"
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False)
Then
    ' Se il Cd è in uso perchè usato in chissà quale modo allora
    ' il lettore si suicida !
    ' al lato pratico apre un canale MCI, ovvero una routine di
    ' subsistem (livello kernel32, priorità= massima - 1, seconda solo
    ' al mouse e alle finestre d'errore) che si accoda all'evento
    ' _TIMER del clock di sistema per dar retta alla periferica CD.
    End
End If
SendMCIString "set cd time format tmsf wait", True
' "Scusa, windows, mi prepari il letttore Cd ?"
' (lo fa sempre se ha superato l'IF di prima)
Timer1.Enabled = True
'Abilita l'aggiornamento display
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Chiude tutti i canali MCI aperti dal programma
'se non lo fai si intrippa tutto windows !!!!!
SendMCIString "close all", False
End Sub
' Play (questo lo capisci, vero ?)
Private Sub play_Click()
SendMCIString "play cd", True
fPlaying = True
End Sub
' Stop
Private Sub stopbtn_Click()
' "Windows, ferma il Cd per favore e ASPETTA N'ATTIMO !"
SendMCIString "stop cd wait", True
' "Metti il lettore Cd ad inizio della traccia corrente, ti scongiuro"
cmd = "seek cd to " & track
SendMCIString cmd, True
fPlaying = False
Update 'Aggiorna il display
End Sub
' Pausa (chiaro, no?)
Private Sub pause_Click()
SendMCIString "pause cd", True
fPlaying = False
Update
End Sub
' Espelle
Private Sub eject_Click()
' Setta la door del cd su open
SendMCIString "set cd door open", True
Update 'secondo te ?
End Sub
' Avanza di un tot di tempo indicato da fastForwardSpeed
Private Sub ff_Click()
Dim s As String * 40
' Avvisa windows che le info che gli sto per dare saranno in millisecondi
' PS: E' necessario, non c'è scelta; la Microsoft è fatta così !"
SendMCIString "set cd time format milliseconds", True
' Ferma la lettura e mette in attesa il CD
' NOTA: il wait lo mette in attesa, se è fermo ci resta, se gira
'       continua a girare, pronto per evitare salti audio troppo marcati o
'       per evitare il ritorno del laser
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
    ' se il Cd è in esecuzione salta avanti dalla posizione attuale (s)
    ' di un tot di millisecondi pari a 100 * numero di sec impostati.
    cmd = "play cd from " & CStr(CLng(s) + fastForwardSpeed * 1000)
Else
    ' idem ma con CD non in esecuzione. Il Cd è fermo, viene spostato
    ' il laser, fatto fare circa 15 giri al CD per un posizionamento
    ' perfetto, quindi ... basta, è pronto
    cmd = "seek cd to " & CStr(CLng(s) + fastForwardSpeed * 1000)
End If
'spedisce i comandi di cui sopra
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
'Dice a Windows che ora puo spedirci le info sul tempo Cd nel suo modo
' quale ?!?!
Update
End Sub
' Riavvolge
' vedi sub precedente
Private Sub rew_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
    cmd = "play cd from " & CStr(CLng(s) - fastForwardSpeed * 1000)
Else
    cmd = "seek cd to " & CStr(CLng(s) - fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub
' TRaccia successiva
' Non ho voglia di spiegare altro, è inglese corrente !
Private Sub ftrack_Click()
If (track < numTracks) Then
    If (fPlaying) Then
        cmd = "play cd from " & track + 1
        SendMCIString cmd, True
    Else
        cmd = "seek cd to " & track + 1
        SendMCIString cmd, True
    End If
Else
' se mandi avanti una traccia dall'ultima torna alla prima, ovvio !
    SendMCIString "seek cd to 1", True
End If
Update
End Sub
' Traccia precedente
' vedi sub precedente, anche se questa è orghanizzata diversamente
' per variare lo stile
Private Sub btrack_Click()
Dim from As String
If (min = 0 And sec = 0) Then
    If (track > 1) Then
        from = CStr(track - 1)
    Else
        from = CStr(numTracks)
    End If
Else
    from = CStr(track)
End If
If (fPlaying) Then
    cmd = "play cd from " & from
    SendMCIString cmd, True
Else
    cmd = "seek cd to " & from
    SendMCIString cmd, True
End If
Update
End Sub
' Aggiorna il display e le variabili di stato
Private Sub Update()
Static s As String * 30
' Controlla su il Cd è inserito, restuisce un "quasi-booleano"
mciSendString "status cd media present", s, Len(s), 0
' Se il CD è inserito
If (CBool(s)) Then
    If (fCDLoaded = False) Then
        'Se ancora non abbiamo le info sul CD se le procura
        'fCDLoaded viene messo a true dopo questa lettura, quindi
        'viene fatto solo all'inserimento del CD
        'Numero traccie
        mciSendString "status cd number of tracks wait", s, Len(s), 0
        numTracks = CInt(Mid$(s, 1, 2))
        eject.Enabled = True
        's è la lunghezza del CD. Chiossà poi perchè windows che
        'usa un formato suo ce lo dice già in mm:ss ?!?
        mciSendString "status cd length wait", s, Len(s), 0
        totalplay.Caption = "Brani: " & numTracks & "  Totale: " & s
        'memo sull'array delle info traccie
        'utile per il tempo rimasto
        ReDim trackLength(1 To numTracks)
        Dim i As Integer
        For i = 1 To numTracks
            cmd = "status cd length track " & i
            mciSendString cmd, s, Len(s), 0
            'la lunghezza traccia è una stringa che, oltre
            ' alla lunghezza nel formato min:sec:cent contiene
            ' un sacco di sozzeria che, però, non necessita di
            ' filtraggio perchè non vengono visualizzate (sia resa
            ' lode ai font file incompleti dei simboli strani !)
            trackLength(i) = s
        Next
        play.Enabled = True
        pause.Enabled = True
        ff.Enabled = True
        rew.Enabled = True
        ftrack.Enabled = True
        btrack.Enabled = True
        stopbtn.Enabled = True
        fCDLoaded = True
        'partiamo dalla uno, dai !!!
        SendMCIString "seek cd to 1", True
    End If
    ' Chiede il tempo d'avanzamento attuale della traccia in esecuzione
    mciSendString "status cd position", s, Len(s), 0
    ' Ovviamento viene dato in un ennesimo formato diverso !
    track = CInt(Mid$(s, 1, 2))
    min = CInt(Mid$(s, 4, 2))
    sec = CInt(Mid$(s, 7, 2))
    timeWindow.Text = "[" & Format(track, "00") & "] " & Format(min, "00") _
            & ":" & Format(sec, "00")
    tracktime.Caption = "Durata: " & trackLength(track)
    ' Controlla se il Cd è in esecuzione, così al prossimo
    ' evento _Timer il display non sta lì ad aggiornarsi
    ' inutilmente
    mciSendString "status cd mode", s, Len(s), 0
    fPlaying = (Mid$(s, 1, 7) = "playing")
Else 'se il Cd non è inserito
    eject.Enabled = False
    ' Disabilita i controlli e pulisce il display
    ' perchè se abbiamo le info sul CD vuol dire che qualche villano
    ' ha sputato fuori il CD mentre era in play !!
    If (fCDLoaded = True) Then
        play.Enabled = False
        pause.Enabled = False
        ff.Enabled = False
        rew.Enabled = False
        ftrack.Enabled = False
        btrack.Enabled = False
        stopbtn.Enabled = False
        fCDLoaded = False
        fPlaying = False
        totalplay.Caption = ""
        tracktime.Caption = ""
        timeWindow.Text = ""
    End If
End If
End Sub
' Imposta l'avanzamento veloce
Private Sub ffspeed_Click()
Dim s As String
s = InputBox("Secondi di avanzamento/riavvolgimento veloce ?", "Fast Forward
Speed", CStr(fastForwardSpeed))
If IsNumeric(s) Then
    'non si sa mai la perrversità dell'utente cosa lo porti a fare !!
    fastForwardSpeed = CLng(s)
End If
End Sub
Private Sub Timer1_Timer()
 Update 'appena ne ha voglia (_TIMER) aggiorna il display
End Sub
' ----------------
' ----------------
2) Contenuto di CdPlayer.vbp
Type=Exe
Form=Form1.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\WINDOWS\SYST
EM\StdOle2.tlb#OLE Automation
Module=Module1; ..\..\Linguaggi\Lavori\Cd Player\Module1.bas
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="Leifen's CD PLAYER"
ExeName32="Project1.exe"
Command32=""
Name="CDPlyr"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
ThreadPerObject=0
MaxNumberOfThreads=1
3) Module1.bas
Attribute VB_Name = "Module1"
Option Explicit
' dichiariamo prima la routine che, in caso di OVVI errori ci speiga
' cos'è in ITALIANO !
Declare Function mciGetErrorString Lib "winmm.dll" Alias
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String,
ByVal uLength As Long) As Long
' adesso, più tranquilli, possiamo dichiarare la routine per la
' comunicazione delle stringhe di comando veros il canale MCI
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal
lpstrCommand As String, ByVal lpstrReturnString As String, ByVal
uReturnLength As Long, ByVal hwndCallback As Long) As Long
'NOTE esecutive:
' 1 - Se durante l'esecuzione del lettore si ferma il progetto
'       col tasto stop del VB5 il canale MCI resta aperto, per
'       cui viene avvisato l'utente che l'alias del canale MCI
'       è gia in uso. Qualsiasi cosa voglia dire si rende ora
'       necessario procedere come segue:
'       a - Stoppare il progetto
'       b - avviarlo CON F8
'       c - dopo la primissima istruzione eseguire da
'           finestra "immediata" la seguente istruzione:
'           SendMCIString "close all", True
'       d - stoppare il progetto
'OK
'Altre note attualmente non ce ne sono