标签归档：ASP

用FileDB快速开发生成静态系统

发表回复

最近要用到一套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

ASP文本存储方案-FileDB

1条回复

四月份做个一个短信系统，当时为了节省成本(使用万网的空间，不带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 定于数据存放在根目录，就会报错的错误

ASP版本 文件转十六进制

发表回复

最近接了一个彩信接口的网站，需要将 文本文件、图片文件 转换成 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，有些简陋，不过常用的功能都可以直接调用了。

<%
'==============================================================
'   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数据

发表回复

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
%>

ASP的Base64加密解密

发表回复

JS有Base64.js，PHP内建Base64支持，ASP处理Base64数据就没有那么幸运了，既没有Base64.asp，也没有内建的函数，这可怎么办？

ASP一般用到Base64的时候，都是处理二进制文件。简单的文本，就没有必要编码咯。ASP处理二进制又是一个弱项，有没有好的方法呢？xml中的bin.base64也许可以拿来用用。

'调用xml的编码，用于参照
function Base64Encode(strData)
    dim objAds,objXd
    set objAds=createobject("adodb.stream")
    objAds.Type=2
    objAds.charset="unicode"
    objAds.mode=3
    call objAds.open()
    objAds.writeText strData
    objAds.Position=0
    objAds.Type=1
    'objAds.Position=2

    set objXd=createobject("msxml.domdocument")
    call objXd.loadXml("<root/>")
    objXd.DocumentElement.DataType="bin.base64"
    objXd.DocumentElement.NodeTypedValue=objAds.read()
    Base64Encode=objXd.DocumentElement.text
end function

function Base64Decode(strData)
    dim objXd
    set objXd=createobject("msxml.domdocument")
    call objXd.loadXml("<root/>")
    objXd.DocumentElement.DataType="bin.base64"
    objXd.DocumentElement.text=strData
    Base64Decode=objXd.DocumentElement.NodeTypedValue
end function