לוגו אתר Fresh          
 
 
  אפשרות תפריט  ראשי     אפשרות תפריט  צ'אט     אפשרות תפריט  מבזקים     אפשרות תפריט  צור קשר     חץ שמאלה ברוכים הבאים לפורום ASP חץ ימינה  

לך אחורה   לובי הפורומים > מחשבים > ASP
שמור לעצמך קישור לדף זה באתרי שמירת קישורים חברתיים
 
כלי אשכול חפש באשכול זה



  #1  
ישן 31-10-2005, 18:08
  a1_shay a1_shay אינו מחובר  
 
חבר מתאריך: 01.05.04
הודעות: 124
בעיה עם מילוי טופס ושליחתו דרך ASP

אני צריך שגולש נכנס לאתר שלי הוא יוכל להעלות קובץ ולשלוח אותו למייל שלי . הורדתי דוגמא איך לעשות את זה .ניסיתי להריץ על IIS ואחרי ה-SEND זה רק נותן לי דוח על הקובץ וזהו .מה עוד צריך לעשות כדי שאני יקבל את הקובץ.??
תודה מראש

דף של ה-HTML

<HTML>
<HEAD>
<TITLE>העלאת קבצים ללא קומפוננטה ושדות טקסט</TITLE>
</HEAD>
<BODY dir=rtl>
<p>
זהו טופס דוגמא, המאפשר העלאת 2 קבצים, 2 שדות טקסט, 2 כפתורי סימון ואזור טקסט.<BR>
לשתי תיבות הסימון יש אותו שם
<FORM ACTION="UploadReceive.asp" METHOD="POST" ENCTYPE="multipart/form-data">
שדה טקסט: <input type=text name=txtData1><br>
תמונה: <INPUT TYPE=FILE NAME="UploadFormName1"><br>
שדה טקסט: <input type=text name=txtData2><br>
תמונה: <INPUT TYPE=FILE NAME="UploadFormName2"><br>
אזור טקסט: <textarea name=txtTextArea rows="5" cols="70"></textarea>
<br>
תיבת סימון: <input type=checkbox name=chkTest value="Yes"><br>
תיבת סימון: <input type=checkbox name=chkTest value="No"><br>
<INPUT TYPE="SUBMIT">

</FORM>

</BODY>
</HTML>

דף של ה-ASP :

<%@ Language=VBScript %>
<%option explicit%>
<%server.ScriptTimeout = 60000%>
<html>
<head>
<title>Pure ASP upload</title>
</head>

<body dir=rtl>
<basefont face=arial>
<%
' ------------------------------------------------
' Author: Adrian Forbes
' ------------------------------------------------

Dim objDict
Dim aData, sData, lDataLen
Dim sFormData
Dim lFormDataStart
Dim lFormDataEnd
Dim sHeader
Dim sPath
Dim sFilename
Dim iFilenameStart
Dim sDelimeter
Dim lCount
Dim iHeadPos
Dim iPos
Dim iDelimLen
Dim lMax
Dim adVarChar, adBoolean, adInteger, adLongVarChar, adDouble
Dim objRS
Dim objFSO
Dim objFile
Dim iHeadEnd
Dim sFieldname
Dim bFile
Dim bSave
Dim sSaveAs
Dim objDOM, objElement, objNode, tmpNode, tmpFieldNode
Dim tmpSize, tmpData
Dim lSize
Dim lMIMEStart, lMIMEEnd, sMIME
Dim sExtensions
Dim iMode
Dim owNoOverwrite, owOverwrite, owUnique

' If we want to limit the size of uploads set the lMax value to the
' max amount of kb we want to load. 2048 is 2mb. For no limit set
' this to 0

lMax = 2048

' If we want to limit the type of files to upload add the extensions of valid
' files to sExtensions as a comma separated list. If you don't want to
' limit the extensions simply make the variable blank ("")

sExtensions = "zip,txt,jpg,gif"

' Define the overwrite constants

owNoOverwrite = 0 ' the upload will not overwrite an existing file of the same name
owOverwrite = 1 ' the upload will overwrite an existing file of the same name
owUnique = 2 ' if a file exists with the same name the uploaded file will be given a new, unique name

' Set the overwrite mode

iMode = owOverwrite

' Define the ADO constants, you can INCLUDE adoinc.vbs or reference
' the type library instead if you want

adVarChar = 200
adBoolean = 11
adInteger = 3
adLongVarChar = 201
adDouble = 5

' We're going to store our FORM data as XML the coding
' you can implement a storage method of your own if you want.
' objDOM is the XML DOM that our data will be stored in. The
' downside of XML is that we have to code up some quite
' basic manipulation functions.

