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

保存远程图片到本地 同时取得第一张图片并创建缩略图

Submitted by on 2006, November 28, 12:35 AM

采集中 或者 在线添加文章中 都可以用到此功能.
SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取
以下是函数
代码:
<%
"==================================================
"函数名：CheckDir2
"作  用：检查文件夹是否存在
"参  数：FolderPath ------文件夹地址
"==================================================
Function CheckDir2(byval FolderPath)
    dim fso
    folderpath=Server.MapPath(".")&amp;"\"&amp;folderpath
    Set fso = Server.Cr&#101;ateObject("Scripting.FileSystemObject")
    If fso.FolderExists(FolderPath) then
    "存在
        CheckDir2 = True
    Else
    "不存在
        CheckDir2 = False
    End if
    Set fso = nothing
End Function
"==================================================
"函数名：MakeNewsDir2
"作  用：创建新的文件夹
"参  数：foldername ------文件夹名称
"==================================================
Function MakeNewsDir2(byval foldername)
    dim fso
    Set fso = Server.Cr&#101;ateObject("Scripting.FileSystemObject")
        fso.Cr&#101;ateFolder(Server.MapPath(".") &amp;"\" &amp;foldername)
        If fso.FolderExists(Server.MapPath(".") &amp;"\" &amp;foldername) Then
           MakeNewsDir2 = True
        Else
           MakeNewsDir2 = False
        End If
    Set fso = nothing
End Function
"==================================================
"函数名：DefiniteUrl
"作  用：将相对地址转换为绝对地址
"参  数：PrimitiveUrl ------要转换的相对地址
"参  数：ConsultUrl ------当前网页地址
"==================================================
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
   Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
   If PrimitiveUrl="" o&#114; ConsultUrl="" o&#114; PrimitiveUrl="$False$" Then
      DefiniteUrl="$False$"
      Exit Function
   End If
   If Left(ConsultUrl,7)<>"HTTP://" And Left(ConsultUrl,7)<>"http://" Then
      ConsultUrl= "http://" &amp; ConsultUrl
   End If
   ConsultUrl=Replace(ConsultUrl,"://",":\\")
   If Right(ConsultUrl,1)<>"/" Then
      If Instr(ConsultUrl,"/")>0 Then
         If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then  
         Else
            ConsultUrl=ConsultUrl &amp; "/"
         End If
      Else
         ConsultUrl=ConsultUrl &amp; "/"
      End If
   End If
   ConArray=Split(ConsultUrl,"/")
   If Left(PrimitiveUrl,7) = "http://" then
      DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")
   ElseIf Left(PrimitiveUrl,1) = "/" Then
      DefiniteUrl=ConArray(0) &amp; PrimitiveUrl
   ElseIf Left(PrimitiveUrl,2)="./" Then
      DefiniteUrl=ConArray(0) &amp; Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
   ElseIf Left(PrimitiveUrl,3)="../" then
      Do While Left(PrimitiveUrl,3)="../"
         PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
         Pi=Pi+1
      Loop            
      For Ci=0 to (Ubound(ConArray)-1-Pi)
         If DefiniteUrl<>"" Then
            DefiniteUrl=DefiniteUrl &amp; "/" &amp; ConArray(Ci)
         Else
            DefiniteUrl=ConArray(Ci)
         End If
      Next
      DefiniteUrl=DefiniteUrl &amp; "/" &amp; PrimitiveUrl
   Else
      If Instr(PrimitiveUrl,"/")>0 Then
         PriArray=Split(PrimitiveUrl,"/")
         If Instr(PriArray(0),".")>0 Then
            If Right(PrimitiveUrl,1)="/" Then
               DefiniteUrl="http:\\" &amp; PrimitiveUrl
            Else
               If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then
                  DefiniteUrl="http:\\" &amp; PrimitiveUrl
               Else
                  DefiniteUrl="http:\\" &amp; PrimitiveUrl &amp; "/"
               End If
            End If      
         Else
            If Right(ConsultUrl,1)="/" Then  
               DefiniteUrl=ConsultUrl &amp; PrimitiveUrl
            Else
               DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) &amp; PrimitiveUrl
            End If
         End If
      Else
         If Instr(PrimitiveUrl,".")>0 Then
            If Right(ConsultUrl,1)="/" Then
               If right(PrimitiveUrl,3)=".cn" o&#114; right(PrimitiveUrl,3)="com" o&#114; right(PrimitiveUrl,3)="net" o&#114; right(PrimitiveUrl,3)="org" Then
                  DefiniteUrl="http:\\" &amp; PrimitiveUrl &amp; "/"
               Else
                  DefiniteUrl=ConsultUrl &amp; PrimitiveUrl
               End If
            Else
               If right(PrimitiveUrl,3)=".cn" o&#114; right(PrimitiveUrl,3)="com" o&#114; right(PrimitiveUrl,3)="net" o&#114; right(PrimitiveUrl,3)="org" Then
                  DefiniteUrl="http:\\" &amp; PrimitiveUrl &amp; "/"
               Else
                  DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) &amp; "/" &amp; PrimitiveUrl
               End If
            End If
         Else
            If Right(ConsultUrl,1)="/" Then
               DefiniteUrl=ConsultUrl &amp; PrimitiveUrl &amp; "/"
            Else
               DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) &amp; "/" &amp; PrimitiveUrl &amp; "/"
            End If        
         End If
      End If
   End If
   If Left(DefiniteUrl,1)="/" then
     DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
   End if
   If DefiniteUrl<>"" Then
      DefiniteUrl=Replace(DefiniteUrl,"//","/")
      DefiniteUrl=Replace(DefiniteUrl,":\\","://")
   Else
      DefiniteUrl="$False$"
   End If
End Function
"==================================================
"函数名：ReplaceSaveRemoteFile
"作  用：替换、保存远程文件
"参  数：ConStr ------ 要替换的字符串
"参  数：StarStr ----- 前导
"参  数：OverStr -----
"参  数：IncluL ------
"参  数：IncluR ------
"参  数：SaveTf ------ 是否保存文件，False不保存，True保存
"参  数：SaveFilePath- 保存文件夹
"参  数: TistUrl------ 当前网页地址
"==================================================
Function ReplaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
   If ConStr="$False$" o&#114; ConStr="" Then
      ReplaceSaveRemoteFile="$False$"
      Exit Function
   End If
   Dim TempStr,TempStr2,ReF,Matches,Match,Tempi,TempArray,TempArray2,OverTypeArray

   Set ReF = New Regexp
   ReF.IgnoreCase = True
   ReF.Global = True
   ReF.Pattern = "("&amp;StartStr&amp;").+?("&amp;OverStr&amp;")"
   Set Matches =ReF.Execute(ConStr)
   For Each Match in Matches
      If Instr(TempStr,Match.Value)=0 Then
         If TempStr<>"" then
            TempStr=TempStr &amp; "$Array$" &amp; Match.Value
         Else
            TempStr=Match.Value
         End if
      End If
   Next
   Set Matches=nothing
   Set ReF=nothing
   If TempStr="" o&#114; IsNull(TempStr)=True Then
      ReplaceSaveRemoteFile=ConStr
      Exit function
   End if
   If IncluL=False then
      TempStr=Replace(TempStr,StartStr,"")
   End if
   If IncluR=False then
      If Instr(OverStr,"|")>0 Then
         OverTypeArray=Split(OverStr,"|")
         For Tempi=0 To Ubound(OverTypeArray)
            TempStr=Replace(TempStr,OverTypeArray(Tempi),"")
         Next
      Else
         TempStr=Replace(TempStr,OverStr,"")
      End If  
   End if
   TempStr=Replace(TempStr,"""","")
   TempStr=Replace(TempStr,""","")

   Dim RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
   If Right(SaveFilePath,1)="/" then
      SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1)
   End If
   If SaveTf=True then
      If CheckDir2(SaveFilePath)=False Then
         If MakeNewsDir2(SaveFilePath)=False Then
            SaveTf=False
         End If
      End If
   End If
   SaveFilePath=SaveFilePath &amp; "/"

   "图片转换/保存
   TempArray=Split(TempStr,"$Array$")
   For Tempi=0 To Ubound(TempArray)
      RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
      If RemoteFileurl<>"$False$" And SaveTf=True Then"保存图片
        ArrSaveFileName = Split(RemoteFileurl,".")
        SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))"文件类型
        RanNum=Int(900*Rnd)+100
        SaveFileName = SaveFilePath&amp;year(now)&amp;month(now)&amp;day(now)&amp;hour(now)&amp;minute(now)&amp;second(now)&amp;ranNum&amp;"."&amp;SaveFileType                  
        Call SaveRemoteFile(SaveFileName,RemoteFileurl)
            ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
      ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then"不保存图片
            SaveFileName=RemoteFileUrl
            ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
      End If
      If RemoteFileUrl<>"$False$" Then
         If UploadFiles="" then
            UploadFiles=SaveFileName
         Else
            UploadFiles=UploadFiles &amp; "|" &amp; SaveFileName
         End if
      End If
   Next  
   ReplaceSaveRemoteFile=ConStr
