Visual_Basic 板


LINE

我要做專題 有一小部分要上傳圖片的 請大家幫忙看一下 程式那裡有問題 可以上傳成功 可是圖片不會出現 還是 如果誰有的 就請寄給我 [email protected] 因為很急 有誰是 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)
1F:推 goooeooo:大家如果要看完這整偏都花多久時間阿 10/23 15:43







like.gif 您可能會有興趣的文章
icon.png[問題/行為] 貓晚上進房間會不會有憋尿問題
icon.pngRe: [閒聊] 選了錯誤的女孩成為魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一張
icon.png[心得] EMS高領長版毛衣.墨小樓MC1002
icon.png[分享] 丹龍隔熱紙GE55+33+22
icon.png[問題] 清洗洗衣機
icon.png[尋物] 窗台下的空間
icon.png[閒聊] 双極の女神1 木魔爵
icon.png[售車] 新竹 1997 march 1297cc 白色 四門
icon.png[討論] 能從照片感受到攝影者心情嗎
icon.png[狂賀] 賀賀賀賀 賀!島村卯月!總選舉NO.1
icon.png[難過] 羨慕白皮膚的女生
icon.png閱讀文章
icon.png[黑特]
icon.png[問題] SBK S1安裝於安全帽位置
icon.png[分享] 舊woo100絕版開箱!!
icon.pngRe: [無言] 關於小包衛生紙
icon.png[開箱] E5-2683V3 RX480Strix 快睿C1 簡單測試
icon.png[心得] 蒼の海賊龍 地獄 執行者16PT
icon.png[售車] 1999年Virage iO 1.8EXi
icon.png[心得] 挑戰33 LV10 獅子座pt solo
icon.png[閒聊] 手把手教你不被桶之新手主購教學
icon.png[分享] Civic Type R 量產版官方照無預警流出
icon.png[售車] Golf 4 2.0 銀色 自排
icon.png[出售] Graco提籃汽座(有底座)2000元誠可議
icon.png[問題] 請問補牙材質掉了還能再補嗎?(台中半年內
icon.png[問題] 44th 單曲 生寫竟然都給重複的啊啊!
icon.png[心得] 華南紅卡/icash 核卡
icon.png[問題] 拔牙矯正這樣正常嗎
icon.png[贈送] 老莫高業 初業 102年版
icon.png[情報] 三大行動支付 本季掀戰火
icon.png[寶寶] 博客來Amos水蠟筆5/1特價五折
icon.pngRe: [心得] 新鮮人一些面試分享
icon.png[心得] 蒼の海賊龍 地獄 麒麟25PT
icon.pngRe: [閒聊] (君の名は。雷慎入) 君名二創漫畫翻譯
icon.pngRe: [閒聊] OGN中場影片:失蹤人口局 (英文字幕)
icon.png[問題] 台灣大哥大4G訊號差
icon.png[出售] [全國]全新千尋侘草LED燈, 水草

請輸入看板名稱,例如:Gossiping站內搜尋

TOP