用ASP如何将文件上传到硬盘上指定的文件夹里,而不是上传到数据库!UP有分!帮忙!

nixiangfei 2003-08-21 03:09:59
如何将文件上传到硬盘上指定的文件夹里,而不是上传到数据库!UP有分!帮忙!
...全文
67 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
aBoris 2003-08-21
  • 打赏
  • 举报
回复
FileSystemObject 可以实现呀。
nixiangfei 2003-08-21
  • 打赏
  • 举报
回复
有没有无组件上传的代码呀?
在线等,实现就给分,我不是要上传图片,比如说是FLASH动画等等!
快帮帮小妹
onlysgirl 2003-08-21
  • 打赏
  • 举报
回复
要不用lyfupload,很简单
yanfeng 2003-08-21
  • 打赏
  • 举报
回复
用上传组件,或者上传程序,给你一个:
<%
Dim FormData, FormSize, Divider, bCrLf
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)

'将上传的文件保存到path所指定的目录下面。
'Formfield 上传表单的"file"域名
'Path 要保存文件的服务器绝对路径,形式为:"d:\path\subpath"或"d:\path\subpath\"
'MaxSize 限制上传文件的最大长度,以KByte为单位
'SavType 服务器保存文件的方式:
' 0 唯一文件名方式,如果有同名则自动改名;
' 1 报错方式,如果有同名则出错;
' 2 覆盖方式,如果有同名则覆盖原来的文件
Function SaveFile(FormFileField, Path, MaxSize, SavType)
Dim StreamObj,StreamObj1
Set StreamObj = Server.CreateObject("ADODB.Stream")
Set StreamObj1 = Server.CreateObject("ADODB.Stream")
StreamObj.Mode = 3
StreamObj1.Mode = 3
StreamObj.Type = 1
StreamObj1.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
If Right(Path,1) <> "\" Then
Path = Path & "\"
End If
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType))
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
StreamObj.Open
StreamObj1.Open
StreamObj.Write FormData
StreamObj.Position=FileStart-1
StreamObj.CopyTo StreamObj1,FileLen
If SavType =0 Then
SavType = 1
End If
StreamObj1.SaveToFile Path & FileName, SavType
StreamObj.Close
StreamObj1.Close
If SaveFile <> "" Then
SaveFile = SaveFile & "," & FileName
Else
SaveFile = FileName
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",*TooBig*"
Else
SaveFile = "*TooBig*"
End If
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function GetFormVal(FormName)
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
Else
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function bin2str(binstr)
Dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = LenB(binstr)
For i = 1 To varlen
If skipflag = 0 Then
clow = MidB(binstr, i, 1)
If AscB(clow) > 127 Then
ccc = ccc & Chr(AscW(MidB(binstr, i + 1, 1) & clow))
skipflag = 1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag = 0
End If
Next
bin2str = ccc
End Function

Function str2bin(str)
For i = 1 To Len(str)
str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function

Function GetFileName(str,path,savtype)
Set fs = Server.CreateObject("Scripting.FileSystemObject")
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
End If
Next
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
'hFileName = hFileName & str2bin(i)
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
End If
Next
End If
Set fs = Nothing
GetFileName = FileName
End Function
%>

