整理了一些asp初学者常用的代码 (6)

1。文本框自动滚动条：
<textarea name=words rows=18 cols=26 style="border:1 solid #000000;background-color:white; font-size:9pt; width:188; overflow:auto" wrap=hard></textarea>
2。背景全屏
<script language="JavaScript">
function makeIm() {
NS4=(document.layers);
IE4=(document.all);
scaleWidth = true;
scaleHeight = true;
imSRC = "image/200263164930.jpg";
if (NS4) {
origWidth = innerWidth;
origHeight = innerHeight;}
function reDo() {
if (innerWidth != origWidth || innerHeight != origHeight)
location.reload();}
if (NS4) onresize = reDo;
if (IE4) onresize = reDoIE;
function reDoIE(){
imBG.width = document.body.clientWidth;
imBG.height = document.body.clientHeight;}
winWid = (NS4) ? innerWidth : document.body.clientWidth;
winHgt = (NS4) ? innerHeight : document.body.clientHeight;
imStr = "<div id=elBGim"
+ " style='position:absolute;left:0;top:0;z-index:-1'>"
+ "<img name='imBG' border='0' src="+imSRC;
if (scaleWidth) imStr += " width="+winWid;
if (scaleHeight) imStr += " height="+winHgt;
imStr += "></div>";
document.write(imStr);}
makeIm();
</script>
3。全选并复制
<FORM name=test><INPUT οnclick="javascript:HighlightAll('test.select1')" type=button value=全选并复制><BR><TEXTAREA name=select1 rows=3 cols=46>你好，欢迎您的光临！</TEXTAREA>
</FORM>
<SCRIPT language=Javascript>
<!--

var copytoclip=1

function HighlightAll(theField) {
var tempval=eval("document."+theField)
tempval.focus()
tempval.select()
if (document.all&&copytoclip==1){
therange=tempval.createTextRange()
therange.execCommand("Copy")
window.status="Contents highlighted and copied to clipboard!"
setTimeout("window.status=''",1800)
}
}
//-->
</SCRIPT>
4。屏蔽JAVASCRIPT错误
<script language="JavaScript">
<!--
function killErrors(){
return true;
}
window.onerror = killErrors;
-->
</script>


活用 Index server SSO 组件 (企业内网搜索引型)

1, 到 管理工具 ---> 服务 ---> Indexing Service 组件 (激活并设置自动)

2. 在wwwboot 根目录 建立 search.asp

3.在IIS 运行 search.asp 完成

search.asp

<script language="vbscript" RunAt="Server">
Dim SearchScope,LocaleID,QryStr
Dim ASPFile,NewQuery,UsedQuery
Dim PageSize
Dim NextPgNo,NextRecNo,CurrentPage
Dim ActiveQuery
Dim Rs,Q,util
Sub Initialize()
SearchScope="/"
LocaleID="ZH-CN"
PageSize=20
NewQuery=FALSE
UsedQuery=False
QryStr=""
ASPFile=Request.ServerVariables("PATH_INFO")
ENd sub

Sub Judge_Method()
if Request.ServerVariables("REQUEST_METHOD")="POST" then
QryStr=Request.Form("QryStr")
if Request.Form("Action")="执行" then
NewQuery=True
end if
end if
if Request.ServerVariables("REQUEST_METHOD")="GET" then
QryStr=Request.QueryString("qu")
SearchScope=Request.QueryString("sc")
if Request.QueryString("pg")<>"" then
NextPgNo=Request.QueryString("pg")
NewQuery=false
UsedQuery=true
else
NewQuery=QryStr<>""
end if
end if
end sub

sub Show_Mainform()
Response.write "<font size=+3><b>全文数据检索系统</b></font>"
Response.write "<Form action='"& ASPFile &"' METHOD=Post>"
Response.write "请输入查询的字符串:"
Response.write "<input type='text' name='QryStr' Size=46 MAXLENGTH=100 VALUE='"&QryStr&"'>"
Response.write "&nbsp;<input type='submit' name='Action' value='执行'>"
Response.write "&nbsp;<input type='reset' name='Cleat' value='清除'>"
Response.write "<ht></form>"
end sub

