Attribute VB_Name = "modDemoFileUpload"
Option Explicit
Const FILE_PATH As String = "files\"
Const TEMP_PATH As String = "temp\"
Sub Main()
'
' let WebRainbow accept both GET and POST
'
Call DynaPage.SetRequestMethod(RequestMethod.hmAuto)
'
' get request method
'
If GetCgiEnvironment(ceREQUEST_METHOD) = "GET" Then
'
' for GET, check form-data
'
If (CountFormData = 0) Then
'
' just give page
'
SendPage
Else
'
' send requested file
'
SendRequestedFile
End If
Else
'
' for POST, process upload first
'
ProcessUpload
'
' send page to show upoaded file
'
SendPage
End If
End Sub
Sub SendPage()
Call HtmlBegin
Call Welcome
CPrint "<TABLE WIDTH=""100%"" CELLPADDING=""10"" CELLSPACING=""20"" BORDER=""5"">"
CPrint "<TR VALIGN=""TOP"">"
CPrint "<TD WIDTH=""50%"" ALIGN=""CENTER"">"
Call FileUploadSection
CPrint "</TD>"
CPrint "<TD WIDTH=""50%"" ALIGN=""CENTER"">"
Call ListFile
CPrint "</TD>"
CPrint "</TR>"
CPrint "</TABLE>"
Call HtmlEnd
End Sub
Sub HtmlBegin()
CPrint "<HTML>"
CPrint "<HEAD><TITLE>Test program for File Upload / Download</TITLE></HEAD>"
CPrint "<BODY>"
End Sub
Sub HtmlEnd()
CPrint "</BODY></HTML>"
End Sub
Sub Welcome()
CPrint "<P>"
CPrint "<CENTER>"
CPrint "<FONT SIZE=""5"" COLOR=""RED""> Demo for File Upload / Download with WebRainbow</FONT>"
CPrint "</CENTER>"
CPrint "<P>"
End Sub
Sub FileUploadSection()
'
' show file upload form
'
CPrint "<FORM ACTION=""demoFileUpload.exe"" ENCTYPE=""multipart/form-data"" METHOD=""POST"">"
CPrint " <TABLE>"
CPrint " <TR><TD ALIGN=""RIGHT""><FONT SIZE=""4"" COLOR=""BLUE"">LOCAL - Select file(s) to upload</FONT></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""> </TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file1"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file2"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file3"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file4"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file5"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file6"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file7"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file8"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file9"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file10"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file11"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""FILE"" NAME=""file12"" VALUE=""select a file""></TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""> </TD></TR>"
CPrint " <TR><TD ALIGN=""RIGHT""><INPUT TYPE=""SUBMIT"" VALUE=""Upload Files =>""></TD></TR>"
CPrint " </TABLE>"
CPrint "</FORM>"
End Sub
Sub ListFile()
Dim MyFile As String
'
' return first file in the fold.
'
MyFile = Dir(FILE_PATH & "*.*")
' send file
' note: For PDF, some time IE works with POST, some time does not
' NetScape works fine with both GET & POST
' But both browsers only works with GET as normal file retrieve
CPrint "<FORM ACTION=""demoFileUpload.exe"" METHOD=""GET"">"
CPrint " <TABLE>"
CPrint " <TR><TD ALIGN=""LEFT""><FONT SIZE=""4"" COLOR=""BLUE"">REMOTE - Select file to download</FONT></TD></TR>"
CPrint " <TR><TD ALIGN=""LEFT""> </TD></TR>"
'
' loop to find all files
'
Do While MyFile <> ""
CPrint " <TR><TD ALIGN=""LEFT""><INPUT TYPE=""RADIO"" NAME=""dwfile"" VALUE=""" & MyFile & """>" & MyFile & "</TD></TR>"
MyFile = Dir
Loop
'
' show download button
'
CPrint " <TR><TD ALIGN=""LEFT""> </TD></TR>"
CPrint " <TR><TD ALIGN=""LEFT""><INPUT TYPE=""SUBMIT"" VALUE=""<= Download File""></TD></TR>"
CPrint " </TABLE>"
CPrint "</FORM>"
End Sub
Sub SendRequestedFile()
Dim sFileName As String
'
' get requested filename
'
sFileName = GetFormData("dwfile")
If Trim(sFileName) <> "" Then
'
' send request file now
'
SetExtHeader "Content-Disposition", "attachment;filename=" & sFileName
SetCgiHeader sc200_OK, "application/x-download"
If DynaPage.Sendfile(Trim(FILE_PATH & sFileName), ctAutoTypeSelect, _
ContentType.ctApplicationOctet_stream, 10) = -1 Then
'
' error
'
Call HtmlBegin
CPrint "<CENTER>Error in opening file</CENTER>"
Call HtmlEnd
End If
Else
'
' no file specified
'
Call HtmlBegin
CPrint "<CENTER>Error in opening file</CENTER>"
Call HtmlEnd
End If
End Sub
Sub ProcessUpload()
Dim iTotalUploadFiles As Integer
Dim i As Integer
'
' let WebRainbow read data with content-type as multipart/form-data only
'
DynaPage.SpecityContentType ctMultipartForm_data
'
' set WebRainbow to retrieve all data sent by browser
' you can specify the size in K, e.g. 100 as 100K too
'
DynaPage.SetContentLength DynaPageProperty.clRetrieveAllData
'
' let WebRainbow retrieve files up to 12 files
'
DynaPage.SetMaxUploadFiles "12"
'
' set temp directory for temp file
'
DynaPage.SetTempDirectory TEMP_PATH
'
' get number of files uploaded
'
iTotalUploadFiles = DynaPage.CountUploadFiles
'
' save uploaded file(s) to given directory
'
For i = 0 To iTotalUploadFiles - 1
'
' here all uploaded file will be saved same as their original name
'
DynaPage.SaveUploadFileAs CStr(i), FILE_PATH & DynaPage.GetUploadFileName(CStr(i))
Next i
End Sub