Skip to content

Commit 195b9ba

Browse files
cdhighcdhigh
committed
1.7.2
1 parent e9e1776 commit 195b9ba

File tree

6 files changed

+222
-83
lines changed

6 files changed

+222
-83
lines changed

‎Common.bas‎

Lines changed: 0 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -129,78 +129,6 @@ Public Function QuoteFast(s As String) As String
129129
QuoteFast = "'" & s & "'"
130130
End Function
131131

132-
'要添加引用Microsoft Activex data objects 2.8 library
133-
Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String)
134-
Dim adostream As New ADODB.Stream
135-
Dim fn As Long, abContent() As Byte, nSize As Long
136-
With adostream
137-
.Type = adTypeText
138-
.Mode = adModeReadWrite
139-
.Charset = "utf-8"
140-
.Open
141-
.Position = 0
142-
.WriteText vVar
143-
.SaveToFile sFileName, adSaveCreateOverWrite
144-
.Close
145-
End With
146-
Set adostream = Nothing
147-
148-
'去掉BOM
149-
On Error GoTo FileError
150-
151-
fn = FreeFile
152-
Open sFileName For Binary As fn
153-
nSize = LOF(fn)
154-
ReDim abContent(1 To nSize - 3) As Byte
155-
Get fn, 4, abContent
156-
Close fn
157-
Open sFileName For Binary As fn
158-
Put fn, , abContent
159-
Close fn
160-
Exit Sub
161-
162-
FileError:
163-
Close fn
164-
End Sub
165-
166-
'要添加引用Microsoft Activex data objects 2.8 library
167-
Public Function Utf8File_Read_VB(ByVal sFileName As String) As String
168-
Dim adostream As New ADODB.Stream
169-
With adostream
170-
.Type = adTypeText
171-
.Mode = adModeReadWrite
172-
.Charset = "utf-8"
173-
.Open
174-
.LoadFromFile sFileName
175-
Utf8File_Read_VB = .ReadText
176-
.Close
177-
End With
178-
Set adostream = Nothing
179-
End Function
180-
181-
'读取文件的二进制数据到一个字节数组中，返回读取的字节数，0表示失败
182-
Public Function ReadFileBinaryContent(sFile As String, ByRef abContent() As Byte) As Long
183-
184-
Dim fn As Long, nSize As Long
185-
186-
On Error GoTo FileError
187-
188-
'获取二进制数据
189-
fn = FreeFile
190-
Open sFile For Binary As fn
191-
nSize = LOF(fn)
192-
ReDim abContent(nSize - 1) As Byte
193-
Get fn, , abContent
194-
Close fn
195-
ReadFileBinaryContent = nSize
196-
Exit Function
197-
198-
FileError:
199-
Close fn
200-
ReadFileBinaryContent = 0
201-
202-
End Function
203-
204132
'提取文件名，包括扩展名，不包括路径名
205133
Public Function FileFullName(ByVal sF As String) As String
206134
Dim ns As Long

