by Bernt Figaro (8 Submissions)
Category: Sound/MP3
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Thu 6th April 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Make a name and a time list for all midifiles in current directory.
API Declarations
MIDITIME.FRM. The program uses MCI32.OCX
Here we using an Batch File to get all the midifiles names,
converting them from DOS filenames to Windows filenames
short and long filenames. Using MCI32.OCX we can get the
playing time and then convert them to sec (double) and in
textformat. We also uses and long to short filename function.
Use this snippet as You like.
Best regard from Bernt Figaro
[email protected]
VBcoders
Type=Exe
Form=MidiTime.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\StdOle2.tlb#OLE Automation
Object={C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0; MCI32.OCX
IconForm="MidiTime"
Startup="MidiTime"
HelpFile=""
Title="MidiTime"
Command32=""
Name="Get_MidiTime"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="The Hook SoftWare ®© [email protected]"
VersionFileDescription="Insert the midifiles name long/short and the playtime in single/strings"
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
Rem Cut This part to MIDITIME.FORM----------------
VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form MidiTime
Caption = "Get Midi files time to MidiTime.bas"
ClientHeight = 2025
ClientLeft = 60
ClientTop = 345
ClientWidth = 4125
LinkTopic = "Form1"
ScaleHeight = 135
ScaleMode = 3 'Pixel
ScaleWidth = 275
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton ExitUs
Caption = "Exit Program"
Height = 480
Left = 2520
TabIndex = 3
Top = 1320
Width = 1080
End
Begin VB.CommandButton Examine
Caption = "Examination file"
Height = 480
Left = 1320
TabIndex = 2
Top = 1320
Width = 1080
End
Begin VB.CommandButton MakeList
Caption = "Make Listfile"
Height = 480
Left = 120
TabIndex = 1
Top = 1320
Width = 1080
End
Begin MCI.MMControl Mci
Height = 375
Left = 360
TabIndex = 0
Top = 2640
Width = 3540
Visible = 0 'False
_ExtentX = 6244
_ExtentY = 661
_Version = 327680
DeviceType = ""
FileName = ""
End
Begin VB.Label Report
AutoSize = -1 'True
Caption = "-------------------------"
Height = 195
Left = 120
TabIndex = 6
Top = 960
Width = 1125
End
Begin VB.Label Status
AutoSize = -1 'True
Caption = "------------------------"
Height = 195
Left = 120
TabIndex = 5
Top = 600
Width = 1080
End
Begin VB.Label FileCounter
AutoSize = -1 'True
Caption = "------------------------"
Height = 195
Left = 120
TabIndex = 4
Top = 240
Width = 1080
End
End
Attribute VB_Name = "MidiTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z
Rem Subject: Code Snippet
Rem Date: Sun, 4 june 2000 08:08:54
Rem From: [email protected]
Rem To: <vbcode.com>
Rem
Rem Author: Bernt Figaro
Rem Author's email: [email protected]
Rem Date Submitted: 6/4/00
Rem Compatibility: VB 6,VB 5,VB 4/32
Rem
Rem used to create a short filename from a long filename
Rem ------------------------------------------------------------
Private Declare Function apiGetShortPathName Lib "Kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Rem ------------------------------------------------------------
Rem ®© The Hook Software
Rem [email protected]
Rem --------------------------------
Rem Make a time list for midifiles
Rem using an batch file
Rem ----------------------------
Rem You Need:
Rem A BAT FILE
Rem Make the Batfile using notepad
Rem in the same directory (or use an path)
Rem Name Midfile.bat
Rem Do'nt forget to remove the
Rem minimized files icon on the
Rem Tray bar (click on it and then
Rem hit the upper x)
Rem -----
Rem Text:
Rem -----
Rem DIR *.MID /B > MIDFILE.LST
Rem Extended example
Rem Dir D:\Midis\*.MID / B > C:\vb5.0\vb\MIDFILE.LST
Rem Do'nt forget to put a path
Rem to get files later in the program
Rem when open MIDFILE.LST
Rem ----------------------------
Rem /B used for only file names
Rem This gives long file name
Rem For other purposes i use
Rem the long2short function
Rem ----------------------------
Rem No Error handling used
Rem ======================
Rem ----------------------------
Rem A form, name it MidiTime
Rem Startup pos 2 (center)
Rem ScaleMode 3 (pixel)
Rem ----------------------------
Rem Mci32.OCX (invisible) somewhere on the form
Rem Name it: Mci
Rem ----------------------------
Rem Three Labels
Rem All have AutoSize True
Rem ----------------------------
Rem 1) Name FileCounter
Rem 2) Name Status
Rem 3) Name Report
Rem ----------------------------
Rem Three Command Butttons
Rem Width x Height = 72 x 32
Rem ----------------------------
Rem 1) Name MakeList
Rem Caption Make Listfile
Rem 2) Name Examine
Rem Caption Examination File
Rem 3) Name ExitUs
Rem Caption Exit Program
Rem ----------------------------
Rem After loading the filename
Rem and split to short/long filename
Rem and sorting we make an finale:
Rem MidiTime.bas
Rem ----------------------------
Rem ----------------------------
Const MCIERR_INVALID_DEVICE_ID = 30257
Const MCIERR_DEVICE_OPEN = 30263
Const MCIERR_CANNOT_LOAD_DRIVER = 30266
Const MCIERR_UNSUPPORTED_FUNCTION = 30274
Const MCIERR_INVALID_FILE = 30304
Const MCI_MODE_NOT_OPEN = 524
Const MCI_MODE_PLAY = 526
Const MCI_FORMAT_MILLISECONDS = 0
Const MCI_FORMAT_TMSF = 10
Rem ----------------------------
Dim Msg As String
Dim Dummy As String
Dim U%
Dim B$
Dim Fel$
Dim f As Integer
Dim I As Integer
Dim J As Integer
Dim L As Integer
Dim S As Integer
Dim temp As String
Dim A$
Dim Cnt As Integer
Dim C$
Dim Exe As Long
Dim OldCnt As Integer
Dim MidiShort() As String
Dim MidiLong() As String
Dim MidiSec() As Single
Dim MidiTime() As String
Dim ShortFileName As String * 80
Dim LongFileName As String
Dim Path As String
Dim msec As Double
Private Function dos2win(DosText As String) As String
Rem
Rem Task: The functions convert a MsDos text in a Windows text and viceversa.
Rem Inputs: strings to convert
Rem Returns:strings converted
Dim Dos$, Oem$
Dos$ = DosText
Oem$ = Space$(Len(DosText))
OemToChar Dos$, Oem$
dos2win = Oem$
End Function
Sub Examination()
Rem Pass 1 : Counting Files
Open "midfile.lst" For Input As #1
While Not EOF(1)
DoEvents
Input #1, A$
Cnt = Cnt + 1
Report.Caption = "Item Read # " & Cnt
Wend
Reset
FileCounter.Caption = "Found " & Cnt & " files"
ReDim MidiShort(Cnt)
ReDim MidiLong(Cnt)
ReDim MidiSec(Cnt)
ReDim MidiTime(Cnt)
OldCnt = Cnt
Rem Pass 2 : Get strings
Cnt = 0
'On Error GoTo ErrorHandler
Status.Caption = "Reading to short and long file names"
Open "midfile.lst" For Input As #1
While Not EOF(1)
DoEvents
Input #1, A$
A$ = dos2win(A$)
Cnt = Cnt + 1
MidiLong(Cnt) = A$
MidiShort(Cnt) = Long2Short(A$)
Report.Caption = "Getting Long/short Filename # " & Cnt
Wend
Reset
Rem Pass 3: Sorting files
Status.Caption = "Begin Sorting"
Report.Caption = "Sorting " & Cnt & " files"
QuickSort 1, Cnt
Status.Caption = "Sorting finished"
Rem Pass 4: Split files in parts
Finale OldCnt
End Sub
Private Sub Examine_Click()
Examine.Enabled = False
Examination
End Sub
Private Sub ExitUs_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
Me.Show
End Sub
Sub Finale(OldCnt)
U% = OldCnt
B$ = Chr$(34)
Status.Caption = "The Finale has begin !"
Rem Create file MidiTime.bas
Open "MidiTime.bas" For Output As #1
Print #1, "Option Explicit"
Print #1, "Defint A-Z"
Print #1, "Rem"
Print #1, "REM MIDITIME.BAS Created "; Date$; " "; Time$
Print #1, "REM By MidiTime"
Print #1, "REM Author: [email protected] ®©By"
Print #1, "Rem The Hook Software"
Print #1, "Rem"
Print #1, "Dim MidiLong(1 to "; OldCnt; ") As String"
Print #1, "Dim MidiShort(1 to"; OldCnt; " ) As String"
Print #1, "Dim MidiSec(1 to "; OldCnt; ") As Single"
Print #1, "Dim MidiTime(1 to"; OldCnt; ") As String"
Print #1, ""
Print #1, "Sub VariableInit () : REM Alternativt Public Sub VariableInit() för VB4,VB5"
Print #1, "Rem"
Print #1, "REM "; Date$
Print #1, "REM Antal files = 1 to "; U%
Print #1, "Rem"
Print #1, ""
For I% = 1 To OldCnt
DoEvents
Report.Caption = "Write item # " & I% & " of [" & OldCnt & " ]"
On Error GoTo MCI_ERROR
Mci.filename = MidiLong(I%)
Mci.Command = "Open"
On Error GoTo 0
Rem Set the timing labels on the form.
Mci.TimeFormat = MCI_FORMAT_MILLISECONDS
msec = (CDbl(Mci.Length) / 1000)
Mci.Command = "Close"
C$ = Format$(Int(msec / 60), "#0") + " min " + Format$(Int((msec + 0.5) Mod 60), "##0") + " sec"
Rem
Print #1, "MidiLong(" & Str$(I%) & ")=" & B$ & MidiLong(I%) & B$ & " : ";
Print #1, "MidiShort(" & Str$(I%) & ")=" & B$ & MidiShort(I%) & B$ & " : ";
Print #1, "MidiSec(" & Str$(I%) & ")=" & Str$(msec) & " : ";
Print #1, "MidiTime(" & Str$(I%) & ")=" & B$ & C$ & B$
Next I%
Print #1, ""
Print #1, "End Sub"
Reset
Status.Caption = "Do'nt forget to remove DOS Icon from the task bar"
Report.Caption = "MidiTime.bas created"
Examine.Enabled = True
MakeList.Enabled = True
Exit Sub
MCI_ERROR:
MsgBox "Error " + Mci.Error
Open "RAPPORT.LST" For Append As #2
Print #2, Fel$
Close #2
MsgBox "rapport.lst created"
End Sub
Sub swap(I%, J%)
Dummy = MidiShort(I%)
MidiShort(I%) = MidiShort(J%)
MidiShort(J%) = Dummy
Dummy = MidiLong(I%)
MidiLong(I%) = MidiLong(J%)
MidiLong(J%) = Dummy
End Sub
Sub QuickSort(Start As Integer, Ending As Integer)
ReDim QuickStack%(1000)
S = 1
f = Start
L = Start + Ending - 1
Do
temp = MidiShort((L + f) \ 2)
I = f
J = L
DoEvents
Do
While MidiShort(I) < temp: Rem Use > for descending
I = I + 1
DoEvents
Wend
While MidiShort(J) > temp: Rem Use < for descending
J = J - 1
DoEvents
Wend
If I > J Then Exit Do
If I < J Then swap I, J
I = I + 1
J = J - 1
Loop Until I > J
If I < L Then
QuickStack(S) = I
QuickStack(S + 1) = L
S = S + 2
End If
L = J
If f > L Then
If S = 1 Then Exit Do
S = S - 2
f = QuickStack(S)
L = QuickStack(S + 1)
End If
Loop
Erase QuickStack
End Sub
Private Function Long2Short(LongFileName As String) As String
Rem ------------------------------------------------------------
Rem Task: create short filename
Dim Ln As Integer
Dim I As Integer
apiGetShortPathName LongFileName, ShortFileName, 80
Rem ------------------------------------------------------------
Rem short filename
Ln = InStr(ShortFileName, ".") + 3
Long2Short = Left$(ShortFileName, Ln) 'max Ln char
Rem ------------------------------------------------------------
End Function
Private Sub MakeList_Click()
Msg = "Start " & Time$
Report.Caption = Msg
Exe = Shell("MIDFILE.BAT", 2)
Msg = Msg & " : Ending " & Time$
Report.Caption = Msg
Status.Caption = "MIDFILE.LST created !"
MakeList.Enabled = False
End Sub
No comments have been posted about Make a name and a time list for all midifiles in current directory.. Why not be the first to post a comment about Make a name and a time list for all midifiles in current directory..
