من با این کد فایل آپلود می کنم :
<%@ Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<!--#include file="ASPired2Upload.asp" -->
<%
dim Upload, strResponse, key_count, fKey
Dim str_dir
str_dir = Server.Mappath("./sabtenam/upload/")
If Request("MODE") = "Upload" Then
set Upload = new c_ASP2Upload
Upload.StartUpload(str_dir)
strResponse = ""
key_count = Upload.UFiles.keys
if (UBound(key_count) <> -1) then
strResponse = "با تشکر از شما، این فایل با موفقیت ارسال شد"
for each fKey in Upload.UFiles.keys
strResponse = Upload.UFiles(fKey).FileName & " (" & Upload.UFiles(fKey).Length & "B) " & strResponse
next
end if
End If
%>
حال در فرم انتخاب فایل نام شیئ انتخاب فایل را filesToUpload انخاب کنید.
به عنوان مثال :
<center><font face="Tahoma" style="font-size: 12pt" color="#000000" ><%=strResponse%></font></center>
<form action="index.asp?MODE=Upload" method="post" enctype="multipart/form-data">
<br><br>
<p align="justify" dir="rtl"><font face="Tahoma" style="font-size: 10pt" color="#000000">ابتدا فایل مورد نظر خود را انتخاب نمایید :</font></p>
<input class="edit_input" type="file" name="filesToUpload" size="30">
<br>
<td><input type="submit" value="ارسال">
</td>
<td><p align="justify" dir="rtl"><font face="Tahoma" style="font-size: 10pt" color="#000000">سپس روی کلید ارسال کلیک کنید.</font></p>
</td>
</form>
در ضمن فایل ASPired2Upload.asp را با محتوای زیر در همان آدرس قرار دهید :
<%
Class c_ASP2Upload
Public UFiles
Public Felem
Private b_arr
Private StreamRequest
Private ASPupload_Done
Private Sub Class_Initialize()
Set UFiles = Server.CreateObject("Scripting.Dictionary")
Set Felem = Server.CreateObject("Scripting.Dictionary")
Set StreamRequest = Server.CreateObject("ADODB.Stream")
StreamRequest.Type = 1
StreamRequest.Open
ASPupload_Done = false
End Sub
Private Sub Class_Terminate()
If IsObject(UFiles) Then
UFiles.RemoveAll()
Set UFiles = Nothing
End If
If IsObject(Felem) Then
Felem.RemoveAll()
Set Felem = Nothing
End If
StreamRequest.Close
Set StreamRequest = Nothing
End Sub
Public Property Get Files()
Files = UFiles.Items
End Property
Public Sub StartUpload(path)
Dim file_stream, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not ASPupload_Done then Upload
For Each fileItem In UFiles.Items
Set file_stream = Server.CreateObject("ADODB.Stream")
file_stream.Type = 1
file_stream.Open
StreamRequest.Position=fileItem.Start
StreamRequest.CopyTo file_stream, fileItem.Length
file_stream.SaveToFile path & fileItem.FileName, 2
file_stream.close
Set file_stream = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub
Private Sub Upload()
Dim Pos_Cur, Pos_DB, Pos_LS, Pos_File, Pos_BND, str_fieldname, osPathSep, str_temp
Dim SEP_DATAX
Dim CONST_newLine, CONST_DBL_QUOTE, CONST_TERMINATOR, CONST_FILENAME, CONST_NAME, CONST_CD, CONST_CT
CONST_newLine = Convert_B2S(Chr(13))
CONST_DBL_QUOTE = Convert_B2S(Chr(34))
CONST_TERMINATOR = Convert_B2S("--")
CONST_FILENAME = Convert_B2S("filename=""")
CONST_NAME = Convert_B2S("name=""")
CONST_CD = Convert_B2S("Content-Disposition")
CONST_CT = Convert_B2S("Content-Type:")
ASPupload_Done = true
on error resume next
b_arr = Request.BinaryRead(Request.TotalBytes)
if Err.Number <> 0 then
response.write "<br><br><B>System Error:</B><p>"
response.write Err.Description & "<p>"
Exit Sub
end if
on error goto 0
Pos_Cur = Token_locate(CONST_newLine,1) 'Note: Pos_Cur is 1-based (and so is InstrB, MidB, etc)
If Pos_Cur <= 1 Then Exit Sub
SEP_DATAX = MidB(b_arr, 1, Pos_Cur-1)
Pos_DB = 1
Pos_LS = Token_locate(SEP_DATAX & CONST_TERMINATOR, 1)
Do Until Pos_DB = Pos_LS
Pos_Cur = Token_bypass(CONST_CD, Pos_DB)
Pos_Cur = Token_bypass(CONST_NAME, Pos_Cur)
str_fieldname = ExtractField(CONST_DBL_QUOTE, Pos_Cur)
Pos_File = Token_locate(CONST_FILENAME, Pos_Cur)
Pos_BND = Token_locate(SEP_DATAX, Pos_Cur)
If Pos_File <> 0 And Pos_File < Pos_BND Then
Dim tmp_upload_file
Set tmp_upload_file = New CompletedFile
Pos_Cur = Token_bypass(CONST_FILENAME, Pos_Cur)
str_temp = ExtractField(CONST_DBL_QUOTE, Pos_Cur)
osPathSep = "\"
if InStr(str_temp, osPathSep) = 0 then osPathSep = "/"
tmp_upload_file.FileName = Right(str_temp, Len(str_temp)-InStrRev(str_temp, osPathSep))
if (Len(tmp_upload_file.FileName) > 0) then 'File field not left empty
Pos_Cur = Token_bypass(CONST_CT, Pos_Cur)
str_temp = ExtractField(CONST_newLine, Pos_Cur)
tmp_upload_file.ContentType = Right(str_temp, Len(str_temp)-InStrRev(str_temp, " "))
Pos_Cur = Token_locate(CONST_newLine, Pos_Cur) + 4 'skip empty line
tmp_upload_file.Start = Pos_Cur-1
tmp_upload_file.Length = Token_locate(SEP_DATAX, Pos_Cur) - 2 - Pos_Cur
If tmp_upload_file.Length > 0 Then UFiles.Add LCase(str_fieldname), tmp_upload_file
End If
Else
Dim vEOD
Pos_Cur = Token_locate(CONST_newLine, Pos_Cur) + 4 'skip empty line
vEOD = Token_locate(SEP_DATAX, Pos_Cur) - 2
If Not Felem.Exists(LCase(str_fieldname)) Then
Felem.Add LCase(str_fieldname), Convert_S2B(MidB(b_arr, Pos_Cur, vEOD-Pos_Cur))
else
Felem.Item(LCase(str_fieldname))= Felem.Item(LCase(str_fieldname)) & ", " & Convert_S2B(MidB(b_arr, Pos_Cur, vEOD-Pos_Cur))
end if
End If
Pos_DB = Token_locate(SEP_DATAX, Pos_Cur)
Loop
StreamRequest.Write(b_arr)
End Sub
Private Function Token_bypass(sToken, nStart)
Token_bypass = InstrB(nStart, b_arr, sToken)
If Token_bypass = 0 then
Response.write "Parsing Error."
Response.End
end if
Token_bypass = Token_bypass + LenB(sToken)
End Function
Private Function Convert_B2S(sString)
Dim i
For i = 1 to Len(sString)
Convert_B2S = Convert_B2S & ChrB(AscB(Mid(sString,i,1)))
Next
End Function
Private Function Convert_S2B(bsString)
Dim i
Convert_S2B =""
For i = 1 to LenB(bsString)
Convert_S2B = Convert_S2B & Chr(AscB(MidB(bsString,i,1)))
Next
End Function
Private Function ExtractField(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, b_arr, sToken)
If nEnd = 0 then
Response.write "Parsing Error."
Response.End
end if
ExtractField = Convert_S2B(MidB(b_arr, nStart, nEnd-nStart))
End Function
Private Function Token_locate(sToken, nStart)
Token_locate = InstrB(nStart, b_arr, sToken)
End Function
End Class
Class CompletedFile
Public ContentType
Public Start
Public Length
Public Path
Private nameOfFile
Public Property Let FileName(fN)
nameOfFile = fN
nameOfFile = Kill_char(nameOfFile, "\", "_")
nameOfFile = Kill_char(nameOfFile, "/", "_")
nameOfFile = Kill_char(nameOfFile, ":", "_")
nameOfFile = Kill_char(nameOfFile, "*", "_")
nameOfFile = Kill_char(nameOfFile, "?", "_")
nameOfFile = Kill_char(nameOfFile, """", "_")
nameOfFile = Kill_char(nameOfFile, "<", "_")
nameOfFile = Kill_char(nameOfFile, ">", "_")
nameOfFile = Kill_char(nameOfFile, "|", "_")
End Property
Public Property Get FileName()
FileName = nameOfFile
End Property
End Class
Function Kill_char(thestring, oldStr, newStr)
Dim POS_CURRENT, POS_OLD, skip
If IsNull(thestring) Or Len(thestring) = 0 Then
Kill_char = ""
ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
Kill_char = thestring
Else
If IsNull(newStr) Then newStr = ""
POS_CURRENT = 1
POS_OLD = 0
Kill_char = ""
skip = Len(oldStr)
Do While POS_CURRENT <= Len(thestring)
POS_OLD = InStr(POS_CURRENT, thestring, oldStr)
If POS_OLD = 0 Then
Kill_char = Kill_char & Mid(thestring, POS_CURRENT, Len(thestring) - POS_CURRENT + 1)
POS_CURRENT = Len(thestring) + 1
Else
Kill_char = Kill_char & Mid(thestring, POS_CURRENT, POS_OLD - POS_CURRENT) & newStr
POS_CURRENT = POS_OLD + skip
End If
Loop
End If
End Function
%>
بنظرم خود متن این فایل به اندازه کافی رسا باشد تا شما تغییراتی را که میل دارید در آن اعمال کنید