回帖變美女asp源碼(挺有意思)

顯示全部樓層 · 發表於 2007-6-3 16:44:33

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
- |2 ~3 R9 v. R. G4 t; `
<%
: I& h h$ p2 @0 h! t
Function AllPath()
+ J+ V; u3 z/ c& x2 _
Dim Domain,GFilePath , |) J7 V) L- `1 E g
Domain = Request.ServerVariables("SERVER_NAME") r& x3 _+ A) L2 F1 q
GFilePath = Request.ServerVariables("PATH_INFO") + k: X- x7 Q. r
GFilePath = lcase(left(GFilePath,instrRev(GFilePath,"/"))) ( `; e7 O$ L8 }% w
AllPath = "http://www.w16888.com/" //唯一需要修改的地方，你的圖片目錄如果是在http://xxxx/myfile/angie/pic，這裡就寫http://xxx.com/myfile/angie/ ; / T! ^1 v. l3 _* P. i. P2 }! \
End Function 7 X, Z/ t2 A7 X4 @
Function ShowFileList(folderspec) - z# O+ [ H+ h( c' i; D3 S
Dim Path,objFSO,objFolder,count,objFile,nume,S 1 \3 g: ? L: x+ P, e' a* @
Path = Server.MapPath(folderspec) 7 k7 y# R0 g$ S% b
Set objFSO = Server.CreateObject("Scripting.FileSystemObject") ! u3 h6 h: L0 m n O7 r+ x/ J
If objFSO.FolderExists(Path) Then
6 A# o6 f# [: l8 d% [4 T
Set objFolder = objFSO.GetFolder(Path)
" _8 e2 v" n _2 I H* T: M$ Q" |
count = 0 " z/ C% d7 d/ L; r/ @: X
For Each objFile in objFolder.Files + E6 @* F0 H2 u7 O5 G. y1 L
count = count+1
2 U0 @ u8 q0 g4 v" z
Next
3 @0 T: J0 S2 W+ Q7 g% ]4 i
randomize
3 N+ e4 c8 Y. Z% \% E: \6 [( [
nume = Int((count*rnd)+1) ) c. ?2 W6 U. |6 q! H
S = 0
& r u8 d0 ^5 e
ShowFileList = "" / a5 C* R& a( v6 d$ P
For Each objFile in objFolder.Files 1 b [2 @% b9 D# P2 D! ]
S = S + 1 / H; z( e4 S6 {* t' |( D
If S = nume Then . p7 Y8 l- x% W% w( U) P" I" T
ShowFileList = objFile.Name
3 e: m7 t( i' `- { _8 o
Exit For 0 f7 c+ f* @: D! q
End If : [# K' d4 S2 d& l6 Z
Next % @% c0 F2 m2 Z' B8 [; T7 f
Set objFolder = Nothing 4 W/ t, V& X" K
Else 5 P' q2 I; \8 t8 e
ShowFileList = "NO"
6 K! y/ q$ d9 U. G( T& L+ s* Q
End If
5 Z4 B$ x9 _, a& y, N# c
Set objFSO = Nothing * J) s& C' r2 p+ b _+ t) N& O
End Function * s, }, m5 Z) ~( @6 {
Dim list,filename,address,str % T7 C, A. ]1 j" ]
list = trim(Request.QueryString("list"))
+ ]4 w+ O9 P9 c* X
if list = "" then
* i' F- |2 M+ G) H( T
Response.write "本頁需要正確參數引入,您缺少相關的參數！正確格式如下："&AllPath&"xxxxxx.asp?list=xxxxxx.jpg" 1 c# a% T8 U* N& Y% x
Response.End() 0 K }" M/ a$ f4 g( j& I
end if
l: w2 s. q' L3 q' y9 X5 M
filename = ShowFileList("./"&list&"/")
4 [4 F) I1 q) Y2 |# k# x
if filename = "NO" then
N; x$ @" O2 k) a
Response.write "您指定的目錄<b>"&list&"</b>不存在，請重新指定！"
( F& W+ @: s/ w; I
Response.End() / q! y, A; o* d+ @! _& r. X. O
end if 3 b2 N$ r# |8 q1 e
if filename = "" then # O( O1 T' ?1 s: ?- ?
Response.write "您指定的目錄<b>"&list&"</b>沒有相關的圖片文件存在，請重新指定！"
2 @. a c5 `" q! e2 _+ h3 s
Response.End()
" Q2 ~% Q# Z0 Q; t/ N/ ^# \+ W
end if
) L' d! K+ o; h1 D
str = right(filename,3) 1 Q, e( a+ b3 E5 `
if str<>"jpg" and str<>"gif" then 0 X* i# r4 x) a+ M
filename = "erro.gif"
, [2 Z5 u) c ]4 c5 w. p) B5 A
end if
. @6 N3 q0 ^1 N% Z% V& L
address = AllPath&list&"/"
# `% f- D2 w3 t
address = address&filename
! o: I* S- g- p0 j
%> 2 D3 l4 U \. U% r8 m2 a8 k1 @
<%Response.redirect(address)%> 8 U& ~' U3 @9 r# J
把這段代碼保存為im.asp! E9 \5 Y, s2 V1 g8 {. z/ t
把美女圖片放在pic文件夾下,把pic文件夾和im.asp放在網站根目錄下,在瀏覽器裡打開演

複製代碼

[ 本帖最後由 tcbxh2008 於 2007-6-3 16:47 編輯 ]

顯示全部樓層 · 發表於 2007-6-9 21:55:56

呵呵，這個玩過的哦，不錯的`

顯示全部樓層 · 發表於 2007-7-30 13:07:24

看看

		自動登錄	找回密碼
密碼			免费注册

回帖變美女asp源碼(挺有意思)

相關帖子