Microsoft VBScript 运行时错误 错误 '800a0046' 没有权限:
开始->运行->dcomcnfg 找到\\\"Microsoft Excel 应用程序\\\"(这个名称取决于你调用的Object是什么),然后右键->Properties->security把三个权限都给everyone即可,其实第一个Launch & activate即可 这是权限的问题. 还有一个简单的方法,就是找到c:\windows目录中的scrrun.dll文件,设置属性中的安全,加入user组,并给予读取和运行、读取即可。 你也可以把网站放到FAT32分区试一下.因为在NTFS分区,有关于权限问题有一些程序莫明其妙就出错了 试试这个无组件上传吧!用得比较多 文件:upload_5xsoft.inc <!--METADATA TYPE="TypeLib" UUID="{00000205-0000-0010-8000-00aa006d2ea4}"--> <% dim fo,gPath,gAct,gFileName,gFilePath,g,gRootUrl,gBaseUrl,gPage,gSearch,gEachPage,gFolder,gFilter dim gPageSize,sTemp,gNoFile dim sfor(28,2) gPageSize=100 gRootUrl=Session("webeditbase") if right(gRootUrl,1)<>"/" then gRootUrl=gRootUrl&"/" gNoFile=array("asp","aspx") '禁止访问的脚本 set fo=Server.CreateObject("Scripting.FileSystemObject") sFor(0,0)="txt":sFor(0,1)=1 sFor(1,0)="chm":sFor(1,1)=2 sFor(2,0)="hlp":sFor(2,1)=2 sFor(3,0)="doc":sFor(3,1)=3 sFor(4,0)="pdf":sFor(4,1)=4 sFor(5,0)="gif":sFor(5,1)=6 sFor(6,0)="jpg":sFor(6,1)=6 sFor(7,0)="png":sFor(7,1)=6 sFor(8,0)="bmp":sFor(8,1)=6 sFor(9,0)="asp":sFor(9,1)=7 sFor(10,0)="jsp":sFor(10,1)=7 sFor(11,0)="js" :sFor(11,1)=7 sFor(12,0)="htm":sFor(12,1)=8 sFor(13,0)="html":sFor(13,1)=8 sFor(14,0)="shtml":sFor(14,1)=8 sFor(15,0)="zip":sFor(15,1)=9 sFor(16,0)="rar":sFor(16,1)=9 sFor(17,0)="exe":sFor(17,1)=10 sFor(18,0)="avi":sFor(18,1)=11 sFor(19,0)="mpg":sFor(19,1)=11 sFor(20,0)="ra" :sFor(20,1)=12 sFor(21,0)="ram":sFor(21,1)=12 sFor(22,0)="mid":sFor(22,1)=13 sFor(23,0)="wav":sFor(23,1)=13 sFor(24,0)="mp3":sFor(24,1)=13 sFor(25,0)="asf":sFor(25,1)=11 sFor(26,0)="php":sFor(26,1)=7 sFor(27,0)="php3":sFor(27,1)=7 sFor(28,0)="aspx":sFor(28,1)=7 gFilePath=Request.ServerVariables("SCRIPT_NAME") gFileName=mid(gFilePath,instrRev(gFilePath,"/")+1) gFilePath=lcase(left(gFilePath,instrRev(gFilePath,"/"))) gPath=lcase(getVar("path","str",gRootUrl)) if left(gPath,1)<>"/" then gPath=gRootUrl&gPath gPage=getVar("page","num",1) gAct=getVar("act","str","") gFilter=getVar("filter","str","") setBaseUrl sub setBaseUrl() gBaseUrl=gFileName&"?page="&gPage&"&path="&gPath if gFilter<>"" then gBaseUrl=gBaseUrl&"&filter="&gFilter end sub function getVar(theStr,strType,defValue) select case strType case "str" if isEmpty(Request.QueryString(theStr)) or trim(Request.QueryString(theStr))="" then getVar=defValue else getVar=trim(Request.QueryString(theStr)) end if case "num" if isEmpty(Request.QueryString(theStr)) or not isNumeric(Request.QueryString(theStr)) then getVar=defValue else getVar=cint(Request.QueryString(theStr)) end if case else getStr=defValue end select end function function getForm(theStr,strType,defValue) select case strType case "str" if isEmpty(Request.form(theStr)) or trim(Request.form(theStr))="" then getForm=defValue else getForm=trim(Request.form(theStr)) end if case "num" if isEmpty(Request.form(theStr)) or not isNumeric(Request.form(theStr)) then getForm=defValue else getForm=cint(Request.form(theStr)) end if case else getForm=defValue end select end function sub HtmEnd(info,isback,dir) set fo=nothing set gFolder=nothing if info<>"" then Response.Write("<script language=""javascript"">alert('"&info&"');</script>") select case isback case 1 Response.Write("<script language=""javascript"">history.back();</script>") case 2 Response.Write("<script language=""javascript"">location.href='"&dir&"';</script>") end select Response.write("</body></html>") Response.End end sub function procIsEdit(sName) dim i1,i,isEdit isEdit=Array(1,7,8) procIsEdit=0 i1=procGetFormat(sName) for i=0 to ubound(isEdit) if isEdit(i)=i1 then procIsEdit=1 exit for end if next end function function procGetExtName(sName) procGetExtName="" if instrRev(sName,".")<1 then exit function procGetExtName=lcase(mid(sName,instrRev(sName,".")+1)) end function function procGetFormat(sName) dim i,str procGetFormat=0 if instrRev(sName,".")=0 then exit function str=lcase(mid(sName,instrRev(sName,".")+1)) for i=0 to uBound(sFor,1) if str=sFor(i,0) then procGetFormat=sFor(i,1) exit for end if next end function function procCheckFile(sName,ischeck) dim sExt,sPath,i,errorchar errorchar=array("'","""","\","/","*","?","&","|","<",">") procCheckFile="ok" sExt=lcase(procGetExtName(sName)) if gFilter<>"" then if instr(sName,gFilter)<1 then procCheckFile="没有权限访问此文件!" exit function end if end if if Session("webeditrun")="0" then for i=0 to ubound(gNoFile) if gNoFile(i)=sExt then procCheckFile="没有权限访问此文件!" exit function end if next end if if ischeck>0 then sPath=left(sName,instrRev(sName,"/")) sPath=procCheckDir(sPath,1) if sPath<>"ok" then procCheckFile=sPath exit function end if if ischeck=1 and not fo.FileExists(Server.MapPath(sName)) then procCheckFile="文件没有找到!" exit function end if else for i=0 to ubound(errorchar) if instr(sName,errorchar(i))>0 then procCheckFile="文件名中含有非法字符!" exit function end if next end if procCheckFile="ok" end function function procCheckDir(sPath,mode) dim errorchar,i,hd,str sPath=lcase(sPath) procCheckDir="ok" errorchar=array("'","""","\","..","//","*","?","&","|","<",">") if isempty(sPath) or trim(sPath)="" then procCheckDir="目录不能为空!" exit function end if for i=0 to ubound(errorchar) if instr(sPath,errorchar(i))>0 then procCheckDir="目录名中含有非法字符" exit function end if next if gFilePath=left(sPath,len(gFilePath)) then procCheckDir="没有权限访问此目录!" exit function end if if mode=0 then exit function if not fo.FolderExists(Server.MapPath(sPath)) then procCheckDir="目录"&sPath&"没有找到!" exit function end if if left(sPath,len(gRootUrl))<>gRootUrl then procCheckDir="没有权限访问此目录!" exit Function end if end function '取文件夹的类型 Function GetFileExt(strFilePath) GetFileExt=Mid(strFilePath,InstrRev(strFilePath,".")) End Function %> <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> ''''''''''''''''''''''''''''''''''''''''''''''''' ' '请保留此信息: 稻香老农制作http://www.5xSoft.com/ ; ' ''''''''''''''''''''''''''''''''''''''''''''''''' 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> 上传表单: <form action="upload.asp" method="post" enctype="multipart/form-data" name="form1"> 上传:<input name="file" type="file" size="30"> <input type="submit"> </form> 文件upload.asp <!--#include FILE="upload_5xsoft.inc"--> <% formPath="c:\upload\" set upload=new upload_5xSoft for each formName in upload.file set file=upload.file(formName) if file.FileSize>0 then response.write "<br>"&file.FilePath&file.FileName&",大小:"&file.FileSize&" => "&formPath&file.FileName file.SaveAs Server.mappath(formPath&file.FileName) end if next %>本文出自 51CTO.COM技术博客 |


rwj716
博客统计信息
热门文章
最新评论
友情链接