End function
"==================================================
"过程名：SaveRemoteFile
"作  用：保存远程的文件到本地
"参  数：LocalFileName ------ 本地文件名
"参  数：RemoteFileUrl ------ 远程文件URL
"==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
    dim Ads,Retrieval,GetRemoteData
    Set Retrieval = Server.Cr&#101;ateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open "Get", RemoteFileUrl, False, "", ""
        .Send
        GetRemoteData = .ResponseBody
    End With
    Set Retrieval = Nothing
    Set Ads = Server.Cr&#101;ateObject("Adodb.Stream")
    With Ads
        .Type = 1
        .Open
        .Write GetRemoteData
        .SaveToFile server.MapPath(LocalFileName),2
        .Cancel()
        .Close()
    End With
    Set Ads=nothing
end sub

"==================================================
"过程名：GetImg
"作  用：取得文章中第一张图片
"参  数：str ------ 文章内容
"参  数：strpath ------ 保存图片的路径
"==================================================
Function GetImg(str,strpath)
set objregEx = new RegExp
objregEx.IgnoreCase = true
objregEx.Global = true
zzstr=""&amp;strpath&amp;"(.+?)\.(jpg|gif|png|bmp)"
objregEx.Pattern = zzstr
set matches = objregEx.execute(str)
for each match in matches
retstr = retstr &amp;"|"&amp; Match.Value
next
if retstr<>"" then
Imglist=split(retstr,"|")
Imgone=replace(Imglist(1),strpath,"")
GetImg=Imgone
else
GetImg=""
end if
end function
%>

例:
代码:
<form id="form1" name="form1" method="post" action="?action=test">
  <textarea name="body" cols="50" rows="5" id="body">
<img height="180" src="http://cimg2.163.com/cnews... width="240" border="0" />
<img class="left"src="http://news.163.com/img/ne... width="114" />
<img height="60" src="http://cimg2.163.com/cnews... width="120" border="0" />
<img height="60" alt="中国维和人数大国之首" src="http://cimg2.163.com/cnews... width="120" border="0" />
  </textarea>
  <input type="submit" name="Submit" value="提交" />
</form>
<%
if request.QueryString("action")="test" then
    "图片开始的字符串
    FilesStartStr="src="
    "图片结束的字符串
    FilesOverStr="gif|jpg|bmp"
    "保存图片的文件夹
    FilesPath="qq"
    "取得保存图片的网站URL 自动判断是绝对 还是相对路径
    NewsUrl="http://news.163.com&#3...
    "取得文章内容
    Content =Request.Form("body")
    "开始保存图片
    Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
    "对新闻中的第一张图片创建缩略图
    if GetImg(Content,FilesPath)<>"" then
        Imgsrc=GetImg(Content,FilesPath)
        Imgsrc=replace(Imgsrc,FilesPath,"")
        Set Jpeg = Server.Cr&#101;ateObject("Persits.Jpeg")
        Path = Server.MapPath(""&amp;FilesPath&amp;"") &amp; "\"&amp;Imgsrc&amp;""
        Jpeg.Open Path
            "如果图片宽小于等于120 高小于等于90 则不创建缩略图
        if Jpeg.OriginalWidth<=120 and Jpeg.Height<=90 then
            Jpeg.Width = Jpeg.OriginalWidth
            Jpeg.Height = Jpeg.OriginalHeight
            Smallimg=FilesPath&amp;""&amp;GetImg(Content,FilesPath)
        else
            "图片宽度高度/2
            Jpeg.Width = Jpeg.OriginalWidth / 2
            Jpeg.Height = Jpeg.OriginalHeight / 2
            Jpeg.Save Server.MapPath(""&amp;FilesPath&amp;"") &amp; "\small_"&amp;Imgsrc&amp;""
            Smallimg=""&amp;FilesPath&amp;"/small_"&amp;Imgsrc&amp;""
        end if
    end if
    "显示结果
    response.Write("新闻中的第一张图片是:")
    response.Write("<img src="&amp;FilesPath&amp;"/"&amp;GetImg(Content,FilesPath)&amp;">")
    response.Write("<br>新闻中的第一张图片的缩略图是:")
    response.Write("<img src="&amp;Smallimg&amp;">")
    response.Write("<br>新的新闻内容（图片为本地）:<br>")
    Response.Write(Content)
    Response.End()
end if
%>


Tags: 远程保存

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

ASP实现文件直接下载

Submitted by on 2006, November 28, 12:22 AM

主程序代码如下：(淡水河边这厮还没有用过)
--------------------------------------------------------------------------------
代码:
"定义所有需要使用的变量
Dim strFilename,S,Fso,F,intFilelength
strFilename = Server.MapPath(Trim(Request("File")))
Response.Buffer = True
Response.Clear
Set S = Server.Cr&#101;ateObject("ADODB.Stream")
S.Open
S.Type = 1
On Error Resume Next
Set Fso = Server.Cr&#101;ateObject("Scripting.FileSystemObject")
If Not Fso.FileExists(strFilename) Then
Response.Write("<h1>Error:</h1>"&amp;strFilename&amp;"你要下载的文件不存在！<p>")
Response.End
End If

Set F = Fso.GetFile(strFilename)
intFilelength = F.Size "获取文件大小
S.LoadFromFile(strFilename)
If Err Then
Response.Write("<h1>Error： </h1>Unknown Error！<p>")
Response.End
End If

Response.AddHeader "Content-Disposition","attachment;filename="&amp;F.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "GB2312"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite S.Read
Response.Flush
S.Close
Set S = Nothing


对文本类文件（*.txt;*.html;*.doc;等等），图片类文件（*.jpg;*.gif等等）直接点击链接时会在浏览器打开，而无法出现下载保存对话框。
如果要实现点击上述文件，弹出保存对话框，则需要用到下面这个函数了：
代码:
<%
"Call downloadFile(Request("path"))

function downloadFile(strFile)
strFilename = server.MapPath(strFile)

"Clear the buffer
Response.Buffer = True
Response.Clear

"Cr&#101;ate stream
Set s = Server.Cr&#101;ateObject("ADODB.Stream")
s.Open

