1	REM ***********************************************************************
2	REM Titel: 		Winword 6.0 - CDPlayer-Makro
3	REM Autor:		(c) Copyright Ralf Nebelo & ct 12/94
4	REM Version:	1.0
5	REM
6	REM Voraussetzungen:	
7	REM				- Windows 3.1/3.11
8	REM				- CD-ROM-Laufwerk nach MPC-Norm
9	REM				- Windows Sound System 2.0 (Lautstrkeregelung)
10	REM ***********************************************************************
11	
12	REM ***********************************************************************
13	REM Deklarationen
14	REM ***********************************************************************
15	
16	Declare Function GetWindowsDirectory Lib "kernel"(lpbuffer As String, nsize As Integer) As Integer
17	
18	Declare Function mciSendString Lib "MMSystem"(lpstrCommand As String, lpstrReturn As String, nSize As Integer, hCallback As Integer) As Long
19	
20	Declare Function mciGetErrorString Lib "MMSystem"(dwError As Long, lpstrBuffer As String, wLength As Integer) As Integer
21	
22	Dim Shared TrackName$(0), TrackStartPos$(0), TrackLen(0), TrackAnz
23	
24	Dim Shared CdEjected, CDLnge$, CDIntroLen, CDAltTrack, PausePos$
25	
26	Dim Shared IniDat$, CdCheckSum$, CdTitel$, VolCntrl$
27	
28	REM ***********************************************************************
29	REM Player-Dialog gestalten und aufrufen
30	REM ***********************************************************************
31	
32	Sub MAIN
33		IniDat$ = GetWinDir$(1) + "WW6-CD.INI"
34		DlgTitel$ = "ct-Player"
35		VolCntrl$ = GetPrivateProfileString$("Tools", "Volume", GetWinDir$(1) + "sndsys.ini")
36		CdEjected = - 1
37		Begin Dialog BenutzerDialog 438, 326, DlgTitel$, .MainFunk
38			Text 11, 88, 40, 13, "&Titel:", .Text1
39			TextBox 11, 103, 416, 18, .Tracktitel
40			ListBox 11, 127, 416, 140, TrackName$(), .Trackliste
41			PushButton 11, 274, 100, 21, "&Play", .Play
42			PushButton 116, 274, 100, 21, "P&ause", .Pause
43			PushButton 221, 274, 100, 21, "&Stop", .Stop
44			PushButton 326, 274, 100, 21, "&Eject", .Eject
45			PushButton 11, 298, 100, 21, "S&chlieen", .Schlieen
46			PushButton 116, 298, 100, 21, "<", .Zurck
47			PushButton 221, 298, 100, 21, ">", .Vor
48			PushButton 326, 298, 100, 21, "&Volume", .Volume
49			GroupBox 11, 5, 416, 80, "", .Rahmen1
50			Text 18, 19, 68, 13, "CD-T&itel:", .Text2
51			TextBox 117, 16, 296, 18, .CDTitel
52			Text 18, 36, 40, 15, "Titel:", .Text3
53			Text 272, 36, 29, 15, "von", .Text4
54			Text 18, 51, 95, 15, "CD-Laufzeit:", .Text5
55			Text 272, 51, 29, 15, "von", .Text6
56			Text 18, 66, 95, 13, "Titellaufzeit:", .Text7
57			Text 272, 66, 29, 15, "von", .Text8
58			Text 192, 36, 30, 15, "", .TrackNr
59			Text 388, 36, 30, 15, "", .TrackZahl
60			Text 168, 51, 50, 15, "", .CDPos
61			Text 364, 51, 50, 15, "", .CDLen
62			Text 168, 66, 50, 15, "", .TrackPos
63			Text 364, 66, 50, 15, "", .TrackLen
64		End Dialog
65		Dim dlg As Dialog BenutzerDialog
66		Funk = Dialog(dlg, 1)
67	End Sub
68	
69	REM ***********************************************************************
70	REM Player-Dialogfunktion
71	REM ***********************************************************************
72	
73	Function MainFunk(Bezeichner$, Aktion, Zusatzwert)
74		EingabeUnterdrcken
75		Select Case Aktion
76		Case 1
77			If VolCntrl$ = "" Then
78				DlgAktivieren "Volume", 0
79			End If
80		Case 2
81			Weiteranzeigen = - 1
82			If Bezeichner$ = "Play" Then
83				Call PlayTrack(DlgWert("Trackliste") + 1)
84			ElseIf Bezeichner$ = "Schlieen" Then
85				WriteTitles
86				Weiteranzeigen = 0
87			ElseIf Bezeichner$ = "Zurck" Then
88				Track = DlgWert("Trackliste") + 1
89				If Track > 1 Then
90					DlgWert "Trackliste", Track - 2
91				Else
92					DlgWert "Trackliste", TrackAnz - 1
93				End If
94				Call PlayTrack(DlgWert("Trackliste") + 1)
95			ElseIf Bezeichner$ = "Vor" Then
96				Track = DlgWert("Trackliste") + 1
97				If Track < TrackAnz Then
98					DlgWert "Trackliste", Track
99				Else
100					DlgWert "Trackliste", 0
101				End If
102				Call PlayTrack(DlgWert("Trackliste") + 1)
103			ElseIf Bezeichner$ = "Pause" Then
104				If DlgText$(Bezeichner$) = "P&ause" Then
105					tmp$ = SendMci$("pause cdaudio")
106					PausePos$ = SendMci$("status cdaudio position")
107					DlgText$ Bezeichner$, "&Weiter"
108				Else
109					tmp$ = SendMci$("play cdaudio from " + PausePos$)
110					PausePos$ = ""
111					DlgText$ Bezeichner$, "P&ause"
112				End If
113			ElseIf Bezeichner$ = "Stop" Then
114				tmp$ = SendMci$("stop cdaudio")
115				tmp$ = SendMci$("close cdaudio")
116			ElseIf Bezeichner$ = "Eject" Then
117				WriteTitles
118				tmp$ = SendMci$("stop cdaudio")
119				tmp$ = SendMci$("close cdaudio")
120				tmp$ = SendMci$("set cdaudio door open")
121			ElseIf Bezeichner$ = "Volume" Then
122				Shell VolCntrl$
123			ElseIf Bezeichner$ = "Trackliste" Then
124				DlgText$ "Tracktitel", DlgText$(Bezeichner$)
125			End If
126		Case 3
127			If Bezeichner$ = "Tracktitel" Then
128				Track = DlgWert("Trackliste")
129				If DlgText$(Bezeichner$) > "" Then
130					TrackName$(Track) = DlgText$(Bezeichner$)
131				Else
132					TrackName$(Track) = "??"
133				End If
134				DlgListenfeldDatenfeld "Trackliste", TrackName$()
135				DlgWert "Trackliste", Track
136			ElseIf Bezeichner$ = "CDTitel" Then
137				CdTitel$ = DlgText$(Bezeichner$)
138			End If
139			WeiterAnzeigen = - 1
140		Case 5
141			If CdEjected = - 1 Then
142				CdOK = CdInit
143				If CdOK = - 1 Then
144					DlgListenfeldDatenfeld "Trackliste", TrackName$()
145					DlgAktivieren "Play", 1
146					DlgAktivieren "Zurck", 1
147					DlgAktivieren "Vor", 1
148					DlgAktivieren "Pause", 1
149					DlgAktivieren "Stop", 1
150					If SendMci$("capability cdaudio can eject") = "true" Then
151						DlgAktivieren "Eject", 1
152					Else
153						DlgAktivieren "Eject", 0
154					End If
155				End If
156			End If
157			If SendMci$("status cdaudio ready") <> "true" Then
158				Redim TrackStartPos$(0), TrackName$(0), TrackLen(0)
159				TrackName$(0) = "Bitte CD einlegen..."
160				DlgFokus "Schlieen"
161				DlgListenfeldDatenfeld "Trackliste", TrackName$()
162				DlgAktivieren "Play", 0
163				DlgAktivieren "Zurck", 0
164				DlgAktivieren "Vor", 0
165				DlgAktivieren "Pause", 0
166				DlgAktivieren "Stop", 0
167				DlgAktivieren "Eject", 0
168				DlgText$ "CDTitel", ""
169				DlgText$ "Tracktitel", ""
170				DlgText$ "TrackNr", "00"
171				DlgText$ "TrackZahl", "00"
172				DlgText$ "CDPos", "00:00"
173				DlgText$ "CDLen", "00:00"
174				DlgText$ "TrackPos", "00:00"
175				DlgText$ "TrackLen", "00:00"
176				CDAltTrack = - 1
177				CdEjected = - 1
178			Else
179				Cmd$ = "status cdaudio current track"
180				CDAktTrack = Val(SendMci$(Cmd$))
181				If CDAktTrack <> CDAltTrack Then
182					DlgWert "Trackliste", CDAktTrack - 1
183					DlgText$ "CDTitel", CdTitel$
184					DlgText$ "Tracktitel", TrackName$(CDAktTrack - 1)
185					CDAltTrack = CDAktTrack
186					DlgText$ "TrackNr", ShowNr$(CDAktTrack)
187					DlgText$ "TrackZahl", ShowNr$(TrackAnz)
188					DlgText$ "CDLen", CDLnge$
189					DlgText$ "TrackLen", ShowZeit$(TrackLen(CDAktTrack - 1))
190				End If
191				CDPos$ = SendMci$("status cdaudio position")
192				DlgText$ "CDPos", Left$(CDPos$, 5)
193				DlgText$ "TrackPos", ShowZeit$(GetSekunden(CDPos$) - GetSekunden(TrackStartPos$(CDAktTrack - 1)))
194			End If
195			Weiteranzeigen = - 1
196		Case Else
197		End Select
198		MainFunk = WeiterAnzeigen
199	End Function
200	
201	REM ***********************************************************************
202	REM Player-Funktionen und Prozeduren
203	REM ***********************************************************************
204	
205	Function SendMci$(Cmd$)
206		Result$ = String$(256, 0)
207		Status = mciSendString(Cmd$, Result$, Len(Result$), 0)
208		If Status <> 0 Then
209			Status = mciGetErrorString(Status, Result$, Len(Result$))
210		End If
211		i = InStr(Result$, Chr$(0))
212		If i <> 0 Then
213			tmp$ = Left$(Result$, i - 1)
214		Else
215			tmp$ = Result$
216		End If
217		If InStr(tmp$, "Gert ist bereits geffnet") > 0 Then
218			tmp$ = "Gert wird von einer anderen Anwendung benutzt"
219		ElseIf InStr(tmp$, "Der Gertename wird von dieser Anwendung") Then
220			tmp$ = "1"
221		End If
222		SendMci$ = tmp$
223	End Function
224	
225	Function CdInit
226		tmp$ = SendMci$("close cdaudio")
227		tmp$ = SendMci$("open cdaudio")
228		If tmp$ = "1" Then
229			CDAltTrack = - 1
230			PausePos$ = ""
231			CdEjected = 0
232			Call GetTracks
233			CdInit = - 1
234		Else
235			CdInit = 0
236		End If
237	End Function
238	
239	Sub GetTracks
240		CDLnge$ = Left$(SendMci$("status cdaudio length"), 5)
241		TrackAnz = Val(SendMci$("status cdaudio number of tracks"))
242		Redim TrackStartPos$(TrackAnz - 1), TrackName$(TrackAnz - 1), TrackLen(TrackAnz - 1)
243		For i = 1 To TrackAnz
244			Cmd$ = "status cdaudio position track" + Str$(i)
245			TrackStartPos$(i - 1) = SendMci$(Cmd$)
246		Next i
247		CDIntroLen = GetSekunden(TrackStartPos$(0))
248		For i = 1 To TrackAnz
249			If i < TrackAnz Then
250				TrackLen(i - 1) = GetSekunden(TrackStartPos$(i)) - GetSekunden(TrackStartPos$(i - 1))
251			Else
252				TrackLen(TrackAnz - 1) = GetSekunden(CDLnge$) - GetSekunden(TrackStartPos$(TrackAnz - 1)) - CDIntroLen
253			End If
254		Next i
255		Call GetTitles
256	End Sub
257	
258	Function GetSekunden(TrackPos$)
259		If TrackPos$ > "" Then
260			m = Val(Left$(TrackPos$, 2))
261			s = Val(Mid$(TrackPos$, 4, 2))
262		End If
263		GetSekunden = (m * 60) + s
264	End Function
265	
266	Sub GetTitles
267		CdCheckSum$ = GetChecksum$
268		If Files$(IniDat$) > "" Then
269			TitelAnz = Val(GetPrivateProfileString$(CdChecksum$, "Anzahl", IniDat$))
270			If TitelAnz = TrackAnz Then
271				CdTitel$ = GetPrivateProfileString$(CdChecksum$, "CDTitel", IniDat$)
272				IstRegistriert = - 1
273			End If
274		End If
275		For i = 1 To TrackAnz
276			If IstRegistriert = - 1 Then
277				TrackName$(i - 1) = GetPrivateProfileString$(CdChecksum$, ShowNr$(i), IniDat$)
278			Else
279				TrackName$(i - 1) = ShowNr$(i)
280			End If
281		Next i
282	End Sub
283	
284	Function GetChecksum$
285		Dig1$ = TextZahlForm$(TrackAnz, "00")
286		Dig2$ = TextZahlForm$(GetSekunden(CDLnge$), "0000")
287		For i = 1 To TrackAnz
288			dummy = (dummy + (TrackLen(i - 1) And 127) * i) Mod 99
289		Next i
290	 	Dig3$ = TextZahlForm$(dummy, "00")
291		GetChecksum$ = Dig1$ + Dig2$ + Dig3$
292	End Function
293	
294	Sub PlayTrack(Track)
295		tmp$ = SendMci$("play cdaudio from " + TrackStartPos$(Track - 1))
296	End Sub
297	
298	Sub WriteTitles
299		If CdEjected = 0 Then
300			SetPrivateProfileString CdChecksum$, "Anzahl", LTrim$(Str$(TrackAnz)), IniDat$
301			SetPrivateProfileString CdChecksum$, "CDTitel", CdTitel$, IniDat$
302			For i = 1 To TrackAnz
303				SetPrivateProfileString CdChecksum$, ShowNr$(i), TrackName$(i - 1), IniDat$
304			Next i
305		End If
306	End Sub
307	
308	REM ***********************************************************************
309	REM Allgemeine Prozeduren und Funktionen
310	REM ***********************************************************************
311	
312	Function GetWinDir$(AddSlash)
313		dummy = GetWindowsDirectory(tmp$, 128)
314		If AddSlash <> 0 And Right$(tmp$, 1) <> "\" Then
315			tmp$ = tmp$ + "\"
316		End If
317		GetWinDir$ = UCase$(tmp$)
318	End Function
319	
320	Function TextZahlForm$(Zahl, Basis$)
321		tmp$ = LTrim$(Str$(Zahl))
322		If Len(tmp$) > Len(Basis$) Then
323			tmp$ = Left$(tmp$, Len(Basis$))
324		End If
325		TextZahlForm$ = Left$(Basis$, Len(Basis$) - Len(tmp$)) + tmp$
326	End Function
327	
328	Function ShowNr$(Nr)
329		If Nr < 10 Then
330			ShowNr$ = "0" + LTrim$(Str$(Nr))
331		Else
332			ShowNr$ = LTrim$(Str$(Nr))
333		End If
334	End Function
335	
336	Function ShowZeit$(Sekunden)
337		If Sekunden < 0 Then
338			Sekunden = 0
339		End If
340		min = Int(Sekunden / 60)
341		sek = Sekunden - (min * 60)
342		ShowZeit$ = ShowNr$(min) + ":" + ShowNr$(sek)
343	End Function

