comdlg32.bas

电话本信息 基本上实现电话功能 自己下载侃侃吧

Attribute VB_Name = "COMDLG32"
Option Explicit

Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Declare Function GetSaveFileNameD Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As tOPENFILENAME) As Long
Private Declare Function GetOpenFileNameD Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As tOPENFILENAME) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pIdl As ITEMIDLIST) As Long
Private Declare Function SHGetFileInfo Lib "Shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)


Public Enum SHSpecialFolderIDs      '注释：列出所有Windows下特殊文件夹的ID
    CSIDL_DEFAULT = &HFF
    CSIDL_DESKTOP = &H0
    CSIDL_INTERNET = &H1
    CSIDL_PROGRAMS = &H2
    CSIDL_CONTROLS = &H3
    CSIDL_PRINTERS = &H4
    CSIDL_PERSONAL = &H5
    CSIDL_FAVORITES = &H6
    CSIDL_STARTUP = &H7
    CSIDL_RECENT = &H8
    CSIDL_SENDTO = &H9
    CSIDL_BITBUCKET = &HA
    CSIDL_STARTMENU = &HB
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_DRIVES = &H11
    CSIDL_NETWORK = &H12
    CSIDL_NETHOOD = &H13
    CSIDL_FONTS = &H14
    CSIDL_TEMPLATES = &H15
    CSIDL_COMMON_STARTMENU = &H16
    CSIDL_COMMON_PROGRAMS = &H17
    CSIDL_COMMON_STARTUP = &H18
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    CSIDL_APPDATA = &H1A
    CSIDL_PRINTHOOD = &H1B
    CSIDL_ALTSTARTUP = &H1D
    CSIDL_COMMON_ALTSTARTUP = &H1E
    CSIDL_COMMON_FAVORITES = &H1F
    CSIDL_INTERNET_CACHE = &H20
    CSIDL_COOKIES = &H21
    CSIDL_HISTORY = &H22
End Enum

Public Enum SHGFI_flags
    SHGFI_LARGEICON = &H0
    SHGFI_SMALLICON = &H1
    SHGFI_OPENICON = &H2
    SHGFI_SHELLICONSIZE = &H4
    SHGFI_PIDL = &H8
    SHGFI_USEFILEATTRIBUTES = &H10
    SHGFI_ICON = &H100
    SHGFI_DISPLAYNAME = &H200
    SHGFI_TYPENAME = &H400
    SHGFI_ATTRIBUTES = &H800
    SHGFI_ICONLOCATION = &H1000
    SHGFI_EXETYPE = &H2000
    SHGFI_SYSICONINDEX = &H4000
    SHGFI_LINKOVERLAY = &H8000
    SHGFI_SELECTED = &H10000
End Enum

Public Enum UlFlagtype
    ULF_RETURNONLYFSDIRS = &H1
    ULF_DONTGOBELOWDOMAIN = &H2
    ULF_STATUSTEXT = &H4
    ULF_RETURNFSANCESTORS = &H8
    ULF_BROWSEFORCOMPUTER = &H1000
    ULF_BROWSEFORPRINTER = &H2000
End Enum