"Set as binary
s.Type = 1

"Load in the file
on error resume next

"Check the file exists
Set fso = Server.Cr&#101;ateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFilename) then
Response.Write("<p><strong>Error: </strong>" &amp; strFilename &amp; " does not exist</p>")
Response.End
end if

"Get length of file
Set f = fso.GetFile(strFilename)
intFilelength = f.size

s.LoadFromFile(strFilename)
if err then
Response.Write("<p><strong>Error: </strong>" &amp; err.Description &amp; "</p>")
Response.End
end if

"Send the headers to the users browser
Response.AddHeader "Content-Disposition", "attachment; filename=" &amp; f.name
Response.AddHeader "Content-Length", intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"

"Output the file to the browser
Response.BinaryWrite s.Read
Response.Flush

"Tidy up
s.Close
Set s = Nothing

End Function
%>

Tags: 直接下载

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

记录分几列显示,也就是几行几列了

Submitted by on 2006, November 28, 12:14 AM

因为做到这样的案子,所以淡水河边分享一下.清晰明了呀
代码:
<table>
        <tr>
<%
    Set rs= Server.Cr&#101;ateObject("ADODB.Recordset")
    rs.open "sel&#101;ct id from [tbl] wh&#101;re the_type=1",conn,1,1
    tempnum=1
    do while not rs.eof
%>
<td><%=rs(0)%></td>
<%
    if (tempnum mod 3)=0 then response.write "</tr>" "3列显示mod 3
    tempnum=tempnum+1
    rs.movenext
    loop
%>
</tr>
<%
    rs.close
    set rs=nothing
%>
</table>

Tags: 几列, 几行几列

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

PJBLOG的验证码

Submitted by on 2006, November 27, 6:56 PM

PJBLOG的验证码,留个记号.用了
代码:
<%@CodePage="65001"%>
<%
Call Com_CreatValidCode("GetCode")

Sub Com_CreatValidCode(pSN)
    " 禁止缓存
    Response.Expires = -9999
    Response.AddHeader "Pragma","no-cache"
    Response.AddHeader "cache-ctrol","no-cache"
    "Response.ContentType = "Image/BMP"

    Randomize

    Dim i, ii, iii

    Const cOdds = 4 " 杂点出现的机率
    Const cAmount = 36 " 文字数量
    Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    " 颜色的数据(字符，背景)
    Dim vColorData(1),vColorRandom(10)
    "vColorData(0) = ChrB(Int(Rnd*155)+100) &amp; ChrB(Int(Rnd*155)+100) &amp; ChrB(Int(Rnd*155)+100) " 蓝0，绿0，红0（黑色）
    vColorRandom(0)=ChrB(150) &amp; ChrB(0) &amp; ChrB(0)
    vColorRandom(1)=ChrB(0) &amp; ChrB(150) &amp; ChrB(0)
    vColorRandom(2)=ChrB(0) &amp; ChrB(0) &amp; ChrB(150)
    vColorRandom(3)=ChrB(0) &amp; ChrB(50) &amp; ChrB(150)
    vColorRandom(4)=ChrB(150) &amp; ChrB(50) &amp; ChrB(0)
    vColorRandom(5)=ChrB(150) &amp; ChrB(0) &amp; ChrB(150)
    vColorRandom(6)=ChrB(150) &amp; ChrB(100) &amp; ChrB(10)
    vColorRandom(7)=ChrB(150) &amp; ChrB(40) &amp; ChrB(120)
    vColorRandom(8)=ChrB(150) &amp; ChrB(0) &amp; ChrB(250)
    vColorRandom(9)=ChrB(100) &amp; ChrB(100) &amp; ChrB(100)
    vColorRandom(10)=ChrB(50) &amp; ChrB(50) &amp; ChrB(50)
    vColorData(0) = vColorRandom(0)
    vColorData(1) = ChrB(250) &amp; ChrB(250) &amp; ChrB(255) "背景色 蓝250，绿236，红211（浅蓝色）
    " 随机产生字符
    Dim vCode(4),vCodes,vCodeColors(4)
    For i = 0 To 3
        vCodeColors(i)=vColorRandom(Int(Rnd * 10))
        vCode(i) = Int(Rnd * cAmount)
        vCodes = vCodes &amp; Mid(cCode, vCode(i) + 1, 1)
    Next

    Session(pSN) = vCodes "记录入Session
    " 字符的数据
    Dim vNumberData(35)
    vNumberData(0) = "1110000111110111101111011110111101001011110100101111010010111101001011110111101111011110111110000111"
    vNumberData(1) = "1111011111110001111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
    vNumberData(2) = "1110000111110111101111011110111111111011111111011111111011111111011111111011111111011110111100000011"
    vNumberData(3) = "1110000111110111101111011110111111110111111100111111111101111111111011110111101111011110111110000111"
    vNumberData(4) = "1111101111111110111111110011111110101111110110111111011011111100000011111110111111111011111111000011"
    vNumberData(5) = "1100000011110111111111011111111101000111110011101111111110111111111011110111101111011110111110000111"
    vNumberData(6) = "1111000111111011101111011111111101111111110100011111001110111101111011110111101111011110111110000111"
    vNumberData(7) = "1100000011110111011111011101111111101111111110111111110111111111011111111101111111110111111111011111"
    vNumberData(8) = "1110000111110111101111011110111101111011111000011111101101111101111011110111101111011110111110000111"
    vNumberData(9) = "1110001111110111011111011110111101111011110111001111100010111111111011111111101111011101111110001111"
    vNumberData(10) = "1111011111111101111111101011111110101111111010111111101011111100000111110111011111011101111000100011"
    vNumberData(11) = "1000000111110111101111011110111101110111110000111111011101111101111011110111101111011110111000000111"
    vNumberData(12) = "1110000011110111101110111110111011111111101111111110111111111011111111101111101111011101111110001111"
    vNumberData(13) = "1000001111110111011111011110111101111011110111101111011110111101111011110111101111011101111000001111"
    vNumberData(14) = "1000000111110111101111011011111101101111110000111111011011111101101111110111111111011110111000000111"
    vNumberData(15) = "1000000111110111101111011011111101101111110000111111011011111101101111110111111111011111111000111111"
    vNumberData(16) = "1110000111110111011110111101111011111111101111111110111111111011100011101111011111011101111110001111"
    vNumberData(17) = "1000100011110111011111011101111101110111110000011111011101111101110111110111011111011101111000100011"
    vNumberData(18) = "1100000111111101111111110111111111011111111101111111110111111111011111111101111111110111111100000111"
    vNumberData(19) = "1110000011111110111111111011111111101111111110111111111011111111101111111110111110111011111000011111"
    vNumberData(20) = "1000100011110111011111011011111101011111110001111111010111111101101111110110111111011101111000100011"
    vNumberData(21) = "1000111111110111111111011111111101111111110111111111011111111101111111110111111111011110111000000011"
    vNumberData(22) = "1000100011110010011111001001111100100111110101011111010101111101010111110101011111010101111001010011"
    vNumberData(23) = "1000100011110011011111001101111101010111110101011111010101111101100111110110011111011001111000110111"
    vNumberData(24) = "1110001111110111011110111110111011111011101111101110111110111011111011101111101111011101111110001111"
    vNumberData(25) = "1000000111110111101111011110111101111011110000011111011111111101111111110111111111011111111000111111"
    vNumberData(26) = "1110001111110111011110111110111011111011101111101110111110111011111011101001101111011001111110001011"
    vNumberData(27) = "1000001111110111011111011101111101110111110000111111010111111101101111110110111111011101111000110011"
    vNumberData(28) = "1110000011110111101111011110111101111111111001111111111001111111111011110111101111011110111100000111"
    vNumberData(29) = "1000000011101101101111110111111111011111111101111111110111111111011111111101111111110111111110001111"
    vNumberData(30) = "1000100011110111011111011101111101110111110111011111011101111101110111110111011111011101111110001111"
    vNumberData(31) = "1000100011110111011111011101111101110111111010111111101011111110101111111010111111110111111111011111"
    vNumberData(32) = "1001010011110101011111010101111101010111110101011111001001111110101111111010111111101011111110101111"
    vNumberData(33) = "1000100011110111011111101011111110101111111101111111110111111110101111111010111111011101111000100011"
    vNumberData(34) = "1000100011110111011111011101111110101111111010111111110111111111011111111101111111110111111110001111"
    vNumberData(35) = "1100000011110111011111111101111111101111111110111111110111111111011111111011111111101110111100000011"

    " 输出图像文件头
    Response.BinaryWrite ChrB(66) &amp; ChrB(77) &amp; ChrB(230) &amp; ChrB(4) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp;_
    ChrB(0) &amp; ChrB(0) &amp; ChrB(54) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(40) &amp; ChrB(0) &amp;_
    ChrB(0) &amp; ChrB(0) &amp; ChrB(40) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(10) &amp; ChrB(0) &amp;_
    ChrB(0) &amp; ChrB(0) &amp; ChrB(1) &amp; ChrB(0)

    " 输出图像信息头
    Response.BinaryWrite ChrB(24) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(176) &amp; ChrB(4) &amp;_
    ChrB(0) &amp; ChrB(0) &amp; ChrB(18) &amp; ChrB(11) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(18) &amp; ChrB(11) &amp;_
    ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp; ChrB(0) &amp;_
    ChrB(0) &amp; ChrB(0)
    For i = 9 To 0 Step -1 " 历经所有行
        For ii = 0 To 3 " 历经所有字
            For iii = 1 To 10 " 历经所有像素
                " 逐行、逐字、逐像素地输出图像数据
                vColorData(0)=vCodeColors(ii)
                If Rnd * 99 + 1 < cOdds Then " 随机生成杂点
                    Response.BinaryWrite vColorData(0)
                Else
                    Response.BinaryWrite vColorData(Mid(vNumberData(vCode(ii)), i * 10 + iii, 1))
                End If
            Next
        Next
    Next
