|
#2
风吹过b2021-07-26 19:13
|
给个编程思路就行。
只有本站会员才能查看附件，请 登录
15 回复
|
#3
yuma2021-07-26 19:40
已搞定，搞定之后才发现你上面发的内容。
思路： 1.全部转换为ASCII，用逗号分开 2.ASCII打散成数组，ASCII依次还原为字符，加条件加空格 VBS代码如下：  程序代码：Dim i, str, ascstr,l Const ForReading = 1, ForWriting = 2,ForAppend=8 Dim fso, f,openFile Set fso = CreateObject("Scripting.FileSystemObject") Set Stm =CreateObject("ADODB.Stream") Stm.Type=2 '2-文本模式，1-二进制模式 Stm.Mode=3 '3-读写，1-读，2-写 Stm.CharSet= "gb2312" 'Unicode,utf-8,ASCII,gb2312,big5,gbk Stm.Open Stm.LoadFromFile "1.txt" str = Stm.ReadText Stm.Close Set Stm=Nothing For i = 1 To Len(str) ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1))) j = right(ascstr,len(ascstr)-1) Next 'MsgBox j Set f = fso.OpenTextFile("ASCII代码.txt",ForAppend, True) f.Write j f.Close Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True) '1表示只读，2表示可写，8表示追加，True表示目标文件存在时是否覆盖 AsciiStr = openFile.ReadAll openFile.Close S=split(AsciiStr,",") '以空格作为分隔符 For i=0 to ubound(S) if i+1 <= ubound(S) then '防止下标越界 if S(i)<0 and S(i+1)>=0 then '加入空格的时机，条件 SaveFiles(Chr(S(i))) SaveFiles(" ") else SaveFiles(Chr(S(i))) end if else SaveFiles(Chr(S(i))) end if Next Function SaveFiles(content) '文件内容 Const ForReading = 1, ForWriting = 2,ForAppend=8 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile("已处理文本.txt",ForAppend, True) f.Write content End Function |
|
|
#4
风吹过b2021-07-27 13:00
Set Stm =CreateObject("ADODB.Stream")
Stm.Type=2 '2-文本模式，1-二进制模式 Stm.Mode=3 '3-读写，1-读，2-写 Stm.CharSet= "gb2312" 'Unicode,utf-8,ASCII,gb2312,big5,gbk Stm.Open Stm.LoadFromFile "1.txt" str = Stm.ReadText Stm.Close Set Stm=Nothing 使用 ADODB.Stream 打开文件，读了全部内容就关闭。这里容易产生的BUG就是文件如果过大，会导致内存爆掉。 ------------------ For i = 1 To Len(str) ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1))) j = right(ascstr,len(ascstr)-1) Next 'MsgBox j Set f = fso.OpenTextFile("ASCII代码.txt",ForAppend, True) f.Write j f.Close 预处理读到的内容，然后保存到一个文件，等等，为什么这步要保存？？ 这里保存文件使用的是 FSO 。另外是追加模式，如果第一次运行时生成的文件没删掉时，再运行第二次那文件里会有第二份内容啊。 Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True) '1表示只读，2表示可写，8表示追加，True表示目标文件存在时是否覆盖 AsciiStr = openFile.ReadAll openFile.Close 重新读上一行保存的文件。等等，为什么这步要重新读，不可以直接用上步生成的字符串吗？ 还有，这里读取使用的是 FSO ，为什么不用第一步的 ADODB.Stream ，兼程序不够复杂吗？ 到这步，内存里已存在 三份副本。 1、原始文件：str 2、预处理后的内容：j 3、重新读取后的内容：Asciistr ---------------- S=split(AsciiStr,",") '以空格作为分隔符 For i=0 to ubound(S) if i+1 <= ubound(S) then '防止下标越界 if S(i)<0 and S(i+1)>=0 then '加入空格的时机，条件 SaveFiles(Chr(S(i))) SaveFiles(" ") else SaveFiles(Chr(S(i))) end if else SaveFiles(Chr(S(i))) end if Next 处理，然后每处理一个字符，就直接写入文件。 每次写一个字符时，就会触发一次写盘操作，极大的影响效率和磁盘的寿命，如果是 固态硬盘的话，按你文件字符数进行磨损块次数。 为什么不直接在上一次直接得到ascii数组 只需要几句代码 程序代码：redim S(len(str) '重定义数组大小 For i = 1 To Len(str) s(i)=Asc(Mid(str, i, 1)) '保存ASCII码 Next ===================== 总结： 1、程序是拼凑起来的。不同部分甚至使用了不同的组件。 2、对程序的优化没任何经验。程序优化有二个方向，内存优化和速度优化。 对于处理文件不能确定大小时，有可能出现超大文件时，考虑的是内存优化，这种情况下是读文件的部分容进行进行处理的。 对于处理文件能确定不会超大时，这时考虑的是速度优化，文件就是一次性读入内容。 根据你的代码能正常运行，说明你文件不会超大，可以使用速度优化，按行处理好了，为啥硬要分解成每一个字符来处理呢，拖延运行速度。 [此贴子已经被作者于2021-7-27 13:41编辑过] |
|
|
#5
风吹过b2021-07-27 13:36
程序代码：'这二个文件名我测试用的 Const FileName1 = "D:\86_1.txt" '原始文件名 Const FileName2 = "D:\86_2.txt" '目标文件名 Dim s1 As String Dim f() As String Dim i As Long, j As Long '两个循环变量 Dim k1 As Integer, k2 As Integer '两个AscII值临时变量 '-------读所有内容--------- Open FileName1 For Binary Access Read As #1 s1 = StrConv(InputB$(LOF(1), 1), vbUnicode) Close #1 '--------按行分解-------- f = Split(s1, vbCrLf) s1 = "" '释放字符串内存 '--------直接处理，无预处理-------- For i = 0 To UBound(f) If Len(f(i)) > 0 Then '空行直接跳 k1 = Asc(Left(f(i), 1)) '第一个字符的Asc值 For j = 1 To Len(f(i)) - 1 '循环取所有的字符 k2 = Asc(Mid(f(i), j + 1, 1)) '后面一个字符的值,k1前一个的值 If k1 < 0 And k2 > 0 Then '判断 If k2 <> 32 Then '如果k2不为空格，则加上空格。是空格的不再加上空格 f(i) = Left(f(i), j) & " " & Mid(f(i), j + 1) '在字符串中间插入一个空格 Exit For '一行只加一个空格，处理完本行结束 End If End If k1 = k2 '如果不符合条件，把后一个字符值给k1，按循环，k2将又是后一个字符 Next j End If Next i s1 = Join(f, vbCrLf) '拼接字符串，分隔符仍然是回车换行符 Erase f '释放数组内存 Open FileName2 For Binary Access Write As #1 Put #1, 1, s1 '一次性写入文件 Close #1 |
|
#6
diycai2021-07-27 13:58
|
|
|
#7
William19492021-07-29 21:55
用正则 试试
程序代码：Private Sub Command1_Click() Dim Source As String, Dest As String Dim RE As New RegExp Dim MColl As MatchCollection Source = "工a aaaa" & vbCrLf & "式aa aad" & vbCrLf & "黄花菜aaae" With RE .Global = True ' .Pattern = "([\u4e00-\u9fa5])(\w)" '匹配 汉字与非汉字 .Pattern = "([\u4e00-\u9fa5])" '匹配 每个汉字 Set MColl = .Execute(Source) ' Dest = .Replace(Source, "$1 $2") '汉字与非汉字之间，加空格 Dest = .Replace(Source, "$1 ") '每个汉字之间，加空格 End With Set RE = Nothing End Sub 只有本站会员才能查看附件，请 登录 |
|
|
#8
yuma2021-08-08 20:50
回复 5楼 风吹过b
算了，就这样了。
程序代码：Const ForReading = 1, ForWriting = 2,ForAppend=8 Set fso = CreateObject("Scripting.FileSystemObject") Set openFile=fso.OpenTextFile("1.txt",1,True) str = openFile.ReadAll 'MsgBox str openFile.Close For i = 1 To Len(str) ascstr = ascstr & "," & CStr(Asc(Mid(str, i, 1))) j = right(ascstr,len(ascstr)-1) Next 'MsgBox j Set f = fso.OpenTextFile("ASCII代码.txt",2, True) f.Write j f.Close Set openFile=fso.OpenTextFile("ASCII代码.txt",1,True) AsciiStr = openFile.ReadAll openFile.Close S=split(AsciiStr,",") '以空格作为分隔符 For i=0 to ubound(S) if i+1 <= ubound(S) then '防止下标越界 if S(i)<0 and S(i+1)>=0 then '加入空格的时机，条件 SaveFiles(Chr(S(i))) SaveFiles(" ") else SaveFiles(Chr(S(i))) end if else SaveFiles(Chr(S(i))) end if Next Function SaveFiles(content) '文件内容 Const ForReading = 1, ForWriting = 2,ForAppend=8 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile("已处理文本.txt",ForAppend, True) f.Write content End Function |
|
|
#9
yuma2021-08-08 21:11
|
|
|
#10
kings123332021-08-09 16:14
回复 5楼 风吹过b
|
|
|
#11
风吹过b2021-08-09 19:22
|
|
|
#12
mastervb2021-08-14 23:38
|
|
#13
chenyucheng2022-07-02 23:23
回复 10楼 kings12333
|
|
#14
ioriliao2022-07-04 18:46
|
|
|
#15
ioriliao2022-07-04 18:48
回复 7楼 William1949
|
|
|
#16
chenyucheng2022-07-05 20:34
程序代码：[Description] Name=自定义码 MaxCodes = 4 UsedCodes='abcdefghijklmnopqrstuvwxy WildChar=z Sort=1 [Text] 的a 地b 得c 我abaw 你aban 他abat 我们wamn 你们wbmn 他们wcmn 计算机jsj' 这是美国微软公司码表输入法的一个练习仅作为参考定义一个很长的词组abcd 学习ipnu 美国微软公司ultn 中文olaa 软件olaa 内心的喜悦无法言表olba 程序代码：[Description] Name=五笔型 MaxCodes=4 MaxElement=1 UsedCodes=abcdefghijklmnopqrstuvwxy WildChar=z NumRules=3 [Rule] ca4=p11+p21+p31+n11 ce2=p11+p12+p21+p22 ce3=p11+p21+p31+p32 [Text] 工a aaaa 式aa aad 工aaa aaaa 工aaaa 工期aaad 黄花菜aaae 工艺aaan 工区aaaq 工匠aaar 式aad 工友aadc 工厂aadg 匿aadk 慝aadn 葚aadn 萁aadw 苷aaf aaff 工地aafb 甙aafd 苷aaff 工场aafn 工夫aafw 工事aagk 戒严aago 芽aah aaht 芽aaht 工具aahw 工龄aahw 卧薪尝胆aaie 落花流水aaii 工党aaip 葡萄酒aais 工时aajf 蒸蒸日上aajh 戒aak 工艺品aakk 苣aan aanf 苣aanf 工业aaog 戒烟aaol 工农aape 蔚蓝色aaqc 茫茫然aaqd 工钱aaqg 匿名aaqk 工兵aarg 芭蕾舞aarl 熙熙攘攘aarr 工本aasg 式样aasu 荛aat aatq 工程aatk 工种aatk 荛aatq 莫斯科aatu 工委aatv 工装aauf 工商aaum 工资aauq 勤勤恳恳aavv 工段aawd 工会aawf 勤工俭学aawi 工件aawr 欧共体aaws 工作aawt 工分aawv 工人aaww 医药费aaxj 工序aayc …… …… 文职yybk 设计院yybp 文联yybu 主席台yyck 广大yydd 方面yydm 文坛yyff 文献yyfm 广场yyfn 文教yyft 设计者yyft 亠yyg 文武yyga 方yygn 广yygt 恋恋不舍yygw 文yygy 文具yyhw 谅yyi yyiy 方法yyif 文学yyip 广泛yyit 谅yyiy 文明yyje 议题yyjg 设计师yyjg 这就是说yyjy 议员yykm 评论员yykm 评论员文章yyku 丶yyl yyll 主席团yylf 廪yyli 方圆yylk 丶yyll 庐山yymm 文风yymq 访yyn 讠yyn 谝yyna 庐yyne 文书yynn 该yynw 文字yypb 评论家yype 方案yypv 议yyq yyqy 谅解yyqe 方针yyqf 议yyqy 广播yyrt 文摘yyru 广柑yysa 广西yysg 文本yysg 文档yysi 言辞yytd 广告yytf 文选yytf 议程yytk 方向yytm 文物yytr 文笔yytt 文科yytu 主旋律yytv 文稿yyty 广阔yyui 文章yyuj 访问yyuk 高谈阔论yyuy 廊yyv yyvb 廊yyvb 文娱yyvk 谇yyw yywf 谇yywf 方便yywg 文件yywr 文体yyws 文凭yywt 方位yywu 议价yyww 文化yywx 文集yywy 论文集yywy 京广线yyxg 言yyy yyyy 广度yyya 言语yyyg 语文课yyyj 广州市yyym 文盲yyyn 言谈yyyo 文豪yyyp 广义yyyq 广州yyyt 应该说yyyu 议论yyyw 码表： 只有本站会员才能查看附件，请 登录 只有本站会员才能查看附件，请 登录 输入法生成器： 只有本站会员才能查看附件，请 登录 [此贴子已经被作者于2022-7-5 20:39编辑过] |
1