sub Init_ixsso()
Dim StrLen
if NewQuery then
Set Session("Query")=Nothing
Set Session("Recordset")=Nothing
NextRecNo=1
strLen=len(QryStr)
if left(QryStr,1)=chr(34) then
StrLen=Strlen-1
Qrystr=right(QryStr,StrLen)
end if
if right(QryStr,1)=chr(34) then
StrLen=StrLen-1
Qrystr=Left(QryStr,StrLen)
end if
Set Q=server.createobject("ixsso.Query")
set util=Server.Createobject("ixsso.Util")
Q.Query=QryStr
Q.SortBy="rank[d]"
Q.Columns="DocTitle,vpath,filename,size,write,characterization,rank"
Q.MaxRecords=3000
if SearchScope <>"/" then
util.AddScopeToQuery Q,SearchScope,"deep"
end if
if LocaleID<>"" then
Q.LocaleID=util.ISOToLocaleID(LocaleID)
end if
set Rs=Q.CreateRecordSet("nonsequential")
Rs.pagesize=PageSize
ActiveQuery=true
else UsedQuery=true
if Isobject(Session("Query")) and IsObject(Session("RecordSet")) then
set Q=Session("Query")
set RS=Session("RecordSet")
if Rs.RecordCount<>-1 and NextPgNo <>-1 then
Rs.AbsolutePage=NextPgNo
NextRecNo=Rs.AbsolutePosition
end if
ActiveQuery=true
else
Response.write "错误 - 尚无任何查询条件！"
end if
end if
End Sub

Sub show_Query()
Dim LastRecordOnPage
if ActiveQuery then
if not Rs.Eof then
LastRecordOnPage=NextRecNo+Rs.PageSize - 1
CurrentPage=Rs.AbsolutePage
if Rs.RecordCount <> -1 And _
Rs.RecordCount < LastRecordOnPage then
LastRecordOnPage=Rs.RecordCount
end if
Response.write "文件"&NextRecNo&"至"
Response.write LastRecordOnPage&","
if Rs.RecordCount <> -1 then
Response.write "总共有<font color='red'><b>"
Response.write Rs.RecordCount&"</b></font>"
end if
Response.write "条件录符合查询条件:"&chr(34)&"<b>"
Response.write QryStr & "</b>" & chr(34) &".<p>"
if Not Rs.eof and NextRecNo <= LastRecordOnPage then
Response.write "<table border='0'><colgroup width=105>"
end if
Do While Not Rs.eof and NextRecNo <= LastRecordOnpage
Response.write "<p><tr class='RecordTitle'>"
Response.write "<td align='right' valign='top' bgcolor='#ffff80' class='RecordTitle'>"
Response.write NextRecNo&".</td>"
Response.write "<td bgcolor='#ffff80'>"
Response.write "<b class='RecordTitle'>"
if VarType(Rs("DocTitle"))=1 or RS("DocTitle")="" then
Response.write "<a href='"&Rs("vpath")&"'"&"class='RecordTitle'>"
Response.write Server.HTMLEncode(RS("filename"))&"</a>"
else
Response.write "<a href='"&Rs("vpath")&"' class='RecordTitle'>"
Response.write Server.HTMLEncode(Rs("DocTitle"))&"</a>"
end if
Response.write "</b></td></tr><tr><td></td><td valign='top'>"
if VarType(Rs("characterization"))=8 and _
Rs("characterization")<>"" then
Response.write "<b><i>摘要</i></b>"
Response.write Server.HTMlEncode(Rs("characterization"))
end if
Response.write "<p><i class='RecordStats'><a href='"&Rs("vpath")&"' class='RecordStats' style='color:blue;'>http://"
Response.write Request("server_name")&Rs("vpath")&"</a><br>"
if Rs("size")="" then
Response.Write "(大小和时间不详)"
else
Response.write "大小"&Rs("size")&"个字节-"
Response.write Rs("write")&"GMT"
end if
Response.write "</i></td></tr><tr></tr>"
RS.MoveNext
NextRecNo=NextRecNo+1
loop
Response.write "</table><P><br>"
else
if NextRecNo=1 then
Response.write "没有任何文件符合查询条件!<p>"
else
Response.write "符合查询条件的文件均已显示!<p>"
end if
end if
'if Q.OutOfDate then
' Response.Write "<p><i><b>检索即将过期(out of date).</b></i><br>"
'end if
if Q.QueryIncomplete then
Response.write "<p><i><b>查询无法完整完成"
Response.write "(Query Incomplete).</b></i><br>"
end if
if Q.QueryTimedOut then
Response.Write "<p><i><b>查询时间太长(Time out). </b></i><br>"
end if
Call Show_Button()
end if
End Sub
Sub Show_Button()
Dim SaveQuery
Response.write"<table>"
SaveQuery=false
if CurrentPage > 1 and Rs.RecordCount <> -1 then
Response.write "<td align=left>"
Response.write "<form action='" & ASPFile & "' method='get'>"
Response.write "<input Type='HiDDen' name='qu' value='"& QryStr & "'>"
Response.write "<input type='hidden' name='sc' value='"& SearchScope & "'>"
Response.write "<input type='hidden' name='pg' value='"& CurrentPage-1&"'>"
Response.write "<input type='submit' value='前 "
Response.write Rs.PageSize &"份文件'>"
Response.write "</form></td>"
SaveQuery=true
end if
if Not Rs.eof then
Response.Write "<td align='right'><form action='"&ASPFile&"' method='get'>"
Response.write "<input type='hidden' name='qu' value='"&QryStr&"'>"
Response.write "<input type='hidden' name='sc' value='"&SearchScope&"'>"
Response.write "<input type='hidden' name='pg' value='"&CurrentPage+1&"'>"
NextString="后 "
if Rs.RecordCount <>-1 then
NextSet=(Rs.RecordCount-NextRecNo)+1
if NextSet > Rs.PageSize then
NextSet=Rs.PageSize
end if
NextString=NextString&NextSet&"份文件"
else
NextString=NextString & " 页文件"
end if
Response.write "<input type='submit' value='"& NextString &"'>"
Response.write "</form></td>"
SaveQuery=true
end if
Response.write "</table> 页数:"& CurrentPage
if Rs.pageCount <> -1 then
Response.write "/" & Rs.pageCount
end if
if SaveQuery then
set Session("Query")=Q
set Session("RecordSet")=Rs
else
Rs.close
set Rs=nothing
set Q=Nothing
set Session("Query")=Nothing
set Session("RecordSet")=Nothing
end if
end sub
</script>
<html>
<head>
<meta name="MS.LOCALE" CONTENT="ZH-CH">
<mete http-EQUIV="Content-Type" CONTent="text/html;charset=gb">
<title>全文数据搜索引型</title>
<body>
<%
call Initialize()
call Judge_Method()
call Show_Mainform()
call Init_ixsso()
call Show_Query()
%>
</body>
</html>