Public Enum OFNConst
       OFN_READONLY = &H1                             '“以只读方式”为选中
       OFN_OVERWRITEPROMPT = &H2                      '隐藏“以只读方式”
       OFN_HIDEREADONLY = &H4                         '出现“是否覆盖”对话框
       OFN_NOCHANGEDIR = &H8                          '不能改变目录
       OFN_SHOWHELP = &H10                            '显示“帮助”
       OFN_ENABLEHOOK = &H20                          '使对话框钩子函数生效
       OFN_ENABLETEMPLATE = &H40                      '模板生效
       OFN_ENABLETEMPLATEHANDLE = &H80                '模板句柄生效？？
       OFN_NOVALIDATE = &H100                         '允许非法字符
       OFN_ALLOWMULTISELECT = &H200                   '允许选择多个文件
       OFN_EXTENSIONDIFFERENT = &H400
       OFN_PATHMUSTEXIST = &H800                      '路径必须存在
       OFN_FILEMUSTEXIST = &H1000                     '文件必须存在
       OFN_CREATEPROMPT = &H2000                      '出现“是否建立文件”对话框
       OFN_SHAREAWARE = &H4000                        '忽略共享冲突
       OFN_NOREADONLYRETURN = &H8000
       OFN_NOTESTFILECREATE = &H10000                 '不进行文件创建测试
       OFN_NONETWORKBUTTON = &H20000                  '没有网络按键（旧风格专用）
       OFN_NOLONGNAMES = &H40000                      '不使用长文件名（旧风格专用）
       OFN_EXPLORER = &H80000                         '资源管理器风格（新风格）
       OFN_NODEREFERENCELINKS = &H100000              '使*.lnk可以选中
       OFN_LONGNAMES = &H200000                       '使用长文件名（旧风格专用）
       OFN_ENABLEINCLUDENOTIFY = &H400000             '准许包括通知？？
       OFN_ENABLESIZING = &H800000                    '可改变大小
       OFN_USEMONIKERS = &H1000000
       OFN_DONTADDTORECENT = &H2000000
       OFN_FORCESHOWHIDDEN = &H10000000
         
       OFN_SHAREWARN = 0
       OFN_SHARENOWARN = 1
       OFN_SHAREFALLTHROUGH = 2
         
       OFN_EX_NOPLACESBAR = &H1
End Enum

Private Const MAX_PATH = 260
Private Const NOERROR = 0
Private Const fMaxLong = 255

'  Only returns file system directories. If the user selects folders
'  that are not part of the file system, the OK button is grayed.
'Private Const BIF_RETURNONLYFSDIRS = &H1
'  Does not include network folders below the domain level in the tree view control.
'  For starting the Find Computer
'Private Const BIF_DONTGOBELOWDOMAIN = &H2
'  Includes a status area in the dialog box. The callback function can set
'  the status text by sending messages to the dialog box.
'Private Const BIF_STATUSTEXT = &H4
'  Only returns file system ancestors. If the user selects anything other
'  than a file system ancestor, the OK button is grayed.
'Private Const BIF_RETURNFSANCESTORS = &H8
'  Only returns computers. If the user selects anything other
'  than a computer, the OK button is grayed.
'Private Const BIF_BROWSEFORCOMPUTER = &H1000
'  Only returns (network) printers. If the user selects anything other
'  than a printer, the OK button is grayed.
'Private Const BIF_BROWSEFORPRINTER = &H2000

Private Type tOPENFILENAME
  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 Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Private Type SHITEMID
    cb As Long
    abID() As Byte
End Type

Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Private OpenFileNAMEList() As String

Public Function GetExtension(fileName As String)
Dim I, j, PthPos, ExtPos As Integer

  For I = Len(fileName) To 1 Step -1   '注释： Go from the Length of the filename, to the first character by 1.
    If Mid(fileName, I, 1) = "." Then '注释： If the current position is '注释：.'注释： then...
      ExtPos = I '注释： ...Change the ExtPos to the number.
      For j = Len(fileName) To 1 Step -1 '注释： Do the Same...
        If Mid(fileName, j, 1) = "\" Then '注释： ...but for '注释：\'注释：.
          PthPos = j '注释： Change the PthPos to the number.
          Exit For '注释： Since we found it, don'注释：t search any more.
        End If
      Next j
    Exit For '注释： Since we found it, don'注释：t search any more.
  End If
  Next I
  If PthPos > ExtPos Then
    Exit Function ''注释： No extension.
  Else
  If ExtPos = 0 Then Exit Function ''注释： If there is not extension, then exit sub.
    GetExtension = Mid(fileName, ExtPos + 1, Len(fileName) - ExtPos) ''注释：Messagebox the Extension
  End If
End Function
'注释： 使用:
'注释： FileExt = GetExtension("c:\windows\vb\vb.exe")

'282、如何从全路径名中提取文件名(从前向后)？