导航

心动吧黑客BLOG

自发研究:须要多维思想而且要想不可能为可能的人才能做到

« ASp ADO对像之Connection(第十七节)心动吧警告:除20080508外并未发布其他版本 »

ASp 在ASP中怎样才能用动态数组

dim arr()



redim arr(2)



redim arr(4)重新定义一个数组,以前的值都不保留



redim preserve arr(5)保留以前的值



redim a(10)



1----> redim a(20) '这样的话原来a(10)中的所有内容会没掉



2----> redim preserve a(20) '这样的话原来的a(10)中的内容就不会掉



=============================================



常用ASP自定义函数集



rem ---表单提示函数 Being-----------------------------

CODE Copy ...

Function Check_submit(str,restr)

if str="" then

response.write "<script>"

response.write "alert('"&restr&"');"

response.write "history.go(-1)"

response.write "</script>"

response.end

else

Check_submit=str

end if

End Function



CODE Copy ...

Function Alert_submit(str)

response.write "<script>"

response.write "alert('"&str&"');"

'response.write "location.reload();"

response.write "</script>"

End Function



CODE Copy ...

Function localhost_submit(str,urls)

response.write "<script>"

if str<>"" then

response.write "alert('"&str&"');"

end if

response.write "location='"&urls&"';"

response.write "</script>"

End Function



rem ---生成自定义位随机数 Being-----------------------------

CODE Copy ...

Function makerndid(byVal maxLen)

Dim strNewPass

Dim whatsNext, upper, lower, intCounter

RANdomize

For intCounter = 1 To maxLen

whatsNext = int(2 * Rnd)

If whatsNext = 0 Then

upper = 80

lower = 70

Else

upper = 48

lower = 39

End If

strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + upper))

Next

makerndid = strNewPass

End Function



rem ---生成四位随机数 Being-----------------------------

CODE Copy ...

Function get_rand()

dim num1

dim rndnum

Randomize

Do While Len(rndnum)<4

num1=CStr(Chr((57-48)*rnd+48))

rndnum=rndnum&num1

loop

get_rand=rndnum

End Function



rem ---判断数据是否整型 Being-----------------------------

CODE Copy ...

Function IsInteger(para)

on error resume next

dim str

dim l,i

if isNUll(para) then

isInteger=false

exit function

end if

str=cstr(para)

if trim(str)="" then

isInteger=false

exit function

end if

l=len(str)

for i=1 to l

if mid(str,i,1)>"9" or mid(str,i,1)<"0" then

isInteger=false

exit function

end if

next

isInteger=true

if err.number<>0 then err.clear

End Function



rem ---数据库链接函数 Being-----------------------------

CODE Copy ...

Function OpenCONN

Set conn = Server.CreateObject("ADODB.Connection")

connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DB_login)

conn.Open connstr

End Function



rem ---中文字符转Uncode代码函数 Being-----------------------------

CODE Copy ...

Function URLEncoding(vstrIn)

strReturn = ""

For i = 1 To Len(vstrIn)

ThisChr = Mid(vStrIn,i,1)

If Abs(Asc(ThisChr)) < &HFF Then

strReturn = strReturn & ThisChr

Else

innerCode = Asc(ThisChr)

If innerCode < 0 Then

innerCode = innerCode + &H10000

End If

Hight8 = (innerCode And &HFF00)\ &HFF

Low8 = innerCode And &HFF

strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)

End If

Next

URLEncoding = strReturn

End Function



rem ---Html过滤函数 Being-----------------------------Function Htmlout(str)

CODE Copy ...

dim result

dim l

if isNULL(str) then

Htmlout=""

exit function

end if

l=len(str)

result=""

dim i

for i = 1 to l

select case mid(str,i,1)

case "<"

result=result+"&lt;"

case ">"

result=result+"&gt;"

case chr(13)

if session("admin_system")="" then

result=result+"<br>"

end if

case chr(34)

result=result+"&quot;"

case "&"

result=result+"&amp;"

case chr(32)

'result=result+"&nbsp;"

if i+1<=l and i-1>0 then

if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then

result=result+"&nbsp;"

else

result=result+" "

end if

else

result=result+"&nbsp;"

end if

case chr(9)

result=result+" "

case else

result=result+mid(str,i,1)

end select

next

Htmlout=result

End Function



rem ---textarea显示用---

CODE Copy ...

function htmlencode1(fString)

if fString<>"" and not isnull(fString) then

fString = replace(fString, "&gt;", ">")

fString = replace(fString, "&lt;", "<")

fString = Replace(fString, "&nbsp;", chr(32))

fString = Replace(fString, "</p><p>", CHR(10) & CHR(10))

fString = Replace(fString, "<br>", CHR(10))

htmlencode1=fString

else

htmlencode1=""

end if

end function



rem ---页面显示用---

CODE Copy ...

function htmlencode2(fString)

if fString<>"" and not isnull(fString) then

fString = replace(fString, ">", "&gt;")

fString = replace(fString, "<", "&lt;")

fString = Replace(fString, chr(32), "&nbsp;")

fString = Replace(fString, CHR(10) & CHR(10), "</p><p>")

fString = Replace(fString, CHR(10), "<br>")

htmlencode2=fString

else

htmlencode2=""

end if

end function



rem ---取出指定字符串前后的字符串方法---

CODE Copy ...

