آموزش asp >> فرستادن فایل یا Upload از صفحه وب
در اینجا به ذکر نمونه ای از یک کد آماده برای بارگزاری فایل از طریق صفحه وب ( Upload ) به یک سرویس دهنده می پردازیم . این کدها از مجموعه موجود در سایت
گرفته شده اند . در ابتدا باید هر دو فایل زیر را بسازید :
upload_page.asp :
"
wrFoot
'--------------------------------------
Sub wrForm
wr "
"
End Sub
Sub wrHead
wr ""
wr "
wr "
wr ""
wr ""
End Sub
Sub wrFoot
wr ""
wr ""
Response.End
End Sub
Sub wr(byval sText)
If sText <> "" Then Response.Write sText & vbNewLine
End Sub
%>
upload_class.asp :
Public Property Get MaxFilesize
MaxFilesize = lngMaxFileSize
End Property
Public Property Let AllowedFiles(byval vData)
If Len(vData) > 0 Then
strAllowedFiles = vData
End If
End Property
Public Property Get AllowedFiles
AllowedFiles = strAllowedFiles
End Property
Public Property Get Error
Error = strError
End Property
Public Property Get ContentType
ContentType = strContentType
End Property
Public Property Let Path(byval vData)
If Len(vData) > 0 Then
strPath = vData
End If
End Property
Public Property Get Path
Path = strPath
End Property
Public Property Let Filename(byval vData)
If Len(vData) > 0 Then
strFilename = vData
End If
End Property
Public Property Get Filename
Filename = strFilename
End Property
Public Function Upload()' as integer
Dim bytAllData
lngTotalbytes = Request.Totalbytes
If lngTotalbytes > 0 Then
If lngMaxFilesize <> ۰ Then
If lngTotalBytes > lngMaxFileSize Then
strError = "The file exceeds the allowed capacity."
Upload = 2
Exit Function
End If
End If
bytAllData = Request.BinaryRead(lngTotalbytes)
strContentType = GetContentType(bytAllData)
strFilename = GetFilename(bytAllData)
If strAllowedFiles <> "" Then
If Not AllowedFile(strFilename) Then
strError = "Filetype is not allowed."
Upload = 3
Exit Function
End If
End If
bytData = GetData(bytAllData)
Upload = 0
Else
Upload = 1
strError = "No data recieved."
End If
End Function
Public Function Save(byval bOverwrite)
If strError <> "" Then
Save = 4
Exit Function
End If
If strPath <> "" Then
If Mid(strPath,Len(strPath)-1,1) <> "\" Then strPath = strPath & "\"
If strFilename <> "" Then
If LenB(bytData) > 1 Then
If SaveBinaryData(bytData,strPath & strFilename,bOverwrite) Then
Save = 0
Else
Save = 1
End If
Else
Save = 2
strError = "No data."
End If
Else
Save = 3
strError = "Not a valid filename specified."
End If
Else
Save = 4
strError = "No path specified."
End If
End Function
Private Function AllowedFile(byval sFilename)'as boolean
Dim arrAllowedFiles, intCount
Dim strExtension
If Len(sFilename) > 0 Then
If inStr(sFilename,".") > 0 Then
strExtension = Mid(sFilename,Len(sFilename) - inStr(strReverse(sFilename),".")+2)
arrAllowedFiles = Split(strAllowedFiles,",")
AllowedFile = False
For intCount = 0 To Ubound(arrAllowedFiles)
If arrAllowedFiles(intCount) <> "" Then
If Lcase(strExtension) = Lcase(Trim(arrAllowedFiles(intCount))) Then
AllowedFile = True
Exit For
End If
End If
Next
Else
AllowedFile = False
End If
Else
AllowedFile = False
End If
End Function
Private Function SaveBinaryData(byval bData, byval sFilename, byval bOverwrite) 'as boolean
Dim objFs, objTextFile
Dim intCount, strFile
If LenB(bData) < 2 Then
strError = "No data."
SaveBinaryData = False
Exit Function
End If
Set objFs = Server.CreateObject("scripting.filesystemobject")
If Not objFs.FolderExists(strPath) Then
strError = "Directory does not exists."
SaveBinaryData = False
Exit Function
End If
If Not bOverwrite And objFs.FileExists(sFilename) Then
strError = "File already exists."
SaveBinaryData = False
Exit Function
End If
Set objTextFile = objFs.CreateTextFile(sFilename,True,False)
For intCount = 1 To LenB(bData)
objTextFile.Write Chr(AscB(MidB(bData,intCount,1)))
Next
objTextFile.Close
Set objTextFile = Nothing
Set objFs = Nothing
Session("file") = Null
SaveBinaryData = True
End Function
Private Function GetData(byval bFile)'as bytearray
Dim intStart, intEnd
If LenB(bFile) < 1 Then
GetData = ChrB(10)
Exit Function
End If
intStart = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)) + 4
intEnd = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(45) & ChrB(45)& ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45))
If intStart > 0 Then
If intStart < intEnd Then
GetData = MidB(bFile, intStart, intEnd - intStart)
Else
GetData = ChrB(10)
End If
Else
GetData = ChrB(10)
End If
End Function
Private Function GetFilename(byval bFile)' as string
Dim bytFilename, bytChar, strFilename
Dim intStart, intCount
If LenB(bFile) < 1 Then
GetFilename = ""
Exit Function
End If
If LenB(bFile) > 0 Then
If inStrB(bFile,ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) Then
intStart = inStrB(bFile, ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) + 10
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(34) Then
Exit For
End If
bytFilename = bytFilename & bytChar
Next
End If
End If
For intCount = 1 To LenB(bytFilename)
strFilename = strFilename & Chr(AscB(MidB(bytFilename,intCount,1)))
Next
strFilename = Mid(strFilename,Len(strFilename) - inStr(strReverse(strFilename),"\")+2)
GetFilename = strFilename
End Function
Private Function GetContentType(byval bFile)
Dim bytContentType, strContentType, bytChar
Dim intStart, intCount
If LenB(bFile) < 1 Then
GetContentType = ""
Exit Function
End If
If inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) > 0 Then
intStart = inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) + 14
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(13) Then
Exit For
End If
bytContentType = bytContentType & bytChar
Next
End If
For intCount = 1 To LenB(bytContentType)
strContentType = strContentType & Chr(AscB(MidB(bytContentType,intCount,1)))
Next
GetContentType = strContentType
End Function
End Class
'-----------------------------------------------------------------------------------
%>
حالا کافیست در فایل اول در خط ۱۵ مسیر را برای ذخیره فایلها روی سرویسدهنده خود مشخص کنید :
.Path = "D:\Inetpub\wwwroot\test
"
;
مسیر تعیین شده باید حتماً موجود باشد
دیدگاهتان را بنویسید