ASP高手可以幫我看一下 上傳圖片的程式嗎?
我要做專題 有一小部分要上傳圖片的
請大家幫忙看一下 程式那裡有問題
可以上傳成功 可是圖片不會出現
還是 如果誰有的 就請寄給我 jennystq@yahoo.com.tw
因為很急 有誰是 ASP很強的 可以幫我嗎?
如果覺得這樣子很亂 就留一下信箱
我再把整個程式 寄過去 謝謝拜託了
檔名 upload_5xsoft.asp
程式
<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="WLONG3D專用上傳程序 Version 1.0"
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>
檔名upfile
程式:
<!--#include FILE="upload_5xsoft.inc"-->
<%
UpFilePath = "file/" '設定存放的目錄
if right(UpFilePath,1) <> "/" then UpFilePath = UpFilePath & "/" '在目錄後加(\)
UpFilePath = Server.MapPath(UpFilePath) '抓出完整主機路徑
Set fds = Server.CreateObject("Scripting.FileSystemObject")
'建立引用至FileSystemObject物件的fsObj物件變數
'利用FileSystemObject物件的FileExists方法檢查目錄是否存在(若發生錯誤，表示該主機不開放建立檔案寫入權限)
if Not fds.FolderExists(UpFilePath) then fds.CreateFolder(UpFilePath) '建立目錄指令
set fds = nothing '清除fsObj物件
FileMaxSize = 500000000 '設定檔案允許的大小
Server.ScriptTimeOut = 10000 '設定檔案傳輸時間
FileType = ".jpg.gif.htm" '設定允許的副檔名
set upload = new upload_5xsoft ''建立上傳對象
dim formName,StrFile
for each formName in upload.file ''列出所有上傳的檔案
set file = upload.file(formName) ''生成一個檔案對象
if file.FileSize > 0 then ''如果 FileSize > 0 說明有檔案byte數
if file.FileSize < FileMaxSize then ''如果未超過檔案大小限制
if FileType <> "" then '有限制上傳檔案類型
if Instr(FileType,GetExtendName(file.FileName)) then
TypeFlag = 1 '檔案為允許的類型
else
TypeFlag = 0 '檔案為不允許的類型
'session("txt") = "不支援您所上傳的檔案類型﹕"
'session("file") = session("file") & GetExtendName(file.FileName)
end if
else
TypeFlag = 1 '沒有限制上傳檔案類型
end if
if TypeFlag = 1 then
fname = file.FileName
file.SaveAs UpFilePath & "\" & fname ''儲存檔案
StrFile = StrFile & " " & fname
end if
else
'session("txt") = "檔案大小超出限制，您最多可以上傳 " & FileMaxSize & "byte的檔案"
exit for
end if
end if
set file = nothing
next
set upload = nothing ''刪除此對象
'此函數抓取副檔名
function GetExtendName(FileName)
dim ExtName
ExtName = LCase(FileName)
ExtName = right(ExtName,3)
ExtName = right(ExtName,3-Instr(ExtName,"."))
GetExtendName = ExtName
end function
if fname <> Empty then
%>
<center><%=StrFile%> 上傳完畢</center>
<%
else
%>
<script>alert('上傳圖片失敗，目前只允許使用<%=FileType%>檔案')</script>
<%
end if
%>
<p align="center"><a href="upfile.htm">返回上傳頁</a></p>
檔名:upfile.htm
程式:
<script>
function op()
{
txt1 = document.text1.file1.value
if( txt1 != "")
{
var dd = window.open("","new","width=500,height=500");
dd.document.write("<center>預覽結果<hr color=#00bbff width=80%><img src=\"" + txt1 + "\"></center>");
dd.document.close();
}
}
</script>
<center>
<p> </p>
<form method="post" action="upfile.asp" name="text1" enctype="multipart/form-data" >
<table border="1" bordercolor="#7B68EE" id="AutoNumber1" cellpadding="0" width="506" height="116">
<tr>
<td bordercolor="#FFFFFF" width="498" height="1" colspan="2" style="border: 1pt solid #000000" align="center" bgcolor="#CCCCCC">
<b>簡 易 上 傳 測 試</b></td>
</tr>
<tr>
<td bordercolor="#FFFFFF" width="78" height="32" style="border: 1pt solid #7B68EE">
<p align="center"><span lang="zh-tw"><a href="javascript:op()" style="color: #7B68EE"><font size="2">預覽</font></a></span>
</td>
<td bordercolor="#FFFFFF" width="416" height="32" align="center">
<span lang="zh-tw">
<font size="2" color="#7B68EE">上傳圖片 </font></span><input type="file" name="file1" size="20" style="color: #4B0082; font-size: 10 pt; border: 1px solid #4B0082">
<input type="submit" value="傳送" name="B1" style="font-size: 10 pt; color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8"> <input type="reset" value="重設" name="B2" style="color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8">
</td>
</tr>
<tr>
<td bordercolor="#FFFFFF" width="78" height="32" style="border: 1pt solid #7B68EE">
<p align="center"><span lang="zh-tw"><a href="javascript:op()" style="color: #7B68EE"><font size="2">預覽</font></a></span>
</td>
<td bordercolor="#FFFFFF" width="416" height="32" align="center">
<span lang="zh-tw">
<font size="2" color="#7B68EE">上傳圖片 </font></span><input type="file" name="file2" size="20" style="color: #4B0082; font-size: 10 pt; border: 1px solid #4B0082">
<input type="submit" value="傳送" name="B1" style="font-size: 10 pt; color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8"> <input type="reset" value="重設" name="B2" style="color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8">
</td>
</tr>
<tr>
<td bordercolor="#FFFFFF" width="78" height="32" style="border: 1pt solid #7B68EE">
<p align="center"><span lang="zh-tw"><a href="javascript:op()" style="color: #7B68EE"><font size="2">預覽</font></a></span>
</td>
<td bordercolor="#FFFFFF" width="416" height="32" align="center">
<span lang="zh-tw">
<font size="2" color="#7B68EE">上傳圖片 </font></span><input type="file" name="file3" size="20" style="color: #4B0082; font-size: 10 pt; border: 1px solid #4B0082">
<input type="submit" value="傳送" name="B1" style="font-size: 10 pt; color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8"> <input type="reset" value="重設" name="B2" style="color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8">
</td>
</tr>
<tr>
<td bordercolor="#FFFFFF" width="78" height="32" style="border: 1pt solid #7B68EE">
<p align="center"><span lang="zh-tw"><a href="javascript:op()" style="color: #7B68EE"><font size="2">預覽</font></a></span>
</td>
<td bordercolor="#FFFFFF" width="416" height="32" align="center">
<span lang="zh-tw">
<font size="2" color="#7B68EE">上傳圖片 </font></span><input type="file" name="file4" size="20" style="color: #4B0082; font-size: 10 pt; border: 1px solid #4B0082">
<input type="submit" value="傳送" name="B1" style="font-size: 10 pt; color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8"> <input type="reset" value="重設" name="B2" style="color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8">
</td>
</tr>
<tr>
<td bordercolor="#FFFFFF" width="78" height="32" style="border: 1pt solid #7B68EE">
<p align="center"><span lang="zh-tw"><a href="javascript:op()" style="color: #7B68EE"><font size="2">預覽</font></a></span>
</td>
<td bordercolor="#FFFFFF" width="416" height="32" align="center">
<span lang="zh-tw">
<font size="2" color="#7B68EE">上傳圖片 </font></span><input type="file" name="file5" size="20" style="color: #4B0082; font-size: 10 pt; border: 1px solid #4B0082">
<input type="submit" value="傳送" name="B1" style="font-size: 10 pt; color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8"> <input type="reset" value="重設" name="B2" style="color: #4B0082; border: 1px solid #4B0082; background-color: #D4D0C8">
</td>
</tr>
</table>
</form>
</center>
</body>
</html>
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 61.225.204.22
※ 編輯: jenny7587 來自: 61.225.204.22 (10/21 18:08)
推
10/23 15:43, , 1F
10/23 15:43, 1F
Visual_Basic 近期熱門文章
PTT數位生活區 即時熱門文章
