frmmain.frm
Version 5.00
Begin vb.form frmmain
BorderStyle = 1 'single-line fixed
CAPTION = "VB project is simple"
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 'screen center
Begin vb.checkbox subcheck
CAPTION = "Scan Sub Directory"
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 = 120width = 5535
End
Begin vb.frame frame1
CAPTION = "File Type"
Forecolor = & H000000FF &
HEIGHT = 3855
LEFT = 240
TabINDEX = 2
TOP = 240
Width = 1695
Begin vb.checkbox checktxt
CAPTION = "TXT file"
Forecolor = & H00FF0000 &
HEIGHT = 255
LEFT = 240
TabINDEX = 12
TOP = 2660
Width = 1215
End
Begin vb.checkbox checkdoc
CAPTION = "DOC file"
Forecolor = & H00FF0000 &
HEIGHT = 255
LEFT = 240
TabINDEX = 11
TOP = 2200
Width = 1215
End
Begin vb.checkbox checkcls
CAPTION = "CLS file"
Forecolor = & H00FF0000 &
HEIGHT = 255
LEFT = 240
TabINDEX = 10
TOP = 1740
Width = 1215
End
Begin Vb.checkbox Checkfrm
CAPTION = "FRM file"
Forecolor = & H00FF0000 &
HEIGHT = 255
LEFT = 240
TabINDEX = 5
TOP = 360
Width = 1215
End
Begin Vb.checkbox Checkbas
CAPTION = "BAS file"
Forecolor = & H00FF0000 &
HEIGHT = 255
LEFT = 240
TabINDEX = 4
TOP = 820
Width = 1215
End
Begin vb.checkbox checkctl
CAPTION = "CTL file"
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 = "start conversion"
HEIGHT = 495
LEFT = 2160
Maskcolor = & h8000000a & 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 expedition
Private sub btnStart_click ()
Call seachfile (txtpath)
MSGBOX "OK"
End Sub
Private sub GBTOBIG5 (Strfilename As String, StrfilenameEx as String)
DIM FSO As Object
SET FSO = CreateObject ("scripting.filesystemObject")
DIM TMPFILE AS STRING 'Temporary File Name
TMPFILE = Format (now, "YYYYMMDDHMMMS")
Open strpath & tmpfile & strfilenameex for Output AS # 1
Print # 1, STRGBTOBIG5 (UefloadTextFile (StrfLoadTextFile (StrfLoadTextFile (StrfLoadTextFile (StrfLoadTextFile)
Close # 1
Call fso.deletefile (strpath & strfilename & strfilenameex)
Call Fso.Movefile (StrPath & Tmpfile & Strfilenameex, StrPath & Strfilename & StrfileNameex)
End Sub
'Get all subdirectorial paths and names and names in a directory
Public Sub Seachfile (Byval StrPath As String)
'spath = "c: / documents and settings / administrator / desktop / 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 'File Name (excluding extensions)
DIM SFILENAMEX AS STRING 'extension
DIM SFILEPATH AS STRING 'File Path
For Each Fil in Fol.Files
SfileNameex = ucase ("scripting.filesystemObject"). getExtensionName (Fil.Name)) 'extension
If Trim (sfilenameex) = "" "" If the extension is empty, you jump out of this loop.
Goto Noex
END IF
SfileName = Left (Fil.Name, Len (Fil.Name) - LEN (SFileNameex) - IIF (Len (sfilenameex) = 0, 0, 1))
SfilePath = Fil.ParentFolder 'gets the parent folder path
sfilepath = sfilepath & "/"
If CheckValue (sfilenameex) = 1 THEN
Checkfrm.value = 1
Call GBTOBIG5 (sfilepath, sfilename, "." & Sfilenameex)
END IF
NOEX:
NEXT
'Scanning Sub Directory
If Subcheck.Value = 1 THEN
For Each Fol in Fol.Subfolders
Seachfile Fol
NEXT
END IF
End Sub
Private sub Drive_change ()
ON Error ResMe next
Dir.path = drive.drive
End Sub
Private sub Dir_change ()
TXTPATH.TEXT = dir.path
End Sub
'Replace control with variables, method 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
'' Replacement controls for variables, method 2
'Private function checkvalue (Str as string) AS Integer
'DIM TMPCONTROL As Checkbox
'Set TmpControl = CallbyName (ME, "Check" & Str, VBGET)
'CheckValue = TmpControl.Value'ENEND FUNCTION
Private sub flow_load ()
TXTPATH.TEXT = dir.path
End Sub
PRIVATE SUB TXTPATH_GOTFOCUS ()
TXTPATH.SELSTART = 0
TXTPATH.SELLENGTH = LEN (TXTPATH.TEXT)
End Sub
GB2BIG5.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
'Primary language ID
Public constrane_chinese as long = & h4
'Sub-language ID
Public const SUBLANG_CHINESE_TRADITIONAL AS Long = & H1
Public const SUBLANG_CHINESE_SIMPLIFIED AS Long = & H2Public const SUBLANG_CHINESE_HONGKONG AS long = & h3
Public const SUBLANG_CHINESE_SIINGAPORE As Long = & H4
Public const SUBLANG_CHINESE_MACAU As long = & h5
'Sort by
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
'Generate LCID
Public const lcid_chinese_simplified as long = (LANG_CHINESE OR SUBLANG_CHINESE_SIMPLIFIED * & H400) AND & HFFF & 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 'Simplified Translucent
DIM SZSRC AS STRING
Dim Szdest As String
SZSRC = STR
Szdest = string $ (len (szsrc), 0) 'only simple conversion length does not change
Call lcmapstringw (lcmap_tinese_traditional, lcmap_traditional_chinese, byval strptr (szsrc), len (szsrc), ByVal Strptr (szdest), Len (szdest))
STRGBTOBIG5 = SZDEST
END FUNCTION
MTEXTUTF.BAS
Attribute VB_Name = "mtextutf"
Option expedition
'mtextutf.bas
'Module: UTF text file access
'Author: zyl910
'Version: 1.0
'Date: 2006-1-23
'== Description =============================================== =====
'Support Unicode encoded text archives read and write. Temporarily support ANSI, UTF-8, UTF-16LE, UTF-16BE these coded text '== update record ========================= ======================
'[V1.0] 2006-1-23
'1. Support the most common ANSI, UTF-8, UTF-16LE, UTF-16BE these coding text
'## Compilation Prerequisites ######################################################################################################################################################################################################################################################################################
'== global constant ============================================= ==
'Includeapilib: Reference API library, there is no need to manually write API declarations
'## 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 LongPrivate 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) AS Long
Private declare function setfilepointer lib "kernel32" (Byval LdistanceTomove As Long, Byval DWMOVEMETHIGH AS Long) As long, ByVal DWMOVEMETHIGH AS Long, ByVal DWMOVEMETHOVE
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 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 LongPrivate 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 encoding format
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 'Automatic Identification Code
'Hidden project
[_UEF_MIN] = UEF_ANSI
[_UEF_MAX] = UEF_UTF32BE
END ENUM
The internal code table used by the text of the 'ANSI DBCS mode. Default is 0, indicating the use of the current internal code table. You can use this parameter to read the text of other code encoding. For example, if you want to read the TXT generated by the Traditional Chinese Platform under the Simplified Chinese Platform, set it to 950
Public UEFCODEPAGE AS Long
'Judging BOM
'Return value: BOM occupied tuple
'dwfirst: [in] 4 position groups in the file
'FMT: [OUT] Returns Code Type
Public Function UEfcheckbom (Byval Dwfirst As Long, Byref FMT As UnicodeEncodeFormat) AS LONG
IF dwfirst = & hfeff&
FMT = UEF_UTF32LE
Uefcheckbom = 4
Elseif dwfirst = & hfffe0000 Then
FMT = UEF_UTF32BE
Uefcheckbom = 4
Elseif (dwfirst and & hfff &) = & hfeff & kil
FMT = UEF_UTF16LELE
Uefcheckbom = 2
Elseif (dwfirst and & hfff &) = & hffe & kil
FMT = UEF_UTF16BE
Uefcheckbom = 2
Elseif (dwfirst and & hfffff) = & hbfbbef damt = UEF_UTF8
Uefcheckbom = 3
Else
FMT = UEF_ANSII
Uefcheckbom = 0
END IF
END FUNCTION
'Generate BOM
'Return value: BOM occupied tuple
'fmt: [in] encoding type
'dwfirst: [OUT] The first 4 position group
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 & HFEFF &
UEFMAKEBOM = 2
Case UEF_UTF16BE
Dwfirst = & HFFFE & HFFFE & HFFE &
UEFMAKEBOM = 2
Case UEF_UTF32LE
Dwfirst = & HFEFF & HFEFF &
UEFMAKEBOM = 4
Case UEF_UTF32BE
dwfirst = & hffe0000
UEFMAKEBOM = 4
Case Else
dwfirst = 0
UEFMAKEBOM = 0
End SELECT
END FUNCTION
'Judging the encoding type of the text file
'Return Value: Code type. When the file is unable to open, return to UEF_AUTO
'Filename: archive name
Public Function UEfcheckTextFileFormat (Byval FileName As String) AS UnicodeEncodeFormat
DIM HFILE AS Long
DIM DWFIRST AS Long
DIM NNUMREAD As Long
'open a file
Hfile = cretefile (filename, generic_read, file_share_read or file_share_write, byval 0 &, open_existing, file_attribute_normal, byval 0 &)
If INVALID_HANDLE_VALUE = Hfile Ten 'files can't open
UefcheckTextFileFormat = UEF_AUTO
EXIT FUNCTION
END IF
'Judging BOM
dwfirst = 0
Call Readfile (Hfile, Dwfirst, 4, NNumread, Byval 0 &)
NNumRead = UEfcheckbom (dwfirst, uefchecktextfileformat)
'Debug.print nnumread
'Close file
Call CloseHandle (HFILE)
END FUNCTION
'Read text file
'Return Value: Read the text. Returns vbnullstring means that the file cannot be opened.
'Filename: [in] archive name
'FMT: [IN, OUT] uses what text encoding format to read text. Express the automatic judgment when UEF_AUTO, and the encoding format used in the FMT parameter returns text
Public Function UefloadTextFile (Byval FileName As String, Optional Byref FMT As UnicodeEncodeFormat = UEF_AUTO) AS STRINGDIM 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
'Judging the FMT range
IF fmt <> UEF_AUTO THEN
IF FMT <[_UEF_MIN] or FMT> [_UEF_MAX] THEN
Goto Funend
END IF
END IF
'open a file
Hfile = cretefile (filename, generic_read, file_share_read or file_share_write, byval 0 &, open_existing, file_attribute_normal, byval 0 &)
If INVALID_HANDLE_VALUE = Hfile Ten 'files can't open
Goto Funend
END IF
'Judging the file size
NFILESIZE = GetFileSize (Hfile, NNumRead)
IF nnumread <> 0 TEN 'More than 4GB
Goto FreeHandle
END IF
IF NFILESIZE <0 Then 'More than 2GB
Goto FreeHandle
END IF
'Judging BOM
dwfirst = 0
Call Readfile (Hfile, Dwfirst, 4, NNumread, Byval 0 &)
CBBOM = UEfcheckbom (dwfirst, curfmt)
'Recovery file pointer
If FMT = UEF_AUTO THEN 'automatic judgment
FMT = Curfmt
'CBBOM = CBBOM
Else 'manual settings
If FMT = Curfmt Then 'is the same as the same encoding, ignore the BOM tag
'CBBOM = CBBOM
Else 'Coding is different, so all information
CBBOM = 0
END IF
END IF
Call setfilepointer (Hfile, CBBOM, BYVAL 0 &, FILE_BEGIN)
CBTextData = NFILESIZE - CBBOM
'Read data
UefloadTextFile = ""
SELECT CASE FMT
Case UEF_ANSI, UEF_UTF8
'Judging the CodePage you should use
'Curcp = IIF (FMT = UEF_UTF8, CP_UTF8, UEFCODEPAGE)
Curcp = IIF (FMT = UEF_UTF8, CP_UTF8, 936)
'Distribution buffer
ON Error Goto Freehandle
Redim Bybuf (0 to CBTextData - 1)
ON Error Goto 0
'Read data
NNumRead = 0
Call Readfile (HFile, Bybuf (0), CbtextData, Nnumread, Byval 0 &) Gets the length of Unicode text
Cchstr = MultibytetowideChar (Curcp, 0, Bybuf (0), NNumread, Byval 0 &, ByVal 0 &)
IF cchstr> 0 THEN
'Distributing a string space
ON Error Goto Freehandle
UefloadTextFile = string $ (cchstr, 0)
ON Error Goto 0
'Get text
Cchstr = multibytetowidechar (curcp, 0, bybuf (0), nnumread, byval strptr (uefloadtextfile), cchstr 1)
END IF
Case UEF_UTF16LE
Cchstr = (CBTextData 1) / 2
'Distributing a string space
ON Error Goto Freehandle
UefloadTextFile = string $ (cchstr, 0)
ON Error Goto 0
'Get text
NNumRead = 0
Call Readfile (Hfile, Byval Strptr (UefloadTextFile), CBTextData, NnumRead, Byval 0 &)
'Correction text length
Cchstr = (NNumRead 1) / 2
IF cchstr> 0 THEN
IF LEN (UEfloadTextFile> cchstr
UefloadTextFile = Left $ (UEfloadTextFile, Cchstr)
END IF
Else
UefloadTextFile = ""
END IF
Case UEF_UTF16BE
'Distribution buffer
ON Error Goto Freehandle
Redim Bybuf (0 to CBTextData - 1)
ON Error Goto 0
'Read data
NNumRead = 0
Call Readfile (Hfile, Bybuf (0), CBTextdata, Nnumread, Byval 0 &)
IF nnumread> 0 THEN
'Turning the neighboring tuple in two-position group
For i = 0 to nnumread - 1 - 1 Step 2 'Re-1 is to avoid the last bit group group
Bytemp = bybuf (i)
Bybuf (i) = bybuf (i 1)
Bybuf (i 1) = bytemp
Next I
'Get text
UefloadTextFile = bybuf 'VB allows string data in String to directly convert directly to Byte array
END IF
Case UEF_UTF32LE
UefloadtextFile = vbnullstring 'is not supported
Case UEF_UTF32BE
UefloadtextFile = vbnullstring 'is not supported
Case Else
Debug.Assert False
End SELECT
FreeHandle:
'Close file
Call CloseHandle (HFILE)
Funend:
END FUNCTION
'Save text file
'Return value: whether it is successful
'Filename: [in] archive name
'Stext: [in] Want to output text' isappend: [in] is adding way
'fmt: [in, out] uses what text encoding format to store text. When isappend = true, the UEF_AUTO is allowed to automatically judge, and the encoding format used in the FMT parameter returns to the text.
'DEFFMT: [IN] When using the Add mode, if the file does not exist and the FMT = UEF_AUTO should be used in the encoding format
Public Function UefsavetextFile (Byval FileName As String, _
Byref Stext Asa String, Optional Byval Isappend As Boolean = FALSE, _
Optional byref fmt as uncodeEncodeformat = 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
'Judging the FMT range
IF isappend and (fmt = UEF_AUTO) THEN
Else
IF FMT <[_UEF_MIN] or FMT> [_UEF_MAX] THEN
Goto Funend
END IF
END IF
'open a file
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 Ten 'files can't open
Goto Funend
END IF
'Judging the file size
NFILESIZE = GetFileSize (Hfile, NNumRead)
IF nfilesize = 0 and nnumread = 0 THEN 'file size is 0 bits group
Isappend = false 'This time you need to write a BOM logo
IF FMT = UEF_AUTO THEN FMT = DEFFMT
END IF
'Judging 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 kil
CBBOM = UEFMAKEBOM (FMT, DWFIRST)
END IF
'File pointer positioning
Call setfilepointer (Hfile, 0, ByVal 0 &, IIF (Isappend, File_end, File_Begin)
'Write BOM
IF isappend = false kil
IF CBBOM> 0 THEN
Call Writefile (Hfile, Dwfirst, CBBOM, NNUMREAD, BYVAL 0 &) END IF
END IF
'Write text information
IF LEN (Stext)> 0 THEN
SELECT CASE FMT
Case UEF_ANSI, UEF_UTF8
'Judging the CodePage you should use
CURCP = IIF (FMT = UEF_UTF8, CP_UTF8, UEFCODEPAGE)
'Get the buffer size
CBBUF = Widechartomultibyte (Curcp, 0, ByVal Str (Stext), Len (Stext), Byval 0 &, 0, Byval 0 &, ByVal 0 &)
IF CBBUF> 0 THEN
'Distribution buffer
ON Error Goto Freehandle
Redim Bybuf (0 to CBBUF)
ON Error Goto 0
'Conversion text
CBBUF = Widechartomultibyte (curcp, 0, byval strptr (stext), len (stext), Bybuf (0), CBBUF 1, ByVAL 0 &, BYVAL 0 &)
'Write file
Call Writefile (Hfile, Bybuf (0), CBBUF, NNumread, ByVal 0 &)
UEFSAVETEXTFILE = TRUE
END IF
Case UEF_UTF16LE
'Write file
Call writefile (hfile, byval strptr (stext), lenb (stext), nnumread, byval 0 &)
UEFSAVETEXTFILE = TRUE
Case UEF_UTF16BE
'Copy the information in the string to bybuf
ON Error Goto Freehandle
Bybuf = stext
ON Error Goto 0
CBBUF = Ubound (Bybuf) - LBound (Bybuf) 1
'Turning the neighboring tuple in two-position group
For i = 0 to CBBUF - 1 - 1 Step 2 'Re-1 is to avoid the last bit group group
Bytemp = bybuf (i)
Bybuf (i) = bybuf (i 1)
Bybuf (i 1) = bytemp
Next I
'Write file
Call Writefile (Hfile, Bybuf (0), CBBUF, NNumread, ByVal 0 &)
UEFSAVETEXTFILE = TRUE
Case UEF_UTF32LE
UEFSAVETEXTFILE = false 'is not supported
Case UEF_UTF32BE
UEFSAVETEXTFILE = false 'is not supported
Case Else
Debug.Assert False
End SELECT
Else
UEFSAVETEXTFILE = TRUE
END IF
FreeHandle:
'Close file
Call CloseHandle (HFILE)
Funend:
END FUNCTION
