输入法编程

开发平台：
Visual C++

PublicModule.bas：源码内容
							Attribute VB_Name = "PublicModule"
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_STRING = 7
Public Const HKEY_CURRENT_USER = &H80000001
Public Const KLF_REORDER = &H8
Public Const WM_IME_CHAR = &H286
Public Const WM_CHAR = &H102
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetFocus Lib "user32" () As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Const MAX_FILENAME_LEN = 260
Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Public Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Public Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long
Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long
Public Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Public Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Public KeyPross As Integer
Public Declare Function outsource Lib "TranChiDll.dll" (ByVal code As String, ByVal userSources As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long) As Boolean
Public Declare Function OutsourceOne Lib "TranChiDll.dll" (ByVal code As String, ByVal userSources As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long) As Boolean
Public Declare Function ChissToCode Lib "TranChiDll.dll" (ByVal MainCodeLibName As String, ByVal chiss As String, codess As String) As Boolean
Public Declare Function creat Lib "TranChiDll.dll" (ByVal CodeSources As String, ByVal userdefine As String, ByVal ExCodeSource As String, ByVal code As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long) As Boolean
Public Declare Function creatNotest Lib "TranChiDll.dll" (ByVal CodeSources As String, ByVal userdefine As String, ByVal ExCodeSource As String, ByVal code As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long) As Boolean
Public Declare Function TestLib Lib "TranChiDll.dll" (ByVal code As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long, ByVal enchar As String, showmsg As Long, rets As String) As Long
Public Declare Function TestLibEx Lib "TranChiDll.dll" (ByVal code As String, ByVal base As Long, ByVal goldeNum As Long, ByVal goldeLen As Long) As Boolean
Public Declare Function ToolTranChar Lib "TranChiDll.dll" (ByVal fileName As String, ByVal num As Long, ByVal cc As String, ByVal tranCh As String) As Long
Public Declare Function SetOrderIME Lib "TranChiDll.dll" (ByVal instHKL As Long) As Integer
Public Const MAX_PATH = 260
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Public Function myfindfile(sFile As String) As String
   Dim i As Integer, hfind As Long
   Dim s2 As WIN32_FIND_DATA
   'Check if the file exists
   If Dir(sFile) = "" Or sFile = "" Then
        myfindfile = ""
    End If
   'Create a buffer
   'Retrieve the name and handle of the executable, associated with this file
   hfind = FindFirstFile(sFile, s2)
   If hfind = INVALID_HANDLE_VALUE Then
       myfindfile = ""
   Else
       myfindfile = sFile
        FindClose hfind
   End If
End Function
'测试字符串的长度,中文占两个,英文一个
Function MyLen(ss As String) As Integer
Dim lon As Integer
Dim s1 As String
Dim i As Integer, t As Integer
i = 0
t = 0
lon = Len(ss)
While i < lon
 s1 = MyGetchar(ss, i)
 If Asc(s1) < 0 Or Asc(s1) > 257 Then
  t = t + 2
 Else
  t = t + 1
 End If
 i = i + 1
Wend
MyLen = t
End Function
Function MyGetchar(ss As String, i As Integer) As String
 Dim st As String
  st = Chr(Asc(Right(ss, Len(ss) - i))) '从0开始
 MyGetchar = st
End Function
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)    '查询类型
    If lResult = 0 And (REG_SZ = lValueType Or REG_STRING = lValueType) And lDataBufSize > 0 Then
            strBuf = String(lDataBufSize, Chr$(0))
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
    End If
End Function
Public Sub SaveRegLong(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim ret
    RegCreateKey hKey, strPath, ret
    RegSetValueEx ret, strValue, 0, REG_DWORD, CLng(strData), 4
    RegCloseKey ret
End Sub
Function ReadRegString(hKey As Long, strPath As String, strValue As String)
    Dim ret
    RegOpenKey hKey, strPath, ret
    ReadRegString = RegQueryStringValue(ret, strValue)
    RegCloseKey ret
End Function
Function WriteRegString(hKey As Long, strPath As String, ByVal strValueName As String, strData As String)
    Dim ret
    RegCreateKey hKey, strPath, ret
    RegSetValueEx ret, strValueName, 0, REG_SZ, ByVal strData, MyLen(strData)
    RegCloseKey ret
End Function
Sub CheckAdd(ms As Integer)
Dim EnC As String, ChiC As String, ss As String, temss As String
Dim path As String
ChiC = ReadRegString(HKEY_CURRENT_USER, "Softwarejsime", "ChiCodeEnd")
EnC = ReadRegString(HKEY_CURRENT_USER, "Softwarejsime", "EnCodeEnd")
If (ChiC <> "") Then
    
    temss = "               "
    ChissToCode App.path & "MainCode.txt", ChiC, temss
    ss = ChiC + "  (  " + Left(temss, 4) + "  )"
     
     EnC = InputBox("是否要把下面的词语加入库中" + Chr(13) + Chr(13) + ss, "增加词库", temss)
     If (EnC <> "") Then
         path = App.path & "userSource.txt"
         Open path For Append As #1      ' 打开输入文件。
         Print #1, EnC & " " & ChiC
         Close #1    ' 关闭文件。
            
         If (creatNotest(App.path & "CodeSource.txt", App.path & "userSource.txt", App.path & "winpy.txt", App.path & "Code.txt", 64, 27, 4)) Then
            MsgBox "生成词典失败"
            End
         Else
            SaveRegLong HKEY_CURRENT_USER, "Software\jsime", "jsime", "55"
         End If
    
     End If
     
     WriteRegString HKEY_CURRENT_USER, "Softwarejsime", "ChiCodeEnd", ""
     WriteRegString HKEY_CURRENT_USER, "Softwarejsime", "EnCodeEnd", ""
     If (ms = 1) Then MsgBox "新增词可用了", , EnC & " --" & ChiC
     End
End If
End Sub

						