<%
' save as create_upload_form.asp
' this upload will upload file to folder and enter file information into database.

%>


 


<head>
<title>Your generated ASP upload form</title>
<link rel="stylesheet" type="text/css" href="../index.css">
</head>

<p>
<b><font face="Webdings" color="#FF0000">3</font></b><i><font size="1"><a href="http://www.classicaspreference.com/aspexamples/menu.htm">Back
to ASP Examples
Menu</a></font><br>
</i>
<b><font face="Webdings" color="#FF0000">3</font><font size="1"><i><a target="_blank" href="select_database.asp">Back
to Database Selection</a></i></font></b><br>
<b><font face="Webdings" color="#FF0000">3</font></b><i><font size="1"><a href="default.asp">Back to Database Interface Wizard Home Page</a></font><br>
</i>
<b><font face="Webdings" color="#FF0000">4</font><i><font size="1"><a title="Please let me know if this has been helpful." href="mailto:lilpeck@gmail.com?subject=database interface generation wizard">This
script cobbled together by Lil Peck</a></font></i></b></p>
<p><b><font size="3">Here is your upload form script for uploading files to
folder and file details to database. <br>
Please <a href="mailto:lilpeck@gmail.com?subject=upload form">let me know</a> of
any errors it gives you. When I get time I will add thumbnail creation to
this thing.</font></b></p>
<p><b>Save as <%=request.form("Table")%>_upload.asp - You'll also need
<a target="_blank" href="freeaspupload_asp.asp">freeASPUpload.asp</a> as the
include file.</b></p>
<p>&lt;%<br>
option explicit<br>
Response.expires = 0<br>
Response.expiresabsolute = Now() - 1<br>
Response.addHeader &quot;pragma&quot;, &quot;no-cache&quot;<br>
Response.addHeader &quot;cache-control&quot;, &quot;private&quot;<br>
Response.CacheControl = &quot;no-cache&quot;<br>
%&gt;<br>
&lt;% <br>
Server.ScriptTimeout = 600<br>
dim strKey<br>
strKey = request.querystring(&quot;key&quot;)<br>
if request.querystring(&quot;key&quot;)=&quot;&quot; then<br>
strKey = 1<br>
end if<br>
%&gt;<br>
&lt;%<br>
dim CurrentDirectory, asPath, StripDirectory, aSplit, script_name, PixSQL,
rsPixConn, adCmdText, strFsz, strType, MatchArray, YES, Cal, img, NewID,
strTypemsg<br>
CurrentDirectory = (Request.ServerVariables(&quot;PATH_TRANSLATED&quot;))<br>
'response.write CurrentDirectory<br>
<br>
asPath = Left(CurrentDirectory, InStrRev(CurrentDirectory, &quot;\&quot;))<br>
StripDirectory = asPath<br>
'response.write StripDirectory<br>
<br>
<br>
aSplit = Split (CurrentDirectory, &quot;\&quot;)<br>
<br>
UBound(aSplit)<br>
<br>
If UBound(aSplit) &gt; 1 Then<br>
'Response.WRite &quot;the folder is: &quot; &amp; aSplit(Ubound(aSplit) - 1) &amp; &quot;&lt;BR&gt;&quot;<br>
dim CurFldr<br>
CurFldr = aSplit(Ubound(aSplit) - 1)<br>
End If <br>
<br>
script_name=request.servervariables(&quot;script_name&quot;)<br>
<br>
%&gt;<br>
&lt;!-- #include file=&quot;freeaspupload.asp&quot; --&gt;<br>
<br>
<br>
<br>
&lt;p&gt;&lt;b&gt;&lt;font size=&quot;4&quot;&gt;Select your image file.&lt;/font&gt;&lt;/b&gt; &lt;br&gt;<br>
&lt;/p&gt;<br>
<br>
<br>
&lt;%<br>
<br>
<br>
' ****************************************************<br>
' Change the value of the variable below to the pathname<br>
' of a directory with write permissions, for example &quot;C:\Inetpub\wwwroot&quot;<br>
Dim uploadsDirVar<br>
uploadsDirVar = StripDirectory<br>
' ****************************************************<br>
<br>
' Note: this file uploadTester.asp is just an example to demonstrate<br>
' the capabilities of the freeASPUpload.asp class. There are no plans<br>
' to add any new features to uploadTester.asp itself. Feel free to add<br>
' your own code. If you are building a content management system, you<br>
' may also want to consider this script: http://www.webfilebrowser.com/<br>
<br>
function OutputForm()<br>
%&gt;&lt;b&gt;&lt;font size=&quot;2&quot;&gt;Adapted from upload script by<br>
&lt;a href=&quot;http://www.freeaspupload.net/freeaspupload/download.asp&quot;&gt;<br>
Free ASP Upload&lt;/a&gt;.&lt;br&gt;<br>
This script will upload file to folder and insert filename and image details <br>
into database.&lt;/font&gt;&lt;/b&gt;&lt;br&gt;<br>
&lt;form name=&quot;FrontPage_Form1&quot; method=&quot;POST&quot; enctype=&quot;multipart/form-data&quot;
action=&quot;&lt;%= script_name %&gt;?key=&lt;%=strKey%&gt;&quot; onSubmit=&quot;return onSubmitForm();&quot;&gt;<br>
&lt;B&gt;&lt;/B&gt;&lt;p&gt;&lt;br&gt;<br>
&lt;%<br>
Dim Pixconn ' ADO connection<br>
Dim rsPix ' ADO recordset<br>
Dim strPixPath ' path to our Access database (*.mdb) file<br>
<br>
dim CursorType,adOpenStatic<br>
strPixPath = Server.MapPath(&quot;<%=request.form("dbname")%>&quot;)
<font color="#FF0000">' You'll need to correct this path for your database which
should be outside public html or in the fpdb folder for security</font><br>
Set Pixconn = Server.CreateObject(&quot;ADODB.Connection&quot;)<br>
Pixconn.Open &quot;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=&quot; &amp; strPixPath &amp; &quot;;&quot;<br>
<br>
'To show one single record for viewrecord.asp comment out above and uncomment
below<br>
PixSQL = &quot;SELECT * FROM <%=request.form("CatTable")%> ORDER BY <%=request.form("CatForeignKey")%> DESC&quot; &amp; &quot;;&quot;
<font color="#FF0000">' check this line for errors</font><br>
<br>
Set rsPixConn = Server.CreateObject(&quot;ADODB.Connection&quot;)<br>
<br>
' Create recordset and set the page size<br>
Set rsPix = Server.CreateObject(&quot;ADODB.Recordset&quot;)<br>
<br>
' Open rsPix<br>
rsPix.Open PixSQL, Pixconn,3,3, adCmdText<br>
%&gt;<br>
&lt;!--webbot bot=&quot;Validation&quot; s-display-name=&quot;Select Category&quot;
b-disallow-first-item=&quot;TRUE&quot; --&gt;<br>
&lt;select name=&quot;<%=request.form("Filecategory")%>&quot; size=&quot;1&quot;&gt;<br>
&lt;option&gt;Select Category&lt;/option&gt;<br>
&lt;% Do While Not rsPix.EOF %&gt;<br>
&lt;option value=&quot;&lt;%= rsPix(&quot;<%=Request.Form("CatForeignKey")%>&quot;) %&gt;&quot;&gt;&lt;%= rsPix(&quot;<%=Request.Form("CatName")%>&quot;)
%&gt;&lt;/option&gt; <font color="#FF0000">' Type in your Category primary key and title fields here
</font> <br>
&lt;%<br>
rsPix.MoveNext<br>
Loop<br>
%&gt;</p>
<p><br>
&lt;/select&gt;<br>
&lt;%<br>
rsPix.Close<br>
set rsPix = Nothing<br>
Pixconn.Close<br>
set Pixconn = Nothing<br>
%&gt;&lt;/p&gt;<br>
&lt;p&gt;Image: &lt;br&gt;<br>
&amp;nbsp;&lt;input name=&quot;FILENAME&quot; type=&quot;file&quot; size=35&gt;&lt;br&gt;<br>
&lt;br&gt;<br>
Image Title:&lt;br&gt;<br>
&amp;nbsp;&lt;!--webbot bot=&quot;Validation&quot; b-value-required=&quot;TRUE&quot; i-minimum-length=&quot;3&quot; i-maximum-length=&quot;100&quot;
--&gt;&lt;input type=&quot;text&quot; name=&quot;FILE_TITLE&quot; size=&quot;50&quot; maxlength=&quot;100&quot;&gt;&lt;br&gt;<br>
&lt;br&gt;<br>
Image Description:&lt;br&gt;<br>
&amp;nbsp;&lt;!--webbot bot=&quot;Validation&quot; b-value-required=&quot;TRUE&quot; i-minimum-length=&quot;5&quot; i-maximum-length=&quot;1000&quot;
--&gt;&lt;textarea rows=&quot;4&quot; name=&quot;FILE_DESCRIPTION&quot; cols=&quot;50&quot;&gt;&lt;/textarea&gt;&lt;br&gt;<br>
&lt;br&gt;<br>
Your name or nickname: &lt;br&gt;<br>
&amp;nbsp;&lt;!--webbot bot=&quot;Validation&quot; b-value-required=&quot;TRUE&quot; i-minimum-length=&quot;2&quot; i-maximum-length=&quot;50&quot;
--&gt;&lt;input type=&quot;text&quot; name=&quot;USER_ID&quot; size=&quot;12&quot; maxlength=&quot;12&quot;&gt;&lt;br&gt;<br>
<br>
<br>
&lt;!-- End of additional elements --&gt;<br>
&lt;input style=&quot;margin-top:4&quot; type=submit value=&quot;Upload&quot;&gt;<br>
&lt;/p&gt;<br>
&lt;/form&gt;<br>
&lt;/p&gt;<br>
<br>
&lt;%<br>
end function<br>
<br>
function TestEnvironment()<br>
Dim fso, fileName, testFile, streamTest<br>
TestEnvironment = &quot;&quot;<br>
Set fso = Server.CreateObject(&quot;Scripting.FileSystemObject&quot;)<br>
if not fso.FolderExists(uploadsDirVar) then<br>
TestEnvironment = &quot;&lt;B&gt;Folder &quot; &amp; uploadsDirVar &amp; &quot; does not exist.&lt;/B&gt;&lt;br&gt;The
value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and
change the value of uploadsDirVar to the pathname of a directory with write
permissions.&quot;<br>
exit function<br>
end if<br>
fileName = uploadsDirVar &amp; &quot;\test.txt&quot;<br>
on error resume next<br>
Set testFile = fso.CreateTextFile(fileName, true)<br>
If Err.Number&lt;&gt;0 then<br>
TestEnvironment = &quot;&lt;B&gt;Folder &quot; &amp; uploadsDirVar &amp; &quot; does not have write
permissions.&lt;/B&gt;&lt;br&gt;The value of your uploadsDirVar is incorrect. Open
uploadTester.asp in an editor and change the value of uploadsDirVar to the
pathname of a directory with write permissions.&quot;<br>
exit function<br>
end if<br>
Err.Clear<br>
testFile.Close<br>
fso.DeleteFile(fileName)<br>
If Err.Number&lt;&gt;0 then<br>
TestEnvironment = &quot;&lt;B&gt;Folder &quot; &amp; uploadsDirVar &amp; &quot; does not have delete
permissions&lt;/B&gt;, although it does have write permissions.&lt;br&gt;Change the
permissions for IUSR_&lt;I&gt;computername&lt;/I&gt; on this folder.&quot;<br>
exit function<br>
end if<br>
Err.Clear<br>
Set streamTest = Server.CreateObject(&quot;ADODB.Stream&quot;)<br>
If Err.Number&lt;&gt;0 then<br>
TestEnvironment = &quot;&lt;B&gt;The ADODB object &lt;I&gt;Stream&lt;/I&gt; is not available in your
server.&lt;/B&gt;&lt;br&gt;Check the Requirements page for information about upgrading your
ADODB libraries.&quot;<br>
exit function<br>
end if<br>
Set streamTest = Nothing<br>
end function<br>
<br>
function SaveFiles<br>
Dim Upload, fileName, fileSize, ks, i, fileKey<br>
<br>
Set Upload = New FreeASPUpload<br>
Upload.Save(uploadsDirVar)<br>
<br>
<br>
<br>
' If something fails inside the script, but the exception is handled<br>
If Err.Number&lt;&gt;0 then Exit function<br>
<br>
SaveFiles = &quot;&quot;<br>
ks = Upload.UploadedFiles.keys<br>
if (UBound(ks) &lt;&gt; -1) then<br>
<br>
SaveFiles = &quot;&lt;B&gt;Files uploaded:&lt;/B&gt; &quot;<br>
for each fileKey in Upload.UploadedFiles.keys<br>
<br>
dim strFile<br>
strFile = Upload.UploadedFiles(fileKey).FileName <br>
<br>
<br>
SaveFiles = &quot;Saved: &quot; &amp; Upload.UploadedFiles(fileKey).FileName&amp;&quot; - (&quot;&amp; Upload.UploadedFiles(fileKey).Length &amp; &quot;
KB) &quot; &amp; &quot;&lt;br&gt;&quot;<br>
'strFsz<br>
strFsz = Upload.UploadedFiles(fileKey).Length<br>
strType = Upload.UploadedFiles(fileKey).ContentType<br>
next<br>
else<br>
SaveFiles = &quot;The file name specified in the upload form does not correspond to a
valid file in the system.&quot;<br>
end if<br>
<br>
'&lt;--- Begin screening mime types<br>
<br>
'&lt;--- Begin check for allowed filetypes <br>
Dim sMyArray(5)'what we name our array and how many items in it <br>
sMyArray(0) = &quot;image/bmp&quot; 'in this example, these are records I don't want code
testers to be able to delete <br>
sMyArray(1) = &quot;image/gif&quot; <br>
sMyArray(2) = &quot;image/jpeg&quot; <br>
sMyArray(3) = &quot;image/pjpeg&quot; <br>
sMyArray(4) = &quot;image/png&quot; <br>
<br>
<br>
For Each i In sMyArray 'i can be any designation for the items in the array<br>
<br>
'now we need to set up a Case with with to compare our querystring to the items
in the array <br>
Select Case MatchArray 'give your case a name for identification purposes <br>
<br>
Case YES <br>
<br>
if i = strType then <br>
Cal = &quot;YES&quot; <br>
<br>
end if <br>
End select <br>
<br>
<br>
Next <br>
<br>
If NOT Cal = &quot;YES&quot; then <br>
response.write &quot;Sorry, that filetype &quot; &amp; strType &amp; &quot; is not allowed. Your file
must be one of the following extensions:&lt;br&gt; &quot; <br>
for each i in sMyArray <br>
response.write i &amp;&quot;&lt;br&gt;&quot; <br>
<br>
next <br>
response.write &quot;&lt;b&gt;Image files only.&lt;b&gt;&quot; <br>
<br>
'delete if filetype not okay<br>
dim fso 'create variables,tfile<br>
set fso=Server.CreateObject(&quot;Scripting.FileSystemObject&quot;) <br>
if fso.FileExists(server.mappath(strFile)) then <br>
fso.DeleteFile(server.mappath(strFile))<br>
else<br>
response.write &quot;Can't find file.&quot;<br>
end if<br>
'end delete<br>
<br>
response.end <br>
end if <br>
'&lt;--- End mimetypes check<br>
'&lt;--- Begin routine to check for image width and height<br>
<br>
dim iWidth, iHeight, iType <br>
'sub ImgDimension(img) <br>
dim myImg, fs <br>
Set fs= CreateObject(&quot;Scripting.FileSystemObject&quot;) <br>
img=server.mappath(strFile)<br>
if not fs.fileExists(img) then <br>
end if <br>
set myImg = loadpicture(img) <br>
iWidth = round(myImg.width / 26.4583) <br>
iHeight = round(myImg.height / 26.4583) <br>
iType = myImg.Type <br>
select case iType <br>
case 0 <br>
iType = &quot;None&quot; <br>
case 1 <br>
iType = &quot;Bitmap&quot; <br>
case 2 <br>
iType = &quot;Metafile&quot; <br>
case 3 <br>
iType = &quot;Icon&quot; <br>
case 4 <br>
iType = &quot;Win32-enhanced metafile&quot; <br>
end select <br>
set myImg = nothing <br>
'end sub <br>
<br>
'ImgDimension(Server.MapPath(strFile))<br>
<br>
<br>
<br>
'&lt;--- End image file type and dimensions routine <br>
<br>
<br>
'&lt;--- begin database insert<br>
<br>
<br>
'if NOT request.form(&quot;add&quot;)=&quot;&quot; then <br>
<br>
'Our ADO constants we'll need<br>
Const adOpenForwardOnly = 0<br>
Const adLockOptimistic = 3<br>
Const adCmdTable = &amp;H0002<br>
<br>
Dim conn ' ADO connection<br>
Dim rs ' ADO recordset<br>
Dim strDBPath ' path to our Access database (*.mdb) file<br>
<br>
<br>
strDBPath = Server.MapPath(&quot;<%=request.form("dbname")%>&quot;)
<font color="#FF0000">' You'll need to correct this path for your database which
should be outside public html or in the fpdb folder for security</font><br>
Set conn = Server.CreateObject(&quot;ADODB.Connection&quot;)<br>
conn.Open &quot;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=&quot; &amp; strDBPath &amp; &quot;;&quot;<br>
<br>
<br>
'Create a recordset object<br>
<br>
Set rs = Server.CreateObject(&quot;ADODB.Recordset&quot;)<br>
<br>
'Open a table view for the table name specified by Request(&quot;TableName&quot;)<br>
Dim strTableName<br>
strTableName = &quot;<%=request.form("Table")%>&quot; <br>
<br>
'Add a new record...<br>
<br>
rs.Open strTableName, conn, , adLockOptimistic, adCmdTable<br>
<br>
rs.AddNew<br>
rs(&quot;<%=request.form("Filename")%>&quot;) = strFile<br>
rs(&quot;<%=request.form("Filewidth")%>&quot;) = iWidth<br>
rs(&quot;<%=request.form("Fileheight")%>&quot;) = iHeight <br>
rs(&quot;<%=request.form("Filetype")%>&quot;) = strType<br>
rs(&quot;<%=request.form("Filesize")%>&quot;) = strFsz<br>
rs(&quot;<%=request.form("Filedate")%>&quot;) = Date()<br>
rs(&quot;<%=request.form("Filetitle")%>&quot;) = Upload.Form(&quot;<%=request.form("Filetitle")%>&quot;)<br>
rs(&quot;<%=request.form("Filedescription")%>&quot;) = Upload.Form(&quot;<%=request.form("Filedescription")%>&quot;)<br>
rs(&quot;<%=request.form("Fileuser")%>&quot;) = Upload.Form(&quot;<%=request.form("FileUser")%>&quot;)<br>
rs(&quot;<%=request.form("Filecategory")%>&quot;) = Upload.Form(&quot;<%=request.form("Filecategory")%>&quot;)<br>
<br>
rs.movelast<br>
NewID = rs(&quot;<%=request.form("key")%>&quot;)<br>
<br>
<br>
<br>
<br>
<br>
'Clean Up...<br>
rs.Close<br>
Set rs = Nothing<br>
<br>
conn.Close<br>
Set conn = Nothing<br>
<br>
<br>
'Send the user to some confirmation page or give confirmation message:<br>
'Response.Redirect &quot;list.asp&quot;<br>
'Response.Write &quot;Record Added!&quot;<br>
<br>
<br>
'end if <br>
<br>
'&lt;--- end database insert <br>
response.write &quot;&lt;br&gt;&quot; <br>
<br>
response.write &quot;Here is your Record ID: &quot;&amp; NewID &amp; &quot; &quot; &amp; strTypemsg &amp; &quot;&lt;BR&gt;&quot;<br>
SaveFiles = SaveFiles &amp; &quot;&lt;br&gt;Enter a number = &quot; &amp; Upload.Form(&quot;enter_a_number&quot;)
&amp; &quot;&lt;br&gt;&quot;<br>
SaveFiles = SaveFiles &amp; &quot;Checkbox values = &quot; &amp; Upload.Form(&quot;checkbox_values&quot;) &amp;
&quot;&lt;br&gt;&quot;<br>
<br>
end function<br>
%&gt;<br>
<br>
&lt;%<br>
Response.expires = 0<br>
Response.expiresabsolute = Now() - 1<br>
Response.addHeader &quot;pragma&quot;, &quot;no-cache&quot;<br>
Response.addHeader &quot;cache-control&quot;, &quot;private&quot;<br>
Response.CacheControl = &quot;no-cache&quot;<br>
%&gt;<br>
&lt;HTML&gt;<br>
&lt;HEAD&gt;<br>
&lt;TITLE&gt;Upload a picture&lt;/TITLE&gt;<br>
&lt;link rel=&quot;stylesheet&quot; type=&quot;text/css&quot; href=&quot;../index.css&quot;&gt;<br>
&lt;script&gt;<br>
function onSubmitForm() {<br>
var formDOMObj = document.frmSend;<br>
if (formDOMObj.attach1.value == &quot;&quot; &amp;&amp; formDOMObj.attach2.value == &quot;&quot; &amp;&amp;
formDOMObj.attach3.value == &quot;&quot; &amp;&amp; formDOMObj.attach4.value == &quot;&quot; )<br>
alert(&quot;Please press the browse button and pick a file.&quot;)<br>
else<br>
return true;<br>
return false;<br>
}<br>
&lt;/script&gt;<br>
<br>
&lt;/HEAD&gt;<br>
<br>
&lt;BODY&gt;<br>
<br>
&lt;br&gt;<br>
&lt;%<br>
Dim diagnostics<br>
if Request.ServerVariables(&quot;REQUEST_METHOD&quot;) &lt;&gt; &quot;POST&quot; then<br>
diagnostics = TestEnvironment()<br>
if diagnostics&lt;&gt;&quot;&quot; then<br>
response.write &quot;&lt;div style=&quot;&quot;margin-left:20; margin-top:30; margin-right:30;
margin-bottom:30;&quot;&quot;&gt;&quot;<br>
response.write diagnostics<br>
response.write &quot;&lt;p&gt;After you correct this problem, reload the page.&quot;<br>
response.write &quot;&lt;/div&gt;&quot;<br>
else<br>
response.write &quot;&lt;div style=&quot;&quot;margin-left:150&quot;&quot;&gt;&quot;<br>
OutputForm()<br>
response.write &quot;&lt;/div&gt;&quot;<br>
end if<br>
else<br>
response.write &quot;&lt;div style=&quot;&quot;margin-left:150&quot;&quot;&gt;&quot;<br>
OutputForm()<br>
response.write SaveFiles()<br>
response.write &quot;&lt;br&gt;&lt;br&gt;&lt;/div&gt;&quot;<br>
end if<br>
<br>
%&gt;<br>
&lt;p&gt;&amp;nbsp;&lt;/p&gt;<br>
&nbsp;</p>