Uploads a file to the server
<html >
<head >
<title >File Upload </title >
</head >
<body >
<%response.buffer=true
Func = Request("Func")
if isempty(Func) Then
Func = 1
End if
Select Case Func
Case 1
'You do not need to use this form to sen
' d your files.
'However you should not give your submit
' button a NAME or ID.
% >
<font face=verdana >
<H2 >Please Select a File to Upload. </H1 >
<FORM ENCTYPE="multipart/form-data" ACTION="saveany.asp?func=2" METHOD=POST id=form1 name=form1 >
<TABLE >
<TR > <TD >Type In the full path and name of the file To upload. </TD > </TR >
<TR > <TD >-or- </TD > </TR >
<TR > <TD >Hit the [Browse] button to find the file on your computer. <BR > <BR > </TD > </TR >
<TR > <TD >Then hit the [Upload] button. <BR > <BR > </TD > </TR >
<TR > <TD > <STRONG >File Name... </STRONG > </TD > </TR >
<TR > <TD > <INPUT NAME=File1 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD > <INPUT NAME=File2 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD > <INPUT NAME=File2 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD align=left > <INPUT type="submit" value="Upload File" > <BR > <BR > </TD > </TR >
<TR > <TD >NOTE: Please be patient, you will not receive any notification until the file is completely transferred. <BR > <BR > </TD > </TR >
</TABLE >
</font >
<%
Case 2
ForWriting = 2
adLongVarChar = 201
lngNumberUploaded = 0
'Get binary data from form
noBytes = Request.TotalBytes
binData = Request.BinaryRead (noBytes)
'convery the binary data to a string
Set RST = CreateObject("ADODB.Recordset")
LenBinary = LenB(binData)
if LenBinary > 0 Then
RST.Fields.Append "myBinary", adLongVarChar, LenBinary
RST.Open
RST.AddNew
RST("myBinary").AppendChunk BinData
RST.Update
strDataWhole = RST("myBinary")
End if
'Creates a raw data file for with all da
' ta sent. Uncomment for debuging.
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set f = fso.OpenTextFile(server.mappath(".") & "\raw.txt", ForWriting, True)
'f.Write strDataWhole
'set f = nothing
'set fso = nothing
'get the boundry indicator
strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE")
lngBoundryPos = instr(1,strBoundry,"boundary=") + 8
strBoundry = "--" & right(strBoundry,len(strBoundry)-lngBoundryPos)
'Get first file boundry positions.
lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
Do While lngCurrentEnd > 0
'Get the data between current boundry an
' d remove it from the whole.
strData = mid(strDataWhole,lngCurrentBegin, lngCurrentEnd - lngCurrentBegin)
strDataWhole = replace(strDataWhole,strData,"")
'Get the full path of the current file.
lngBeginFileName = instr(1,strdata,"filename=") + 10
lngEndFileName = instr(lngBeginFileName,strData,chr(34))
'Make sure they selected at least one fi
' le.
if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 Then
Response.Write " <font face=verdana > <H2 > The following Error occured. </H2 >"
Response.Write "You must Select at least one file To upload"
Response.Write " <BR > <BR >Hit the back button, make the needed corrections and resubmit your information."
Response.Write " <BR > <BR > <INPUT type='button' onclick='history.go(-1)' value=' < < Back' id='button'1 name='button'1 > </font >"
Response.End
End if
'There could be one or more empty file b
' oxes.
if lngBeginFileName < > lngEndFileName Then
strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName)
'Creates a raw data file with data betwe
' en current boundrys. Uncomment for debug
' ing.
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set f = fso.OpenTextFile(server.mappath(".") & "\raw_" & lngNumberUploaded & ".txt", ForWriting, True)
'f.Write strData
'set f = nothing
'set fso = nothing
'Loose the path information and keep jus
' t the file name.
tmpLng = instr(1,strFilename,"\")
Do While tmpLng > 0
PrevPos = tmpLng
tmpLng = instr(PrevPos + 1,strFilename,"\")
Loop
FileName = right(strFilename,len(strFileName) - PrevPos)
'Get the begining position of the file d
' ata sent.
'if the file type is registered with the
' browser then there will be a Content-Typ
' e
lngCT = instr(1,strData,"Content-Type:")
if lngCT > 0 Then
lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4
Else
lngBeginPos = lngEndFileName
End if
'Get the ending position of the file dat
' a sent.
lngEndPos = len(strData)
'Calculate the file size.
lngDataLenth = lngEndPos - lngBeginPos
'Get the file data
strFileData = mid(strData,lngBeginPos,lngDataLenth)
'Create the file.
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(server.mappath(".") & "\" & FileName, ForWriting, True)
f.Write strFileData
Set f = nothing
Set fso = nothing
lngNumberUploaded = lngNumberUploaded + 1
End if
'Get then next boundry postitions if any
' .
lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
loop
Response.Write " <H2 >File(s) Uploaded </H2 >"
Response.Write lngNumberUploaded & " files have been uploaded. <BR >"
Response.Write " <BR > <BR > <INPUT type='button' onclick='document.location=" & chr(34) & "saveany.asp" & chr(34) & "' value=' < < Back to Listings' id='button'1 name='button'1 >"
End Select
% >
</BODY >
</HTML >
<head >
<title >File Upload </title >
</head >
<body >
<%response.buffer=true
Func = Request("Func")
if isempty(Func) Then
Func = 1
End if
Select Case Func
Case 1
'You do not need to use this form to sen
' d your files.
'However you should not give your submit
' button a NAME or ID.
% >
<font face=verdana >
<H2 >Please Select a File to Upload. </H1 >
<FORM ENCTYPE="multipart/form-data" ACTION="saveany.asp?func=2" METHOD=POST id=form1 name=form1 >
<TABLE >
<TR > <TD >Type In the full path and name of the file To upload. </TD > </TR >
<TR > <TD >-or- </TD > </TR >
<TR > <TD >Hit the [Browse] button to find the file on your computer. <BR > <BR > </TD > </TR >
<TR > <TD >Then hit the [Upload] button. <BR > <BR > </TD > </TR >
<TR > <TD > <STRONG >File Name... </STRONG > </TD > </TR >
<TR > <TD > <INPUT NAME=File1 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD > <INPUT NAME=File2 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD > <INPUT NAME=File2 SIZE=30 TYPE=file > <BR > </TD > </TR >
<TR > <TD align=left > <INPUT type="submit" value="Upload File" > <BR > <BR > </TD > </TR >
<TR > <TD >NOTE: Please be patient, you will not receive any notification until the file is completely transferred. <BR > <BR > </TD > </TR >
</TABLE >
</font >
<%
Case 2
ForWriting = 2
adLongVarChar = 201
lngNumberUploaded = 0
'Get binary data from form
noBytes = Request.TotalBytes
binData = Request.BinaryRead (noBytes)
'convery the binary data to a string
Set RST = CreateObject("ADODB.Recordset")
LenBinary = LenB(binData)
if LenBinary > 0 Then
RST.Fields.Append "myBinary", adLongVarChar, LenBinary
RST.Open
RST.AddNew
RST("myBinary").AppendChunk BinData
RST.Update
strDataWhole = RST("myBinary")
End if
'Creates a raw data file for with all da
' ta sent. Uncomment for debuging.
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set f = fso.OpenTextFile(server.mappath(".") & "\raw.txt", ForWriting, True)
'f.Write strDataWhole
'set f = nothing
'set fso = nothing
'get the boundry indicator
strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE")
lngBoundryPos = instr(1,strBoundry,"boundary=") + 8
strBoundry = "--" & right(strBoundry,len(strBoundry)-lngBoundryPos)
'Get first file boundry positions.
lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
Do While lngCurrentEnd > 0
'Get the data between current boundry an
' d remove it from the whole.
strData = mid(strDataWhole,lngCurrentBegin, lngCurrentEnd - lngCurrentBegin)
strDataWhole = replace(strDataWhole,strData,"")
'Get the full path of the current file.
lngBeginFileName = instr(1,strdata,"filename=") + 10
lngEndFileName = instr(lngBeginFileName,strData,chr(34))
'Make sure they selected at least one fi
' le.
if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 Then
Response.Write " <font face=verdana > <H2 > The following Error occured. </H2 >"
Response.Write "You must Select at least one file To upload"
Response.Write " <BR > <BR >Hit the back button, make the needed corrections and resubmit your information."
Response.Write " <BR > <BR > <INPUT type='button' onclick='history.go(-1)' value=' < < Back' id='button'1 name='button'1 > </font >"
Response.End
End if
'There could be one or more empty file b
' oxes.
if lngBeginFileName < > lngEndFileName Then
strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName)
'Creates a raw data file with data betwe
' en current boundrys. Uncomment for debug
' ing.
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set f = fso.OpenTextFile(server.mappath(".") & "\raw_" & lngNumberUploaded & ".txt", ForWriting, True)
'f.Write strData
'set f = nothing
'set fso = nothing
'Loose the path information and keep jus
' t the file name.
tmpLng = instr(1,strFilename,"\")
Do While tmpLng > 0
PrevPos = tmpLng
tmpLng = instr(PrevPos + 1,strFilename,"\")
Loop
FileName = right(strFilename,len(strFileName) - PrevPos)
'Get the begining position of the file d
' ata sent.
'if the file type is registered with the
' browser then there will be a Content-Typ
' e
lngCT = instr(1,strData,"Content-Type:")
if lngCT > 0 Then
lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4
Else
lngBeginPos = lngEndFileName
End if
'Get the ending position of the file dat
' a sent.
lngEndPos = len(strData)
'Calculate the file size.
lngDataLenth = lngEndPos - lngBeginPos
'Get the file data
strFileData = mid(strData,lngBeginPos,lngDataLenth)
'Create the file.
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(server.mappath(".") & "\" & FileName, ForWriting, True)
f.Write strFileData
Set f = nothing
Set fso = nothing
lngNumberUploaded = lngNumberUploaded + 1
End if
'Get then next boundry postitions if any
' .
lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
loop
Response.Write " <H2 >File(s) Uploaded </H2 >"
Response.Write lngNumberUploaded & " files have been uploaded. <BR >"
Response.Write " <BR > <BR > <INPUT type='button' onclick='document.location=" & chr(34) & "saveany.asp" & chr(34) & "' value=' < < Back to Listings' id='button'1 name='button'1 >"
End Select
% >
</BODY >
</HTML >
Views 5,062
Downloads 1,581
CodeID
DB ID
