by Bernt Figaro (8 Submissions)
Category: Sound/MP3
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Wed 20th June 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Another way to get CD Time Info
VBcoders
' 1)
' Use a form named CD_TimeInfo
' Caption = "CD TIME INFO"
' Height = 2235
' Width = 3960
' ScaleMode = 3 'Pixel
' StartUpPosition = 2 'CenterScreen
' 2)
' Use a CommandButton named ExitMe
' Caption = "Goodbye"
' Height = 25
' Left = 104
' ToolTipText = "Yes, Sir !"
' Top = 72
' Width = 80
' 3)
' Four checkboxes named CD1,CD2,CD3,CD4
' Caption = "*** "
' Height = 17
' Width = 36
' Visible = 0 'False
' 3a
' CD1 Left = 16
' Top = 24
' 3b
' CD2 Left = 16
' Top = 48
' 3c
' CD3 Left = 16
' Top = 72
' 3d
' CD4 Left = 16
' Top = 96
' 4)
' a FileListBox named File1
' Height = 19
' Left = 72
' Pattern = "*.CDA"
' Top = 24
' Width = 170
' Visible = 0 'False
' 5)
' a label named Info
' AutoSize = -1 'True
' Height = 13
' Left = 136
' Top = 48
' 6)
' a label named Rubrik
' AutoSize = -1 'True
' Caption = "Show Time"
' Height = 13
' Left = 136
' Top = 48
' Width = 3
' 7)
' a label named Attention
' AutoSize = -1 'True
' Caption = "Mark the CDAudio drive"
' Height = 13
' Left = 0
' Top = 8
' Width = 113
'Form Code ----------------------------------------------
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Const DRIVE_ANY = 0
Const DRIVE_REMOVABLE = 2
Const DRIVE_FIXED = 3
Const DRIVE_REMOTE = 4
Const DRIVE_CDROM = 5
Const DRIVE_RAMDISK = 6
Dim strTmpArray() As String
Dim Path As String
Dim cdromdrive$
Dim lngType As Long
Function GetLocalDrives(lngType As Long) As Variant
Dim cResult As Long
Dim I As Integer
Dim intCount As Integer
ReDim strTmpArray(0 To 25)
If lngType = DRIVE_ANY Then
'Loop and check for any drive
For I = 0 To 25
cResult = GetDriveType(Chr(65 + I) & ":\")
If cResult <> 1 Then
strTmpArray(intCount) = Chr(65 + I)
intCount = intCount + 1
End If
Next I
Else
'Loop and check for a specific type of drive
For I = 0 To 25
cResult = GetDriveType(Chr(65 + I) & ":\")
If cResult = lngType Then
strTmpArray(intCount) = Chr(65 + I)
intCount = intCount + 1
End If
Next I
End If
'Only redim if one or more drives were found
If intCount > 0 Then
ReDim Preserve strTmpArray(0 To intCount - 1)
GetLocalDrives = strTmpArray
End If
End Function
Function Explain(File As String) As String
Dim A$, B$
Dim Time1 As Integer
Dim Time2 As Integer
Dim Time3 As Integer
A$ = Space$(44)
Open File For Binary As #1
Get #1, , A$
B$ = Right$(A$, 3)
Time1 = Asc(Mid$(B$, 3, 1))
Time2 = Asc(Mid$(B$, 2, 1))
Time3 = Asc(Mid$(B$, 1, 1))
Close #1
Explain = Right$(Str$(Time1 + 100), 2) + ":" + Right$(Str$(Time2 + 100), 2) + ":" + Right$(Str$(Time3 + 100), 2)
End Function
Private Sub CD1_Click()
cdromdrive$ = CD1.Caption
Path = cdromdrive$
File1.Path = Path
File1.Visible = True
CD1.Value = 1
End Sub
Private Sub CD2_Click()
cdromdrive$ = CD2.Caption
Path = cdromdrive$
File1.Path = Path
File1.Visible = True
CD2.Value = 1
End Sub
Private Sub CD3_Click()
cdromdrive$ = CD3.Caption
Path = cdromdrive$
File1.Path = Path
File1.Visible = True
CD3.Value = 1
End Sub
Private Sub CD4_Click()
cdromdrive$ = CD4.Caption
Path = cdromdrive$
File1.Path = Path
File1.Visible = True
CD4.Value = 1
End Sub
Private Sub ExitMe_Click()
Unload Me
End
End Sub
Private Sub File1_Click()
Dim File As String
File = Path & File1.List(File1.ListIndex)
Info.Caption = Explain(File)
End Sub
Private Sub Form_Load()
Dim I As Integer
Dim CD As Variant
lngType = DRIVE_CDROM
CD = GetLocalDrives(lngType)
For I = 0 To UBound(strTmpArray)
If strTmpArray(I) <> "" Then
Select Case I
Case 0: CD1.Caption = strTmpArray(I) & ":\": CD1.Visible = True
Case 1: CD2.Caption = strTmpArray(I) & ":\": CD2.Visible = True
Case 2: CD3.Caption = strTmpArray(I) & ":\": CD3.Visible = True
Case 3: CD4.Caption = strTmpArray(I) & ":\": CD4.Visible = True
Case Else
End Select
End If
Next I
End Sub
