**电子手册企业版(XP系统正式版)注册机

donpps

《农药电子手册》是北京际峰天震信息技术有限公司与农业部农药检定所有关专家设计并完成的农药数据库应用软件。此软件采用 Windows 窗口式图形环境，操作简单、使用方便、功能齐全。具有优良的农药查询功能，是农药开发、决策、管理、科研、教学、生产、应用、劳动卫生、农药中毒急救治疗及经营者的理想参考工具。

权威数据 每周更新 轻松点击 把握商机

产品功能
您可以查询：农药产品的登记证号、有效期、产（商）品名称、生产企业、有效成分及混（单）剂含量、适用作物、防治对象、环境毒性、禁限用、中毒与急救等详细信息
您可以判断：您所销售、购买、使用的农药是否为合法登记产品
您可以掌握：中国境内的所有农药生产企业及其产品的详细信息
您可以了解：中国境内所有国内、国外农药登记的最新动态
您可以分析：同类所有农药产品目前最新的应用统计
您可以节省：轻松点击，减少工作量，迅速获得准确数据和信息

产品特点
权威性： 全部数据由中国农业部农药检定所权威发布
全面性： 中国境内所有合法登记的农药产品相关信息：2万多种农药产品、近千种有效成分、近万家农药生产企业等农药相关的详细信息，每周定时增新
及时性： 数据每周更新，轻松在线升级
方便性： 脱机使用，多种查询入口，灵活的查询方式，强大的统计、对比分析功能，随心所欲的轻松获取各种针对性信息，摆脱繁琐、凌乱、难以全面的信息收集方式，把握准确数据。

农药电子手册详细适用单位
农药生产企业 农药经销商 农药管理部门 农药科研机构 农药使用者 农药进出口公司 农业技术推广部门 庄稼医生 卫生医疗机构 环保部门。

原版下载地址：http://www.chinapesticide.gov.cn/epm/xiazaiz.htm

注册机原来在嬴政论坛发过，用 PB 编写，要带库文件，比较大，后一直想用 VBS 编写，发现 Replace() 函数在两者之间差异甚大，遂作罢。今天又翻出来，就自己写了个 VBS 函数模拟 PB 的 Replace() 函数得到了结果。玩一玩，看看 .VBS 怎么样。

----------------------------------代码部分------------------------------------
'Copyright (C) 2008 DonPPS. All right reserved.

Dim str_zch_qy,Input,Inputzcm,Inputabout,text
Inputabout = MsgBox ("农药电子手册企业版XP系统正式版官方网页："&Chr(10)&Chr(10)&"http://www.j-f.com.cn"&Chr(10)&Chr(10)&"《农药电子手册》是北京际峰天震信息技术有限公司与农业部农药检定所有关专家设计并完成的农药数据库应用软件。此软件采用 Windows 窗口式图形环境，操作简单、使用方便、功能齐全。具有优良的农药查询功能，是农药开发、决策、管理、科研、教学、生产、应用、劳动卫生、农药中毒急救治疗及经营者的理想参考工具。"&Chr(10)&Chr(10)&"===================================================================================================="&Chr(10)&Chr(10)&"仅供测试，请勿商用！无时间限制，软件更新后，数据库变更，需要重安装，或清除注册，再重新注册。"&Chr(10)&Chr(10)&"Copyright (C) 2008 DonPPS. All right reserved.",,"免责申明")

'输入机器码
Input = InputBox("输入机器码","农药电子手册企业版XP系统正式版注册机")
Input = trim(CStr(Input))
Input = replace_print(Input)
If (Len (Input) < 4 or Len (Input) > 64) Then '为了简单起见，做了约束。
  MsgBox "机器码位数出界。"&Chr(10)&Chr(10)&"单击【确定】退出程序。",48,"程序异常"
Else

