Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function OSGetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function OSGetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Const nBUFSIZEINI = 1024
Private Const nBUFSIZEINIALL = 4096

' Константы под шрифты
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const SCREEN_FONTTYPE = &H2000
Const BOLD_FONTTYPE = &H100
Const FW_BOLD = 700
Const LOGPIXELSY = 90

' Переменные под шрифты
Dim CF As ChooseFont
Dim LF As LOGFONT

' Флаги для установки корневой папки при просмотре.
Public Enum FolderType
    CSIDL_BITBUCKET = 10
    CSIDL_CONTROLS = 3
    CSIDL_DESKTOP = 0
    CSIDL_DRIVES = 17
    CSIDL_FONTS = 20
    CSIDL_NETHOOD = 18
    CSIDL_NETWORK = 19
    CSIDL_PERSONAL = 5
    CSIDL_PRINTERS = 4
    CSIDL_PROGRAMS = 2
    CSIDL_RECENT = 8
    CSIDL_SENDTO = 9
    CSIDL_STARTMENU = 11
End Enum

' Флаги Common Dialog
Public Enum CommonDialogOFN_Flags
    cdlOFNAllowMultiselect = &H200
    cdlOFNCreatePrompt = &H2000
    cdlOFNExplorer = &H80000
    cdlOFNExtensionDifferent = &H400
    cdlOFNFileMustExist = &H1000
    cdlOFNHelpButton = &H10
    cdlOFNHideReadOnly = &H4
    cdlOFNLongNames = &H200000
    cdlOFNNoChangeDir = &H8
    cdlOFNNoDereferenceLinks = &H100000
    cdlOFNNoLongNames = &H40000
    cdlOFNNoReadOnlyReturn = &H8000
    cdlOFNNoValidate = &H100
    cdlOFNOverwritePrompt = &H2
    cdlOFNPathMustExist = &H800
    cdlOFNReadOnly = &H1
    cdlOFNShareAware = &H4000
End Enum
Public Enum CommonDialogPD_Flags
    cdlPDAllPages = &H0
    cdlPDCollate = &H10
    cdlPDDisablePrintToFile = &H80000
    cdlPDHelpButton = &H800
    cdlPDHidePrintToFile = &H100000
    cdlPDNoPageNums = &H8
    cdlPDNoSelection = &H4
    cdlPDNoWarning = &H80
    cdlPDPageNums = &H2
    cdlPDPrintSetup = &H40
    cdlPDPrintToFile = &H20
    cdlPDReturnDC = &H100
    cdlPDReturnDefault = &H400
    cdlPDReturnIC = &H200
    cdlPDSelection = &H1
    cdlPDUseDevModeCopies = &H40000
End Enum
Public Enum CommonDialogCF_Flags
    cdlCFANSIOnly = &H400
    cdlCFApply = &H200
    cdlCFBoth = &H3
    cdlCFEffects = &H100
    cdlCFFixedPitchOnly = &H4000
    cdlCFForceFontExist = &H10000
    cdlCFHelpButton = &H4
    cdlCFLimitSize = &H2000
    cdlCFNoFaceSel = &H80000
    cdlCFNoSimulations = &H1000
    cdlCFNoSizeSel = &H200000
    cdlCFNoStyleSel = &H100000
    cdlCFNoVectorFonts = &H800
    cdlCFPrinterFonts = &H2
    cdlCFScalableOnly = &H20000
    cdlCFScreenFonts = &H1
    cdlCFTTOnly = &H40000
    cdlCFWYSIWYG = &H8000
End Enum
Public Enum CommonDialogOthers_Flags
    Restart_Logoff = &H0
    Restart_ShutDown = &H1
    Restart_Reboot = &H2
    Restart_Force = &H4
    Run_NoBrowse = &H10
    Run_NoDefault = &H20
    Run_CalcDir = &H40
    Run_NoLable = &H80
    ObjProp_System = &H0
    ObjProp_Printer = &H100
    ObjProp_File = &H200
    ObjProp_Mouse = &H300
    ObjProp_Locale = &H400
    ObjProp_MMedia = &H500
    ObjProp_TimeDate = &H600
    ObjProp_Network = &H700
    ObjProp_Screen = &H800
    ObjProp_Internet = &H900
    Folder_COMPUTER = &H1000
    Folder_PRINTER = &H2000
    Folder_INCLUDEFILES = &H4001
End Enum

'Тип для шрифов
Private Type ChooseFont
    lStructSize As Long
    hwndOwner As Long
    HDC As Long
    lpLogFont As Long
    iPointSize As Long
    flags As Long
    rgbColors As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    hInstance As Long
    lpszStyle As String
    nFontType As Integer
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long
    nSizeMax As Long
End Type

' Тоже для шрифов
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(32) As Byte
End Type

' Переменные под шрифты
Dim mItalic As Boolean
Dim mUnderline As Boolean
Dim mStrikethru As Boolean
Dim mFontName As String
Dim mFontSize As Long
Dim mBold As Boolean
Dim mFontCharSet As Long

Private Type rezDlgFont
    FontItalic As Boolean
    FontUnderline As Boolean
    FontStrikethru As Boolean
    FontName As String
    FontSize As Long
    FontBold As Boolean
    FontColor As Long
    FontCharSet As Long
End Type

' здесь будут все свойства выбранного шрифта.
Public ChosenFont As rezDlgFont


'Константы для API функций памяти
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

' Для генерации списка дополнительных цветов
Dim clrList(15) As Long
Dim clrInd As Long
Dim kolvoClr As Integer

