ASP的自定义函数[8]
利用ASP怎么实现对指定文件夹下的内容（包括子文件夹的）进行搜索？
搜索出来的结果再分页显示？
这是Lshdic以前写过的,在Lshdic2002中有更详细的FSO对象浏览器<p>
做成ASP你可以手工改一改，这里方便浏览<p>
<script language=vbs>
Set fso=CreateObject("Scripting.FileSystemObject")
set getfso=fso.GetFolder("c:\windows\desktop").files
document.write "以下是桌面所有文件"
for each i in getfso
document.write i & "<br>"
next
document.write "<p>以下是桌面所有文件子文件夹包含的文件夹和文件<p>"
set getfso=fso.GetFolder("c:\windows\desktop").SubFolders
for each r in getfso
document.write r & " 文件夹包含<p>"
set getfso1=fso.GetFolder(r).files
for each n in getfso1
document.write n & "<br>"
next
next
</script>
身份证真伪
'id 省份证号
'birthday生日,yyyy-mm-dd格式
'sex性别,值为"男:1","女:0"
id = "460102800925121"
birthday = "1980-09-25"
sex = 1
IF idcard_check(id,birthday,sex) Then
response.write "不错"
else
response.write "**"
End if
Function idcard_check(id,birthday,sex)
If len(id)<>15 and len(id)<>18 then
idcard_check=false
Exit Function
Else
For i=1 to len(id)
temp=mid(id,i,1)
If temp<"0" or temp>"9" Then
idcard_check=False
Exit Function
End if
Next
bdl=left(birthday,4) & mid(birthday,6,2) & mid(birthday,9,2)
bds=mid(birthday,3,2) & mid(birthday,6,2) & mid(birthday,9,2)
If len(id)=15 Then
If mid(id,7,6)<>bds Then
idcard_check=False
Exit Function
End if
If int(mid(id,15,1)) Mod 2 = 1 And sex=1 Then
idcard_check=True
Exit Function
ElseIf int(mid(id,15,1)) Mod 2 = 0 And sex=0 Then
idcard_check=True
Exit Function
Else
idcard_check=False
Exit Function
End if
Else
If mid(id,7,8)<>bdl Then
idcard_check=False
Exit Function
End if
If int(mid(id,17,1)) Mod 2 = 1 And sex=1 Then
idcard_check=False
Exit Function
ElseIf int(mid(id,17,1)) Mod 2 = 0 And sex=0 Then
idcard_check=False
Exit Function
Else
idcard_check=False
Exit Function
End if
End if
End if
idcard_check=True
End function
11="北京"
12="天津"
13="河北"
14="山西"
15="内蒙古"
21="辽宁"
22="吉林"
23="黑龙江"
31="上海"
32="江苏"
33="浙江"
34="安徽"
35="福建"
36="江西"
37="山东"
41="河南"
42="湖北"
43="湖南"
44="广东"
45="广西"
46="海南"
50="重庆"
51="四川"
52="贵州"
53="云南"
54="西藏"
61="陕西"
62="甘肃"
63="青海"
64="宁夏"
65="新疆"
71="台湾"
81="香港"
82="澳门"
91="国外"
--------------------------------------------------------------------------------
--
检测上载图片尺寸的
用aspjpeg组件
up.htm
<html>
<body>
<form action="up.asp" ENCTYPE="multipart/form-data" method="post">
<table border=0 width=100% cellspacing="0">
<tr>
<td width="30%">请选择您要上传的gif图片:</td>
<td width="70%"><input type="file" name="pic" style="font-size:10pt;"></td>
</tr>
</table>
<p align="center"><input type="submit" value="提交" style="font-size:9pt;background-color:#54B060;color:white;">
</form>
</body>
</html>
up.asp
<%
FormSize = Request.TotalBytes
FormData = Request.BinaryRead( FormSize )
bncrlf=chrb(13) & chrb(10)
divider=leftb(formdata,instrb(formdata,bncrlf)-1)
datastart=instrb(formdata,bncrlf & bncrlf)+4
dataend=instrb(datastart+1,formdata,divider)-datastart
Image=midb(formdata,datastart,dataend)
head_version = Ascb( midb( Image,1,3 ) )
head_subversion = Ascb( midb( Image,4,3 ) )
head_width_l = Ascb( midb( Image,7,1 ) )
head_width_h = Ascb( midb( Image,8,1 ) )
head_height_l = Ascb( midb( Image,9,1 ) )
head_height_h = Ascb( midb( Image,10,1 ) )
head_colors = Ascb( midb( Image, 11, 1 ) )
head_width_h = head_width_h * 256
head_height_h = head_height_h * 256
head_colors = head_colors And &H07
Response.Write "图像大小为" & head_width_h + head_width_l & "x" & head_height_h + head_height_l _
& "x" & 2^( head_colors + 1 )
%>
--------------------------------------------------------------------------------
--
程序说明:函数ShowChar(num)可根据num值返回0-9的位图。注意num取值范围0-9。当前只可生成一位数字代码，任意位数代码待续开放~
ShowChar(2)
function ShowChar(num)
dim tempstr
tempstr="0x3c,0x42,0x42,0x42,0x42,0x42,0x42,0x42,0x42,0x3c|0x20,0x30,0x28,0x20,0x20,0x20,0x20,0x20,0x20,0x20|0x3c,0x66,0x60,0x60,0x30,0x18,0x0c,0x06,0x06,0x7e|0x3c,0x42,0x40,0x40,0x38,0x40,0x40,0x40,0x42,0x3c|0x20,0x30,0x30,0x28,0x28,0x24,0x24,0x7e,0x20,0x20|0x7c,0x04,0x04,0x02,0x3e,0x42,0x40,0x40,0x42,0x3c|0x3c,0x42,0x02,0x02,0x3a,0x46,0x42,0x42,0x42,0x3c|0x7e,0x20,0x20,0x10,0x10,0x08,0x08,0x04,0x04,0x04|0x3c,0x42,0x42,0x42,0x3c,0x42,0x42,0x42,0x42,0x3c|0x3c,0x42,0x42,0x42,0x5c,0x40,0x40,0x40,0x22,0x1c"
CharItem=split(tempstr,"|")
Response.ContentType ="image/x-xbitmap"
response.write "#define counter_width 8"&chr(10)&chr(13)
response.write "#define counter_height 10"&chr(10)&chr(13)
response.write "static unsigned char counter_bits[]={"&chr(10)&chr(13)
response.write CharItem(num)
response.write "};"&chr(10)&chr(13)
end function
%>
------------------------------------------------------------
<%
sub show_img(num)
Dim Image
Dim Width, Height
Dim digtal
Dim Length
Dim sort
Dim imgdata(10,10)
imgdata(0,1)="0x3c":imgdata(0,2)="0x42":imgdata(0,3)="0x42":imgdata(0,4)="0x42":imgdata(0,5)="0x42":imgdata(0,6)="0x42":imgdata(0,7)="0x42":imgdata(0,8)="0x42":imgdata(0,9)="0x42":imgdata(0,10)="0x3c"
imgdata(1,1)="0x20":imgdata(1,2)="0x30":imgdata(1,3)="0x28":imgdata(1,4)="0x20":imgdata(1,5)="0x20":imgdata(1,6)="0x20":imgdata(1,7)="0x20":imgdata(1,8)="0x20":imgdata(1,9)="0x20":imgdata(1,10)="0x20"
imgdata(2,1)="0x3c":imgdata(2,2)="0x66":imgdata(2,3)="0x60":imgdata(2,4)="0x60":imgdata(2,5)="0x30":imgdata(2,6)="0x18":imgdata(2,7)="0x0c":imgdata(2,8)="0x06":imgdata(2,9)="0x06":imgdata(2,10)="0x7e"
imgdata(3,1)="0x3c":imgdata(3,2)="0x42":imgdata(3,3)="0x40":imgdata(3,4)="0x40":imgdata(3,5)="0x38":imgdata(3,6)="0x40":imgdata(3,7)="0x40":imgdata(3,8)="0x40":imgdata(3,9)="0x42":imgdata(3,10)="0x3c"
imgdata(4,1)="0x20":imgdata(4,2)="0x30":imgdata(4,3)="0x30":imgdata(4,4)="0x28":imgdata(4,5)="0x28":imgdata(4,6)="0x24":imgdata(4,7)="0x24":imgdata(4,8)="0x7e":imgdata(4,9)="0x20":imgdata(4,10)="0x20"
imgdata(5,1)="0x7c":imgdata(5,2)="0x04":imgdata(5,3)="0x04":imgdata(5,4)="0x02":imgdata(5,5)="0x3e":imgdata(5,6)="0x42":imgdata(5,7)="0x40":imgdata(5,8)="0x40":imgdata(5,9)="0x42":imgdata(5,10)="0x3c"
imgdata(6,1)="0x3c":imgdata(6,2)="0x42":imgdata(6,3)="0x02":imgdata(6,4)="0x02":imgdata(6,5)="0x3a":imgdata(6,6)="0x46":imgdata(6,7)="0x42":imgdata(6,8)="0x42":imgdata(6,9)="0x42":imgdata(6,10)="0x3c"
imgdata(7,1)="0x7e":imgdata(7,2)="0x20":imgdata(7,3)="0x20":imgdata(7,4)="0x10":imgdata(7,5)="0x10":imgdata(7,6)="0x08":imgdata(7,7)="0x08":imgdata(7,8)="0x04":imgdata(7,9)="0x04":imgdata(7,10)="0x04"
imgdata(8,1)="0x3c":imgdata(8,2)="0x42":imgdata(8,3)="0x42":imgdata(8,4)="0x42":imgdata(8,5)="0x3c":imgdata(8,6)="0x42":imgdata(8,7)="0x42":imgdata(8,8)="0x42":imgdata(8,9)="0x42":imgdata(8,10)="0x3c"
imgdata(9,1)="0x3c":imgdata(9,2)="0x42":imgdata(9,3)="0x42":imgdata(9,4)="0x42":imgdata(9,5)="0x5c":imgdata(9,6)="0x40":imgdata(9,7)="0x40":imgdata(9,8)="0x40":imgdata(9,9)="0x22":imgdata(9,10)="0x1c"
Length = 10 '自定计数器长度
Redim sort( Length )
digital =right(string(length,"0")&num,length)
For I = 1 To Len( digital )
sort(I) = Mid( digital, I, 1 )
Next
Width = 8 * Len( digital ) '图像的宽度
Height = 10 '图像的高度，在本例中为固定值
Response.ContentType="image/x-xbitmap"
hc=chr(13) & chr(10)
Image = "#define counter_width " & Width & hc
Image = Image & "#define counter_height " & Height & hc
Image = Image & "static unsigned char counter_bits[]={" & hc
For I = 1 To Height
For J = 1 To Length
Image = Image & imgdata(sort(J),I) & ","
Next
Next
Image = Left( Image, Len( Image ) - 1 ) '去掉最后一个逗号
Image = Image & "};" & hc
Response.Write Image
end sub
call show_img(797436412)
%>
注：num不能超过15位，且只能显示10位。当然，大家可以修改Length的值来显示15位。
--------------------------------------------------------------------------------
--
纯编码实现Access数据库的建立或压缩
<%
'#######以下是一个类文件，下面的注解是调用类的方法################################################
'# 注意：如果系统不支持建立Scripting.FileSystemObject对象，那么数据库压缩功能将无法使用
'# Access 数据库类
'# CreateDbFile 建立一个Access 数据库文件
'# CompactDatabase 压缩一个Access 数据库文件
'# 建立对象方法:
'# Set a = New DatabaseTools
'#########################################################################################
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 ("无法建立，请检查错误信息<br>" & Err.number & "<br>" & 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 ("无法压缩，请检查错误信息<br>" & Err.number & "<br>" & 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("删除文件发生错误!请查看错误信息<br>" & Err.number & "<br>" & 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("修改文件名时发生错误!请查看错误信息<br>" & Err.number & "<br>" & 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
%>
--------------------------------------------------------------------------------
--
一套加解密字符串的函数
<%
Function Encrypt(theNumber)
On Error Resume Next
Dim n, szEnc, t, HiN, LoN, i
n = CDbl((theNumber + 1570) ^ 2 - 7 * (theNumber + 1570) - 450)
If n < 0 Then szEnc = "R" Else szEnc = "J"
n = CStr(abs(n))
For i = 1 To Len(n) step 2
t = Mid(n, i, 2)
If Len(t) = 1 Then
szEnc = szEnc & t
Exit For
End If
HiN = (CInt(t) And 240) / 16
LoN = Cint(t) And 15
szEnc = szEnc & Chr(Asc("M") + HiN) & Chr(Asc("C") + LoN)
Next
Encrypt = szEnc
End Function
Function Decrypt(theNumber)
On Error Resume Next
Dim e, n, sign, t, HiN, LoN, NewN, I
e = theNumber
If Left(e, 1) = "R" Then sign = -1 Else sign = 1
e = Mid(e, 2)
NewN = ""
For I = 1 To Len(e) step 2
t = Mid(e, I, 2)
If Asc(t) >= Asc("0") And Asc(t) <= Asc("9") Then
NewN = NewN & t
Exit For
End If
HiN = Mid(t, 1, 1)
LoN = Mid(t, 2, 1)
HiN = (Asc(HiN) - Asc("M")) * 16
LoN = Asc(LoN) - Asc("C")
t = CStr(HiN Or LoN)
If Len(t) = 1 Then t = "0" & t
NewN = NewN & t
Next
e = CDbl(NewN) * sign
Decrypt = CLng((7 + sqr(49 - 4 * (-450 - e))) / 2 - 1570)
End Function
%>
<html><body>
original number: 69 <br>
Encrypt(69) returns: JNMQMOJ8 <br>
Decrypt("JNMQMOJ8") returns: 69
<p>
Another example using variables instead: <br>
Encrypt(Request.Form("ID")) <br>
Encrypt(myVar) <br>
Decrypt(Request.QueryString("id")) <br>
Decrypt("JNMQMOJ8") <br>
Decrypt(myVar)
</body></html>
版权声明：
作者：Kiyo
链接：https://www.wkiyo.cn/html/2008-01/i142.html
来源：Kiyo's space
文章版权归作者所有，未经允许请勿转载。
共有 0 条评论