[常用API收藏] 注册表编辑

这几天整理注册表相关的,于是收藏了此模块,相当完善的编辑方法。
标准模块代码:

Option Explicit
Option Compare Text
'---------------------------------------------------------------
'- 注册表 API 声明...
'---------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, 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 RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) 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
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long          'Returns a valid LUID which is important when making security changes in NT.
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'---------------------------------------------------------------
'- 注册表 Api 常数...
'---------------------------------------------------------------
' 注册表创建类型值...
Const REG_OPTION_NON_VOLATILE = 0        ' 当系统重新启动时,关键字被保留
' 注册表关键字安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_Create_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_Create_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_Create_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_Create_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_Create_LINK + READ_CONTROL
' 返回值...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0
' 有关导入/导出的常量
Const REG_FORCE_RESTORE As Long = 8&
Const TOKEN_QUERY As Long = &H8&
Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Const SE_PRIVILEGE_ENABLED As Long = &H2
Const SE_RESTORE_NAME = "SeRestorePrivilege"
Const SE_BACKUP_NAME = "SeBackupPrivilege"
'---------------------------------------------------------------
'- 注册表类型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges As LUID_AND_ATTRIBUTES
End Type
'---------------------------------------------------------------
'- 自定义枚举类型...
'---------------------------------------------------------------
' 注册表数据类型...
Public Enum ValueType
REG_SZ = 1                         ' 字符串值
REG_EXPAND_SZ = 2                  ' 可扩充字符串值
REG_BINARY = 3                     ' 二进制值
REG_DWORD = 4                      ' DWORD值
REG_MULTI_SZ = 7                   ' 多字符串值
End Enum
' 注册表关键字根类型...
Public Enum KeyRoot
HKEY_CLASSES_ROOT =\n&H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum
Private hKey As Long                   ' 注册表打开项的句柄
Private i As Long, j As Long           ' 循环变量
Private Success As Long                ' API函数的返回值, 判断函数调用是否成功
'-------------------------------------------------------------------------------------------------------------
'- 新建注册表关键字并设置注册表关键字的值...
'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键...
'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------
Public Function SetKeyValue(KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As ValueType = REG_SZ) As Boolean
Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型
lpAttr.nLength = 50                                 ' 设置安全属性为缺省值...
lpAttr.lpSecurityDescriptor = 0                     ' ...
lpAttr.bInheritHandle = True                        ' ...
' 新建注册表关键字...
Success = RegCreateKeyEx(KeyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
' 设置注册表关键字的值...
If IsMissing(ValueName) = False Then
Select Case ValueType
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
Case REG_DWORD
If CDbl(Value) < = 4294967295# And CDbl(Value) >= 0 Then
Dim sValue As String
sValue = DoubleToHex(Value)
Dim dValue(3) As Byte
dValue(0) = Format("&h" & Mid(sValue, 7, 2))
dValue(1) = Format("&h" & Mid(sValue, 5, 2))
dValue(2) = Format("&h" & Mid(sValue, 3, 2))
dValue(3) = Format("&h" & Mid(sValue, 1, 2))
Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)
Else
Success = ERROR_BADKEY
End If
Case REG_BINARY
On Error Resume Next
Success = 1                             ' 假设调用API不成功(成功返回0)
ReDim tmpValue(UBound(Value)) As Byte
For i = 0 To UBound(tmpValue)
tmpValue(i) = Value(i)
Next i
Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)
End Select
End If
If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
' 关闭注册表关键字...
RegCloseKey hKey
SetKeyValue = True                                       ' 返回函数值
End Function
'-------------------------------------------------------------------------------------------------------------
'- 获得已存在的注册表关键字的值...
'- 如果 ValueName="" 则返回 KeyName 项的默认值...
'- 如果指定的注册表关键字不存在, 则返回空串...
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------
Public Function GetKeyValue(KeyRoot As KeyRoot, KeyName As String, ValueName As String, Optional ValueType As Long) As String
Dim TempValue As String      &nbs\np;                      ' 注册表关键字的临时值
Dim Value As String                                 ' 注册表关键字的值
Dim ValueSize As Long                               ' 注册表关键字的值的实际长度
TempValue = Space(1024)                             ' 存储注册表关键字的临时值的缓冲区
ValueSize = 1024                                    ' 设置注册表关键字的值的默认长度
' 打开一个已存在的注册表关键字...
RegOpenKeyEx KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey
' 获得已打开的注册表关键字的值...
RegQueryValueEx hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize
' 返回注册表关键字的的值...
Select Case ValueType                                                        ' 通过判断关键字的类型, 进行处理
Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
TempValue = Left$(TempValue, ValueSize - 1)                          ' 去掉TempValue尾部空格
Value = TempValue
Case REG_DWORD
ReDim dValue(3) As Byte
RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize
For i = 3 To 0 Step -1
Value = Value + String(2 - Len(Hex(dValue(i))), "0") + Hex(dValue(i))   ' 生成长度为8的十六进制字符串
Next i
If CDbl("&H" & Value) < 0 Then                                              ' 将十六进制的 Value 转换为十进制
Value = 2 ^ 32 + CDbl("&H" & Value)
Else
Value = CDbl("&H" & Value)
End If
Case REG_BINARY
If ValueSize > 0 Then
ReDim bValue(ValueSize - 1) As Byte                                     ' 存储 REG_BINARY 值的临时数组
RegQueryValueEx hKey, ValueName, 0, REG_BINARY, bValue(0), ValueSize
For i = 0 To ValueSize - 1
Value = Value + String(2 - Len(Hex(bValue(i))), "0") + Hex(bValue(i)) + " "  ' 将数组转换成字符串
Next i
End If
End Select
' 关闭注册表关键字...
RegCloseKey hKey
GetKeyValue = Trim(Value)                                                    ' 返回函数值
End Function
'-------------------------------------------------------------------------------------------------------------
'- 删除已存在的注册表关键字的值...
'- 如果指定的注册表关键字不存在, 则不做任何操作...
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称
'-------------------------------------------------------------------------------------------------------------
Public Function DeleteKey(KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String) As Boolean
Dim tmpKeyName As String                            ' 注册表关键字的临时子项名称
Dim tmpValueName As String                          ' 注册表关键字的临时子键名称
' 打开一个已存在的注册表关键字...
Success = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit Function
' 删除已打开的注册表关键字...
tmpKeyName = ""
tmpValueName = KeyName
If ValueName = "" Then                                    &\nnbsp;         ' 判断ValueName是否缺省, 如缺省作相应处理
If InStrRev(KeyName, "\\") > 1 Then
tmpValueName = Right(KeyName, InStrRev(KeyName, "\\") + 1)
tmpKeyName = Left(KeyName, InStrRev(KeyName, "\\") - 1)
End If
Success = RegOpenKeyEx(KeyRoot, tmpKeyName, 0, KEY_ALL_ACCESS, hKey)
Success = RegDeleteKey(hKey, tmpValueName)
Else
Success = RegDeleteValue(hKey, ValueName)
End If
If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit Function
' 关闭注册表关键字...
RegCloseKey hKey
DeleteKey = True                                    ' 返回函数值
End Function
'-------------------------------------------------------------------------------------------------------------
'- 获得注册表关键字的一些信息...
'- SubKeyName()      注册表关键字的所有子项的名称(注意:最小下标为0)
'- ValueName()       注册表关键字的所有子键的名称(注意:最小下标为0)
'- ValueType()       注册表关键字的所有子键的类型(注意:最小下标为0)
'- CountKey          注册表关键字的子项数量
'- CountValue        注册表关键字的子键数量
'- MaxLenKey         注册表关键字的子项名称的最大长度
'- MaxLenValue       注册表关键字的子键名称的最大长度
'-------------------------------------------------------------------------------------------------------------
Public Function GetKeyInfo(KeyRoot As KeyRoot, KeyName As String, SubKeyName() As String, ValueName() As String, ValueType() As ValueType, Optional CountKey As Long, Optional CountValue As Long, Optional MaxLenKey As Long, Optional MaxLenValue As Long) As Boolean
Dim f As FILETIME
Dim l As Long, s As String
' 打开一个已存在的注册表关键字...
Success = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
' 获得一个已打开的注册表关键字的信息...
Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)
If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
If CountKey <> 0 Then
ReDim SubKeyName(CountKey - 1) As String            ' 重新定义数组, 使用数组大小与注册表关键字的子项数量匹配
For i = 0 To CountKey - 1
SubKeyName(i) = Space(255)
l = 255
RegEnumKeyEx hKey, i, ByVal SubKeyName(i), l, 0, vbNullString, ByVal 0&, f
SubKeyName(i) = Left(SubKeyName(i), l)
Next i
' 下面的二重循环对字符串数组进行冒泡排序
For i = 0 To UBound(SubKeyName)
For j = i + 1 To UBound(SubKeyName)
If SubKeyName(i) > SubKeyName(j) Then
s = SubKeyName(i)
SubKeyName(i) = SubKeyName(j)
SubKeyName(j) = s
End If
Next j
Next i
End If
If CountValue <> 0 Then
ReDim ValueName(CountValue - 1) As String           ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
ReDim ValueType(CountValue - 1) As Long             ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
For i = 0 To CountValue - 1
ValueName(i) = Space(255)
l = 255
RegEnumValue hKey, i, ByVal ValueName(i), l, 0, ValueType(i), ByVal 0&, ByVal 0&
ValueName(i) = Left(ValueName(i), l)
Next i
' 下面的二重循环对字符串数组进行冒泡排序
For i = 0 To UBound(ValueName)
For j = i + 1 To UBound(ValueName)
If ValueName(i) > ValueName(j) Then
s = ValueName(i)
ValueName(i) = ValueName(j)
ValueName(j) = s
End If
&\nnbsp;  Next j
Next i
End If
' 关闭注册表关键字...
RegCloseKey hKey
GetKeyInfo = True                                   ' 返回函数值
End Function
'-------------------------------------------------------------------------------------------------------------
'- 导出注册表关键字的值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导出的文件路径及文件名(原始数据库格式)
'-------------------------------------------------------------------------------------------------------------
Public Function SaveKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
On Error Resume Next
Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型
lpAttr.nLength = 50                                 ' 设置安全属性为缺省值...
lpAttr.lpSecurityDescriptor = 0                     ' ...
lpAttr.bInheritHandle = True                        ' ...
If EnablePrivilege(SE_BACKUP_NAME) = False Then
SaveKey = False
Exit Function
End If
Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
If Success <> 0 Then
SaveKey = False
Success = RegCloseKey(hKey)
Exit Function
End If
Success = RegSaveKey(hKey, FileName, lpAttr)
If Success = 0 Then SaveKey = True Else SaveKey = False
Success = RegCloseKey(hKey)
End Function
'-------------------------------------------------------------------------------------------------------------
'- 导入注册表关键字的值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导入的文件路径及文件名(原始数据库格式)
'-------------------------------------------------------------------------------------------------------------
Public Function RestoreKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
On Error Resume Next
If EnablePrivilege(SE_RESTORE_NAME) = False Then
RestoreKey = False
Exit Function
End If
Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
If Success <> 0 Then
RestoreKey = False
Success = RegCloseKey(hKey)
Exit Function
End If
Success = RegRestoreKey(hKey, FileName, REG_FORCE_RESTORE)
If Success = 0 Then RestoreKey = True Else RestoreKey = False
Success = RegCloseKey(hKey)
End Function
'-------------------------------------------------------------------------------------------------------------
'- 使注册表允许导入/导出
'-------------------------------------------------------------------------------------------------------------
Private Function EnablePrivilege(seName As String) As Boolean
On Error Resume Next
Dim p_lngRtn As Long
Dim p_lngToken As Long
Dim p_lngBufferLen As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, p_lngToken)
If p_lngRtn = 0 Then
EnablePrivilege = False
Exit Function
End If
If Err.LastDllError <> 0 Then
EnablePrivilege = False
Exit Function
End If
p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
If p_lngRtn = 0 Then
EnablePrivilege = False
Exit Function
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)
End Function
'-------------------------------------------------------------------------------------------------------------
'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零
'- 参数说明: Number--要转换的 Double 型数字
'-------------------------------------------------------------------------------------------------------------
Private Function DoubleToHex(ByVal Number As Double) As String
Dim strHex As String
strHex = Space(8)
For i = 1 To 8
Select Case Number - Int(Number / 16) * 16
Case 10
Mid(strHex, 9 - i, 1) = "A"
Case 11
Mid(strHex, 9 - i, 1) = "B"
Case 12
Mid(strHex, 9 - i, 1) = "C"
&nbs\np;        Case 13
Mid(strHex, 9 - i, 1) = "D"
Case 14
Mid(strHex, 9 - i, 1) = "E"
Case 15
Mid(strHex, 9 - i, 1) = "F"
Case Else
Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)
End Select
Number = Int(Number / 16)
Next i
DoubleToHex = strHex
End Function