'计算注册号
str_zch_qy = f_zch(Input)
str_zch_qy =  "XE@0X@SW%" + left(str_zch_qy,1) + "@" + mid(str_zch_qy,2,len(str_zch_qy) -2) + "@" + right(str_zch_qy,1) + "%EN@EW@EW" '两端的文本是时间代码，表示2099.12.31。

'复制到剪贴板
CopyToClipBoard str_zch_qy
Inputzcm = MsgBox ("农药电子手册企业版XP系统正式版注册码："&Chr(10)&Chr(10)&str_zch_qy&Chr(10)&Chr(10)&"注册码已复制到 Windows 剪贴板，粘贴注册即可。",64,"农药电子手册企业版XP系统正式版注册机")
End If

'函数 f_zch (as_xlh)
Function f_zch(as_xlh)

Dim str(36)
Dim str_xlh,str_jf,str_sn,str_c1,str_c2,strc5,str_zch,str_zch_r,str_zch_l,str_rand
Dim i,j,k,int_c3,int_c4
'字符表(原程序有个比较复杂的算法，不知道怎么逆算，干脆搞个表算了)
str(1) = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
str(2) = "16CJUVQBA7DKHG0ZITLYO8EWXRM23PNSF954"
str(3) = "2CV1KMHDUANGSWR7F3Z6I4PXLYT50JOE98QB"
str(4) = "3J1T82YZ9F746BSIKQOPUXVDNE50HMACGWRL"
str(5) = "4UK8SGNMHQTEOPZ5RX2A0CFJ17WBL93IY6DV"
str(6) = "5VM2GTSNKUOWEXYA907CFBJLZ63QR1IP84HD"
str(7) = "6QHYNSMKDBGOTI14LP85XA0F92ECJRW3Z7VU"
str(8) = "7BDZMNKHVCSTG396JIY4P5X0R8OAFLEW12UQ"
str(9) = "8AU9HKDVQ5MSNEL20W1736IPJZG4XFTORYBC"
str(10) = "97AFQUBC52VHDSX13GJZTYOEPLK8WIMN0R46"
str(11) = "ADN7TOGSMVE3W08C1F6BJQLRY4IU9ZPX25KH"
str(12) = "BKG4EWOTSH3PIJ7QYL5URV912AXDZ80F6CNM"
str(13) = "CHS6OETGNDWI3F2BZJ4QLUR985PV1YX07AMK"
str(14) = "DGWBPXI3ES0JF1AH6ZQKYM825ULN74R9CVOT"
str(15) = "E0RSZY19LX872AMWDCG3BIQUKT6PVH45NOJF"
str(16) = "FZ7I5A4621CQBHWJTKPLMRNSEXU9GOVD308Y"
str(17) = "GIFKR9LJ031YZ6DTQ4MO5EACVN8WBU27HSXP"
str(18) = "HT3QX0PIWGFLJZCK4YUM8N27AVRS6591BDEO"
str(19) = "ILZO278Y1J654QGPMUEXV0DHSWAFKNCBT39R"
str(20) = "JY6PAC547ZBUQK3LOMXRN9SGW0V1TEDHIF28"
str(21) = "KOIU0FXP3TJRLYBM58VN2S76CD9G4A1ZQHWE"
str(22) = "L84XCBA56YQVUMIREN09S1GT3FDZOWHKPJ72"
str(23) = "MEPVFJ0XIOL9R8QNA2DS7G64BH1T5CZYUK3W"
str(24) = "NWXDJLF0PER192USC7HG6T45QKZOABY8VMI3"
str(25) = "OXLN1Z9RJPY285KEVASWC3BQHG7IUD64MTF0"
str(26) = "PRYE7628ZL4A5UTXNVW0DFHKG3CJMSBQOI19"
str(27) = "QMT5W3EOGKIXPL6U8RAV9D1Z7C0HY2FJ4BSN"
str(28) = "R250BQCA48UDVNP9WSF1GZTOIJHYE3KMXL67"
str(29) = "S30HLRJFXW9Z17VGB6KT4O5AUMYECQ82DNPI"
str(30) = "TPJM91RLFIZ8Y4HOU5NEAWCBDS23QV76KG0X"
str(31) = "UNOA3IWETMP0XR4V29CD1HZY6BFK87JL5QGS"
str(32) = "VSECIP3WONXF095D71BHZKY84QJM26LRAUTG"
str(33) = "WF9GY8Z1R0267CN3HBTIQPUVMO4XDK5ASELJ"
str(34) = "X98W6472YR5CAVO0SD3FHJKMTIBLNGQUEPZ1"
str(35) = "Y5QRDHVUB4KNMOJ8XE92W73IF1S6P0GTLZCA"
str(36) = "Z4BLVDUQC6HMKTFYPOR8E2W309N7IXSGJ1A5"

