使用ASP开发时,如果不导入证书,会遇到 的问题。如图所示:
出现这个问题,是因为 调用微信支付接口时,没有导入 微信证书导致。如果 继续阅读
最近要用到一套ASP生成静态的小系统,虽然说程序简单,但是写起来还是比较繁琐的,正好前几天写过一个:ASP文件存储方案(http://www.miaoqiyuan.cn/p/asp-filedb),用改类,可以直接快速开发生成ASP的系统。
'加载模板 '对于模板,不了解的,可以参考我以前写过的文章,当然也可以用任何asp的模板系统 set p = new MYW3_TPL p.LoadTpl "tpl/chengyu.html" p.assign "Title","猫七" p.assign "WebHome",WebHome p.assign "WebSkin",WebSkin '/index.html url = "index" '/home/index.html 'url = "home::index" '/home/1/2/333.html 'url = "home::1::2::333" '生成静态 ‘使用FileDB类,超级简单 set f = new FileDB f.DBPath = "/" f.idxKey = url f.save(p.outHtml)
需要对FileDB的类做一下小的修改
Private Function getPath() Dim tmp getPath = replace(idxKey,"::","/") & ".html" End Function
四月份做个一个短信系统,当时为了节省成本(使用万网的空间,不带SQL数据库空间便宜),使用了ASP+Access开发,最近需要升级,增加一个短信接口。发现现在Access的数据库竟然有170MB。我的天啊,因为查询比较少,不是很耗资源,所以没有检查出来。
仅仅六个月,数据库竟然到了170MB。随着客户业务的增长,可能再过六个月就要到500MB了,真恐怖。主要占空间大小的,就是存储的短信的发送号码,思考再三,决定将所有的保存到文本文件中。于是写下了一个暂时成为FileDB的asp类。
Class FileDB Dim fso,IdxKey,DBPath Private Sub Class_Initialize Set fso = Server.CreateObject("Scripting.FileSystemObject") idxKey = "demo::test" DBPath = "DataCenter/File_DB/" End Sub Private Function getPath() Dim tmp getPath = replace(idxKey,"::","/") & ".html" End Function Private Function checkFile(byref fname) fname = Server.Mappath(DBPath & getPath()) checkFile = fso.fileexists(fname) End Function Private Sub createPathName(byval idxKey) Dim TmpPa TmpPa = Server.Mappath(DBPath & idxKey) if not fso.folderexists(TmpPa) then if instr(idxKey,"\") > 0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1)) fso.createfolder(TmpPa) end if End Sub Public Function getTxt() if checkFile(fname) then set Txt = fso.getfile(fname) if Txt.size = 0 then Tmp = "" else Tmp = fso.opentextfile(fname).readall end if set Txt = Nothing getTxt = Tmp else getTxt = "" end if End Function Public Function remove() if checkFile(fname) then fso.deletefile fname end if End Function Public Function Save(byval content) if checkFile(fname) then set fpo = fso.opentextfile(fname,2) else idxKey = replace(idxKey,"::","\") if instr(idxKey,"\")>0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1)) set fpo = fso.createtextfile(fname) end if fpo.write content fpo.close set fpo = nothing End Function End Class
因为时间比较紧,而且代码比较简单,就不加注释了,实际就是简化了文本文件的操作方法。
<% Server.ScriptTimeOut=10000 %> <% '数据库链接代码 set fdb = new FileDB fdb.DBPath = "../DataCenter/sms_DB/" conn.open constr set rs = server.createobject("ADODB.Recordset") '得到所有没有转换的数据 rs.open "select * from sendlog where send_mob not like '%::%'",conn,3,2 do while not rs.eof 'FileDB 数据存放路径,日期::MD5(ID) idxStr = split(Rs("send_date")," ")(0) & "::" & md5(Rs("send_id")) fdb.IdxKey = idxStr fdb.Save(Rs("send_mob")) Rs("send_mob") = idxStr rs.update rs.movenext loop rs.close conn.close '数据库压缩过程,不是重点,再次不再多述 compactdata(DataPath) %> 减肥成功,所有数据转存到FileDB中。
执行一下,所有数据就转存好了,读取的时候很简单,指定了 idxStr,用getTxt()即可得到内容。
set fdb = new FileDB fdb.DBPath = "../DataCenter/sms_DB/" '../DataCenter/sms_DB/aaa/1111.txt fdb.idxKey = "aaa::1111" str1 = fdb.getTxt() '../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt fdb.idxKey = "bbb:ccc::ddd:eee" str2 = fdb.getTxt() '删除 ../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt fdb.remove() '因为文件不存在,得到的值就是空字符串 str3 = fdb.getTxt() '将内容保存到../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt,因为不存在则创建,如果存在,则修改。 fdb.save("11111")
2010年10月24日更新小Bug,修复了idxKey 定于数据存放在根目录,就会报错的错误
最近接了一个彩信接口的网站,需要将 文本文件、图片文件 转换成 HexString,通过Form提交,.net、php、javascript的函数网上一抓一大把,asp的却不好找,今天我就来写一个asp版本的hexstring转换函数,为了方便以后用,直接写成类。
class bin2txt dim adostream private sub class_initialize set adostream = server.createobject("ADODB.Stream") adostream.type = 1 adostream.mode = 3 end sub public sub open(fn) adostream.open adostream.LoadFromFile fn end sub public function getHex(t) dim tmp,hexstr,binstr binstr = adostream.read() for i = 1 to lenB(binstr) tmp = hex(ascB(midB(binstr,i,1))) if len(tmp) = 1 then tmp = "0" & tmp hexstr = hexstr & tmp & t next getHex = hexstr end function public function getOct(t) dim tmp,octstr,binstr binstr = adostream.read() for i = 1 to lenB(binstr) tmp = (ascB(midB(binstr,i,1))) if len(tmp) = 2 then tmp = "0" & tmp if len(tmp) = 1 then tmp = "00" & tmp octstr = octstr & tmp & t next getOct = octstr end function end class
使用方法,很简单,代码如下:
set f = new bin2txt f.open server.mappath("sms/1.jpg") response.write f.getHex()
彩信添加桢也添加玩函数
'addpage 'pid:帧编号 'showtime:帧展示时间 function addpage(pid,showtime,ttype,tfile,ptype,pfile,mtype,mfile) addpage = "&d" & pid & "=" & showtime if ttype <> "" and ptype <> "" then f.open server.mappath(tfile) addpage = addpage & "&tt" & pid & "=" & ttype &_ "&tv" & pid & "=" & f.getHex() end if if ptype <> "" and ptype <> "" then f.open server.mappath(ptype) addpage = addpage & "&pt" & pid & "=" & ptype &_ "&pv" & pid & "=" & f.getHex() end if if mtype <> "" and mtype <> "" then f.open server.mappath(mtype) addpage = addpage & "&mt" & pid & "=" & mtype &_ "&mv" & pid & "=" & f.getHex() end if end function set f = new bin2txt f.open server.mappath("sms/title.txt") sendstr = "id=***&pwd=***&subject=" & f.getHex() sendstr = sendstr & addpage(1,5,"txt","sms/1.txt","jpg","sms/1.jpg","","") sendstr = sendstr & addpage(2,5,"txt","sms/2.txt","jpg","sms/2.jpg","","") response.write openApi("http://118.144.76.79:8080/mmsServer/sendMms",sendstr)
新写的xmlClass,有些简陋,不过常用的功能都可以直接调用了。
<% '============================================================== ' xmlClass v1.10.0617 by CatSeven '============================================================== ' 文件:xmlClass.asp ' 功能:常用的XML处理 ' 作者:苗启源(http://www.miaoqiyuan.cn) '============================================================== class xmlClass Dim xmlobj Public Sub Class_Initialize set xmlobj = Server.CreateObject("Microsoft.XMLDOM") End Sub Public Sub Class_Terminate set xmlobj = Nothing End Sub '功能:从文件加载XML 'f -> file 要保存的XML文件 ' web://aaa.xml 根目录下的 myw3.xml ' path://myw3.xml 当前目录下的 myw3.xml ' E:/web/www/myw3.xml ' http://localhost/myw3.xml Public Sub Load(byval f) f = Mappath(f) xmlobj.load f End Sub '功能:将当前的数据保存到XML问及那 'f -> file 要保存的XML文件 ' web://aaa.xml 根目录下的 myw3.xml ' path://myw3.xml 当前目录下的 myw3.xml ' E:/web/www/myw3.xml ' http://localhost/myw3.xml Public Sub Save(byval f) f = Mappath(f) xmlobj.save f End Sub '功能:通过标签获取节点列表 '参数:tag -> TagName '返回:符合条件的节点列表 Public Function getTags(byval tag) dim p set p = xmlobj.getElementsByTagName(tag) set getTags = p End Function '功能:通过xPath获取节点列表 '参数:str -> xpath 字符串 '返回:符合条件的节点列表 Public Function xPath(byval str) dim p set p = xmlobj.selectNodes(str) set xPath = p End Function '功能:设置节点属性 '参数:obj -> 要设置属性的节点 ' othervalue -> 属性值:比如 a=1&b=2 ==> <xxx a="1" b="2" /> Public Sub setNode(byref obj,byval othervalue) dim valArr valArr = split(othervalue,"&") for i = 0 to ubound(valArr) if instr(valArr(i),"=")>0 then valDB = split(valArr(i),"=") obj.setAttribute valDB(0),valDB(1) end if next End Sub '功能:设置节点属性 '参数:obj -> 节点列表,必须是一个列表,且只为列表中的第一项添加子节点。一般为:getTags,xPath返回的节点列表。 ' xmlname -> 属性名。 ' xmlvalue-> 属性值。 Public Sub setAttribute(byval obj,byval xmlname,byval xmlvalue) for i = 0 to obj.length - 1 obj(i).setAttribute xmlname,xmlvalue next End Sub '功能:删除当前节点 '参数:obj -> 删除当前节点 Public Sub Remove(byval obj) if obj.length>0 then obj(0).parentNode.removeChild obj(0) End Sub '功能:添加一个新的节点 '参数:obj -> 节点列表,必须是一个列表,且只为列表中的第一项添加子节点。一般为:getTags,xPath返回的节点列表。 ' nodename -> 节点名称(tagName) ' xmlname -> 索引属性。如果在当前文件中有节点名相同,且属性相同的节点,则不会新增节点 ' valuearr -> 索引属性的值,必须是一个一元数组。 ' othervalue -> 传递到setNode的属性,请参照 Public Sub setNode Public Sub Append(byval obj,byval nodename,byval xmlname,byval valuearr,byval othervalue) if obj.length<1 then Exit Sub for i = 0 to ubound(valuearr) if trim(valuearr(i))<>"" then if xPath("//"&nodename&"[@"&xmlname&"='"&valuearr(i)&"']").length=0 then set newNode = xmlobj.CreateElement(nodename) newNode.setAttribute xmlname,valuearr(i) setNode newNode,otherValue obj(0).appendChild(newNode) end if end if next End Sub '功能:获取节点属性列表 '参数:obj -> 节点列表,必须是一个列表,且只为列表中的第一项添加子节点。一般为:getTags,xPath返回的节点列表。 ' xmlname -> 属性名。 '返回:一元数组,包含了所有的属性名 Public Function getAttribute(byval obj,byval xmlname) dim Arr redim Arr(obj.length - 1) for i = 0 to obj.length - 1 Arr(i) = obj(i).getAttribute(xmlname) next getAttribute = Arr End Function '功能:获取文件的路径 'f -> file 要保存的XML文件 ' web://aaa.xml 根目录下的 myw3.xml ' path://myw3.xml 当前目录下的 myw3.xml ' E:/web/www/myw3.xml ' http://localhost/myw3.xml '返回:文件的路径 Private Function Mappath(byval f) if instr(f,"web://")>0 then f = replace(f,"web://","/") f = server.mappath(f) elseif instr(f,"path://")>0 then f = replace(f,"path://","") f = server.mappath(f) end if if left(LCase(f),7)<>"http://" then f = "file://" & f Mappath = f End Function end class %>
ASP也能处理JSON数据?呵呵,刚才在Pjblog论坛上看到一个兄弟写的文章,没有测试,不过理论上一定是可以的~ 太晚了,不测试了。
以前处理JSON太麻烦了,输出还好说,循环一下就可以了,解析真的很头疼。所以遇到 这种问题API问题,一般都是XML处理,不太喜欢,很麻烦。
<% Dim sc4Json Sub InitScriptControl Set sc4Json = Server.CreateObject("MSScriptControl.ScriptControl") sc4Json.Language = "JavaScript" sc4Json.AddCode "var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}" End Sub Function getJSONObject(strJSON) sc4Json.AddCode "var jsonObject = " & strJSON Set getJSONObject = sc4Json.CodeObject.jsonObject End Function Sub getJSArrayItem(objDest,objJSArray,index) On Error Resume Next sc4Json.Run "getJSArray",objJSArray, index Set objDest = sc4Json.CodeObject.itemTemp If Err.number=0 Then Exit Sub objDest = sc4Json.CodeObject.itemTemp End Sub Dim strTest strTest = "{name:""alonely"", age:24, email:[""ycplxl1314@163.com"",""ycplxl1314@gmail.com""], family:{parents:[""父亲"",""母亲""],toString:function(){return ""家庭成员"";}}}" Dim objTest Call InitScriptControl Set objTest = getJSONObject(strTest) %> <%=objTest.name%>的邮件地址是< %=sc4Json.Eval("jsonObject.email[0]")%><br />共有邮件地址< %=objTest.email.length%>个<br /> <% Dim father getJSArrayItem father, objTest.family.parents, 0 Response.Write father %>