关于近期的模拟赛

于是,和往年一样,一到这个时候,大大小小的模拟赛都出来了,但是今年气氛很不同,以往喜欢都往Vijos塞的模拟赛,目前都喜欢邮件提交,难道都被Vijos那神奇的系统搞怕了。
于是还是收集了最近的两次,难能可贵的是,还有初赛的模拟赛,看来Oier的热情高涨呀。
2007年8月19日(农历七月初七) 晚7:00至10:00举办MM群2007七夕模拟赛,希望大家踊跃参加!
地址:http://rle.sqybi.com/
AboutMe:由于15日-20日军训,于是等到军训回来才能参加了= =
2007年8月25日 19:30—21:30(2小时) OIFans.cn第一次NOIP初赛模拟赛
地址:http://oifans.cn/
AboutMe:少有的初赛模拟赛,怎能错过。
另外上次在Vijos上办的《潘帕斯雄鹰比赛》,今年第一场不错的模拟赛,我整理成Cena的文档了。下面给出 下载:
下载文件 点击下载此文件

郁闷,又一个常用软件在Vista下不能正常运行了

前一段,在进行工具安装的时候,发现手头的《金山词霸2006》是iso的,于是去下载了一个Daemon Tools ,安装后重启变蓝屏,使用最后一次正常的系统记录恢复后,系统提示Daemon Tools 与Vista不兼容,于是想了其他办法,装好《金山词霸2006》 打开,告诉我 他也不被兼容= =,话说之前的金山快译丝毫没有问题。
辅助更新还好,昨天装了零售版的《天网防火墙2007》,系统就挂掉了,最后用了系统修复光盘才恢复,今天留意了一下,天网尽然不支持Vista,而且Vista下的版本还正在开发中。。。。。。。。。。安全软件没有怎么吃饭呀,难道还要用Vista自带的脆弱的防火墙,还好装了卡巴,不过只是KAV而不是KIS。。。。不过先凑合避免病毒再说了,只能说等待这天网。。。。。。又开始怀念之前因为一个功能影响网络而被我换装到台式机上的麦咖啡了。。。。。。好说他只要关闭一个本来就不必要的功能就能在Vista正常使用了。。。
看来Vista的普及还需要时间那。。。。。。。。。。。。。