‎Readme.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -211,6 +211,8 @@ Readme of english version refers to [Readme_EN.md](https://github.com/cdhigh/tki
211211

212212

213213
# 版本历史
214+
* v1.7.2
215+
1. bugfix: 面向过程代码无法预览
214216
* v1.7.1
215217
1. Combobox的Change事件映射到Tkinter的ComboboxSelected
216218
2. 多行Text的Change事件映射到Tkinter的Modified

‎Readme_EN.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -183,6 +183,8 @@ The standard built-in ttk themes extension provides native style on different op
183183

184184

185185
# Changelog
186+
* v1.7.2
187+
1. bugfix: Cannot preview structured code.
186188
* v1.7.1
187189
1. The 'Change' event of the Combobox is mapped to 'ComboboxSelected'.
188190
2. The 'Change' event of the multi-line Text is mapped to 'Modified'.

‎Vb6Tkinter.vbp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\st
33
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
44
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
55
Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#C:\Program Files (x86)\VB6Expr\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility
6-
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
76
Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1
87
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0; MSCOMCTL.OCX
98
UserControl=GridOcx.ctl
@@ -49,6 +48,7 @@ Module=modJson; modJson.bas
4948
Form=frmNewVer.frm
5049
Form=frmAbout.frm
5150
ResFile32="XP.RES"
51+
Module=utf8file; utf8file.bas
5252
IconForm="FrmMain"
5353
Startup="(None)"
5454
HelpFile=""
@@ -64,7 +64,7 @@ CompatibleEXE32="Release\Vb6Tkinter.dll"
6464
VersionCompatible32="1"
6565
MajorVer=1
6666
MinorVer=7
67-
RevisionVer=1
67+
RevisionVer=2
6868
AutoIncrementVer=0
6969
ServerSupportFiles=0
7070
DllBaseAddress=&H1f390000

‎Vb6Tkinter.vbw‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
GridOcx = 125, 125, 851, 574, C, 175, 175, 1048, 606, C
2-
Common = 125, 125, 998, 556, C
2+
Common = 125, 125, 998, 556,
33
FileDlg = 150, 150, 981, 581, C
4-
clsBaseControl = 100, 100, 931, 531, Z
4+
clsBaseControl = 100, 100, 931, 531, C
55
clsButton = 75, 75, 906, 506, C
66
clsCanvas = 0, 0, 0, 0, C
77
clsCheckbutton = 0, 0, 0, 0, C
@@ -17,26 +17,27 @@ clsSerialization = 0, 0, 0, 0, C
1717
clsText = 0, 0, 879, 406, C
1818
cStrBuilder = 0, 0, 0, 0, C
1919
Dictionary = 0, 0, 0, 0, C
20-
FrmMain = 25, 25, 898, 456, , 50, 50, 923, 481, C
20+
FrmMain = 25, 25, 898, 456, Z, 50, 50, 923, 481, C
2121
clsMenu = 0, 0, 0, 0, C
2222
clsMenuItem = 0, 0, 0, 0, C
2323
clsProgressBar = 0, 0, 0, 0, C
24-
clsCombobox = 175, 175, 1054, 581,
25-
clsComboboxAdapter = 25, 25, 799, 474,
24+
clsCombobox = 175, 175, 1054, 581, C
25+
clsComboboxAdapter = 25, 25, 799, 474, C
2626
clsTreeview = 200, 200, 1079, 606, C
2727
clsNotebook = 50, 50, 929, 456, C
28-
MultiLanguage = 175, 175, 1054, 608,
29-
Base64 = 100, 100, 874, 549,
28+
MultiLanguage = 175, 175, 1054, 608, C
29+
Base64 = 100, 100, 874, 549, C
3030
clsForm = 125, 125, 956, 556, C
3131
clsStatusbar = 75, 75, 801, 497, C
3232
Resizer = 100, 100, 826, 549, C
3333
frmOption = 0, 0, 0, 0, C, 200, 200, 1073, 631, C
3434
xpcmdbutton = 0, 0, 0, 0, C, 0, 0, 873, 431, C
3535
clsNotebookTab = 0, 0, 0, 0, C
3636
clsSeparator = 0, 0, 0, 0, C
37-
Connect = 25, 25, 904, 458,
38-
frmEncodeAFile = 100, 100, 973, 531, , 25, 25, 898, 456, C
37+
Connect = 25, 25, 904, 458, C
38+
frmEncodeAFile = 100, 100, 973, 531, C, 25, 25, 898, 456, C
3939
http = 125, 125, 1004, 558, C
4040
modJson = 25, 25, 904, 458, C
4141
frmNewVer = 100, 100, 979, 533, C, 75, 75, 954, 508, C
4242
frmAbout = 50, 50, 776, 472, C, 25, 25, 927, 447, C
43+
utf8file = 50, 50, 894, 499,

‎utf8file.bas‎

Lines changed: 206 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,206 @@
1+
Attribute VB_Name = "utf8file"
2+
' UTF8文件读写
3+
Option Explicit
4+
5+
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
6+
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
7+
8+
' UTF-8代码页常量
9+
Private Const CP_UTF8 = 65001
10+
11+
'返回一个字节数组的元素个数
12+
Private Function BytesLength(abBytes() As Byte) As Long
13+
On Error Resume Next
14+
BytesLength = UBound(abBytes) - LBound(abBytes) + 1
15+
End Function
16+
17+
'转换字符串为UTF-8字节数组
18+
Public Function Utf8BytesFromString(strInput As String) As Byte()
19+
Dim nBytes As Long
20+
Dim abBuffer() As Byte
21+
' Catch empty or null input string
22+
Utf8BytesFromString = vbNullString
23+
If Len(strInput) < 1 Then Exit Function
24+
' Get length in bytes *including* terminating null
25+
nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, vbNull, 0&, 0&, 0&)
26+
' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
27+
ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need
28+
nBytes = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strInput), -1, VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
29+
Utf8BytesFromString = abBuffer
30+
End Function
31+
32+
'转换UTF-8字节数组为字符串
33+
Public Function Utf8BytesToString(abUtf8Array() As Byte) As String
34+
Dim nBytes As Long
35+
Dim nChars As Long
36+
Dim strOut As String
37+
Utf8BytesToString = ""
38+
' Catch uninitialized input array
39+
nBytes = BytesLength(abUtf8Array)
40+
If nBytes <= 0 Then Exit Function
41+
' Get number of characters in output string
42+
nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
43+
' Dimension output buffer to receive string
44+
strOut = String(nChars, 0)
45+
nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
46+
Utf8BytesToString = Left$(strOut, nChars)
47+
End Function
48+
49+
Public Function ReadFileIntoString(sFilePath As String) As String
50+
' Reads file (if it exists) into a string.
51+
Dim strIn As String
52+
Dim hFile As Integer
53+
54+
' Check if file exists
55+
If Len(Dir(sFilePath)) = 0 Then
56+
Exit Function
57+
End If
58+
hFile = FreeFile
59+
Open sFilePath For Binary Access Read As #hFile
60+
strIn = Input(LOF(hFile), #hFile)
61+
Close #hFile
62+
ReadFileIntoString = strIn
63+
64+
End Function
65+
66+
Public Function WriteFileFromString(sFilePath As String, strIn As String) As Boolean
67+
' Creates a file from a string. Clobbers any existing file.
68+
On Error GoTo OnError
69+
Dim hFile As Integer
70+
71+
If Len(Dir(sFilePath)) > 0 Then
72+
Kill sFilePath
73+
End If
74+
hFile = FreeFile
75+
Open sFilePath For Binary Access Write As #hFile
76+
Put #hFile, , strIn
77+
Close #hFile
78+
WriteFileFromString = True
79+
Done:
80+
Exit Function
81+
OnError:
82+
Resume Done
83+
84+
End Function
85+
86+
Public Function ReadFileIntoBytes(sFilePath As String) As Byte()
87+
' Reads file (if it exists) into an array of bytes.
88+
Dim abData() As Byte
89+
Dim hFile As Integer
90+
91+
' Set default return value that won't cause a run-time error
92+
ReadFileIntoBytes = StrConv("", vbFromUnicode)
93+
' Check if file exists
94+
If Len(Dir(sFilePath)) = 0 Then
95+
Exit Function
96+
End If
97+
hFile = FreeFile
98+
Open sFilePath For Binary Access Read As #hFile
99+
abData = InputB(LOF(hFile), #hFile)
100+
Close #hFile
101+
ReadFileIntoBytes = abData
102+
103+
End Function
104+
105+
Public Function WriteFileFromBytes(sFilePath As String, abData() As Byte) As Boolean
106+
' Creates a file from a string. Clobbers any existing file.
107+
On Error GoTo OnError
108+
Dim hFile As Integer
109+
110+
If Len(Dir(sFilePath)) > 0 Then
111+
Kill sFilePath
112+
End If
113+
hFile = FreeFile
114+
Open sFilePath For Binary Access Write As #hFile
115+
Put #hFile, , abData
116+
Close #hFile
117+
WriteFileFromBytes = True
118+
Done:
119+
Exit Function
120+
OnError:
121+
Resume Done
122+
123+
End Function
124+
125+
'外部接口
126+
'读取文件的二进制数据到一个字节数组中，返回读取的字节数，0表示失败
127+
Public Function ReadFileBinaryContent(sFile As String, ByRef abContent() As Byte) As Long
128+
129+
Dim fn As Long, nSize As Long
130+
131+
On Error GoTo FileError
132+
133+
'获取二进制数据
134+
fn = FreeFile
135+
Open sFile For Binary As fn
136+
nSize = LOF(fn)
137+
ReDim abContent(nSize - 1) As Byte
138+
Get fn, , abContent
139+
Close fn
140+
ReadFileBinaryContent = nSize
141+
Exit Function
142+
143+
FileError:
144+
Close fn
145+
ReadFileBinaryContent = 0
146+
147+
End Function
148+
149+
'写UTF8文件
150+
Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String)
151+
Dim b() As Byte
152+
153+
b = Utf8BytesFromString(vVar)
154+
WriteFileFromBytes sFileName, b
155+
End Sub
156+
157+
'下面是以前的实现，需要外部依赖
158+
'要添加引用Microsoft Activex data objects 2.8 library
159+
'Public Sub Utf8File_Write_VB(ByVal sFileName As String, ByVal vVar As String)
160+
' Dim adostream As New ADODB.Stream
161+
' Dim fn As Long, abContent() As Byte, nSize As Long
162+
' With adostream
163+
' .Type = adTypeText
164+
' .Mode = adModeReadWrite
165+
' .Charset = "utf-8"
166+
' .Open
167+
' .Position = 0
168+
' .WriteText vVar
169+
' .SaveToFile sFileName, adSaveCreateOverWrite
170+
' .Close
171+
' End With
172+
' Set adostream = Nothing
173+
'
174+
' '去掉BOM
175+
' On Error GoTo FileError
176+
'
177+
' fn = FreeFile
178+
' Open sFileName For Binary As fn
179+
' nSize = LOF(fn)
180+
' ReDim abContent(nSize - 3) As Byte
181+
' Get fn, 4, abContent
182+
' Close fn
183+
' Open sFileName For Binary As fn
184+
' Put fn, , abContent
185+
' Close fn
186+
' Exit Sub
187+
'
188+
'FileError:
189+
' Close fn
190+
'End Sub
191+
192+
'要添加引用Microsoft Activex data objects 2.8 library
193+
'Public Function Utf8File_Read_VB(ByVal sFileName As String) As String
194+
' Dim adostream As New ADODB.Stream
195+
' With adostream
196+
' .Type = adTypeText
197+
' .Mode = adModeReadWrite
198+
' .Charset = "utf-8"
199+
' .Open
200+
' .LoadFromFile sFileName
201+
' Utf8File_Read_VB = .ReadText
202+
' .Close
203+
' End With
204+
' Set adostream = Nothing
205+
'End Function
206+

0 commit comments

Comments
 (0)