language.bas

中日邮件短信网关

Attribute VB_Name = "language"
Global jisstore As String
Global gbstore As String
Global txtstrin As String
Global pinstore(396, 1 To 2) As String
Public Function LoadLanguage()
'取日文汉字表
Open App.Path + "\Shift-Jis.txt" For Input As #1

 Do While Not EOF(1)
     Line Input #1, txtstrin    '取文件的每一行
     jisstore = jisstore & txtstrin
 Loop
 Close #1
'取中文汉子表
Open App.Path + "\GB.txt" For Input As #1

 Do While Not EOF(1)
     Line Input #1, txtstrin    '取文件的每一行
     gbstore = gbstore & txtstrin
 Loop
 Close #1
 '取拼音转译表
Open App.Path + "\pinyin.txt" For Input As #1

For i = 1 To 396
     Line Input #1, txtstrin    '取文件的每一行
     pinstore(i, 1) = Left(txtstrin, InStr(1, txtstrin, ",") - 1)
     pinstore(i, 2) = Mid(txtstrin, InStr(1, txtstrin, ",") + 1)
     
Next
 Close #1

End Function
Public Function GB2ShiftJIS(ByVal inputstr As String) As String

Dim st

 
 For i = 1 To Len(inputstr)
 txtstrin = Mid(inputstr, i, 1)
 st = InStr(1, gbstore, txtstrin)
 If st = 0 Then  ' 如果没有该字符，则用汉字拼音代替
GB2ShiftJIS = GB2ShiftJIS & pinyin(txtstrin)
 
 Else
 '否则进行转码
 
 GB2ShiftJIS = GB2ShiftJIS & Mid(jisstore, st, 1)
 
 
 End If
 
 Next
 
End Function
Public Function ShiftJIS2GB(ByVal inputstr As String) As String

Dim st
 
 For i = 1 To Len(inputstr)
 txtstrin = Mid(inputstr, i, 1)
 st = InStr(1, jisstore, txtstrin)
 If st = 0 Then  ' 如果没有该字符，则用汉字拼音代替
 
 
 Else
 '否则进行转码
 
 ShiftJIS2GB = ShiftJIS2GB & Mid(gbstore, st, 1)
 
 
 End If
 
 Next
End Function

Public Function pinyin(ByVal inputstr As String) As String


 Debug.Print Asc(inputstr)
If Asc(inputstr) > 0 And Asc(inputstr) < 160 Then
   pinyin = inputstr
 Else
   If Asc(inputstr) < -20319 Or Asc(inputstr) > -10247 Then
    pinyin = Chr(Asc(inputstr) + 23680)
    Else
    
    
    For i = 396 To 1 Step -1
    If Val(pinstore(i, 2)) <= Asc(inputstr) Then Exit For
    Next
    pinyin = pinstore(i, 1)
    End If
 
 End If


End Function

Public Function quan2ban(ByVal inputstr As String) As String
Dim quan As String
Dim ban As String
quan = "１２３４５６７８９０"
ban = "1234567890"

Dim st
 
 For i = 1 To Len(inputstr)
 txtstrin = Mid(inputstr, i, 1)
 st = InStr(1, quan, txtstrin)
 If st = 0 Then  ' 如果没有该字符，则用yuanshuzi
 
 quan2ban = quan2ban & txtstrin
 Else
 '否则进行转码
 
 quan2ban = quan2ban & Mid(ban, st, 1)
 
 
 End If
 
 Next


End Function