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

ASP JPEG图片处理高级使用方法

 aspjpeg是一款非常强大的图片处理组件,纯英文版本。不过早已经有免费版和破解版,但是对其进行详细与深入介绍的文章却是不多,即使有也只牵涉到图片缩略和图片水印。可能是因为纯英文的缘故。这里我就是针对这些问题谈谈aspjpeg的高级用法。这里的技术主要包括:

aspjpeg唯一点不足的就是输出方式比较单一。在这里,我们主要谈将图片处理保存后再调用的这种输出方法。另外,本人比较懒,所以有些代码仍然引用于原文档,不懂的地方偶会加以解释!

学过vb或者.net的同志肯定一看就明白了。刷子来着。呵呵。

一、图片缩略

代码:

<%
Set Jpeg = Server.Cr&#101;ateObject("Persits.Jpeg") "调用组件
Path = Server.MapPath("images") &amp; "\clock.jpg" "待处理图片路径
Jpeg.Open Path "打开图片
"高与宽为原图片的1/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
"保存图片
Jpeg.Save Server.MapPath("images") &amp; "\clock_small.jpg"
%>

<IMG SRC="images/clock_small.jpg"> 查看处理的图片

二、图片水印

代码:

<%
Set Jpeg = Server.Cr&#101;ateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("images/dodge_viper.jpg")
"开始写文字
Jpeg.Canvas.Font.Color = &amp;HFF0000" red 颜色
Jpeg.Canvas.Font.Family = "Courier New" "字体
Jpeg.Canvas.Font.Bold = True "是否加粗
Jpeg.Canvas.Print 10, 10, "Copyright (c) XYZ, Inc."
"打印坐标x 打印坐标y 需要打印的字符
"以下是对图片进行边框处理
Jpeg.Canvas.Pen.Color = &amp;H000000" black 颜色
Jpeg.Canvas.Pen.Width = 2" 画笔宽度
Jpeg.Canvas.Brush.Solid = False "是否加粗处理
Jpeg.Canvas.Bar 1, 1, Jpeg.Width, Jpeg.Height
"起始X坐标 起始Y坐标 输入长度 输入高度
Jpeg.Save Server.MapPath("images/dodge_viper_framed.jpg") "保存
%>


三、安全码

安全码的道理和加水印差不多,很多朋友问我要具体的代码技术,在这里我就写出来和大家分享,一般人我还不告诉他。呵呵。

代码:
<%
"生成安全码的函数
function make_randomize(max_len,w_n) "max_len 生成长度,w_n:0 可能包含字母,1:只为数字
randomize
for intcounter=1 to max_len
whatnext=int((1-0+1)*rnd+w_n)
if whatnext=0 then
upper=122
lower=97
else
upper=57
lower=48
end if
strnewpass=strnewpass &amp; chr(int((upper-lower+1)*rnd)+lower)
next
make_randomize=strnewpass
end function
%>


生成安全码的图片。当然你要预先准备一张背景图哦

代码:
<%random_num=make_randomize(4,1) "生成4位数字的安全码
session("random_num")=random_num "为什么调用session,没有session的安全码是完全没有意义的。呵呵
Set Jpeg = Server.Cr&#101;ateObject("Persits.Jpeg") "调用组件
Jpeg.Open Server.MapPath("infos/random_pic/random_index.gif") "打开准备的图片
Jpeg.Canvas.Font.Color = &amp;H006699
Jpeg.Canvas.Font.Family = "Arial Black"
Jpeg.Canvas.Font.Bold = false
Jpeg.Canvas.PrintText 0, -2, random_num
jpeg.save Server.MapPath("infos/random_pic/random_index.bmp") "保存
%>

<img src="infos/random_pic/random_index.bmp" border="0" align="absmiddle">
自己做做看。呵呵。
不想做背景图片的。去http://comapny.windowscar....下载吧

四、图片切割

一直以来,对aspjpeg不了解的人以为是无法用它来进行切割的。
其实有这样的一个方法的
crop x1,y1,x2,y2
切割长方型左上角x坐标,y坐标 右下角x坐标 y坐标
下面我就做一个演示哈
Set Jpeg = Server.Cr&#101;ateObject("Persits.Jpeg")
jpeg.open server.MapPath("/pic/1.gif")
jpeg.width=70
Jpeg.Height = Jpeg.OriginalHeight*70 / jpeg.Originawidth
jpeg.crop 0,0,70,52 开始切割其实是把超过52象素的下部分去掉
jpeg.save server.MapPath("/temp_pic/small_1.gif") 保存
怎么样,很简单吧

