淡水河边的博客 TinyButStrong中文教程 | PHP模板教程 | PHP视频

浏览模式: 标准 | 列表分类:网站|ASP备忘

ASP快速建成生成静态文件的网站发布系统

Submitted by on 2006, November 17, 8:34 AM

一、先进行技术原理分析

　　1、模板技术参看

　　2、如何使得ASP页面转变为HTML？一般都会想到FSO组件，因为该组件能新建任何文件格式。

　　那么其整个运行过程是怎么样的呢？

　　a、提供信息输入页面进行信息收集；

　　b、接受信息值先保存数据库，再FSO生成文件；

　　c、技术性完成任务，显示刚被创建的HTML文件的路径地址。该技术的实现过程中有如下几个难点：

　　i、FSO生成的文件是直接放在一个大文件夹下，还是单独放在某个每日更新的子文件夹中？可能表述不准确，这样理解吧：相信通过FSO生成的文件随着时间的推移，文件会越来越多，管理也会越来越乱……通常你可能看到一些地址诸如 www.xxx.com/a/2004-5-20/20... 可以分析得出应该是建立了当前日期的文件夹。这样，一天就是一个文件夹的页面内容，查看管理也就显得比较合理。

　　ii、我在试图通过以上方法建立文件夹的时候，又发现了第二个问题。第一次通过FSO建立以当前日期命名的文件夹，没有问题。当我有新的文件需要生成时，因为是同一个程序，所以，其又将会执行建立同样的文件夹。此时，FSO组件会发现该路径已存在……卡壳-_-! 继续处理，在首行添加代码：

　　引用:

On Error Resume Next
　　达到自欺欺人、掩耳盗铃的效果。

　　当然规矩的用法是判断文件夹的有无

代码:

<%
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if (fso.FolderExists(Server.MapPath(folder))) then
"判断如果存在就不做处理
else
"判断如果不存在则建立新文件夹
fso.CreateFolder(Server.MapPath(folder))
end if
%>

　　iii、文件夹是建立了，文件该如何建立呢？主要也就是文件名的生成。当然这个就需要自己来写个函数，功能就是如何生成文件名：

代码:

<%
function makefilename(fname)
fname = fname "前fname为变量，后fname为函数参数引用
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
makefilename = fname & ".html"
end function
%>

　　引用函数则：

代码:

<%fname = makefilename(now())%>

　　其实嘛，就是以年月日时分秒命名的文件。

　　iv、最后，生成的文件该如何查看到？当然需要把生成文件的路径保存的数据库中，并且添加到相对应的记录集中了。当然，这在下面的数据库设计时会提及到。

　　3、模板技术和2HTML技术的结合：将模板中特殊代码的值替换为从表单接受过来的值，完成模板功能；将最终替换过的所有模板代码生成HTML文件。需要注意的是：替换应能将输入数据的格式或者支持UBB的代码彻底改变。

二、再进行数据库设计

　　目前数据库的设计需要两个表：一个是存放模板数据的；一个是存放信息内容的。 1，建立新数据库asp2html.mdb

　　2、设计新数据库表c_moban

　　字段m_id（自动编号，主关键字）；字段m_html（备注类型）。

　　并将下列完整的代码拷贝至m_html字段

代码:

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=hz">
<title>Cnbruce.Com | ASP2HTML TEST</title>
</head>
<body leftmargin="0" topmargin="0">
<table width="100%" height="100%" border="0" cellpadding="5" cellspacing="2">
<tr align="right" bgcolor="#CCCCCC">
<td height="20" colspan="2">$cntop{LogContent}lt;/td>
</tr>
<tr valign="top">
<td width="25%" bgcolor="#e5e5e5">$cnleft{LogContent}lt;/td>
<td width="74%" bgcolor="#f3f3f3">$cnright{LogContent}lt;/td>
</tr>
</table>
</body>
</html>

　　3、设计新数据库表c_news

　　字段c_id：自动编号，主关键字
　　字段c_title：文本类型，保存文章标题
　　字段c_content：备注类型，保存文章内容
　　字段c_filepath：文本类型，保持生成文件的路径地址
　　字段c_time：日期/时间类型，默认值：Now()

　　三、页面需求设计

　　1、首先建立一个存放HTML页的文件夹

　　在文件同一目录下，建立文件夹newsfile，夹子内部主要存放生成的HTML页面，当然内部还会采用程序方式建立以日期命名的子文件夹，以方便浏览以及管理。

　　2、功能函数页面lib.asp

代码:

<%
"生成文件名的函数
function makefilename(fname)
fname = fname
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
makefilename=fname & ".shtml"
end function

"保持数据格式不变的函数
function HTMLEncode(fString)
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "<br>")
fString = Replace(fString, CHR(10), "<br>")
HTMLEncode = fString
end function
%>

　　3、数据库连接页面conn.asp

　　完成数据库的字符串连接方法

代码:

<%
set conn = Server.CreateObject("ADODB.Connection")
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath("asp2html.mdb")
conn.Open connstr
%>

　　4、信息输入页面add.html

　　其实很简单，就是表单嘛。注意action是跳转到addit.asp

代码:

<form action="addit.asp" method="post">
Title:<input type="text" name="c_title"><br>
Content:<br>
<textarea name="c_content" rows="8" cols="30"></textarea><br>
<input type="submit" value="Add">
<input type="reset" value="Reset">
</form>

　　5、处理数据功能显示页面addit.asp

　　首先是处理接受过来的数据，并将值写入数据库；接着将模板代码进行引用，并将其中特殊代码转换为接受值，最终通过FSO生成HTML页面。其中需要注意的还有，生成文件的路径地址保存至数据库表。

代码:

<%"容错处理
On Error Resume Next
%>




<%"接受传递值
c_title=request.form("c_title")
c_content=request.form("c_content")
%>

<%"生成HTML文件名，建立文件夹，指定文件路径
fname = makefilename(now()) "makefilename为自定义函数
folder = "newsfile/"&date()&"/"
filepath = folder&fname
%>

<%"将接受值及路径保持至数据库表
sql = "Select * from c_news"
Set rs = Server.CreateObject ("ADODB.Recordset")
rs.Open sql,conn,3,2
rs.addnew
rs("c_title")=c_title
rs("c_content")=c_content
rs("c_filepath")=filepath
rs.update
rs.close
Set rs = Nothing
%>

