Volker.
schau mal bei http://www.webdesigners.de/Accessware/ vorbei
Viele Grüße aus Ansfelden bei Linz / Österreich
Peter
Volker Bertsch schrieb in Nachricht
<6uoebs$ctm$1...@nz12.rz.uni-karlsruhe.de>...
1. Gib folgendes im Funktions-Deklarationsteil ein
eines VBA Moduls ein:
----------------------------------------------------------------------
Dim r as string * 255
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
Function MCISend(ByVal Cmd$, Rets$)
Dim RetSend As Long
Dim ErrorStr As String * 255
Dim InfoStr As String * 255
Cmd$ = Cmd$ + Chr$(0)
RetSend = mciSendString(Cmd$, InfoStr, 255, 0)
Rets$ = Left$(InfoStr, InStr(InfoStr, Chr$(0)) - 1)
End Function
Unter Verwendung der vorstehenden Funktion mciSend kannst
Du nun Dein CD Rom Laufwerk als CD-Spieler verwenden und steuern,
d.h. also auch Titellaengen etc. auslesen (die Laengen und
Ergebnisse werden bei Bedarf immer im Rueckgabestring r$ von der
Funktion zurueckgegeben - Du selbst darfst nichts an die
Variable uebergeben):
Du musst aber vor dem Starten einer CD
grundsaetzlich mit folgenden Befehlen starten und am Schluss
beenden (sonst treten
Fehler auf bzw. CD startet nicht): - Am besten im Direktfenster testen:
mciSend "Open CDAudio", r$ 'Oeffnet CDSpieler (jedoch noch kein
Spielstart!)
mciSend "Set CDAudio Time Format tmsf", r$ ' Einstellung auf Track,
Min.,Sek.,Frame)
... es koennen nun die Wunschbefehle (s.unten) eingegeben werden,...
und immer beenden mit
mciSend "Close CDAudio",r$ ' CDSpieler schliessen (bewirkt jedoch keinen
Spielstopp!)
Und hier nun die Befehle, die nach dem Oeffnen (Open CDAudio) und
Festlegen des Anzeigestatus (Setzen auf Track,Zeit) moeglich sind:
******
mciSend "Status CDAudio Length Track 5",r$ '(Beisp.: Liefert im String
r$
die Spielzeit/Laenge des Track 5 zurueck)
******
mciSend "Status CDAudio length",r$ 'Liefert Gesamtlaenge CD im String r$
mciSend "Play CDAudio",r$ 'Startet CD vom Anfang an
mciSend "Status CDAudio current track",r$ 'Liefert gerade spielende
Tracknummer
mciSend "Play CDAudio From 5",r$ 'Beisp.: Spielt ab Track 5
mciSend "Play CDAudio From 5 to 6" 'Beisp.: Spielt nur Track 5
mciSend "Pause CDAudio",r$ 'Anhalten/Pause CD, weiter wieder mit "Play
CDAudio" (s.o.)
mciSend "Stop CDAudio",r$ 'Stoppt CD endgueltig, Neustart oder anderer
Track moeglich,
solange nicht mit Close CDAudio
beendet.
mciSend "Status CDAudio Media present",r$ 'Liefert in r$ den Wert FALSE,
wenn
keine CD im Laufwerk, sonst TRUE
Gruss Uwe
von Claus Lerch am 10.6. gepostet:
'***************************************
Function CDNum (Drive As String) As String
On Error GoTo CDNum_Err
Dim cdfile As String * 44
Dim i As Integer
If Dir$(Drive & "\Track01.CDA") = "" Then
CDNum = ""
Exit Function
End If
Open Drive & "\Track01.CDA" For Binary Shared As #1
Get 1, , cdfile
CDNum = Format$(Asc(Mid$(cdfile, 25, 1)), "000") _
& Format$(Asc(Mid$(cdfile, 26, 1)), "000") _
& Format$(Asc(Mid$(cdfile, 27, 1)), "000")
Close 1
Exit Function
CDNum_Err:
If Err = 71 Then
If MsgBox("Bitte CD einlegen und Laufwerk schliessen.", _
1 + 64, "CD-Info") = 1 Then
Resume
Else
CDNum = ""
Exit Function
End If
Else
MsgBox Error$, 64, "Fehlernummer: " & Str(Err)
On Error Resume Next
Close 1
Exit Function
End If
End Function
Die Nummer ist in Byte 25-27 als ASCII-Zeichen in jedem .CDA-File
abgelegt. Die Werte als Zeichenkette hintereinandergehaengt geben
die Nummer.
Im uebrigen kann man aus Byte 42 und 43 die Laenge jedes Tracks
ermitteln.
Function TrackLength (Drive As String, TrackNum As Integer) As Double
On Error GoTo TrackLength_Err
Dim cdfile As String * 44
Dim i As Integer
If Dir$(Drive & "\Track" & Format(TrackNum, "00") & ".CDA") = "" Then
MsgBox "Spur " & Format(TrackNum, "00") & _
" nicht vorhanden", 64, "CD-Info"
Exit Function
End If
Open Drive & "\Track" & Format(TrackNum, "00") & _
".CDA" For Binary Shared As #1
Get 1, , cdfile
TrackLength = TimeSerial(0, Asc(Mid$(cdfile, 43, 1)), _
Asc(Mid$(cdfile, 42, 1)))
Close 1
Exit Function
TrackLength_Err:
If Err = 71 Then
If MsgBox("Bitte CD einlegen und Laufwerk schliessen.", _
1 + 64, "CD-Info") = 1 Then
Resume
Else
Exit Function
End If
Else
MsgBox Error$, 64, "Fehlernummer: " & Str(Err)
Exit Function
End If
End Function
'****************************************
>Viele Grüße aus Ansfelden bei Linz / Österreich
>Peter
Heyheyhey, die Wüste lebt? In Ansfelden gibt's jetzt auch schon
Computer und sogar Access-Programmierer?
Dachte mit meiner Flucht sei da alles ausgestorben.
(Haid bis vor einigen Jährchen)
Servus
Karl
*************************************
Am 3./4.10.98 veranstalten wir die "1. Access-Entwickler-Konferenz (AEK)".
Nähere Info dazu bei http://members.ping.at/donkarl/ und hier in der NG.
Karl Donaubauer schrieb in Nachricht
<6up7t2$pvm$5...@fleetstreet.Austria.EU.net>...
>von Claus Lerch am 10.6. gepostet:
>'***************************************
>Function CDNum (Drive As String) As String
>Function TrackLength (Drive As String, TrackNum As Integer) As Double
ersetzen zu
Function TrackLength (Drive As String, TrackNum As Integer) As Date
Nett, das Teil.
Hast du evtl. auch den Befehl zum Auslesen der Titel parat,
oder geht das nicht?
gruss
gerd
UW> Es gibt leider keine API Funktion fuer das Auslesen
UW> der Titel im Klartext, weils leider auch -soweit mir
UW> bekannt- keine Speicherung auf der CD gibt.
Oh.
welch Alptraum(a)
jedenfalls danke für die Antwort
gerd
Sorry, dass ich keine bessere Nachricht habe...
Ich haette natuerlich auch gern die Titel gehabt, um
mir das muehselige Schreiben in eine Datenbank
zu ersparen...
Gruss Uwe
----------
> Von: Gerd Schlag <G.Sc...@TBX.berlinet.de>
>
> Hallo Weineck <uwe1 // 6up3p8$9cl$1...@unlisys.unlisys.net>
> "Re: Audio CD Titel-Zeiten auslesen" /DE/COMP/DATENBANKEN/MS-ACCESS