[推荐]非常准确的测试图片宽高的一个类
Class GetImage_WH
Private Cls_obj_Image,Cls_PicName,Cls_Errors,Cls_fso,Errs
Private Pic_Ext,Pic_Types,Pic_Width,Pic_Height

Private Sub Class_Initialize
set Cls_obj_Image=CreateObject("Adodb.Stream")
Set Cls_FSO=CreateObject("Scripting.FileSystemObject")
Cls_obj_Image.Mode=3
Cls_obj_Image.Type=1
Cls_obj_Image.Open
Pic_Types="GIF|JPG|PNG|BMP"
Errs=0
End Sub

Private Sub Class_Terminate
set Cls_obj_Image=nothing
set Cls_FSO=nothing
End Sub

'属性，得到图像的路径及图片名
Public Property Let PicName(str_PicName)
If str_PicName<>"" or not isNull(str_PicName) Then
If instr(str_PicName,":")=0 then
Cls_PicName=Server.Mappath(str_PicName)
Else
Cls_PicName=Replace(str_PicName,"/","/")
End If
Pic_Ext=Ucase(Right(Cls_PicName,3))
If instr(Pic_Types,Pic_Ext)=0 then
Cls_Errors=Cls_Errors & "图片类型不正确，只能是{"&Pic_Types&"}等格式"
Errs=3
Else
If not Cls_FSO.FileExists(Cls_PicName) Then
Cls_Errors=Cls_Errors & "所在路径的图片不存在"
Errs=2
End IF
End if
Else
Cls_Errors=Cls_Errors & "图片名和路径不能为空"
Errs=1
End If
IF Errs=0 then
GetImageSize()
End IF
End Property

'获取图片的名称
Public Property Get GetPicName()
Dim i,str_Name
str_Name=split(Cls_PicName,"/")
i=Ubound(str_Name)
GetPicName=str_Name(i)
End Property
'获取图片的宽度
Public Property Get GetPicWidth()
GetPicWidth=Pic_Width
End Property
'获取图片的扩展名
Public Property Get GetPicExt()
GetPicExt=Pic_Ext
End Property
'获取图片的高度
Public Property Get GetPicHeight()
GetPicHeight=Pic_Height
End Property
'获取类错误值
Public Function Error()
Error=Errs
End Function
'获取类错误信息
Public Function GetErrors()
GetErrors=Cls_Errors
End Function

Private Function Bin2Str(Bin)
Dim I, Str,Cls_Clow
For I=1 to LenB(Bin)
Cls_Clow=MidB(Bin,I,1)
if ASCB(Cls_Clow)<128 then
Str = Str & Chr(ASCB(Cls_Clow))
else
I=I+1
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&Cls_Clow))
end if
Next
Bin2Str = Str
End Function

Private Function Num2Str(num,base,lens)
dim Cls_Ret
Cls_Ret = ""
while(num>=base)
Cls_Ret = (num mod base) & Cls_Ret
num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & Cls_Ret,lens)
End Function