str_jf = "JIFENGISACOMPUTERTECHNOLOGYCOMPANYINBEIJINGHADIANQUZHONGCUN0"
str_sn = "Y5QRDHVUB4KNMOJ8XE92W73IF1S6P0GTLZCA"
str_rand = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

str_xlh = "J" & as_xlh & "F" '两边的字母可以随便，不影响注册。

for i = 1 to (len(str_xlh) - Int(len(str_xlh) / 2))
k = i * 2 - 1
j = k Mod 60
str_c1 = mid(str_xlh,k,1)
str_c2 = mid(str_jf,j,1)
int_c3 = InStr(1,str_sn,str_c2,1)
int_c4 = InStr(1,str(1),str_c1,1)
strc5 = mid(str(Int(int_c3)),int_c4,1)
str_zch_l = replacePB(str_zch_l,k,1,strc5)
next

for i = 1 to Int(len(str_xlh) / 2)
k = i * 2
j = k Mod 60
str_c1 = mid(str_xlh,k,1)
str_c2 = mid(str_jf,j,1)
int_c3 = InStr(1,str_sn,str_c2,1)
int_c4 = InStr(1,str(1),str_c1,1)
strc5 = mid(str(Int(int_c3)),int_c4,1)
str_zch_r = replacePB(str_zch_r,k,1,strc5)
next

str_zch = str_zch_l + str_zch_r
f_zch = str_zch

End Function

'函数 replacePB (expression, start, count, replacewith)，用来代替 PB 的 replace，较弱。
Function replacePB (expression, start, count, replacewith)

expression = CStr(expression)
replacewith = CStr(Mid(replacewith,1,1))
count = Int(count)
start = Int(start)
replacePB = Mid (expression,1,start) & replacewith & Mid (expression,(1 + start))

End Function

'函数 replace_print (as_1)，用来排除非打印字符。
Function replace_print (as_1)

Dim i,ls_temp
for i = 1 to len(as_1)
        if ((asc(mid(as_1,i,1)) >= 48 and asc(mid(as_1,i,1)) <= 57) or (asc(mid(as_1,i,1)) >= 65 and asc(mid(as_1,i,1)) <= 90)) then
                ls_temp = ls_temp + mid(as_1,i,1)
        end if
next
replace_print = ls_temp

End Function

'过程 CopyToClipBoard(Text)，复制注册码到剪贴板。
Sub CopyToClipBoard(Text)
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate("about:blank")
    objIE.Document.ParentWindow.ClipboardData.SetData "text", Text
    objIE.Quit
End Sub
-----------------------------------------------------------------------------
附件： 电子手册企业版XP系统正式版注册机.rar (2.87 KB, 下载次数: 36)

2008-4-2 20:22 上传

点击文件名下载附件

[ 本帖最后由 donpps 于 2008-4-2 20:23 编辑 ]

magic659117852

强  学习

/:001 不过注册机就没必要发在交流区了

千里之外

请发到KEY区

donpps

只是体验一下 VBS 写注册机的乐趣，没别的什么！

飘之叶

高手！学习！

jcly

好
学习一下
支持一下