asp和fso实现新建文件夹

'-------------------------------------------------------------------------------------------------------1.asp

<!--#include file="function.asp" -->
<%if Request.Cookies("venshop")("user_name")<>"" then%>
<script>
   function checkAll(){
   for (i=0;i<document.forms[0].length;i++){
    if (document.forms[0][i].tagName=="INPUT"){
    if (document.forms[0][i].type=="radio")
     {document.forms[0][i].checked="checked"}
    }
   }
   }
</script>

<style type="text/css">
<!--
.STYLE1 {
 color: #CC3300;
 font-size: 13px;
 font-family: "宋体";
 font-weight: bold;
}
.STYLE5 {
 font-family: "宋体";
 color: #FF0000;
}
.STYLE7 {
 font-family: "宋体";
 font-size: 13px;
}
-->
</style>
<form name="form1" method="post" action="folder-action.asp">

<%
AttPath=Request.QueryString("AttPath")
  if len(AttPath)<1 then
    AttPath="uploadfile"
   elseif bc(server.mapPath(AttPath),server.mapPath("uploadfile")) then
    AttPath="uploadfile"
   end If

ArrFolders=split(getPathList(AttPath)(0),"*")
Arrfiles=split(getPathList(AttPath)(1),"*")
'response.write (AttPath&"<br>")

if AttPath<>"uploadfile" then
    arrUpFolders=split(AttPath,"/")
    for i=0 to ubound(arrUpFolders)-1
    arrUpFolder=arrUpFolder&TempF&arrUpFolders(i)
    TempF="/"
    next
end if
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr>
    <td bgcolor="#ff9600" colspan="5"height="2"></td>
  </tr>
  <tr>
    <td height="32" colspan="3" align="left">
    <table width="100%" border="0" cellspacing="0" cellpadding="0">
        <tr>  <td width="9%" align="center"><a href="keshikongjian.asp"><img src="images/fhmu.gif" alt="" width="83" height="26" /></a></td>
        
  <td width="17%" align="center"> <%
if len(arrUpFolder)>0 then
  %><% response.write "<a href=""?AttPath="&arrUpFolder&"""><img src=images/fanhui.gif></a><br>"%>
  <%else%><img src=images/fanhui1.gif>  <%end if%></td>
          <td width="10%" align="left"><a href="cjwjj.asp"><img src="images/xinjianwenjan.gif" alt="" width="110" height="26" /></a></td>
          <td width="61%"><a href="scwj.asp"><img src="images/shangchuan.gif" alt="" width="53" height="26" /></a></td>
          <td width="3%">&nbsp;</td>
        </tr>
      </table></td>
    </tr>
  <tr>
    <td bgcolor="#ff9600" colspan="5"height="1"></td>
  </tr>
  <tr>
    <td width="361" align="right" class="STYLE7">请输入文件夹名称：</td>
    <td width="286" height="30"><input type="text" name="name1" /></td>
    <td width="456">&nbsp;</td>
  </tr>
  <tr>
    <td align="right" valign="top" class="STYLE7">您选择的当前目录是：</td>
    <td height="30"><span class="STYLE5">
      <input type="text" name="AttPath" value="<%=AttPath%>" />
    </span></td>
    <td valign="top">&nbsp;</td>
  </tr>
  <tr>
    <td align="right" valign="top"><p class="STYLE7">请选择文件夹位置：</p>
        <p class="STYLE1">&nbsp;</p></td>
    <td><%
for each ArrFolder in ArrFolders
   response.write "<input name=""add"" type=""radio"" value="""&AttPath&"/"&ArrFolder&"""/>&nbsp;<img src=images/wenjianjia.gif>&nbsp;<a href=""?AttPath="&AttPath&"/"&ArrFolder&""">"&ArrFolder&"</a><br>"
next

