diff --git a/Common.bas b/Common.bas index d4a1472..1e3cb17 100644 --- a/Common.bas +++ b/Common.bas @@ -129,78 +129,6 @@ Public Function QuoteFast(s As String) As String QuoteFast = "'" & s & "'" End Function -'要添加引用Microsoft Activex data objects 2.8 library -Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String) - Dim adostream As New ADODB.Stream - Dim fn As Long, abContent() As Byte, nSize As Long - With adostream - .Type = adTypeText - .Mode = adModeReadWrite - .Charset = "utf-8" - .Open - .Position = 0 - .WriteText vVar - .SaveToFile sFileName, adSaveCreateOverWrite - .Close - End With - Set adostream = Nothing - - '去掉BOM - On Error GoTo FileError - - fn = FreeFile - Open sFileName For Binary As fn - nSize = LOF(fn) - ReDim abContent(1 To nSize - 3) As Byte - Get fn, 4, abContent - Close fn - Open sFileName For Binary As fn - Put fn, , abContent - Close fn - Exit Sub - -FileError: - Close fn -End Sub - -'要添加引用Microsoft Activex data objects 2.8 library -Public Function Utf8File_Read_VB(ByVal sFileName As String) As String - Dim adostream As New ADODB.Stream - With adostream - .Type = adTypeText - .Mode = adModeReadWrite - .Charset = "utf-8" - .Open - .LoadFromFile sFileName - Utf8File_Read_VB = .ReadText - .Close - End With - Set adostream = Nothing -End Function - -'读取文件的二进制数据到一个字节数组中，返回读取的字节数，0表示失败 -Public Function ReadFileBinaryContent(sFile As String, ByRef abContent() As Byte) As Long - - Dim fn As Long, nSize As Long - - On Error GoTo FileError - - '获取二进制数据 - fn = FreeFile - Open sFile For Binary As fn - nSize = LOF(fn) - ReDim abContent(nSize - 1) As Byte - Get fn, , abContent - Close fn - ReadFileBinaryContent = nSize - Exit Function - -FileError: - Close fn - ReadFileBinaryContent = 0 - -End Function - '提取文件名，包括扩展名，不包括路径名 Public Function FileFullName(ByVal sF As String) As String Dim ns As Long diff --git a/Readme.md b/Readme.md index add692f..118d3f1 100644 --- a/Readme.md +++ b/Readme.md @@ -211,6 +211,8 @@ Readme of english version refers to [Readme_EN.md](https://github.com/cdhigh/tki # 鐗堟湰鍘嗗彶 +* v1.7.2 + 1. bugfix: 闈㈠悜杩囩▼浠ｇ爜鏃犳硶棰勮 * v1.7.1 1. Combobox鐨凜hange浜嬩欢鏄犲皠鍒癟kinter鐨凜omboboxSelected 2. 澶氳Text鐨凜hange浜嬩欢鏄犲皠鍒癟kinter鐨凪odified diff --git a/Readme_EN.md b/Readme_EN.md index 99f9d5a..676571f 100644 --- a/Readme_EN.md +++ b/Readme_EN.md @@ -183,6 +183,8 @@ The standard built-in ttk themes extension provides native style on different op # Changelog +* v1.7.2 + 1. bugfix: Cannot preview structured code. * v1.7.1 1. The 'Change' event of the Combobox is mapped to 'ComboboxSelected'. 2. The 'Change' event of the multi-line Text is mapped to 'Modified'. diff --git a/Vb6Tkinter.vbp b/Vb6Tkinter.vbp index 484891e..59e1abd 100644 --- a/Vb6Tkinter.vbp +++ b/Vb6Tkinter.vbp @@ -3,7 +3,6 @@ Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\st Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.0#0#C:\Program Files (x86)\office2010\MShared\OFFICE14\MSO.DLL#Microsoft Office 8.0 Object Library Reference=*\G{AC0714F2-3D04-11D1-AE7D-00A0C90F26F4}#1.0#0#C:\Program Files (x86)\Common Files\designer\MSADDNDR.TLB#Add-In Designer/Instance Control Library Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#C:\Program Files (x86)\VB6Expr\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility -Reference=*\G{2A75196C-D9EB-4129-B803-931327F72D5C}#2.8#0#C:\Program Files (x86)\Common Files\System\ado\msado28.tlb#Microsoft ActiveX Data Objects 2.8 Library Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1 Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0; MSCOMCTL.OCX UserControl=GridOcx.ctl @@ -49,6 +48,7 @@ Module=modJson; modJson.bas Form=frmNewVer.frm Form=frmAbout.frm ResFile32="XP.RES" +Module=utf8file; utf8file.bas IconForm="FrmMain" Startup="(None)" HelpFile="" @@ -64,7 +64,7 @@ CompatibleEXE32="Release\Vb6Tkinter.dll" VersionCompatible32="1" MajorVer=1 MinorVer=7 -RevisionVer=1 +RevisionVer=2 AutoIncrementVer=0 ServerSupportFiles=0 DllBaseAddress=&H1f390000 diff --git a/Vb6Tkinter.vbw b/Vb6Tkinter.vbw index 6ddf60e..5e2d37f 100644 --- a/Vb6Tkinter.vbw +++ b/Vb6Tkinter.vbw @@ -1,7 +1,7 @@ GridOcx = 125, 125, 851, 574, C, 175, 175, 1048, 606, C -Common = 125, 125, 998, 556, C +Common = 125, 125, 998, 556, FileDlg = 150, 150, 981, 581, C -clsBaseControl = 100, 100, 931, 531, Z +clsBaseControl = 100, 100, 931, 531, C clsButton = 75, 75, 906, 506, C clsCanvas = 0, 0, 0, 0, C clsCheckbutton = 0, 0, 0, 0, C @@ -17,16 +17,16 @@ clsSerialization = 0, 0, 0, 0, C clsText = 0, 0, 879, 406, C cStrBuilder = 0, 0, 0, 0, C Dictionary = 0, 0, 0, 0, C -FrmMain = 25, 25, 898, 456, , 50, 50, 923, 481, C +FrmMain = 25, 25, 898, 456, Z, 50, 50, 923, 481, C clsMenu = 0, 0, 0, 0, C clsMenuItem = 0, 0, 0, 0, C clsProgressBar = 0, 0, 0, 0, C -clsCombobox = 175, 175, 1054, 581, -clsComboboxAdapter = 25, 25, 799, 474, +clsCombobox = 175, 175, 1054, 581, C +clsComboboxAdapter = 25, 25, 799, 474, C clsTreeview = 200, 200, 1079, 606, C clsNotebook = 50, 50, 929, 456, C -MultiLanguage = 175, 175, 1054, 608, -Base64 = 100, 100, 874, 549, +MultiLanguage = 175, 175, 1054, 608, C +Base64 = 100, 100, 874, 549, C clsForm = 125, 125, 956, 556, C clsStatusbar = 75, 75, 801, 497, C Resizer = 100, 100, 826, 549, C @@ -34,9 +34,10 @@ frmOption = 0, 0, 0, 0, C, 200, 200, 1073, 631, C xpcmdbutton = 0, 0, 0, 0, C, 0, 0, 873, 431, C clsNotebookTab = 0, 0, 0, 0, C clsSeparator = 0, 0, 0, 0, C -Connect = 25, 25, 904, 458, -frmEncodeAFile = 100, 100, 973, 531, , 25, 25, 898, 456, C +Connect = 25, 25, 904, 458, C +frmEncodeAFile = 100, 100, 973, 531, C, 25, 25, 898, 456, C http = 125, 125, 1004, 558, C modJson = 25, 25, 904, 458, C frmNewVer = 100, 100, 979, 533, C, 75, 75, 954, 508, C frmAbout = 50, 50, 776, 472, C, 25, 25, 927, 447, C +utf8file = 50, 50, 894, 499, diff --git a/utf8file.bas b/utf8file.bas new file mode 100644 index 0000000..65d85f3 --- /dev/null +++ b/utf8file.bas @@ -0,0 +1,206 @@ +Attribute VB_Name = "utf8file" +' UTF8文件读写 +Option Explicit + +Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long +Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long + +' UTF-8代码页常量 +Private Const CP_UTF8 = 65001 + +'返回一个字节数组的元素个数 +Private Function BytesLength(abBytes() As Byte) As Long + On Error Resume Next + BytesLength = UBound(abBytes) - LBound(abBytes) + 1 +End Function + +'转换字符串为UTF-8字节数组 +Public Function Utf8BytesFromString(strInput As String) As Byte() + Dim nBytes As Long + Dim abBuffer() As Byte + ' Catch empty or null input string + Utf8BytesFromString = vbNullString + If Len(strInput) < 1 Then Exit Function + ' Get length in bytes *including* terminating null + nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, vbNull, 0&, 0&, 0&) + ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes + ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need + nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&) + Utf8BytesFromString = abBuffer +End Function + +'转换UTF-8字节数组为字符串 +Public Function Utf8BytesToString(abUtf8Array() As Byte) As String + Dim nBytes As Long + Dim nChars As Long + Dim strOut As String + Utf8BytesToString = "" + ' Catch uninitialized input array + nBytes = BytesLength(abUtf8Array) + If nBytes <= 0 Then Exit Function + ' Get number of characters in output string + nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&) + ' Dimension output buffer to receive string + strOut = String(nChars, 0) + nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars) + Utf8BytesToString = Left$(strOut, nChars) +End Function + +Public Function ReadFileIntoString(sFilePath As String) As String +' Reads file (if it exists) into a string. + Dim strIn As String + Dim hFile As Integer + + ' Check if file exists + If Len(Dir(sFilePath)) = 0 Then + Exit Function + End If + hFile = FreeFile + Open sFilePath For Binary Access Read As #hFile + strIn = Input(LOF(hFile), #hFile) + Close #hFile + ReadFileIntoString = strIn + +End Function + +Public Function WriteFileFromString(sFilePath As String, strIn As String) As Boolean +' Creates a file from a string. Clobbers any existing file. +On Error GoTo OnError + Dim hFile As Integer + + If Len(Dir(sFilePath)) > 0 Then + Kill sFilePath + End If + hFile = FreeFile + Open sFilePath For Binary Access Write As #hFile + Put #hFile, , strIn + Close #hFile + WriteFileFromString = True +Done: + Exit Function +OnError: + Resume Done + +End Function + +Public Function ReadFileIntoBytes(sFilePath As String) As Byte() +' Reads file (if it exists) into an array of bytes. + Dim abData() As Byte + Dim hFile As Integer + + ' Set default return value that won't cause a run-time error + ReadFileIntoBytes = StrConv("", vbFromUnicode) + ' Check if file exists + If Len(Dir(sFilePath)) = 0 Then + Exit Function + End If + hFile = FreeFile + Open sFilePath For Binary Access Read As #hFile + abData = InputB(LOF(hFile), #hFile) + Close #hFile + ReadFileIntoBytes = abData + +End Function + +Public Function WriteFileFromBytes(sFilePath As String, abData() As Byte) As Boolean +' Creates a file from a string. Clobbers any existing file. +On Error GoTo OnError + Dim hFile As Integer + + If Len(Dir(sFilePath)) > 0 Then + Kill sFilePath + End If + hFile = FreeFile + Open sFilePath For Binary Access Write As #hFile + Put #hFile, , abData + Close #hFile + WriteFileFromBytes = True +Done: + Exit Function +OnError: + Resume Done + +End Function + +'外部接口 +'读取文件的二进制数据到一个字节数组中，返回读取的字节数，0表示失败 +Public Function ReadFileBinaryContent(sFile As String, ByRef abContent() As Byte) As Long + + Dim fn As Long, nSize As Long + + On Error GoTo FileError + + '获取二进制数据 + fn = FreeFile + Open sFile For Binary As fn + nSize = LOF(fn) + ReDim abContent(nSize - 1) As Byte + Get fn, , abContent + Close fn + ReadFileBinaryContent = nSize + Exit Function + +FileError: + Close fn + ReadFileBinaryContent = 0 + +End Function + +'写UTF8文件 +Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String) + Dim b() As Byte + + b = Utf8BytesFromString(vVar) + WriteFileFromBytes sFileName, b +End Sub + +'下面是以前的实现，需要外部依赖 +'要添加引用Microsoft Activex data objects 2.8 library +'Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String) +' Dim adostream As New ADODB.Stream +' Dim fn As Long, abContent() As Byte, nSize As Long +' With adostream +' .Type = adTypeText +' .Mode = adModeReadWrite +' .Charset = "utf-8" +' .Open +' .Position = 0 +' .WriteText vVar +' .SaveToFile sFileName, adSaveCreateOverWrite +' .Close +' End With +' Set adostream = Nothing +' +' '去掉BOM +' On Error GoTo FileError +' +' fn = FreeFile +' Open sFileName For Binary As fn +' nSize = LOF(fn) +' ReDim abContent(nSize - 3) As Byte +' Get fn, 4, abContent +' Close fn +' Open sFileName For Binary As fn +' Put fn, , abContent +' Close fn +' Exit Sub +' +'FileError: +' Close fn +'End Sub + +'要添加引用Microsoft Activex data objects 2.8 library +'Public Function Utf8File_Read_VB(ByVal sFileName As String) As String +' Dim adostream As New ADODB.Stream +' With adostream +' .Type = adTypeText +' .Mode = adModeReadWrite +' .Charset = "utf-8" +' .Open +' .LoadFromFile sFileName +' Utf8File_Read_VB = .ReadText +' .Close +' End With +' Set adostream = Nothing +'End Function +