End Sub

%>

Tags: 验证码

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

文件上传前台控制检测程序

Submitted by on 2006, November 23, 8:34 PM

对恶意访问没有作用，但对正常访问者来说，确实方便了使用，改善了体验.
[html]
<body>
<title>文件上传前台控制检测程序 v0.6</title>
<style>
body,td{font-size:12px;}
</style>
<script language=javascript>

/*----------------------------------------
文件上传前台控制检测程序 v0.6

远程图片检测功能
检测上传文件类型

　检测图片文件格式是否正确
　检测图片文件大小
　检测图片文件宽度
　检测图片文件高度
图片预览

For 51js.com Author:333 Date:2005/08/26
Up&#100;ate:2005/09/03
-----------------------------------------*/

var ImgObj=new Image();//建立一个图像对象

var AllImgExt=".jpg|.jpeg|.gif|.bmp|.png|"//全部图片格式类型
var FileObj,ImgFileSize,ImgWidth,ImgHeight,FileExt,ErrMsg,FileMsg,HasCheked,IsImg//全局变量 图片相关属性

//以下为限制变量
var AllowExt=".jpg|.gif|.doc|.txt|"//允许上传的文件类型 0为无限制 每个扩展名后边要加一个"|" 小写字母表示
//var AllowExt=0
var AllowImgFileSize=70;//允许上传图片文件的大小 0为无限制 单位：KB
var AllowImgWidth=500;//允许上传的图片的宽度 0为无限制　单位：px(像素)
var AllowImgHeight=500;//允许上传的图片的高度 0为无限制　单位：px(像素)

HasChecked=false;

function CheckProperty(obj)//检测图像属性
{
FileObj=obj;
if(ErrMsg!="")//检测是否为正确的图像文件　返回出错信息并重置
{
ShowMsg(ErrMsg,false);
return false;//返回
}

if(ImgObj.readyState!="complete")//如果图像是未加载完成进行循环检测
{
setTimeout("CheckProperty(FileObj)",500);
return false;
}

ImgFileSize=Math.round(ImgObj.fileSize/1024*100)/100;//取得图片文件的大小
ImgWidth=ImgObj.width;//取得图片的宽度
ImgHeight=ImgObj.height;//取得图片的高度
FileMsg="\n图片大小:"+ImgWidth+"*"+ImgHeight+"px";
FileMsg=FileMsg+"\n图片文件大小:"+ImgFileSize+"Kb";
FileMsg=FileMsg+"\n图片文件扩展名:"+FileExt;

if(AllowImgWidth!=0&amp;&amp;AllowImgWidth<ImgWidth)
ErrMsg=ErrMsg+"\n图片宽度超过限制。请上传宽度小于"+AllowImgWidth+"px的文件，当前图片宽度为"+ImgWidth+"px";

if(AllowImgHeight!=0&amp;&amp;AllowImgHeight<ImgHeight)
ErrMsg=ErrMsg+"\n图片高度超过限制。请上传高度小于"+AllowImgHeight+"px的文件，当前图片高度为"+ImgHeight+"px";

if(AllowImgFileSize!=0&amp;&amp;AllowImgFileSize<ImgFileSize)
ErrMsg=ErrMsg+"\n图片文件大小超过限制。请上传小于"+AllowImgFileSize+"KB的文件，当前文件大小为"+ImgFileSize+"KB";

if(ErrMsg!="")
ShowMsg(ErrMsg,false);
else
ShowMsg(FileMsg,true);
}

ImgObj.onerror=function(){ErrMsg="\n图片格式不正确或者图片已损坏!"}

function ShowMsg(msg,tf)//显示提示信息 tf=true 显示文件信息 tf=false 显示错误信息 msg-信息内容
{
msg=msg.replace("\n","<li>");
msg=msg.replace(/\n/gi,"<li>");
if(!tf)
{
document.all.UploadButton.disabled=true;
FileObj.outerHTML=FileObj.outerHTML;
MsgList.innerHTML=msg;
HasChecked=false;
}
else
{
document.all.UploadButton.disabled=false;
if(IsImg)
PreviewImg.innerHTML="<img src=""+ImgObj.src+"" width="60" height="60">"
else
PreviewImg.innerHTML="非图片文件";
MsgList.innerHTML=msg;
HasChecked=true;
}
}

function CheckExt(obj)
{
ErrMsg="";
FileMsg="";
FileObj=obj;
IsImg=false;
HasChecked=false;
PreviewImg.innerHTML="预览区";
if(obj.value=="")return false;
MsgList.innerHTML="文件信息处理中...";
document.all.UploadButton.disabled=true;
FileExt=obj.value.substr(obj.value.lastIndexOf(".")).toLowerCase();
if(AllowExt!=0&amp;&amp;AllowExt.indexOf(FileExt+"|")==-1)//判断文件类型是否允许上传
{
ErrMsg="\n该文件类型不允许上传。请上传 "+AllowExt+" 类型的文件，当前文件类型为"+FileExt;
ShowMsg(ErrMsg,false);
return false;
}

if(AllImgExt.indexOf(FileExt+"|")!=-1)//如果图片文件，则进行图片信息处理
{
IsImg=true;
ImgObj.src=obj.value;
CheckProperty(obj);
return false;
}
else
{
FileMsg="\n文件扩展名:"+FileExt;
ShowMsg(FileMsg,true);
}

}