Private Function Str2Num(str,base)
dim Cls_Ret
Cls_Ret = 0
for i=1 to len(str)
Cls_Ret = Cls_Ret *base + cint(mid(str,i,1))
next
Str2Num=Cls_Ret
End Function

Private Function BinVal(bin)
dim Cls_Ret,i
Cls_Ret = 0
for i = lenb(bin) to 1 step -1
Cls_Ret = Cls_Ret *256 + ascb(midb(bin,i,1))
next
BinVal=Cls_Ret
End Function

Private Function BinVal2(bin)
dim Cls_Ret,i
Cls_Ret = 0
for i = 1 to lenb(bin)
Cls_Ret = Cls_Ret *256 + ascb(midb(bin,i,1))
next
BinVal2=Cls_Ret
End Function

Private Function GetImageSize()
dim Cls_Ret(3),bFlag,P1
Cls_obj_Image.LoadFromFile(Cls_PicName)
bFlag=Cls_obj_Image.read(3)
select case hex(binVal(bFlag))
case "4E5089":
Cls_obj_Image.read(15)
Cls_Ret(0)="PNG"
Cls_Ret(1)=BinVal2(Cls_obj_Image.read(2))
Cls_obj_Image.read(2)
Cls_Ret(2)=BinVal2(Cls_obj_Image.read(2))
case "464947":
Cls_obj_Image.read(3)
Cls_Ret(0)="GIF"
Cls_Ret(1)=BinVal(Cls_obj_Image.read(2))
Cls_Ret(2)=BinVal(Cls_obj_Image.read(2))
case "FFD8FF":
do
dP1=binVal(Cls_obj_Image.Read(1)): loop while P1=255 and not Cls_obj_Image.EOS
if P1>191 and P1<196 then exit do else Cls_obj_Image.read(binval2(Cls_obj_Image.Read(2))-2)
dP1=binVal(Cls_obj_Image.Read(1)):loop while P1<255 and not Cls_obj_Image.EOS
loop while true
Cls_obj_Image.Read(3)
Cls_Ret(0)="JPG"
Cls_Ret(2)=binval2(Cls_obj_Image.Read(2))
Cls_Ret(1)=binval2(Cls_obj_Image.Read(2))
case else:
if left(Bin2Str(bFlag),2)="BM" then
Cls_obj_Image.Read(15)
Cls_Ret(0)="BMP"
Cls_Ret(1)=binval(Cls_obj_Image.Read(4))
Cls_Ret(2)=binval(Cls_obj_Image.Read(4))
else
Cls_Ret(0)=""
end if
end select
Pic_Width=Cls_Ret(1)
Pic_Height=Cls_Ret(2)
End Function
End Class

用法：

dim thisPic
set thisPic=new GetImage_WH
With thisPic
.PicName="images/foat.jpg"
if .Error>0 then
response.write .GetErrors
else
response.write "图片名："&.GetPicName&"<br>扩展名："&.GetPicExt&"<br> 宽:" & .GetPicWidth & "<br> 高:" & .GetPicHeight
end if
End with
Set thisPic=nothing


16.使用FSO修改文件特定内容的函数
function FSOchange(filename,Target,String)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FiletempData = objCountFile.ReadAll
objCountFile.Close
FiletempData=Replace(FiletempData,Target,String)
Set objCountFile=objFSO.CreateTextFile(Server.MapPath(filename),True)
objCountFile.Write FiletempData
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
17.使用FSO读取文件内容的函数
function FSOFileRead(filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
18.使用FSO读取文件某一行的函数
function FSOlinedit(filename,lineNum)
if linenum < 1 then exit function
dim fso,f,temparray,tempcnt
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr(10))
if lineNum>ubound(temparray)+1 then
exit function
else
FSOlinedit = temparray(lineNum-1)
end if
end if
end function
19.使用FSO写文件某一行的函数
function FSOlinewrite(filename,lineNum,Linecontent)
if linenum < 1 then exit function
dim fso,f,temparray,tempCnt
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
temparray = split(tempcnt,chr(13)&chr(10))
if lineNum>ubound(temparray)+1 then
exit function
else
temparray(lineNum-1) = lineContent
end if
tempcnt = join(temparray,chr(13)&chr(10))
set f = fso.createtextfile(server.mappath(filename),true)
f.write tempcnt
end if
f.close
set f = nothing
end function
20.使用FSO添加文件新行的函数
function FSOappline(filename,Linecontent)
dim fso,f
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),8,1)
f.write chr(13)&chr(10)&Linecontent
f.close
set f = nothing
end function
21.读文件最后一行的函数
function FSOlastline(filename)
dim fso,f,temparray,tempcnt
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr(10))
FSOlastline = temparray(ubound(temparray))
end if
end function