写入时没问题,但读出来时就是乱码了。(Line Input读)
而且对于一个文件的头几个字符的读取也有问题(比如注册表文件,我写了一个过程来解析系统注册表文件,如果全是英文就没有一点问题,但是中文始终是乱码)
原因不明,希望有朋友可以给出原因及解决方案。
先谢谢了。
26 个解决方案
#1
print写文件的吗?怎不知道是怎么回事,看看代码再说吧
#2
读TXT文件,读出的中文都是乱码
http://community.csdn.net/Expert/topic/4519/4519138.xml?temp=.6458399
http://community.csdn.net/Expert/topic/4519/4519138.xml?temp=.6458399
#3
这个不好说是什么原因?先看看文件的编码?再把你的代码贴上来
#4
首先非常感谢大家的关注。
浪费了大家的时间,我也感到很抱歉。
只是这个问题已经很久了,而我自己又不知道问题的原因,所以才来麻烦大家。
具体代码是这样的:
Public Function LoadFile(Optional ByVal FileName As String)
'载入文件
Dim TmpStr As String
Dim tmpNum1 As Long, tmpNum2 As Long, tmpNum3 As Long
Dim i As Long
Dim hIcon As Long
Dim cDlg As New ClsComdlg
On Error GoTo Err
If Changed = True Then
If MsgBox("当前文件已经改变,是否保存?", vbYesNo) = vbYes Then
Call SaveFile
Exit Function
End If
End If
If Len(FileName) < 5 Then
With cDlg
.FileTitle = "打开文件"
.Filter = "数据文件(*.DAT)|*.DAT|所有文件(*.*)|*.*"
.ShowOpen
FileName = .FileName
End With
If Len(FileName) < 6 Then Exit Function
End If
If FileExist(FileName) <> 1 Then
bMsg.bMsgBox "加载数据文件失败!", "严重"
Exit Function
Else
Call ClsArray
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, TmpStr
TmpStr = Mid(TmpStr, 2, Len(TmpStr) - 2)
If Len(TmpStr) > 1 Then
' TmpStr = DeCode(TmpStr, PassWD)
If Mid(TmpStr, 1, 3) = "###" Then '读入分类列表
ReDim Preserve ProgTypeList(UBound(ProgTypeList) + 1)
ReDim Preserve ProgTL_Num(UBound(ProgTL_Num) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
ProgTypeList(UBound(ProgTypeList)) = Mid(TmpStr, 1, tmpNum1 - 1)
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
If tmpNum1 > 0 Then ProgTL_Num(UBound(ProgTL_Num)) = CInt(TmpStr)
ElseIf Mid(TmpStr, 1, 3) = "#$#" Then
ReDim Preserve ProgTitle(UBound(ProgTitle) + 1)
ReDim Preserve ProgExeName(UBound(ProgExeName) + 1)
ReDim Preserve ProgCmd(UBound(ProgCmd) + 1)
ReDim Preserve ProgType(UBound(ProgType) + 1)
ReDim Preserve ProgIco(UBound(ProgIco) + 1)
ReDim Preserve RunBefore(UBound(RunBefore) + 1)
ReDim Preserve RunBCmd(UBound(RunBCmd) + 1)
ReDim Preserve RunMode(UBound(RunMode) + 1)
ReDim Preserve RunInHDD(UBound(RunInHDD) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
If tmpNum1 > 0 Then
ProgTitle(UBound(ProgTitle)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入标题
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '切割
tmpNum2 = InStr(TmpStr, ",")
ProgExeName(UBound(ProgExeName)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入文件名
Debug.Print ProgExeName(UBound(ProgExeName))
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgCmd(UBound(ProgCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入运行参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
ProgType(UBound(ProgType)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1)) '读入分类
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgIco(UBound(ProgIco)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入图标
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
RunBefore(UBound(RunBefore)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入"运行前执行"
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
RunBCmd(UBound(RunBCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入"运行前执行"的参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
If Mid(TmpStr, 1, tmpNum2 - 1) = "" Then '读入"是否在本地运行"
RunInHDD(UBound(RunInHDD)) = 0
Else
RunInHDD(UBound(RunInHDD)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1))
End If
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
If TmpStr = "" Then '读入兼容模式
RunMode(UBound(RunMode)) = -1
Else
RunMode(UBound(RunMode)) = CInt(TmpStr)
End If
Else
GoTo Err
End If
ElseIf Mid(TmpStr, 1, 3) = "#@#" Then
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
cUser = Mid(TmpStr, 1, tmpNum1 - 1) '读入用户名
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
cPassWD = TmpStr '读入密码
End If
End If
Loop
Close #1
Changed = False
Exit Function
End If
Err:
bMsg.bMsgBox "读取数据时出现错误!", "严重"
Close #1
Exit Function
End Function
浪费了大家的时间,我也感到很抱歉。
只是这个问题已经很久了,而我自己又不知道问题的原因,所以才来麻烦大家。
具体代码是这样的:
Public Function LoadFile(Optional ByVal FileName As String)
'载入文件
Dim TmpStr As String
Dim tmpNum1 As Long, tmpNum2 As Long, tmpNum3 As Long
Dim i As Long
Dim hIcon As Long
Dim cDlg As New ClsComdlg
On Error GoTo Err
If Changed = True Then
If MsgBox("当前文件已经改变,是否保存?", vbYesNo) = vbYes Then
Call SaveFile
Exit Function
End If
End If
If Len(FileName) < 5 Then
With cDlg
.FileTitle = "打开文件"
.Filter = "数据文件(*.DAT)|*.DAT|所有文件(*.*)|*.*"
.ShowOpen
FileName = .FileName
End With
If Len(FileName) < 6 Then Exit Function
End If
If FileExist(FileName) <> 1 Then
bMsg.bMsgBox "加载数据文件失败!", "严重"
Exit Function
Else
Call ClsArray
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, TmpStr
TmpStr = Mid(TmpStr, 2, Len(TmpStr) - 2)
If Len(TmpStr) > 1 Then
' TmpStr = DeCode(TmpStr, PassWD)
If Mid(TmpStr, 1, 3) = "###" Then '读入分类列表
ReDim Preserve ProgTypeList(UBound(ProgTypeList) + 1)
ReDim Preserve ProgTL_Num(UBound(ProgTL_Num) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
ProgTypeList(UBound(ProgTypeList)) = Mid(TmpStr, 1, tmpNum1 - 1)
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
If tmpNum1 > 0 Then ProgTL_Num(UBound(ProgTL_Num)) = CInt(TmpStr)
ElseIf Mid(TmpStr, 1, 3) = "#$#" Then
ReDim Preserve ProgTitle(UBound(ProgTitle) + 1)
ReDim Preserve ProgExeName(UBound(ProgExeName) + 1)
ReDim Preserve ProgCmd(UBound(ProgCmd) + 1)
ReDim Preserve ProgType(UBound(ProgType) + 1)
ReDim Preserve ProgIco(UBound(ProgIco) + 1)
ReDim Preserve RunBefore(UBound(RunBefore) + 1)
ReDim Preserve RunBCmd(UBound(RunBCmd) + 1)
ReDim Preserve RunMode(UBound(RunMode) + 1)
ReDim Preserve RunInHDD(UBound(RunInHDD) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
If tmpNum1 > 0 Then
ProgTitle(UBound(ProgTitle)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入标题
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '切割
tmpNum2 = InStr(TmpStr, ",")
ProgExeName(UBound(ProgExeName)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入文件名
Debug.Print ProgExeName(UBound(ProgExeName))
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgCmd(UBound(ProgCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入运行参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
ProgType(UBound(ProgType)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1)) '读入分类
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgIco(UBound(ProgIco)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入图标
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
RunBefore(UBound(RunBefore)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入"运行前执行"
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
RunBCmd(UBound(RunBCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入"运行前执行"的参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
If Mid(TmpStr, 1, tmpNum2 - 1) = "" Then '读入"是否在本地运行"
RunInHDD(UBound(RunInHDD)) = 0
Else
RunInHDD(UBound(RunInHDD)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1))
End If
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
If TmpStr = "" Then '读入兼容模式
RunMode(UBound(RunMode)) = -1
Else
RunMode(UBound(RunMode)) = CInt(TmpStr)
End If
Else
GoTo Err
End If
ElseIf Mid(TmpStr, 1, 3) = "#@#" Then
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
cUser = Mid(TmpStr, 1, tmpNum1 - 1) '读入用户名
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
cPassWD = TmpStr '读入密码
End If
End If
Loop
Close #1
Changed = False
Exit Function
End If
Err:
bMsg.bMsgBox "读取数据时出现错误!", "严重"
Close #1
Exit Function
End Function
#5
这个过程是我程序的主类里的一个方法,用于读入数据文件到类中一组动态数组内。
其实它现在也工作很长一段时间了,只是这几天发现读入的文件中有一些中文不对头。
由于并不是全部不对,所以也觉得有点晕晕的(数据文件是用记事本手工编辑后保存为Dat文件的)。
另外,对于注册表的读入,就完全不对了,没有一个汉字是正常的,读注册表过程如下:
Public Sub OpenRegFile(ByVal RegFileName As String)
Dim RegStr() As String, tmpValue(5) As Long
Dim i As Long
Dim MainKeyName As String, SubKeyName As String, KeyValue As String
ReDim RegStr(0)
Open RegFileName For Input As #1
Do While EOF(1) = False
ReDim Preserve RegStr(UBound(RegStr) + 1)
Line Input #1, RegStr(UBound(RegStr))
RegStr(UBound(RegStr)) = UCase(RegStr(UBound(RegStr)))
Loop
Close #1
For i = 1 To UBound(RegStr)
tmpValue(0) = InStr(RegStr(i), "@")
tmpValue(1) = InStr(RegStr(i), "[")
tmpValue(2) = InStr(RegStr(i), "]")
tmpValue(3) = InStr(RegStr(i), """=HEX:")
tmpValue(4) = InStr(RegStr(i), """=DWORD:")
tmpValue(5) = InStr(RegStr(i), """=""")
SubKeyName = ""
KeyValue = ""
If tmpValue(1) > 0 And tmpValue(2) > 0 Then
MainKeyName = Mid(RegStr(i), tmpValue(1) + 1, tmpValue(2) - tmpValue(1) - 1)
End If
If tmpValue(0) = 0 Then
If tmpValue(3) > 0 Then
'二进制值
If GetKeyValue(RegStr(i), REGS_HEX, SubKeyName, KeyValue) = 1 Then
SetBinaryValue MainKeyName, SubKeyName, Hex(KeyValue)
End If
ElseIf tmpValue(4) > 0 Then
'十六进制值
If GetKeyValue(RegStr(i), REGS_DWORD, SubKeyName, KeyValue) = 1 Then
SetDWORDValue MainKeyName, SubKeyName, "&H" & KeyValue
End If
ElseIf tmpValue(5) > 0 Then
'字符串值
If GetKeyValue(RegStr(i), REGS_STRING, SubKeyName, KeyValue) = 1 Then
SetStringValue MainKeyName, SubKeyName, KeyValue
End If
End If
End If
Next i
End Sub
由于某些程序的注册表字符串中含有中文,导致这个过程根本无法使用,以致于现在我都还是调用的regedit.exe来导入,真的很不爽。。。。。。。
现在我希望各位能把造成此问题的原因讲讲,好让我以后遇到此类问题后也可以自己分析并解决。当然,能同时给出解决方案就更好了,呵呵~~
还有就是,我没有看过VB编程方面的书,学VB基本是看别人代码以及写代码学来的,所以在基础方面非常的差,因此在某些基础知识上还希望各位不嫌麻烦,讲明白一些~~:D
辛苦大家了!!
其实它现在也工作很长一段时间了,只是这几天发现读入的文件中有一些中文不对头。
由于并不是全部不对,所以也觉得有点晕晕的(数据文件是用记事本手工编辑后保存为Dat文件的)。
另外,对于注册表的读入,就完全不对了,没有一个汉字是正常的,读注册表过程如下:
Public Sub OpenRegFile(ByVal RegFileName As String)
Dim RegStr() As String, tmpValue(5) As Long
Dim i As Long
Dim MainKeyName As String, SubKeyName As String, KeyValue As String
ReDim RegStr(0)
Open RegFileName For Input As #1
Do While EOF(1) = False
ReDim Preserve RegStr(UBound(RegStr) + 1)
Line Input #1, RegStr(UBound(RegStr))
RegStr(UBound(RegStr)) = UCase(RegStr(UBound(RegStr)))
Loop
Close #1
For i = 1 To UBound(RegStr)
tmpValue(0) = InStr(RegStr(i), "@")
tmpValue(1) = InStr(RegStr(i), "[")
tmpValue(2) = InStr(RegStr(i), "]")
tmpValue(3) = InStr(RegStr(i), """=HEX:")
tmpValue(4) = InStr(RegStr(i), """=DWORD:")
tmpValue(5) = InStr(RegStr(i), """=""")
SubKeyName = ""
KeyValue = ""
If tmpValue(1) > 0 And tmpValue(2) > 0 Then
MainKeyName = Mid(RegStr(i), tmpValue(1) + 1, tmpValue(2) - tmpValue(1) - 1)
End If
If tmpValue(0) = 0 Then
If tmpValue(3) > 0 Then
'二进制值
If GetKeyValue(RegStr(i), REGS_HEX, SubKeyName, KeyValue) = 1 Then
SetBinaryValue MainKeyName, SubKeyName, Hex(KeyValue)
End If
ElseIf tmpValue(4) > 0 Then
'十六进制值
If GetKeyValue(RegStr(i), REGS_DWORD, SubKeyName, KeyValue) = 1 Then
SetDWORDValue MainKeyName, SubKeyName, "&H" & KeyValue
End If
ElseIf tmpValue(5) > 0 Then
'字符串值
If GetKeyValue(RegStr(i), REGS_STRING, SubKeyName, KeyValue) = 1 Then
SetStringValue MainKeyName, SubKeyName, KeyValue
End If
End If
End If
Next i
End Sub
由于某些程序的注册表字符串中含有中文,导致这个过程根本无法使用,以致于现在我都还是调用的regedit.exe来导入,真的很不爽。。。。。。。
现在我希望各位能把造成此问题的原因讲讲,好让我以后遇到此类问题后也可以自己分析并解决。当然,能同时给出解决方案就更好了,呵呵~~
还有就是,我没有看过VB编程方面的书,学VB基本是看别人代码以及写代码学来的,所以在基础方面非常的差,因此在某些基础知识上还希望各位不嫌麻烦,讲明白一些~~:D
辛苦大家了!!
#6
这两个过程的思路都是把文本文件以行为单位读入到字符串动态数组内,然后再进行字符串分析完成处理。
对字符串的分析过程应该已经没什么问题了,因为全英文文本文件是完全通过的。
现在只有这个中文的问题了。
另,刚刚突然想到一篇文章,是关于“模拟键盘输入”的,里面使用的是SendMessage函数发送文本,说“如果是中文,就要把中文同XXXX进行与运算,要不然就是乱码”,其中的“XXXX”我忘了是什么东东了,好象是一个十六进制值。
这个会不会有什么关系呢?
现在就等各位发言了,因为我现在已经发不了言了(CSDN连续发帖只能三帖吧,以前试过的),呵呵~~~辛苦各位了~~~
对字符串的分析过程应该已经没什么问题了,因为全英文文本文件是完全通过的。
现在只有这个中文的问题了。
另,刚刚突然想到一篇文章,是关于“模拟键盘输入”的,里面使用的是SendMessage函数发送文本,说“如果是中文,就要把中文同XXXX进行与运算,要不然就是乱码”,其中的“XXXX”我忘了是什么东东了,好象是一个十六进制值。
这个会不会有什么关系呢?
现在就等各位发言了,因为我现在已经发不了言了(CSDN连续发帖只能三帖吧,以前试过的),呵呵~~~辛苦各位了~~~
#7
注册表的:
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
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
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
调用的时候用GetString这个函数即可
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
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
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
调用的时候用GetString这个函数即可
#8
谢.....谢谢暴风雨.....
可能我还是没有说得很明白,抱歉....
读文件并处理的过程是这样的:
打开文本文件--->以行读取方式读入动态数组---->分析字符串并还原操作
现在我的问题不是第三步,而是第一二步里,"读入的内容"本身就不对头.
写入注册表的函数我有,而且可以正常写入中文.
我想得到一个此种问题的原因,因为只知道个解决办法是治标不治本啊~~~到头来我还是什么也没学到,最多就是多收藏一些代码而已.
再次麻烦各位~~~~~抱歉抱歉啦~~~呵呵
可能我还是没有说得很明白,抱歉....
读文件并处理的过程是这样的:
打开文本文件--->以行读取方式读入动态数组---->分析字符串并还原操作
现在我的问题不是第三步,而是第一二步里,"读入的内容"本身就不对头.
写入注册表的函数我有,而且可以正常写入中文.
我想得到一个此种问题的原因,因为只知道个解决办法是治标不治本啊~~~到头来我还是什么也没学到,最多就是多收藏一些代码而已.
再次麻烦各位~~~~~抱歉抱歉啦~~~呵呵
#9
vb的line input只能读本地编码的文件.
你的文本文件肯定不是本地编码(比如gb2312), 说不定是unicode编码的。
你在2000下用notepad打开, 另存为一下就行了。
你的文本文件肯定不是本地编码(比如gb2312), 说不定是unicode编码的。
你在2000下用notepad打开, 另存为一下就行了。
#10
同意楼上的想法啊,看看是不是编码问题啊
#11
只能人为地更改文件来源才能做到吗?
由于这里的目标是由系统注册表导出的REG文件,无法人为地更改其编码.
楼上有朋友说"vb的line input只能读本地编码的文件",那么是否有更好的办法来读入中文字符串呢?
麻烦各位了
由于这里的目标是由系统注册表导出的REG文件,无法人为地更改其编码.
楼上有朋友说"vb的line input只能读本地编码的文件",那么是否有更好的办法来读入中文字符串呢?
麻烦各位了
#12
//那么是否有更好的办法来读入中文字符串呢
用2进制方式(binary)访问文件
用2进制方式(binary)访问文件
#13
Unicode
ANSI
UTF-8
ANSI
UTF-8
#14
注册表用的Unicode字符集吧!我以前把它导出为文本文件时为Unicode,这时我在读该文件时就会出乱码,通常我会把它转成ANSI字符集的文件
#15
以二进制方式打开,判断BOM标记,自己写格式转换程序
对于UTF-8
可以以用MultiByteToWideChar将其转为Unicode格式,使用Windows2000新增代码页65001
对于UTF-16LE
VB的String用的就是UTF-16LE格式,先用字节数组读取文件内容,再直接给字符串变量赋值(sText = byBuf)
对于UTF-16BE
这是大端方式的UTF-16,先还是用字节数组读取文件内容,然后在字节数组中两个两个地交换相邻字节,再直接给字符串变量赋值
对于UTF-32
UTF-32采用的是4字节编码,只能手动转换,幸亏其不多见。
对于UTF-8
可以以用MultiByteToWideChar将其转为Unicode格式,使用Windows2000新增代码页65001
对于UTF-16LE
VB的String用的就是UTF-16LE格式,先用字节数组读取文件内容,再直接给字符串变量赋值(sText = byBuf)
对于UTF-16BE
这是大端方式的UTF-16,先还是用字节数组读取文件内容,然后在字节数组中两个两个地交换相邻字节,再直接给字符串变量赋值
对于UTF-32
UTF-32采用的是4字节编码,只能手动转换,幸亏其不多见。
#16
程序的基本思路没错,读出文件的部分也没错,问题出在每行读出后再做字符串操作这一块:如果读出的字符串全都是英文,你的这段代码也没什么问题;如果是中英文混合问题就来了,这里有几个表达式:
a=len("你好")
b=len("abcd")
c=lenb("你好")
d=lenb("abcd")
如果你认为a=b,那问题就出在这里了,实际结果是a=2,b=4,也就是说一个汉字占二个字符位(双字节表示),但c=d且都等于4,这说明它们占的字节数相同。这样问题也同样存在于mid这种字符串截取函数中,这里还有几个表达式:
str1=mid("你好吗",2)
str2=midb("你好吗",2)
str3=mid("abcdef",2)
str4=midb("abcdef",2)
str5=midb("abcdef",3)
对比一下它们的值,再注意一下它们的实际截取位置就可以了,祝你好运了!
a=len("你好")
b=len("abcd")
c=lenb("你好")
d=lenb("abcd")
如果你认为a=b,那问题就出在这里了,实际结果是a=2,b=4,也就是说一个汉字占二个字符位(双字节表示),但c=d且都等于4,这说明它们占的字节数相同。这样问题也同样存在于mid这种字符串截取函数中,这里还有几个表达式:
str1=mid("你好吗",2)
str2=midb("你好吗",2)
str3=mid("abcdef",2)
str4=midb("abcdef",2)
str5=midb("abcdef",3)
对比一下它们的值,再注意一下它们的实际截取位置就可以了,祝你好运了!
#17
支持UTF文本文件访问的模块
支持常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
Option Explicit
'mTextUTF.bas
'模块:UTF文本文件访问
'作者:zyl910
'版本:1.0
'日期:2006-1-23
'== 说明 ===================================================
'支持Unicode编码的文本文件读写。暂时支持ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'== 更新记录 ===============================================
'[V1.0] 2006-1-23
'1.支持最常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'## 编译预处理常数 #########################################
'== 全局常数 ===============================================
'IncludeAPILib:引用了API库,此时不需要手动写API声明
'## API ####################################################
#If IncludeAPILib = 0 Then
'== File ===================================================
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2
'== Unicode ================================================
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpDefaultChar As Any, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 As Long = 65001
#End If
'###########################################################
'Unicode编码格式
Public Enum UnicodeEncodeFormat
UEF_ANSI = 0 'ANSI+DBCS
UEF_UTF8 'UTF-8
UEF_UTF16LE 'UTF-16LE
UEF_UTF16BE 'UTF-16BE
UEF_UTF32LE 'UTF-32LE
UEF_UTF32BE 'UTF-32BE
UEF_Auto = -1 '自动识别编码
'隐藏项目
[_UEF_Min] = UEF_ANSI
[_UEF_Max] = UEF_UTF32BE
End Enum
'ANSI+DBCS方式的文本所使用的代码页。默认为0,表示使用系统当前代码页。可以利用该参数实现读取其他代码编码的文本,比如想在 简体中文平台下 读取 繁体中文平台生成的txt,就将它设为950
Public UEFCodePage As Long
'判断BOM
'返回值:BOM所占字节
'dwFirst:[in]文件最开始的4个字节
'fmt:[out]返回编码类型
Public Function UEFCheckBOM(ByVal dwFirst As Long, ByRef fmt As UnicodeEncodeFormat) As Long
If dwFirst = &HFEFF& Then
fmt = UEF_UTF32LE
UEFCheckBOM = 4
ElseIf dwFirst = &HFFFE0000 Then
fmt = UEF_UTF32BE
UEFCheckBOM = 4
ElseIf (dwFirst And &HFFFF&) = &HFEFF& Then
fmt = UEF_UTF16LE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFF&) = &HFFFE& Then
fmt = UEF_UTF16BE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFFFF) = &HBFBBEF Then
fmt = UEF_UTF8
UEFCheckBOM = 3
Else
fmt = UEF_ANSI
UEFCheckBOM = 0
End If
End Function
'生成BOM
'返回值:BOM所占字节
'fmt:[in]编码类型
'dwFirst:[out]文件最开始的4个字节
Public Function UEFMakeBOM(ByVal fmt As UnicodeEncodeFormat, ByRef dwFirst As Long) As Long
Select Case fmt
Case UEF_UTF8
dwFirst = &HBFBBEF
UEFMakeBOM = 3
Case UEF_UTF16LE
dwFirst = &HFEFF&
UEFMakeBOM = 2
Case UEF_UTF16BE
dwFirst = &HFFFE&
UEFMakeBOM = 2
Case UEF_UTF32LE
dwFirst = &HFEFF&
UEFMakeBOM = 4
Case UEF_UTF32BE
dwFirst = &HFFFE0000
UEFMakeBOM = 4
Case Else
dwFirst = 0
UEFMakeBOM = 0
End Select
End Function
'判断文本文件的编码类型
'返回值:编码类型。文件无法打开时,返回UEF_Auto
'FileName:文件名
Public Function UEFCheckTextFileFormat(ByVal FileName As String) As UnicodeEncodeFormat
Dim hFile As Long
Dim dwFirst As Long
Dim nNumRead As Long
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
UEFCheckTextFileFormat = UEF_Auto
Exit Function
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
nNumRead = UEFCheckBOM(dwFirst, UEFCheckTextFileFormat)
'Debug.Print nNumRead
'关闭文件
Call CloseHandle(hFile)
End Function
支持常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
Option Explicit
'mTextUTF.bas
'模块:UTF文本文件访问
'作者:zyl910
'版本:1.0
'日期:2006-1-23
'== 说明 ===================================================
'支持Unicode编码的文本文件读写。暂时支持ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'== 更新记录 ===============================================
'[V1.0] 2006-1-23
'1.支持最常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'## 编译预处理常数 #########################################
'== 全局常数 ===============================================
'IncludeAPILib:引用了API库,此时不需要手动写API声明
'## API ####################################################
#If IncludeAPILib = 0 Then
'== File ===================================================
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2
'== Unicode ================================================
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpDefaultChar As Any, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 As Long = 65001
#End If
'###########################################################
'Unicode编码格式
Public Enum UnicodeEncodeFormat
UEF_ANSI = 0 'ANSI+DBCS
UEF_UTF8 'UTF-8
UEF_UTF16LE 'UTF-16LE
UEF_UTF16BE 'UTF-16BE
UEF_UTF32LE 'UTF-32LE
UEF_UTF32BE 'UTF-32BE
UEF_Auto = -1 '自动识别编码
'隐藏项目
[_UEF_Min] = UEF_ANSI
[_UEF_Max] = UEF_UTF32BE
End Enum
'ANSI+DBCS方式的文本所使用的代码页。默认为0,表示使用系统当前代码页。可以利用该参数实现读取其他代码编码的文本,比如想在 简体中文平台下 读取 繁体中文平台生成的txt,就将它设为950
Public UEFCodePage As Long
'判断BOM
'返回值:BOM所占字节
'dwFirst:[in]文件最开始的4个字节
'fmt:[out]返回编码类型
Public Function UEFCheckBOM(ByVal dwFirst As Long, ByRef fmt As UnicodeEncodeFormat) As Long
If dwFirst = &HFEFF& Then
fmt = UEF_UTF32LE
UEFCheckBOM = 4
ElseIf dwFirst = &HFFFE0000 Then
fmt = UEF_UTF32BE
UEFCheckBOM = 4
ElseIf (dwFirst And &HFFFF&) = &HFEFF& Then
fmt = UEF_UTF16LE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFF&) = &HFFFE& Then
fmt = UEF_UTF16BE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFFFF) = &HBFBBEF Then
fmt = UEF_UTF8
UEFCheckBOM = 3
Else
fmt = UEF_ANSI
UEFCheckBOM = 0
End If
End Function
'生成BOM
'返回值:BOM所占字节
'fmt:[in]编码类型
'dwFirst:[out]文件最开始的4个字节
Public Function UEFMakeBOM(ByVal fmt As UnicodeEncodeFormat, ByRef dwFirst As Long) As Long
Select Case fmt
Case UEF_UTF8
dwFirst = &HBFBBEF
UEFMakeBOM = 3
Case UEF_UTF16LE
dwFirst = &HFEFF&
UEFMakeBOM = 2
Case UEF_UTF16BE
dwFirst = &HFFFE&
UEFMakeBOM = 2
Case UEF_UTF32LE
dwFirst = &HFEFF&
UEFMakeBOM = 4
Case UEF_UTF32BE
dwFirst = &HFFFE0000
UEFMakeBOM = 4
Case Else
dwFirst = 0
UEFMakeBOM = 0
End Select
End Function
'判断文本文件的编码类型
'返回值:编码类型。文件无法打开时,返回UEF_Auto
'FileName:文件名
Public Function UEFCheckTextFileFormat(ByVal FileName As String) As UnicodeEncodeFormat
Dim hFile As Long
Dim dwFirst As Long
Dim nNumRead As Long
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
UEFCheckTextFileFormat = UEF_Auto
Exit Function
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
nNumRead = UEFCheckBOM(dwFirst, UEFCheckTextFileFormat)
'Debug.Print nNumRead
'关闭文件
Call CloseHandle(hFile)
End Function
#18
'读取文本文件
'返回值:读取的文本。返回vbNullString表示文件无法打开
'FileName:[in]文件名
'fmt:[in,out]使用何种文本编码格式来读取文本。为UEF_Auto时表示自动判断,且在fmt参数返回文本所用编码格式
Public Function UEFLoadTextFile(ByVal FileName As String, Optional ByRef fmt As UnicodeEncodeFormat = UEF_Auto) As String
Dim hFile As Long
Dim nFileSize As Long
Dim nNumRead As Long
Dim dwFirst As Long
Dim CurFmt As UnicodeEncodeFormat
Dim cbBOM As Long
Dim cbTextData As Long
Dim CurCP As Long
Dim byBuf() As Byte
Dim cchStr As Long
Dim I As Long
Dim byTemp As Byte
'判断fmt范围
If fmt <> UEF_Auto Then
If fmt < [_UEF_Min] Or fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
GoTo FunEnd
End If
'判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nNumRead <> 0 Then '超过4GB
GoTo FreeHandle
End If
If nFileSize < 0 Then '超过2GB
GoTo FreeHandle
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
cbBOM = UEFCheckBOM(dwFirst, CurFmt)
'恢复文件指针
If fmt = UEF_Auto Then '自动判断
fmt = CurFmt
'cbBOM = cbBOM
Else '手动设置编码
If fmt = CurFmt Then '若编码相同,则忽略BOM标记
'cbBOM = cbBOM
Else '编码不同,那么都是数据
cbBOM = 0
End If
End If
Call SetFilePointer(hFile, cbBOM, ByVal 0&, FILE_BEGIN)
cbTextData = nFileSize - cbBOM
'读取数据
UEFLoadTextFile = ""
Select Case fmt
Case UEF_ANSI, UEF_UTF8
'判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
'读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
'取得Unicode文本长度
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal 0&, ByVal 0&)
If cchStr > 0 Then
'分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
'取得文本
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal StrPtr(UEFLoadTextFile), cchStr + 1)
End If
Case UEF_UTF16LE
cchStr = (cbTextData + 1) \ 2
'分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
'取得文本
nNumRead = 0
Call ReadFile(hFile, ByVal StrPtr(UEFLoadTextFile), cbTextData, nNumRead, ByVal 0&)
'修正文本长度
cchStr = (nNumRead + 1) \ 2
If cchStr > 0 Then
If Len(UEFLoadTextFile) > cchStr Then
UEFLoadTextFile = Left$(UEFLoadTextFile, cchStr)
End If
Else
UEFLoadTextFile = ""
End If
Case UEF_UTF16BE
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
'读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
If nNumRead > 0 Then
'隔两字节翻转相邻字节
For I = 0 To nNumRead - 1 - 1 Step 2 '再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
'取得文本
UEFLoadTextFile = byBuf 'VB允许String中的字符串数据与Byte数组直接转换
End If
Case UEF_UTF32LE
UEFLoadTextFile = vbNullString '暂时不支持
Case UEF_UTF32BE
UEFLoadTextFile = vbNullString '暂时不支持
Case Else
Debug.Assert False
End Select
FreeHandle:
'关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function
#19
'保存文本文件
'返回值:是否成功
'FileName:[in]文件名
'sText:[in]欲输出的文本
'IsAppend:[in]是否是添加方式
'fmt:[in,out]使用何种文本编码格式来存储文本。当IsAppend=True时允许UEF_Auto自动判断,且在fmt参数返回文本所用编码格式
'DefFmt:[in]当使用添加模式时,若文件不存在且fmt = UEF_Auto时应使用的编码格式
Public Function UEFSaveTextFile(ByVal FileName As String, _
ByRef sText As String, Optional ByVal IsAppend As Boolean = False, _
Optional ByRef fmt As UnicodeEncodeFormat = UEF_Auto, Optional ByVal DefFmt As UnicodeEncodeFormat = UEF_ANSI) As Boolean
Dim hFile As Long
Dim nFileSize As Long
Dim nNumRead As Long
Dim dwFirst As Long
Dim cbBOM As Long
Dim CurCP As Long
Dim byBuf() As Byte
Dim cbBuf As Long
Dim I As Long
Dim byTemp As Byte
'判断fmt范围
If IsAppend And (fmt = UEF_Auto) Then
Else
If fmt < [_UEF_Min] Or fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
'打开文件
hFile = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, IIf(IsAppend, OPEN_ALWAYS, CREATE_ALWAYS), FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
GoTo FunEnd
End If
'判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nFileSize = 0 And nNumRead = 0 Then '文件大小为0字节
IsAppend = False '此时需要写BOM标志
If fmt = UEF_Auto Then fmt = DefFmt
End If
'判断BOM
If IsAppend And (fmt = UEF_Auto) Then
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
cbBOM = UEFCheckBOM(dwFirst, fmt)
ElseIf IsAppend = False Then
cbBOM = UEFMakeBOM(fmt, dwFirst)
End If
'文件指针定位
Call SetFilePointer(hFile, 0, ByVal 0&, IIf(IsAppend, FILE_END, FILE_BEGIN))
'写BOM
If IsAppend = False Then
If cbBOM > 0 Then
Call WriteFile(hFile, dwFirst, cbBOM, nNumRead, ByVal 0&)
End If
End If
'写文本数据
If Len(sText) > 0 Then
Select Case fmt
Case UEF_ANSI, UEF_UTF8
'判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
'取得缓冲区大小
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), ByVal 0&, 0, ByVal 0&, ByVal 0&)
If cbBuf > 0 Then
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbBuf)
On Error GoTo 0
'转换文本
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), byBuf(0), cbBuf + 1, ByVal 0&, ByVal 0&)
'写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
End If
Case UEF_UTF16LE
'写文件
Call WriteFile(hFile, ByVal StrPtr(sText), LenB(sText), nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF16BE
'将字符串中的数据复制到byBuf
On Error GoTo FreeHandle
byBuf = sText
On Error GoTo 0
cbBuf = UBound(byBuf) - LBound(byBuf) + 1
'隔两字节翻转相邻字节
For I = 0 To cbBuf - 1 - 1 Step 2 '再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
'写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF32LE
UEFSaveTextFile = False '暂时不支持
Case UEF_UTF32BE
UEFSaveTextFile = False '暂时不支持
Case Else
Debug.Assert False
End Select
Else
UEFSaveTextFile = True
End If
FreeHandle:
'关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function
#20
晕,至于这么复杂吗?
#21
//晕,至于这么复杂吗?
现在本文编码技术发展飞快
GB2312-1980标准在1993年被GB13000-1993代替
GB13000-1993也在2000年被GB18030-2000代替
ASCII?!已经在坟墓里不知道烂了多久了
中国80年代的老教材早该改版了
从VB4开始
VB的String就是Unicode格式了
准确点来说是UTF-16LE编码
很是还有很多人受老教材的影响,还是以为英文1字节、中文2字节,这是根本错误的
现在本文编码技术发展飞快
GB2312-1980标准在1993年被GB13000-1993代替
GB13000-1993也在2000年被GB18030-2000代替
ASCII?!已经在坟墓里不知道烂了多久了
中国80年代的老教材早该改版了
从VB4开始
VB的String就是Unicode格式了
准确点来说是UTF-16LE编码
很是还有很多人受老教材的影响,还是以为英文1字节、中文2字节,这是根本错误的
#22
非常感谢这个模块!
读取中文字符现在没有问题了!
马上结帖!!!!
读取中文字符现在没有问题了!
马上结帖!!!!
#23
只能无条件佩服楼主了,呵呵!
#24
910几年以来一直都是个强人
#25
TO zyl910(910:分儿,我又来了!)
可否让我把这个模块放在我论坛上供网友们使用?
可否让我把这个模块放在我论坛上供网友们使用?
#26
没问题
#1
print写文件的吗?怎不知道是怎么回事,看看代码再说吧
#2
读TXT文件,读出的中文都是乱码
http://community.csdn.net/Expert/topic/4519/4519138.xml?temp=.6458399
http://community.csdn.net/Expert/topic/4519/4519138.xml?temp=.6458399
#3
这个不好说是什么原因?先看看文件的编码?再把你的代码贴上来
#4
首先非常感谢大家的关注。
浪费了大家的时间,我也感到很抱歉。
只是这个问题已经很久了,而我自己又不知道问题的原因,所以才来麻烦大家。
具体代码是这样的:
Public Function LoadFile(Optional ByVal FileName As String)
'载入文件
Dim TmpStr As String
Dim tmpNum1 As Long, tmpNum2 As Long, tmpNum3 As Long
Dim i As Long
Dim hIcon As Long
Dim cDlg As New ClsComdlg
On Error GoTo Err
If Changed = True Then
If MsgBox("当前文件已经改变,是否保存?", vbYesNo) = vbYes Then
Call SaveFile
Exit Function
End If
End If
If Len(FileName) < 5 Then
With cDlg
.FileTitle = "打开文件"
.Filter = "数据文件(*.DAT)|*.DAT|所有文件(*.*)|*.*"
.ShowOpen
FileName = .FileName
End With
If Len(FileName) < 6 Then Exit Function
End If
If FileExist(FileName) <> 1 Then
bMsg.bMsgBox "加载数据文件失败!", "严重"
Exit Function
Else
Call ClsArray
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, TmpStr
TmpStr = Mid(TmpStr, 2, Len(TmpStr) - 2)
If Len(TmpStr) > 1 Then
' TmpStr = DeCode(TmpStr, PassWD)
If Mid(TmpStr, 1, 3) = "###" Then '读入分类列表
ReDim Preserve ProgTypeList(UBound(ProgTypeList) + 1)
ReDim Preserve ProgTL_Num(UBound(ProgTL_Num) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
ProgTypeList(UBound(ProgTypeList)) = Mid(TmpStr, 1, tmpNum1 - 1)
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
If tmpNum1 > 0 Then ProgTL_Num(UBound(ProgTL_Num)) = CInt(TmpStr)
ElseIf Mid(TmpStr, 1, 3) = "#$#" Then
ReDim Preserve ProgTitle(UBound(ProgTitle) + 1)
ReDim Preserve ProgExeName(UBound(ProgExeName) + 1)
ReDim Preserve ProgCmd(UBound(ProgCmd) + 1)
ReDim Preserve ProgType(UBound(ProgType) + 1)
ReDim Preserve ProgIco(UBound(ProgIco) + 1)
ReDim Preserve RunBefore(UBound(RunBefore) + 1)
ReDim Preserve RunBCmd(UBound(RunBCmd) + 1)
ReDim Preserve RunMode(UBound(RunMode) + 1)
ReDim Preserve RunInHDD(UBound(RunInHDD) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
If tmpNum1 > 0 Then
ProgTitle(UBound(ProgTitle)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入标题
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '切割
tmpNum2 = InStr(TmpStr, ",")
ProgExeName(UBound(ProgExeName)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入文件名
Debug.Print ProgExeName(UBound(ProgExeName))
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgCmd(UBound(ProgCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入运行参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
ProgType(UBound(ProgType)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1)) '读入分类
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgIco(UBound(ProgIco)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入图标
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
RunBefore(UBound(RunBefore)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入"运行前执行"
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
RunBCmd(UBound(RunBCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入"运行前执行"的参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
If Mid(TmpStr, 1, tmpNum2 - 1) = "" Then '读入"是否在本地运行"
RunInHDD(UBound(RunInHDD)) = 0
Else
RunInHDD(UBound(RunInHDD)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1))
End If
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
If TmpStr = "" Then '读入兼容模式
RunMode(UBound(RunMode)) = -1
Else
RunMode(UBound(RunMode)) = CInt(TmpStr)
End If
Else
GoTo Err
End If
ElseIf Mid(TmpStr, 1, 3) = "#@#" Then
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
cUser = Mid(TmpStr, 1, tmpNum1 - 1) '读入用户名
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
cPassWD = TmpStr '读入密码
End If
End If
Loop
Close #1
Changed = False
Exit Function
End If
Err:
bMsg.bMsgBox "读取数据时出现错误!", "严重"
Close #1
Exit Function
End Function
浪费了大家的时间,我也感到很抱歉。
只是这个问题已经很久了,而我自己又不知道问题的原因,所以才来麻烦大家。
具体代码是这样的:
Public Function LoadFile(Optional ByVal FileName As String)
'载入文件
Dim TmpStr As String
Dim tmpNum1 As Long, tmpNum2 As Long, tmpNum3 As Long
Dim i As Long
Dim hIcon As Long
Dim cDlg As New ClsComdlg
On Error GoTo Err
If Changed = True Then
If MsgBox("当前文件已经改变,是否保存?", vbYesNo) = vbYes Then
Call SaveFile
Exit Function
End If
End If
If Len(FileName) < 5 Then
With cDlg
.FileTitle = "打开文件"
.Filter = "数据文件(*.DAT)|*.DAT|所有文件(*.*)|*.*"
.ShowOpen
FileName = .FileName
End With
If Len(FileName) < 6 Then Exit Function
End If
If FileExist(FileName) <> 1 Then
bMsg.bMsgBox "加载数据文件失败!", "严重"
Exit Function
Else
Call ClsArray
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, TmpStr
TmpStr = Mid(TmpStr, 2, Len(TmpStr) - 2)
If Len(TmpStr) > 1 Then
' TmpStr = DeCode(TmpStr, PassWD)
If Mid(TmpStr, 1, 3) = "###" Then '读入分类列表
ReDim Preserve ProgTypeList(UBound(ProgTypeList) + 1)
ReDim Preserve ProgTL_Num(UBound(ProgTL_Num) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
ProgTypeList(UBound(ProgTypeList)) = Mid(TmpStr, 1, tmpNum1 - 1)
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
If tmpNum1 > 0 Then ProgTL_Num(UBound(ProgTL_Num)) = CInt(TmpStr)
ElseIf Mid(TmpStr, 1, 3) = "#$#" Then
ReDim Preserve ProgTitle(UBound(ProgTitle) + 1)
ReDim Preserve ProgExeName(UBound(ProgExeName) + 1)
ReDim Preserve ProgCmd(UBound(ProgCmd) + 1)
ReDim Preserve ProgType(UBound(ProgType) + 1)
ReDim Preserve ProgIco(UBound(ProgIco) + 1)
ReDim Preserve RunBefore(UBound(RunBefore) + 1)
ReDim Preserve RunBCmd(UBound(RunBCmd) + 1)
ReDim Preserve RunMode(UBound(RunMode) + 1)
ReDim Preserve RunInHDD(UBound(RunInHDD) + 1)
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
If tmpNum1 > 0 Then
ProgTitle(UBound(ProgTitle)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入标题
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '切割
tmpNum2 = InStr(TmpStr, ",")
ProgExeName(UBound(ProgExeName)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入文件名
Debug.Print ProgExeName(UBound(ProgExeName))
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgCmd(UBound(ProgCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入运行参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
ProgType(UBound(ProgType)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1)) '读入分类
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
ProgIco(UBound(ProgIco)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入图标
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
RunBefore(UBound(RunBefore)) = Mid(TmpStr, 1, tmpNum2 - 1) '读入"运行前执行"
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
RunBCmd(UBound(RunBCmd)) = Mid(TmpStr, 1, tmpNum1 - 1) '读入"运行前执行"的参数
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1) '再切割
tmpNum2 = InStr(TmpStr, ",")
If Mid(TmpStr, 1, tmpNum2 - 1) = "" Then '读入"是否在本地运行"
RunInHDD(UBound(RunInHDD)) = 0
Else
RunInHDD(UBound(RunInHDD)) = CInt(Mid(TmpStr, 1, tmpNum2 - 1))
End If
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum2) '再切割
tmpNum1 = InStr(TmpStr, ",")
If TmpStr = "" Then '读入兼容模式
RunMode(UBound(RunMode)) = -1
Else
RunMode(UBound(RunMode)) = CInt(TmpStr)
End If
Else
GoTo Err
End If
ElseIf Mid(TmpStr, 1, 3) = "#@#" Then
TmpStr = Right(TmpStr, Len(TmpStr) - 3)
tmpNum1 = InStr(TmpStr, ",")
cUser = Mid(TmpStr, 1, tmpNum1 - 1) '读入用户名
TmpStr = Right(TmpStr, Len(TmpStr) - tmpNum1)
cPassWD = TmpStr '读入密码
End If
End If
Loop
Close #1
Changed = False
Exit Function
End If
Err:
bMsg.bMsgBox "读取数据时出现错误!", "严重"
Close #1
Exit Function
End Function
#5
这个过程是我程序的主类里的一个方法,用于读入数据文件到类中一组动态数组内。
其实它现在也工作很长一段时间了,只是这几天发现读入的文件中有一些中文不对头。
由于并不是全部不对,所以也觉得有点晕晕的(数据文件是用记事本手工编辑后保存为Dat文件的)。
另外,对于注册表的读入,就完全不对了,没有一个汉字是正常的,读注册表过程如下:
Public Sub OpenRegFile(ByVal RegFileName As String)
Dim RegStr() As String, tmpValue(5) As Long
Dim i As Long
Dim MainKeyName As String, SubKeyName As String, KeyValue As String
ReDim RegStr(0)
Open RegFileName For Input As #1
Do While EOF(1) = False
ReDim Preserve RegStr(UBound(RegStr) + 1)
Line Input #1, RegStr(UBound(RegStr))
RegStr(UBound(RegStr)) = UCase(RegStr(UBound(RegStr)))
Loop
Close #1
For i = 1 To UBound(RegStr)
tmpValue(0) = InStr(RegStr(i), "@")
tmpValue(1) = InStr(RegStr(i), "[")
tmpValue(2) = InStr(RegStr(i), "]")
tmpValue(3) = InStr(RegStr(i), """=HEX:")
tmpValue(4) = InStr(RegStr(i), """=DWORD:")
tmpValue(5) = InStr(RegStr(i), """=""")
SubKeyName = ""
KeyValue = ""
If tmpValue(1) > 0 And tmpValue(2) > 0 Then
MainKeyName = Mid(RegStr(i), tmpValue(1) + 1, tmpValue(2) - tmpValue(1) - 1)
End If
If tmpValue(0) = 0 Then
If tmpValue(3) > 0 Then
'二进制值
If GetKeyValue(RegStr(i), REGS_HEX, SubKeyName, KeyValue) = 1 Then
SetBinaryValue MainKeyName, SubKeyName, Hex(KeyValue)
End If
ElseIf tmpValue(4) > 0 Then
'十六进制值
If GetKeyValue(RegStr(i), REGS_DWORD, SubKeyName, KeyValue) = 1 Then
SetDWORDValue MainKeyName, SubKeyName, "&H" & KeyValue
End If
ElseIf tmpValue(5) > 0 Then
'字符串值
If GetKeyValue(RegStr(i), REGS_STRING, SubKeyName, KeyValue) = 1 Then
SetStringValue MainKeyName, SubKeyName, KeyValue
End If
End If
End If
Next i
End Sub
由于某些程序的注册表字符串中含有中文,导致这个过程根本无法使用,以致于现在我都还是调用的regedit.exe来导入,真的很不爽。。。。。。。
现在我希望各位能把造成此问题的原因讲讲,好让我以后遇到此类问题后也可以自己分析并解决。当然,能同时给出解决方案就更好了,呵呵~~
还有就是,我没有看过VB编程方面的书,学VB基本是看别人代码以及写代码学来的,所以在基础方面非常的差,因此在某些基础知识上还希望各位不嫌麻烦,讲明白一些~~:D
辛苦大家了!!
其实它现在也工作很长一段时间了,只是这几天发现读入的文件中有一些中文不对头。
由于并不是全部不对,所以也觉得有点晕晕的(数据文件是用记事本手工编辑后保存为Dat文件的)。
另外,对于注册表的读入,就完全不对了,没有一个汉字是正常的,读注册表过程如下:
Public Sub OpenRegFile(ByVal RegFileName As String)
Dim RegStr() As String, tmpValue(5) As Long
Dim i As Long
Dim MainKeyName As String, SubKeyName As String, KeyValue As String
ReDim RegStr(0)
Open RegFileName For Input As #1
Do While EOF(1) = False
ReDim Preserve RegStr(UBound(RegStr) + 1)
Line Input #1, RegStr(UBound(RegStr))
RegStr(UBound(RegStr)) = UCase(RegStr(UBound(RegStr)))
Loop
Close #1
For i = 1 To UBound(RegStr)
tmpValue(0) = InStr(RegStr(i), "@")
tmpValue(1) = InStr(RegStr(i), "[")
tmpValue(2) = InStr(RegStr(i), "]")
tmpValue(3) = InStr(RegStr(i), """=HEX:")
tmpValue(4) = InStr(RegStr(i), """=DWORD:")
tmpValue(5) = InStr(RegStr(i), """=""")
SubKeyName = ""
KeyValue = ""
If tmpValue(1) > 0 And tmpValue(2) > 0 Then
MainKeyName = Mid(RegStr(i), tmpValue(1) + 1, tmpValue(2) - tmpValue(1) - 1)
End If
If tmpValue(0) = 0 Then
If tmpValue(3) > 0 Then
'二进制值
If GetKeyValue(RegStr(i), REGS_HEX, SubKeyName, KeyValue) = 1 Then
SetBinaryValue MainKeyName, SubKeyName, Hex(KeyValue)
End If
ElseIf tmpValue(4) > 0 Then
'十六进制值
If GetKeyValue(RegStr(i), REGS_DWORD, SubKeyName, KeyValue) = 1 Then
SetDWORDValue MainKeyName, SubKeyName, "&H" & KeyValue
End If
ElseIf tmpValue(5) > 0 Then
'字符串值
If GetKeyValue(RegStr(i), REGS_STRING, SubKeyName, KeyValue) = 1 Then
SetStringValue MainKeyName, SubKeyName, KeyValue
End If
End If
End If
Next i
End Sub
由于某些程序的注册表字符串中含有中文,导致这个过程根本无法使用,以致于现在我都还是调用的regedit.exe来导入,真的很不爽。。。。。。。
现在我希望各位能把造成此问题的原因讲讲,好让我以后遇到此类问题后也可以自己分析并解决。当然,能同时给出解决方案就更好了,呵呵~~
还有就是,我没有看过VB编程方面的书,学VB基本是看别人代码以及写代码学来的,所以在基础方面非常的差,因此在某些基础知识上还希望各位不嫌麻烦,讲明白一些~~:D
辛苦大家了!!
#6
这两个过程的思路都是把文本文件以行为单位读入到字符串动态数组内,然后再进行字符串分析完成处理。
对字符串的分析过程应该已经没什么问题了,因为全英文文本文件是完全通过的。
现在只有这个中文的问题了。
另,刚刚突然想到一篇文章,是关于“模拟键盘输入”的,里面使用的是SendMessage函数发送文本,说“如果是中文,就要把中文同XXXX进行与运算,要不然就是乱码”,其中的“XXXX”我忘了是什么东东了,好象是一个十六进制值。
这个会不会有什么关系呢?
现在就等各位发言了,因为我现在已经发不了言了(CSDN连续发帖只能三帖吧,以前试过的),呵呵~~~辛苦各位了~~~
对字符串的分析过程应该已经没什么问题了,因为全英文文本文件是完全通过的。
现在只有这个中文的问题了。
另,刚刚突然想到一篇文章,是关于“模拟键盘输入”的,里面使用的是SendMessage函数发送文本,说“如果是中文,就要把中文同XXXX进行与运算,要不然就是乱码”,其中的“XXXX”我忘了是什么东东了,好象是一个十六进制值。
这个会不会有什么关系呢?
现在就等各位发言了,因为我现在已经发不了言了(CSDN连续发帖只能三帖吧,以前试过的),呵呵~~~辛苦各位了~~~
#7
注册表的:
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
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
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
调用的时候用GetString这个函数即可
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
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
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
调用的时候用GetString这个函数即可
#8
谢.....谢谢暴风雨.....
可能我还是没有说得很明白,抱歉....
读文件并处理的过程是这样的:
打开文本文件--->以行读取方式读入动态数组---->分析字符串并还原操作
现在我的问题不是第三步,而是第一二步里,"读入的内容"本身就不对头.
写入注册表的函数我有,而且可以正常写入中文.
我想得到一个此种问题的原因,因为只知道个解决办法是治标不治本啊~~~到头来我还是什么也没学到,最多就是多收藏一些代码而已.
再次麻烦各位~~~~~抱歉抱歉啦~~~呵呵
可能我还是没有说得很明白,抱歉....
读文件并处理的过程是这样的:
打开文本文件--->以行读取方式读入动态数组---->分析字符串并还原操作
现在我的问题不是第三步,而是第一二步里,"读入的内容"本身就不对头.
写入注册表的函数我有,而且可以正常写入中文.
我想得到一个此种问题的原因,因为只知道个解决办法是治标不治本啊~~~到头来我还是什么也没学到,最多就是多收藏一些代码而已.
再次麻烦各位~~~~~抱歉抱歉啦~~~呵呵
#9
vb的line input只能读本地编码的文件.
你的文本文件肯定不是本地编码(比如gb2312), 说不定是unicode编码的。
你在2000下用notepad打开, 另存为一下就行了。
你的文本文件肯定不是本地编码(比如gb2312), 说不定是unicode编码的。
你在2000下用notepad打开, 另存为一下就行了。
#10
同意楼上的想法啊,看看是不是编码问题啊
#11
只能人为地更改文件来源才能做到吗?
由于这里的目标是由系统注册表导出的REG文件,无法人为地更改其编码.
楼上有朋友说"vb的line input只能读本地编码的文件",那么是否有更好的办法来读入中文字符串呢?
麻烦各位了
由于这里的目标是由系统注册表导出的REG文件,无法人为地更改其编码.
楼上有朋友说"vb的line input只能读本地编码的文件",那么是否有更好的办法来读入中文字符串呢?
麻烦各位了
#12
//那么是否有更好的办法来读入中文字符串呢
用2进制方式(binary)访问文件
用2进制方式(binary)访问文件
#13
Unicode
ANSI
UTF-8
ANSI
UTF-8
#14
注册表用的Unicode字符集吧!我以前把它导出为文本文件时为Unicode,这时我在读该文件时就会出乱码,通常我会把它转成ANSI字符集的文件
#15
以二进制方式打开,判断BOM标记,自己写格式转换程序
对于UTF-8
可以以用MultiByteToWideChar将其转为Unicode格式,使用Windows2000新增代码页65001
对于UTF-16LE
VB的String用的就是UTF-16LE格式,先用字节数组读取文件内容,再直接给字符串变量赋值(sText = byBuf)
对于UTF-16BE
这是大端方式的UTF-16,先还是用字节数组读取文件内容,然后在字节数组中两个两个地交换相邻字节,再直接给字符串变量赋值
对于UTF-32
UTF-32采用的是4字节编码,只能手动转换,幸亏其不多见。
对于UTF-8
可以以用MultiByteToWideChar将其转为Unicode格式,使用Windows2000新增代码页65001
对于UTF-16LE
VB的String用的就是UTF-16LE格式,先用字节数组读取文件内容,再直接给字符串变量赋值(sText = byBuf)
对于UTF-16BE
这是大端方式的UTF-16,先还是用字节数组读取文件内容,然后在字节数组中两个两个地交换相邻字节,再直接给字符串变量赋值
对于UTF-32
UTF-32采用的是4字节编码,只能手动转换,幸亏其不多见。
#16
程序的基本思路没错,读出文件的部分也没错,问题出在每行读出后再做字符串操作这一块:如果读出的字符串全都是英文,你的这段代码也没什么问题;如果是中英文混合问题就来了,这里有几个表达式:
a=len("你好")
b=len("abcd")
c=lenb("你好")
d=lenb("abcd")
如果你认为a=b,那问题就出在这里了,实际结果是a=2,b=4,也就是说一个汉字占二个字符位(双字节表示),但c=d且都等于4,这说明它们占的字节数相同。这样问题也同样存在于mid这种字符串截取函数中,这里还有几个表达式:
str1=mid("你好吗",2)
str2=midb("你好吗",2)
str3=mid("abcdef",2)
str4=midb("abcdef",2)
str5=midb("abcdef",3)
对比一下它们的值,再注意一下它们的实际截取位置就可以了,祝你好运了!
a=len("你好")
b=len("abcd")
c=lenb("你好")
d=lenb("abcd")
如果你认为a=b,那问题就出在这里了,实际结果是a=2,b=4,也就是说一个汉字占二个字符位(双字节表示),但c=d且都等于4,这说明它们占的字节数相同。这样问题也同样存在于mid这种字符串截取函数中,这里还有几个表达式:
str1=mid("你好吗",2)
str2=midb("你好吗",2)
str3=mid("abcdef",2)
str4=midb("abcdef",2)
str5=midb("abcdef",3)
对比一下它们的值,再注意一下它们的实际截取位置就可以了,祝你好运了!
#17
支持UTF文本文件访问的模块
支持常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
Option Explicit
'mTextUTF.bas
'模块:UTF文本文件访问
'作者:zyl910
'版本:1.0
'日期:2006-1-23
'== 说明 ===================================================
'支持Unicode编码的文本文件读写。暂时支持ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'== 更新记录 ===============================================
'[V1.0] 2006-1-23
'1.支持最常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'## 编译预处理常数 #########################################
'== 全局常数 ===============================================
'IncludeAPILib:引用了API库,此时不需要手动写API声明
'## API ####################################################
#If IncludeAPILib = 0 Then
'== File ===================================================
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2
'== Unicode ================================================
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpDefaultChar As Any, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 As Long = 65001
#End If
'###########################################################
'Unicode编码格式
Public Enum UnicodeEncodeFormat
UEF_ANSI = 0 'ANSI+DBCS
UEF_UTF8 'UTF-8
UEF_UTF16LE 'UTF-16LE
UEF_UTF16BE 'UTF-16BE
UEF_UTF32LE 'UTF-32LE
UEF_UTF32BE 'UTF-32BE
UEF_Auto = -1 '自动识别编码
'隐藏项目
[_UEF_Min] = UEF_ANSI
[_UEF_Max] = UEF_UTF32BE
End Enum
'ANSI+DBCS方式的文本所使用的代码页。默认为0,表示使用系统当前代码页。可以利用该参数实现读取其他代码编码的文本,比如想在 简体中文平台下 读取 繁体中文平台生成的txt,就将它设为950
Public UEFCodePage As Long
'判断BOM
'返回值:BOM所占字节
'dwFirst:[in]文件最开始的4个字节
'fmt:[out]返回编码类型
Public Function UEFCheckBOM(ByVal dwFirst As Long, ByRef fmt As UnicodeEncodeFormat) As Long
If dwFirst = &HFEFF& Then
fmt = UEF_UTF32LE
UEFCheckBOM = 4
ElseIf dwFirst = &HFFFE0000 Then
fmt = UEF_UTF32BE
UEFCheckBOM = 4
ElseIf (dwFirst And &HFFFF&) = &HFEFF& Then
fmt = UEF_UTF16LE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFF&) = &HFFFE& Then
fmt = UEF_UTF16BE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFFFF) = &HBFBBEF Then
fmt = UEF_UTF8
UEFCheckBOM = 3
Else
fmt = UEF_ANSI
UEFCheckBOM = 0
End If
End Function
'生成BOM
'返回值:BOM所占字节
'fmt:[in]编码类型
'dwFirst:[out]文件最开始的4个字节
Public Function UEFMakeBOM(ByVal fmt As UnicodeEncodeFormat, ByRef dwFirst As Long) As Long
Select Case fmt
Case UEF_UTF8
dwFirst = &HBFBBEF
UEFMakeBOM = 3
Case UEF_UTF16LE
dwFirst = &HFEFF&
UEFMakeBOM = 2
Case UEF_UTF16BE
dwFirst = &HFFFE&
UEFMakeBOM = 2
Case UEF_UTF32LE
dwFirst = &HFEFF&
UEFMakeBOM = 4
Case UEF_UTF32BE
dwFirst = &HFFFE0000
UEFMakeBOM = 4
Case Else
dwFirst = 0
UEFMakeBOM = 0
End Select
End Function
'判断文本文件的编码类型
'返回值:编码类型。文件无法打开时,返回UEF_Auto
'FileName:文件名
Public Function UEFCheckTextFileFormat(ByVal FileName As String) As UnicodeEncodeFormat
Dim hFile As Long
Dim dwFirst As Long
Dim nNumRead As Long
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
UEFCheckTextFileFormat = UEF_Auto
Exit Function
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
nNumRead = UEFCheckBOM(dwFirst, UEFCheckTextFileFormat)
'Debug.Print nNumRead
'关闭文件
Call CloseHandle(hFile)
End Function
支持常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
Option Explicit
'mTextUTF.bas
'模块:UTF文本文件访问
'作者:zyl910
'版本:1.0
'日期:2006-1-23
'== 说明 ===================================================
'支持Unicode编码的文本文件读写。暂时支持ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'== 更新记录 ===============================================
'[V1.0] 2006-1-23
'1.支持最常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
'## 编译预处理常数 #########################################
'== 全局常数 ===============================================
'IncludeAPILib:引用了API库,此时不需要手动写API声明
'## API ####################################################
#If IncludeAPILib = 0 Then
'== File ===================================================
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2
'== Unicode ================================================
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpWideCharStr As Any, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByRef lpDefaultChar As Any, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 As Long = 65001
#End If
'###########################################################
'Unicode编码格式
Public Enum UnicodeEncodeFormat
UEF_ANSI = 0 'ANSI+DBCS
UEF_UTF8 'UTF-8
UEF_UTF16LE 'UTF-16LE
UEF_UTF16BE 'UTF-16BE
UEF_UTF32LE 'UTF-32LE
UEF_UTF32BE 'UTF-32BE
UEF_Auto = -1 '自动识别编码
'隐藏项目
[_UEF_Min] = UEF_ANSI
[_UEF_Max] = UEF_UTF32BE
End Enum
'ANSI+DBCS方式的文本所使用的代码页。默认为0,表示使用系统当前代码页。可以利用该参数实现读取其他代码编码的文本,比如想在 简体中文平台下 读取 繁体中文平台生成的txt,就将它设为950
Public UEFCodePage As Long
'判断BOM
'返回值:BOM所占字节
'dwFirst:[in]文件最开始的4个字节
'fmt:[out]返回编码类型
Public Function UEFCheckBOM(ByVal dwFirst As Long, ByRef fmt As UnicodeEncodeFormat) As Long
If dwFirst = &HFEFF& Then
fmt = UEF_UTF32LE
UEFCheckBOM = 4
ElseIf dwFirst = &HFFFE0000 Then
fmt = UEF_UTF32BE
UEFCheckBOM = 4
ElseIf (dwFirst And &HFFFF&) = &HFEFF& Then
fmt = UEF_UTF16LE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFF&) = &HFFFE& Then
fmt = UEF_UTF16BE
UEFCheckBOM = 2
ElseIf (dwFirst And &HFFFFFF) = &HBFBBEF Then
fmt = UEF_UTF8
UEFCheckBOM = 3
Else
fmt = UEF_ANSI
UEFCheckBOM = 0
End If
End Function
'生成BOM
'返回值:BOM所占字节
'fmt:[in]编码类型
'dwFirst:[out]文件最开始的4个字节
Public Function UEFMakeBOM(ByVal fmt As UnicodeEncodeFormat, ByRef dwFirst As Long) As Long
Select Case fmt
Case UEF_UTF8
dwFirst = &HBFBBEF
UEFMakeBOM = 3
Case UEF_UTF16LE
dwFirst = &HFEFF&
UEFMakeBOM = 2
Case UEF_UTF16BE
dwFirst = &HFFFE&
UEFMakeBOM = 2
Case UEF_UTF32LE
dwFirst = &HFEFF&
UEFMakeBOM = 4
Case UEF_UTF32BE
dwFirst = &HFFFE0000
UEFMakeBOM = 4
Case Else
dwFirst = 0
UEFMakeBOM = 0
End Select
End Function
'判断文本文件的编码类型
'返回值:编码类型。文件无法打开时,返回UEF_Auto
'FileName:文件名
Public Function UEFCheckTextFileFormat(ByVal FileName As String) As UnicodeEncodeFormat
Dim hFile As Long
Dim dwFirst As Long
Dim nNumRead As Long
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
UEFCheckTextFileFormat = UEF_Auto
Exit Function
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
nNumRead = UEFCheckBOM(dwFirst, UEFCheckTextFileFormat)
'Debug.Print nNumRead
'关闭文件
Call CloseHandle(hFile)
End Function
#18
'读取文本文件
'返回值:读取的文本。返回vbNullString表示文件无法打开
'FileName:[in]文件名
'fmt:[in,out]使用何种文本编码格式来读取文本。为UEF_Auto时表示自动判断,且在fmt参数返回文本所用编码格式
Public Function UEFLoadTextFile(ByVal FileName As String, Optional ByRef fmt As UnicodeEncodeFormat = UEF_Auto) As String
Dim hFile As Long
Dim nFileSize As Long
Dim nNumRead As Long
Dim dwFirst As Long
Dim CurFmt As UnicodeEncodeFormat
Dim cbBOM As Long
Dim cbTextData As Long
Dim CurCP As Long
Dim byBuf() As Byte
Dim cchStr As Long
Dim I As Long
Dim byTemp As Byte
'判断fmt范围
If fmt <> UEF_Auto Then
If fmt < [_UEF_Min] Or fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
'打开文件
hFile = CreateFile(FileName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
GoTo FunEnd
End If
'判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nNumRead <> 0 Then '超过4GB
GoTo FreeHandle
End If
If nFileSize < 0 Then '超过2GB
GoTo FreeHandle
End If
'判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
cbBOM = UEFCheckBOM(dwFirst, CurFmt)
'恢复文件指针
If fmt = UEF_Auto Then '自动判断
fmt = CurFmt
'cbBOM = cbBOM
Else '手动设置编码
If fmt = CurFmt Then '若编码相同,则忽略BOM标记
'cbBOM = cbBOM
Else '编码不同,那么都是数据
cbBOM = 0
End If
End If
Call SetFilePointer(hFile, cbBOM, ByVal 0&, FILE_BEGIN)
cbTextData = nFileSize - cbBOM
'读取数据
UEFLoadTextFile = ""
Select Case fmt
Case UEF_ANSI, UEF_UTF8
'判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
'读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
'取得Unicode文本长度
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal 0&, ByVal 0&)
If cchStr > 0 Then
'分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
'取得文本
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal StrPtr(UEFLoadTextFile), cchStr + 1)
End If
Case UEF_UTF16LE
cchStr = (cbTextData + 1) \ 2
'分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
'取得文本
nNumRead = 0
Call ReadFile(hFile, ByVal StrPtr(UEFLoadTextFile), cbTextData, nNumRead, ByVal 0&)
'修正文本长度
cchStr = (nNumRead + 1) \ 2
If cchStr > 0 Then
If Len(UEFLoadTextFile) > cchStr Then
UEFLoadTextFile = Left$(UEFLoadTextFile, cchStr)
End If
Else
UEFLoadTextFile = ""
End If
Case UEF_UTF16BE
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
'读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
If nNumRead > 0 Then
'隔两字节翻转相邻字节
For I = 0 To nNumRead - 1 - 1 Step 2 '再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
'取得文本
UEFLoadTextFile = byBuf 'VB允许String中的字符串数据与Byte数组直接转换
End If
Case UEF_UTF32LE
UEFLoadTextFile = vbNullString '暂时不支持
Case UEF_UTF32BE
UEFLoadTextFile = vbNullString '暂时不支持
Case Else
Debug.Assert False
End Select
FreeHandle:
'关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function
#19
'保存文本文件
'返回值:是否成功
'FileName:[in]文件名
'sText:[in]欲输出的文本
'IsAppend:[in]是否是添加方式
'fmt:[in,out]使用何种文本编码格式来存储文本。当IsAppend=True时允许UEF_Auto自动判断,且在fmt参数返回文本所用编码格式
'DefFmt:[in]当使用添加模式时,若文件不存在且fmt = UEF_Auto时应使用的编码格式
Public Function UEFSaveTextFile(ByVal FileName As String, _
ByRef sText As String, Optional ByVal IsAppend As Boolean = False, _
Optional ByRef fmt As UnicodeEncodeFormat = UEF_Auto, Optional ByVal DefFmt As UnicodeEncodeFormat = UEF_ANSI) As Boolean
Dim hFile As Long
Dim nFileSize As Long
Dim nNumRead As Long
Dim dwFirst As Long
Dim cbBOM As Long
Dim CurCP As Long
Dim byBuf() As Byte
Dim cbBuf As Long
Dim I As Long
Dim byTemp As Byte
'判断fmt范围
If IsAppend And (fmt = UEF_Auto) Then
Else
If fmt < [_UEF_Min] Or fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
'打开文件
hFile = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, IIf(IsAppend, OPEN_ALWAYS, CREATE_ALWAYS), FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then '文件无法打开
GoTo FunEnd
End If
'判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nFileSize = 0 And nNumRead = 0 Then '文件大小为0字节
IsAppend = False '此时需要写BOM标志
If fmt = UEF_Auto Then fmt = DefFmt
End If
'判断BOM
If IsAppend And (fmt = UEF_Auto) Then
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
cbBOM = UEFCheckBOM(dwFirst, fmt)
ElseIf IsAppend = False Then
cbBOM = UEFMakeBOM(fmt, dwFirst)
End If
'文件指针定位
Call SetFilePointer(hFile, 0, ByVal 0&, IIf(IsAppend, FILE_END, FILE_BEGIN))
'写BOM
If IsAppend = False Then
If cbBOM > 0 Then
Call WriteFile(hFile, dwFirst, cbBOM, nNumRead, ByVal 0&)
End If
End If
'写文本数据
If Len(sText) > 0 Then
Select Case fmt
Case UEF_ANSI, UEF_UTF8
'判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
'取得缓冲区大小
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), ByVal 0&, 0, ByVal 0&, ByVal 0&)
If cbBuf > 0 Then
'分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbBuf)
On Error GoTo 0
'转换文本
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), byBuf(0), cbBuf + 1, ByVal 0&, ByVal 0&)
'写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
End If
Case UEF_UTF16LE
'写文件
Call WriteFile(hFile, ByVal StrPtr(sText), LenB(sText), nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF16BE
'将字符串中的数据复制到byBuf
On Error GoTo FreeHandle
byBuf = sText
On Error GoTo 0
cbBuf = UBound(byBuf) - LBound(byBuf) + 1
'隔两字节翻转相邻字节
For I = 0 To cbBuf - 1 - 1 Step 2 '再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
'写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF32LE
UEFSaveTextFile = False '暂时不支持
Case UEF_UTF32BE
UEFSaveTextFile = False '暂时不支持
Case Else
Debug.Assert False
End Select
Else
UEFSaveTextFile = True
End If
FreeHandle:
'关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function
#20
晕,至于这么复杂吗?
#21
//晕,至于这么复杂吗?
现在本文编码技术发展飞快
GB2312-1980标准在1993年被GB13000-1993代替
GB13000-1993也在2000年被GB18030-2000代替
ASCII?!已经在坟墓里不知道烂了多久了
中国80年代的老教材早该改版了
从VB4开始
VB的String就是Unicode格式了
准确点来说是UTF-16LE编码
很是还有很多人受老教材的影响,还是以为英文1字节、中文2字节,这是根本错误的
现在本文编码技术发展飞快
GB2312-1980标准在1993年被GB13000-1993代替
GB13000-1993也在2000年被GB18030-2000代替
ASCII?!已经在坟墓里不知道烂了多久了
中国80年代的老教材早该改版了
从VB4开始
VB的String就是Unicode格式了
准确点来说是UTF-16LE编码
很是还有很多人受老教材的影响,还是以为英文1字节、中文2字节,这是根本错误的
#22
非常感谢这个模块!
读取中文字符现在没有问题了!
马上结帖!!!!
读取中文字符现在没有问题了!
马上结帖!!!!
#23
只能无条件佩服楼主了,呵呵!
#24
910几年以来一直都是个强人
#25
TO zyl910(910:分儿,我又来了!)
可否让我把这个模块放在我论坛上供网友们使用?
可否让我把这个模块放在我论坛上供网友们使用?
#26
没问题