set objDOM = CreateObject("MSXML.DOMDocument")

' Our XML structure has a parent node that we will call FormData.

Set objElement = objDOM.createNode("element", "FormData", "")
objDOM.appendChild objElement

' Find out how much data is in the request
lDataLen = Request.TotalBytes

' Load the data into aData which will be a safe array
aData = Request.BinaryRead(lDataLen)

' The problem with this data is that VBScript can't manipulate the binary
' data so we need to convert it into text. There are routines to do this,
' but we're going to get the Recordset object to do it for us

if lenb(aData) > 0 then
Set objRS = CreateObject("ADODB.Recordset")

' Append a field of type LongVarChar that is the length of our data
objRS.Fields.Append "Data", adLongVarChar, lenb(aData)
objRS.Open

' Add a new record
objRS.AddNew

' Insert the data into the field
objRS("Data").AppendChunk aData
objRS.Update

' And then get it out as ASCII text!
sData = objRS("Data")
set objRS = nothing
else
sData = ""
end if

' Clean up the array
aData = ""

' As well as storing FORM data in an XML tree, we are also going to hold it rather simply
' in a dictionary object
set objDict = CreateObject("Scripting.Dictionary")

' To see the request on the page uncomment the following 2 lines. This is useful in understanding how
' the raw data looks and what the code is doing.
'Response.Write "<p>Data (" & len(sData) & " bytes): <pre>" & sData
'Response.Write vbCRLF & "</pre><br><hr>"

' We want to find out the delimeter that seperates each FORM item
' The delimeter will be the first line so look for the first CRLF
' and the delimeter is evertthing before that CRLF
iPos = Instr(sData, vbCRLF)
if iPos > 0 then
sDelimeter = left(sData, iPos - 1)
end if

' If the FORM is empty then there will have been no CRLF so sDelimeter will
' be empty. Do a check just to make sure some data has been posted
if len(sDelimeter) > 0 then
' We're going to keep track of our position through the data, starting at the start!
iPos = 1
do
' Find the start of the delimeter
iPos = Instr(iPos, sData, sDelimeter, 1)

' Move past the delimeter and the CRLF to come to the header
iPos = iPos + len(sDelimeter & vbCRLF)

' The header data ends with CRLFCRLF so find the position of the
' next CRLFCRLF. Adding 3 to this value means we get the
' header and the trailing CRLFCRLF
iHeadEnd = Instr(iPos, sData, vbCrLf & vbCrLf, 1) + 3

' We know that iPos is the start of the header and iHeadEnd is the end
' so get the text inbetween
sHeader = Mid(sData, iPos, iHeadEnd - iPos + 1)

' The data starts the position 1 after the header
lFormDataStart = iHeadEnd + 1

' The data ends with a CRLF and then the next delimeter so find out where
' the delimeter is and subtract 3 which takes us before the CRLF and
' to the end of the data
lFormDataEnd = Instr(lFormDataStart, sData, sDelimeter, 1) - 3

' Calculate the size of the data
lSize = lFormDataEnd - lFormDataStart + 1

' The name of the field is in the header's "name" field. We have written
' a small function called GetFieldData that reads the values of fields in
' the header
sFieldname = GetFieldData(sHeader, "name")

' To find out if this FORM data is an uploaded file we want to search
' the header for the presence of a filename header.
sPath = GetFieldData(sHeader, "filename")

' If a filename has been found then we know it's a file
if len(sPath) > 0 then
bFile = true

