文件写入问题(在线等待)
各位:
为什么我在本地测试通过,放到internet服务器上就提示文件写入错误呢
代码如下
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'''''用这个程序上传文件时,表单的submit按钮必须有命名,任何名称均可
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>