输入法编程

开发平台：
Visual C++

MdFile.bas：源码内容
							Attribute VB_Name = "MdFile"
Option Explicit
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_NEWDIALOGSTYLE = &H40
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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
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 OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'浏览文件夹函数
Public Function BrowseFolder(ByVal hwnd As Long, ByVal Title As String) As String
    Dim bi As BROWSEINFO
    Dim rtn, pid As Long
    Dim path As String * 512
    Dim pos As Integer
    With bi
        .hOwner = hwnd
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
        .lpszTitle = Title
    End With
    pid = SHBrowseForFolder(bi)
    rtn = SHGetPathFromIDList(ByVal pid, ByVal path)
    If rtn Then
        pos = InStr(path, Chr(0))
        BrowseFolder = Left(path, pos - 1)
    Else
        BrowseFolder = ""
    End If
End Function
'不用控件实现打开文件对话框
Public Function OpenDlg(hwnd As Long, filter As String, FilterIndex As Integer) As String
    Dim pOpenfilename As OPENFILENAME
    Dim dd As Long, FileName As String, pos As Integer
    With pOpenfilename
        .flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST
        .lpstrTitle = "打开文件"
        .hwndOwner = hwnd
        .hInstance = App.hInstance
        .lpstrFilter = filter
        .lpstrInitialDir = App.path
        .nFilterIndex = FilterIndex
        .lpstrFile = Space(254)
        .nMaxFile = 255
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = 255
        .lStructSize = Len(pOpenfilename)
    End With
    dd = GetOpenFileName(pOpenfilename)
    If dd Then
        pos = InStrRev(pOpenfilename.lpstrFile, vbNullChar)
       FileName = Left(pOpenfilename.lpstrFile, pos - 2)
    Else
        FileName = ""
    End If
    OpenDlg = FileName
End Function
'取得系统文件夹
Public Function GetSystemDir() As String
    Dim nSize As Long
    Dim tmp As String
    tmp = Space$(256)
    nSize = Len(tmp)
    Call GetSystemDirectory(tmp, nSize)
    If Right(TrimNull(tmp), 1) <> "" Then
       GetSystemDir = TrimNull(tmp) + ""
    Else: GetSystemDir = TrimNull(tmp)
    End If
    
End Function
'取得windows文件夹
Public Function GetWinDir() As String
    Dim nSize As Long
    Dim tmp As String
    tmp = Space$(256)
    nSize = Len(tmp)
    Call GetWindowsDirectory(tmp, nSize)
    
    If Right(TrimNull(tmp), 1) <> "" Then
      GetWinDir = TrimNull(tmp) + ""
    Else: GetWinDir = TrimNull(tmp)
    End If
    
End Function
'删除VBNullchar字符
Private Function TrimNull(item As String)
    Dim pos As Integer
    pos = InStr(item, Chr$(0))
    If pos Then
          TrimNull = Left$(item, pos - 1)
    Else: TrimNull = item
    End If
  
End Function
'返回文件路径,包含""
Public Function ExtractFilePath(ByVal FileName As String) As String
    Dim i As Integer
    i = InStrRev(FileName, "")
    ExtractFilePath = Left(FileName, i)
End Function
'从全路径中返回文件名,包含扩展名
Public Function ExtractFileName(ByVal FileName As String) As String
    Dim x
    x = Split(FileName, "")
    ExtractFileName = x(UBound(x))
End Function

						