' Step backwards through the path to get the filename from the end
For lCount = len(sPath) To 1 Step -1
If Strcomp(Mid(sPath, lCount, 1), "\") = 0 Then
iFilenameStart = lCount + 1
Exit For
End If
Next
sFilename = Mid(sPath, iFilenameStart)

' If it's a file we want to find the MIME type. This is held in the Content-Type field
' Find the start of the Content-Type field
lMIMEStart = Instr(1, sHeader, "Content-Type:", 1)
if lMIMEStart > 0 then
' Add 13 to this to get past Content-Type: and to the start of the data
lMIMEStart = lMIMEStart + 13
' Find the trailing vbCRLF
lMIMEEnd = Instr(lMIMEStart, sHeader, vbCRLF, 0)
if lMIMEEnd > 0 then
' Get the text in the middle
sMIME = trim(mid(sHeader, lMIMEStart, lMIMEEnd - lMIMEStart))
end if
end if

else
' If the filename path returned blank then it is not a file
' Now we know where the data starts and ends so let's get it. We only do
' this if it isn't a file to aid performance as we will return to
' save the files later on
sFormData = mid(sData, lFormDataStart, lFormDataEnd - lFormDataStart + 1)
bFile = false
end if

' Ok, here is an HTTP "gotcha". There is nothing to stop you having
' multiple items called the same thing. We want to search the already
' saved FORM items to see if this is a duplicate name. We've written
' a function called FindDuplicateField to do this for us
if FindDuplicateField(objNode, sFieldname) then
' FindDuplicateField leaves objNode pointing at the duplicate
' node. We want to get the size value of the existing node
tmpSize = CDbl(GetChildValue(objNode, "Size", 0))
' And get the data as well
tmpData = GetChildValue(objNode, "Value", "")

' We now add the new field to the end of the existing one and
' separate the two with a comma. We want to update the node to reflect
' the new size and new data. We add 1 to the combined length to cater
' for the comma that seperates the existing values from the new one.
' So "ExistingData" will become "ExistingData,NewData". We have written
' a function called SetValue that updates the node value for us. We
' are storing the size in kilobytes instead of bytes so we need to
' divide by 1000 when storing, and then multiply by 1000 to get the actual
' size in bytes if we need it.
SetValue objNode, "Size", (tmpSize + ((len(sFormData) + 1) / 1000))
SetValue objNode, "Value", tmpData & "," & sFormData

objDict(objNode.nodeName) = tmpData & "," & sFormData
else
' This is a new FORM element so create a new node
Set objNode = objDOM.createNode("element", sFieldName, "")
' Add it to the tree
objElement.appendChild objNode

' Now we want to add data to that node. We have written a function
' called AddNode to do this for us
AddNode objNode, "Size", cstr(lSize / 1000)
if bFile then
' If it's a file we want to store this data as well
AddNode objNode, "File", "Yes"
AddNode objNode, "OriginalPath", sPath
AddNode objNode, "Filename", sFilename
AddNode objNode, "DataStart", lFormDataStart
AddNode objNode, "MIME", sMIME

' If it is a file we add the field name to the dictionary. Later on
' we'll update this to hold the location of the file
objDict.Add sFieldName, ""
else
AddNode objNode, "File", "No"
' We only want to store the data in the XML tree for non-files
' as the file data will be saved to disk instead
AddNode objNode, "Value", sFormData

' If it is not a file we add the item to the dictionary
objDict.Add sFieldName, sFormData
end if
end if
' Now that FORM element has been processed let's move on to the next
' one. The next section is the end of the data for this one + 3. The
' extra 3 is to take us past the CRLF that trails the data
iPos = lFormDataEnd + 3

' Now we want to know if there is another FORM element after this one. The
' final element is followed by the delimeter and then "--". At this
' point iPos is pointing at the next delimeter, if that delimeter is
' followed directly by "--" then we don't want to continue processing
loop until (iPos = instr(iPos, sData, sDelimeter & "--", 1))

' OK, all the FORM elements are now in the tree. We want to revisit all of the
' file elements and save their data to disk. The reason we do it in this two-phase
' manner is so that we can contol the file saving process by elements in the FORM
' data. I also feel it just makes for a neater and more flexible solution.
Set objFSO = CreateObject("Scripting.FileSystemObject")
for each tmpNode in objDOM.firstChild.childNodes
' Check the "File" property of the element to see if it's a file
if strcomp (GetChildValue(tmpNode, "File", "no"), "yes", 1) = 0 then
' If it is we want to save it to disk
bSave = true

' Check the size of the file to ensure it is below any limit
' we have set
if lMax > 0 then
if cdbl(GetChildValue(tmpNode, "Size", "0")) > lMax then
bSave = false
' The file was bigger than the set limit so lets make that clear by
' saying so in the SavedAs field. I just think it's a nice touch.
SetValue tmpNode, "SavedAs", "File exceeded size limit of " & lMax
end if
end if

sPath = Server.MapPath(".")

if strcomp(right(sPath,1), "\") <> 0 then
sPath = sPath & "\"
end if

' Get the original filename
sFilename = GetChildValue(tmpNode, "Filename", "")

' GetFilename will return the name we have to save the file to. If it returns emoty
' the file cannot be saved. This will only happen if the file already exists and iMode
' is owNoOverwrite
sFilename = GetFilename(sPath, sFilename, iMode)
if len(sFilename) = 0 then
bSave = false
SetValue tmpNode, "SavedAs", "A file of this name already exists and cannot be overwritten"
end if

if bSave then
' We only want to save if the file's extension is in the list of valid extensions
if not IsValidExtension (sFilename, sExtensions) then
bSave = false
SetValue tmpNode, "SavedAs", "The file's extension is invalid. Only these files can be uploaded: " & sExtensions
end if
end if

if bSave then

' Find out the path to save the file to. We're just putting it in the
' root of the web but you can put it anywhere
sSaveAs = sPath & sFilename

' The file size is OK so we're fine to save.
' We saved the start position and length of the file data so let's use
' that to get the file. Remember that the size was previously
' divided by 1000 to show the size in kbs so we have to multiply it
' by 1000 to get the real size again
sFormData = mid(sData, Cdbl(GetChildValue(tmpNode,"DataStart", "0")), (Cdbl(GetChildValue(tmpNode, "Size", "0")) * 1000))

' Create the file and save the data to it
set objFile = objFSO.CreateTextFile (sSaveAs, true)
objFile.write sFormData
objFile.close
set objFile = nothing

' Now lets update the XML tree to show where the file was saved to
SetValue tmpNode, "SavedAs", sSaveAs

' Also lets update the dictionary object
objDict(tmpNode.nodeName) = sSaveAs
end if
end if
next
set objFSO = nothing
end if

' ----------------
' Here are the small functions we wrote to aid us in dealing with the XML data
' ----------------
function GetFieldData(sText, sTarget)
' Extract the value from a named field in the header. The format is
' fieldname="fielddata"
' sText is the header, sTarget is the fieldname and the function returns fielddata
dim iPosS, iPosE

iPosS = instr(1, sText, sTarget & "=""")
if iPosS < 1 then
GetFieldData = ""
exit function
end if

iPosS = iPosS + len(sTarget & "=""")
iPosE = Instr(iPosS, sText, """")

if iPosE <= iPosS then
GetFieldData = ""
exit function
end if

GetFieldData = mid(sText, iPosS, iPosE - iPosS)

end function

function FindDuplicateField (byref pObjNode, byval sField)
' This searches the XML tree to find a FORM element named in sField
' If one is found it returns True and leave pObjNode pointing to
' the node

For Each pObjNode In objDOM.firstChild.childNodes
If StrComp(pObjNode.nodeName, sField, 1) = 0 Then
FindDuplicateField = true
exit function
end if
next

FindDuplicateField = false

end function

Function AddNode(ByRef ParentNode, ByVal NodeName, ByVal NodeText)
' This adds a child node to the parent node.
Dim tmpNode
Dim tmpAtt

Set tmpNode = objDOM.createNode("element", NodeName, "")
tmpNode.Text = NodeText

ParentNode.appendChild tmpNode

Set AddNode = tmpNode
End Function

function GetChildValue(ByVal pObjNode, ByVal sName, ByVal sDefault)
' Given a node that represents a FORM element it returns the value
' of the property held in sName. If that property does noe exist
' it returns sDefault
dim tmpNode

For Each tmpNode In pObjNode.childNodes
If StrComp(tmpNode.nodeName, sName, 1) = 0 Then
GetChildValue = tmpNode.Text
exit function
end if
next

GetChildValue = sDefault

end function

function SetValue(ByVal pObjNode, ByVal sName, ByVal sValue)
' Given a node that represents a FORM element this updates an existing
' property to that held in sValue. If the property does not exist it
' is added
dim tmpNode

For Each tmpNode In pObjNode.childNodes
If StrComp(tmpNode.nodeName, sName, 1) = 0 Then
tmpNode.text = sValue
SetValue = true
exit function
end if
next

AddNode pObjNode, sName, sValue

SetValue = false

end function

function IsValidExtension(byval sFilename, byval sValidExtensions)
' Given a filename and comma separated list of valid extensions this
' function checks that the filename has an extension that appears
' in the valid list
dim iPos, sExt, aExt, iIndex

if len(trim(sValidExtensions)) = 0 then
IsValidExtension = true
exit function
end if

sFilename = Trim(sFilename)
for iPos = len(sFilename) to 1 step -1
If Strcomp(Mid(sFilename, iPos, 1), ".") = 0 Then
sExt = mid(sFilename, iPos+1)
aExt = split(sValidExtensions, ",")
for iIndex = lbound(aExt) to ubound(aExt)
if strcomp(trim(aExt(iIndex)), sExt, 1) = 0 then
IsValidExtension = true
exit function
end if
next
end if
next

IsValidExtension = false

end function

function GetFilename(ByVal sPath, ByVal sFilename, ByVal iMode)
' This function will return the name of the file to be created
' If the file cannot be created then it returns an empty string
dim objFSO, lIndex, bFound, sTempFilename, sFile, iPos, sExt

select case iMode
case owOverwrite
' We are using overwrite mode so it doesn't matter if the file
' already exists
GetFilename = sFilename
case owNoOverwrite
' We are not in overwritw mode so check to see if the
' file exists
set objFSO = CreateObject("Scripting.FileSystemObject")
if objFSO.FileExists (sPath & sFilename) then
' It does so return an empty string
GetFilename = ""
else
' It doesn't so return the filename as it's OK to save.
GetFilename = sFilename
end if
set objFSO = nothing
case owUnique
' Unique mode means that the file will be saved but amended
' if neccessary so that it doesn't overwrite existing files
set objFSO = CreateObject("Scripting.FileSystemObject")

' First check to see if the file exists, if it doesn't things
' are nice and simple
if objFSO.FileExists (sPath & sFilename) then
' The file already exists so we need to find a new name for it
' First of all split it up into its name and extension
sFile = sFilename
sExt = ""
for iPos = len(sFilename) to 1 step -1
If Strcomp(Mid(sFilename, iPos, 1), ".") = 0 Then
sFile = left(sFilename, iPos - 1)
sExt = mid(sFilename, iPos+1)
exit for
end if
next

' We will get a unique name by adding a number in parenthesis until
' we get a unique name. So for file.txt we will try file(2).txt
' then file(3).txt and so on
bFound = false
lIndex = 2
while not bFound
sFilename = sFile & "(" & lIndex & ")." & sExt
if objFSO.FileExists(sPath & sFilename) then
lIndex = lIndex + 1
else
bFound = true
end if
wend
set objFSO = nothing
' Return the new, unique filename
GetFilename = sFilename
else
' The file doesn't exists so it can keep its name
GetFilename = sFilename
end if
set objFSO = nothing
end select
end function
%>

<h2>XML Form results</h2>

<table border="1" cellpadding=5>
<tr><td>Name</td><td>Value</td><td>Size (kb)</td><td>File?</td><td>Filename</td><td>MIME Type</td><td>Original Path</td><td>Saved As</td></tr>
<%
' OK, at this stage we have an XML tree that represents our FORM data. To save it
' to disk to view at your leasure uncomment the following lione
'objDOM.save "c:\formdata.xml"

' Loop through each node, each node represents a FORM element
for each tmpFieldNode in objDOM.firstChild.childNodes
' Use GetChildValue to retrieve the properties of the FORM element
Response.Write "<tr><td>" & tmpFieldNode.nodeName & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "Value", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "Size", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "File", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "Filename", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "MIME", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "OriginalPath", " ") & "</td>" & vbCRLF
Response.Write "<td>" & GetChildValue(tmpFieldNode, "SavedAs", " ") & "</td>" & vbCRLF
Response.Write "</tr>" & vbCRLF
next
%>
</table>

<h2>Dictionary Form results</h2>

<p align=right>
תוכן הטופס נמצא באובייקט מסוג Dictionaty וניתן לגשת בצורה הבאה אל תוכן השדות:<br>
<span dir=ltr>Response.Write objDict("txtData1")</span><BR><BR>

צורת קריאה זו, תחזיר לנו במקרה זה: <B><%=objDict("txtData1")%></B>
</p>

<p>
ניתן גם לגשת אל מיקום קובץ שנשמר בצורה הבאה:<BR>
<span dir=ltr>Response.Write objDict("UploadFormName1")</span><BR><BR>
צורת קריאה זו, תחזיר לנו במקרה זה: <B><%=objDict("UploadFormName1")%></B>
<%
objDict.RemoveAll
set objDict = nothing
%>
</body>
</html>
חזרה לפורום

כלי אשכול חפש באשכול זה
חפש באשכול זה:

חיפוש מתקדם
מצבי תצוגה דרג אשכול זה
דרג אשכול זה:

מזער את תיבת המידע אפשרויות משלוח הודעות
אתה לא יכול לפתוח אשכולות חדשים
אתה לא יכול להגיב לאשכולות
אתה לא יכול לצרף קבצים
אתה לא יכול לערוך את ההודעות שלך

קוד vB פעיל
קוד [IMG] פעיל
קוד HTML כבוי
מעבר לפורום



כל הזמנים המוצגים בדף זה הם לפי איזור זמן GMT +2. השעה כעת היא 00:09

הדף נוצר ב 0.05 שניות עם 10 שאילתות

הפורום מבוסס על vBulletin, גירסא 3.0.6
כל הזכויות לתוכנת הפורומים שמורות © 2024 - 2000 לחברת Jelsoft Enterprises.
כל הזכויות שמורות ל Fresh.co.il ©

צור קשר | תקנון האתר