• Home
 · 
• Sound/MP3
 · 
• Make a name and a time list for all midifiles in current directory.

Make a name and a time list for all midifiles in current directory.

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]




Rate Make a name and a time list for all midifiles in current directory.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

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