<%"打开模板代码，并将其中特殊代码转变为接受值
sql1="select m_id,m_html from c_moban where m_id=1"
set rs1=Server.CreateObject("adodb.recordset")
rs1.open sql1,conn,1,1
mb_code=rs1("m_html")
rs1.close
set rs1=nothing
conn.close
set conn=nothing
c_title=htmlencode(c_title)
c_content=htmlencode(c_content)
mb_code=replace(mb_code,"$cntop{LogContent}quot;,now())
mb_code=replace(mb_code,"$cnleft{LogContent}quot;,c_title)
mb_code=replace(mb_code,"$cnright{LogContent}quot;,c_content)
%>

<%"生成HTML页面
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(folder))
Set fout = fso.CreateTextFile(Server.MapPath(filepath))
fout.WriteLine mb_code
fout.close
%>
文章添加成功，<a href="showit.asp">浏览</a>

6、显示数据库表记录，并做指向HTML页的链接：showit.asp

代码:

<%
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from c_news order by c_id desc"
rs.Open sql,conn,1,1
%>

<%
if rs.EOF and rs.BOF then
response.write ("暂时还没有文章，<a href=add.html>添加</a>")
else
Do Until rs.EOF
%>
<table width="758" border="0" align="center" cellpadding="3" cellspacing="1" bgcolor="#000000">
<tr>
<td width="159" align="right" bordercolor="#CCCCCC" bgcolor="#CCCCCC"><%=rs("c_time")%></td>
<td width="591" bordercolor="#f3f3f3" bgcolor="#f3f3f3"><a href=<%=rs("c_filepath")%> target="a_blank"><%=rs("c_title")%></a></td>
</tr>
<tr>
<td valign="top" align="right" bordercolor="#ececec" bgcolor="#ececec">[<a href=del.asp?c_id=<%=rs("c_id")%>>Dell</a>][<a href=change.asp?c_id=<%=rs("c_id")%>>Edit</a>][<a href="add.html">Add</a>]</td>
<td valign="top" bordercolor="#FFFFFF" bgcolor="#FFFFFF"><%=htmlencode(rs("c_content"))%></td>
</tr>
</table><br>
<%
rs.MoveNext
Loop
end if
%>

<%
rs.close
Set rs = Nothing
conn.close
set conn=Nothing
%>

　　7、修改数据内容页change.asp

　　修改数据内容，同时也需要修改更新对应的HTML页面。修改其实就是重新生成文件，且文件名和之前一样，类似文件的覆盖。

代码:

<%id=request.querystring("c_id")%>

<%
if request.form("submit")="change" then
c_title=request.form("c_title")
c_content=request.form("c_content")
c_id=request.form("c_id")
c_filepath=request.form("c_filepath")

Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from c_news where c_id="&c_id
rs.Open sql,conn,3,2
rs("c_title")=c_title
rs("c_content")=c_content
rs("c_time")=now()
rs.update
rs.close
Set rs = Nothing
%>

<%"打开模板代码，并将其中特殊代码转变为接受值
sql1="select m_id,m_html from c_moban where m_id=1"
set rs1=Server.CreateObject("adodb.recordset")
rs1.open sql1,conn,1,1
mb_code=rs1("m_html")
rs1.close
set rs1=nothing
conn.close
set conn=nothing
c_title=htmlencode(c_title)
c_content=htmlencode(c_content)
mb_code=replace(mb_code,"$cntop{LogContent}quot;,now())
mb_code=replace(mb_code,"$cnleft{LogContent}quot;,c_title)
mb_code=replace(mb_code,"$cnright{LogContent}quot;,c_content)
%>

<%"生成HTML页面
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(Server.MapPath(c_filepath))
fout.WriteLine mb_code
fout.close
%>
<%response.redirect("showit.asp")%>
<%end if%>

<%
if id<>"" then
Set rs = Server.CreateObject ("ADODB.Recordset")
sql="select * from c_news where c_id="&id
rs.Open sql,conn,1,1
c_id=rs("c_id")
c_filepath=rs("c_filepath")
c_title=rs("c_title")
c_content=rs("c_content")
end if
%>

<form action="change.asp" method="post">
Title:<input type="text" name="c_title" value=<%=c_title%>><br>
Content:<br>
<textarea name="c_content" rows="8" cols="30"><%=c_content%></textarea><br>
<input type="submit" value="change" name="submit">
<input type="reset" value="Reset">
<input name="c_id" type="hidden" value="<%=id%>">
<input name="c_filepath" type="hidden" value="<%=c_filepath%>">
</form>

　　8、删除记录页del.asp

　　同样！删除，除了删除数据库表中的记录，与其对应的HTML页面也需删除。代码如下：

代码:

<%
c_id = request.querystring("c_id")
sql = "Select * from c_news where c_id="&c_id
Set rs = Server.CreateObject ("ADODB.Recordset")
rs.Open sql,conn,2,3

filepath=rs("c_filepath")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Server.mappath(filepath))
Set fso = nothing

rs.delete
rs.close
Set rs = Nothing
conn.close
set conn=nothing
%>

<%response.redirect("showit.asp")%>

　　四、其它功能

　　模板管理页面：

　　不会每次都是打开数据库表进行增加或者修改模板代码吧，所以，管理代码的页面程序不能少了，自己捣鼓下应该很简单的。当然，之前管理员的登录认证程序就不在书中交代了：）还有，如果设计了多个模板，那么在发表信息的时候应添加模板选择单选框，同样在执行转换HTML时，SQL选择的不同m_id了。

　　不管怎么说，先把这些技术自己调试感受下。多多操作，相信“读书千遍，其意自见”。

Tags: tohtml

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1329

10秒后自动关闭

Submitted by on 2006, November 17, 4:57 AM

ie6适用。ie7没有测试过。

» 阅读全文

Tags: js

网站|ASP备忘 | 评论:2 | Trackbacks:0 | 阅读:1728

整理了一个editplus的剪辑文件（ASP方面的内容）

Submitted by on 2006, November 17, 4:15 AM

把下列代码保存成任意名称的.ctl文件（*.ctl），放到EditPlus的安装目录即可
效果见：

代码:

#TITLE=ASP常用语法及函数
#INFO
ASP常用的一些语法及自定义函数
#SORT=n

#T= ===ASP常用语法===
#T=============================
#T=数据库相关
#T=　连接ACCESS数据库
<%
Dim DBName,Conn
DBName"^!"    "定义数据库路径及名称
SET Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DBName)
%>

#T=　连接MS SQL数据库
<%
Dim Conn
SET Conn=Server.CreateObject("ADODB.connection")
Conn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服务器名称或IP地址;UID=数据库登录帐号;PWD=数据库密码;DATABASE=数据库名称"
%>

#T=　建立记录集
SET ^!=Server.CreateObject("ADODB.recordset")

#T=　执行SQL命令
RS.Open SQL,conn,1,1

#T=　执行SQL命令
Conn.Execute("^!")

#T=　RS直接执行SQL命令
SET RS = Conn.Execute("^!")

#T=　关闭记录集
RS.CLOSE
SET RS=NOTHING

#T=　关闭数据库
Conn.Close
SET Conn=Nothing

#T=============================
#T=ServerVariables相关
#T=　取上一页地址
Request.ServerVariables("HTTP_REFERER")

#T=　取服务器的名称1
Request.ServerVariables("SERVER_NAME")

#T=　取服务器的名称2
Request.ServerVariables("HTTP_HOST")

#T=　取服务器IP
Request.ServerVariables("LOCAL_ADDR")

#T=　取用户IP
Request.ServerVariables("Remote_Host")

#T=　取用户真实IP1
Request.serverVariables("REMOTE_ADDR")

#T=　取用户真实IP函数
Function GetRealIP()
    GetRealIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    IF(GetRealIP = "")THEN GetRealIP = Request.ServerVariables("REMOTE_ADDR")
End Function

#T=　取服务器端口
Request.ServerVariables("SERVER_PORT")

#T=　取服务器操作系统
Request.ServerVariables("OS")

#T=　取服务器的绝对路径
Request.ServerVariables("APPL_PHYSICAL_PATH")

#T=　取本文件的绝对路径1
Requet.ServerVariables("PATH_TRANSLATED")

#T=　取本文件的绝对路径2
Server.mappath(Request.ServerVariables("SCRIPT_NAME"))

#T=　取本文件的相对路径1
Request.ServerVariables("URL")

#T=　取本文件的相对路径2
Request.ServerVariables("SCRIPT_NAME")

#T=　取本文件的相对路径3
Request.ServerVariables("PATH_INFO")

#T=　取地址栏后的参数
Request.ServerVariables("QUERY_STRING")

#T=　取服务器系统信息
Request.ServerVariables("HTTP_USER_AGENT")

#T=　服务器组件检测
<%
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    SET xTestObj = Server.CreateObject(strClassString)
    IF(0 = Err)THEN IsObjInstalled = True
    SET xTestObj = Nothing
    Err = 0
End Function
"IF(IsObjInstalled("Persits.Upload")=True)THEN
"    Response.Write "支持AspUpload组件"
"ELSE
"    Response.Write "不支持AspUpload组件"
"END IF
%>

#T=　取客户端语言环境
^!Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")

#T=　取客户端信息:HTTP_USER_AGENT
^!Request.ServerVariables("HTTP_USER_AGENT")

#T=　取表单(Form)值元素值
Request.Form("^!")

#T=　取URL传递的值
Request.QueryString("^!")

#T=　取完整URL地址
Function GetUrl()
    GetUrl="http://"&R... ... .ServerVariables("URL")
    IF(Request.ServerVariables("QUERY_STRING")<>"")THEN GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function

#T=============================
#T=自定义函数
#T=　过滤HTML字符
<%
"过滤HTML字符函数
Function HTMLEncode(str)
    IF(str <> "")THEN
        str = Replace(str, "&", "&amp;")
        str = Replace(str, ">", "&gt;")
        str = Replace(str, "<", "&lt;")
        str = Replace(str, Chr(32), "&nbsp;")
        str = Replace(str, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
        str = Replace(str, Chr(34), "&quot;")
        str = Replace(str, Chr(39), "&#39;")
        str = Replace(str, Chr(13), "")
        str = Replace(str, Chr(10) & Chr(10), "</P><P>")
        str = Replace(str, Chr(10), "<BR>")
        str = Replace(str, Chr(255), "&nbsp;")
    END IF
    HTMLEncode = str
End Function
%>

#T=　检测上页是否从本站提交
<%
"检测上页是否从本站提交
"返回:True,False
"===============================================================
Function IsSelfRefer()
    Dim sHttp_Referer, sServer_Name
    sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
    sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
    IF(Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name)THEN
        IsSelfRefer = True
    ELSE
        IsSelfRefer = False
    END IF
End Function
%>

#T=　清除所有HTML标记
<%
"清除HTML标记
Function stripHTML(htmlStr)
    Dim regEx
    SET regEx = New Regexp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = "<.+?>"
    htmlStr = regEx.Replace(htmlStr,"")
    htmlStr = Replace(htmlStr, "<","&lt;")
    htmlStr = Replace(htmlStr, ">","&gt;")
    htmlStr = Replace(htmlStr,chr(10),"")
    htmlStr = Replace(htmlStr,chr(13),"")
    stripHTML = htmlStr
    SET regEx = Nothing
End Function

%>

#T=　取字符串长度
<%
"求字符串长度函数
Function GetLength(str)
    Dim Length
    For i=1 to Len(str)
        IF(Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256)THEN
            Length=Length+2
        ELSE
            Length=Length+1
        END IF
    Next
    GetLength=Length
End Function
%>

#T=　截取指定长度字符串
<%
"截取指定长度的字符串，多余的用...代替
Function StrLeft(str,strlen)
    IF(str = "")THEN
        StrLeft = ""
        Exit Function
    END IF
    Dim l,t,c,i
    str = Replace(Replace(Replace(Replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
    l=len(str)
    t=0
    For i=1 to l
        c=Abs(Asc(Mid(str,i,1)))
        IF(c>255)THEN
            t=t+2
        ELSE
            t=t+1
        END IF
        IF(t>strlen)THEN
            StrLeft = left(str,i) & "..."
            Exit For
        ELSE
            StrLeft = str
        END IF
    Next
    StrLeft = Replace(Replace(Replace(Replace(StrLeft," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
End Function
%>

#T=　获取安全的提交参数
<%
"===============================================================
"SQL Injection Check
"函数功能：过滤字符参数中的单引号，对于数字参数进行判断，如果不是数值类型，则赋值0
"参数意义：str ---- 要过滤的参数
"strType ---- 参数类型，分为字符型和数字型，字符型为"s"，数字型为"i"
"===============================================================
Function CheckStr(str,strType)
    Dim strTmp
    strTmp = ""
    IF(strType ="s")THEN
        strTmp = Replace(Trim(str),""","""")
    ELSEIF(strType="i")THEN
        IF(IsNumeric(str)=False)THEN str=False
        strTmp = str
    ELSE
        strTmp = str
    End IF
    CheckStr= strTmp
End Function
%>

#T=　过滤不良字符(BadWord)
<%
"过滤不良字符(BadWords)
Function ChkBadWords(fString)
    Dim BadWords,bwords,i
    BadWords = "我操|操你|操他|你妈的|他妈的|狗|杂种|屄|屌|王八|强奸|做爱|处女|泽民|法轮|法伦|洪志|法輪"
    IF(Not(IsNull(BadWords) or IsNull(fString)))THEN
    bwords = Split(BadWords, "|")
    For i = 0 to UBound(bwords)
        fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
    Next
    ChkBadWords = fString
    END IF
End Function
%>

#T=　生成随机自定义长度密码
<%
"生成随机自定义长度密码
Function makePassword(maxLen)
    Dim strNewPass
    Dim whatsNext, upper, lower, intCounter
    Randomize
    For intCounter = 1 To maxLen
        whatsNext = Int((1 - 0 + 1) * Rnd + 0)
        IF(whatsNext = 0)THEN
        "character
            upper = 90
            lower = 65
        ELSE
            upper = 57
            lower = 48
        END IF
        strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
    Next
    makePassword = strNewPass
End Function
"Response.Write makepassword(8)
%>

#T=　填入Textarea时保持格式inHTML
<%
"===============================================================
"去除Html格式，用于从数据库中取出值填入输入框时
"注意：value="?"这边一定要用双引号
"===============================================================
Function inHTML(str)
     Dim sTemp
     sTemp = str
     inHTML = ""
     If IsNull(sTemp) = True Then
        Exit Function
     End If
     sTemp = Replace(sTemp, "&amp;", "&")
     sTemp = Replace(sTemp, "<br>",chr(13))
     sTemp = Replace(sTemp, "&lt;", "<")
     sTemp = Replace(sTemp, "&gt;", ">")
     sTemp = Replace(sTemp, "&quot;", Chr(34))
     inHTML = sTemp
End Function
%>

#T=　正则表表达式验证函数
<%
"正则表表达式验证函数 patrn-正则表达式　strng-需要验证的字符串
"===============================================================
Function RegExpTest(patrn, strng)
    Dim regEx, retVal " 建立变量。
    SET regEx = New RegExp " 建立正则表达式。
    regEx.Pattern = patrn " 设置模式。
    regEx.IgnoreCase = False " 设置是否区分大小写。
    retVal = regEx.Test(strng) " 执行搜索测试。
    RegExpTest = retVal "返回值，不符合就返回false，符合为true
    SET regEx = NOTHING
End Function
%>

#T=　生成随机字符串
<%
"生成随机字符串
Function RndCode()
    Dim CodeSet,AmountSet
    CodeSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
    AmountSet = 62 " 文字数量
    Randomize

    Dim vCode(10), vCodes,i
    For i = 0 To 9
      vCode(i) = Int(Rnd * AmountSet)
      vCodes = vCodes & Mid(CodeSet, vCode(i) + 1, 1)
    Next
    RndCode=vCodes
End Function
%>

#T=============================
#T=FSO相关操作
#T=　判断目录是否存在
<%
Function IsFloderExist(strFolderName)
    SET FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF(FSO.FolderExists(strFolderName))THEN
        IsFloderExist = True
    ELSE
        IsFloderExist = False
    END IF
    SET FSO=NOTHING
End Function
%>

#T=　创建目录
<%
Function CreateFolder(strFolderName)
    SET FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF(FSO.FolderExists(strFolderName) = False)THEN
        FSO.CreateFolder(strFolderName)
    END IF
    SET FSO=NOTHING
END Function
%>

#T=　删除目录
<%
Function DeleteFolder(strFolderName)
    SET FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF(FSO.FolderExists(strFolderName))THEN
        FSO.DeleteFolder(strFolderName)
    END IF
    SET FSO=NOTHING
END Function
%>

#T=　判断文件是否存在
<%
Function IsFileExist(strFileName)
    SET FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF(FSO.FileExists(strFileName))THEN
        IsFileExist = True
    ELSE
        IsFileExist = False
    END IF
    SET FSO=NOTHING
End Function
%>

#T=　删除文件
<%
Function DeleteFile(strFileName)
    SET FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF(FSO.FileExists(strFileName))THEN
        FSO.DeleteFile(strFileName)
    END IF
    SET FSO=NOTHING
END Function
%>

#T=============================
#T=　ASP小偷常用的几个函数
<%
Function ByteToStr(vIn)
    Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
    strReturn = ""
    For i = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn,i,1))
        IF(ThisCharCode < &H80)THEN
            strReturn = strReturn & Chr(ThisCharCode)
        ELSE
            NextCharCode = AscB(MidB(vIn,i+1,1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            i = i + 1
        END IF
    Next
    ByteToStr = strReturn
End Function

Function GetHttpPageContent(url,Method,SendStr)
    Dim Retrieval
    SET Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open Method, url, False ,"" ,""
        .setRequestHeader "Content-Type","application/x-www-form-urlencoded"
        .Send(SendStr)
        GetHttpPageContent = .ResponseBody
    End With
    SET Retrieval = Nothing
    GetHttpPageContent=ByteToStr(GetHttpPageContent)
End Function

Function RegExpText(strng,regStr)
    Dim regEx,Match,Matches,RetStr
    SET regEx = New RegExp
    regEx.Pattern = regStr
    regEx.IgnoreCase = True
    regEx.Global = True
    SET Matches = regEx.Execute(strng)
    For Each Match in Matches
        RetStr = RetStr & regEx.Replace(Match.Value,"$1") & ","
    Next
    RegExpText = RetStr
    set regEx=nothing
End Function

Function StreamBytesToBstr(strBody, CodeBase)
Dim objStream
SET objStream = Server.CreateObject("Adodb.Stream")
With objStream
    .Type = 1
    .Mode = 3
    .Open
    .Write strBody
    .Position = 0
    .Type = 2
    .Charset = CodeBase
    StreamBytesToBstr = .ReadText
    .Close
End With
SET objStream = Nothing
End Function
%>

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1081

支持多风格变换的ASP分页类

Submitted by on 2006, November 17, 3:38 AM

这个分页使用的是0游标，也就是Rs.Open Sql,Conn,0,1。但是感觉也快不了多少，10
万条数据的分页时间300多豪秒之间

代码:

<%
"******************************
"名称：分页类
"日期：2005/12/3
"作者：西楼冷月
"网址：www.xilou.net | www.chinaCMS.org
"描述：无
"版权：转载请注名出处，作者
"******************************
Class Page
Private CurrPage
Private PageN
Private UrlStr
Private TempStr
Private ErrInfo
Private IsErr
Private TotalRecord
Private TotalPage
Public  PageRs

Private TempA(11)
Private TempB(8)
"------------------------------------------------------------
Private Sub Class_Initialize()
      CurrPage=1"//默认显示当前页为第一页
      PageN=10"//默认每页显示10条数据
      UrlStr="#"
      TempStr=""
      ErrInfo="ErrInfo:"
      IsErr=False
End Sub
Private Sub Class_Terminate()
      If IsObject(PageRs) Then
            PageRs.Close
            Set PageRs=Nothing
      End If
      Erase TempA
      Erase TempB
End Sub
"----------------------------------------------------------
"//获取当前页码
Public Property Let CurrentPage(Val)
      CurrPage=Val
End Property
Public Property Get CurrentPage()
      CurrentPage=CurrPage
End Property
"//获取每页显示条数
Public Property Let PageNum(Val)
      PageN=Val
End Property
Public Property Get PageNum()
      PageNum=PageN
End Property
"//获取URL
Public Property Let Url(Val)
      UrlStr=Val
End Property
Public Property Get Url()
      Url=UrlStr
End Property
"//获取模板
Public Property Let Temp(Val)
      TempStr=Val
End Property
Public Property Get Temp()
      Temp=TempStr
End Property
"------------------------------------------------------------

Public Sub Exec(Sql,ConnObj)
      On Error Resume Next
      Set PageRs=Server.CreateObject("ADODB.RecordSet")
      PageRs.CursorLocation = 3 "使用客户端游标，可以使效率提高
      PageRs.PageSize = PageN "定义分页记录集每页显示记录数
      PageRs.Open Sql,ConnObj,0,1
      If Err.Number<>0 Then
        Err.Clear
     PageRs.Close
     Set PageRs=Nothing
        ErrInfo=ErrInfo&"建立或打开记录集错误..."
     IsErr=True
     Response.Write ErrInfo
     Response.End
      End If
      TotalRecord=PageRs.RecordCount"//如果为0呢？
      If TotalRecord>=1 Then
      "----------------------------------------------------------------------------开始
      "//计算总页数,Ps,为什么不用PageRs.PageCount呢？
      "If TotalRecord Mod PageN=0 Then
        "TotalPage=PageRs.RecordCount\PageN
      "Else
        "TotalPage=PageRs.RecordCount\PageN
     "TotalPage=Abs(Int(TotalPage))
      "End If
   TotalPage=PageRs.PageCount
      "//处理当前接收页码,默认的为1，所以不是数字类型的都会为1
      If IsNumeric(CurrPage) Then
         CurrPage=CLNg(CurrPage)
         If CurrPage<1 Then CurrPage=1
      If CurrPage>TotalPage Then CurrPage=TotalPage
      Else
            "//Dim M:M="":IsNumeric(M)=True
         CurrPage=1
      End If
      "---------------------------------------------------------------------------结束
      Else
         TotalPage=0
         CurrPage=1
      End If
      "//
      PageRs.AbsolutePage = CurrPage "absolutepage：设置指针指向某页开头
      PageRs.PageSize=PageN
End Sub
Private Sub Init()
      "Private TempA(10)
      TempA(1)="{N1}" "//首页
      TempA(2)="{N2}""//上一页
      TempA(3)="{N3}""//下一页
      TempA(4)="{N4}""//尾页
      TempA(5)="{N5}""//当前页码
      TempA(6)="{N6}""//页码总数
      TempA(7)="{N7}""//每页条数
      TempA(8)="{N8}""//文章总数
      TempA(9)="{L}""//循环标签开始
      TempA(10)="{N}""//循环内单标签：页码
      TempA(11)="{L/}""//循环标签结束
      "Private TempB(8)
      TempB(1)="首页"
      TempB(2)="上一页"
      TempB(3)="下一页"
      TempB(4)="尾页"
      TempB(5)=CurrPage"//当前页码
      TempB(6)=TotalPage"//页码总数
      TempB(7)=PageN"//每页条数
      TempB(8)=TotalRecord"//文章总数
End Sub
Public Sub Show(Style)
      If IsErr=True Then
        Response.Write ErrInfo
     Exit Sub
      End If

      Call Init()
      Select Case Style
      Case 1
         Response.Write StyleA()
      Case 2
         Response.Write StyleB()
      Case 3
         Response.Write StyleC()
      Case 4
         Response.Write StyleD()
      Case Else
         ErrInfo=ErrInfo&"不存在当前样式..."
      Response.Write ErrInfo
      End Select
End Sub
Public Function ShowStyle(Style)
      If IsErr=True Then
        ShowStyle=ErrInfo
     Exit Function
      End If

      Call Init()
      Select Case Style
      Case 1
         ShowStyle= StyleA()
      Case 2
         ShowStyle= StyleB()
      Case Else
         ErrInfo=ErrInfo&"不存在当前样式..."
  ShowStyle=ErrInfo
      End Select
End Function

Private Function StyleA()
"首页上一页下一页尾页  本页为第1/20页，共20页，每页10条，文章总数200条
"//分页样例：[首页] [上页] [下页] [尾页] [页次：4/5页] [共86篇 20篇/页] 转到：_ 页
"//标签：{N1} {N2} {N3} {N4} || 共:{N8}条记录 {N6}页当前为第{N5}页每页{N7}条
If IsEmpty(TempStr) Then
      ErrInfo=ErrInfo&"模板为空..."
      StyleB=ErrInfo
      Exit Function
End If
Dim M
If TotalPage>1 Then
      If CurrPage>1 Then
        M="<a href=""&UrlStr&"Page=1">"&"首页"&"</a>"
     TempStr=Replace(TempStr,"{N1}",M)
     M="<a href=""&UrlStr&"Page="&CurrPage-1&"">"&"上一页"&"</a>"
     TempStr=Replace(TempStr,"{N2}",M)
     If CurrPage<TotalPage Then
       M="<a href=""&UrlStr&"Page="&CurrPage+1&"">"&"下一页"&"</a>"
    TempStr=Replace(TempStr,"{N3}",M)
    M="<a href=""&UrlStr&"Page="&TotalPage&"">"&"尾页"&"</a>"
          TempStr=Replace(TempStr,"{N4}",M)
        Else
       TempStr=Replace(TempStr,"{N3}","下一页")
    TempStr=Replace(TempStr,"{N4}","尾页")
     End If
      Else
        TempStr=Replace(TempStr,"{N1}","首页")
     TempStr=Replace(TempStr,"{N2}","上一页")
        M="<a href=""&UrlStr&"Page="&CurrPage+1&"">"&"下一页"&"</a>"
     TempStr=Replace(TempStr,"{N3}",M)
     M="<a href=""&UrlStr&"Page="&TotalPage&"">"&"尾页"&"</a>"
        TempStr=Replace(TempStr,"{N4}",M)
      End If
Else
      TempStr=Replace(TempStr,"{N1}","首页")
      TempStr=Replace(TempStr,"{N2}","上一页")
      TempStr=Replace(TempStr,"{N3}","下一页")
      TempStr=Replace(TempStr,"{N4}","尾页")
End If
T=TempStr
T=Replace(T,"{N8}",TotalRecord)
T=Replace(T,"{N6}",TotalPage)
T=Replace(T,"{N5}",CurrPage)
T=Replace(T,"{N7}",PageN)
TempStr=T
StyleA=TempStr
End Function

Private Function StyleB()
"首页 |< 1 2 3 4 5 6 7 >| 尾页
"//标签:{N1} {N2} {L}{N}{L/}{N3}{N4}
If IsEmpty(TempStr) Then
      ErrInfo=ErrInfo&"模板为空..."
      StyleB=ErrInfo
      Exit Function
End If
Dim ForceNum,BackNum"//当前页的前面和后面显示个数
ForceNum=5
BackNum=4
Dim M
"//首页
M="<a href=""&UrlStr&"Page=1">"&TempB(1)&"</a>"
TempStr=Replace(TempStr,"{N1}",M)
"//尾页
M="<a href=""&UrlStr&"Page="&TempB(6)&"">"&TempB(4)&"</a>"
TempStr=Replace(TempStr,"{N4}",M)
"//前一页
M="|<"
If CurrPage-1>=1 Then
      M="<a href=""&UrlStr&"Page="&CurrPage-1&"">"&"|<"&"</a>"
End If
TempStr=Replace(TempStr,"{N2}",M)
"//后一页
M=">|"
If CurrPage+1<=TotalPage Then
      M="<a href=""&UrlStr&"Page="&CurrPage+1&"">"&">|"&"</a>"
End If
TempStr=Replace(TempStr,"{N3}",M)
"//取出循环标签
Dim N1,N2,N3,N4,N5,N6
If InStr(TempStr,"{L}")>0 Then
      N1=InStr(TempStr,"{L}")
End If
If InStr(TempStr,"{L/}")>0 Then
      N2=InStr(TempStr,"{L/}")
End If
If N2<=N1 Then
      ErrInfo=ErrInfo&"循环标签出错..."
      StyleB=ErrInfo
      Exit Function
End If
N3=Mid(TempStr,N1,N2-N1+4)"//储存包括{L}{L/}循环标签的模板
N4=Replace(N3,"{L}","")"//储存不包括{L}{L/}循环标签的模板
N4=Replace(N4,"{L/}","")
"//页码列表
Dim FirstPageNum,LastPageNum
If CurrPage-ForceNum<=1 Then
   FirstPageNum=1
   PageList=""
Else
   FirstPageNum=CurrPage-ForceNum
   PageList="... ..."
End If
If CurrPage+BackNum>=TotalPage Then
   LastPageNum=TotalPage
   PageList_2=""
Else
   LastPageNum=CurrPage+BackNum
   PageList_2="... ..."
End If
Dim I
For I=FirstPageNum To LastPageNum
      If I=CurrPage Then
        N5=Replace(N4,"{N}","<b>"&I&"</b>")
     N6=N6&N5
      Else
        M="<a href=""&UrlStr&"Page="&I&"">"&I&"</a>"
     N5=Replace(N4,"{N}",M)
     N6=N6&N5
      End If
Next
TempStr=Replace(TempStr,N3,N6)
StyleB=TempStr
End Function

Private Function StyleC()
"首页 |< |<< 1 2 3 4 5 6 7 >>| >| 尾页
"//此风格在StyleB的基础上修改，增加两个标签：{N9}上10页 {N10}下10页
"//标签:{N1}{N2}{N9}{L}{N}{L/}{N10}{N3}{N4}
Dim T
T=StyleB()
"//前十页
M="|<<"
If CurrPage-10>=1 Then
      M="<a href=""&UrlStr&"Page="&CurrPage-10&"">"&"|<<"&"</a>"
End If
T=Replace(T,"{N9}",M)
M=">>|"
If CurrPage+10<=TotalPage Then
      M="<a href=""&UrlStr&"Page="&CurrPage+10&"">"&">>|"&"</a>"
End If
T=Replace(T,"{N10}",M)
StyleC=T
End Function

Private Function StyleD()
"//此风格在StyleC的基础上修改
"//共{N8}条记录 {N6}页当前为第{N5}页每页{N7}条
"//首页 |< |<< 1 2 3 4 5 6 7 >>| >| 尾页
"//标签:{N1}{N2}{N9}{L}{N}{L/}{N10}{N3}{N4}
Dim T
T=StyleC()
T=Replace(T,"{N8}",TotalRecord)
T=Replace(T,"{N6}",TotalPage)
T=Replace(T,"{N5}",CurrPage)
T=Replace(T,"{N7}",PageN)
StyleD=T
End Function

End Class
%>

调用示例：

代码:

Set test = New Page
test.CurrentPage=request.QueryString("page") "自己去读取拉
test.temp="{N1} {N2} {L} {N} {L/} {N3} {N4}"
test.Exec "Select * From tblname",conn
test.Show 4 "调用第四种风格显示分页
test.PageNum = 5

用模板设置风格不错。只是没有把读取记录集封装进去，不太好。不用。

Tags: 分页, ASP类

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1099

6行代码实现无组件上传(打自己嘴巴,只能用在本地)

Submitted by on 2006, November 13, 8:46 PM

淡水河边这厮特别提示!!!这个程序只能在本地上传(拷贝)，无法实现远程上传，上传的时候程序先是获取文件路径，然后就对文件进行复制，获取的路径是本地的(例:C:/MYPIC.JPG)，所以在用在远程服务器上时,远程的服务器上并没有你本地上的文件(服务器上并没有C:/MYPIC.JPG),所以上传的时候就出现文件不能打开出现"adodb.stream 错误 800a0bba".不过PHP到是有这样简单的方法

  目前有很多无组件上传类，我大概看了一下，大多写的相当复杂，有的居然还只能传文本
  最关键的是没有10行代码以下的：）
  我花了一个晚上时间研究了一下ADODB.Stream，并且用了6行代码实现了无组件上传：

代码:

  strFileName = Request.QueryString("file1")
  Set objstream = Server.CreateObject("ADODB.Stream")
  objstream.Type = 1 " adTypeBinary
  objstream.Open
  objstream.LoadFromFile strFileName
  objstream.SaveToFile Server."123_onweb.gif",2

  使用方法：

  把上面的代码写成upload.asp
  在浏览器里面输入：
  http://XXX/upload.asp?file...\上传文件\123.gif
  XXX为你的主机地址
  执行完后你会看到你的目录下面多了一个123_onweb.gif
  他就是你要文件拉！！！！

  根据原理我们可以扩展以下代码：
  upload.asp文件

代码:

  <%
  Function GetFileName(ByVal strFile)
  If strFile <> "" Then
   GetFileName = mid(strFile,InStrRev(strFile, "\")+1)
  Else
   GetFileName = ""
  End If
  End  function

  strFileName = Request.Form("file1")
  Set objstream = Server.CreateObject("ADODB.Stream")
  objstream.Type = 1 " adTypeBinary
  objstream.Open
  objstream.LoadFromFile strFileName
  objstream.SaveToFile Server.MapPath(GetFileName(strFileName)),2
  objstream.Close
  %>

upload.htm文件

代码:

注，淡水河边这厮提示一下，要有权限。没有权限会出错的。当然，这段代码用“ADODB.Stream”。有些杀软可能会报毒。可以用"ADODB"&"."&"Stre"&"am"方法代替

Tags: 无组件上传

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1111

ASP彩色校验码的制作！！！！(幻想剑)

Submitted by on 2006, November 11, 8:52 PM

要读懂这些代码主要是要了解ASP中操作二进制数据的对象ADODB.Stream！本程序主要用的就是Adodb.Stream，如果你有这个基础，就可以进一步添加更多的功能如加入杂点，渐变底色，数字行列错位，笔画短点，提高被ocr识别的不可能。目前还没有好的识别引擎,昨天下载了个号称能识别图像验证码90%的！把4321识别成 89910,所以图像码还是比较安全的。

在网上看到有暴力破解的方法，如果我用图像附加码+禁止外部提交+10次密码错误封帐号 +50次密码错误琐死IP+10秒的防刷新间隔注册页，登陆页均要加上+禁止外部提交，这样,暴力破解应该就没戏了。

ASP文件：Code.ASP
数据文件：body.Fix , Head.Fix
用法：<img src="http://www.xxx.com/code.AS...

代码:

Response.buffer = true
NumCode

Function NumCode()
Response.Expires = -1
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
dim zNum,i,j
dim Ados,Ados1
Randomize timer
"生成随机四位数字：
zNum = cint(8999*Rnd+1000)
"传递给session
Session("GetCode") = zNum
"该for循环是将随机数字放入一个下标3的数组，便于提供给后面的阵列变换
dim zimg(3),NStr
NStr=cstr(zNum)
For i=0 to 3
zimg(i)=cint(mid(NStr,i+1,1))
Next
dim Pos

"定义二个 ADODB.Stream binary对象,作图像数据操作之用:

set Ados=Server.CreateObject("Adodb.Stream")
Ados.Mode=3
Ados.Type=1
Ados.Open
set Ados1=Server.CreateObject("Adodb.Stream")
Ados1.Mode=3
Ados1.Type=1
Ados1.Open
"载入0~9的数字数据10x100的，Gbr的阵列数据,每个320字节,10个数字3200byte
"BGR一个点,10x10个点一个数字，一个点三个字节(二进制8位，16进制 00~FF)
"一行10个点 30字节 + 行结束标记 00 00 二字节 32字节，所以一个10x100宽小于长的图像每个数字10x10是320字节
"长大于宽的则无行结束标记 0000,直接是300字节
"这些就是BMP 24bit的数据详细信息了
"至于头部，也很简单，包含长宽，图像开始标记等等~~才54字节，远没jpg什么的复杂

Ados.LoadFromFile(Server.mappath("body.Fix"))
Ados1.write Ados.read(1280)
"第一个for循环,按生成的随机数字顺序从 10X100的数字阵列中提取出相应的四个数字
"但是竖排的数字阵列
for i=0 to 3
Ados.Position=(9-zimg(i))*320
Ados1.Position=i*320
Ados1.write ados.read(320)
next
"清空已经用完的ADOS的数据，调入替换新的图像头54字节的头文件
Ados.LoadFromFile(Server.mappath("head.fix"))
Pos=lenb(Ados.read())
Ados.Position=Pos "指定Pos位置,即可再偏移54字节的位置添加图形数据
"第二个for循环，进行数字的阵列变换，由竖排的块转换为横排的数字块
"方法是隔320字节抽取4次30字节写入ados对象，再抽取偏移第二行的图像数据
"30字节是因为bmp 宽大于长时无00 00的行结束标记
for i=0 to 9 step 1
for j=0 to 3
Ados1.Position=i*32+j*320
Ados.Position=Pos+30*j+i*120
Ados.write ados1.read(30)
next
next
Ados.Position=0
response.BinaryWrite直接向客户端发送图像数据
Response.ContentType = "image/BMP"
Response.BinaryWrite Ados.read()
Ados.Close:set Ados=nothing
Ados1.Close:set Ados1=nothing
End Function

Tags: 验证码

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1053

详细注解ASPJPGE组件的添加水印用法

Submitted by on 2006, November 11, 7:26 AM

详细注解ASPJPGE组件的添加水印用法。

代码:

"------------为图片添加水印--------
Sub AddWaterMark(imagename)
"定义变量。
Dim Jpeg

Set Jpeg = Server.CreateObject("Persits.Jpeg")  " 建立对象
Jpeg.Open trim(server.MapPath(imagename))  " 图片所在位置
Jpeg.Canvas.Font.Color = "&HFFFFFF" " 颜色
Jpeg.Canvas.Font.Family = "宋体"  " 设置字体

"是否设置成粗体
Jpeg.Canvas.Font.Bold = false

Jpeg.Canvas.Font.ShadowColor = "&H000000" "//水印文字的阴影色彩。
Jpeg.Canvas.Font.ShadowXoffset = 1  "//水印文字阴影向右偏移的像素值，输入负值则向左偏移。
Jpeg.Canvas.Font.ShadowYoffset = 1  "//水印文字阴影向下偏移的像素值，输入负值则向右偏移。
Jpeg.Canvas.Font.Size = 12 "字体大小
Jpeg.Canvas.Font.Quality = 3 " 文字清晰度
Jpeg.Canvas.Print 5,5, "淡水河边 - kissmumu@126.com"   "水印文字,位置在原图的坐标的5,5处
Jpeg.Save Server.MapPath(imagename)  " 保存文件
Set Jpeg = Nothing

End Sub
"---------------添加完毕------------------

调用：
Dim FilePath
FilePath="uploadpic/demo.jpg""图片路径
AddWaterMark FilePath

Tags: 水印, aspjpge

网站|ASP备忘 | 评论:2 | Trackbacks:0 | 阅读:1471

show点asp?id=x变成show/?x的形式@防盗链

Submitted by on 2006, November 11, 7:16 AM

首先建立一个show目录,建立一个index.asp文件,就是系统默认的那个文件
以前是 show.asp?id=26 的样子,show文件得到id一般用id=request.QueryString("id")之类的获得id.
现在是把获得id换成获得?后面的数字,用以下代码.
id = LCase(Trim(Request.ServerVariables("QUERY_STRING")))

效果:
http://www.xxx.com/show/?x

另外加上一个Request.ServerVariables的应用范例

Request.ServerVariables("HTTP_REFERER")
　用来获取(从哪个页面转到当前页面的) & 路径
　常用来转到某一网址
　response.redirect Request.ServerVariables("HTTP_REFERER")
　用来判断是不是从某个网址链接过来的也一错,可以防址盗链
　下面判断是不是从主面进来,

代码:

server_vv=len(Request.ServerVariables("SERVER_NAME"))"取得WWW名,不好说大概就是这个意思
　server_v1=left(Cstr(Request.ServerVariables("HTTP_REFERER")),server_vv)"取得本页路径的主HTTP
　server_v2=left(Cstr("http://"&R...,server_vv)取得带HTTP名
　if server_v1<>server_v2 and server_v1<>"" and server_v2<>"" then
　response.write("<script>alert("错误：禁止从站点外部提交数据!.")</script>")
　response.end

再来一个简单的防盗程序

代码:

sServerName = LCase(Request.ServerVariables("SERVER_NAME"))
　    sReferrerpage = LCase(Request.ServerVariables("HTTP_REFERER"))
　    "//盗链检测
　    If InStr(sReferrerPage,sServerName)<1 then
　          Response.Redirect("/Error.asp?IllegalLink")
　    End If

InStr 函数返回某字符串在另一字符串中第一次出现的位置。
　上面的也就是说,如果没有主机这个名字值小于1(怎么是数字值呢)
　就转到错误页面

Tags: Request，盗链

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1796

Request点ServerVariables大全

Submitted by on 2006, November 11, 7:14 AM

ASP.NET语法:
Request.ServerVariables [int index]; Request.ServerVariables [string name];

ASP语法:
Request.ServerVariables (server environment variable);

参数服务器环境变量
指定要检索的服务器环境变量名。可以使用下面列出的值。
变量说明
ALL_HTTP ：客户端发送的所有 HTTP 标题文件。
ALL_RAW ：检索未处理表格中所有的标题。ALL_RAW 和 ALL_HTTP 不同，ALL_HTTP 在标题文件名前面放置 HTTP_ prefix，并且标题名称总是大写的。使用 ALL_RAW 时，标题名称和值只在客户端发送时才出现。
APPL_MD_PATH ：检索 ISAPI DLL 的 (WAM) Application 的元数据库路径。
APPL_PHYSICAL_PATH：检索与元数据库路径相应的物理路径。IIS 通过将 APPL_MD_PATH 转换为物理（目录）路径以返回值。
AUTH_PASSWORD ：该值输入到客户端的鉴定对话中。只有使用基本鉴定时，该变量才可用。
AUTH_TYPE ：这是用户访问受保护的脚本时，服务器用于检验用户的验证方法。
AUTH_USER：未被鉴定的用户名。
CERT_COOKIE：客户端验证的唯一 ID，以字符串方式返回。可作为整个客户端验证的签字。
CERT_FLAGS：如有客户端验证，则 bit0 为 1。
如果客户端验证的验证人无效（不在服务器承认的 CA 列表中），bit1 被设置为 1。

CERT_ISSUER ：用户验证中的颁布者字段（O=MS，OU=IAS，CN=user name，C=USA）。
CERT_KEYSIZE ：安全套接字层连接关键字的位数，如 128。
CERT_SECRETKEYSIZE：服务器验证私人关键字的位数。如 1024。
CERT_SERIALNUMBER ：用户验证的序列号字段。
CERT_SERVER_ISSUER ：服务器验证的颁发者字段。
CERT_SERVER_SUBJECT ：服务器验证的主字段。
CERT_SUBJECT ：客户端验证的主字段。
CONTENT_LENGTH ：客户端发出内容的长度。
CONTENT_TYPE ：内容的数据类型。同附加信息的查询一起使用，如 HTTP 查询 GET、 POST 和 PUT。
GATEWAY_INTERFACE：服务器使用的 CGI 规格的修订。格式为 CGI/revision。
HTTP_<HeaderName> HeaderName ：存储在标题文件中的值。未列入该表的标题文件必须以 HTTP_ 作为前缀，以使 ServerVariables 集合检索其值。
注意服务器将 HeaderName 中的下划线（_）解释为实际标题中的破折号。例如，如果您指定 HTTP_MY_HEADER，服务器将搜索以 MY-HEADER 为名发送的标题文件。

HTTPS ：如果请求穿过安全通道（SSL），则返回 ON。如果请求来自非安全通道，则返回 OFF。
HTTPS_KEYSIZE ：安全套接字层连接关键字的位数，如 128。
HTTPS_SECRETKEYSIZE ：服务器验证私人关键字的位数。如 1024。
HTTPS_SERVER_ISSUER：服务器验证的颁发者字段。
HTTPS_SERVER_SUBJECT ：服务器验证的主字段。
INSTANCE_ID ：文本格式 IIS 实例的 ID。如果实例 ID 为 1，则以字符形式出现。使用该变量可以检索请求所属的（元数据库中）Web 服务器实例的 ID。
INSTANCE_META_PATH ：响应请求的 IIS 实例的元数据库路径。
LOCAL_ADDR ：返回接受请求的服务器地址。如果在绑定多个 IP 地址的多宿主机器上查找请求所使用的地址时，这条变量非常重要。
LOGON_USER ：用户登录 Windows NT? 的帐号。
PATH_INFO ：客户端提供的额外路径信息。可以使用这些虚拟路径和 PATH_INFO 服务器变量访问脚本。如果该信息来自 URL，在到达 CGI 脚本前就已经由服务器解码了。
PATH_TRANSLATED PATH_INFO：转换后的版本，该变量获取路径并进行必要的由虚拟至物理的映射。
QUERY_STRING ：查询 HTTP 请求中问号（?）后的信息。
REMOTE_ADDR ：发出请求的远程主机的 IP 地址。
REMOTE_HOST ：发出请求的主机名称。如果服务器无此信息，它将设置为空的 MOTE_ADDR 变量。
REMOTE_USER ：用户发送的未映射的用户名字符串。该名称是用户实际发送的名称，与服务器上验证过滤器修改过后的名称相对。
REQUEST_METHOD：该方法用于提出请求。相当于用于 HTTP 的 GET、HEAD、POST 等等。
SCRIPT_NAME：执行脚本的虚拟路径。用于自引用的 URL。
SERVER_NAME ：出现在自引用 UAL 中的服务器主机名、DNS 化名或 IP 地址。
SERVER_PORT ：发送请求的端口号。
SERVER_PORT_SECURE ：包含 0 或 1 的字符串。如果安全端口处理了请求，则为 1，否则为 0。
SERVER_PROTOCOL ：请求信息协议的名称和修订。格式为 protocol/revision 。
SERVER_SOFTWARE：应答请求并运行网关的服务器软件的名称和版本。格式为 name/version 。
URL 提供 URL 的基本部分。

注释
如果客户端发送的标题文件在上述表格中找不到，可以在调用 Request.ServerVariables 中给标题文件名加上 HTTP_ 的前缀以检索其值。例如，如果客户端发送标题文件

SomeNewHeader:SomeNewValue 您可以通过使用下面的语法检索 SomeNewValue

<% Request.ServerVariables("HTTP_SomeNewHeader") %> 您可使用重述符以循环遍历所有的服务器变量名。例如，使用下面的脚本打印出所有的服务器名。

<TABLE><TR><TD><B>Server Variable</B></TD><TD><B>Value</B></TD></TR><% For Each name In Request.ServerVariables %> <TR><TD> <%= name %> </TD><TD> <%= Request.ServerVariables(name) %> </TD></TR></TABLE><% Next %> 示例
下面的例子使用 Request 对象显示一些服务器变量。

<HTML> ALL_HTTP server variable = <%= Request.ServerVariables("ALL_HTTP") %> <BR>CONTENT_LENGTH server variable = <%= Request.ServerVariables("CONTENT_LENGTH") %> <BR> CONTENT_TYPE server variable = <%= Request.ServerVariables("CONTENT_TYPE") %> <BR>QUERY_STRING server variable = <%= Request.ServerVariables("QUERY_STRING") %> <BR> SERVER_SOFTWARE server variable = <%= Request.ServerVariables("SERVER_SOFTWARE") %> <BR> </HTML> 下一个示例使用 ServerVariables 集合将服务器名插入一个超文本链接。

<A HREF = "http://<%= Request.ServerVariables("SERVER_NAME") %>/scripts/MyPage.asp">Link to MyPage.asp</A>

Tags: Request

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1004

asp程序打包和安装程序

Submitted by on 2006, November 7, 7:11 PM

作者：落伍者 Lukin

代码:

把网站源码全部打包到Xml文件里面，生成 updata.xml 文件，把xml文件上传到空间里面
然后通过 install.asp文件将文件全部释放出来。
就和z-blog的自动安装包一样的功能呵呵。
代码是落伍的一位兄弟写的，不过代码好像有错误，这个是我参考他的修改过了，可以正常运行！~~
此代码可以应用到 asp程序的自动升级服务上面。具体怎么来实现，欢迎探讨！~~
不用设定打包目录版，需要设定打包目录版这两个版本的区别：

不用设定打包目录版，直接放到你需要打包的目录执行就可以了。
需要设定打包目录版，必须指定需要打包的路径（在程序里修改），不指定，不能进行打包。

功能不错，偷偷备份一下。

下载文件

点击这里下载文件

下载文件

点击这里下载文件

Tags: 打包

网站|ASP备忘 | 评论:0 | Trackbacks:0 | 阅读:1343

Records:123‹1 2 345 6 7 8 9 10 ›»

关于我们┊Aboutus

昵称：淡水河边
年龄：属八零后
职业：全职小工
联系：QQ-24064120
邮箱：24064120{a}qq.com
签名：如果需要，点击广告

博客月历┊Celendar

日	一	二	三	四	五	六
« 2008年08月 »
					1	2
3	4	5	6	7	8	9
10	11	12	13	14	15	16
17	18	19	20	21	22	23
24	25	26	27	28	29	30
31

日志分类┊Category

点击排行┊HotBlog

日志归档┊Archives

博客信息┊Stats

分类数量: 8
文章数量: 649
评论数量: 290
标签数量: 299
附件数量: 50
引用数量: 8
注册用户: 39
今日访问: 755
总访问量: 1045423
程序版本: 1.6

淡水河边的博客

ASP快速建成生成静态文件的网站发布系统

10秒后自动关闭

整理了一个editplus的剪辑文件（ASP方面的内容）

支持多风格变换的ASP分页类

6行代码实现无组件上传(打自己嘴巴,只能用在本地)

ASP彩色校验码的制作！！！！(幻想剑)

详细注解ASPJPGE组件的添加水印用法

show点asp?id=x变成show/?x的形式@防盗链

Request点ServerVariables大全

asp程序打包和安装程序

关于我们┊Aboutus

博客月历┊Celendar

日志分类┊Category

最新评论┊Comments

点击排行┊HotBlog

热门标签┊Tags

日志归档┊Archives

博客信息┊Stats

友情链接┊Links

控制面板┊ControlPanel