五、图片合并

我们这里是要把logo图片加到dodge_viper.jpg图片上去
其实,图片合并的方法也可以用来动态打水印哦

Set Photo = Server.Cr&#101;ateObject("Persits.Jpeg")
PhotoPath = Server.MapPath("images") &amp; "\dodge_viper.jpg"
Photo.Open PhotoPath
Set Logo = Server.Cr&#101;ateObject("Persits.Jpeg")
LogoPath = Server.MapPath("images") &amp; "\clock.jpg"
Logo.Open LogoPath

Logo.Width = 70
Logo.Height = Logo.Width * Logo.OriginalHeight / Logo.OriginalWidth

Photo.DrawImage 0, 0, Logo

Photo.SendBinary 这里用了sendBinary的输出方法。当然,你也可以先保存更改后的dodge_viper.jpg,再输入也可以。我个人不大喜欢用sendBinary方法,在网速慢的时候容易出错。在速度方面也不怎样。呵呵。

六、数据库支持

这里不多说了。其实就是Binary方法,大家知道图片存进数据库只能存为二进制的文件的。所以代码就懒的写了。

七、更多方法介绍

Canvas.Line(Left, Top, Right, Bottom)
画一条直线
Canvas.Ellipse(Left, Top, Right, Bottom)
画出一个椭圆
Canvas.Circle(X, Y, Radius)
画出一个圆
Canvas.Bar(Left, Top, Right, Bottom)
画出一个长方形,上面有代码介绍了
Canvas.Font.ShadowColor
文字阴影颜色
Canvas.Font.ShadowXOffset As Long
阴影X坐标设定
Canvas.Font.ShadowYOffset As Long
Y坐标设定
Canvas.Font.BkMode As String
文字背景

Tags: aspjpeg

ASP获取多项选择的值(zt)

原文如下:

引用

<%
dim test
test=Split(request.from("test"),", ")
'取值的时候
Response.Write test(0)
Response.Write "<br />"
Response.Write test(1)
Response.Write "<br />"
Response.Write test(2)
'……
Response.Write "<br />"

'循环取值/操作
For I=0 To UBound(test)
    Response.Write test(I)
    Response.Write "<br />"
Next
%>



原文地址:
http://blog.dushine.com/?a...
这个什么地方用到呢?
好些个复选框name都是test
你的爱好是什么?
《input type="checkbox" name="test" value="打球"》
《input type="checkbox" name="test" value="打人"》
《input type="checkbox" name="test" value="打飞机"》
《input type="checkbox" name="test" value="打屁"》
《input type="checkbox" name="test" value="打酱油"》

然后用到这个方法取出来。嗯

采集相关函数

代码:
Public Function GetFileText(url)
"on error resume next "有错误时继续执行代码
Dim http "定义变量
"Set http=Server.cr&#101;ateobject(XmlHttpCom) "申请对象
Set http=Server.cr&#101;ateobject("Microsoft.XMLHTTP") "保险起见,写出一个服务器一般都支持的版本
Http.open "GET",url,False "打开对象 用GET方式 等待服务器响应
Http.Send() "发送
If Http.readystate<>4 Then "如果服务器没反应,则退出函数
Exit Function
End If

GetFileText=bytes2BSTR(Http.responseBody,"utf-8")

Set http=Nothing
If err.number<>0 Then err.Clear "如果有错误,清除错误
End Function
Function Bytes2bStr(vin,cSet)
Dim BytesStream,StringReturn
Set BytesStream = Server.Cr&#101;ateObject("ADODB.Stream")
BytesStream.Type = 2
BytesStream.Open
BytesStream.WriteText vin
BytesStream.Position = 0
BytesStream.CharSet = cSet
BytesStream.Position = 2
StringReturn =BytesStream.ReadText
BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End Function

Tags: asp函数, 采集, XMLHTTP

水印等比例缩小固定图片大小