for each Arrfile in Arrfiles
 'response.write "<input name=""Files"" type=""checkbox"" value="""&AttPath&"/"&Arrfile&"""/>&nbsp;<a href="""&AttPath&"/"&Arrfile&""" target=""_blank"">"&Arrfile&"</a>&nbsp;&nbsp;"&getFileInfo(AttPath&"/"&Arrfile)(0)&" | "&getFileInfo(AttPath&"/"&Arrfile)(2)&" | "&getFileInfo(AttPath&"/"&Arrfile)(3)&"<br>"
next

%></td>
    <td valign="top"><p></p></td>
  </tr>
  <tr>
    <td bgcolor="#ff9600" colspan="5"height="1"></td>
  </tr>
  <tr>
    <td height="30" colspan="2" align="center"><input type="submit" name="Submit" value="提 交" />
      &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
      <input type="reset" name="Submit2" value="取 消" /></td>
    <td align="center" valign="middle">&nbsp;</td>
  </tr>
  <tr>
    <td bgcolor="#ff9600" colspan="5"height="1"></td>
  </tr>
</table>
</form>
<%else%>
<%response.write"<script language=javascript>alert('对不起您还未登录！或您权限不够！');window.location='ksyx.asp';</script>"
response.write"javascript:history.go(-1)</script>"
response.end%>
<%end if%>

 

 

'------------------------------------------------------------------------------------------------------------------function.asp

<%
Dim stream1,stream2,istart,iend,filename
istart=1
vbEnter=Chr(13)&Chr(10)

function getvalue(fstr,foro,paths)'fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径
if foro then
getvalue=""
istart=instring(istart,fstr)

istart=istart+len(fstr)+5
iend=instring(istart,vbenter+"-----------------------------")
if istart>5+len(fstr) then
getvalue=substring(istart,iend-istart)

else
getvalue=""
end if
else
istart=instring(istart,fstr)
istart=istart+len(fstr)+13
iend=instring(istart,vbenter)-1

filename=substring(istart,iend-istart)
filename=getfilename(filename)

istart=instring(iend,vbenter+vbenter)+3
iend=instring(istart,vbenter+"-----------------------------")
filestart=istart
filesize=iend-istart-1
objstream.position=filestart
Set sf = Server.CreateObject("ADODB.Stream")
sf.Mode=3
sf.Type=1
sf.Open
objstream.copyto sf,FileSize

if filename<>"" then
Set rf = Server.CreateObject("Scripting.FileSystemObject")
i=0
fn=filename
while rf.FileExists(server.mappath(paths+fn))

fn=cstr(i)+filename
i=i+1
wend
filename=fn
sf.SaveToFile server.mappath(paths+filename),2
end if
getvalue=filename
end if

end function

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

Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to objStream.Size-theLen
if i>objstream.size then exit Function

objstream.Position=i-1
if AscB(objstream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if objstream.EOS then
inString=0
Exit for
end if
if AscB(objstream.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

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

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

 

 

'---------------------------------------------------------------------------------------------------------folder-action.asp

<%dim Name,add,Name1
Name1=Request("Name1")
add=Request("add")
AttPath=Request("AttPath")
if len(Name1)=0 then
  response.write"<script language=javascript>alert('文件夹名称不能为空请重新填写！');window.location='keshikongjian.asp';</script>"
  response.end
 end If
if len(add)=0  and len(AttPath)<>0 then
Name=AttPath+"/"+Name1
else  if len(add)=0 and len(AttPath)=0  then
Name=uploadfile+"/"+Name1
else
if len(add)<>0 and len(AttPath)<>0  then
Name=add+"/"+Name1
end if
end if
end if
%>
<%'=Name%>
 <%set fs=createobject("scripting.filesystemobject")
 MyFolder=server.mappath(""&name&"")
 
 if fs.folderexists(MyFolder) then
  response.write"<script language=javascript>alert('文件夹已存在请重新创建！');window.location='keshikongjian.asp';</script>"
  response.end
 end If
 If NOT fs.folderexists(MyFolder) then
  fs.createfolder(MyFolder)
 End If
 If fs.folderexists(MyFolder) then
     response.write"<script language=javascript>alert('文件夹创建成功！');window.location='keshikongjian.asp';</script>"
  response.end
 End If%>