home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 July / Chip_1999-07_cd.bin / zkuste / VBasic / Data / Priklady / cdaudio.bas < prev    next >
Encoding:
BASIC Source File  |  1997-03-27  |  8.7 KB  |  336 lines
  1. Attribute VB_Name = "CD_Serial_Number"
  2. Option Explicit
  3. Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" _
  4. (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  5.  
  6. Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" _
  7. (ByVal AppName As String, ByVal KeyName As String, ByVal keydefault As String, ByVal Filename As String) As Long
  8.  
  9. Global CDMin As Integer
  10. Global CDSec As Integer
  11. Global TMin As Integer
  12. Global TSec As Integer
  13. Global RMin As Integer
  14. Global RSec As Integer
  15. Global TimeTrack As String
  16. Global TimeElapsed As String
  17. Global TimeRemaining As String
  18.  
  19. Global Artist1 As String
  20. Global Title1 As String
  21.  
  22. Global Artist2 As String
  23. Global Title2 As String
  24.  
  25.  
  26. Sub CDAudioProperties()
  27. Dim T As Double
  28. On Error Resume Next
  29. T = Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3", 5)
  30.  
  31. End Sub
  32.  
  33.  
  34. Function GetRawRemainingTime(MMCOntrol1 As Object) As String
  35. Dim Z As String, Min As String, Sec As String, _
  36. Temp As String
  37.  
  38. Z = GetRunningTime(MMCOntrol1)
  39. Z = GetTrackTime(MMCOntrol1)
  40.  
  41. Min = LTrim$(Str$(CDMin - TMin))
  42. Sec = LTrim$(Str$(CDSec - TSec))
  43.  
  44. RMin = Val(Min)
  45. RSec = Val(Sec)
  46.  
  47. If RSec < 0 Then
  48.     RSec = 60 + Val(Sec)
  49.     RMin = RMin - 1
  50. End If
  51. Min = LTrim$(Str$(RMin))
  52. Temp = Trim$(Str$(RSec))
  53. If Len(Temp) = 1 Then
  54.     Sec = "0" + Temp
  55. Else
  56.     Sec = Temp
  57. End If
  58. GetRawRemainingTime = Min + Sec
  59. End Function
  60. Function GetRemainingTime(MMCOntrol1 As Object) As String
  61. Dim Z As String, Min As String, Sec As String, _
  62. Temp As String
  63.  
  64. Z = GetRunningTime(MMCOntrol1)
  65. Z = GetTrackTime(MMCOntrol1)
  66.  
  67. Min = LTrim$(Str$(CDMin - TMin))
  68. Sec = LTrim$(Str$(CDSec - TSec))
  69.  
  70. RMin = Val(Min)
  71. RSec = Val(Sec)
  72.  
  73. If RSec < 0 Then
  74.     RSec = 60 + Val(Sec)
  75.     RMin = RMin - 1
  76. End If
  77. Min = LTrim$(Str$(RMin))
  78. Temp = Trim$(Str$(RSec))
  79. If Len(Temp) = 1 Then
  80.     Sec = "0" + Temp
  81. Else
  82.     Sec = Temp
  83. End If
  84. GetRemainingTime = Min + ":" + Sec
  85. End Function
  86.  
  87.  
  88. Sub GetTime(MMCOntrol1 As Object)
  89. Dim Z$
  90. Z$ = GetRemainingTime(MMCOntrol1)
  91.  
  92. End Sub
  93.  
  94. Function GetTrackTime(MMCOntrol1 As Object) As String
  95. Dim Length&, Entry2$, Min$, Sec$, D$, Entry$
  96. MMCOntrol1.TimeFormat = 2
  97. Length& = MMCOntrol1.TrackLength
  98. Min$ = Str$(Length& And &HFF)
  99. Sec$ = LTrim$(Str$((Length& And 65280) / 256))
  100. Entry2$ = Min$ & ":" & Sec$
  101. If Len(Sec$) = 1 Then Entry2$ = Min$ + ":0" + Sec$
  102. Entry$ = Min$ + ":" + Sec$
  103. If Len(Entry2$) = 4 Then
  104.     D$ = "0" + Entry2$
  105. Else
  106.     D$ = Entry2$
  107. End If
  108. If Len(Entry2$) = 3 Then
  109.     D$ = "00" + Entry2$
  110. Else
  111.     D$ = Entry2$
  112. End If
  113. D$ = Entry2$
  114. GetTrackTime = Trim$(D$)
  115. MMCOntrol1.TimeFormat = 10
  116. CDMin = Val(Min$)
  117. CDSec = Val(Sec$)
  118.  
  119. End Function
  120.  
  121.  
  122. Function GetRunningTime(MMCOntrol1 As Object) As String
  123. Dim E As Long, M As String, S As String, Length&, Min$, Sec$, D As Long, Entry2$
  124. MMCOntrol1.TimeFormat = 2
  125. Length& = MMCOntrol1.Position - MMCOntrol1.TrackPosition
  126. Min$ = Str$(Length& And &HFF)
  127. Sec$ = LTrim$(Str$((Length& And 65280) / 256))
  128. If Len(Sec$) = 3 Then
  129.     D = Val(Min$) - 1
  130.     Min$ = LTrim$(Str$(D))
  131.     E = Val(Right$(Sec$, 2)) + 4
  132.     
  133.     Sec$ = LTrim$(Str$(E))
  134. End If
  135.  
  136. M = Min$
  137. 'If Len(Min$) = 1 Then M = "0" + Min$ Else M = Min$
  138. 'If Val(M) = 0 Then M = "00"
  139. 'If Val(M) = 1 Then M = "01"
  140. 'If Val(M) = 2 Then M = "02"
  141. 'If Val(M) = 3 Then M = "03"
  142. 'If Val(M) = 4 Then M = "04"
  143. 'If Val(M) = 5 Then M = "05"
  144. 'If Val(M) = 6 Then M = "06"
  145. 'If Val(M) = 7 Then M = "07"
  146. 'If Val(M) = 8 Then M = "08"
  147. 'If Val(M) = 9 Then M = "09"
  148. If Len(Sec$) = 1 Then
  149.     S = "0" + Sec$
  150. Else
  151.     If Len(Sec$) = 3 Then
  152.         S = Mid$(Sec$, 2)
  153.     Else
  154.         S = Sec$
  155.     End If
  156. End If
  157. TMin = Val(M)
  158. TSec = Val(S)
  159. Entry2$ = LTrim$(M) + ":" + LTrim$(S)
  160. MMCOntrol1.TimeFormat = 10
  161. GetRunningTime = Entry2$
  162. End Function
  163.  
  164.  
  165.  
  166. Function GetRawRunningTime(MMCOntrol1 As Object) As String
  167. Dim E As Long, M As String, S As String, Length&, Min$, Sec$, D As Long, Entry2$
  168. MMCOntrol1.TimeFormat = 2
  169. Length& = MMCOntrol1.Position - MMCOntrol1.TrackPosition
  170. Min$ = Str$(Length& And &HFF)
  171. Sec$ = LTrim$(Str$((Length& And 65280) / 256))
  172. If Len(Sec$) = 3 Then
  173.     D = Val(Min$) - 1
  174.     Min$ = LTrim$(Str$(D))
  175.     E = Val(Right$(Sec$, 2)) + 4
  176.     
  177.     Sec$ = LTrim$(Str$(E))
  178. End If
  179.  
  180. M = Min$
  181. 'If Len(Min$) = 1 Then M = "0" + Min$ Else M = Min$
  182. 'If Val(M) = 0 Then M = "0"
  183. 'If Val(M) = 1 Then M = "1"
  184. 'If Val(M) = 2 Then M = "2"
  185. 'If Val(M) = 3 Then M = "3"
  186. 'If Val(M) = 4 Then M = "4"
  187. 'If Val(M) = 5 Then M = "5"
  188. 'If Val(M) = 6 Then M = "6"
  189. 'If Val(M) = 7 Then M = "7"
  190. 'If Val(M) = 8 Then M = "8"
  191. 'If Val(M) = 9 Then M = "9"
  192. If Len(Sec$) = 1 Then
  193.     S = "0" + Sec$
  194. Else
  195.     If Len(Sec$) = 3 Then
  196.         S = Mid$(Sec$, 2)
  197.     Else
  198.         S = Sec$
  199.     End If
  200. End If
  201. Entry2$ = M + S
  202. MMCOntrol1.TimeFormat = 10
  203. GetRawRunningTime = Entry2$
  204. End Function
  205.  
  206.  
  207. Function GetRawTrackTime(MMCOntrol1 As Object) As String
  208. Dim Length&, Entry2$, Min$, Sec$, D$
  209. MMCOntrol1.TimeFormat = 2
  210. Length& = MMCOntrol1.TrackLength
  211. Min$ = Str$(Length& And &HFF)
  212. Sec$ = LTrim$(Str$((Length& And 65280) / 256))
  213. Entry2$ = Min$ + Sec$
  214. If Len(Sec$) = 1 Then Entry2$ = Min$ + "0" + Sec$
  215. GetRawTrackTime = Entry2$
  216. MMCOntrol1.TimeFormat = 10
  217.  
  218. End Function
  219.  
  220. Public Function myReadINI(inifile, inisection, inikey, iniDefault)
  221. 'Fail fracefully if no file / wrong file is specified.
  222. 'If no section (appname), default is first appname
  223. 'if no key, default is first key
  224.  
  225.  
  226. Dim lpApplicationName As String
  227. Dim lpKeyName As String
  228. Dim lpDefault As String
  229. Dim lpReturnedString As String
  230. Dim nSize As Long
  231. Dim lpFileName As String
  232. Dim retval As Long
  233. Dim Filename As String
  234. lpDefault = Space$(254)
  235. lpDefault = iniDefault
  236.  
  237. lpReturnedString = Space$(254)
  238.  
  239. nSize = 254
  240. lpFileName = inifile
  241. lpApplicationName = inisection
  242. lpKeyName = inikey
  243. Filename = lpFileName
  244. retval = GetPrivateProfileString _
  245. (lpApplicationName, lpKeyName, lpDefault, lpReturnedString, nSize, lpFileName)
  246. myReadINI = lpReturnedString
  247. End Function
  248.  
  249.  
  250. Public Function myWriteINI(inifile As String, inisection As String, inikey As String, Info As String) As String
  251. Dim retval As Long
  252. retval = WritePrivateProfileString(inisection, inikey, Info, inifile)
  253. myWriteINI = LTrim$(Str$(retval))
  254. End Function
  255.  
  256. Public Function GenCDSerial(MMCOntrol1 As Object) As Long
  257. Const MCI_FORMAT_MILLISECONDS = 0
  258. Const MCI_FORMAT_MSF = 2
  259. Const MCI_FORMAT_TMSF = 10
  260. 'MCI_Format :0,2,10 are the only supported formats for CD
  261. Dim Compat As Integer
  262. Dim i As Integer
  263. Dim dwtotal&, dwtemp&
  264. Dim byte0%, byte1%, byte2%, byte3%
  265. 'compat = 0 for EXISTING code
  266. 'Compat = 1 for use with CDPLAYER.EXE
  267. Compat = 1
  268. MMCOntrol1.Notify = False
  269. MMCOntrol1.Wait = True
  270. MMCOntrol1.Shareable = True
  271. If MMCOntrol1.Error <> 0 Then
  272.     MsgBox MMCOntrol1.ErrorMessage
  273.     Exit Function
  274. End If
  275. MMCOntrol1.TimeFormat = MCI_FORMAT_MSF
  276. dwtotal& = 0
  277. For i = 1 To MMCOntrol1.Tracks
  278.     DoEvents
  279.     MMCOntrol1.Track = i
  280.     dwtemp& = MMCOntrol1.TrackPosition
  281.     byte0% = dwtemp& And &HFF&
  282.     byte1% = (dwtemp& And &HFF00&) \ &H100
  283.     byte2% = (dwtemp& And &HFF0000) \ &H10000
  284.     byte3% = (dwtemp& And &H7F000000) \ &H1000000
  285.     If (dwtemp& And &H80000000) <> 0 Then
  286.         ' put sign bit back into byte4
  287.         byte3 = byte3 + &H80
  288.     End If
  289.     dwtemp& = byte0% * &H10000 + byte1% * &H100 + byte2%
  290.     dwtotal& = dwtotal& + dwtemp&
  291. Next i
  292. If MMCOntrol1.Tracks < 3 Then
  293.     dwtotal& = dwtotal& + msf2frames(MMCOntrol1.Length) + Compat
  294. End If
  295. GenCDSerial = dwtotal&
  296.  
  297. End Function
  298. Function msf2frames(msf As Long) As Long
  299. Rem From the KnowledgeBase
  300. Rem    byte1 = MMControl1.Position And &HFF&
  301. Rem    byte2 = (MMControl1.Position And &HFF00&) \ &H100
  302. Rem    byte3 = (MMControl1.Position And &HFF0000) \ &H10000
  303. Rem    byte4 = (MMControl1.Position And &H7F000000) \ &H1000000
  304. Rem    If (MMControl1.Position And &H80000000) <> 0 Then
  305. Rem       ' put sign bit back into byte4
  306. Rem       byte4 = byte4 + &H80
  307. Rem    End If
  308.     Dim byte0, byte1, byte2, byte3 As Integer
  309.     Dim Min, Sec, fra As Integer
  310.     byte0 = msf And &HFF&
  311.     byte1 = (msf And &HFF00&) \ &H100
  312.     byte2 = (msf And &HFF0000) \ &H10000
  313.     byte3 = (msf And &H7F000000) \ &H1000000
  314.     If (msf And &H80000000) <> 0 Then
  315.        ' put sign bit back into byte4
  316.        byte3 = byte3 + &H80
  317.     End If
  318.     Min = byte0
  319.     Sec = byte1
  320.     fra = byte2
  321.     msf2frames = (Min * 60 + Sec) * 75 + fra
  322.     
  323. End Function
  324.  
  325.  
  326. Function Z_Trim(String1 As String) As String
  327. Dim A As Integer
  328. For A = 1 To Len(String1)
  329.     If Mid$(String1, A, 1) = Chr$(0) Then Exit For
  330. Next A
  331. Z_Trim = RTrim$(Left$(String1, A - 1))
  332.  
  333. End Function
  334.  
  335.  
  336.