代码:
Function pic(picname)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath(PicName)
'response.Write Server.MapPath(PicName)
'response.end
d=jpeg.OriginalWidth*1.25
if Jpeg.OriginalHeight>d then
'a=(Jpeg.OriginalHeight-d)/5
'b=Jpeg.OriginalHeight-a
jpeg.crop 0,0,Jpeg.Originalwidth,d
Jpeg.Save Server.MapPath(PicName)
end if
dd=jpeg.OriginalHeight*0.75
if Jpeg.OriginalHeight<d then
aa=(Jpeg.OriginalWidth-dd)/2
bb=Jpeg.OriginalWidth-aa
jpeg.crop aa,0,bb,Jpeg.OriginalHeight
Jpeg.Save Server.MapPath(picname)
end if
set jpeg=nothing
set logo=nothing
daxiao (PicName)
waterMark (picname)
End Function

Function daxiao(PicName)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath(PicName)
Jpeg.Width =240
Jpeg.Height = 320
Jpeg.Save Server.MapPath(picName)
set jpeg=nothing
set logo=nothing
End Function

Function WaterMark(PicName)
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath(PicName)

Jpeg.Canvas.Font.Color = &HFFffff
Jpeg.Canvas.Font.Family = "宋体"
Jpeg.Canvas.Font.Bold = false
jpeg.Canvas.Font.Size = 13
Jpeg.Canvas.Print Jpeg.OriginalWidth-80, Jpeg.OriginalHeight-20, "mnv520.com"

Jpeg.Save Server.MapPath(PicName)
set jpeg=nothing
set logo=nothing
End Function

纯编码实现Access数据库的建立或压缩

代码:
<%
'#######以下是一个类文件,下面的注解是调用类的方法################################################
'# 注意:如果系统不支持建立Scripting.FileSystemObject对象,那么数据库压缩功能将无法使用
'# Access 数据库类
'# CreateDbFile 建立一个Access 数据库文件
'# CompactDatabase 压缩一个Access 数据库文件
'# 建立对象方法:
'# Set a = New DatabaseTools
'# by (萧寒雪) s.f.
'#########################################################################################

