Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Const GENERIC_WRITE = &H40000000
Private Const CREATE_ALWAYS = 2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Sub Command1_Click()
On Error Resume Next
Dim hNewFile As Long, bBytes() As Byte
Dim nSize As Long
If Dir("C:\1.mid") <> "1.mid" Then
bBytes = LoadResData(101, "MIDI")
hNewFile = CreateFile("C:\1.mid", GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
nSize = UBound(bBytes) - LBound(bBytes) + 1 'Byte =GetFileSize(hOrgFile, 0)
WriteFile hNewFile, bBytes(0), nSize, nSize, ByVal 0&
CloseHandle hNewFile
End If
mciExecute "play c:\1.mid"
End Sub
Private Sub Command2_Click()
mciExecute "Close C:\1.mid"
Kill "c:\1.mid"
End Sub
将 1.midi添加到自定义资源``
程序运行时自动释放``并播放 ``
加一个时间控件 可达到循环的目的``