Click to See Complete Forum and Search --> : FTP Upload using ASP ?


beginner
05-02-2003, 12:43 AM
Can we upload file (FTP) using ASP ?

cmelnick
05-02-2003, 10:20 AM
This one works great.

upload_form.asp is the page where you select the file, and upload.asp contains the necessary procedures...


<!-- upload_form.asp -->
<!-- #include file="upload.asp" -->

<%

Dim mesg, Uploader, File
Set Uploader = New FileUploader

Uploader.Upload()

If Uploader.Form("submit") <> "" then
If Uploader.Files.Count = 0 Then
mesg = "File Not Uploaded"
Else
For Each File In Uploader.Files.Items
File.SaveToDisk "E:\Webs\10899\sw-tcg\"
Next
mesg = "File uploaded successfully"
End If
End If
%>
<html>
<head>
<title>Upload a file</title>
</head>
<body>
<span class="color: red; font-weight: 600;">
<%=mesg%>
</span><br>
<form action="upload_form.asp" method=post
enctype="multipart/form-data">
<input type=file name="file" size=40><br>
<input type=submit id="submit" name="submit"
value="Upload File">
</form>
</body>
</html>
<%
end if
%>

<!-- end upload_form.asp -->


<!-- upload.asp -->
<%
'***************************************
' File: Upload.asp
' Author: Jacob "Beezle" Gilley
' Email: avis7@airmail.net
' Date: 12/07/2000
' Comments: The code for the Upload, CByteString,
' CWideString subroutines was originally
' written by Philippe Collignon...or so
' he claims. Also, I am not responsible
' for any ill effects this script may
' cause and provide this script "AS IS".
' Enjoy!
'****************************************

Class FileUploader
Public Files
Private mcolFormElem

Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub

Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
'Response.Write "Request was: " & LCase(sIndex) & "<BR>"
'If mcolFormElem.Exists(LCase(sIndex)) Then
' Form = mcolFormElem.Item
'End If
End Property

Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound

biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

If (nPosEnd-nPosBegin) <= 0 Then Exit Sub

vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)

Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))

nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile

nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)

If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then
mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If

nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub

'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function

'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class

Class UploadedFile
Public ContentType
Public FileName
Public FileData

Public Property Get FileSize()
FileSize = LenB(FileData)
End Property

Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex

If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"

Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub

Set oFile = oFS.CreateTextFile(sPath & FileName, True)

For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next

oFile.Close
End Sub

Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub

If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub

End Class
%>

%>

<!-- end upload.asp -->

khaki
05-02-2003, 12:17 PM
hmmm....
tried it...
got this when trying to access upload_form.asp


Microsoft VBScript compilation error '800a040e'

'loop' without 'do'

/upload.asp, line 98

Loop
^
:confused:


;) k

Bullschmidt
05-05-2003, 12:19 AM
For pure ASP (i.e. non component) solutions (and I believe this would be true for component solutions too) can increase the timeout for the page:
' Script timeout in seconds for this page.
' (60 x 60 = 1 hour.)
Server.ScriptTimeout = 60 * 60

ASP File Upload using VBScript by John R. Lewis - 7/10/2000
http://aspzone.com/articles/160.aspx