Class DatabaseTools

Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
'建立数据库文件
'If DbVer is 0 Then Create Access97 dbFile
'If DbVer is 1 Then Create Access2000 dbFile
On error resume Next
If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
If DbExists(SavePath & dbFileName) Then
Response.Write ("对不起,该数据库已经存在!")
CreateDBfile = False
Else
Dim Ca
Set Ca = Server.CreateObject("ADOX.Catalog")
If Err.number<>0 Then
Response.Write ("无法建立,请检查错误信息
" & Err.number & "
" & Err.Description)
Err.Clear
Exit function
End If
If DbVer=0 Then
call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName)
Else
call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName)
End If
Set Ca = Nothing
CreateDBfile = True
End If
End function

Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)
'压缩数据库文件
'0 为access 97
'1 为access 2000
On Error resume next
If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
If DbExists(SavePath & dbFileName) Then
Response.Write ("对不起,该数据库已经存在!")
CompactDatabase = False
Else
Dim Cd
Set Cd =Server.CreateObject("JRO.JetEngine")
If Err.number<>0 Then
Response.Write ("无法压缩,请检查错误信息
" & Err.number & "
" & Err.Description)
Err.Clear
Exit function
End If
If DbVer=0 Then
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data
Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
Else
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
End If
'删除旧的数据库文件
call DeleteFile(SavePath & dbFileName)
'将压缩后的数据库文件还原
call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
Set Cd = False
CompactDatabase = True
End If
end function

Public function DbExists(byVal dbPath)
'查找数据库文件是否存在
On Error resume Next
Dim c
Set c = Server.CreateObject("ADODB.Connection")
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
If Err.number<>0 Then
Err.Clear
DbExists = false
else
DbExists = True
End If
set c = nothing
End function

Public function AppPath()
'取当前真实路径
AppPath = Server.MapPath("./")
End function

Public function AppName()
'取当前程序名称
AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
End Function

Public function DeleteFile(filespec)
'删除一个文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number<>0 Then
Response.Write("删除文件发生错误!请查看错误信息
" & Err.number & "
" & Err.Description)
Err.Clear
DeleteFile = False
End If
call fso.DeleteFile(filespec)
Set fso = Nothing
DeleteFile = True
End function

Public function RenameFile(filespec1,filespec2)
'修改一个文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number<>0 Then
Response.Write("修改文件名时发生错误!请查看错误信息
" & Err.number & "
" & Err.Description)
Err.Clear
RenameFile = False
End If
call fso.CopyFile(filespec1,filespec2,True)
call fso.DeleteFile(filespec1)
Set fso = Nothing
RenameFile = True
End function

End Class
%>

ASP初学者常犯的几个错误

1.记录集关闭之前再次打开:
------------------------------------
sql="select * from test"
rs.open sql,conn,1,1
if not rs.eof then
dim myName
myName=rs("name")
end if
sql="select * from myBook"
rs.open sql,conn,1,1
-------------------------------------
解决:在第二次rs.open之前先关闭 rs.close

set rs1=server.createobject
rs1.open sql,conn,1,1

2,用SQL关键字做表名或字段名
-------------------------------------
sql="select * from user"
rs.open sql,conn,1,1
-------------------------------------
user为sql关键字
解决:改为
sql="select * from [user]"

3,用锁定方式去进行update
-------------------------------------
sql="select * from [user]"
rs.open sql,conn,1,1
rs.addnew

rs("userName")="aa"
rs.update
-------------------------------------
当前记录集的打开方式为只读
解决:
改为
rs.open sql,conn,1,3

4,在查询语句中采用的对比字段值与字段类型不符
-----------------------------------------
sql="select * from [user] where id='" & myID & "'"
rs.open sql,conn,1,1
-----------------------------------------
假设表中设计ID为数字型,那么些时出错。
解决:
sql="select * from [user] where id=" & myID

5,未检查变量值而出错
-----------------------------------------
sql="select * from [user] where id=" & myID
rs.open sql,conn,1,1
-----------------------------------------
假设myID变量此时值为null,那么sql将成为
sql="select * from [user] where id="
解决:
在前面加上
if isnull(myID) then 出错提示

6,未检查变量值类型而出错
-----------------------------------------
sql="select * from [user] where id=" & myID
rs.open sql,conn,1,1
-----------------------------------------
假设id为数字型,myID变量此时值不为null,但为字符,比如myID此时为"aa"
那么sql将成为
sql="select * from [user] where id=aa"
解决:
在前面加上
if isnumeric(myID)=false then 出错提示

这也可以有效防止 sql injection 漏洞攻击。

7,由于数据库文件所在目录的NTFS权限而引起的'不能更新。数据库或对象为只读"错误。
说明:
WIN2K系统延续了WINNT系统的NTFS权限。
对于系统中的文夹都有默认的安全设置。
而通过HTTP对WWW访问时的系统默认用户是 iusr_计算机名 用户 ,它属于guest组。
当通过HTTP访问时,可以ASP或JSP,也或是PHP或.NET程序对数据进行修改操作:
比如:
当打开某一个文章时,程序设定,文章的阅读次数=原阅读次数+1
执行
conn.execute("update arts set clicks=clicks+1 where id=n")
语句时,如果 iusr_计算机名 用户没有对数据库的写权限时,就会出错.
解决方法:
找到数据库所在目录
右键》属性》安全选项卡》设置 iusr_计算机名 用户的写权限(当然,也可以是everyone)

ado的Error对象

在ASP 中Connection对象是用于与各类的数据库进行挂接的,但在此过程中将会出现一些不可预测的错误,因而有了Error这个对象。首先要清楚一个概念,Error对象是在连接数据库时产生的,而并非那些运行时的实时错误。也就是我们常用 On Error Resume Next来忽略到的错误。这些错误将在Err对象中,我们可以用一个统一的模板来集中处理,我会在后面给出一个实例。下面还是先来看Error对象的属性和方法:
  1、 Count属性:用来统计Errors集合的数目,它的特点与前面讲到的Property对象的Count对象相同。
  2、 Clear方法:写法为Error.Clear,是用来清除Errors集合中的原有对象的,在统计新的Error对象时应该先使用此语句。
  3、 Item方法:用来指定特定的一个错误,语法为Error.Item(number),其中number为一数字。由于Item为默认的方法,所以Error(number)的写法与前面的写法是等价的。下面是一段程序。用来列举Error的所有对象。
代码:
<%
"this program is testing the ADO"s Error object
Dim i
Set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionString="Driver={Microsoft Access Driver (*.mdb)};DBQ=" _
&Server.Mappath("/source_asp")&"/property/employee.mdb;"
conn.open
if conn.errors.count>0 then
response.write "connection to database cause problem!"&"<br>"
for i =0 to conn.errors.count-1
response.write conn.errors.item(i)&"<br>"
next
else
response.write "connection to database successfully!"
end if
conn.close
%>

ASP与数据库链接的几种方法

一、MS Access 数据库
1、OLE[推荐]
Dim Conn,ConnStr,DBPath
DBPath = "DataBase.mdb"
ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = "&amp;Server.MapPath(DBPath)
"当数据库设置过密码时用以下语句
ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = "&amp; Server.MapPath(DBPath) &amp;";
Jet OLEDB:Database Password=Password"
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open ConnStr
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

2、ODBC
Dim Conn,ConnStr,DBPath
DBPath = "DataBase.mdb"
ConnStr="DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&amp; Server.MapPath(DBPath) &amp;""
"当数据库设置过密码时用以下语句,以下PWD也可写成Password
"ConnStr="DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&amp; Server.MapPath(DBPath) &amp;";
PWD=Password"
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open ConnStr
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

3、DSN
Dim Conn
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open "DSN=YourDSNName"
"当数据库设置过密码时可用以下语句,或在DSN中设置亦可
"Conn.Open "DSN=YourDSNName","UserName","Password"
"经测试UserName可以随便填[Win2KP+IIS5]测试通过
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

二、MS SQL Server
1、OLE[推荐]
Dim Conn,ConnStr
ConnStr="Provider=SQLOLEDB;Server=(local);UID=Username;PWD=Password;DataBase=DB;"
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open ConnStr
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

2、ODBC
Dim Conn,ConnStr
ConnStr="DRIVER={SQL Server};SERVER=(local);UID=Username;PWD=Password;DATABASE=DB"
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open ConnStr
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

3、DSN
Dim Conn
On Error Resume Next
Set Conn = Server.Cr&#101;ateObject("ADODB.Connection")
Conn.Open "DSN=YourDSNName;UID=Username;PWD=Password;DATABASE=DB"
If Err Then
    Err.Clear
    Conn.Close
    Set Conn = Nothing
    Response.Write("数据库链接出错,请检查链接字符串。")
    Response.End()
Else
    Response.Write("数据库链接成功!")
End If

Tags: 数据库链接

关于 TSYS 栏目列表页分页导航的优化

原文地址:
http://www.pcieee.cn/blog/...

在蓝色加强的TSYS1.1里的栏目导航是这样的:
首页  | 上一页  下一页 |  尾页
个人觉得这样有两个问题:

不便于浏览,如果分页很多很多的时候就麻烦了.导航不是很清晰.
在多语言站点中不好使,比如日语啊,英语,翻译过去就不那么好看,且不好用

所以修改了代码,变成这样:

QUOTE:
[1][2][3][4][5][6][7][8][9][10]> >>
加上css控制效果:

这样一也方便用户浏览,也解决了语言问题,地球人都知道怎么翻页了.

首先,定义一个变量:
"生成栏目列表资源数字导航的长数

QUOTE:
Const NewsList_PageMenu=10
为了方便以后修改,把他写在config.asp里

在 Cr&#101;ateClassFile_Fun.asp 页里添加定义几个变量

QUOTE:
        Dim Current_Page"当前页
        Dim k,Min"k为数字导航循环变量,Min为当前页的数字导航最小数
添加函数Page_Path用来求页面路径的,如果你的页面还有其他的参数传递,也便于添加进去,以后修改方便,呵呵~~

QUOTE:
"//////////////////////////////////////
"//函数:生成某页的路径
"//参数:页码
"//返回:路径index.asp index_1.asp  
Function Page_Path(Num)
        If Num=1 Then
                Page_Path="index"&amp; Def_FileExtension
        Else
                Page_Path="index_"&amp; Num-1 &amp; Def_FileExtension
        end if
End Function
分页的正文代码,很详细,请看说明
高手多多批评.

QUOTE:
"生成分页,lspcieee编写
Current_Page=i+1
strPageList=""
Current_Page=i+1

"计算当前页的数字导航最小数Min
If Current_Page mod NewsList_PageMenu Then
  Min=Current_Page-(Current_Page mod NewsList_PageMenu)+1
Else
  Min=Current_Page-NewsList_PageMenu+1
End If

If arrContent>0 Then
  If Min>NewsList_PageMenu then
  "首页
    strPageList=strPageList&amp;"<a href="""&amp;Page_Path(1)&amp;""" id=""Page_Menu_F1"">|<</a>"
  "前NewsList_PageMenu 页
    strPageList=strPageList&amp;"<a href="""&amp;Page_Path(MIn-NewsList_PageMenu)&amp;""" id=""Page_Menu_F2""><</a>"
  End if
  
  "数字导航
  For k= Min to Min+NewsList_PageMenu-1
    If k>arrContent Then
      Exit for
    end if
    If k=Current_Page Then
      strPageList=strPageList&amp;"<span>"&amp;k&amp;"</span>"
    Else
      strPageList=strPageList&amp;"<a href="""&amp;Page_Path(k)&amp;""">"&amp;k&amp;"</a>"
    End If
  Next
  
  "下NewsList_PageMenu页
  If arrContent>=Min+NewsList_PageMenu Then
    strPageList=strPageList&amp;"<a href="""&amp;Page_Path(MIn+NewsList_PageMenu)&amp;""" id=""Page_Menu_N2"">></a>"
    strPageList=strPageList&amp;"<a href="""&amp;Page_Path(arrContent)&amp;""" id=""Page_Menu_N1"">>|</a>"
  End If

End if
"分页结束      
以上程序也同时带来一个问题
如果你的站点数据量特别大,在生成的时候,会慢一些, NewsList_PageMenu变量的值越大,速度就越慢~~呵呵,因为这样循环的次数就更多,但是,我觉得站点数据不是特别特别大的话,为了前台用户的访问的可用性,多一花一秒两秒,没有什么关系的...

另建议:
去掉在生成单独资源的时候生成同时生成列表,方法:
请去掉News_mdy.asp的以下内容:

QUOTE:
    行151  UsedTemplate_Cr&#101;ateClassFile(Id)
    行379  And UsedTemplate_Cr&#101;ateClassFile(CLng(IdList(I)))
这样在生成单独的资源时可以提升一些速度
呵呵,欢迎兄弟门一起讨论,指出BUG
http://www.pcieee.cn/blog/...

[ 本帖最后由 lspcieee 于 2006-5-30 18:31 编辑 ]

相关关键字: tsys 导航 栏目

Tags: tsys, 分页

ASP和MSSQL存储过程的实现小例

很多朋友学ASP以后,就只会简单的Sel&#101;ct、Up&#100;ate、Del&#101;te几个基本命令。这样在读取或者存入数据的时候,大大降低的系统运行的速度。今天第一次到这个社区来,就先发个小例子让还不会的朋友学习一下。

Cr&#101;ate PROCEDURE Proname  //使用Cr&#101;ate PROCEDURE 创建存储过程 Proname为存储过程名称
@Lname VARCHAR(30)   //定义传入的参数
AS
SET NOCOUNT ON
BEGIN
Sel&#101;ct * FROM TableName Wh&#101;re Lname like "%@Lname%" //使用SELECE模糊查询Lname值与传入参数Lname的值相近所有行
END
GO

以上就是已经创建了一个带一个输入参数的存储过程,并且返回所有查询的记过集。
下面就开始使用ASP操作这个存储过程。

//下面是建立与MSSQL SERVER连接的字符串,大家都知道,我就不讲了。
strConnect = "Driver={SQL Server};Server=(local);uid=sa;password=;database=dataname"
Set conn = server.Cr&#101;ateObject ("Adodb.Connection")
conn.Open strConnect

SET cmd  = Server.Cr&#101;ateObject("ADODB.Command")   //建立一个COMMAND命令对象
with cmd
cmd.ActiveConnection = conn  //conn为连接字符串
cmd.CommandText = "Proname"  //这里为要使用的存储过程名称
cmd.CommandType = 4   //CommandType属性表明请求的类型。
//-1 表明CommandText参数的类型无法确定  
//1 表明CommandText是一般的命令类型  
//2 表明CommandText参数是一个存在的表名称  
//4 表明CommandText参数是一个存储过程的名称,所以这里CommandType = 4。
cmd.Prepared = true  //要求将SQL命令先编译
cmd.Parameters.append cmd.Cr&#101;ateParameter("@Lname",3,1,4,Lname) //添加参数@Lname,后面的Lname是自己在ASP页面里定义的变量。
Set rs = cmd.Execute  //设置rs变量取得返回的查询纪录集。
end with

DO WHILE NOT rs.EOF  //用DO循环读出rs纪录集里面的行
RESPONSE.WRITE(rs("字段名")&amp;"<BR />")
rs.MOVENEXT  //移动到下一条
LOOP   //结束循环

rs.CLOSE   //关闭对象

Tags: 存储过程