function SwitchUpType(tf)
{
if(tf)
str="<input type="file" name="file1" onchange="CheckExt(this)" style="width:180px;">"
else
str="<input type="text" name="file1" onblur="CheckExt(this)" style="width:180px;">"
document.all.file1.outerHTML=str;
document.all.UploadButton.disabled=true;
MsgList.innerHTML="";
}

</script>
<form enctype="multipart/form-data" method="POST" onsubmit="return HasChecked;">
<fieldset style="width: 372; height: 60;padding:2px;">
<legend><font color="#FF0000">图片来源</font></legend>
<input type="radio" name="radio1" checked onclick="SwitchUpType(true);">本地<input type="radio" name="radio1" onclick="SwitchUpType(false);">远程：<input type="file" name="file1" onchange="CheckExt(this)" style="width:180px;"> <input type="submit" id="UploadButton" value="开始上传" disabled><br/>
<div style="border:1 solid #808080;background:#E0E0E0;width100%;height:20px;color:#606060;padding:5px;">
<table border="0"><tr><td width="60" id="PreviewImg">预览区</td><td id="MsgList" valign="top"></td></tr></table>
</div>
</fieldset>
</form>

</body>

[/html]

Tags: 上传, 预览

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

CC攻击终极防范方法

Submitted by on 2006, November 23, 8:33 PM

什么是CC?
       CC就是模拟多个用户(多少线程就是多少用户)不停的进行访问(访问那些需要大量数据操作,就是需要大量CPU时间的页面).造成服务器资源消耗光，导致网站打不开!