function GetStrs(str1,CharFlag,Dflag)

dim tmpstr

if Dflag=0 then'取左

pos1=instr(str1,charFlag)

if pos1<=20 then

tmpstr=left(str1,pos1-1)

else

tmpstr=mid(str1,pos1-20,20)

end if

else '取右

pos1=instr(str1,charFlag)+len(charFlag)

if len(str1)-pos1<=20 then

tmpstr=right(str1,len(str1)-pos1)

else

tmpstr=mid(str1,pos1+1,20)

end if

end if

GetStrs=tmpstr

end function



rem ---取出文件名---

CODE Copy ...

function getfilename(str)

pos=instr(str,".")

if str<>"" then

str=mid(str,pos,len(str))

end if

getfilename=str

end function



rem ---取到浏览器版本转换字符串---

CODE Copy ...

function browser()

dim text

text = Request.ServerVariables("HTTP_USER_AGENT")

if Instr(text,"MSIE 5.5")>0 then

browser="IE 5.5"

elseif Instr(text,"MSIE 6.0")>0 then

browser="IE 6.0"

elseif Instr(text,"MSIE 5.01")>0 then

browser="IE 5.01"

elseif Instr(text,"MSIE 5.0")>0 then

browser="IE 5.00"

elseif Instr(text,"MSIE 4.0")>0 then

browser="IE 4.01"

else

browser="未知"

end if

end function



rem ---取到系统脚本转换字符串---

CODE Copy ...

function system(text)

if Instr(text,"NT 5.1")>0 then

system=system+"Windows XP"

elseif Instr(text,"NT 5")>0 then

system=system+"Windows 2000"

elseif Instr(text,"NT 4")>0 then

system=system+"Windows NT4"

elseif Instr(text,"4.9")>0 then

system=system+"Windows ME"

elseif Instr(text,"98")>0 then

system=system+"Windows 98"

elseif Instr(text,"95")>0 then

system=system+"Windows 95"

else

system=system+"未知"

end if

end function



rem ---=删除文件---

CODE Copy ...

function delfile(filepath)

imangepath=trim(filepath)

path=server.MapPath(imangepath)

SET fs=server.CreateObject("Scripting.FileSystemObject")

if FS.FileExists(path) then

FS.DeleteFile(path)

end if

set fs=nothing

end function



rem ---得到真实的客户端IP---

CODE Copy ...

Public Function GetClientIP()

dim uIpAddr

' 本函数参考webcn.Net/AspHouse 文献<取真实的客户IP>

uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")

If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR")

GetClientIP = uIpAddr

uIpAddr = ""

End function



数据库查询中的特殊字符的问题

在进行数据库的查询时,会经常遇到这样的情况:

  例如想在一个用户数据库中查询他的用户名和他的密码,但恰好该用户使用的名字和密码中有特殊的字符,例如单引号,“|”号,双引号或者连字符“&”。

  例如他的名字是1"test,密码是A|&900

  这时当你执行以下的查询语句时,肯定会报错:

SQL = "SELECT * FROM SecurityLevel WHERE UID="" & UserID & """

SQL = SQL & " AND PWD="" & Password & """

  因为你的SQL将会是这样:

SELECT * FROM SecurityLevel WHERE UID="1"test" AND PWD="A|&900"

  在SQL中,"|"为分割字段用的,显然会出错了。现在提供下面的几个函数专门用来处理这些头疼的东西:

Quoted from Unkown:



Function ReplaceStr (TextIn, ByVal SearchStr As String, _

ByVal Replacement As String, _

ByVal CompMode As Integer)



 Dim WorkText As String, Pointer As Integer

 If IsNull(TextIn) Then

  ReplaceStr = Null

 Else

  WorkText = TextIn

  Pointer = InStr(1, WorkText, SearchStr, CompMode)

  Do While Pointer > 0

   WorkText = Left(WorkText, Pointer - 1) & Replacement & _

   Mid(WorkText, Pointer + Len(SearchStr))

   Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode)

  Loop

  ReplaceStr = WorkText

 End If

End Function



Function SQLFixup(TextIn)

 SQLFixup = ReplaceStr(TextIn, """, """", 0)

End Function

Function JetSQLFixup(TextIn)

 Dim Temp

 Temp = ReplaceStr(TextIn, """, """", 0)

 JetSQLFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)

End Function



Function FindFirstFixup(TextIn)

 Dim Temp

 Temp = ReplaceStr(TextIn, """, "" & chr(39) & "", 0)

 FindFirstFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)

End Function



rem 借助RecordSet将二进制流转化成文本

Quoted from Unkown:

Function BinaryToString(biData,Size)

Const adLongVarChar = 201

Set RS = CreateObject("ADODB.Recordset")

RS.Fields.Append "mBinary", adLongVarChar, Size

RS.Open

RS.AddNew

RS("mBinary").AppendChunk(biData)

RS.Update

BinaryToString = RS("mBinary").Value

RS.Close

End Function

原创文章如转载,请注明:转载自心动吧黑客BLOG [ http://www.abcxd.com/abcxd/ ]

本文链接地址:http://www.abcxd.com/abcxd/abcxdArticle/asp/156/

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

黑客榜之本月排行

搜索内容

日历

Copyright ⊙ 2004-2009 心动吧 UrL:ABCXD.CoM All RiGhts Reserved