求一段ASP图片上传代码。 170
图片上传到指定文件夹（images)。在上传前能将图片重命名。最好能预览的。不能预览也无所谓。...
图片上传到指定文件夹（images)。在上传前能将图片重命名。最好能预览的。不能预览也无所谓。
展开
3个回答
展开全部
Up.asp代码：
<!--#include file="Upload.asp"-->
<%Server.ScriptTimeOut = 9999Dim PicSize, PicTypePicSize = 100 '图片大小，单位KPicType = ".gif|.jpg|.bmp" '图片格式%><HTML><HEAD><TITLE>图片上传</TITLE><META http-equiv="Content-Type" content="text/html; charset=gb2312"></HEAD><BODY><TABLE cellSpacing=0 cellPadding=0 width="100%" align=center border=0 class="tdbg"> <FORM method=post enctype=multipart/form-data action="?action=saveupload" style="margin:0px;"> <TR> <TD height="26"><INPUT type=file name=file size=40> *图片大小不能超过<%=PicSize%>K <INPUT style=FONT-SIZE:9pt type="submit" value=" 上 传 " name=Submit> </TR> </FORM></TABLE><%If Request("Action") = "saveupload" Then Call SaveUploadEnd If%></BODY></HTML><%Sub ShowErr(info) Response.Write "<SCRIPT language=javascript>alert("""&info&""");history.back();</SCRIPT>" Response.EndEnd SubSub SaveUpload() Dim AffixSize, AffixType Dim Affix, i Dim Upload, File, objFso Dim formName, FileName, FileType, FileSize, TotalBytes, ErrorType, FilePath, FullPath Dim Rs, Sql AffixSize = PicSize AffixType = PicType Set Upload = New Upload_Kings For Each formName In Upload.File Set File = Upload.File(formName) FileName = File.FileName FileType = LCase(Mid(FileName, InStrRev(FileName, "."))) FileName = Left(FileName, Len(FileName) - Len(FileType)) '获取文件名（不含后缀），可以在这里定义文件名 FileSize = File.FileSize If InStr("|" & PicType & "|", "|" & FileType & "|") = 0 Then Call ShowErr("文件格式错误！") If FileSize < 1 Then Call ShowErr("请先选择你要上传的文件！") If FileSize>AffixSize*1024 Then Call ShowErr("文件大小不得超过 " & AffixSize & " K\n当前的文件大小为 " & Int(FileSize/1024) & " K") FilePath = "Images" FullPath = Server.Mappath(FilePath) Set objFso = Server.CreateObject("Scripting.FileSystemObject") If Not objFso.FolderExists(FullPath) Then objFso.CreateFolder (FullPath) Set objFso = Nothing File.SaveAs FullPath & "\" & FileName & FileType Set File = Nothing Next Set Upload = Nothing Response.Write "上传成功！"End Sub%>Upload.asp代码：
<%Dim Upfile_Kings_StreamClass Upload_Kings Dim Form, File Private Sub Class_Initialize() Dim iStart, iFileNameStart, iFileNameEnd, iEnd, vbEnter, iFormStart, iFormEnd, theFile Dim strDiv, mFormName, mFormValue, mFileName, mFileSize, mFilePath, iDivLen, mStr Set Form = CreateObject("Scripting.Dictionary") Set File = CreateObject("Scripting.Dictionary") Set Upfile_Kings_Stream = CreateObject("Adodb.Stream") Upfile_Kings_Stream.Mode = 3 Upfile_Kings_Stream.Type = 1 Upfile_Kings_Stream.Open Upfile_Kings_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.FileSize = mFileSize theFile.FileStart = iStart + 4 File.Add mFormName, theFile End If iFormStart = iFormEnd + iDivLen iFormEnd = inString(iFormStart, strDiv) - 1 Wend End Sub
Private Function subString(theStart, theLen) Dim i, c, stemp Upfile_Kings_Stream.Position = theStart - 1 stemp = "" For i = 1 To theLen If Upfile_Kings_Stream.EOS Then Exit For c = AscB(Upfile_Kings_Stream.Read(1)) If c > 127 Then If Upfile_Kings_Stream.EOS Then Exit For stemp=stemp&Chr(AscW(ChrB(AscB(Upfile_Kings_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_Kings_Stream.Size - theLen If i > Upfile_Kings_Stream.Size Then Exit Function Upfile_Kings_Stream.Position = i - 1 If AscB(Upfile_Kings_Stream.Read(1)) = AscB(MidB(Str, 1)) Then inString = i For j = 2 To theLen If Upfile_Kings_Stream.EOS Then inString = 0 Exit For End If If AscB(Upfile_Kings_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 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 FunctionEnd 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_Kings_Stream.Position = FileStart - 1 Upfile_Kings_Stream.Copyto dr, FileSize dr.SaveToFile FullPath, 2 dr.Close Set dr = Nothing SaveAs = 0 End FunctionEnd Class%>
<!--#include file="Upload.asp"-->
<%Server.ScriptTimeOut = 9999Dim PicSize, PicTypePicSize = 100 '图片大小，单位KPicType = ".gif|.jpg|.bmp" '图片格式%><HTML><HEAD><TITLE>图片上传</TITLE><META http-equiv="Content-Type" content="text/html; charset=gb2312"></HEAD><BODY><TABLE cellSpacing=0 cellPadding=0 width="100%" align=center border=0 class="tdbg"> <FORM method=post enctype=multipart/form-data action="?action=saveupload" style="margin:0px;"> <TR> <TD height="26"><INPUT type=file name=file size=40> *图片大小不能超过<%=PicSize%>K <INPUT style=FONT-SIZE:9pt type="submit" value=" 上 传 " name=Submit> </TR> </FORM></TABLE><%If Request("Action") = "saveupload" Then Call SaveUploadEnd If%></BODY></HTML><%Sub ShowErr(info) Response.Write "<SCRIPT language=javascript>alert("""&info&""");history.back();</SCRIPT>" Response.EndEnd SubSub SaveUpload() Dim AffixSize, AffixType Dim Affix, i Dim Upload, File, objFso Dim formName, FileName, FileType, FileSize, TotalBytes, ErrorType, FilePath, FullPath Dim Rs, Sql AffixSize = PicSize AffixType = PicType Set Upload = New Upload_Kings For Each formName In Upload.File Set File = Upload.File(formName) FileName = File.FileName FileType = LCase(Mid(FileName, InStrRev(FileName, "."))) FileName = Left(FileName, Len(FileName) - Len(FileType)) '获取文件名（不含后缀），可以在这里定义文件名 FileSize = File.FileSize If InStr("|" & PicType & "|", "|" & FileType & "|") = 0 Then Call ShowErr("文件格式错误！") If FileSize < 1 Then Call ShowErr("请先选择你要上传的文件！") If FileSize>AffixSize*1024 Then Call ShowErr("文件大小不得超过 " & AffixSize & " K\n当前的文件大小为 " & Int(FileSize/1024) & " K") FilePath = "Images" FullPath = Server.Mappath(FilePath) Set objFso = Server.CreateObject("Scripting.FileSystemObject") If Not objFso.FolderExists(FullPath) Then objFso.CreateFolder (FullPath) Set objFso = Nothing File.SaveAs FullPath & "\" & FileName & FileType Set File = Nothing Next Set Upload = Nothing Response.Write "上传成功！"End Sub%>Upload.asp代码：
<%Dim Upfile_Kings_StreamClass Upload_Kings Dim Form, File Private Sub Class_Initialize() Dim iStart, iFileNameStart, iFileNameEnd, iEnd, vbEnter, iFormStart, iFormEnd, theFile Dim strDiv, mFormName, mFormValue, mFileName, mFileSize, mFilePath, iDivLen, mStr Set Form = CreateObject("Scripting.Dictionary") Set File = CreateObject("Scripting.Dictionary") Set Upfile_Kings_Stream = CreateObject("Adodb.Stream") Upfile_Kings_Stream.Mode = 3 Upfile_Kings_Stream.Type = 1 Upfile_Kings_Stream.Open Upfile_Kings_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.FileSize = mFileSize theFile.FileStart = iStart + 4 File.Add mFormName, theFile End If iFormStart = iFormEnd + iDivLen iFormEnd = inString(iFormStart, strDiv) - 1 Wend End Sub
Private Function subString(theStart, theLen) Dim i, c, stemp Upfile_Kings_Stream.Position = theStart - 1 stemp = "" For i = 1 To theLen If Upfile_Kings_Stream.EOS Then Exit For c = AscB(Upfile_Kings_Stream.Read(1)) If c > 127 Then If Upfile_Kings_Stream.EOS Then Exit For stemp=stemp&Chr(AscW(ChrB(AscB(Upfile_Kings_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_Kings_Stream.Size - theLen If i > Upfile_Kings_Stream.Size Then Exit Function Upfile_Kings_Stream.Position = i - 1 If AscB(Upfile_Kings_Stream.Read(1)) = AscB(MidB(Str, 1)) Then inString = i For j = 2 To theLen If Upfile_Kings_Stream.EOS Then inString = 0 Exit For End If If AscB(Upfile_Kings_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 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 FunctionEnd 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_Kings_Stream.Position = FileStart - 1 Upfile_Kings_Stream.Copyto dr, FileSize dr.SaveToFile FullPath, 2 dr.Close Set dr = Nothing SaveAs = 0 End FunctionEnd Class%>
本回答由网友推荐
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
推荐律师服务：
若未解决您的问题，请您详细描述您的问题，通过百度律临进行免费专业咨询