' Флаги для диалога выбора цвета
Const CC_RGBINIT = &H1

Public Enum ColorDlgFlags
    CC_FULLOPEN = &H2
    CC_PREVENTFULLOPEN = &H4
    CC_SHOWHELP = &H8
    CC_SOLIDCOLOR = &H80
    CC_ANYCOLOR = &H100
End Enum

'Буфер данных для функции ChooseColor
Private Type ChooseColor
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


' Эти свойства можно юзать, и сделать что-нибудь с диалогами, где они используются, но впринципе не надо...
Private mRGBResult As Long
Private iAction As Integer
Private bCancelError As Boolean
Private lColor As Long
Private lhDC As Long
Private lHelpCommand As Long
Private lApiReturn As Long
Private lExtendedError As Long

'constants for color dialog
Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1

Dim fn As String
Dim A1 As Boolean

' Тип для открытия\сохранения файла.
Private OFN As OPENFILENAME

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex 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

' А это для выбора папок
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

' Для ошибок
Private mCancelError As Boolean

Public Function dlgOpenFile(defVal As String, Optional filter As String, Optional startFolder As String, Optional DialogTitle As String, Optional opcFlags As CommonDialogOFN_Flags, Optional FormHwnd As Long) As String
On Error Resume Next

' Если ленивый юзверь чего-то не указал
If filter = "" Then filter = "Все файлы|*.*|"
If DialogTitle = "" Then DialogTitle = "Выбор файла"
If startFolder = "" Then startFolder = CurDir$

 ' А теперь всё приводим к виду, который удобен для Бил Гейтса
OFN.lStructSize = Len(OFN)
OFN.hwndOwner = FormHwnd
OFN.hInstance = App.hInstance
OFN.lpstrFilter = Replace(filter, "|", Chr(0))
OFN.lpstrFile = Space$(254)
OFN.nMaxFile = 255
OFN.nFilterIndex = FilterIndex
OFN.lpstrFileTitle = Space$(254)
OFN.nMaxFileTitle = 255
OFN.lpstrInitialDir = startFolder
OFN.lpstrTitle = DialogTitle
OFN.flags = opcFlags
Dim op As Long
op = GetOpenFileName(OFN) ' Показываем окошко

' Обрабатываем результаты
If (op) Then
dlgOpenFile = Replace(Trim$(OFN.lpstrFile), Chr(0), ""
FilterIndex = OFN.nFilterIndex
Else
dlgOpenFile = defVal
End If
End Function

Public Function dlgSaveFile(defVal As String, Optional filter As String, Optional startFolder As String, Optional DialogTitle As String, Optional opcFlags As CommonDialogOFN_Flags, Optional FormHwnd As Long, Optional dName As String = "" As String
On Error Resume Next
 ' А тут почти всё так же как и в прошлом, поэтому коментировать не стану...
If filter = "" Then filter = "Все файлы|*.*|"
If DialogTitle = "" Then DialogTitle = "Выбор файла"
If startFolder = "" Then startFolder = CurDir$

OFN.lStructSize = Len(OFN)
OFN.hwndOwner = FormHwnd
OFN.hInstance = App.hInstance
OFN.lpstrFilter = Replace(filter, "|", Chr(0))
OFN.lpstrFile = dName & Space$(254 - Len(dName))
OFN.nMaxFile = 255
OFN.nFilterIndex = FilterIndex
OFN.lpstrFileTitle = Space$(254)
OFN.nMaxFileTitle = 255
OFN.lpstrInitialDir = startFolder
OFN.lpstrTitle = DialogTitle
OFN.flags = opcFlags

Dim op As Long
op = GetSaveFileName(OFN) ' Только вот тут мы другую функцию поюзаем

If (op) Then
dlgSaveFile = Replace(Trim$(OFN.lpstrFile), Chr(0), ""
FilterIndex = OFN.nFilterIndex
Else
dlgSaveFile = defVal
End If
End Function

Public Function dlgExtension(fName As String) As String
    If InStrRev(fName, "." <> 0 Then
        dlgExtension = LCase(Right$(fName, Len(fName) - InStrRev(fName, "."))
    Else
        dlgExtension = ""
    End If
End Function




Public Function GetPrivateProfileString(ByVal szSection As String, ByVal szEntry As Variant, ByVal szDefault As String, ByVal szFileName As String) As String
   'Get an entry in the inifile
   im szTmp As String
   im nRet As Long

   If (IsNull(szEntry)) Then
      'Get names of all entries in the named Section
      szTmp = String$(nBUFSIZEINIALL, 0)
      nRet = OSGetPrivateProfileString(szSection, 0&, szDefault, szTmp, nBUFSIZEINIALL, szFileName)
   Else
      'Get the value of the named Entry
      szTmp = String$(nBUFSIZEINI, 0)
      nRet = OSGetPrivateProfileString(szSection, CStr(szEntry), szDefault, szTmp, nBUFSIZEINI, szFileName)
   End If
   GetPrivateProfileString = Left$(szTmp, nRet)
End Function

Dim S As String
S = dlgOpenFile("NONE", "*.txt|*.txt|", App.Path, "Открыть", cdlOFNExplorer, hwnd)
If S = "NONE" Then Exit Sub
If S = "" Then Exit Sub
ext = LCase(dlgExtension(S))
If ext <> "txt" Then
  MsgBox "Неверный формат файла", vbCritical
  Exit Sub
End If
MsgBox S