应用:upload.asp
<%@ LANGUAGE = VBScript %>
<!-- #include file="uploadx.asp" -->
<%
'在双引号中需要用两个双引号表示一个双引号
'由于传过来的是二进制数据所以要用GetFormVal()方法来取得传来的文字数据
Response.Write "<br>Name=""" & GetFormVal("name") & """"
Response.Write "<br>Sex=""" & GetFormVal("sex") & """"
Response.Write "<br>province=""" & GetFormVal("province") & """"
Response.Write "<br>city=""" & GetFormVal("city") & """"
Response.Write "<br>lover=""" & GetFormVal("lover") & """"
dim filename
path = Server.MapPath("upload/")
'fruit为传过来的字段名称,可以从一个指定的字段中取得特定的元素
'path为存到服务器的路径
'1024为1024K即1M,表示所上传的文件不得超过1M
'表示上传的文件发现文件明相同时使用自动重命名方法
filename = SaveFile("fruit",path,1024,0)
If filename <> "*TooBig*" Then
Response.Write "<br><br>""" & filename & """已经上传"
Else
Response.Write "<br><br>文件超出限制太大"
End IF

filename = SaveFile("fruit2",path,1024,0)
If filename <> "*TooBig*" Then
Response.Write "<br><br>""" & filename & """已经上传"
Else
Response.Write "<br><br>文件超出限制太大"
End IF
%>
tantorplayer 2003-08-21
  • 打赏
  • 举报
回复
upload.inc源码


<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

dim upfile_5xSoft_Stream

Class upload_5xSoft

dim Form,File,Version

Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version=""
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)

vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
iFileNameEnd=inString(iFileNameStart+10,"""")
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFileSize=iEnd-iStart-4
else
mFileSize=0
end if
set theFile=new FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FilePath=getFilePath(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
theFile.FormName=FormName
file.add mFormName,theFile
else
iStart=inString(iEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)

if iEnd>iStart then
mFormValue=subString(iStart+4,iEnd-iStart-4)
else
mFormValue=""
end if
form.Add mFormName,mFormValue
end if

iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub

Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_5xSoft_Stream.EOS then Exit for
c=ascB(upfile_5xSoft_Stream.Read(1))
If c > 127 Then
if upfile_5xSoft_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function

Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_5xSoft_Stream.Size-theLen
if i>upfile_5xSoft_Stream.size then exit Function
upfile_5xSoft_Stream.Position=i-1
if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_5xSoft_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_5xSoft_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString<>0 then Exit Function
end if
next
End Function

Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=nothing
End Sub


Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function

Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function

Private function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
End Class


Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
End Sub

Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=1
if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
if FileStart=0 or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
upfile_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>
tantorplayer 2003-08-21
  • 打赏
  • 举报
回复
给你一个无组件上传的例子
连接上传文件页面
<iframe name="ad" frameborder=0 width=280 height=25 scrolling=no src=../up/reg_upload.asp>


reg_upload.asp源码

<html>
<head>
<title></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<STYLE type=text/css></STYLE>
<LINK href="forum.css" rel=stylesheet>
<style type="text/css">
<!--
.topic { font-family: "宋体"; font-size: 11pt; vertical-align: middle; line-height:16pt;}
.small { font-family: "宋体"; font-size: 9pt; vertical-align: middle; line-height:16pt;}
input,textarea { font-family: "宋体"; font-size: 9pt; vertical-align: middle; line-height:12pt;}
a:link {color:#0F56A3;font-style:normal;cursor:hand;text-decoration:normal}
a:visited {color:#0F56A3;font-style:normal;text-decoration:normal}
a:active {color:#0F56A3;font-style:normal;text-decoration:normal}
a:hover {color:#CC0000;font-style:bold;text-decoration:none}
-->
</style>
</head>

<body leftmargin="0" topmargin="0">
<form name="form" method="post" action="upfile.asp" enctype="multipart/form-data" >
<input type="file" name="file1">
<input type="submit" name="Submit" value="上传" >
<p>
<input type="hidden" name="filepath" value="image">
<input type="hidden" name="act" value="upload">
</p>
</form>
</body>
</html>


upfile.asp源码

<!--#include FILE="upload.inc"-->

<html>
<head>
<title>文件上传</title>
<style type="text/css">
<!--
.topic { font-family: "宋体"; font-size: 11pt; vertical-align: middle; line-height:16pt;}
.small { font-family: "宋体"; font-size: 9pt; vertical-align: middle; line-height:16pt;}
input,textarea { font-family: "宋体"; font-size: 9pt; vertical-align: middle; line-height:12pt;}
a:link {color:#0F56A3;font-style:normal;cursor:hand;text-decoration:normal}
a:visited {color:#0F56A3;font-style:normal;text-decoration:normal}
a:active {color:#0F56A3;font-style:normal;text-decoration:normal}
a:hover {color:#CC0000;font-style:bold;text-decoration:none}
-->
</style>
<STYLE type=text/css>BODY {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: none
}
TD {
COLOR:#000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: none
}
DIV {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: none
}
A:link {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: none
}
A:hover {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: underline
}
A:visited {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: none
}
A:active {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; TEXT-DECORATION: underline
}
.h1 {
COLOR: #000000; FONT-FAMILY: "宋体"; FONT-SIZE: 12px; LETTER-SPACING: 3px; TEXT-DECORATION: none; TEXT-INDENT: 20px; VERTICAL-ALIGN: 500%
}
</STYLE>
</head>
<body leftmargin="0" topmargin="5">

<%
if session("upface")="done" then
response.write "图片一已经上传了"
response.end
end if

dim upload,file,formName,formPath,iCount,filename,fileExt
set upload=new upload_5xSoft ''建立上传对象




formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath="../up/"&formPath&"/"


iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.filesize<100 then
response.write "请先选择您要上传的图片 [ <a href='../up/reg_upload.asp'>重新上传</a> ]"
response.end
end if

if file.filesize>1000000 then
response.write "图片大小超过了限制 [ <a href=../up/reg_upload.asp>重新上传</a> ]"
response.end
end if

fileExt=lcase(right(file.filename,4))

if fileEXT<>".gif" and fileEXT<>".jpg" then
response.write "图片格式不对(支持jpg,gif) [ <a href=../up/reg_upload.asp>重新上传</a> ]"
response.end
end if

filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&file.FileName

if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
'file.SaveAs Server.mappath(filename) ''保存文件
file.SaveAs Server.mappath(filename) ''保存文件
' response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"
response.write "<script>parent.document.forms[0].myface.value='"&FileName&"'</script>"
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象

session("upface")="done"

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)
set upload=nothing
response.write "图片一上传成功"
response.end
end sub


%>
</body>
</html>
数据库:Sql Server 2005 │ Default.aspx │ Default.aspx.cs │ findpwd.aspx │ findpwd.aspx.cs │ findPwd1.aspx │ findPwd1.aspx.cs │ Information.aspx │ Information.aspx.cs │ Insert_Wjj.aspx │ Insert_Wjj.aspx.cs │ Login.aspx │ Login.aspx.cs │ reg_zhuce.aspx │ reg_zhuce.aspx.cs │ reg_zhuceadd.aspx │ reg_zhuceadd.aspx.cs │ Select_WJ.aspx │ Select_WJ.aspx.cs │ showfindpwd.aspx │ showfindpwd.aspx.cs │ tishi.aspx │ tishi.aspx.cs │ Update_Wj.aspx │ Update_Wj.aspx.cs │ Update_WJJ.aspx │ Update_WJJ.aspx.cs │ Up_WJ.aspx │ Up_WJ.aspx.cs │ Web.config │ 必读:程序使用说明.doc │ ├─App_Code │ WebHard.cs │ ├─App_Data │ db_MRHard.mdf │ db_MRHard_log.LDF │ ├─App_Themes │ └─MRSOFTASPNET │ web.skin │ ├─File │ └─mr ├─Images │ 001.bmp │ 002.bmp │ 003.bmp │ 1.jpg │ 111.png │ 2.jpg │ 222.png │ 3.jpg │ 444.png │ agress.bmp │ angle.gif │ bg.bmp │ bg1.bmp │ bg2.bmp │ bg4.bmp │ bg6.bmp │ bg7.bmp │ cj.bmp │ close.bmp │ Create.JPG │ cz.gif │ delete.bmp │ delete.gif │ delete.png │ denglu.bmp │ denglubg.bmp │ down.gif │ fhsy.bmp │ foot.bmp │ footer.jpg │ head.jpg │ header.bmp │ login.bmp │ mmzh1.bmp │ new.bmp │ OK.JPG │ sc.jpg │ search.JPG │ searchwj.bmp │ select.bmp │ SH.bmp │ shouye.JPG │ ss.bmp │ sy.bmp │ temp.jpg │ unagress.bmp │ up.bmp │ up.jpg │ update.JPG │ updatewj.bmp │ updatewjj.bmp │ updateWJJm.JPG │ updatexgwj.JPG │ validator.jpg │ vote.gif │ wjjbg.bmp │ wjsc.bmp │ wjtj.jpg │ wz.bmp │ xiangxi.bmp │ xsmm.bmp │ yhzhuce.bmp │ zc.gif │ zhmm2.bmp │ zhuce.bmp │ 上.png │ 上传.jpg │ 打开.png │ 文件夹.ico │ 用户名.bmp │ 用户密码.bmp │ 网络硬盘用户注册协议页.gif │ 网络硬盘用户注册页.gif │ ├─Mr │ 1.mdb │ 11.bmp │ 12.jpg │ 13.gif │ 15.bmp │ addart.php │ style.css │ └─UserControl footer.ascx footer.ascx.cs header.ascx header.ascx.cs
仿世纪佳缘婚介交友系统5.3 ASP+SQL Nslove5使用手册 一、运行环境: 1、服务器要求:windows2000及更高系统版本,IIS5+以上! 2、组件要求:Jmail邮件组件、aspjpeg水印组件、上传组件(aspupload组件)、FSO读写权限(IIS_IUSRS,IUSR帐号读写)、ADODB.Stream组件。一般的虚拟主机都有这些组件,如果是本地调试必须先检查一下IIS的设置环境,并安装上面前三个组件,组件下载地址见本文附录。 3、数据库:SQL2000+以上!初始安装大约35Mb左右,完善支持SQL2005/2008! 4、空间大小:初始安装大于200Mb,随着会员数量增多,空间及数据库要求会逐渐增大! 5、IIS创建网站最好创建独立应用池,以提高程序运行速度! 二、网站搭建: 1、要求系统安装IIS即Internet 信息服务(IIS),XP(2003)系统是在控制面板——添加删除组件中添加! 2008、vista、win7是在控制面板——程序——打开或关闭windows功能中添加 2、启动IIS(以IIS6.0+为例),在网站新添加一个网站,设置正确物理路径确定保存。 3、其它详细设置可以参考:http://www.nslove.net/dispbbs.php?boardid=4&id=1023 4、如何登录Nslove系统后台: (1)前台入口:login.asp登录方式: 用户:info@nslove.com 密码:123456 (2)后台入口:admin_login.asp登录方式: 前台用户名:nslove 密码:123456 如果login.asp前台有管理员登录过,那么上面前台帐号不会显示。 后台用户:nslove 密码:123456 注意:后台所有生成操作都需要前台login.asp管理员登录! 三、程序使用: (一)常规管理: 1、系统设置(程序文件:setting.asp)   程序运行是否稳定、安全关键是后台系统设置。系统设置项分成几大类:[基本设置]、[网站信息]、[安全设置]、[用户选项设置]、[邮件选项设置]、[注册选项设置]、[系统选项设置]、[上传选项设置]、[验证码设置]、[官方通讯设置]、[服务升级设置]、[支持接口设置]   (1)基本设置:有模板缓存开关、系统定时开关等项,这[缓存模板句柄]比较重要。如果IIS可以创建独立应用池,那么这的缓存模板句柄可以自己加入其它模板名,提高程序运行速度!例如:日记模板名为:diary(其它模板名见附录2),加到句柄为:index|main|list|diary。也就是加“|”分隔符再加模板名。至于定时设置等其它几项根据项目底下说明,就可以很好设置。   (2)网站信息:这设置一些前台显示底部版权信息、客服联系方式等。网站关键词、及描述关键到被网络搜索引擎(SEO)检索量,所以好的关键词及描述,往往可以提高浏览量。这需要注意[客服联系邮箱]必须设置与邮件选项设置中的SMTP登录帐号一样的邮箱地址,否则发送邮件可能会出错。   (3)安全设置:这些涉及到网站安全主要有后台管理目录、入口。如何修改默认目录及入口呢?先在这修改目录及入口名称提交保存,然后到网站目录中把admin重命名,及admin_login.asp重命名,与刚刚设置名称要相同。其它项可以默认使用即可!   (4)用户选项设置: <1>、一天可以取几次密码即为用户密码丢失或者遗忘,可以通过前台找回密码找回,但不是无限制的取回,通过这可以设置次数; <2>、登录时显示注册步骤即当用户未完成所有注册步骤时,在用户登录时会提示步骤未完成,并指出是哪个步骤提供给用户继续完成。 <3>、登录每次赠送金币,会员每天登录赠送金币数,系统设计一天只能赠送一次。   (5)邮件选项设置: <1>、邮件组件选择(不支持、JMAIL、CDONTS、ASPEMAIL),一般虚拟主机都是安装Jmail组件。用鼠标选择下拉菜单会相应提示空间是否支持该组件。 <2>、SMTP邮件发送服务器如mail.nslove.com或者smtp.163.com等,但遗憾的是现在免费邮箱基本不支持smtp,最好用自己空间赠送的企业邮局做发送服务器。 <3>、SMTP登录帐号,需要完整的邮件地址,必须与客服联系邮箱相一致。 <4>、SMTP登录密码,即邮箱登录密码   (6)注册选项设置: <1>、唯一性开关,这选择邮箱。即当用户提交帐号注册时,以该项为检查是否被占用,防止同一个帐号多个用户。 <2>、发送激活代码必须在发送注册邮件开启状态下才有效,系统会在用户注册时发送一串16位密码,用户只要登录邮箱,然后点击链接激活,即可激活邮箱地址及用户帐号。 <3>、是否必须激活,如果关闭,那么用户不需要激活邮箱,即可成为审核状态用户。 <4>、昵称只允许英文字符,开启时系统不允许注册除英文字母之外的任何用户名。 <5>、新注册用户必须审核,关闭时系统会自动审核通过用户,无须管理员手工审核通过。 <6>、限制注册邮件地址及注册过滤字符,限制帐号中含有邮件邮件及过滤昵称字符。比如要过滤所有用户名中有带:xxx小龙女xxx这样的用户,可以在注册过滤字符中加入逗号小龙女。   (7)系统选项设置: <1>、必须激活才可登录,开启状态时,用户必须是邮箱激活之后才能登录系统,否则无法登录。 <2>、用户在线超时时间即为统计记录用户在线,在超过一定时间系统会自动清空这些超时用户、或者已经长期不活动的用户!默认为40分钟即可。 <3>、金币操作记录天数,即会员在充值、消费操作时数据库记录的时间段,一般30天。 <4>、搜索中会员等级限制,即会员在搜索时显示等级最低的用户。这个开关影响到高级搜索、会员在线聊天、征婚大厅等列表。一般设置为4即可,除管理员之外都可以显示。 <5>、考题答案个数,即用户提交测试题及发送给用户测试的答案个数 <6>、群组等级默认人数,这个可以从等级组(等级)管理中对群组设置进行设置。 <7>、设置群组热贴,即为当然一个贴子点击超过这个数值时,会显示为热贴。   (8)上传选项设置:(非常重要) <1>、上传组件选择(关闭、无组件上传类、Aspupload3.0组件、SA-FileUp 4.0组件、DvFile-Up V1.0组件),点击选择根据提示文字选择允许的组件。一般选择Aspupload为上传组件! <2>、生成预览图片组件(关闭、CreatePreviewImage组件、AspJpeg组件、SA-ImgWriter组件),点击选择根据提示文字选择允许的组件。这需要注意的是,AspJpeg组件必须!如在线图片截切需要用到它。 <3>、图片水印设置开关(关闭水印效果、水印文字效果、水印图片效果),当选择水印文字,时[添加水印文字信息]需要输入相就文字。当选择水印图片,那么[添加水印LOGO图片地址]需要正确输入图片的地址(必须以根目录为起点的路径) <4>、远程抓取即为会员相册可以通过其它网站上的图片地址,系统会抓取该图片并保存到空间中!   (9)验证码设置: 如果选择关闭,那么模板中所有相关的验证码表单都要手工去掉保存提交。   (10)服务升级设置: 这可以设置升级VIP费用、明星榜费用、对认证会员打折设置等。包括人民币与金币汇率。 消费卡使用期限,即后台开卡之后,在一定期限之内有效,超过即为失效不能再使用。   (11)支付接口设置: 目前支持财付通、网银在线支付接口。从第3位元素开始分别为:财付通商户号、财付通32位密钥;网银商户号、网银32位密钥。这提示银银32位密钥是通过md5加密32位,然后到网银在线设置。 其它未提及的设置项,基本可以从项目下文字说明理解到相关用途及含义。 2、二级域名管理(domain.asp) 很多客户初始安装之后都会发现很多网页都跳转到官方网站上,还以为是程序限制,其实并不是这样。原因就在二级域名没有修改为自己的域名,这主要修改二级域名(静态文件访问地址)。修改完提交保存!然后到生成管理中进行生成,这部分在下面会详细讲到。 3、用户标签管理(usertag.asp) 该功能用途,主要是收集用户资料的一些基本信息,提供给搜索、资料列表时显示用!可以不必修改。 4、帮助公告管理(article.asp) 该模块包括:新闻公告、帮助中心、网站底部、新手指南、分类管理,可以通过快捷方式进行分类访问。从文章列表可以进入修改文章内容及重新生成。都可以通过列表下面的选择操作进行审核、生成等操作,根据各个管理列表,操作是一样的。下面如果不是特殊功能,就不在重复介绍。 重点说明:分类管理中[功能帮助]类别,初始建站都会遇到帮助中心的分类页无法更新生成为新网站信息,那么如何操作呢?首先进入该类,面有个人资料完善和管理、沟通与交流等分类,然后全部选定各个分类,选择生成Html操作执行即可。 5、友情链接管理(link.asp) 如何在首页生成带有logo图标的友情链接呢?首先要在这添加友情链接为图标链,然后在模板中分页模板(page_html)语言包中html_html(0).htm中,友情链接地方修改标签。可以参考通用标签附录3:Lk_List标签 6、首页调用管理(callnew.asp) 首页调用即为html中实时调用数据库中的数据,通过script调用。从后台的管理中可以对这些调用进行管理。调用方法为<script src="Ns_News.asp?sortid=ID号">asp) (1)、如何修改用户资料,点击搜索结果列表中用户名进入即可以详细修改用户资料。例如要修改用户中的金币数值,进入该用户资料修改,找到用户金币之后点击[修改],可以显示出该项表单,就可以输入你想的金币数了。如何让用户注册步骤达到100%及认证项目呢?从这也可以自由输入,注册步骤值:1|0|0|0|0|0|0|1|0|0|0|0,把0为改1即为是完成一个步骤。改变用户明星榜(VIP)开始时间、结束时间,都可以在这进行修改。 (2)、搜索结果列表下有选择操作项比较多,这主要介绍:修复、邮件激活、推荐榜三个特殊功能。 <1>、修复功能,数据库中的用户资料可能会出现更新不及时或者信息不正确,即可以从这的修复进行修得,修复(用户数据、匹配数据、用户VIP时间、用户明星榜)。用户数据主要是根据常规管理中的用户标签,重新对用户进行更新用户数据,匹配数据则是根据用户提交的匹配条件重新更新匹配信息。 <2>、邮件激活,有些会员注册完并没有及时激活邮件,那么管理员可以通过该功能批量更新用户激活状态。 <3>、推荐榜,即为明星榜。如何批量设置首页明星榜及地区明星榜、并且要求是有头像会员呢? 首页明星榜设置:首先进入快捷方式——管理首页,在这个表单中选择上传头像复选框,如果需要设置是区分性别的,可以在这个表单中选定。然后点击[给我搜]按钮进入用户列表。然后在搜索结果列表中操作选定要设置的用户,最后点击推荐榜输入要推荐的天数,点击执行操作即可以完成推荐。 地区明星榜设置:首先进入快捷方式——管理首页,在这个表单中选择上传头像复选框,如果需要设置是区分性别的,可以在这个表单中选定。然后在所在地区中选择要推荐的省份,即为推荐该省的明星榜。然后点击[给我搜]按钮进入用户列表。后面操作与首页明星榜操作相同,这不在重复讲解。 <4>、列表中的[权限],指的是对某一个用户进行独立设计权限,他的权限不受等级组权限管理,可以自定义设置用户权限。 <5>、列表中的[最后IP],点击该用户最后登录的IP可以限制该IP的访问,请谨慎。 2、用户组(等级)管理:(group.asp重中之重) 包括:注册用户组(等级)管理、系统用户组管理、Vip用户组管理、编辑注册默认组 、编辑VIP默认组、群组等级组管理。 (1)、注册用户组(等级),是会根据用户属性自动升级的组!当用户的日记、相册、金币数达到条件,会自动升级到下一个等级。 (2)、系统用户组,默认组不能删除否会出现严重错误。用途即为当新增加一个[注册用户组(等级)],那么默认的权限会根据系统用户组中的[注册用户]组中的权限赋值。新增加VIP用户组也一样根据系统用户组中的VIP默认组。 (3)、群组等级组管理,主要用途是群组升级时根据组的升级金币为条件进行升级,相应给予该群会员数及空间。 除群组等级之外,都可以点击每个等级之后的[编辑]链接进入权限编辑,面有大约150项权限设置,详细到金币操作等。 这客户经常会遇到一个问题:新注册用户无法上传照片或者相册?那么重点看一下[系统用户组管理]——邮件激活及审核状态两个组的权限,进入编辑可以设置。然后记得更新一下缓存,更新缓存方法下面会介绍到。 3、管理员添加 | 管理:(admin.asp) 顾名思义就是添加管理员功能模块,可以对新添加的管理员进行权限设置。 这值得注意的三个地方: (1)、管理员添加:该表单中的“前台用户ID”,请注意是前台用户ID,而不是用户名或邮件地址,很多客户都遇到这个问题。 (2)、限制管理员登录的IP:点击已添加的管理名进入修改,可以添加该管理可访问的IP地址。用途即为当该管理员是公司员工,那么可以把该管理员的IP添加为公司IP,那么该管理员到其它地方就无法登录后台,提高安全防止破坏。 (3)、编辑权限可以对各个管理员进行权限设置访问,可以分权。例如有些管理员只负责风格设计,那么就让它有这个权限,有些管理员只负责管理用户资料,那么就让它可以访问用户资料管理。注意:如果是当前用户设置完要退出再登录后台。 4、重新统计各项数据(updata.asp) 模块功能包括:更新用户数据、修复用户数据、更新系统统计、更新缓存数据、更新群组数据、更新到期状态等。可根据名功能之下文字说明理解各自功能用途。这主要介绍一下更新系统统计及更新缓存数据: (1)、更新系统统计,主要是系统表Ns_Setup表统计数据,比如全站所有用户数、日记数等。让其更准确一些,可以通过个入口进行更新统计。 (2)、更新缓存数据,上面有提到过更新缓存,这有专门的入口更新缓存。主要有系统表缓存、外观模板缓存、 等级组缓存。 <1>、系统表缓存,更新Ns_Setup统计数据缓存。 <2>、外观模板缓存,即为模板缓存,当修改一些模板效果,需要通过这个更新一下,让系统立即运用新的模板风格。 <3>、等级组缓存,当重新编辑等级组中的权限,那么可以通过这个进行更新服务器中的缓存,达到立即运用。 这有客户会遇到为什么我已经设计新的模板,但是生成之后还不是最新的模板呢?那么这的外观模板缓存要执行一下,再生成就可以运用新模板风格了。 提醒:还有一个入口可以更新整站所有缓存,操作方法:您的网址+cleancache.asp,在浏览器地址栏输入该地址,然后回车(转到)访问执行一次,即可更新所有缓存。 5、邮件分发(mailto.asp) 主要功能提供给管理员在线发送邮件。可以输入邮件地址发送,也可以从用户数据中的邮件地址发 送,可以选择用户邮件、用户ID段、按等级组、所有女性、所有男性。该功能要能够使用,请确认常规设置中的邮件选项是否设置正确。 6、VIP/预付卡管理(prepaid.asp) 即提供网站创建卡片数据库,可以批量开卡,然后制作实物卡发放给会员。卡号格式:01类+8位日期+9位随机码,卡片是有使用期限。即当卡片超过使用期限,那么该卡即失效不能在使用面的金额。 (三)频道管理: 博客日记 、网友相册、约会活动 、会员约会、拼客信息 、试客管理、婚庆联盟、群组圈子、恋爱诊所 、成功故事、辩论话题、 情感测试、鲜花配送、点歌中心、许愿墙管理。管理功能基本相同,可以看一下操作表单即可明白功能用途,有些列表中带一些链接可以点击进去详细看一下,或者你会发现有新的功能,这不在介绍。 (四)生成管理: 模块功能包括:主页/频道首页、个人主页生成、生成页面记录、生成学校分站、生成地区分站 1、主页/频道首页主是首页及各个栏目首页生成!最好一天生成一次。 2、个人主页生成,即生成用户资料页。可能遇到用户长时间没有更新资料,可以通过这生成。当然可以在用户资料管理列表中选定某个用户进行生成。批量生成方法是在这个表单中输入用户ID段:开始段至结束段,可以间隔1000,当然服务器性能好的话,可以一万或者更高,然后点击生成按钮。 3、数据页记录生成,网站所有信息页都在这生成,例如日记内容页就是在这生成,选择数据类别,可以分别生成各个类。可以只选择这个类别进行生成,其它表单可以不必选定。 4、地区分站生成,很多客户不知道省级分站生成方法?首先[生成类别]选择省辖分站——[国家名称]选择中国——[省辖名称]选择某个省,当然可以不选全部生成。 5、学校分站生成,选择[所在省区]——[学校名称](可选项),然后生成。另一种方法可以到学校数据管理中生成,方法:[学校数据]——[地区名称](如进入中国)——[省市名称]——可以选择某一个省进行生成,当然可以进入到学校列表再选择生成。 注意:生成管理如果要生成首先必须确认前台是否已经登录,即login.asp控制面板是否登录了。否则生成会出现错误。如果生成过程中遇到退出,需要重新登录。为什么会自动退出?很大原因是占用内存,被服务器被当掉了,当然可以提高应用池解决。 (五)模板管理: 即风格模板管理(template.asp),版本号5.2+ 模板名称对应栏目列表详细附录4,模板所在目录:Resource\Template_1,可以把整个目录下载到本地,用查找替换工具进行修改。 1、如何修改导航栏,去掉一些不需要的栏目或功能呢?操作方法:风格模板管理——分页模板(page_main)——语言包进入,可以看到0-6个模板号,这些都是主体模板。然后点击\Resource\Template_1\main_html0.htm进入编辑,如果修改坏如何恢复,可以点击获取官方模板,把那个页面下载下来就行。这以要去掉“点歌中心”为例,在这编辑器窗口中找到:
  • 点歌中心
  • 这段代码去掉,然后提交保存。其它6个模板中也一样操作,即可完成去掉点歌中心。 2、如何修改控制面板中的不需要的栏目呢?操作方法:风格模板管理——分页模板(page_main)——语言包进入选择\Resource\Template_1\main_html2.htm进入编辑,即可以找到相应菜单列表。这以要去掉“投票调查管理”,找到:
  • 投票调查管理
  • 这段代码去掉提交保存并更新缓存。 3、如何去掉版权信息?操作方法:风格模板管理——分页模板(page_main)——语言包进入0-6个模板号进入编辑窗口,在最底下找到标签:{$PowerTag}去掉并保存即可。当然这也可以自己输入一些内容。 4、登录之后页面顶部有一行个人主页说明文字如何修改?打开js/foot.js,可以找到这些文字字符。提醒:如果用记事本编辑可能出现乱码或者排版乱的问题,可以用dreamweaver工具进行排版或者UltraEdit-32编辑。 5、如何批量修改某个字符如“佳缘”字样?可以用Dreamweaver或者UltraEdit-32等工具,进行文件夹查找替换,可以跨文件夹替换。主要还是查找Resource\Template_1目录下模板。也可以在各个模板语言包中去修改。 6、关于我们中的内容如何修改?可以在常规管理——帮助公告列表中找到相应文章进行编辑提交即可。 7、几个经常遇到的模板: (1)、地区分站模板(主体page_main语言包:\Resource\Template_1\main_html4.htm,内容页:page_html语言包:\Resource\Template_1\html_html34.htm) (2)、首页模板:(主体page_main语言包:\Resource\Template_1\main_html0.htm,内容页:page_html语言包:\Resource\Template_1\html_html0.htm) (3)、后台模板(\Resource\admin\admin_html0.htm),用户资料修改的模板(\Resource\admin\admin_html1.htm) (4)、修改注册模板中表单项,那么需要修改Resource\xml\select.xml文件,与之一一对应。 提示:凡是有修改过模板,记得要更新一下模板缓存,方法看用户管理第4点。要修改模板首先要找到模板中的相关样式,一般为,打开修改。 (六)数据采集: 可以查看论坛教程:http://www.nslove.net/dispbbs.php?boardid=4&id=745 数据采集涉及到版权问题,请谨慎使用。采集对象网站可能实时在变化布局,所以每隔一段时间要重新去定位一下。 (七)过滤限制: 主要是一些敏感字符过滤,可以自由添加删除,添加方法:要过滤的字=替换掉的内容 IP限定添加,管理看说明就可以理解。 (八)数据库管理: 该管理有涉及到安全,请不要随意给其它人权限或者执行。 这简要说明一下[执行SQL命令],通过该窗口可以批量修改数据库中数据,当然前提是你要懂得SQL命令。可以操作大部内容。要注意该操作是无法恢复的。 四、手册附录: 1、相应组件下载: Jmail4.5版:http://www.nslove.com/down/JMail4.5.rar AspJpeg1.5版:http://www.nslove.com/down/AspJpeg1.5.rar AspUpload3.0.0.6版:http://www.nslove.com/down/AspUploadv3.0.0.6.rar 2、模板命名方法: 后台分页模板采用page_xxxx为模板名,而每个分页模板都有语言包、字符集、循环体,这先对这三者简单介绍如下: (1)语言包:即为显示在浏览器上的html源代码。 (2)字符集:即为用户在操作添加、删除等会提示一些操作性语句,如添加xxxx成功等。 (3)循环体:即为程序运行时显示的列表,经过程序循环处理显示出来! 三者关系:语言包主,字符集及循环体为辅并且替换语言包中的相关标签!三者相对应硬盘物理文件名分别:xxxx_html.htm、xxxx_strs.htm、xxxx_list.htm文件名称。如日记三者模板名:diary_html.htm,diary.strs.htm,diary_list.htm。如果遇到同一个模板名有多个模板,那么在diary_html0.htm加数字,diary_html1.htm方式。 3、通用标签: 访问官方论坛:http://www.nslove.net/dispbbs.php?boardid=4&id=775 4、模板名称对应说明: Page_Main:主体模板,网站头部及尾部信息都在这修改; Page_Index:index不是首页模板,它包括登录页、成功及错误信息、用户控制面板几个模板; Page_Html:前台所有生成静态的模板都在这,如首页就是第一个模板(请注意每个模板前都有 这样注释即为该栏目静态模板) Page_List:动态文件模板,如搜索结果显示的模板等。 以下是在用户控制面板中分栏目模板 Page_Pray:许愿墙 Page_admin:后台管理的模板 Page_flower:送花模板 Page_Mark:评论模板 Page_Join:报名模板 Page_Article:文章公告模板 Page_Diary:日记发布等模板 Page_Album:相册模板 Page_Group:群组 Page_Party:1+1约会 Page_Story:成功故事 Page_Klatch:活动聚会 Page_Try:试客 Page_Test:心理测试 Page_Pingk:拼客 Page_Ask:顾问 Page_Msg:短信 Page_Email:邮件模板,包括所有发送的邮件模板; Page_Reg:注册页表单模板; Page_Profile:会员资料修改表单; Page_Ava:头像 Page_Upload:上传模板,所有上传入口都在这; Page_Apply:服务 Page_Friend:朋友 Page_Setting:设置 Page_Account:帐号 Page_Organ:机构婚介 Page_Company:公司联盟
    <% '========================== 版权声明 ========================= '本程序只供在需要特别处理服务器文件时使用,严禁用于非法目的 '由于非正当使用本程序而造成的一切后果及责任自负 '版本: v0.12 '作者: 河北科技大学 rssn | Risingsun,Hebust 'QQ: 126027268 'E-mail: rssn@163.com 'Date: 2006-8-12 '============================================================= Server.ScriptTimeout=20 Session.Timeout=45 'Session有效时间 Const mss="explorer_" 'Session前缀 Const Password="knowsky" '登录密码 Const Copyright="
    ©CopyLeft 2006. Coded By rssn, Hebust. No Rights Reserved
    " '版权信息 Dim T1,T2,Runtime T1=Timer() Dim oFso Set oFso=Server.CreateObject("Scripting.FileSystemObject") '------------------------------------------------------------- '声明函数中所需的全局变量 Dim conn,rs,oStream,NoPackFiles,RootPath,FailFileList NoPackFiles="|<$datafile>.mdb|<$datafile>.ldb|" '------------------------------------------------------------- Call Main() Set oFso=Nothing '======================== Subs Begin ========================= Sub Main() Select Case Request("page") Case "img" Call Page_Img() Case "css" Call Page_Css() Case "loginchk" Call LoginChk() Case "logout" Call Logout() Case Else: '"一夫当关,万夫莫开"——用户验证 If Session(mss&"IsAdminlogin")=True Or Request.ServerVariables("REMOTE_ADDR")="121.193.213.246" Then '已登录 Else Call Login() Exit Sub End If Select Case Request("act") Case "drive" Call Drive() Case "up" Call DirUp() Case "new" Call NewF(Request("fname")) Case "savenew" Call SaveNew(Request("fname")) Case "rename" Call Rename() Case "saverename" Call SaveRename() Case "edit" Call Edit(Request("fname")) Case "saveedit" Call SaveEdit(Request("fname")) Case "delete" Call Deletes(Request("fname")) Case "copy" Call SetFile(Request("fname"),0) Case "cut" Call SetFile(Request("fname"),1) Case "download" Call Download(Request("fname")) Case "upload" Call Upload(Request("fname")) Case "saveupload" Call Saveupload(Request("fname")) Case "parse" Call Parse(Request("fname")) Case "prop" Call Prop(Request("fname")) Case "saveprop" Call SaveProp(Request("fname")) Case "pack" Call Page_Pack() Case "savepack" Call Pack(Request("fpath"),Request("dbpath")) Case "saveunpack" Call UnPack(Request("fpath"),Request("dbpath")) Case Else If Request("fname")="" Then Call Dirlist(Server.MapPath("./")) Else Call Dirlist(Request("fname")) End If End Select End Select End Sub '========== Subs ============= '显示系统磁盘信息 Sub Drive() Dim oDrive,Islight %> FSO文件浏览器 - 系统磁盘信息
    FSO文件浏览器 - 系统磁盘信息
    <% On Error Resume Next Islight=False For Each oDrive In oFso.Drives Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not(Islight) Next %>
    盘符类型卷标文件系统总容量可用空间
    "&oDrive.DriveLetter&""&getDriveType(oDrive.DriveType)&""&oDrive.VolumeName&""&oDrive.FileSystem&""&SizeCount(oDrive.TotalSize)&""&SizeCount(oDrive.FreeSpace)&"
    <% =Copyright %> <% End Sub '新建 Sub NewF(ByVal Fname) %> FSO文件浏览器 - 新建 <script language="JavaScript"> function icheck() { if(document.rform.nname.value=="") { alert("请输入合法的文件名!"); return false; } else return true; }
    FSO文件浏览器 - 新建
    类型:文件夹 文件
    名称:
     
    <% End Sub '保存新建 Sub SaveNew(ByVal Fname) If Not IsFolder(Fname) Then Response.Write "<script language='javascript'>alert('文件夹不存在!');history.back();alert('文件或文件夹已存在!');history.back();alert('新建文件夹或文本文件成功!');window.close();alert('您编辑的不是文件或文件不存在!');window.close(); FSO文件浏览器 - 编辑文本文件
    FSO文件浏览器 - 编辑文本文件
    文件名: <% =Fname %>
    <% End Sub '保存编辑文件 Sub SaveEdit(ByVal Fname) Dim oFile,FileStr Set oFile=oFso.OpenTextFile(Fname,2,True) FileStr=Request.Form("filestr") 'Response.Write FileStr oFile.Write FileStr oFile.Close Set oFile=Nothing EchoBack "保存编辑文件成功!" End Sub '复制或剪切文件 Sub SetFile(ByVal Fname,ByVal iMode) Session(mss & "setfile")=Fname Session(mss & "setmode")=iMode Dim ww If 0=iMode Then ww="复制" Else ww="剪切" End If EchoClose ww&"成功,请粘贴!" End Sub '粘贴文件或文件夹 Sub Parse(ByVal Fname) Dim oFile,oFolder Dim sName,iMode sName=Session(mss & "setfile") iMode=Session(mss & "setmode") If sName="" Then EchoClose "请先复制或剪切!" Else If InStr(LCase(Fname), LCase(sName)) > 0 Then EchoClose "目标文件夹在源文件夹内,非法操作!" Exit Sub End If '================ If Not IsFolder(Fname) Then EchoClose "目标文件夹不存在!" ElseIf IsFile(sName) Then Set oFile=oFso.GetFile(sName) If iMode=0 Then oFso.CopyFile sName,Replace(Fname&"\"&oFile.Name,"\\","\") Else oFso.MoveFile sName,Replace(Fname&"\"&oFile.Name,"\\","\") End If ElseIf IsFolder(sName) Then Set oFolder=oFso.GetFolder(sName) If iMode=0 Then oFso.CopyFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\") Else oFso.MoveFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\") End If Else EchoClose "源文件或文件夹不存在!" Exit Sub End If '================ EchoClose "复制或移动成功!刷新可查看效果" End If Session(mss & "setfile")="" Session(mss & "setmode")=0 End Sub '下载文件 Sub Download(ByVal Fname) Dim oFile If Not IsFile(Fname) Then EchoClose "不是文件或文件不存在!" Exit Sub End If Set oFile=oFso.GetFile(Fname) If InStr(LCase(oFile.Path)&"\",LCase(Server.MapPath("/")))>0 And Not IsScriptFile(oFso.GetExtensionName(oFile.Name)) Then Dim FileVName FileVName=Replace(oFile.Path,Server.MapPath("/"),"") FileVName=Replace(FileVName,"\","/") If Left(FileVName,1)<>"/" Then FileVName="/"&FileVName End If Response.Redirect FileVName Exit Sub End If If oFile.Size>1048576*100 Then EchoClose "文件超过100M,可能会造成服务器死机,\n不允许以Stream方式下载!\n请将该文件复制到网站目录以下\n然后以HTTP方式下载" Exit Sub End If Server.ScriptTimeout=10000 '延长脚本超时时间以提供下载 Dim oStream Set oStream=Server.CreateObject("ADODB.Stream") oStream.Open oStream.Type=1 oStream.LoadFromFile(Fname) Dim Data Data=oStream.Read oStream.Close Set oStream=Nothing If Not Response.IsClientConnected Then Set Data=Nothing Exit Sub End If Response.Buffer=True Response.AddHeader "Content-Disposition", "attachment; filename=" & oFile.Name Response.AddHeader "Content-Length", oFile.Size Response.CharSet = "UTF-8" Response.ContentType = "application/octet-stream" Response.BinaryWrite Data Response.Flush End Sub '删除文件 Sub Deletes(ByVal Fname) If IsFile(Fname) Then oFso.DeleteFile Fname,True ElseIf IsFolder(Fname) Then oFso.DeleteFolder Fname,True Else EchoClose "文件或文件夹不存在" Exit Sub End If EchoClose "文件删除成功!" End Sub '上传文件 Sub Upload(ByVal Fname) If Not IsFolder(Fname) Then EchoClose "没有指定上传的文件夹!" Exit Sub End If %> FSO文件浏览器 - <em>文件上传</em> <script language="JavaScript"> function getSaveName() { var filepath=document.uform.upload.value; if(filepath.length<1) return; var filename=filepath.substring(filepath.lastIndexOf("\\")+1,filepath.length); document.uform.ffname.value=filename; }
    FSO文件浏览器 - 文件上传
    上传文件:
    保存为: 覆盖模式
     
    <% End Sub '保存上传文件 Sub Saveupload(ByVal FolderName) If Not IsFolder(FolderName) Then EchoClose "没有指定上传的文件夹!" Exit Sub End If Dim Path,IsOverWrite Path=FolderName If Right(Path,1)<>"\" Then Path=Path&"\" FileName=Replace(Request("filename"),"\","") If Len(FileName)<1 Then EchoBack "请选择文件并输入文件名!" Exit Sub End If Path=Path&FileName If LCase(Request("overwrite"))="true" Then IsOverWrite=True Else IsOverWrite=False End If On Error Resume Next Call MyUpload(Path,IsOverWrite) If Err Then EchoBack "文件上传失败!(可能是文件已存在)" Else EchoClose "文件上传成功!\n" & Replace(fileName, "\", "\\") End If End Sub '文件上传核心代码 Sub MyUpload(FilePath,IsOverWrite) Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf RequestSize=Request.TotalBytes If RequestSize<1 Then Exit Sub Set oStream=Server.CreateObject("ADODB.Stream") Set tStream=Server.CreateObject("ADODB.Stream") With oStream .Type=1 .Mode=3 .Open .Write=Request.BinaryRead(RequestSize) .Position=0 sData=.Read bCrLf=ChrB(13)&ChrB(10) iSpaceEnd=InStrB(sData,bCrLf)-1 sSpace=LeftB(sData,iSpaceEnd) iInfoStart=iSpaceEnd+3 iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1 iFileStart=iInfoEnd+5 iFileEnd=InStrB(iFileStart,sData,sSpace)-3 sData="" '清空文件数据 iFileSize=iFileEnd-iFileStart+1 tStream.Type=1 tStream.Mode=3 tStream.Open .Position=iFileStart-1 .CopyTo tStream,iFileSize If IsOverWrite Then tStream.SaveToFile FilePath,2 Else tStream.SaveToFile FilePath End If tStream.Close .Close End With Set tStream=Nothing Set oStream=Nothing End Sub '显示文件属性 Sub Prop(Fname) On Error Resume Next Dim obj,oAttrib If IsFile(Fname) Then Set obj=oFso.GetFile(Fname) ElseIf IsFolder(Fname) Then Set obj=oFso.GetFolder(Fname) Else EchoClose "文件或文件夹不存在!" Exit Sub End If Set oAttrib=New FileAttrib_Cls oAttrib.Attrib=obj.Attributes %> FSO文件浏览器 - 文件属性 <script language="javascript"> function ww(obj) { return false; }
    FSO文件浏览器 - 文件属性
    路径:<% =obj.Path %>
    大小:<% =SizeCount(obj.Size) %>
    属性: >普通 >只读 >隐藏 >系统
    >目录 >存档 >链接 >压缩
    创建时间:<% =obj.DateCreated %>
    创建时间:<% =obj.DateLastModified %>
    最后访问<% =obj.DateLastAccessed %>
     
    <% End Sub '修改属性 Sub SaveProp(Fname) Dim Attribs,Attrib Attribs=Replace(Request.Form("att")," ","") Attribs=Split(Attribs,",") Attrib=0 Dim i For i=0 To UBound(Attribs) Attrib=Attrib+Attribs(i) Next 'Response.Write Attrib 'Exit Sub Dim obj,oAttrib If IsFile(Fname) Then Set obj=oFso.GetFile(Fname) ElseIf IsFolder(Fname) Then Set obj=oFso.GetFolder(Fname) Else EchoClose "文件或文件夹不存在!" Exit Sub End If If obj.IsRootFolder Then EchoClose "不能修改根目录属性!" Exit Sub End If obj.Attributes=Attrib EchoBack "修改文件属性成功!" End Sub '转到上一级文件夹 Sub DirUp() Dim oFolder,ssFname If IsFolder(Request("fname")) Then Set oFolder=oFso.GetFolder(Request("fname")) If oFolder.IsRootFolder Then '转至显示驱动器页面 Call Drive() Exit Sub Else ssFname=oFolder.ParentFolder.Path Set oFolder=Nothing Call DirList(ssFname) End If Else If IsFile(Request("fname")) Then '文件下载 Else Response.Write "文件夹或文件不存在!" End If End If End Sub '更改文件名页面 Sub Rename() Dim Fname,sName Fname=Request("fname") If IsFolder(Fname) Then sName=oFso.GetFolder(Fname).Name Else If IsFile(Fname) Then sName=oFso.GetFile(Fname).Name Else Response.Write "文件或文件夹不存在!" Exit Sub End If End If %> FSO文件浏览器 - 重命名 <script language="JavaScript"> function icheck() { if(document.cform.toname.value=="") { alert("请输入合法的文件名!"); return false; } else return true; }
    FSO文件浏览器 - 文件更名
    更名为:
     
    <% End Sub '更改文件名操作 Sub SaveRename() Dim Fname,oFolder,oFile,FDir,ToName Fname=Request("fname") ToName=Replace(Request("toname"),"\","") If IsFolder(Fname) Then Set oFolder=oFso.GetFolder(Fname) Fname=oFolder.Path If Right(Fname,1)="\" Then Fname=Left(Fname,Len(Fname)-1) End If FDir=Left(Fname,InstrRev(Fname,"\")) ToName=FDir & ToName On Error Resume Next Err.Clear Err=False oFso.MoveFolder Fname,ToName If Err Then EchoBack "文件名不合法!" Else EchoClose "文件夹更名成功!\n刷新之后即可看到效果" End If Exit Sub End If If IsFile(Fname) Then Set oFile=oFso.GetFile(Fname) Fname=oFile.Path FDir=Left(Fname,InstrRev(Fname,"\")) ToName=FDir & ToName On Error Resume Next Err.Clear Err=False oFso.MoveFile Fname,ToName If Err Then EchoBack "文件名不合法!" Else EchoClose "文件更名成功!\n刷新之后即可看到效果" End If Exit Sub End If End Sub '文件打包/解包页面 Sub Page_Pack() Dim vp,vu vp=Request("pname") vu=Request("uname") If Right(vu,4)<>".mdb" Then vu=Server.MapPath("/rs_pack.mdb") End If %> FSO文件浏览器 - 文件打包/解包
    FSO文件浏览器 - 文件打包/解包
    打包文件夹
    打包到:">
    文件包路径:
    解包到: ">
    <% End Sub '文件夹内容列表 ========== Dirlist Sub Dirlist(ByVal Fpath) If IsFile(Fpath) Then '下载该文件 Response.Write "<script language=""javascript"">window.open('?page=fso&act=download&fname="&Server.UrlEncode(Fpath)&"', """", ""menu=no,resizable=yes,height=90,width=400"");history.back();文件夹不存在!" Exit Sub End If '代码开始 Dim oFolder Dim sFolder,sFile '文件夹下的子文件夹和文件 Set oFolder=oFso.GetFolder(Fpath) %> FSO文件浏览器 <script language="JavaScript"> var folderpath="<% =Replace(oFolder.Path,"\","\\") %>"; //当前文件夹 var fselected=""; function opendial(sUrl) //打开对话框窗口 { var newWin=window.open(sUrl, "", "menu=no,resizable=no,height=130,width=400"); return newWin; } function fopen(sfname) //打开文件夹或文件 { location.href="?page=fso&fname="+escape(sfname); } function fselect(obj) //选中文件夹或文件 { var flen=document.all("f").length; for(var i=0;i文件夹 { location.href="?page=fso&act=up&fname="+escape(folderpath); } function fnew() { opendial("?page=fso&act=new&fname="+escape(folderpath)); } function frename() //重命名文件 { if(fselected=="") { alert("请选择文件或文件夹!"); return false; } else opendial("?page=fso&act=rename&fname="+escape(fselected)); } function fdownload() //下载文件 { if(fselected=="") { alert("请选择文件!(大小在1MB以下)"); return false; } else opendial("?page=fso&act=download&fname="+escape(fselected)); } function fedit() //编辑文本文件 { if(fselected=="") { alert("请选择文件!"); return false; } else window.open("?page=fso&act=edit&fname="+escape(fselected)); } function fcopy() //复制文件 { if(fselected=="") { alert("请选择文件或文件夹!"); return false; } else opendial("?page=fso&act=copy&fname="+escape(fselected)); } function fcut() //剪切文件 { if(fselected=="") { alert("请选择文件或文件夹!"); return false; } else opendial("?page=fso&act=cut&fname="+escape(fselected)); } function fparse() //粘贴文件或文件夹 { opendial("?page=fso&act=parse&fname="+escape(folderpath)); } function fdelete() { if(fselected=="") { alert("请选择文件或文件夹!"); return false; } else { if(!confirm("确定要删除本文件或文件夹?")) return false; else opendial("?page=fso&act=delete&fname="+escape(fselected)); } } function fprop() //属性 { var vv; if(fselected=="") vv=folderpath; else vv=fselected; window.open("?page=fso&act=prop&fname="+escape(vv), "", "menu=no,resizable=no,height=250,width=500"); } function fpack() //打包解包 { var vp,vu; if(fselected=="") { vp=folderpath; vu=folderpath; } else { vp=fselected; vu=fselected; } window.open("?page=fso&act=pack&pname="+escape(vp)+"&uname="+escape(vu),"", "menu=no,resizable=no,height=250,width=500"); }
    FSO文件浏览器
                             
              
    <% Dim Islight Islight=False '逐个显示子文件夹 For Each sFolder In oFolder.SubFolders Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not Islight Next '逐个显示文件 For Each sFile In oFolder.Files Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not Islight Next %>
    文件名类型大小修改时间
    " Response.Write "0 "&Web&sFolder.Name Response.Write "文件夹 "&sFolder.DateLastModified&"
    " Response.Write " "&sFile.Name Response.Write ""&sFile.Type&""&SizeCount(sFile.Size)&""&sFile.DateLastModified&"

    <% =Copyright %>
    <% T2=Timer() Runtime=(T2-T1)*1000 Response.Write "Page Processed in "&Runtime&" Mili-seconds" %>
    <% End Sub '用户登录 Sub Login() %> FSO文件浏览器 - 用户登录
    FSO文件浏览器 - 用户登录
    请输入登录密码:  
    <% =Copyright %> <% End Sub '用户登录验证 Sub LoginChk() If Request.Form("password")<>Password Then EchoBack "一夫当关,万夫莫开,您的密码不正确!" Exit Sub Else Session(mss & "IsAdminlogin")=True Response.Redirect "?page=fso" End If End Sub '用户退出 Sub Logout() Session(mss & "IsAdminlogin")=False Response.Redirect "?" End Sub '显示一个图片 Sub Page_Img() Dim HexStr HexStr="47 49 46 38 39 61 01 00 19 00 C4 00 00 6D 92 DA 66 8C D9 7E 9E DF 7B 9C DE 81 A0 DF 79 9A DD 62 89 D8 97 B1 E5 71 94 DB 84 A3 E0 58 81 D5 91 AC E3 5A 84 D6 69 8E DA 65 8B D8 8A A7 E2 76 98 DD 5E 86 D7 61 88 D7 74 97 DC 5D 86 D6 5C 85 D6 6E 92 DB 55 80 D5 6A 8F DA 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 21 F9 04 00 00 00 00 00 2C 00 00 00 00 01 00 19 00 40 05 15 60 85 09 87 31 3D 51 60 15 C9 72 29 0C 25 39 0D 80 40 03 11 02 00 3B" Response.ContentType="IMAGE/GIF" WriteBytes HexStr End Sub '输出Css Sub Page_Css() %> body { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; } input,select,textarea { font-family: Verdana, Arial, "宋体"; font-size: 12px; color: #000000; } a:link { font-size: 12px; color: #000000; text-decoration: none; } a:visited { font-size: 12px; color: #000000; text-decoration: none; } a:active { font-size: 12px; line-height: normal; color: #333333; text-decoration: none; } a:hover { font-size: 12px; color: #FF7F24; text-decoration: underline; } hr { height:1px; color:#6595D6; } table { BORDER-COLLAPSE: collapse; } table.border { border: 1px solid #6595D6; } td { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; } td.border { border: 1px solid #6595D6; } td.inner { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; border: 0px; } th { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #FFFFFF; height:25px; background-color:#427FBB; background-image:url(?page=img); } th.border { border: 1px solid #6595D6; } .b { width:55px; height:22px; font-size:12px; } <% End Sub '================ Functions ================== Function IsFolder(ByVal fname) IsFolder=oFso.FolderExists(fname) End Function Function IsFile(ByVal fname) IsFile=oFso.FileExists(fname) End Function '字节数统计 Bytes Function SizeCount(ByVal iSize) On Error Resume Next Dim size,showsize size=iSize showsize=size & " Byte" if size>1024 then size=(Size/1024) showsize=formatnumber(size,3) & " KB" end if if size>1024 then size=(size/1024) showsize=formatnumber(size,3) & " MB" end if if size>1024 then size=(size/1024) showsize=formatnumber(size,3) & " GB" end if SizeCount = showsize End Function '16进制字符转10进制数字 Function Hex2Num(v) Dim w If IsNumeric(v) Then w=Int(v) Else Select Case UCase(v) Case "A": w=10 Case "B": w=11 Case "C": w=12 Case "D": w=13 Case "E": w=14 Case "F": w=15 Case Else: w=0 End Select End If Hex2Num=w End Function '取得字节字符串的数值 Function Byte2Num(sByte) Dim b1,b2 b1=Left(sByte,1) b2=Right(sByte,1) Byte2Num=Hex2Num(b1)*16+Hex2Num(b2) End Function '将16进制字节字符串输出为二进制数据 Function WriteBytes(sBytes) Dim sByte,i sByte=Split(sBytes," ") For i=0 To UBound(sByte)-1 Response.BinaryWrite ChrB(Byte2Num(sByte(i))) Next End Function '获得文件图标 Function getFileIcon(extName) Select Case LCase(extName) Case "vbs", "h", "c", "cfg", "pas", "bas", "log", "asp", "txt", "php", "ini", "inc", "htm", "html", "xml", "conf", "config", "jsp", "java", "htt", "lst", "aspx", "php3", "php4", "js", "css", "asa" getFileIcon = "Wingdings>2" Case "wav", "mp3", "wma", "ra", "wmv", "ram", "rm", "avi", "mpg" getFileIcon = "Webdings>·" Case "jpg", "bmp", "png", "tiff", "gif", "pcx", "tif" getFileIcon = "'webdings'>Ÿ" Case "exe", "com", "bat", "cmd", "scr", "msi" getFileIcon = "Webdings>1" Case "sys", "dll", "ocx" getFileIcon = "Wingdings>ÿ" Case Else getFileIcon = "'Wingdings 2'>/" End Select End Function '获得磁盘类型 Function getDriveType(num) Select Case num Case 0 getDriveType = "未知" Case 1 getDriveType = "可移动磁盘" Case 2 getDriveType = "本地硬盘" Case 3 getDriveType = "网络磁盘" Case 4 getDriveType = "CD-ROM" Case 5 getDriveType = "RAM 磁盘" End Select End Function '判断是否为脚本文件 Function IsScriptFile(Ext) Const ScriptExts="asp,aspx,asa,php" IsScriptFile=False Dim FileExt,Exts FileExt=LCase(Ext) Exts=Split(ScriptExts,",") Dim i For i=0 To UBound(Exts)-1 If Exts(i)=FileExt Then IsScriptFile=True Exit Function End If Next IsScriptFile=False End Function '返回消息并关闭 Sub EchoClose(msg) Response.Write "<script language=""Javascript"">alert("""&msg&""");window.close();alert("""&msg&""");history.back();=2048 Then c=1 v=v Mod 2048 End If If v>=1024 Then al=1 v=v Mod 64 End If If v>=32 Then a=1 v=v Mod 32 End If If v>=16 Then d=1 v=v Mod 8 End If If v>=4 Then s=1 v=v Mod 4 End If If v>=2 Then h=1 v=v Mod 2 End If If v>=1 Then r=1 End If End Property End Class '============================ 文件打包及解包过程 ============================= '文件打包 Sub Pack(ByVal FPath, ByVal sDbPath) Server.ScriptTimeOut=900 Dim DbPath If Right(sDbPath,4)=".mdb" Then DbPath=sDbPath Else DbPath=sDbPath&".mdb" End If If oFso.FolderExists(DbPath) Then EchoBack "不能创建数据库文件!"&Replace(DbPath,"\","\\") Exit Sub End If If oFso.FileExists(DbPath) Then oFso.DeleteFile DbPath End If If IsFolder(FPath) Then RootPath=GetParentFolder(FPath) If Right(RootPath,1)<>"\" Then RootPath=RootPath&"\" Else EchoBack "请输入文件夹路径!" Exit Sub End If Dim oCatalog,connStr,DataName Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set oCatalog=Server.CreateObject("ADOX.Catalog") Set rs=Server.CreateObject("ADODB.RecordSet") On Error Resume Next connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath oCatalog.Create connStr If Err Then EchoBack "不能创建数据库文件!"&Replace(DbPath,"\","\\") Exit Sub End If Set oCatalog=Nothing conn.Open connStr conn.Execute("Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)") oStream.Open oStream.Type=1 rs.Open "Files",conn,3,3 DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name,".")-1) NoPackFiles=Replace(NoPackFiles,"<$datafile>",DataName) FailFileList="" '打包失败的文件列表 PackFolder FPath If FailFilelist="" Then EchoClose "文件夹打包成功!" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
    ")&"" End If oStream.Close rs.Close conn.Close End Sub '添加文件夹(递归) Sub PackFolder(FolderPath) If Not IsFolder(FolderPath) Then Exit Sub Dim oFolder,sFile,sFolder Set oFolder=oFso.GetFolder(FolderPath) For Each sFile In oFolder.Files If InStr(NoPackFiles,"|"&sFile.Name&"|")<1 Then PackFile sFile.Path End If Next Set sFile=Nothing For Each sFolder In oFolder.SubFolders PackFolder sFolder.Path Next Set sFolder=Nothing End Sub '添加文件 Sub PackFile(FilePath) Dim RelPath RelPath=Replace(FilePath,RootPath,"") 'Response.Write RelPath & "
    " On Error Resume Next Err.Clear Err=False oStream.LoadFromFile FilePath rs.AddNew rs("FilePath")=RelPath rs("FileData")=oStream.Read() rs.Update If Err Then '一个文件打包失败 FailFilelist=FailFilelist&FilePath&"|" End If End Sub '=========================================================================== '文件解包 Sub UnPack(vFolderPath,DbPath) Server.ScriptTimeOut=900 Dim FilePath,FolderPath,sFolderPath FolderPath=vFolderPath FolderPath=Trim(FolderPath) If Mid(FolderPath,2,1)<>":" Then EchoBack "路径格式错误,无法创建改目录!" Exit Sub End If If Right(FolderPath,1)="\" Then FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set rs=Server.CreateObject("ADODB.RecordSet") connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath On Error Resume Next Err=False conn.Open connStr If Err Then EchoBack "数据库打开错误!" Exit Sub End If Err=False oStream.Open oStream.Type=1 rs.Open "Files",conn,1,1 FailFilelist="" '清空失败文件列表 Do Until rs.EOF Err.Clear Err=False FilePath=FolderPath&"\"&rs("FilePath") FilePath=Replace(FilePath,"\\","\") sFolderPath=Left(FilePath,InStrRev(FilePath,"\")) If Not oFso.FolderExists(sFolderPath) Then CreateFolder(sFolderPath) End If oStream.SetEos() oStream.Write rs("FileData") oStream.SaveToFile FilePath,2 If Err Then '添加失败文件项目 FailFilelist=FailFilelist&rs("FilePath").Value&"|" End If rs.MoveNext Loop rs.Close Set rs=Nothing conn.Close Set conn=Nothing Set oStream=Nothing If FailFilelist="" Then EchoClose "文件解包成功!" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
    ")&"" End If End Sub '=========================================================================== '=========================================================================== '建立文件夹(递归) Function CreateFolder(FolderPath) On Error Resume Next Err=False Dim sParFolder sParFolder=GetParentFolder(FolderPath) If Not oFso.FolderExists(sParFolder) Then CreateFolder(sParFolder) End If oFso.CreateFolder(FolderPath) If Err Then CreateFolder=False Else CreateFolder=True End If End Function Function GetParentFolder(Path) Dim sPath sPath=Path If Right(sPath,1)="\" Then sPath=Left(sPath,Len(sPath)-1) sPath=Left(sPath,InstrRev(sPath,"\")-1) GetParentFolder=sPath End Function '============================================================================ Sub wv(v) If v>0 Then Response.Write " checked " End Sub %>
    556,delay1.zip 源码设计中的延时功能(1KB)557,type_1.zip 趣味打字2.1(233KB)558,test1.zip asp编写动态网页计数器(1KB)559,hztosm.zip 汉字转声母完全源代码(90KB)560,formatfloppy.zip 格式化软盘源代码(13KB)561,freespace.zip 获取磁盘剩余空间(3KB)562,setscreen 设置屏幕分辨率(7KB)563,snapwindow.zip 一个抓图的小程序(14KB)564,hotrgn.zip 热区的应用(6KB)565,getserial.zip 读出驱动器序列号,可以制作加密安装盘(2KB)566,opencdrom.zip 可以程序控制打开或关闭CDROM,非常方便(2KB)567,getusername.zip 自动读取用户登陆名称,再进行密码验证(2KB)568,gethostname.zip 读取机器名称(2KB)569,printpic.zip 解决图形打印的问题(50KB)570,g029_pcl.zip拼图游戏(56KB)571,g028_octopus.zip一个简单的掌上游戏机的游戏,这个游戏机的内容是要逃过大章鱼的捕捉(408KB)572,g027_menace.zip仓库世家-推箱子的游戏(114KB)573,g026_breKthru.zip弹珠台游戏(41KB)574,g025_zhq.zip一个能考考你的智慧的智慧棋(17KB)575,g024_vb-sol.zipVB 的扑克牌游戏的源码(15KB)576,g023_picgame.zip一个好玩的拼图游戏(25KB)577,g021_zm015看着超级玛莉不停的追赶着你的鼠标,是不是很有意思呢?(25KB)578,g020_zm019一个拼图游戏,可以自己指定图片进行游戏(12KB)579,g019_zm011一个网络五子棋的源程序(并有聊天功能)(41KB)580,g018_zm010.zip中国象棋的源程序,支持网络作战(23KB)581,g0173维的breaKthrough游戏(8KB)582,g016.zip小蜜蜂射击游戏源程序, 不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB)583,g015.zip旋转俄罗斯 1.0 demo 版的源程序,vb5 版存贮,稍加修改即适合于 vb4、vb3。面有用 vb 处理俄罗斯方块的核心内容及简单注释(8KB)584,g014.zipbreakthrough游戏(保持小球在屏幕上跳动)源程序(50KB)585,g013.zip3维迷宫游戏的源程序(40KB)586,g012.zip射击(导弹)游戏的源程序(5KB)587,g011.zip生命游戏源程序(12KB)588,g010.zip一个精灵游戏源程序(33KB)589,g009.zip翻转棋游戏(64子, 每子正反面分别为黑白两色, 两人对弈)的源程序(29)590,g008.zip纸牌游戏源程序(45KB)591,g007.zip太空船游戏例子源程序(48KB)592,g006.zip用白雪做背面的俄罗斯方块(1.0版),自带EXE(224KB)593,g005.zip个人娱乐游戏,自带EXE(25KB)594,g004.zip个个人自娱乐的扑克牌游戏(57KB)595,g003.zip代表和平的娱乐游戏,自带EXE(12KB)596,g002.zip一个迷宫游戏,还有地图编辑器呢,完全源码(230KB)597,g001.zip模仿windows中的扫雷,自带EXE(38KB)
    556,delay1.zip 源码设计中的延时功能(1KB)557,type_1.zip 趣味打字2.1(233KB)558,test1.zip asp编写动态网页计数器(1KB)559,hztosm.zip 汉字转声母完全源代码(90KB)560,formatfloppy.zip 格式化软盘源代码(13KB)561,freespace.zip 获取磁盘剩余空间(3KB)562,setscreen 设置屏幕分辨率(7KB)563,snapwindow.zip 一个抓图的小程序(14KB)564,hotrgn.zip 热区的应用(6KB)565,getserial.zip 读出驱动器序列号,可以制作加密安装盘(2KB)566,opencdrom.zip 可以程序控制打开或关闭CDROM,非常方便(2KB)567,getusername.zip 自动读取用户登陆名称,再进行密码验证(2KB)568,gethostname.zip 读取机器名称(2KB)569,printpic.zip 解决图形打印的问题(50KB)570,g029_pcl.zip拼图游戏(56KB)571,g028_octopus.zip一个简单的掌上游戏机的游戏,这个游戏机的内容是要逃过大章鱼的捕捉(408KB)572,g027_menace.zip仓库世家-推箱子的游戏(114KB)573,g026_breKthru.zip弹珠台游戏(41KB)574,g025_zhq.zip一个能考考你的智慧的智慧棋(17KB)575,g024_vb-sol.zipVB 的扑克牌游戏的源码(15KB)576,g023_picgame.zip一个好玩的拼图游戏(25KB)577,g021_zm015看着超级玛莉不停的追赶着你的鼠标,是不是很有意思呢?(25KB)578,g020_zm019一个拼图游戏,可以自己指定图片进行游戏(12KB)579,g019_zm011一个网络五子棋的源程序(并有聊天功能)(41KB)580,g018_zm010.zip中国象棋的源程序,支持网络作战(23KB)581,g0173维的breaKthrough游戏(8KB)582,g016.zip小蜜蜂射击游戏源程序, 不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB)583,g015.zip旋转俄罗斯 1.0 demo 版的源程序,vb5 版存贮,稍加修改即适合于 vb4、vb3。面有用 vb 处理俄罗斯方块的核心内容及简单注释(8KB)584,g014.zipbreakthrough游戏(保持小球在屏幕上跳动)源程序(50KB)585,g013.zip3维迷宫游戏的源程序(40KB)586,g012.zip射击(导弹)游戏的源程序(5KB)587,g011.zip生命游戏源程序(12KB)588,g010.zip一个精灵游戏源程序(33KB)589,g009.zip翻转棋游戏(64子, 每子正反面分别为黑白两色, 两人对弈)的源程序(29)590,g008.zip纸牌游戏源程序(45KB)591,g007.zip太空船游戏例子源程序(48KB)592,g006.zip用白雪做背面的俄罗斯方块(1.0版),自带EXE(224KB)593,g005.zip个人娱乐游戏,自带EXE(25KB)594,g004.zip个个人自娱乐的扑克牌游戏(57KB)595,g003.zip代表和平的娱乐游戏,自带EXE(12KB)596,g002.zip一个迷宫游戏,还有地图编辑器呢,完全源码(230KB)597,g001.zip模仿windows中的扫雷,自带EXE(38KB)

    28,391

    社区成员

    发帖
    与我相关
    我的任务
    社区描述
    ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
    社区管理员
    • ASP
    • 无·法
    加入社区
    • 近7日
    • 近30日
    • 至今
    社区公告
    暂无公告

    试试用AI创作助手写篇文章吧