<% ' save as select_database_asp.asp


Response.expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma", "no-cache"
Response.addHeader "cache-control", "private"
Response.CacheControl = "no-cache"
%>
<%
Server.ScriptTimeout = 600
%>
<%

CurrentDirectory = (Request.ServerVariables("PATH_TRANSLATED"))
'response.write CurrentDirectory

asPath = Left(CurrentDirectory, InStrRev(CurrentDirectory, "\"))
StripDirectory = asPath
'response.write StripDirectory


aSplit = Split (CurrentDirectory, "\")

UBound(aSplit)

If UBound(aSplit) > 1 Then
'Response.WRite "the folder is: " & aSplit(Ubound(aSplit) - 1) & "<BR>"
dim CurFldr
CurFldr = aSplit(Ubound(aSplit) - 1)
End If

script_name=request.servervariables("script_name")

%>
<!-- #include file="freeaspupload.asp" -->
<html>

<head>
<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>Select your database</title>
<link rel="stylesheet" type="text/css" href="../index.css">
</head>

<body>
<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></i><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><font size="4"><b>The first step is to upload your
database to your server and then use ASP to select the database that you want to
create a script for. The script set includes this page that allows you to upload
a database and then detects the file, like the example databases below.</b></font></p>
<p>&nbsp;</p>
<p><b><font size="4">Select your database.</font></b> <br>
(Using code by
<a target="_blank" href="http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=4&txtCodeId=6286">
Lewis Moten</a> and by
<a target="_blank" href="http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=44&lngWId=4">
Ian Ippolito</a> and '<a target="_blank" href="http://forums.devarticles.com/archive/t-1404/How-Do-You-Get-The-Folder-Name">Roger</a>')</p>
<%
Dim objFileScripting, objFolder
Dim filename, filecollection, strDirectoryPath, strUrlPath
strDirectoryPath=StripDirectory

strUrlPath="..\"&CurFldr&"\"
'strUrlPath="\"

'get file scripting object
Set objFileScripting = CreateObject("Scripting.FileSystemObject")
'Return folder object
Set objFolder = objFileScripting.GetFolder(StripDirectory)

'return file collection In folder
Set filecollection = objFolder.Files
'create the links
For Each Filename In filecollection
StripFileExt = Right(Filename, Len(Filename) - InStrRev(Filename, ".") + 1)
If StripFileExt = ".mdb" then
Filename=right(Filename,len(Filename)-InStrRev(Filename, "\"))
Response.Write "<A HREF=" & strUrlPath & "1showtablenames.asp&#63;mdb=" & filename&">" & "Create scripts for : " & filename & "</A><BR>"

end if
Next

%>

<%


' ****************************************************
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
Dim uploadsDirVar
uploadsDirVar = StripDirectory
' ****************************************************

' Note: this file uploadTester.asp is just an example to demonstrate
' the capabilities of the freeASPUpload.asp class. There are no plans
' to add any new features to uploadTester.asp itself. Feel free to add
' your own code. If you are building a content management system, you
' may also want to consider this script: http://www.webfilebrowser.com/

function OutputForm()
%>

<B>Upload script by
<a href="http://www.freeaspupload.net/freeaspupload/download.asp">
Free ASP Upload</a> - Be sure to password protect this upload because
someone could use it to upload asp code for deleting or rewriting your site.
Remember also to delete these 'project' databases if they are in a publicly
accessible folder.<i></i></B><p>
<form name="frmSend" method="POST" enctype="multipart/form-data" action="<%= script_name %>" onSubmit="return onSubmitForm();">
<B>File names:</B><br>
File 1: <input name="attach1" type="file" size=35><br>
File 2: <input name="attach2" type="file" size=35><br>
File 3: <input name="attach3" type="file" size=35><br>
File 4: <input name="attach4" type="file" size=35><br>
<br>
<!-- These input elements are obviously optional and just included here for demonstration purposes -->
<B>Additional fields (demo):</B><br>
Enter a number: <input type="text" name="enter_a_number"><br>
Checkbox values: <input type="checkbox" value="1" name="checkbox_values">-1 <input type="checkbox" value="2" name="checkbox_values">-2<br>
<!-- End of additional elements -->
<input style="margin-top:4" type=submit value="Upload">
</p>
</form>
</p>

<%
end function

function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(uploadsDirVar) then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>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."
exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>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."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function

function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey

Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)

' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function

SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
SaveFiles = "<a href=1showtablenames.asp?mdb="&Upload.UploadedFiles(fileKey).FileName&">"& "Make Database Interfaces: " & SaveFiles & Upload.UploadedFiles(fileKey).FileName & "</a> (" & Upload.UploadedFiles(fileKey).Length & "B) "
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
SaveFiles = SaveFiles & "<br>Enter a number = " & Upload.Form("enter_a_number") & "<br>"
SaveFiles = SaveFiles & "Checkbox values = " & Upload.Form("checkbox_values") & "<br>"
end function
%>

<%
Response.expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma", "no-cache"
Response.addHeader "cache-control", "private"
Response.CacheControl = "no-cache"
%>
<HTML>
<HEAD>
<TITLE>Upload a database</TITLE>
<link rel="stylesheet" type="text/css" href="../index.css">
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.attach1.value == "" && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )
alert("Please press the browse button and pick a file.")
else
return true;
return false;
}
</script>

</HEAD>

<BODY>

<br><br>
<div style="border-bottom: #A91905 2px solid;font-size:16">Upload files to your server</div>
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
response.write "</div>"
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write "</div>"
end if
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write SaveFiles()
response.write "<br><br></div>"
end if

%>
<hr>
<p>&nbsp;</p>
</body>

</html>