赞,Dell的服务速度快呀,比铁通快多了

由于长期网络不正常,昨晚实在忍不住了,就给Dell的技术中心写了一封资讯邮件,
今天早上上班时间9:20,就接到了Dell的电话,并且直接点破了问题的原因,McAfee的问题
话说我之前卸载McAfee后网络就基本正常,也在怀疑McAfee,但是还是没有确定时哪个模块的问题
今天收到的解释时: McAfee 反钓鱼 在 Vista 环境下导致上网不正常的问题。
另外邮箱也给了解决方案的邮件。工作效率真高。。。。服务态度也相当不错。。。。
于是再次感叹,之前铁通说叫技术人员上门,并一直问我们技术人员来了吗?结果技术人员一直没有联系我们。。。。终于来了,得到的解释时:重装系统吧= =
于是一切终于有了一个说话,无线网络也恢复正常,Orz………………..

[常用API]一个不含在通用对话框控件中的常用对话框

选择文件夹对话框,在安装程序和软件设置中经常用到,但是神奇的是,如此常用的对话框,却不包含在VB的通用对话框控件中,这也导致了很多人手工设计这个对话框。今天在翻看别人程序的时候,发现他们用到了这个API,于是就写出来分享。
此API在Vista下也测试成功,所以可以正常使用。
API如下:
程序代码 程序代码
Private Declare Function SHBrowseForFolder Lib “shell32.dll” Alias “SHBrowseForFolderA” (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib “shell32.dll” Alias “SHGetPathFromIDListA” (ByVal pidl As Long, ByVal pszPath As String) As Long
相关的测试程序代码,贴在附件中。
下载文件

总想写点什么,于是写写最近OI的情况吧

7月底到龙岩的训练,朱全民老师教会了我们许多,当然由于小朋友来了很多,一些难的知识点没有提到,也感到有些遗憾。
在龙岩这段期间,不愉快的事情也有,校舍条件差到没有水(貌似有发现含有那啥钙镁化合物之类的硬水,于是撤离= =)没电灯,没风扇,熄灯不熄灯已经不重要了,最后只要4个人去住宾馆的2室一厅的房间。在晚上上机时龙岩一中的某些人故意限制网路啦,关闭交换机啦,导致局域网都不能有正常的连接,不过还好,他们那的U盘能够正常使用,于是将就着用来交换数据了。也有几天,索性就没有呆在机房了,于是,很多讲义里面的题目需要等到回到福州以后慢慢完成了(话说在那里也没有心情完成了)。
昨天去参加了Stupid的模拟赛,也顺带测验了一下最近的成果,还好,前两题都没有问题,不得不佩服五角星大牛了,后面两题也完成了,虽然说测试当初的程序不佳,但今天改善完成后出现了350分的好程序。我还一直看着 200分(恩,能够没错完成两题。。。。还不错啦)。。。。。
今天主要还是把昨天模拟赛的题目完成了。最近有些昏昏成成的,不过还是有些成果出来,也算对自己的安慰啦。

2007/08/01 数码兽诞生10周年 !

2007年08月01日 与台场纪念日 ,数码兽诞生10周年!
多么激动人心的时刻,回想起DA时,那蝴蝶的翩翩起舞,那惊险刺激的冒险。
10年了,Digimon!
Butter-Fly 振翅高飞!
想要化作快乐的蝴蝶 乘着发亮的风振翅高飞
现在只想马上和你相会
最好把不愉快的事全都忘记
似乎什么 wow wow~会在晴空下出现
但 wow wow~ 我甚至不了解未来的打算
在无限延伸的梦想后面 穿越虚无的世界
就算会失去被爱的梦想
甚至以这些不能依赖的羽翼 隐藏在那易停留的画面中
我仍希冀着爱的飞翔
想要化作幸福的蝴蝶 乘着热忱的风振翅高飞
没有多余的时间可以浪费
似乎什么 wow wow~会在晴空下出现
但 wow wow~ 我甚至不了解未来的打算
在无限延伸的梦想后面 穿越虚无的世界
就算会失去被爱的梦想
甚至以这些不能依赖的羽翼 隐藏在那易停留的画面中
我仍希冀着爱的飞翔
想要化作幸福的蝴蝶 乘着热忱的风振翅高飞
无论何地都想飞到你的身边
不明的话语出奇地简单
听到激动的乐声时 我会大声喊出
似乎什么 wow wow~想象回音响彻小城
但 wow wow~ 不可能预见这一切
在无限延伸的梦想后面 停留在这苦痛的世界
是啊 也许判断并不总是错的
甚至以这些笨拙的羽翼 浸染在那易停留的画面中
我仍希冀着爱的飞翔
在无限延伸的梦想后面 穿越虚无的世界
就算会失去被爱的梦想
甚至以这些不能依赖的羽翼 隐藏在那易停留的画面中
我仍希冀着飞翔 Oh Yeah
在无限延伸的梦想后面 停留在这苦痛的世界
是啊 也许判断并不总是错的
甚至以这些笨拙的羽翼 浸染在那易停留的画面中
我仍希冀着爱的飞翔
==========================================
DM07年台场纪念作《僕らのデジタルワールド》
MU地址:http://www.megaupload.com/?d=U3CM541V
==========================================
全新的专辑诞生,在数码兽诞生10周年的日子里献给所有热爱数码兽的粉丝们。
在数码兽纪念日[8/1台场纪念日],由历代登场角色、歌手的梦一般的竞演终于实现了!!
被Digimon Fans无法忘怀的8月1日纪念日。 今年,数码兽作为手机游戏诞生之后纪念恰好10年,历代五系列的歌手和登场角色梦一般的协作实现。 从数码兽大冒险到数码兽拯救者,这个才是Digimon Fans心愿的1张。
Digimon10周年特别企划CD专辑“デジモン 10th ANNIVERSARY[/b]”曲目判明!

収録曲:
01.永久に続け!! 
   作詞:亜美 作曲·編曲:真崎 修
   歌:八神太一(CV:藤田淑子)
02.明日
   作詞·作曲·編曲:宮崎 歩
   歌:本宮大輔(CV:木内レイコ)
03.キセキの宝物   
   作詞:亜美 作曲·編曲:宮崎 歩
   歌:松田啓人(CV:津村まこと)
04.Secret Rendezvous
   作詞·作曲·編曲:福士健太郎
   歌:神原拓也(CV:竹内順子)
05.夢のカケラ
   作詞:白井裕紀 作曲·編曲:真崎 修
   歌:大門 大(CV:保志総一朗)
06.TRY AGAIN!!
   作詞·作曲·編曲:IKUO
   歌:IKUO
07.想い出の向こう
   作詞·作曲·編曲:宮崎 歩、シライシ紗トリ、鈴木雅也
   歌:宮崎 歩
08.小さなかけら
   作詞·作曲:ai 編曲:守尾 崇
   歌:AiM
09.誇り~限りなき力の証明~
   作詞·作曲:和田光司 編曲:島田 充
   歌:和田光司', '

终于用上Vista了。恢复工作。

今天RP真不错,一回到家,就拿到了Vista的系统。。。。。。。。。。
装了上去,感到相当不错。
华丽的界面刚才是就差点让人疯狂。
当然测试“无线网络”和本地链接在Vista系统上的设置浪费了一个中午,还是无法解决 – – 本来想找宽带技术人员帮忙,结果没有找来,下午突然就可以使用网络了,真是Orz。。。。。
另外就是杀毒软件,据说McAfee很好用,就去买了一套15个月的授权,装了上去,才发现是何等的疯狂,不会用,不过还算好的是网络恢复了,我到网络上简单看了帮助。。。。。
话说再好的杀毒软件没有配置好,也没有用,比如NOD32之类的了。
另外QQ在Vista上很不稳定,我不知道腾讯怎么敢说支持Vista的。还是谷歌拼音+QQ,在Vista上就- – 那就更严重了- –
还 好的是本以为VB6在Vista不能正常运行,但是,我在Vista上就第一次打开貌似是初始化控件出错,关掉再开那就一切正常,没有想到的时 MiniCard此时已经可以自动适应Vista的界面风格了,因此正式确认MiniCard能够不需要任何补丁和修改在Vista上运行,不知道就是如 果在Vista编译,在其他计算机上使用会不会再出问题了 。。。。。。。。

UTF-8的一些处理

由于一些平台对UTF-8的支持不够,导致程序开发上的一些困难,于是查到一些资料,还是很有意义的。发出来参考一下
支持常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本

Option Explicit
&#39;mTextUTF.bas
&#39;模块:UTF文本文件访问
&#39;作者:zyl910
&#39;版本:1.0
&#39;日期:2006-1-23
&#39;== 说明 ===================================================
&#39;支持Unicode编码的文本文件读写。暂时支持ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
&#39;== 更新记录 ===============================================
&#39;[V1.0] 2006-1-23
&#39;1.支持最常见的ANSI、UTF-8、UTF-16LE、UTF-16BE这几种编码文本
&#39;## 编译预处理常数 #########################################
&#39;== 全局常数 ===============================================
&#39;IncludeAPILib:引用了API库,此时不需要手动写API声明
&#39;## API ####################################################
#If IncludeAPILib = 0 Then
&#39;== File ===================================================
Private Declare Function Cr&#101;ateFile Lib "kernel32" Alias "Cr&#101;ateFileA" (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 Cr&#101;ate_NEW = 1
Private Const Cr&#101;ate_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
&#39;== 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
&#39;###########################################################
&#39;Unicode编码格式
Public Enum UnicodeEncodeFormat
UEF_ANSI = 0 &#39;ANSI+DBCS
UEF_UTF8 &#39;UTF-8
UEF_UTF16LE &#39;UTF-16LE
UEF_UTF16BE &#39;UTF-16BE
UEF_UTF32LE &#39;UTF-32LE
UEF_UTF32BE &#39;UTF-32BE
UEF_Auto = -1 &#39;自动识别编码
&#39;隐藏项目
[_UEF_Min] = UEF_ANSI
[_UEF_Max] = UEF_UTF32BE
End Enum
&#39;ANSI+DBCS方式的文本所使用的代码页。默认为0,表示使用系统当前代码页。可以利用该参数实现读取其他代码编码的文本,比如想在 简体中文平台下 读取 繁体中文平台生成的txt,就将它设为950
Public UEFCodePage As Long
&#39;判断BOM
&#39;返回值:BOM所占字节
&#39;dwFirst:[in]文件最开始的4个字节
&#39;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
&#39;生成BOM
&#39;返回值:BOM所占字节
&#39;fmt:[in]编码类型
&#39;dwFirst:[out]文件最开始的4个字节
Public Function UEFMakeBOM(ByVal fmt As UnicodeEncodeFormat, ByRef dwFirst As Long) As Long
Sel&#101;ct 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 Sel&#101;ct
End Function
&#39;判断文本文件的编码类型
&#39;返回值:编码类型。文件无法打开时,返回UEF_Auto
&#39;FileName:文件名
Public Function UEFCheckTextFileFormat(ByVal FileName As String) As UnicodeEncodeFormat
Dim hFile As Long
Dim dwFirst As Long
Dim nNumRead As Long
&#39;打开文件
hFile = Cr&#101;ateFile(FileName, GENERIC_READ, FILE_SHARE_READ o&#114; FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then &#39;文件无法打开
UEFCheckTextFileFormat = UEF_Auto
Exit Function
End If
&#39;判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
nNumRead = UEFCheckBOM(dwFirst, UEFCheckTextFileFormat)
&#39;Debug.Print nNumRead
&#39;关闭文件
Call CloseHandle(hFile)
End Function
&#39;读取文本文件
&#39;返回值:读取的文本。返回vbNullString表示文件无法打开
&#39;FileName:[in]文件名
&#39;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
&#39;判断fmt范围
If fmt <> UEF_Auto Then
If fmt < &#91;_UEF_Min&#93; o&#114; fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
&#39;打开文件
hFile = Cr&#101;ateFile(FileName, GENERIC_READ, FILE_SHARE_READ o&#114; FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then &#39;文件无法打开
GoTo FunEnd
End If
&#39;判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nNumRead <> 0 Then &#39;超过4GB
GoTo FreeHandle
End If
If nFileSize < 0 Then &#\n39;超过2GB
GoTo FreeHandle
End If
&#39;判断BOM
dwFirst = 0
Call ReadFile(hFile, dwFirst, 4, nNumRead, ByVal 0&)
cbBOM = UEFCheckBOM(dwFirst, CurFmt)
&#39;恢复文件指针
If fmt = UEF_Auto Then &#39;自动判断
fmt = CurFmt
&#39;cbBOM = cbBOM
Else &#39;手动设置编码
If fmt = CurFmt Then &#39;若编码相同,则忽略BOM标记
&#39;cbBOM = cbBOM
Else &#39;编码不同,那么都是数据
cbBOM = 0
End If
End If
Call SetFilePointer(hFile, cbBOM, ByVal 0&, FILE_BEGIN)
cbTextData = nFileSize - cbBOM
&#39;读取数据
UEFLoadTextFile = ""
Sel&#101;ct Case fmt
Case UEF_ANSI, UEF_UTF8
&#39;判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
&#39;分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
&#39;读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
&#39;取得Unicode文本长度
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal 0&, ByVal 0&)
If cchStr > 0 Then
&#39;分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
&#39;取得文本
cchStr = MultiByteToWideChar(CurCP, 0, byBuf(0), nNumRead, ByVal StrPtr(UEFLoadTextFile), cchStr + 1)
End If
Case UEF_UTF16LE
cchStr = (cbTextData + 1) \\ 2
&#39;分配字符串空间
On Error GoTo FreeHandle
UEFLoadTextFile = String$(cchStr, 0)
On Error GoTo 0
&#39;取得文本
nNumRead = 0
Call ReadFile(hFile, ByVal StrPtr(UEFLoadTextFile), cbTextData, nNumRead, ByVal 0&)
&#39;修正文本长度
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
&#39;分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbTextData - 1)
On Error GoTo 0
&#39;读取数据
nNumRead = 0
Call ReadFile(hFile, byBuf(0), cbTextData, nNumRead, ByVal 0&)
If nNumRead > 0 Then
&#39;隔两字节翻转相邻字节
For I = 0 To nNumRead - 1 - 1 Step 2 &#39;再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
&#39;取得文本
UEFLoadTextFile = byBuf &#39;VB允许String中的字符串数据与Byte数组直接转换
End If
Case UEF_UTF32LE
UEFLoadTextFile = vbNullString &#39;暂时不支持
Case UEF_UTF32BE
UEFLoadTextFile = vbNullString &#39;暂时不支持
Case Else
Debug.Assert False
End Sel&#101;ct
FreeHandle:
&#39;关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function
&#39;保存文本文件
&#39;返回值:是否成功
&#39;FileName:[in]文件名
&#39;sText:[in]欲输出的文本
&#39;IsAppend:[in]是否是添加方式
&#39;fmt:[in,out]使用何种文本编码格式来存储文本。当IsAppend=True时允许UEF_Auto自动判断,且在fmt参数返回文本所用编码格式
&#39;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
&#39;判断fmt范围
If IsAppend And (fmt = UEF_Auto) Then
Else
If fmt < &#91;_UEF_Min&#93; o&#114; fmt > [_UEF_Max] Then
GoTo FunEnd
End If
End If
&#39;打开文件
hFile = Cr&#101;ateFile(FileName, GENERIC_READ o&#114; GENERIC_WRITE, FILE_SHARE_READ o&#114; FILE_SHARE_WRITE, ByVal 0&, IIf(IsAppend, OPEN_ALWAYS, Cr&#101;ate_ALWAYS), FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If INVALID_HANDLE_VALUE = hFile Then &#39;文件无法打开
GoTo FunEnd
End If
&#39;判断文件大小
nFileSize = GetFileSize(hFile, nNumRead)
If nFileSize = 0 And nNumRead = 0 Then &#39;文件大小为0字节
IsAppend = False &#39;此时需要写BOM标志
If fmt = UEF_Auto Then fmt = DefFmt
End If
&#39;判断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
&#39;文件指针定位
Call SetFilePointer(hFile, 0, ByVal 0&, IIf(IsAppend, FILE_END, FILE_BEGIN))
&#39;写BOM
If IsAppend = False Then
If cbBOM > 0 Then
Call WriteFile(hFile, dwFirst, cbBOM, nNumRead, ByVal 0&)
End If
End If
&#39;写文本数据
If Len(sText) > 0 Then
Sel&#101;ct Case fmt
Case UEF_ANSI, UEF_UTF8
&#39;判断应使用的CodePage
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, UEFCodePage)
&#39;取得缓冲区大小
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), ByVal 0&, 0, ByVal 0&, ByVal 0&)
If cbBuf > 0 Then
&#39;分配缓冲区
On Error GoTo FreeHandle
ReDim byBuf(0 To cbBuf)
On Error GoTo 0
&#39;转换文本
cbBuf = WideCharToMultiByte(CurCP, 0, ByVal StrPtr(sText), Len(sText), byBuf(0), cbBuf + 1, ByVal 0&, ByVal 0&)
&#39;写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
End If
Case UEF_UTF16LE
&#39;写文件
Call WriteFile(hFile, ByVal StrPtr(sText), LenB(sText), nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF16BE
&#39;将字符串中的数据复制到byBuf
On Error GoTo FreeHandle
byBuf = sText
On Error GoTo 0
cbBuf = UBound(byBuf) - LBound(byBuf) + 1
&#39;隔两字节翻转相邻字节
For I = 0 To cbBuf - 1 - 1 Step 2 &#39;再-1是为了避免最后多出的那个字节
byTemp = byBuf(I)
byBuf(I) = byBuf(I + 1)
byBuf(I + 1) = byTemp
Next I
&#39;写文件
Call WriteFile(hFile, byBuf(0), cbBuf, nNumRead, ByVal 0&)
UEFSaveTextFile = True
Case UEF_UTF32LE
UEFSaveTextFile = False &#39;暂时不支持
Case UEF_UTF32BE
UEFSaveTextFile = False &#39;暂时不支持
Case Else
Debug.Assert False
End Sel&#101;ct
Else
UEFSaveTextFile = True
End If
FreeHandle:
&#39;关闭文件
Call CloseHandle(hFile)
FunEnd:
End Function