防范代码如下，帖在你的CONN.ASP文件里面就OK了！1个小时后，会生成CCLog.txt,它的记录格式是:真实IP [代理的IP] 时间,看看哪个真实IP出现的次数多,就知道是谁在攻击了.
代码:
<%
Dim fsoObject
Dim tsObject
dim file
if Request.ServerVariables("HTTP_X_FORWARDED_FOR")="" then  
response.write "系统维护中"
response.end
end if
Set fsoObject = Server.Cr&#101;ateObject("Scripting.FileSystemObject")
file = server.mappath("CCLog.txt")
if not fsoObject.fileexists(file) then
fsoObject.cr&#101;atetextfile file,true,false
end if
set tsObject = fsoObject.OpenTextFile(file,8)
tsObject.Writeline Request.ServerVariables("HTTP_X_FORWARDED_FOR"&amp;"["&amp;Request.ServerVariables("REMOTE_ADDR")&amp;"]"&amp;now()
"Request.ServerVariables("REMOTE_ADDR") 取得访问者IP，如果访问者用了代理刚为代理的IP
" HTTP_X_FORWARDED_FOR,有部分代理会加上这个原始访问者IP（或是肉鸡的）
Set fsoObject = Nothing
Set tsObject = Nothing
response.write "系统维护中"
%>

     由于攻击者需要上百的代理,否则不能达到较好的效果,他很可能不会对代理进行一一验证匿名性,只要一发现某IP多次出现在代理中,就能确定他是攻击的本身或者是肉鸡了上面的代码不是防御的,而是发现攻击者的！在1个小时后，查看生成的CCLog.txt，获得攻击者的IP之后，就要删除了，不然连带正常访问都无法访问！

     而并不是每个代理服务器都能用 Request.ServerVariables("HTTP_X_FORWARDED_FOR") 来读取客户端的真实 IP，有些用此方法读取到的仍然是代理服务器的IP，同时因为网络的关系，攻击者要获得完全匿名的代理也是不难的，代理中国就有直接的匿名代理列表，这样是无法做到获取攻击者证据了.

直接防范代码如下：
代码:
<%
if request.servervariables("http_x_forwarded_for")<>""then
response.write"<fontcolor=#ff0000>您通过了代理服务器，"&amp;_"真实的IP为"&amp;request.servervariables("http_x_forwarded_for")
"这里把它添加到屏蔽IP中
response.end
end if
%>

Tags: 攻击, 防范, cc

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

1小时里搞定ASP,让你很快上手

Submitted by on 2006, November 23, 2:19 AM

<１>基本框架

<%
语句
……
%>


<2>定义变量dim语句

<%
dim a,b
a=10
b=”ok!”
%>
注意：定义的变量可以是数值型，也可以是字符或者其他类型的


<3>简单的控制流程语句
1. If 条件1 then
语句1
elseif 条件2 then
语句2
else
语句3
endif

2.while 条件
语句
wend

3.for count=1 to n step m
语句1
exit for
语句2
next

二.ASP数据库简单*作教程
<1>.数据库连接(用来单独编制连接文件conn.asp)
<%
Set conn = Server.Cr&#101;ateObject("ADODB.Connection")
conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" &amp; Server.MapPath("\bbs\db1\user.mdb")
%>
(用来连接bbs\db1\目录下的user.mdb数据库)

<2>显示数据库记录
原理：将数据库中的记录一一显示到客户端浏览器，依次读出数据库中的每一条记录
如果是从头到尾：用循环并判断指针是否到末 使用: not rs.eof
如果是从尾到头：用循环并判断指针是否到开始 使用：not rs.bof

<!--#include file=conn.asp--> (包含conn.asp用来打开bbs\db1\目录下的user.mdb数据库)
<%
set rs=server.Cr&#101;ateObject("adodb.recordset") (建立recordset对象)
sqlstr="sel&#101;ct * from message" ---->(message为数据库中的一个数据表，即你要显示的数据所存放的数据表)
rs.open sqlstr,conn,1,3 ---->(表示打开数据库的方式)
rs.movefirst ---->(将指针移到第一条记录)
while not rs.eof ---->(判断指针是否到末尾)
response.write(rs("name")) ---->(显示数据表message中的name字段)
rs.movenext ---->(将指针移动到下一条记录)
wend ---->(循环结束)
rs.close
conn.close 这几句是用来关闭数据库
set rs=nothing
set conn=nothing
%>
其中response对象是服务器向客户端浏览器发送的信息.

<3>增加数据库记录
增加数据库记录用到rs.addnew,rs.up&#100;ate两个函数
<!--#include file=conn.asp--> (包含conn.asp用来打开bbs\db1\目录下的user.mdb数据库)
<%
set rs=server.Cr&#101;ateObject("adodb.recordset") (建立recordset对象)
sqlstr="sel&#101;ct * from message" ---->(message为数据库中的一个数据表，即你要显示的数据所存放的数据表)
rs.open sqlstr,conn,1,3 ---->(表示打开数据库的方式)
rs.addnew 新增加一条记录
rs("name")="xx" 将xx的值传给name字段
rs.up&#100;ate 刷新数据库
rs.close
conn.close 这几句是用来关闭数据库
set rs=nothing
set conn=nothing
%>

<4>删除一条记录
删除数据库记录主要用到rs.del&#101;te,rs.up&#100;ate
<!--#include file=conn.asp--> (包含conn.asp用来打开bbs\db1\目录下的user.mdb数据库)
<%
dim name
name="xx"
set rs=server.Cr&#101;ateObject("adodb.recordset") (建立recordset对象)
sqlstr="sel&#101;ct * from message" ---->(message为数据库中的一个数据表，即你要显示的数据所存放的数据表)
rs.open sqlstr,conn,1,3 ---->(表示打开数据库的方式)
while not rs.eof
if rs.("name")=name then
rs.del&#101;te
rs.up&#100;ate 查询数据表中的name字段的值是否等于变量name的值"xx"，如果符合就执行删除，
else 否则继续查询,直到指针到末尾为止
rs.movenext
emd if
wend
rs.close
conn.close 这几句是用来关闭数据库
set rs=nothing
set conn=nothing
%>

<5>关于数据库的查询
(a) 查询字段为字符型
<%
dim user,pass,qq,mail,message
user=request.Form("user")
pass=request.Form("pass")
qq=request.Form("qq")
mail=request.Form("mail")
message=request.Form("message")
if trim(user)&amp;"x"="x" o&#114; trim(pass)&amp;"x"="x" then (检测user值和pass值是否为空，可以检测到空格)
response.write("注册信息不能为空")
else
set rs=server.Cr&#101;ateObject("adodb.recordset")
sqlstr="sel&#101;ct * from user wh&#101;re user=‘‘‘‘"&amp;user&amp;"‘‘‘‘" (查询user数据表中的user字段其中user字段为字符型)
rs.open sqlstr,conn,1,3
if rs.eof then
rs.addnew
rs("user")=user
rs("pass")=pass
rs("qq")=qq
rs("mail")=mail
rs("message")=message
rs.up&#100;ate
rs.close
conn.close
set rs=nothing
set conn=nothing
response.write("注册成功")
end if
rs.close
conn.close
set rs=nothing
set conn=nothing
response.write("注册重名")
%>
(b)查询字段为数字型
<%
dim num
num=request.Form("num")
set rs=server.Cr&#101;ateObject("adodb.recordset")
sqlstr="sel&#101;ct * from message wh&#101;re id="&amp;num (查询message数据表中id字段的值是否与num相等，其中id为数字型)
rs.open sqlstr,conn,1,3
if not rs.eof then
rs.del&#101;te
rs.up&#100;ate
rs.close
conn.close
set rs=nothing
set conn=nothing
response.write("删除成功")
end if
rs.close
conn.close
set rs=nothing
set conn=nothing
response.write("删除失败")
%>

<6>几个简单的asp对象的讲解
response对象:服务器端向客户端发送的信息对象,包括直接发送信息给浏览器,重新定向URL，或设置cookie值
request对象:客户端向服务器提出的请求
session对象:作为一个全局变量，在整个站点都生效
server对象：提供对服务器上方法和属性的访问
(a) response对象的一般使用方法
比如：
<%
resposne.write("hello, welcome to asp!")
%>
在客户端浏览器就会看到 hello, welcome to asp! 这一段文字
<%
response.Redirect("www.sohu.com")
%>
如果执行这一段，则浏览器就会自动连接到 “搜狐” 的网址
关于response对象的用法还有很多，大家可以研究研究
request对象的一般使用方法
比如客户端向服务器提出的请求就是通过request对象来传递的
列如 ：你在申请邮箱的所填写的个人信息就是通过该对象来将
你所填写的信息传递给服务器的
比如：这是一段表单的代码，这是提供给客户填写信息的，填写完了按
“提交”传递给request.asp文件处理后再存入服务器数据库
<form name="form1" method="post" action="request.asp">
<p>
<input type="text" name="user">
</p>
<p>
<input type="text" name="pass">
</p>
<p>
<input type="submit" name="Submit" value="提交">
</p>
</form>
那么request.asp该如何将其中的信息读入，在写入数据库，在这里就要用到
request对象了，下面我们就来分析request.asp的写法
<%
dim name,password (定义user和password两个变量)
name=request.form(“user”) (将表单中的user信息传给变量name)
password=request.form(“pass”) (将表单中的pass信息传给变量password)
%>

通过以上的几句代码我们就将表单中的数据读进来了，接下来我们要做的就是将
信息写入数据库了，写入数据库的方法上面都介绍了，这里就不一一复述了。

Tags: 快速上手

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

asp通过模板/模版生成静态页面

Submitted by on 2006, November 22, 7:47 PM

直接FSO读取模板文件,不存入数据库,这样修改模板才够方便. [lol]
代码:
<!--模板文件(template.htm)-->
<html>
<head>
<title>{TITLE}</title>
</head>
<body>
{CONTENT}
</body>
</html>


代码:
<!--TestTemplate.asp-->
<%
Dim fso,f
Dim strTitle,strContent,strOut
"创建文件系统对象
Set fso=Server.Cr&#101;ateObject("Scripting.FileSystemObject")

"打开网页模板文件，读取模板内容
Set f=fso.OpenTextFile(Server.MapPath("Template.htm"))
strOut=f.ReadAll
f.close

strTitle="这是生成的网页标题"
strContent="这是生成的网页内容"

"用真实内容替换模板中的标记
strOut=Replace(strOut,"{TITLE}",strTitle)
strOut=Replace(strOut,"{CONTENT}",strContent)

"创建要生成的静态页
Set f=fso.Cr&#101;ateTextFile(Server.MapPath("New.htm"),true)

"写入网页内容
f.WriteLine strOut
f.close

Response.Write "生成静态页成功！"

"释放文件系统对象
set f=Nothing
set fso=Nothing
%>

单个文章是可以这样生成的,比用模板类快(那样处理过程多些自然慢些).长文章分页加个判断也就差不多了.
可是问题还是有,列表页的静态生成怎么做?肯定是要用循环的,怎么做呢?难住淡水河边这厮了.

Tags: 模板, tohtml

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

搜索关键词高亮显示

Submitted by on 2006, November 21, 5:10 AM

用baidu，google等搜索引擎搜索到本站时，搜索关键词高亮显示。
核心代码参见：http://www.kryogenix.org/c...
添加了对baidu的支持，解决了中文乱码不能高亮显示(这里vbs与js混在一起有些不爽，不知道有没有纯js的UrlDecode？)。
代码:
<script language=vbscript>
Function UrlDecode(enStr)
  dim deStr
  dim c,i,v
  deStr=""
  for i=1 to len(enStr)
  c=Mid(enStr,i,1)
  if c="%" then
  v=eval("&amp;h"+Mid(enStr,i+1,2))
  if v<128 then
  deStr=deStr&amp;chr(v)
  i=i+2
  else
  if isvalidhex(mid(enstr,i,3)) then
  if isvalidhex(mid(enstr,i+3,3)) then
  v=eval("&amp;h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
  deStr=deStr&amp;chr(v)
  i=i+5
  else
  v=eval("&amp;h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
  deStr=deStr&amp;chr(v)
  i=i+3
  end if
  else
  destr=destr&amp;c
  end if
  end if
  else
  if c="+" then
  deStr=deStr&amp;" "
  else
  deStr=deStr&amp;c
  end if
  end if
  next
  URLDecode=deStr
  end function

  function isvalidhex(str)
  isvalidhex=true
  str=ucase(str)
  if len(str)<>3 then isvalidhex=false:exit function
  if left(str,1)<>"%" then isvalidhex=false:exit function
  c=mid(str,2,1)
  if not (((c>="0") and (c<="9")) o&#114; ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  c=mid(str,3,1)
  if not (((c>="0") and (c<="9")) o&#114; ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  end function
</script>
<script language=javascript>
function highlightWord(node,word) {
  // Iterate into this nodes childNodes
  if (node.hasChildNodes) {
    var hi_cn;
    for (hi_cn=0;hi_cn<node.childNodes.length;hi_cn++) {
      highlightWord(node.childNodes[hi_cn],word);
    }
  }
  
  // And do this node itself
  if (node.nodeType == 3) { // text node
    tempNodeVal = node.nodeValue.toLowerCase();
    tempWordVal = word.toLowerCase();
    if (tempNodeVal.indexOf(tempWordVal) != -1) {
      pn = node.parentNode;
      if (pn.className != "searchword") {
        // word has not already been highlighted!
        nv = node.nodeValue;
        ni = tempNodeVal.indexOf(tempWordVal);
        // Cr&#101;ate a load of replacement nodes
        before = document.cr&#101;ateTextNode(nv.substr(0,ni));
        docWordVal = nv.substr(ni,word.length);
        after = document.cr&#101;ateTextNode(nv.substr(ni+word.length));
        hiwordtext = document.cr&#101;ateTextNode(docWordVal);
        hiword = document.cr&#101;ateElement("span");
        hiword.className = "searchword";
        hiword.appendChild(hiwordtext);
        pn.ins&#101;rtBefore(before,node);
        pn.ins&#101;rtBefore(hiword,node);
        pn.ins&#101;rtBefore(after,node);
        pn.removeChild(node);
      }
    }
  }
}

function SearchHighlight() {
  if (!document.cr&#101;ateElement) return;
  ref = document.referrer;
  if (ref.indexOf("?") == -1) return;
  qs = ref.substr(ref.indexOf("?")+1);
  qsa = qs.split("&amp;");
  for (i=0;i<qsa.length;i++) {
    qsip = qsa[i].split("=");
          if (qsip.length == 1) continue;
          if (qsip[0] == "q" || qsip[0] == "p" || qsip[0] == "wd" ) { //搜索引擎关键字参数
      words = UrlDecode(qsip[1].replace(/\+/g," ")).split(/\s+/);
                  for (w=0;w<words.length;w++) {
        highlightWord(document.getElementsByTagName("body")[0],words[w]);
                  }
          }
  }
}

window.onload = SearchHighlight;

</script>

在样式表中添加
代码:
.searchword{background-color: yellow}/*根据实际情况而定*/

Tags: 高亮

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

ASP中正则表达式的应用

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

      一、正则表达式概述
　　二、正则表达式在VBScript中的应用
　　三、正则表达式在VavaScript中的应用
　　四、示例
　　五、总结

　　一、正则表达式概述
　　如果原来没有使用过正则表达式，那么可能对这个术语和概念会不太熟悉。不过，它们并不是您想象的那么新奇。
　　请回想一下在硬盘上是如何查找文件的。您肯定会使用 ? 和 * 字符来帮助查找您正寻找的文件。? 字符匹配文件名中的单个字符，而 * 则匹配一个或多个字符。一个如 "data?.dat" 的模式可以找到下述文件：data1.dat、data2.dat等等。如果使用 * 字符代替 ? 字符，则将扩大找到的文件数量。"data*.dat" 可以匹配下述所有文件名：data.dat、data1.dat、data12.dat等等，尽管这种搜索文件的方法肯定很有用，但也十分有限。? 和 * 通配符的有限能力可以使你对正则表达式能做什么有一个概念，不过正则表达式的功能更强大，也更灵活。
　　在我们编写ASP程序时，经常会判断一个字符串的有效性，如；一个串是否是数字、是否是有效的Email地址等等。如果不使用正则表达式，那么判断的程序会很长，并且容易出错，如果使用正则表达式，这些判断就是一件很轻松的工作了。后面我们将介绍如何判断数字和Email地址的有效性。
　　在典型的搜索和替换操作中，必须提供要查找的确切文字。这种技术对于静态文本中的简单搜索和替换任务可能足够了，但是由于它缺乏灵活性，因此在搜索动态文本时就有困难了，甚至是不可能的。
　　使用正则表达式，能完成些什么事情呢？
　　测试字符串的某个模式。例如，可以对一个输入字符串进行测试，看在该字符串是否存在一个电话号码模式或一个信用卡号码模式。这称为数据有效性验证。
　　替换文本。可以在文档中使用一个正则表达式来标识特定文字，然后可以全部将其删除，或者替换为别的文字。
　　根据模式匹配从字符串中提取一个子字符串。可以用来在文本或输入字段中查找特定文字。
　　例如，如果需要搜索整个 web 站点来删除某些过时的材料并替换某些HTML 格式化标记，则可以使用正则表达式对每个文件进行测试，看在该文件中是否存在所要查找的材料或 HTML 格式化标记。用这个方法，就可以将受影响的文件范围缩小到包含要删除或更改的材料的那些文件。然后可以使用正则表达式来删除过时的材料，最后，可以再次使用正则表达式来查找并替换那些需要替换的标记。
　　那么，正则表达式语法的语法是如何呢？
　　一个正则表达式就是由普通字符(例如字符 a 到 z)以及特殊字符(称为元字符)组成的文字模式。该模式描述在查找文字主体时待匹配的一个或多个字符串。正则表达式作为一个模板，将某个字符模式与所搜索的字符串进行匹配。
　　这里有一些可能会遇到的正则表达式示例：
　　/^\[ \t]*$/                  "^\[ \t]*$" 匹配一个空白行。
　　/\d{2}-\d{5}/            "\d{2}-\d{5}" 验证一个ID 号码是否由一个2位数字，一个连字符以及一个5位数字组成。
　　/<(.*)>.*<\/\1>/        "<(.*)>.*<\/\1>" 匹配一个 HTML 标记。

　　二、正则表达式在VBScript中的应用
　　VBScript使用RegExp对象、Matches集合以及Match对象提供正则表达式支持功能。我们还是先看一个例子。
代码:
<%
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches 　　"建立变量。
Set regEx = New RegExp 　　"建立正则表达式。
regEx.Pattern = patrn　　"设置模式。
regEx.IgnoreCase = True 　　"设置是否区分字符大小写。
regEx.Global = True 　　"设置全局可用性。
Set Matches = regEx.Execute(strng)　　"执行搜索。
For Each Match in Matches　　"遍历匹配集合。
RetStr = RetStr &amp; "Match found at position "
RetStr = RetStr &amp; Match.FirstIndex &amp; ". Match Value is ""
RetStr = RetStr &amp; Match.Value &amp; ""." &amp; "<BR>"
Next
RegExpTest = RetStr
End Function
response.write RegExpTest("[ij]s.", "IS1 Js2 IS3 is4")
%>

在这个例子中，我们查找字符串中有无is或者js这两个词，忽略大小写。运行的结果如下：
Match found at position 0. Match Value is "IS1".
Match found at position 4. Match Value is "Js2".
Match found at position 8. Match Value is "IS3".
Match found at position 12. Match Value is "is4".
下面我们就介绍这三个对象和集合。
　　1、RegExp对象是最重要的一个对象，它有几个属性，其中：
　　○Global 属性，设置或返回一个 Boolean 值，该值指明在整个搜索字符串时模式是全部匹配还是只匹配第一个。如果搜索应用于整个字符串，Global 属性的值为 True，否则其值为 False。默认的设置为 False。
　　○IgnoreCase 属性，设置或返回一个Boolean值，指明模式搜索是否区分大小写。如果搜索是区分大小写的，则 IgnoreCase 属性为 False；否则为 True。缺省值为 False。
　　○Pattern 属性，设置或返回被搜索的正则表达式模式。必选项。总是一个 RegExp 对象变量。
　　2、Match 对象
　　匹配搜索的结果是存放在Match对象中，提供了对正则表达式匹配的只读属性的访问。 Match 对象只能通过 RegExp 对象的 Execute 方法来创建，该方法实际上返回了 Match 对象的集合。所有的 Match 对象属性都是只读的。在执行正则表达式时，可能产生零个或多个 Match 对象。每个 Match 对象提供了被正则表达式搜索找到的字符串的访问、字符串的长度，以及找到匹配的索引位置等。
　　○FirstIndex 属性，返回在搜索字符串中匹配的位置。FirstIndex 属性使用从零起算的偏移量，该偏移量是相对于搜索字符串的起始位置而言的。换言之，字符串中的第一个字符被标识为字符 0
　　○Length 属性，返回在字符串搜索中找到的匹配的长度。
　　○Value 属性，返回在一个搜索字符串中找到的匹配的值或文本。
　　3、Matches 集合
　　正则表达式 Match 对象的集合。Matches 集合中包含若干独立的 Match 对象，只能使用 RegExp 对象的 Execute 方法来创建之。与独立的 Match 对象属性相同，Matches `集合的一个属性是只读的。在执行正则表达式时，可能产生零个或多个 Match 对象。每个 Match 对象都提供了与正则表达式匹配的字符串的访问入口、字符串的长度，以及标识匹配位置的索引。
　　学习了这三个对象和集合，如何应用于字符串的判断和替换呢？regExp对象的三个方法正好解决了这个问题，它们是Replace方法、Test方法和Execute方法。
　　1、Replace 方法
　　替换在正则表达式查找中找到的文本。我们还是先看个例子：下面的例子说明了 Replace 方法的用法。
代码:
<%
Function ReplaceTest(patrn, replStr)
Dim regEx, str1 " 建立变量。
str1 = "The quick brown fox jumped over the lazy dog."
Set regEx = New RegExp " 建立正则表达式。
regEx.Pattern = patrn " 设置模式。
regEx.IgnoreCase = True " 设置是否区分大小写。
ReplaceTest = regEx.Replace(str1, replStr) " 作替换。
End Function
Response.write ReplaceTest("fox", "cat") &amp; "<BR>" " 将 "fox" 替换为 "cat"。
Response.write ReplaceTest("(\S+)(\s+)(\S+)", "$3$2$1") " 交换词对.
%>

　　2、Test 方法
　　对指定的字符串执行一个正则表达式搜索，并返回一个 Boolean 值指示是否找到匹配的模式。正则表达式搜索的实际模式是通过RegExp对象的Pattern属性来设置的。RegExp.Global属性对Test方法没有影响。
　　如果找到了匹配的模式，Test方法返回True；否则返回False。下面的代码说明了Test 方法的用法。
代码:
<%
Function RegExpTest(patrn, strng)
Dim regEx, retVal " 建立变量。
Set regEx = New RegExp " 建立正则表达式。
regEx.Pattern = patrn " 设置模式。
regEx.IgnoreCase = False " 设置是否区分大小写。
retVal = regEx.Test(strng) " 执行搜索测试。
If retVal Then
RegExpTest = "找到一个或多个匹配。"
Else
RegExpTest = "未找到匹配。"
End If
End Function
Response.write RegExpTest("is.", "IS1 is2 IS3 is4")
%>

　　3、Execute 方法
　　对指定的字符串执行正则表达式搜索。正则表达式搜索的设计模式是通过 RegExp 对象的 Pattern 来设置的。
　　Execute 方法返回一个 Matches 集合，其中包含了在 string 中找到的每一个匹配的 Match 对象。如果未找到匹配，Execute 将返回空的 Matches 集合。

　　三、JavaScript中正则表达式的使用
　　在JavaScript 1.2版以后，JavaScript也支持正则表达式。
　　1、replace
　　replace在一个字符串中通过正则表达式查找替换相应的内容。replace并不改变原来的字符串，只是重新生成了一个新的字符串。如果需要执行全局查找或忽略大小写，那么在正则表达式的最后添加g和i。
例：
代码:
<SCRIPT>
re = /apples/gi;
str = "Apples are round, and apples are juicy.";
newstr=str.replace(re, "oranges");
document.write(newstr)
</SCRIPT>

结果是："oranges are round, and o&#114;anges are juicy."
例：
代码:
<SCRIPT>
str = "Twas the night before Xmas...";
newstr=str.replace(/xmas/i, "Christmas");
document.write(newstr)
</SCRIPT>

结果是："Twas the night before Christmas..."
例：
代码:
<SCRIPT>
re = /(\w+)\s(\w+)/;str = "John Smith";
newstr = str.replace(re, "$2, $1");
document.write(newstr)
</SCRIPT>

结果是："Smith, John".
　　2、search
search通过正则表达式查找相应的字符串，只是判断有无匹配的字符串。如果查找成功，search返回匹配串的位置，否则返回-1。
　　　　　　　　　search(regexp)
代码:
<SCRIPT>
function testinput(re, str){
if (str.search(re) != -1)
midstring = " contains ";
else
midstring = " does not contain ";
document.write (str + midstring + re.source);
}
testinput(/^[1-9]/i,"123")
</SCRIPT>

　　3、match
　　match方法执行全局查找，查找结果存放在一个数组里。
例一：
代码:
<SCRIPT>
str = "For more information, see Chapter 3.4.5.1";
re = /(chapter \d+(\.\d)*)/i;
found = str.match(re);
document.write(found);
</SCRIPT>

显示结果：Chapter 3.4.5.1,Chapter 3.4.5.1,.1
例二：
代码:
<SCRIPT>
str = "abcDdcba";
newArray = str.match(/d/gi);
document.write(newArray);
</SCRIPT>

显示结果D, d.

　　四、示例
1 、判断数字的正确性
代码:
<%@ Language=VBScript %>
<script language="javascript" runat="server">
function isNumeric(strNumber) {
return (strNumber.search(/^(-|\+)?\d+(\.\d+)?$/) != -1);
}
function isUnsignedNumeric(strNumber) {
return (strNumber.search(/^\d+(\.\d+)?$/) != -1);
}
function isInteger(strInteger) {
return (strInteger.search(/^(-|\+)?\d+$/) != -1);
}
function isUnsignedInteger(strInteger) {
return (strInteger.search(/^\d+$/) != -1);
}
</script>
<HTML>
<BODY>
<b>判断数字的正确性</b>
<%
Dim strTemp
strTemp = CStr(Request.Form("inputstring"))
If strTemp = "" Then strTemp = "0"
%>
<TABLE BORDER="1" CELLPADDING="4" CELLSPACING="2">
<TR>
<TD ALIGN="right"><B>原始字符串</B></TD>
<TD><%= strTemp %></TD>
</TR>
<TR>
<TD ALIGN="right"><B>数字</B></TD>
<TD><%=isNumeric(strTemp)%></TD>
</TR>
<TR>
<TD ALIGN="right"><B>非负数字</B></TD>
<TD><%=isUnsignedNumeric(strTemp)%></TD>
</TR>
<TR>
<TD ALIGN="right"><B>整数</B></TD>
<TD><%=isInteger(strTemp)%></TD>
</TR>
<TR>
<TD ALIGN="right"><B>非负整数()</B></TD>
<TD><%=isUnsignedInteger(strTemp)%></TD>
</TR>
</TABLE>
<FORM ACTION="<%=Request.ServerVariables("SCRIPT_NAME")%>" METHOD="post">
请输入一个数字:<BR>
<INPUT TYPE="text" NAME="inputstring" SIZE="50"></INPUT><BR>
<INPUT TYPE="submit" Value="提交"></INPUT><BR>
</FORM>
</BODY>
</HTML>

2、判断Email地址的正确性
代码:
<%
Function isemail(strng)
isemail = false
Dim regEx, Match
Set regEx = New RegExp
regEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
regEx.IgnoreCase = True
Set Match = regEx.Execute(strng)
if match.count then isemail= true
End Function
%>

Tags: 正则表达式, 正则

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

Records:123‹12345678910›»