 |
|
|
 |
 |
|
มีอยู่ใน กระทู้นี้แหละคับ สามารถอัพได้หมดเกือบทุกไฟล์ PDF ยังได้เลยลองๆหาดูก่อนนะคับ
|
 |
 |
 |
 |
| Date :
13 พ.ค. 2549 23:50:19 |
By :
ยากูซ่า |
|
 |
 |
 |
 |
|
|
 |
 |
|
 |
 |
| |
|
|
|
| |
|
โอ้ว แม่จ้าวเอาตามนี้เลยค่ะ
ก่อนอื่นต้องมีตามนี้
เป็นตัวอย่างเอาไปปรับใช้นะคะ
จะสามารถกำหนดขนาดไฟล์ได้ รวมถึงสกุลที่อนุญาติได้
(อันนี้ก๊อปเค้ามานะคะแต่จำไม่ได้แล้วว่าที่ไหน อย่าลบเครดิต เป็นมารยาทที่ดีค่ะ)
ไฟล์ที่ต้องการ
inc_upload.asp
form.asp
addform.asp
โฟลเดอร์สำหรับเก็บไฟล์ที่upload ขึ้นไป
upload (อย่าลืมcmd 777 นะคะ)
สำหรับไฟล์ form.asp จะไม่เขียนรายละเอียดนะคะ คิดว่าน่าจะมีพื้นฐานแล้ว
ต่อไปนี้คือโค้ดของ
inc_upload.asp
-------------------------------------------------------------------------------------------------------------
<%
'-----------------------------------------------------------------------------
'Muli File's upload Created by Bhushan Paranjpe
'-----------------------------------------------------------------------------
Sub BuildUploadRequest(RequestBin)
'Get the boundary
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
if PosEnd = 0 then
Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br>"
Response.Write "Please correct the form attributes and try again."
Response.End
end if
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
'Get all data inside the boundaries
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl
Set UploadControl = CreateObject("Scripting.Dictionary")
'Get an object name
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
'Test if object is of file type
If PosFile<>0 AND (PosFile<PosBound) Then
'Get Filename, content-type and content of file
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
FileName = Mid(FileName,InStrRev(FileName,"\")+1)
'Add filename to dictionary object
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
'Add content-type to dictionary object
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
'Get content of object
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = FileName
ValueBeg = PosBeg-1
ValueLen = PosEnd-Posbeg
Else
'Get content of object
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
ValueBeg = 0
ValueEnd = 0
End If
'Add content to dictionary object
UploadControl.Add "Value" , Value
UploadControl.Add "ValueBeg" , ValueBeg
UploadControl.Add "ValueLen" , ValueLen
'Add dictionary object to main dictionary
UploadRequest.Add name, UploadControl
'Loop to next object
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub
'String to byte string conversion
Function getByteString(StringStr)
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function
'Byte string to string conversion
Function getString(StringBin)
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
Function UploadFormRequest(name)
on error resume next
if UploadRequest.Item(name) then
UploadFormRequest = UploadRequest.Item(name).Item("Value")
end if
End Function
%>
----------------------------------------------------------------------------------------------------------
ต่อไปนี้คือโค้ดของไฟล์
addform.asp
---------------------------------------------------------------------------------------------------------
<%@LANGUAGE="VBSCRIPT" CODEPAGE="874"%>
<title>ส่งใบสมัครแก๊งหางฟู</title>
<meta http-equiv="Content-Type" content="text/html; charset=windows-874">
<!-- #include file="inc_upload.asp" -->
<%
RequestBin = Request.BinaryRead(Request.TotalBytes)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
'------
'Validate required form input
'Dim strErr
strErr = ""
'if UploadFormRequest("message") = "" then strErr = strErr & "กรุณาป้อนข้อความของท่าน" & "<p>" & "กดปุ่ม Back เพื่อป้อนใหม่อีกครั้ง"
'if strErr <> "" then
'Response.Write strErr
'Response.End
'end if
'------
AF_keys = UploadRequest.Keys
'Declare array variable to store file names and check allowed file extensions
Dim imgFileName(), imgMaxFileSize
Redim imgFileName(UploadRequest.Count)
'Max 30 Kb Image File Size
imgMaxFileSize = 40 * 1024
for AF_i = 0 to UploadRequest.Count - 1
AF_curKey = AF_keys(AF_i)
if UploadRequest.Item(AF_curKey).Item("FileName") <> "" then
AF_valueLen = UploadRequest.Item(AF_curKey).Item("ValueLen")
select case Right(UploadRequest.Item(AF_curKey).Item("FileName"), 3)
'Allow these file extensions to be uploaded
case "gif", "jpg", "png", "GIF", "JPG", "PNG"
'Warning if file size is 0 byte
if AF_valueLen = 0 then
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "<br>"
Response.Write "File does not exists or is empty.<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
Response.End
end if
'Warning if file size is more than max one
if AF_valueLen > imgMaxFileSize then
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "<br>"
Response.Write "File size (" & FormatNumber(AF_valueLen,0) & " Bytes) is more than max file size (" & FormatNumber(imgMaxFileSize,0) & " Bytes).<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
Response.End
end if
case else
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "<br>"
Response.Write "File extensions should only be ""gif, jpg, png"".<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
Response.End
end select
' else
'Warning if file is blank
' Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
' Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "<br>"
' Response.Write "File does not exists or is empty.<br>"
' Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
' Response.End
end if
next
'------
Dim numFileName
'Assign initial file number
numFileName = 1
for AF_i = 0 to UploadRequest.Count - 1
AF_curKey = AF_keys(AF_i)
'Save all uploaded files
if UploadRequest.Item(AF_curKey).Item("FileName") <> "" then
AF_value = UploadRequest.Item(AF_curKey).Item("Value")
AF_valueBeg = UploadRequest.Item(AF_curKey).Item("ValueBeg")
AF_valueLen = UploadRequest.Item(AF_curKey).Item("ValueLen")
'Create a Stream instance
Dim AF_strm1, AF_strm2
Set AF_strm1 = Server.CreateObject("ADODB.Stream")
Set AF_strm2 = Server.CreateObject("ADODB.Stream")
'Open the stream
AF_strm1.Open
AF_strm1.Type = 1 'Binary
AF_strm2.Open
AF_strm2.Type = 1 'Binary
AF_strm1.Write RequestBin
AF_strm1.Position = AF_ValueBeg
AF_strm1.CopyTo AF_strm2,AF_ValueLen
'Create and Write to a File
AF_curPath = Request.ServerVariables("PATH_INFO")
AF_curPath = Trim(Mid(AF_curPath,1,InStrRev(AF_curPath,"/")) & "")
if Mid(AF_curPath,Len(AF_curPath),1) <> "/" then
AF_curPath = AF_curPath & "/"
end if
on error resume next
'------
'Declare variable to store folder name and save to file and store file names To array variables
Dim imgFolderName, numFile
imgFolderName = "\upload\"
'Assign file name number as yyyymdhms + running number
numFile = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & numFileName & Right(LCase(UploadRequest.Item(AF_curKey).Item("FileName")),4)
AF_strm2.SaveToFile Trim(Server.mappath(AF_curPath)) & imgFolderName & numFile,2
imgFileName(AF_i) = numFile
numFileName = numFileName + 1
' AF_strm2.SaveToFile Trim(Server.mappath(AF_curPath)) & imgFolderName & LCase(UploadRequest.Item(AF_curKey).Item("FileName")),2
' imgFileName(AF_i) = LCase(UploadRequest.Item(AF_curKey).Item("FileName"))
'------
if err then
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "<br>"
Response.Write "Maybe the destination directory does not exist, or you don't have write permission.<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
err.clear
Response.End
end if
end if
next
'------
'Display file names to browser or Save to file names to your database
Dim sFileName(1), i
for AF_i = 0 to UploadRequest.Count - 1
If imgFileName(AF_i) <> "" Then
'Assign file name to array variables, 1 is Max number of file upload that you can change
for i = 0 to 1
If sFileName(i) = "" Then
sFileName(i) = imgFileName(AF_i)
exit for
End If
next
End If
next
'------
'การเรียกข้อมูลที่ต้องการเช่นเนื้อหาของกระทู้ที่จะตั้ง
message=Trim(UploadFormRequest("message"))
set conn = Server.CreateObject("ADODB.Connection")
conn.Open "Driver={Microsoft Access Driver (*.mdb)}; dbq="&server.mappath("ชื่อดาต้าเบส.mdb")
Sql="Select * from ชื่อตาราง "
Set RS =Server.CreateObject("ADODB.Recordset")
RS.open Sql,Conn,1,3
RS.AddNew
.......................................
RS.Update
rs.Close
%></div>
<link href="../style2.css" rel="stylesheet" type="text/css">
<font size="2">ได้บันทึกขอมูลแล้ว กรุณารอสักครู่</font>
-----------------------------------------------------------------------------------------------------------
ลองดูนะคะ โชคดีค่ะ
|
| |
|
|
| |
| Date :
17 พ.ค. 2549 15:55:18 |
By :
fray |
|
|
| |
|
|
|
|
|
| |
|
|
|
|
