|
- 超级版主
- 1228894
- 26975
- 25
- 8050 朵
- 36129 个
- 4746 个
- 421340
- 2012-07-18
|
1#
t
T
发表于 2021-11-10 13:03
|
|只看楼主
原代码分享----PC按键----N7命令库[2021.04.03更新V3.0][终章]源码分享
2021.11.11新建QQ交流群:８９１０５８９４６后续更新在本群发布
- Dimenv 命令授权
- //系统分辨率
- Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
- //系统文件大小
- Declare Function GetFileSize Lib "kernel32" Alias "GetFileSize" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
- //转换全角半角符号
- Private Declare Function LCMapString Lib "kernel32" 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
- Private Declare Function lstrlen Lib "kernel32" Alias "lstrlen" (ByVal lpString As String) As Long
- //写屏图片缩放
- Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
- Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long,ByVal lpsz As String,ByVal un1 As Long,ByVal n1 As Long,ByVal n2 As Long,ByVal un2 As Long)
- Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long
- Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Long) As Long
- Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long,ByVal hObject As Long) As Long
- Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
- Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Long,ByVal x As Long,ByVal y As Long,ByVal nWidth As Long,ByVal nHeight As Long,ByVal hSrcDC As Long,ByVal xSrc As Long,ByVal ySrc As Long,ByVal dwRop As Long) As Long
- //鼠标按键状态
- Declare Function 获取键鼠信息 Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
- //键盘按键状态
- Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
- //窗口是否卡死判断
- Private Declare Function IsHungAppWindow Lib "user32.dll" ( ByVal hWnd As Long) As Long
- //化繁为简
- Sub 命令库授权()
- TracePrint "=========================================="
- TracePrint "触发声明,作者QQ：１２２３１１６６１８,版本号：v３.０"
- Dim 返回值1
- If 命令授权 <> 520 Then
- 命令授权 = 111
- //返回值=Httpget("https://share.weiyun.com/LTySDKH9")
- 返回值1= HttpgetEx2("http://n15976906190.usa3v.vip",1)
- If instr( 返回值1, "|*V3.0*|") > 0 Then
- TracePrint "授权成功，为避免后期个别功能泛滥并照成不好影响,不得不考虑加入. ...N7命令库永久免费,可放心用于项目"
- 命令授权 = 520
- Else
- TracePrint "抱歉,授权失败. ..."
- 命令授权 = 0
- End If
- Else
- TracePrint "授权成功，为避免后期个别功能泛滥并照成不好影响,不得不考虑加入. ...N7命令库永久免费,可放心用于项目"
- End If
- End Sub
- Function 中英互换(翻译内容)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令": Exit Function
- Dim 返回值,分割1,分割2
- 返回值 = HttpGet("http://api.qingyunke.com/api.php?key=free&appid=0&msg=翻译 " & 翻译内容)
- 分割1 = Split(返回值, "结果：")
- 分割2 = split(分割1(1), chr(34))(0)
- 中英互换 = 分割2
- End Function
- Function 智能对话(对话内容)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令": Exit Function
- Dim 返回值, 分割1, 分割2
- If instr(对话内容, "机器人") > 0 Then
- 智能对话 = "有毛病?你才是机器人。"
- Exit Function
- Else
- 返回值 = HttpGet("http://api.qingyunke.com/api.php?key=free&appid=0&msg=" & 对话内容)
- 分割1 = Split(返回值, "content" & chr(34) & ":" & chr(34))
- 分割2 = split(分割1(1), chr(34))(0)
- 智能对话= 分割2
- End If
- End Function
- Function HttpGet(网址)
- If 命令授权 <> 520 and 命令授权 <> 111 Then TracePrint "未授权,请先调用[命令库授权]命令": Exit Function
- Dim oauth_http
- Set oauth_http = CreateObject("Msxml2.ServerXMLHTTP")
- oauth_http.SetOption 2, 13056
- oauth_http.Open "POST", 网址, False, "", ""
- oauth_http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- oauth_http.Send ("")
- If oauth_http.Status = "200" Then
- HttpGet = oauth_http.responseText
- Else
- HttpGet = ""
- End If
- Set oauth_http=nothing
- End Function
- Function HttpgetEx(网址, 参数)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令": Exit Function
- Dim oauth_http
- Set oauth_http = CreateObject("Msxml2.ServerXMLHTTP")
- oauth_http.SetOption 2, 13056
- oauth_http.Open "POST", 网址, False, "", ""
- oauth_http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- oauth_http.Send (参数)
- If oauth_http.Status = "200" Then
- HttpgetEx = oauth_http.responseText
- Else
- HttpgetEx = ""
- End If
- Set oauth_http=nothing
- End Function
- Function 随机数字(数量,是否重复,最小值, 最大值)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 返回值
- Randomize
- If 是否重复 = True Then
- For 数量
- 返回值 = Int((最大值 - 最小值 + 1) * Rnd + 最小值)
- 随机数字 = 随机数字 & 返回值
- Next
- Else
- For 数量
- Do
- 返回值 = Int((最大值 - 最小值 + 1) * Rnd + 最小值)
- Loop Until InStr(随机数字, 返回值) < 1
- 随机数字 = 随机数字 & 返回值
- Next
- End If
- End Function
- Function 随机字母(数量,是否重复,选项1至3)'1-3
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- TracePrint "1大写、2小写、3大小写"
- Dim 返回值
- Randomize
- If 选项1至3 = 1 and 是否重复 = False Then
- For 数量
- Do
- 返回值 = Int((122 - 97 + 1) * Rnd + 97)
- Loop Until InStr( 随机字母, chr(返回值)) < 1
- 随机字母 = 随机字母 & chr(返回值)
- Next
- ElseIf 选项1至3 = 1 and 是否重复 = True Then
- For 数量
- 返回值 = Int((122 - 97 + 1) * Rnd + 97)
- 随机字母 = 随机字母 & chr(返回值)
- Next
- End If
- If 选项1至3 = 2 and 是否重复 = False Then
- For 数量
- Do
- 返回值 = Int((90 - 65 + 1) * Rnd + 65)
- Loop Until InStr( 随机字母, chr(返回值)) < 1
- 随机字母 = 随机字母 & chr(返回值)
- Next
- ElseIf 选项1至3 = 2 and 是否重复 = True Then
- For 数量
- 返回值 = Int((90 - 65 + 1) * Rnd + 65)
- 随机字母 = 随机字母 & chr(返回值)
- Next
- End If
- If 选项1至3 = 3 and 是否重复 = False Then
- For 数量
- Do
- If rnd > 0.5 Then
- 返回值 = Int((90 - 65 + 1) * Rnd + 65)
- Else
- 返回值 = Int((122 - 97 + 1) * Rnd + 97)
- End If
- Loop Until InStr( 随机字母, chr(返回值)) < 1
- 随机字母 = 随机字母 & chr(返回值)
- Next
- ElseIf 选项1至3 = 3 and 是否重复 = True Then
- For 数量
- If rnd > 0.5 Then
- 返回值 = Int((90 - 65 + 1) * Rnd + 65)
- Else
- 返回值 = Int((122 - 97 + 1) * Rnd + 97)
- End If
- 随机字母 = 随机字母 & chr(返回值)
- Next
- End If
- End Function
- Function 随机颜色()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Randomize
- Dim 颜色文本库
- 颜色文本库="0123456789abcdef"
- For 6
- 随机颜色=随机颜色&Mid(颜色文本库,Int((Len(颜色文本库) - 1 + 1) * Rnd + 1),1)
- Next
- End Function
- Function 随机简体汉字(数量)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 返回值
- For 数量
- Randomize
- 返回值=返回值 & chr(-12160+int(126*rnd+1))
- Next
- 随机简体汉字 = 返回值
- End Function
- Function 随机日文(数量)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 返回值
- Randomize
- For 数量
- 返回值=返回值&Chr(-(Int((2 * Rnd) + 1)*256+Int((83 * Rnd) + 1)+22796))
- Next
- 随机日文=返回值
- End Function
- Function 随机身份证号码(身份证前6位)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Randomize
- Dim 随机身份证号码, 年,月,日,十七位,前17位,求和,求余,尾数
- 随机身份证号码=""
- 随机地区 = 身份证前6位
- 年 = int((30 * rnd) + 1959)
- 月 = int((13 * rnd) + 1)
- 日 = int((28 * rnd) + 1)
- 十七位 = int((500 * rnd) + 100)
- If 月 < 10 Then
- 月="0"&月
- End If
- If 日 < 10 Then
- 日="0"&日
- End If
- 前17位 = 身份证前6位& 年 & 月 & 日 & 十七位
- dim 算法(18)
- dim 值
- 值 = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
- for I = 1 TO 17
- a = mid(前17位, I, 1)
- 算法(I)=a*(值(I-1))
- Next
- 求和=算法(1)+算法(2)+算法(3)+算法(4)+算法(5)+算法(6)+算法(7)+算法(8)+算法(9)+算法(10)+算法(11)+算法(12)+算法(13)+算法(14)+算法(15)+算法(16)+算法(17)
- 求余 = 求和 mod 11
- If 求余 = 0 Then
- 尾数=1
- ElseIf 求余 = 1 Then
- 尾数=0
- ElseIf 求余 = 2 Then
- 尾数 = "X"
- ElseIf 求余 = 3 Then
- 尾数 = 9
- ElseIf 求余 = 4 Then
- 尾数 = 8
- ElseIf 求余 = 5 Then
- 尾数 = 7
- ElseIf 求余 = 6 Then
- 尾数 = 6
- ElseIf 求余 = 7 Then
- 尾数 = 5
- ElseIf 求余 = 8 Then
- 尾数 = 4
- ElseIf 求余 = 9 Then
- 尾数 = 3
- ElseIf 求余 = 10 Then
- 尾数 = 2
- End If
- 随机身份证号码= 前17位 & 尾数
- End Function
- Function 随机日期(最小随机日期, 最大随机日期)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 随机日期_间隔天数, 年, 月, 日
- Randomize
- 随机日期_间隔天数 = DateDiff("d", 最小随机日期, 最大随机日期)
- If 随机日期_间隔天数 < 0 Then Exit Function
- Randomize
- 随机日期_天数 = Int((随机日期_间隔天数 + 1) * Rnd)
- 随机日期 = DateAdd("d", 随机日期_天数, 最小随机日期)
- 年=Year(随机日期): 月=Month(随机日期) :日=Day(随机日期)
- If Len(月) = 1 Then 月 = "0" & 月
- If Len(日) = 1 Then 日 = "0" & 日
- 随机日期 = 年&"/"&月&"/"&日
- End Function
- Function 百度文字识别(图片路径, API_Key, Secret_Key, post接口)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim bs64, tokenid, path
- Dim sendstr,Bodytext,tokedid,arr, brr
- // Call Plugin.Pic.PrintScreen(x1, y1, x2, y2, "C:\1.bmp")
- path= 图片路径 //图片路径自选
- sendstr = "&grant_type=client_credentials&client_id="&API_Key&"&client_secret="&Secret_Key
- Set WinHttp = CreateObject("Microsoft.XMLHTTP")
- WinHttp.Open "POST", "https://aip.baidubce.com/oauth/2.0/token", False
- WinHttp.SetRequestHeader "Content-Type", "text/html"
- WinHttp.SetRequestHeader "Content-Length", len(sendstr)
- WinHttp.Send( sendstr )
- j = 0
- i = Now
- Do
- Delay 100
- j = DateDiff("s", i, Now)
- Loop Until (WinHttp.ReadyState = 4 Or j > 60)
- arr = Split(winhttp.responsetext, "access_token")
- brr = Split(arr(1), chr(34))
- tokenid = brr(2)
- Dim ADS,MSD, node
- Set ADS = CreateObject("ADODB.Stream")
- ADS.Type = 1
- ADS.Open
- ADS.LoadFromFile path
- Set MSD = CreateObject("Msxml2.DOMDocument")
- Set node = MSD.CreateElement("Base64Data")
- node.DataType = "bin.base64"
- node.NodeTypedValue = ADS.Read()
- bs64 = node.Text
- Set node = Nothing
- Set MSD = Nothing
- Set ADS = Nothing
- Dim i
- Dim erg
- erg = bs64
- erg = Replace(erg, "%", Chr(1))
- erg = Replace(erg, "+", Chr(2))
- For i = 0 To 255
- If i=1 or i =37 or i = 43 or (i >=48 and i <= 57) or (i>=65 and i <=90 ) or (i>=97 and i <=122)
- Delay 1
- ElseIf i = 2
- erg = Replace(erg, Chr(i), "%2B")
- ElseIf i = 32
- erg = Replace(erg, Chr(i), "+")
- Elseif (i>=3 and i <=15 )
- erg = Replace(erg, Chr(i), "%0" & Hex(i))
- Else
- erg = Replace(erg, Chr(i), "%" & Hex(i))
- End If
- Next
- bs64 = erg
- Dim BodyTXT
- Set WinHttp = CreateObject("Microsoft.XMLHTTP")
- //post接口 = "https://aip.baidubce.com/rest/2.0/ocr/v1/general_basic"
- WinHttp.Open "POST", post接口&"?access_token="&tokenid, False
- WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- WinHttp.SetRequestHeader "Content-Length", len(bs64)
- WinHttp.Send("&image=" & bs64 )
- j = 0
- i = Now
- Do
- Delay 100
- j = DateDiff("s", i, Now)
- Loop Until (WinHttp.ReadyState = 4 Or j > 60)
- BodyTXT = winhttp.responsetext
- 百度文字识别= BodyTXT
- End Function
- Function 计算笔画数量(汉字)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim char_wordtable(26)
- Dim wordnum_i,wordnum_j,wordnum_k,temp_wordnum
- temp_wordnum=""
- If 汉字 = "" Then
- 计算笔画数量=0
- Exit Function
- end if
- char_wordtable(0)=""
- char_wordtable(1)="一乙"
- char_wordtable(2)="丁七乃乜九了二人亻儿入八冂几凵刀刁力勹匕十厂厶又"
- char_wordtable(3)="万丈三上下丌个丫丸久乇么义乞也习乡亍于亏亡亿兀凡刃勺千卫叉口囗土士夕大女子孑孓寸小尢尸山巛川工己已巳巾干幺广廾弋弓才门飞马"
- char_wordtable(4)="不与丐丑专中丰丹为之乌书予云互亓五井亢什仁仂仃仄仅仆仇仉今介仍从仑仓允元公六兮内冈冗凤凶分切刈劝办勾勿匀化匹区卅升午卞厄厅历及友双反壬天太夫夭孔少尤尹尺屯巴币幻廿开引心忆戈户手扎支攴攵文斗斤方无日曰月木欠止歹殳毋比毛氏气水火爪父爻爿片牙牛犬王瓦肀艺见计订讣认讥贝车邓长闩队韦风乏"
- char_wordtable(5)="且丕世丘丙业丛东丝主乍乎乐仔仕他仗付仙仝仞仟仡代令以仨仪仫们兄兰冉册写冬冯凸凹出击刊刍功加务劢包匆北匝卉半卟占卡卢卮卯厉去发古句另叨叩只叫召叭叮可台叱史右叵叶号司叹叻叼叽囚四圣处外央夯失头奴奶孕宁它宄对尔尕尻尼左巧巨市布帅平幼庀弁弗弘归必忉戊戋扑扒打扔斥旦旧未末本札术正母氐民氕永汀汁汇汉灭犯犰玄玉瓜甘生用甩田由甲申电疋白皮皿目矛矢石示礼禾穴立纠艽艾艿节讦讧讨让讪讫训议讯记轧边辽邗邙邛邝钅闪阡阢饥驭鸟龙"
- char_wordtable(6)="丞丢乒乓乔乩买争亘亚交亥亦产仰仲仳仵件价任份仿企伉伊伍伎伏伐休众优伙会伛伞伟传伢伤伥伦伧伪伫佤充兆先光全共关兴再军农冰冱冲决凫凼刎刑划刖列刘则刚创劣动匈匠匡华协印危压厌厍吁吃各吆合吉吊同名后吏吐向吒吓吕吖吗囝回囟因囡团在圩圪圬圭圮圯地圳圹场圾壮夙多夷夸夹夺夼奸她好妁如妃妄妆妇妈字存孙宅宇守安寺寻导尖尘尥尧尽屹屺屿岁岂岌州巡巩帆师年并庄庆延廷异式弛当忏忖忙戌戍戎戏成托扛扣扦执扩扪扫扬收旨早旬旭旮旯曲曳有朱朴朵机朽杀杂权次欢此死毕氖氘氽汆汊汐汔汕汗汛汜汝江池污汤汲灯灰爷牝牟犴犷犸玎玑百祁竹米糸纡红纣纤纥约级纨纩纪纫缶网羊羽老考而耒耳聿肉肋肌臣自至臼舌舛舟艮色芄芊芋芍芎芏芑芒芗芝芨虍虫血行衣西观讲讳讴讵讶讷许讹论讼讽设访诀贞负轨达迁迂迄迅过迈邡邢那邦邪邬钆钇闫闭问闯阪阮阱防阳阴阵阶页饧驮驯驰齐"
- char_wordtable(7)="两严串丽乱亨亩伯估伲伴伶伸伺似伽佃但位低住佐佑体何佗佘余佚佛作佝佞佟你佣佥佧克免兑兕兵况冶冷冻初删判刨利别刭助努劫劬劭励劲劳匣医卣卤即却卵县君吝吞吟吠吡吣否吧吨吩含听吭吮启吱吲吴吵吸吹吻吼吾呀呃呆呈告呋呐呒呓呔呕呖呗员呙呛呜囤囫园困囱围囵圻址坂均坊坌坍坎坏坐坑块坚坛坜坝坞坟坠声壳奁奂妊妍妒妓妖妗妙妞妣妤妥妨妩妪妫姊姒孚孛孜孝宋完宏寿尬尾尿局屁层岈岍岐岑岔岖岗岘岙岚岛岜希帏帐庇床庋序庐庑库应弃弄弟张形彤彷役彻忌忍忐忑忒志忘忡忤忧忪快忭忮忱忸忻忾怀怃怄怅怆我戒扭扮扯扰扳扶批扼找技抄抉把抑抒抓投抖抗折抚抛抟抠抡抢护报拒拟攸改攻旰旱时旷更杆杈杉杌李杏材村杓杖杜杞束杠条来杨杩极欤步歼每氙氚求汞汨汩汪汰汴汶汹汽汾沁沂沃沅沆沈沉沌沏沐沔沙沛沟没沣沤沥沦沧沩沪泐泛灵灶灸灼灾灿炀牡牢状犹狁狂狃狄狈玖玛甫甬男甸町疔疖疗皂盯矣矶社祀秀私秃究穷系纬纭纯纰纱纲纳纵纶纷纸纹纺纽纾罕羌肓肖肘肚肛肜肝肟肠良芈芘芙芜芟芡芤芥芦芩芪芫芬芭芮芯芰花芳芴芷芸芹芽芾苁苄苇苈苊苋苌苍苎苏苡苣虬补角言证诂诃评诅识诈诉诊诋诌词诎诏译诒谷豆豕豸贡财赤走足身轩轫辛辰迎运近迓返迕还这进远违连迟邑邮邯邰邱邳邴邵邶邸邹邺邻酉里针钉钊钋钌闰闱闲闳间闵闶闷阻阼阽阿陀陂附际陆陇陈陉韧饨饩饪饫饬饭饮驱驳驴鸠鸡麦龟"
- char_wordtable(8)="丧乖乳事些亟享京佩佬佯佰佳佴佶佻佼佾使侃侄侈侉例侍侏侑侔侗供依侠侣侥侦侧侨侩侪侬兔兖其具典冼冽净凭凯函刮到刳制刷券刹刺刻刽刿剀剁剂劾势匦卑卒卓单卖卦卧卷卺厕叁参叔取呢呤呦周呱味呵呶呷呸呻呼命咀咂咄咆咋和咎咏咐咒咔咕咖咙咚咛咝哎囹固国图坡坤坦坨坩坪坫坭坯坳坶坷坻坼垂垃垄垅垆备夜奄奇奈奉奋奔妮妯妲妹妻妾姆始姐姑姓委姗孟孢季孤孥学宓宕宗官宙定宛宜宝实宠审尚居屈屉届岢岣岩岫岬岭岱岳岵岷岸岽岿峁峄巫帑帔帕帖帘帙帚帛帜幸底庖店庙庚府庞废建弥弦弧弩弪录彼往征徂径忝忠念忽忿态怂怊怍怏怔怕怖怙怛怜怡怦性怩怪怫怯怵怿戕或戗戽戾房所承抨披抬抱抵抹抻押抽抿拂拄担拆拇拈拉拊拌拍拎拐拓拔拖拗拘拙拚招拢拣拥拦拧拨择放斧斩於旺昀昂昃昆昊昌明昏易昔昕昙朊朋服杪杭杯杰杲杳杵杷杼松板构枇枉枋析枕林枘枚果枝枞枢枣枥枧枨枪枫枭柜欣欧武歧殁殴氓氛沓沫沭沮沱沲河沸油治沼沽沾沿泄泅泊泌泓泔法泖泗泞泠泡波泣泥注泪泫泮泯泱泳泷泸泺泻泼泽泾浅炅炉炊炎炒炔炕炖炙炜炝炬爬爸版牦牧物狍狎狐狒狗狙狞玟玢玩玫玮环现瓮瓯甙画甾畀畅疙疚疝疟疠疡的盂盱盲直知矸矽矾矿砀码祆祈祉秆秉穸穹空竺籴线绀绁绂练组绅细织终绉绊绋绌绍绎经绐罔罗者耵耶肃股肢肤肥肩肪肫肭肮肯肱育肴肷肺肼肽肾肿胀胁臾舍艰苑苒苓苔苕苗苘苛苜苞苟苠苤若苦苫苯英苴苷苹苻茁茂范茄茅茆茇茉茌茎茏茑茔茕茚虎虏虮虱表衩衫衬规觅视诓诔试诖诗诘诙诚诛诜话诞诟诠诡询诣诤该详诧诨诩责贤败账货质贩贪贫贬购贮贯转轭轮软轰迢迤迥迦迨迩迪迫迭迮述迳邾郁郄郅郇郊郎郏郐郑郓采金钍钎钏钐钒钓钔钕钗闸闹阜陋陌降限陔陕隶隹雨青非顶顷饯饰饱饲饴驵驶驷驸驹驺驻驼驽驾驿骀鱼鸢鸣黾齿"
- char_wordtable(9)="临举亭亮亲侮侯侵便促俄俅俊俎俏俐俑俗俘俚俜保俞俟信俣俦俨俩俪俭修兹养冒冠剃削剌前剐剑勃勇勉勋匍南卸厘厚受变叙叛呲咣咤咦咧咨咩咪咫咬咭咯咱咳咴咸咻咽咿哀品哂哄哆哇哈哉哌响哏哐哑哒哓哔哕哗哙哚哜哝哞哟哪囿型垌垒垓垛垠垡垢垣垤垦垧垩垫垭垮垲垴城埏复奎奏契奕奖姘姚姜姝姣姥姨姹姻姿威娃娄娅娆娇娈娜孩孪客宣室宥宦宪宫封将尜尝屋屎屏峋峒峙峡峤峥峦差巷帝带帧帮幽庠庥度庭弈弭弯彖彦彪待徇很徉徊律後怎怒思怠急怨总怼恂恃恍恒恢恤恨恪恫恬恸恹恺恻恼恽战扁扃拜括拭拮拯拱拴拶拷拼拽拾持挂指按挎挑挖挝挞挟挠挡挢挣挤挥挪挺政故斫施既昝星映春昧昨昭是昱昴昵昶昼显曷朐枯枰枳枵架枷枸柁柃柄柏某柑柒染柔柘柙柚柝柞柠柢查柩柬柯柰柱柳柽柿栀栅标栈栉栊栋栌栎栏树歪殂殃殄殆殇残段毒毖毗毡氟氡氢泉泵泶洁洄洇洋洌洎洒洗洙洚洛洞津洧洪洫洮洱洲洳洵洹活洼洽派浃浇浈浊测浍济浏浑浒浓浔涎炫炭炮炯炱炳炷炸点炻炼炽烀烁烂烃爰牮牯牲牵狠狡狨狩独狭狮狯狰狱狲玲玳玷玻珀珂珈珉珊珍珏珐珑瓴甚甭畈畋界畎畏疣疤疥疫疬疮疯癸皆皇皈盅盆盈相盹盼盾省眄眇眈眉看眍眨矜矧矩砂砉砌砍砑砒研砖砗砘砚砜砭祓祖祗祚祛祜祝神祠祢禹禺秋种科秒秕秭穿窀突窃窆竖竽竿笃笈类籼籽绑绒结绔绕绗绘给绚绛络绝绞统缸罘罚美羿耍耐耔耷胂胃胄胆背胍胎胖胗胙胚胛胜胝胞胡胤胥胧胨胩胪胫脉舁舡舢舣茈茗茛茜茧茨茫茬茭茯茱茳茴茵茶茸茹茺茼荀荃荆荇草荏荐荑荒荔荚荛荜荞荟荠荡荣荤荥荦荧荨荩荪荫荬荭荮药莒莛虐虹虺虻虼虽虾虿蚀蚁蚂蚤衍衲衽衿袂袄袅要觇览觉訇诫诬语诮误诰诱诲诳说诵诶贰贱贲贳贴贵贶贷贸费贺贻赳赴赵趴轱轲轳轴轵轶轷轸轹轺轻迷迸迹追退送适逃逄逅逆选逊郗郛郜郝郡郢郦郧酊酋重钙钚钛钜钝钞钟钠钡钢钣钤钥钦钧钨钩钪钫钬钭钮钯闺闻闼闽闾阀阁阂陛陟陡院除陧陨险面革韭音顸项顺须飑飒食饵饶饷饺饼首香骁骂骄骅骆骇骈骨鬼鸥鸦鸨鸩"
- char_wordtable(10)="乘亳俯俱俳俸俺俾倌倍倏倒倔倘候倚倜借倡倥倦倨倩倪倬倭倮债值倾偌健党兼冢冤冥凄准凇凉凋凌剔剖剜剞剡剥剧勐匪匿卿厝原叟哥哦哧哨哩哭哮哲哳哺哼哽哿唁唆唇唉唏唐唑唔唛唠唢唣唤唧啊圃圄圆垸埂埃埋埒埔埕埘埙埚壶夏套奘奚姬娉娌娑娓娘娟娠娣娥娩娱娲娴婀孬宰害宴宵家宸容宽宾射屐屑展屙峨峪峭峰峻崂崃席帱座弱徐徒徕恁恋恐恕恙恚恝恣恧恩恭息恳恶悃悄悌悍悒悔悖悚悛悝悟悦悭悯扇拳拿挈挚挛挨挫振挹挽捂捃捅捆捉捋捌捍捎捏捐捕捞损捡换捣效敉敌敖斋料旁旃旄旅旆晁晃晋晌晏晒晓晔晕晖晚晟朔朕朗柴栓栖栗栝校栩株栲栳样核根格栽栾桀桁桂桃桄桅框案桉桊桌桎桐桑桓桔桕桠桡桢档桤桥桦桧桨桩梃梆梢梧梨殉殊殷毙毪氤氦氧氨氩泰流浆浙浚浜浞浠浣浦浩浪浮浯浴海浸浼涂涅消涉涌涑涓涔涕涛涝涞涟涠涡涣涤润涧涨涩烈烊烘烙烛烟烤烦烧烨烩烫烬热爱爹特牺狳狴狷狸狺狻狼猁猃玺珙珞珠珥珧珩班珲琊瓞瓶瓷畔留畚畛畜疰疱疲疳疴疸疹疼疽疾痂痃痄病症痈痉皋皱益盍盎盏盐监眙眚真眠眢眩砝弢砟砣砥砧砩砬砰破砷砸砹砺砻砼砾础祟祥祧祯离秘租秣秤秦秧秩秫积称窄窈窍站竞笄笆笊笋笏笑笔笕笫粉粑紊素索紧绠绡绢绣绥绦继绨缺罟罡罢羔羞翁翅耄耆耕耖耗耘耙耸耻耽耿聂胭胯胰胱胲胳胴胶胸胺胼能脂脆脊脍脎脏脐脑脒脓臬臭致舀舐舨航舫般舭舯舰舱艳荷荸荻荼荽莅莆莉莎莓莘莜莞莠莨莩莪莫莰莱莲莳莴莶获莸莹莺莼莽虑虔蚊蚋蚌蚍蚓蚕蚜蚝蚣蚧蚨蚩蚪蚬衄衮衰衷衾袁袍袒袖袜袢被觊请诸诹诺读诼诽课诿谀谁谂调谄谅谆谇谈谊豇豹豺贼贽贾贿赀赁赂赃资赅赆赶起趵趸趿躬軎轼载轾轿辁辂较辱逋逍透逐逑递途逖逗通逛逝逞速造逡逢逦邕部郫郭郯郴郸都酌配酎酏酐酒釜钰钱钲钳钴钵钶钷钸钹钺钻钼钽钾钿铀铁铂铃铄铅铆铈铉铊铋铌铍铎阃阄阅阆陪陬陲陴陵陶陷隼隽难顼顽顾顿颀颁颂颃预饽饿馀馁骊骋验骏高髟鬯鬲鸪鸫鸬鸭鸯鸱鸲鸳鸵"
- char_wordtable(11)="龛鸶龀乾偃假偈偎偏偕做停偬偶偷偻偾偿傀兜兽冕减凑凰剪副勒勖勘匏匐匙匮匾厢厣厩唪唬售唯唰唱唳唷唼唾唿啁啃啄商啉啐啕啖啜啡啤啥啦啧啪啬啭啮啵啶啷啸喏喵圈圉圊埝域埠埤埭埯埴埸培基埽堀堂堆堇堋堍堑堕堵够奢娶娼婆婉婊婕婚婢婧婪婴婵婶孰宿寂寄寅密寇尉屠崆崇崎崔崖崛崞崤崦崧崩崭崮巢帷常帻帼庳庵庶康庸庹庾廊弹彗彩彬得徘徙徜恿悉悠患您悫悬悱悴悸悻悼情惆惊惋惕惘惚惜惝惟惦惧惨惬惭惮惯戚戛扈挲捧捩捭据捱捶捷捺捻掀掂掇授掉掊掎掏掐排掖掘掠探接控推掩措掬掭掮掳掴掷掸掺掼揶敏救敕教敛敝敢斛斜断旋旌旎族晗晡晤晦晨曹曼望桫桴桶桷梁梅梏梓梗梦梭梯械梳梵检棂欲欷殍殒殓毫氪涪涫涮涯液涵涸涿淀淄淅淆淇淋淌淑淖淘淙淝淞淠淡淤淦淫淬淮深淳混淹添清渊渌渍渎渐渑渔渖渗渚渠烯烷烹烽焉焊焐焓焕焖焘爽牾牿犁猊猎猓猕猖猗猛猜猝猞猡猪猫率球琅理琉琏琐瓠甜略畦疵痊痍痒痔痕痖皎皑皲盒盔盖盗盘盛眦眭眯眵眶眷眸眺眼着睁矫砦硅硇硌硎硐硒硕硖硗硭票祭祷祸秸移秽稆窑窒窕竟章笙笛笞笠笤笥符笨笪第笮笱笳笸笺笼笾筇粒粕粗粘粜粝累绩绪绫续绮绯绰绱绲绳维绵绶绷绸绺绻综绽绾绿缀缁缍羚羝羟翊翌翎耜聃聆聊聋职聍胬脖脘脚脞脬脯脱脲脶脸舂舳舴舵舶舷舸船舻艴菀菁菅菇菊菌菏菔菖菘菜菝菟菠菡菥菩菪菰菱菲菸菹菽萁萃萄萆萋萌萍萎萏萑萘萜萝萤营萦萧萨萸著虚蚯蚰蚱蚴蚵蚶蚺蛀蛄蛆蛇蛉蛊蛋蛎蛏衅衔袈袋袤袭袱袷袼裆裉觋觖谋谌谍谎谏谐谑谒谓谔谕谖谗谘谙谚谛谜谝豉豚象赇赈赉赊赦赧趺趼趾跃跄距躯辄辅辆逭逮逯逵逶逸逻郾鄂鄄酗酚酝酞野铐铑铒铕铖铗铘铙铛铜铝铞铟铠争铣铤铥铧铨稔铫铬铭铮铯铰铱铲铳铴铵银铷阈阉阊阋阌阍阎阏阐隅隆隈隋隍随隐隗雀雩雪颅领颇颈馄馅馆馗骐骑骒骓骖鸷鸸鸹鸺鸽鸾鸿鹿麸麻黄龚"
- char_wordtable(12)="亵傅傈傍傣傥傧储傩傲凿剩割募博厥厦厨啻啼啾喀喁喂喃善喇喈喉喊喋喑喔喘喙喜喝喟喧喱喳喷喹喻喽喾嗖嗟堙堞堠堡堤堪堰塄塔壹奠奥婷婺婿媒媚媛媪嫂孱孳富寐寒寓尊就属屡崴崽崾嵇嵋嵌嵘嵛嵝嵫嵬嵯巯巽帽幂幄幅弑强弼彘彭御徨循悲惑惠惩惫惰惴惶惹惺愀愉愎愕愠愣愤愦愧慌慨戟戡戢扉掌掣掰掾揄揆揉揍揎描提插揖揞揠握揣揩揪揭揲援揸揽揿搀搁搂搅搓搔搜搭搽摒敞散敦敬斌斐斑斯普景晰晴晶晷智晾暂暑曾替最朝期棉棋棍棒棕棘棚棠棣森棰棱棵棹棺棼椁椅椋植椎椐椒椟椠椤椭椰楗楮榔欹欺款殖殚殛毯毳毵毽氮氯氰淼渝渡渣渤渥温渫渭港渲渴游渺湃湄湍湎湓湔湖湘湛湟湫湮湾湿溃溅溆溉溲滁滋滑滞焙焚焦焯焰焱然煮牌牍犀犄犊犋犍猢猥猩猬猱猴猸猹猾琚琛琢琥琦琨琪琬琮琰琳琴琵琶琼瑛瓿甥甯番畲畴疏痘痛痞痢痣痤痦痧痨痪痫登皓皖皴睃睇睐睑矬短硝硪硫硬确硷祺禄禅禽宵稃程稍税窖窗窘窜窝竣童竦筅等筋筌筏筐筑筒答策筘筚筛筝筵粞粟粢粤粥粪紫絮絷缂缃缄缅缆缇缈缉缋缌缎缏缑缒缓缔缕编缗缘缙羡翔翕翘耋耠聒联脔脾腆腈腊腋腌腑腓腔腕腙腚腱腴舄舒舜舾艇萱萼落葆葑葙葚葛葜葡董葩葫葬葭葱葳葵葶葸葺蒂蒇蒈蒉蒋蒌蒎蛐蛑蛔蛘蛙蛛蛞蛟蛤蛩蛭蛮蛰蛱蛲蛳蛴蜒蜓街裁裂装裎裒裕裙裢裣裤裥覃觌觚觞詈谟谠谡谢谣谤谥谦谧貂赋赌赍赎赏赐赓赔赕趁趄超越趋跆跋跌跎跏跑跖跗跚跛跞践辇辈辉辊辋辍辎辜逼逾遁遂遄遇遍遏遐遑遒道遗酡酢酣酤酥釉释量铸铹铺铼铽链铿销锁锂锃锄锅锆锇锈锉锊锋锌锍锎锏锐锑锒锓锔锕阑阒阔阕隔隘隙雁雄雅集雇雯雳靓韩颉颊颌颍颏飓飧飨馇馈馊馋骗骘骚骛鱿鲁鲂鹁鹂鹃鹄鹅鹆鹇鹈黍黑黹鼋鼎"
- char_wordtable(13)="催傺傻像剽剿勤叠嗄嗅嗉嗌嗍嗑嗒嗓嗔嗜嗝嗡嗣嗤嗥嗦嗨嗪嗫嗬嗯嗲嗳嗵嗷嘟塌塍塑塘塞塥填塬墓媲媳媵媸媾嫁嫉嫌嫒嫔嫫寝寞尴嵊嵩嵴幌幕廉廒廓彀徭微想愁愆愈愍意愚感愫慈慊慎慑戤戥搋搌搏搐搛搞搠搡搦搪搬携摁摄摅摆摇摈摊摸敫数斟新旒暄暇暌暖暗椴椹椽椿楂楔楚楝楞楠楣楦楫楱楷楸楹楼榀概榄榆榇榈榉榘槌槎槐歃歆歇歌殿毁毂毹氲溏源溘溜溟溢溥溧溪溯溱溴溶溷溺溻溽滂滇滏滓滔滗滚滟滠满滢滤滥滦滨滩漓漠漭煅煊煌煎煜煞煤煦照煨煲煳煸煺牒犏献猷猿獒瑁瑕瑗瑙瑚瑜瑞瑟瑰甄畸畹痰痱痴痹痼痿瘀瘁瘃瘅瘐皙盟睚睛睡睢督睥睦睨睫睬睹瞄矮硼碇碉碌碍碎碑碓碗碘碚碛碜碰禀禁禊福稔稗稚稞稠稣窟窠窥窦筠筢筮筱筲筷筹筻签简粮粱粲粳缚缛缜缝缟缠缡缢缣缤罨罩罪置署群羧耢聘肄肆腠腥腧腩腭腮腰腹腺腻腼腽腾腿舅艄艉蒗蒙蒜蒡蒯蒲蒴蒸蒹蒺蒽蒿蓁蓄蓉蓊蓍蓐蓑蓓蓖蓝蓟蓠蓣蓥蓦蓬虞蛸蛹蛾蜂蜃蜇蜈蜉蜊蜍蜕蜗蜣衙裔裘裟裨裰裱裸裼裾褂褚觎觜解觥触訾詹誉誊谨谩谪谫谬豢貅貉貊赖趑趔跟跣跤跨跪跫跬路跳跷跸跹跺跻躲辏辐辑输辔辞辟遘遛遢遣遥遨鄙鄞鄢鄣酩酪酬酮酯酰酱鉴锖锗锘错锚锛锝锞锟锡锢锣锤锥锦锨锩锪锫锬锭键锯锰锱阖阗阙障雉雍雎雏零雷雹雾靖靳靴靶韪韫韵颐频颓颔颖飕馍馏馐骜骝骞骟骰骱髡魁魂鲅鲆鲇鲈鲋鲍鲎鲐鹉鹊鹋鹌鹎鹏鹑麂鼓鼠龃龄"
- char_wordtable(14)="龅龆僖僚僦僧僬僭僮僳儆兢凳劁劂厮嗽嗾嘀嘁嘈嘉嘌嘎嘏嘘嘛嘞嘣嘤嘧塾墁境墅墉墒墙墚夤夥嫖嫘嫜嫠嫡嫣嫦嫩嫱孵察寡寤寥寨屣嶂幔幛廑廖弊彰愿慕慝慢慵慷截戬搴搿摔摘摞摧摭摹摺撂撄撇撖敲斡旖旗暝暧暨榍榕榛榜榧榨榫榭榱榴榷榻槁槊槔槛槟槠槭模歉殡毓滴滹漂漆漉漏演漕漤漩漪漫漯漱漳漶漾潆潇潋潍潢潴澉煽熄熊熏熔熘熙熬犒獍獐瑭瑶瑷璃甍疑瘊瘌瘕瘗瘘瘙瘟瘥瘦瘩睽睾睿瞀瞅瞍碟碡碣碥碧碱碲碳碴碹磁磋禚稳窨窬窭竭端箅箍箐箔箕算箜箝管箢箦箧箨箩箪箫箬箸粹粼粽精糁綦綮缥缦缧缨缩缪缫罂罱罴翟翠翡翥耥聚肇腐膀膂膈膊膏膑膜臧舆舔舞艋蓰蓼蓿蔌蔑蔓蔗蔚蔟蔡蔫蔷蔸蔹蔺蔻蔼蔽蕖蜀蜘蜚蜜蜞蜡蜢蜥蜩蜮蜱蜴蜷蜻蜾蜿蝇蝈蝉螂裳裴裹褊褐褓褙褛褡褪觏觫誓谭谮谯谰谱谲豪貌赘赙赚赛赫跽踅踉踊踌辕辖辗辣遭遮鄯鄱酲酴酵酶酷酸酹酽酾酿銎銮锲锴锵锶锷锸锹锺锻锼锾锿镀镁镂镄镅阚隧雌雒需霁霆静靼鞅韬韶颗馑馒骠骡骢骶骷髦魃魄魅鲑鲒鲔鲕鲚鲛鲜鲞鲟鹕鹗鹘鹚鹛鹜麽鼐鼻"
- char_wordtable(15)="龇龈僵僻儇儋凛劈劐勰嘬嘭嘱嘲嘶嘹嘻嘿噌噍噎噔噗噘噙噜噢噶墀增墟墨墩嬉寮履屦嶙嶝幞幡幢廛影徵德慧慰憋憎憔憧憨憬懂戮摩撅撑撒撕撙撞撤撩撬播撮撰撵撷撸撺擒敷暮暴暹槲槽槿樊樗樘樟横樯樱橄橡橥毅滕潘潜潦潭潮潲潸潺潼澄澈澌澍澎澜澳熟熠熨熳熵牖獗獠瑾璀璁璇璋璎璜畿瘛瘠瘢瘤瘪瘫瘼瞌瞎瞑瞒瞢碾磅磉磊磐磔磕磙稷稹稻稼稽稿窳箭箱箴篁篆篇篌篑篓糅糇糈糊糌糍缬缭缮缯羯羰翦翩耦耧聩聪膘膛膝膣艏艘蔬蕃蕈蕉蕊蕙蕞蕤蕨蕲蕴蕺虢蝌蝎蝓蝗蝙蝠蝣蝤蝥蝮蝰蝴蝶蝻蝼蝽蝾螋褒褥褫褴觐觑觯谳谴谵豌豫赜赭趟趣踏踔踝踞踟踢踣踩踪踬踮踯踺躺辘遴遵醅醇醉醋醌鋈镆镇镉镊镌镍镎镏镐镑镒镓镔霄震霈霉靠靥鞋鞍鞑鞒题颚颛颜额飘餍馓馔骣骸骺骼髫髯魇鲠鲡鲢鲣鲤鲥鲦鲧鲨鲩鲫鹞鹣鹤麾黎"
- char_wordtable(16)="齑龉龊儒冀凝劓嘴噤器噩噪噫噬噱噻噼嚆圜墼壁壅嬖嬗嬴寰廨廪徼憝憩憷憾懈懊懒懔撼擀擂擅操擎擐擗擞整斓暾樨樵樽樾橇橐橘橙橛橱橹橼檎檠歙殪氅氆氇潞澡澧澶澹激濂濉濑濒熹燃燎燔燕燠燧犟獬獭璞瓢甏甑瘭瘰瘳瘴瘵瘸瘾瘿癀癃盥瞟瞠瞥瞰磨磬磲磺禧穆穑窿篙篚篝篡篥篦篪篮篱篷糕糖糗糙缰缱缲缳缴罹羲翮翰翱耨耩耪聱膦膨膪膳臻蕹蕻蕾薄薅薇薏薛薜薤薨薪薮薯螃螅螈融螓螗螟螨螭螯蟆蟒衡褰褶赝赞赠踱踵踹踽蹀蹁蹂蹄蹉辙辚辨辩遽避邀邂鄹醍醐醑醒醚醛錾镖镗镘镙镛镜镝镞镟隰雕霍霎霏霓霖靛鞔鞘颞颟颠颡飙飚餐髭髹髻魈魉鲭鲮鲰鲱鲲鲳鲴鲵鲶鲷鲸鲺鲻鹦鹧鹨鹾麇麈黉黔默"
- char_wordtable(17)="鼽儡嚅嚎嚏嚓壑壕嬲嬷孺嶷徽懋懑懦戴擘擢擤擦曙朦檀檄檐檑檗檩檬濞濠濡濮濯燥燮爵獯璐璨璩甓疃癌癍皤瞧瞩瞪瞬瞳瞵磴磷礁礅穗篼篾簇簋簌簏簖簧糜糟糠縻繁繇罄罅罾羁翳翼膺膻臀臁臂臃臆臊臌艚薰薷薹藁藉藏藐藓螫螬螳螵螺螽蟀蟊蟋蟑蟓蟥襁襄觳謇豁豳貔貘赡赢蹇蹈蹊蹋蹑蹒辫邃邈醢醣鍪镡镢镣镤镥镦镧镨镩镪镫隳霜霞鞠馘骤髀髁魍魏鲼鲽鳃鳄鳅鳆鳇鳊鳋鹩鹪鹫鹬麋黏黛黜黻鼢鼾龋"
- char_wordtable(18)="龌龠冁嚣彝懵戳曛曜檫瀑燹璧癔癖癜癞瞻瞽瞿礓礞簟簦簪糨翻艟藕藜藤藩蟛蟠蟪蟮襟覆謦蹙蹦蹩躇邋醪鎏鏊镬镭镯镰镱雠鞣鞫鞭鞯颢餮馥髂髅鬃鬈鳌鳍鳎鳏鳐鹭鹰"
- char_wordtable(19)="黝黟黠鼬嚯孽巅攀攉攒曝瀚瀛瀣爆璺瓣疆癣礤簸簿籀籁缵羸羹艨藻藿蘅蘑蘧蟹蟾蠃蠊蠓蠖襞襦警谶蹬蹭蹯蹰蹲蹴蹶蹼蹿酃醭醮醯鏖镲霪霭靡鞲鞴颤骥髋髌鬏魑鳓鳔鳕鳖鳗鳘鳙鹱麒麓"
- char_wordtable(20)="麴黢黼鼗嚷嚼壤孀巍攘曦瀵瀹灌獾瓒矍籍糯纂耀蘖蘩蠕蠛譬躁躅酆醴醵镳霰颥馨骧鬓魔鳜鳝鳞"
- char_wordtable(21)="鳟黥黧黩黪鼍鼯夔曩灏爝癫礴禳羼蠡蠢赣躏醺鐾露霸霹颦髓"
- char_wordtable(22)="鳢麝黯鼙囊懿氍瓤穰耱蘸蘼躐躔镶"
- char_wordtable(23)="霾饔饕髑鬻鹳麟攥攫癯罐趱躜颧"
- char_wordtable(24)="鬟鼷鼹齄灞矗蠲蠹衢襻躞鑫"
- char_wordtable(25)="鬣馕囔戆攮纛"
- char_wordtable(26)="蠼爨"
- wordnum_i=0
- wordnum_j=0
- wordnum_k=0
- for wordnum_i=1 to Len(汉字)
- temp_wordnum=Mid(汉字,wordnum_i,1)
- for wordnum_j=1 to 26
- if instr(1,char_wordtable(wordnum_j),temp_wordnum)>0 then
- wordnum_k=wordnum_k+wordnum_j
- exit for
- End If
- next
- next
- 计算笔画数量=wordnum_k
- End Function
- Function 坐标距离计算(x1, y1, x2, y2)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- 坐标距离计算 = Round(sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2), 2)
- End Function
- Function 坐标距离排序(数组, x, y)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- '参照点坐标：x, y
- '距离越近排越前，数组元素格式：坐标x,坐标y
- Dim i, m, arr1, k, k2, dm, di
- For m = 0 To UBound(数组)
- For i = m + 1 To UBound(数组)
- k = 数组(m)
- arr1 = split(k, ",")
- dm = 坐标距离计算(arr1(0), arr1(1), x,y)
- k2 = 数组(i)
- arr1 = split(k2, ",")
- di = 坐标距离计算(arr1(0), arr1(1), x,y)
- If dm > di Then
- 数组(m) = 数组(i)
- 数组(i) = k
- End If
- Next
- Next
- 坐标距离排序 = 数组
- End Function
- Function 获取系统用户名()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim bag, coc, str1
- Set bag = GetObject("winmgmts:\\.\root\cimv2")
- Set coc = bag.ExecQuery("Select * from Win32_ComputerSystem")
- For Each objcomputer in coc
- str1 = objcomputer.username
- Next
- 获取系统用户名 = split(str1, "\")(1)
- End Function
- Function 获取系统分辨率()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim x,y
- x = GetSystemMetrics(0)
- y = GetSystemMetrics(1)
- 获取系统分辨率=Array(x,y)
- End Function
- //Function 获取系统文件大小(路径)
- // If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- // Dim hFile, FileSize
- // hFile = Plugin.File.OpenFile(路径)
- // If hFile <> - 1 Then
- // FileSize = GetFileSize(hFile, 0)
- // If &HFFFFFFFF <> FileSize Then
- // 获取系统文件大小= FileSize
- // Else
- // 获取系统文件大小="null"
- // End If
- // Call Plugin.File.CloseFile(hFile)
- // End If
- //End Function
- Function 获取系统各种路径(选项1至12)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Set wshell = CreateObject("WScript.Shell")
- TracePrint "1桌面、2收藏夹、3字体、4我的文档、5网上邻居、6打印机、7程序、8最近文档、9绝对路径、10开始菜单、11启动、12模板"
- Select Case 选项1至12
- Case 1
- 获取系统各种路径 = wshell.specialfolders("Desktop")
- Case 2
- 获取系统各种路径 = wshell.specialfolders("Favorites")
- Case 3
- 获取系统各种路径 = wshell.specialfolders("Fonts")
- Case 4
- 获取系统各种路径 = wshell.specialfolders("MyDocuments")
- Case 5
- 获取系统各种路径 = wshell.specialfolders("NetHood")
- Case 6
- 获取系统各种路径 = wshell.specialfolders("PrintHood")
- Case 7
- 获取系统各种路径 = wshell.specialfolders("Programs")
- Case 8
- 获取系统各种路径 = wshell.specialfolders("Recent")
- Case 9
- 获取系统各种路径 = wshell.specialfolders("SendTo")
- Case 10
- 获取系统各种路径 = wshell.specialfolders("StartMenu")
- Case 11
- 获取系统各种路径 = wshell.specialfolders("StartUp")
- Case 12
- 获取系统各种路径 = wshell.specialfolders("Templates")
- End Select
- End Function
- Function 获取网络时间()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- 获取网络时间=split(HttpGet("https://apps.game.qq.com/CommArticle/app/reg/gdate.php"),"'") (1)
- End Function
- Function 获取CPU序列号()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim strout,str
- strout=""
- Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
- Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
- str=""
- str=str & vbcrlf & "For Each objItem in colItems"
- str=str & vbcrlf & " strOut = strOut & objItem.ProcessorId"
- str=str & vbcrlf & "Next"
- execute (str)
- 获取CPU序列号=strOut
- End Function
- Function 获取MAC序列号()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim mc,mo
- Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
- For Each mo In mc
- If mo.IPEnabled=True Then
- 获取MAC序列号= mo.MacAddress
- Exit For
- End If
- Next
- End Function
- Function 获取外网IP地址()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 返回值, MyPos,MyVar,一次提取,二次提取,IP, IP地名
- 返回值 = HttpGet("http://www.ip38.com")
- MyPos = Instr(返回值, "ip=")
- MyVar = Mid(返回值, MyPos, 200)
- 一次提取 = Split(MyVar, ">"):二次提取 = Split(一次提取(1), "<")
- IP = 二次提取(0)
- 一次提取 = Split(MyVar, "FF0000>"):二次提取 = Split(一次提取(1), "<")
- IP地名 = 二次提取(0)
- 获取外网IP地址= IP地名&","&IP
- End Function
- Function 获取内网ip地址()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 返回值
- ComputerName="."
- Dim objWMIService,colItems,objItem,objAddress
- Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
- Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
- For Each objItem in colItems
- For Each objAddress in objItem.IPAddress
- If objAddress <> "" Then
- 返回值 = 返回值 & objAddress & "|"
- End If
- Next
- Next
- 获取内网ip地址 = left(返回值, len(返回值) - 1)
- End Function
- Function 获取U盘序列号()'根据U盘盘符获取序列号
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim objWMIService
- Dim USBDevices, USBDevice, USBDiskPartitions, USBDiskPartition, LogicalUSBDisks, LogicalUSBDisk
- Dim strID
- Dim Finded
- Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
- Set USBDevices = objWMIService.execquery("Select * From Win32_DiskDrive where InterfaceType='USB'")
- For Each USBDevice In USBDevices
- If Finded Then Exit For
- Set USBDiskPartitions = objWMIService.execquery("Associators of {Win32_DiskDrive.DeviceID='" & USBDevice.DeviceId & "'} where AssocClass = Win32_DiskDriveToDiskPartition")
- For Each USBDiskPartition In USBDiskPartitions
- Set LogicalUSBDisks = objWMIService.execquery("Associators of {Win32_DiskPartition.DeviceID='" & USBDiskPartition.DeviceId & "'} where AssocClass = Win32_LogicalDiskToPartition")
- For Each LogicalUSBDisk In LogicalUSBDisks
- If LogicalUSBDisk.DeviceId = UCase(获取U盘盘符) Then
- strID = Split(USBDevice.PNPDeviceID, "\")
- strID = Split(strID(UBound(strID)), "&")
- 获取U盘序列号 = strID(0)
- Finded = True
- End If
- Next
- Next
- //Delay 1
- Next
- Set USBDevices = Nothing
- Set USBDevice = Nothing
- Set USBDiskPartitions = Nothing
- Set USBDiskPartition = Nothing
- Set LogicalUSBDisks = Nothing
- Set LogicalUSBDisk = Nothing
- End Function
- Function 获取U盘盘符()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim d, i
- Set d = CreateObject("Scripting.FileSystemObject")
- For i = 68 To 90
- If d.DriveExists(Chr(i)) Then
- If (d.GetDrive(Chr(i)).DriveType = 1) Then
- 'TracePrint "发现可移动磁盘：" & Chr(i)
- 获取U盘盘符 = Chr(i) & ":"
- End If
- End If
- Next
- End Function
- Function 获取硬件型号(选项1至3)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- TracePrint "1CPU、2显卡、3主板"
- Set wmi = GetObject("winmgmts:\\.\root\CIMV2")
- Set cpu = wmi.ExecQuery("select * from win32_processor")
- Set display = wmi.ExecQuery("select * from win32_VideoController")
- Set board = wmi.ExecQuery("select * from win32_BaseBoard")
- Select Case 选项1至3
- Case 1
- For Each i In cpu
- Hdstr = "CPU型号" & i.Name
- Next
- Case 2
- For Each i In display
- Hdstr = Hdstr & i.Name
- Next
- Case 3
- For Each i In board
- Hdstr = Hdstr & i.Manufacturer & " " & i.ProDuct
- Next
- End Select
- 获取硬件型号= Hdstr
- End Function
- Function 获取CPU使用率()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Set objProc = GetObject("winmgmts:\\.\root\cimv2:win32_processor='cpu0'")
- 获取CPU使用率= objProc.LoadPercentage
- End Function
- Function 获取操作系统信息()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim strComputer, objWMIService
- Dim colItems, objItem, iCount
- Dim aTemp,Str
- Str = "计算机名称,操作系统名称,制造商,版本,补丁包版本,内部版本,内部版本种类,注册的用户名," _
- & "序列标识号,Windows路径,系统所在目录,编码页,加密级别,国家(地区)编码,当前时区,安装日期," _
- & "最后启动的时间,本地日期和时间,已加载进程总数,可用的物理内存,可用的页面空间,可用的虚拟内存," _
- & "虚拟内存总数,可用物理内存"
- aTemp=Split(Str,",")
- strComputer = "."
- Set objWMIService = GetObject("winmgmts:" _
- & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
- Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
- For Each objItem in colItems
- aInfo=aInfo & aTemp(0) & ":" & objItem.CSName & "|"
- aInfo= aInfo & aTemp(1) & ":" & objItem.Caption & "|"
- aInfo= aInfo & aTemp(2) & ":" & objItem.Manufacturer & "|"
- aInfo= aInfo & aTemp(3) & ":" & objItem.Version & "|"
- aInfo=aInfo & aTemp(4) & ":" & objItem.CSDVersion & "|"
- aInfo= aInfo & aTemp(5) & ":" & objItem.BuildNumber & "|"
- aInfo=aInfo & aTemp(6) & ":" & objItem.BuildType & "|"
- aInfo= aInfo & aTemp(7) & ":" & objItem.RegisteredUser & "|"
- aInfo=aInfo & aTemp(8) & ":" & objItem.SerialNumber & "|"
- aInfo=aInfo & aTemp(9) & ":" & objItem.WindowsDirectory & "|"
- aInfo= aInfo & aTemp(10) & ":" & objItem.SystemDirectory & "|"
- aInfo=aInfo & aTemp(11) & ":" & objItem.CodeSet & "|"
- aInfo=aInfo & aTemp(12) & ":" & objItem.EncryptionLevel & " 位" & "|"
- aInfo=aInfo & aTemp(13) & ":" & objItem.CountryCode & "|"
- aInfo=aInfo & aTemp(14) & ":" & objItem.CurrentTimeZone & "|"
- aInfo=aInfo & aTemp(15) & ":" & objItem.InstallDate & "|"
- aInfo=aInfo & aTemp(16) & ":" & objItem.LastBootUpTime & "|"
- aInfo=aInfo & aTemp(17) & ":" & objItem.LocalDateTime & "|"
- aInfo=aInfo & aTemp(18) & ":" & objItem.NumberOfProcesses & "|"
- aInfo=aInfo & aTemp(19) & ":" & Round(objItem.FreePhysicalMemory / 1024) & " MB" & "|"
- aInfo=aInfo & aTemp(20) & ":" & Round(objItem.FreeSpaceInPagingFiles / 1024) & " MB" & "|"
- aInfo=aInfo & aTemp(21) & ":" & Round(objItem.FreeVirtualMemory / 1024) & " MB" & "|"
- aInfo=aInfo & aTemp(22) & ":" & Round(objItem.TotalVirtualMemorySize / 1024) & " MB" & "|"
- aInfo=aInfo & aTemp(23) & ":" & Round(objItem.TotalVisibleMemorySize / 1024) & " MB" & "|"
- Next
- aInfo = "操作系统信息"& "|" & aInfo
- 获取操作系统信息 = aInfo
- End Function
- //Function 获取登录的QQ()
- // If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- // Dim HwndEx, Hwnd, Shul, Text, Tmp, i
- // HwndEx = Plugin.Window.SearchEx(0, "qqexchangewnd_shortcut_prefix_", 0)
- // If len(HwndEx) > 0 Then
- // Hwnd = Split(HwndEx, "|")
- // Shul = UBound(Hwnd) - 1
- // For i = 0 To Shul
- // Text = Plugin.Window.GetText(Hwnd(i))
- // Tmp = Tmp & Replace(Text, "qqexchangewnd_shortcut_prefix_", "") & "|"
- // Next
- // 获取登录的QQ = mid(Tmp,1,len(Tmp)-1)
- // End If
- //End Function
- Function 下载网络文件(网络http, 本地路径)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim url
- url = 网络http '这里写你要下载文件的全路径
- Set obj1 = CreateObject("msxml2.xmlhttp")
- Set obj2 = CreateObject("adodb.stream")
- obj1.open "get",url,False
- obj1.send
- temp = obj1.responseBody
- obj2.Type = 1
- obj2.Mode = 3
- obj2.Open
- obj2.Write(temp)
- obj2.SaveToFile 本地路径,2 '2的意思是已有则覆盖
- obj2.Close
- End Function
- Function 获取QQ头像(QQ号, 本地路径)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 网址
- 网址 = "http://q.qlogo.cn/g?b=qq&nk=" & QQ号 & "&s=100" '这里写你要下载文件的全路径
- 返回值= 下载网络文件(网址, 本地路径)
- End Function
- Function 转半角为全角(半角字符)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- STlen=len(半角字符)
- JZF = Space(STlen)
- LCMapString &H804, &H800000, 半角字符, STlen, JZF, STlen
- 转半角为全角 = JZF
- End Function
- Function 转全角为半角(全角字符)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- STlen=len(全角字符)
- JZF = Space(STlen)
- LCMapString &H804, &H400000, 全角字符, STlen, JZF, STlen
- 转全角为半角 = JZF
- End Function
- Function 写屏画图(hwnd, 文件名, x, y, w, h)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim dc,hdc
- dc=GetDC(hwnd)
- hdc = CreateCompatibleDC(dc)
- hbit=LoadImage (0, 文件名, 0, w, h, 16)
- SelectObject hdc, hbit
- BitBlt dc, x, y, w, h, hdc, 0, 0, 13369376
- DeleteObject hbit
- DeleteObject hdc
- ReleaseDC hwnd,dc
- End Function
- Function 坐标角度计算(x1, y1, x2, y2)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- If x2 - x1 = 0 Then
- 坐标角度计算=0
- Else
- 坐标角度计算 = FormatNumber(Atn((y2 - y1) / (x2 - x1)) * 180 / (4 * Atn(1)),2)
- End If
- End Function
- Function 鼠标带轨迹移动(x1, y1)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim cs,轨迹x,轨迹y,移动次数,随机次数,移动步长,移动偏差x,移动偏差y,移动延时
- GetCursorPos x, y
- If abs(x - x1) > abs(y - y1) Then
- cs = abs(x - x1)
- Else
- cs = abs(y - y1)
- End If
- If cs=0 then cs=1
- 轨迹x = (x1 - x) / cs : 轨迹y = (y1 - y) / cs
- 移动次数 = 0 : 随机次数 = 0 : 移动步长 = Int((20 - 16 + 1) * Rnd + 16)
- While x <> x1 and y <>y1
- 移动次数 = 移动次数 + 1
- x = x + 轨迹x : y = y + 轨迹y
- If 移动次数 = 移动步长 Then
- Randomize
- 移动次数 = 0 : 随机次数 = 随机次数 + 1 : 移动步长 = Int((20 - 16 + 1) * Rnd + 16) : 移动延时 = Int((15 - 10 + 1) * Rnd + 10)
- If 随机次数 = 4 Then
- 移动偏差x = Int((12 + 12 + 1) * Rnd - 12) : 移动偏差y = Int((9 + 9 + 1) * Rnd - 9) : 随机次数 = 0
- End If
- MoveTo x + 移动偏差x, y + 移动偏差y
- Delay 移动延时
- ElseIf abs(x - x1) <= 移动步长 and abs(y - y1) <= 移动步长 Then
- x = x1 : y = y1
- MoveTo x1, y1
- End If
- Wend
- End Function
- Function 键盘急速点击(按键码)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- KeyDown 按键码, 1
- KeyUp 按键码, 1
- End Function
- Function 鼠标急速点击(选项1至2)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Select Case 选项1至2
- Case 1
- LeftDown 1
- LeftUp 1
- Case 2
- RightDown 1
- RightUp 1
- End Select
- End Function
- Function 鼠标按键状态(选项1至2)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- 鼠标按键状态 = 获取键鼠信息(选项1至2)
- End Function
- Function 键盘按键状态(按键码)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- 键盘按键状态= GetAsyncKeyState(按键码)
- End Function
- Function 窗口是否未响应(句柄, 检测秒数)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim i
- For 检测秒数
- If IsHungAppWindow(句柄)=0 Then
- i = 0'窗口正常，次数归零
- 窗口是否未响应="正常"
- Else
- i=i+1
- If i = 检测秒数 Then
- 窗口是否未响应="卡死"
- End If
- End If
- Delay 1000
- Next
- End Function
- Function 结束进程(映像名称)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim strComputer, objWMIService, colProcessList, objProcess
- strComputer = "."
- Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
- Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & 映像名称 & "'")
- For Each objProcess in colProcessList
- objProcess.Terminate
- Next
- End Function
- //Function 获取网络Ping(网址)
- // If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- // 网址 = Replace(网址, "https://", "")
- // 网址 = Replace(网址, "http://", "")
- // Call Plugin.File.DeleteFile("c:\Ping.bat")
- // Call Plugin.File.DeleteFile("c:\Ping结果.txt")
- // Call Plugin.File.WriteFileEx("c:\Ping.bat", "cmd.exe /c ping "&网址&" -t >c:\Ping结果.txt")
- // set ws=CreateObject("WScript.Shell")
- // ws.Run "c:\Ping.bat", 0
- // Delay 5000
- // 结束进程("Ping.exe")
- // For 10
- // 获取网络Ping = Plugin.File.ReadFileEx("c:\Ping结果.txt")
- // If 获取网络Ping <> "" Then
- // Exit Function
- // End If
- // Delay 1000
- // Next
- //End Function
- Function 获取网络连接状态()
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- If HttpGet("https://www.baidu.com/") = "" Then
- 获取网络连接状态 = "断网"
- Else
- 获取网络连接状态 = "连网"
- End If
- End Function
- Function 键盘QTP按键(按键)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Set wshobj = CreateObject("WScript.Shell")
- wshobj.SendKeys "{"&按键码&"}"
- Set wshobj = Nothing
- End Function
- Function 数组相似度排序(数组)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim intI,intLen,intK,Ci,intTemp
- intI=0: intLen=UBound(数组)
- For intLen
- intK=intI
- Ci=intLen-intK+1
- For Ci
- If int(Left(数组(intI),Len(数组(intI))-1)) >= int(Left(数组(intK),Len(数组(intK))-1)) Then
- intTemp=数组(intI)
- 数组(intI)=数组(intK)
- 数组(intK)=intTemp
- End If
- intK=intK+1
- Next
- intI=intI+1
- Next
- 数组相似度排序=join(数组,"-")
- End Function
- Function 数组冒泡排序(数组, 选项1至2)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim 最大可用下标, 最小可用下标, 调换情况, 中转存储, i, j
- 最大可用下标 = UBound(数组)
- 最小可用下标 = LBound(数组)
- For i = 最小可用下标 To 最大可用下标 - 1
- 调换情况 = False
- For j = 最大可用下标 To i + 1 Step - 1
- If 选项1至2 = 1 Then
- If 数组(j) < 数组(j - 1) Then
- 中转存储 = 数组(j - 1)
- 数组(j - 1) = 数组(j)
- 数组(j) = 中转存储
- 调换情况 = True
- End If
- Else
- If 数组(j) > 数组(j - 1) Then
- 中转存储 = 数组(j - 1)
- 数组(j - 1) = 数组(j)
- 数组(j) = 中转存储
- 调换情况 = True
- End If
- End If
- Next
- If Not (调换情况) Then Exit For
- Next
- 数组冒泡排序 = join(数组,"-")
- End Function
- Function 查找B在A的数量(A, B)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Set regEx = New RegExp
- regEx.Pattern = A
- regEx.IgnoreCase = True
- Execute "regEx.Global = True"
- Set Matches = regEx.Execute(B)
- For Each Match in Matches
- '对每个匹配项的处理
- Next
- 查找B在A的数量 =Matches.count '直接返回匹配数量
- End Function
- Function 取字符串中间值(字符串, 前特征, 后特征)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- If InStr(字符串,前特征)>0 And InStr(字符串,后特征)>0 Then 取字符串中间值=Split(Split(字符串,前特征)(1),后特征)(0)
- End Function
- Function 取字符串中间所有值(字符串, 前特征, 后特征)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Dim i,Arr前特征,Ck
- ArrStrA=Split(字符串,前特征)
- For i = 1 To UBound(ArrStrA)
- If InStr(ArrStrA(i), 后特征) > 0 Then Ck = Ck & Split(ArrStrA(i),后特征)(0) &"|"
- Next
- 取字符串中间所有值=Ck
- End Function
- Function 音量设置(选项1至3)
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- Select Case 选项1至3
- Case 1
- KeyPress 173, 1
- Case 2
- KeyPress 174, 1
- Case 3
- KeyPress 173, 1
- End Select
- End Function
- Function 文本急速读取(路径)'2021.02.16
- If 命令授权 <> 520 Then TracePrint "未授权,请先调用[命令库授权]命令" : Exit Function
- 文本急速读取 = createobject("scripting.filesystemobject").opentextfile(路径,1).readall()
- 文本急速读取 =Replace(文本急速读取,vbcrlf,"|")
- End Function
- Function 输入字符串(发送内容, 发送延迟, 文字编码类型)
- TracePrint "文字编码类型：ANSI、Unicode"
- If 文字编码类型 = "ANSI" Or 文字编码类型 = "Unicode" Then
- Dim str, 字符编码,i, k
- str = 发送内容
- For i = 1 To Len(str)
- If 文字编码类型 = "ANSI" Then
- 字符编码 = Asc(Mid(str, i, 1))
- Elseif 文字编码类型 = "Unicode"
- 字符编码 = AscW(Mid(str, i, 1))
- End If
- If 字符编码 < 0 Then
- 字符编码 = 字符编码 + 65536
- End If
- KeyDown 18, 1
- For k = 1 To Len(字符编码)
- KeyPress Asc(Mid(字符编码, k, 1)) + 48, 1
- Next
- KeyUp 18, 1
- Delay 发送延迟
- Next
- 输入字符串=1
- Else
- 输入字符串=0
- End If
- End Function
- Function 键盘按键编码(键名)
- Var1 = Array("CTRL", "ALT", "SHIFT", "LCTRL", "LALT", "LSHIFT", "RCTRL", "RALT", "RSHIFT", "WIN", "DOWN", "UP", "LEFT", "RIGHT", "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12", "HOME", "END", "PAGEDOWN", "PAGEUP", "ESC", "ENTER", "SPACE", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "`", "-", "=", "[", "]", "\", "/", ",", ".", "CapsLock", "Tab", "BackSpace", "Insert", "Delete", "Num Lock", "Print Screen", "Scroll Lock", "'", ";", "Pause/Break", "Num /", "Num *", "Num -", "Num +", "Enter", "Num .", "Num 0", "Num 1", "Num 2", "Num 3", "Num 4", "Num 5", "Num 6", "Num 7", "Num 8", "Num 9", "*", "-", "+", ".", "/")
- Var2 = Array("17", "18", "16", "162", "164", "160", "163", "165", "161", "91", "40", "38", "37", "39", "112", "113", "114", "115", "116", "117", "118", "119", "120", "121", "122", "123", "36", "35", "34", "33", "27", "13", "32", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "192", "189", "187", "219", "221", "220", "191", "188", "190", "20", "9", "8", "45", "46", "144", "44", "145", "222", "186", "19", "111", "106", "109", "107", "13", "110", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "109", "107", "110", "111")
- For i=0 to UBound(Var1) - 1
- If Var1(i) =UCase(键名) Then Exit For
- Next
- 键盘按键编码 = Var2(i)
- End Function
- Function HttpgetEx2(网页地址, 选项1至2)//多个参数.设置编码.跟乱码说88
- If 命令授权 <> 520 and 命令授权 <> 111 Then TracePrint "未授权,请先调用[命令库授权]命令": Exit Function
- //Plugin.Sys.SetCLB(lib.网络.获得网页源文件_增强版("www.baidu.com","utf-8")) //百度
- //Plugin.Sys.SetCLB(lib.网络.获得网页源文件_增强版("www.sina.com.cn","gbk")) //新浪
- Dim xmlHttp, xmlUrl,ObjStream
- If InStr(网页地址, "http://") = 0 Then
- xmlUrl = "http://" & 网页地址
- Else
- xmlUrl = 网页地址
- End if
- Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1") //用这个对象,跟缓存/cookie 干扰说88
- xmlHttp.Open "GET", xmlUrl, True
- xmlHttp.Send
- If xmlhttp.waitforresponse() Then
- Set ObjStream = CreateObject("Adodb.Stream")
- ObjStream.Type = 1
- ObjStream.Mode = 3
- ObjStream.Open
- ObjStream.Write xmlHttp.ResponseBody
- ObjStream.Position = 0
- ObjStream.Type = 2
- Select Case 选项1至2
- Case 1
- 网页编码="utf-8"
- Case 2
- 网页编码="gbk"
- End Select
- ObjStream.Charset = 网页编码
- HttpgetEx2 = ObjStream.ReadText
- Set ObjStream = Nothing
- Else
- HttpgetEx2 = "" //如果获取失败返回值是 空
- End If
- Set xmlHttp = Nothing
- End Function
- Function Unicode编码转文字(编码内容)
- 编码内容 = LCase(编码内容)
- Unicode编码转文字 = ""
- Dim regEx, Matches
- Set regEx = New RegExp
- regEx.Pattern ="\\u"
- regEx.[Global] = True
- regEx.IgnoreCase = False
- 编码内容 = regEx.Replace(编码内容, "&H")//将/u替换为&H
- regEx.Pattern ="&H.+?\b"
- Set Matches = regEx.Execute(编码内容) //将每个字的编码搜索出来
- For Each Match In Matches
- Unicode编码转文字=Unicode编码转文字&Eval("ChrW(" & Match & ")")
- Next
- End Function
- Function 文字转Unicode编码(文字内容)
- Dim i
- 文字转Unicode编码 = ""
- For i = 1 To Len(文字内容)
- 文字转Unicode编码 = 文字转Unicode编码 & "\u"&LCase(Hex(AscW(Mid(文字内容, i, 1))))
- Next
- End Function
- Function 文字转GB2312格式URL(字符串)
- 文字转GB2312格式URL =""
- for I = 1 To Len(字符串)
- UdTxt = ""
- UdTxt = Mid(字符串, I, 1)
- NumTxt="-,.0123456789/"
- If instr(NumTxt,UdTxt)>0 Then
- 文字转GB2312格式URL = 文字转GB2312格式URL &UdTxt
- Else
- If Asc(UdTxt) < 0 Then
- tempStr = "%" & Right(CStr(Hex(Asc(UdTxt))), 2)
- tempStr ="%"&Left(CStr(Hex(Asc(UdTxt))),Len(CStr(Hex(Asc(UdTxt))))-2)&tempStr
- 文字转GB2312格式URL=文字转GB2312格式URL&tempStr
- ElseIf Asc(UdTxt) >= 65 And Asc(UdTxt) <= 90 Then
- 文字转GB2312格式URL=文字转GB2312格式URL&UdTxt
- ElseIf Asc(UdTxt) >= 97 And Asc(UdTxt) <= 122 Then
- 文字转GB2312格式URL=文字转GB2312格式URL&UdTxt
- Else
- 文字转GB2312格式URL=文字转GB2312格式URL&"%"&CStr(Hex(Asc(UdTxt)))
- End If
- End If
- Next
- End Function
- Function 文字转UTF8格式URL(字符串)
- 文字转UTF8格式URL =""
- Dim wch, uch, szRet
- Dim x
- Dim nAsc, nAsc2, nAsc3
- If 字符串 = "" Then
- 文字转UTF8格式URL = 字符串
- Exit Function
- End If
- For x = 1 To Len(字符串)
- wch = Mid(字符串, x, 1)
- nAsc = AscW(wch)
- If nAsc < 0 Then nAsc = nAsc + 65536
- If (nAsc And &HFF80) = 0 Then
- szRet = szRet & wch
- Else
- If (nAsc And &HF000) = 0 Then
- uch = "%" & Cstr(Hex(((nAsc \ 2 ^ 6)) Or &HC0)) & Cstr(Hex(nAsc And &H3F Or &H80))
- szRet = szRet & uch
- Else
- uch = "%" & Cstr(Hex((nAsc \ 2 ^ 12) Or &HE0)) & "%" &Cstr(Hex((nAsc \ 2 ^ 6) And &H3F Or &H80)) & "%" &Cstr(Hex(nAsc And &H3F Or &H80))
- szRet = szRet & uch
- End If
- End If
- Next
- 文字转UTF8格式URL = szRet
- End Function
- Function 进制转换(字符串,原进制, 转换进制)
- Dim sc
- Set sc = CreateObject("ScriptControl")
- sc.Language = "JScript"
- sc.AddCode ("function tmp(str,d1,d2){return parseInt(str,d1).toString(d2);}")
- 进制转换 = sc.Run("tmp",字符串,原进制, 转换进制)
- Set sc = nothing
- End Function
- Function 文字繁体转简体(繁体字)
- Dim STlen, JZF
- STlen=len(繁体字)
- fzj = Space(STlen)
- LCMapString &H804, &H2000000, 繁体字, STlen, fzj, STlen
- 文字繁体转简体 = fzj
- End Function
点评
江中游
好源码 ，必须收藏
发表于 2021/11/10 20:26:27
|
闽公网安备 35010002000112号