Private m_cancelled As Boolean
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Type OpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
iFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public sFileName As String
Public Sub ShowOpen()
ShowFileDialog (1)
End Sub
Private Sub ShowFileDialog(ByVal iAction As Integer)
Dim tOpenFile As OpenFilename
Dim lMaxSize As Long
Dim sFileNameBuff As String
Dim sFileTitleBuff As String
On Error GoTo ShowFileDialogError
'инициализация буфера
iAction = iAction 'Action property
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
tOpenFile.lStructSize = Len(tOpenFile)
tOpenFile.hwndOwner = lhdc
'Замена "|" на Chr(0)
tOpenFile.lpstrFilter = sAPIFilter("Аудио файлы|*.wav;*.mp3")
tOpenFile.iFilterIndex = iFilterIndex
'определение размера буфера от свойства MaxFileSize
If lMaxFileSize > 0 Then
lMaxSize = lMaxFileSize
Else
lMaxSize = 255
End If
sFileNameBuff = sFileName
'заполнение пробелами до 255
While Len(sFileNameBuff) < lMaxSize - 1
sFileNameBuff = sFileNameBuff & " "
Wend
'обрежем до длины lMaxFileSize - 1
If lMaxFileSize = 0 Then
sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxSize - 1)
Else
sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxFileSize - 1)
End If
'установим в конце нулевой знак
sFileNameBuff = sFileNameBuff & Chr$(0)
tOpenFile.lpstrFile = sFileNameBuff
If lMaxFileSize <> 255 Then
tOpenFile.nMaxFile = 255
End If
'операции, аналогичные вышеисполненным
sFileTitleBuff = sFileTitle
While Len(sFileTitleBuff) < lMaxSize - 1
sFileTitleBuff = sFileTitleBuff & " "
Wend
If lMaxFileSize = 0 Then
sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxSize - 1)
Else
sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxFileSize - 1)
End If
sFileTitleBuff = sFileTitleBuff & Chr$(0)
tOpenFile.lpstrFileTitle = sFileTitleBuff
tOpenFile.lpstrInitialDir = sInitDir
tOpenFile.lpstrTitle = "Выбирите аудиофайл"
tOpenFile.Flags = lFlags
tOpenFile.lpstrDefExt = sDefaultExt
'выполним GetOpenFileName API-функцию
lApiReturn = GetOpenFileName(tOpenFile)
m_cancelled = False
'Возвращение дескриптора от API-функции GetOpenFileName
Select Case lApiReturn
Case 0 'нажата кнопка Cancel
'генерация ошибки
m_cancelled = True
Exit Sub
Case 1 'пользователь выбрал или ввел файл
'Используем внутреннюю процедуру sLeftOfNull
'для получения пути и имени файла
sFileName = sLeftOfNull(tOpenFile.lpstrFile)
sFileTitle = sLeftOfNull(tOpenFile.lpstrFileTitle)
Case Else 'если произошла ошибка вызываем CommDlgExtendedError
lExtendedError = CommDlgExtendedError
End Select
Exit Sub
ShowFileDialogError:
Exit Sub
End Sub
Private Function sAPIFilter(sIn)
Dim lChrNdx As Long
Dim sOneChr As String
Dim sOutStr As String
For lChrNdx = 1 To Len(sIn)
sOneChr = Mid$(sIn, lChrNdx, 1)
If sOneChr = "|" Then
sOutStr = sOutStr & Chr$(0)
Else
sOutStr = sOutStr & sOneChr
End If
Next
sOutStr = sOutStr & Chr$(0)
sAPIFilter = sOutStr
End Function
Private Function sLeftOfNull(ByVal sIn As String)
Dim lNullPos As Long
sLeftOfNull = sIn
lNullPos = InStr(sIn, Chr$(0))
If lNullPos > 0 Then
sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
End If
End Function

Dim cd As New cmnDLG
cd.ShowOpen