frmMain.frm
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 '單線固定
Caption = "VB工程簡轉繁"
ClientHeight = 4935
ClientLeft = 45
ClientTop = 330
ClientWidth = 7815
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4935
ScaleWidth = 7815
StartUpPosition = 2 '螢幕中央
Begin VB.CheckBox SubCheck
Caption = "掃描子目錄"
ForeColor = &H00FF00FF&
Height = 255
Left = 360
TabIndex = 14
Top = 4440
Width = 1455
End
Begin VB.CommandButton Command3
Enabled = 0 'False
Height = 495
Left = 120
TabIndex = 13
Top = 4320
Width = 1935
End
Begin VB.DriveListBox Drive
Height = 300
Left = 2280
TabIndex = 9
Top = 240
Width = 5295
End
Begin VB.DirListBox Dir
Height = 3030
Left = 2280
TabIndex = 8
Top = 600
Width = 5295
End
Begin VB.TextBox txtPath
Height = 330
Left = 2280
TabIndex = 7
Top = 3720
Width = 5295
End
Begin VB.CommandButton Command2
Caption = "Command2"
Enabled = 0 'False
Height = 4095
Left = 2160
TabIndex = 6
Top = 120
Width = 5535
End
Begin VB.Frame Frame1
Caption = "文件類型"
ForeColor = &H000000FF&
Height = 3855
Left = 240
TabIndex = 2
Top = 240
Width = 1695
Begin VB.CheckBox CheckTXT
Caption = "TXT文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 12
Top = 2660
Width = 1215
End
Begin VB.CheckBox CheckDOC
Caption = "DOC文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 11
Top = 2200
Width = 1215
End
Begin VB.CheckBox checkCLS
Caption = "CLS文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 10
Top = 1740
Width = 1215
End
Begin VB.CheckBox checkFRM
Caption = "FRM文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 5
Top = 360
Width = 1215
End
Begin VB.CheckBox checkBAS
Caption = "BAS文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 4
Top = 820
Width = 1215
End
Begin VB.CheckBox checkCTL
Caption = "CTL文件"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 3
Top = 1280
Width = 1215
End
End
Begin VB.CommandButton Command1
Caption = "Command1"
Enabled = 0 'False
Height = 4095
Left = 120
TabIndex = 1
Top = 120
Width = 1935
End
Begin VB.CommandButton btnStart
Caption = "開 始 轉 換"
Height = 495
Left = 2160
MaskColor = &H8000000A&
TabIndex = 0
Top = 4320
Width = 5535
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub btnStart_Click()
Call SeachFile(txtPath)
MsgBox "OK"
End Sub
Private Sub GBToBIG5(strPath As String, strFileName As String, strFileNameEx As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim TmpFile As String '臨時文件名
TmpFile = Format(Now, "YYYYMMDDHHMMSS")
Open strPath & TmpFile & strFileNameEx For Output As #1
Print #1, StrGBToBIG5(UEFLoadTextFile(strPath & strFileName & strFileNameEx, UEF_Auto))
Close #1
Call Fso.DeleteFile(strPath & strFileName & strFileNameEx)
Call Fso.MoveFile(strPath & TmpFile & strFileNameEx, strPath & strFileName & strFileNameEx)
End Sub
'獲取某目錄下的所有子目錄路徑及名稱和檔的路徑及名稱
Public Sub SeachFile(ByVal strPath As String)
'sPath = "C:/Documents and Settings/Administrator/桌面/WallpaperChanger/"
'sFileName = "FrmMain.frm"
Dim Fso As Object
Dim Fol As Object
Dim Fil As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fol = Fso.GetFolder(strPath)
Dim sFileName As String '文件名(不含擴展名)
Dim sFileNameEx As String '擴展名
Dim sFilePath As String '文件路徑
For Each Fil In Fol.Files
sFileNameEx = UCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(Fil.Name)) '擴展名
If Trim(sFileNameEx) = "" Then '如果擴展名為空，則跳出本次循環
GoTo NoEx
End If
sFileName = Left(Fil.Name, Len(Fil.Name) - Len(sFileNameEx) - IIf(Len(sFileNameEx) = 0, 0, 1))
sFilePath = Fil.ParentFolder '取得父階文件夾路徑
sFilePath = sFilePath & "/"
If CheckValue(sFileNameEx) = 1 Then
checkFRM.Value = 1
Call GBToBIG5(sFilePath, sFileName, "." & sFileNameEx)
End If
NoEx:
Next
'掃描子目錄
If SubCheck.Value = 1 Then
For Each Fol In Fol.subfolders
SeachFile Fol
Next
End If
End Sub
Private Sub Drive_Change()
On Error Resume Next
Dir.Path = Drive.Drive
End Sub
Private Sub Dir_Change()
txtPath.Text = Dir.Path
End Sub
'用變量替代控件,方法1
Private Function CheckValue(Str As String) As Integer
On Error GoTo Err_Line
Dim TmpControl As CheckBox
Set TmpControl = Controls("check" & Str)
CheckValue = TmpControl.Value
Exit Function
Err_Line:
CheckValue = 0
End Function
''用變量替代控件,方法2
'Private Function CheckValue(Str As String) As Integer
' Dim TmpControl As CheckBox
' Set TmpControl = CallByName(Me, "check" & Str, VbGet)
' CheckValue = TmpControl.Value
'End Function
Private Sub Form_Load()
txtPath.Text = Dir.Path
End Sub
Private Sub txtPath_GotFocus()
txtPath.SelStart = 0
txtPath.SelLength = Len(txtPath.Text)
End SubGB2BIG5.bas
Attribute VB_Name = "GB2BIG5"
Public Declare Function LCMapString Lib "kernel32.dll" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Public Declare Function LCMapStringA Lib "kernel32.dll" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByRef lpSrcStr As Any, ByVal cchSrc As Long, ByRef lpDestStr As Any, ByVal cchDest As Long) As Long
Public Declare Function LCMapStringW Lib "kernel32.dll" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchDest As Long) As Long
Public Const LCMAP_BYTEREV As Long = &H800
Public Const LCMAP_FULLWIDTH As Long = &H800000
Public Const LCMAP_HALFWIDTH As Long = &H400000
Public Const LCMAP_HIRAGANA As Long = &H100000
Public Const LCMAP_KATAKANA As Long = &H200000
Public Const LCMAP_LINGUISTIC_CASING As Long = &H1000000
Public Const LCMAP_LOWERCASE As Long = &H100
Public Const LCMAP_SIMPLIFIED_CHINESE As Long = &H2000000
Public Const LCMAP_SORTKEY As Long = &H400
Public Const LCMAP_TRADITIONAL_CHINESE As Long = &H4000000
Public Const LCMAP_UPPERCASE As Long = &H200
'主語言ID
Public Const LANG_CHINESE As Long = &H4
'次語言ID
Public Const SUBLANG_CHINESE_TRADITIONAL As Long = &H1
Public Const SUBLANG_CHINESE_SIMPLIFIED As Long = &H2
Public Const SUBLANG_CHINESE_HONGKONG As Long = &H3
Public Const SUBLANG_CHINESE_SINGAPORE As Long = &H4
Public Const SUBLANG_CHINESE_MACAU As Long = &H5
'排序方式
Public Const SORT_CHINESE_PRCP As Long = &H0
Public Const SORT_CHINESE_BIG5 As Long = &H0
Public Const SORT_CHINESE_UNICODE As Long = &H1
Public Const SORT_CHINESE_PRC As Long = &H2
Public Const SORT_CHINESE_BOPOMOFO As Long = &H3
'生成LCID
Public Const LCID_CHINESE_SIMPLIFIED As Long = (LANG_CHINESE Or SUBLANG_CHINESE_SIMPLIFIED * &H400) And &HFFFF& Or SORT_CHINESE_PRCP * &H10000
Public Const LCID_CHINESE_TRADITIONAL As Long = (LANG_CHINESE Or SUBLANG_CHINESE_TRADITIONAL * &H400) And &HFFFF& Or SORT_CHINESE_BIG5 * &H10000
Public Function StrGBToBIG5(Str As String) As String '簡體轉繁體
Dim szSrc As String
Dim szDest As String
szSrc = Str
szDest = String$(Len(szSrc), 0) '僅僅簡繁轉換長度不會變化
Call LCMapStringW(LCID_CHINESE_TRADITIONAL, LCMAP_TRADITIONAL_CHINESE, ByVal StrPtr(szSrc), Len(szSrc), ByVal StrPtr(szDest), Len(szDest))
StrGBToBIG5 = szDest
End FunctionmTextUTF.bas
Attribute VB_Name = "mTextUTF"
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
'讀取文字檔案
'返回值：讀取的文本。返回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)
CurCP = IIf(fmt = UEF_UTF8, CP_UTF8, 936)
'分配緩衝區
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
'保存文字檔案
'返回值：是否成功
'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
