<% tableDropDown() %>
> Select
> Insert
> Update
<%
End Sub
Sub buildPage(fileName,strSQL)
Dim str,x,pagesize
pagesize = request("pagesize")
If pagesize = "" Then
pagesize = 10
End If
strSQL = replace(strSQL,vbCrLf,"")
str = chr(60) & chr(37) & VbCrLf
str = str & "Option Explicit" & VbCrLf & VbCrLf
str = str & " If adCmdText = """" Then" & VbCrLf
str = str & " Const adOpenStatic = 3" & VbCrLf
str = str & " Const adCmdText = &H0001" & VbCrLf
str = str & " End If" & VbCrLf & VbCrLf
str = str & " Dim objConn, objRS, strSQL, pagesize, pageno" & VbCrLf
str = str & " Dim intRecordCnt, intpages, intpage, x, intRecord" & VbCrLf & VbCrLf
str = str & " Set objConn = Server.CreateObject(""ADODB.Connection"")" & VbCrLf
str = str & " objConn.ConnectionString = ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & request("choosetable") & """" & VbCrLf
str = str & " strSQL=""" & strSQL & """"& VbCrLf
str = str & " pageno = Request.QueryString(""pageno"")" & VbCrLf & VbCrLf
str = str & " pagesize = " & pagesize & VbCrLf & VbCrLf
str = str & " If pageno = """" then" & VbCrLf
str = str & " pageno = 1 " & VbCrLf
str = str & " End if" & VbCrLf & VbCrLf & VbCrLf
str = str & " Set objRS = server.createobject(""ADODB.Recordset"")" & VbCrLf
str = str & " objConn.open" & VbCrLf
str = str & " objRS.Open strSQL,objConn ,adOpenStatic , adCmdText" & VbCrLf
str = str & " objRS.PageSize = pagesize" & VbCrLf
str = str & " intRecordCnt = objRS.recordcount" & VbCrLf
str = str & " intpages = objRS.pagecount" & VbCrLf
str = str & " objRS.AbsolutePage = pageno" & VbCrLf & VbCrLf
str = str & " If objRS.eof Then" & VbCrLf
str = str & " response.write(""No Matching records Database is empty"")" & VbCrLf
str = str & " objRS.close" & VbCrLf
str = str & " Set objRS = nothing" & VbCrLf
str = str & " objConn.close" & VbCrLf
str = str & " Set objConn = nothing" & VbCrLf
str = str & " Else" & VbCrLf & VbCrLf
str = str & " response.write("""") & VbCrLf" & VbCrLf
str = str & " response.write(""ASPAlliance.com/mbrink1111/ "") & VbCrLf" & VbCrLf
str = str & " response.write(""This is page "" & pageno & "" of "") & VbCrLf" & VbCrLf
str = str & " response.write(intpages & "" pages - "" & intRecordCnt & "" Total Records, "") & VbCrLf" & VbCrLf
str = str & " response.write(pagesize & "" records per page.
"")" & VbCrLf
str = str & " response.write(""Click to select page: "") & VbCrLf" & VbCrLf
str = str & " For intPage = 1 to intpages" & VbCrLf& VbCrLf
str = str & " If intPage = intpages And CInt(intPage) = CInt(pageno) Then" & VbCrLf
str = str & " response.write("" "" & CInt(intPage) & "" "") & VbCrLf" & VbCrLf
str = str & " ElseIf intPage = intpages Then" & VbCrLf
str = str & " response.write(""""&intPage&"" "") & VbCrLf" & VbCrLf
str = str & " ElseIf CInt(intPage) = CInt(pageno) Then" & VbCrLf
str = str & " response.write("" "" & intPage & "" | "") & VbCrLf" & VbCrLf
str = str & " Else" & VbCrLf
str = str & " response.write(""""&intPage&"" | "") & VbCrLf" & VbCrLf
str = str & " End If" & VbCrLf & VbCrLf
str = str & " Next" & VbCrLf & VbCrLf
str = str & " response.write(""
"")" & VbCrLf
str = str & " response.write("""") & VbCrLf" & VbCrLf & VbCrLf
str = str & " For each x in objRS.Fields" & VbCrLf & VbCrLf
str = str & " response.write("""" & x.name & "" "") & VbCrLf" & VbCrLf & VbCrLf
str = str & " Next" & VbCrLf & VbCrLf
str = str & " response.write("" "") & VbCrLf" & VbCrLf & VbCrLf
str = str & " For intRecord = 1 to objRS.PageSize " & VbCrLf & VbCrLf
str = str & " Response.write("""") & VbCrLf" & VbCrLf
str = str & " for each x in objRS.Fields" & VbCrLf
str = str & " response.write("""" & x.value & "" "") & VbCrLf" & VbCrLf
str = str & " Next" & VbCrLf
str = str & " Response.write("" "") & VbCrLf" & VbCrLf
str = str & " objRS.MoveNext" & VbCrLf
str = str & " If objRS.EOF then exit for " & VbCrLf & VbCrLf
str = str & " Next" & VbCrLf & VbCrLf
str = str & " Response.write(""
"")" & VbCrLf & VbCrLf
str = str & " If CInt(pageno)> 1 Then" & VbCrLf
str = str & " response.write(""<< Previous "") & VbCrLf" & VbCrLf
str = str & " End If" & VbCrLf & VbCrLf
str = str & " response.write("" | "") & VbCrLf" & VbCrLf & VbCrLf
str = str & " If CInt(intpages) > CInt(pageno) Then" & VbCrLf
str = str & " response.write(""Next >>
"") & VbCrLf" & VbCrLf
str = str & " End If" & VbCrLf & VbCrLf
str = str & " objRS.Close" & VbCrLf
str = str & " set objRS = Nothing" & VbCrLf
str = str & " objConn.Close" & VbCrLf
str = str & " Set objConn = nothing" & VbCrLf & VbCrLf
str = str & "End If" & VbCrLf & VbCrLf
str = str & chr(37) & chr(62)
str = str & " BuildAccess Author: Michael Brinkley - mbrink1111@yahoo.com
" & VbCrLf
str = str & " "
Call writePage(fileName,str)
End Sub
Sub writePage(strFileName,str)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f, strPath, newFile
strPath = server.mappath(strFileName &".asp")
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(strPath)) Then
Response.write("")
Response.write("File already exists
")
Set fso = nothing
Exit Sub
Else
Set newFile = fso.CreateTextFile(strPath, True)
Set newFile = nothing
End If
Set f = fso.OpenTextFile(strPath, ForWriting, True)
f.Write str
f.Close
Set f = nothing
response.write("Here is your new page: ")
response.write(""&strFileName&" ")
response.write("
")
Set fso = nothing
End Sub
SUB PK_FKTable()
Dim strConn
Dim conntemp
Dim rsSchema
Dim PKT
Dim PKC
Dim FKT
Dim FKC
Const adSchemaForeignKeys = 27
response.write("
" & vbCrLf)
response.write("Primary Key Foreign Key " & vbCrLf)
response.write("PK Table PK Field FK Table FK Field " & vbCrLf)
connect()
objConn.open
set rsSchema = objConn.OpenSchema(adSchemaForeignKeys)
DO UNTIL rsSchema.eof
PKT = rsSchema.fields("PK_TABLE_NAME")
PKC = rsSchema.fields("PK_COLUMN_NAME")
FKT = rsSchema.fields("FK_TABLE_NAME")
FKC = rsSchema.fields("FK_COLUMN_NAME")
If PKT <> "" Then
response.write("" &PKT & " " & PKC & " " & FKT& " " & FKC & " " & vbCrLf)
End If
rsSchema.MoveNext
LOOP
response.write("
" & vbCrLf)
rsSchema.Close
set rsSchema = nothing
objConn.close
set objConn = nothing
END SUB
Sub clearQueries()
Dim argtxt
Dim whatnot
Dim counter
Dim strBox
For counter = 1 to request.cookies.count()
argtxt = Request.Cookies.Item(counter)
whatnot = Request.Cookies.Key(counter)
If argtxt <> "" Then
If instr(whatnot,"QOB")Then
If whatnot <> "" Then
Response.Cookies.Item(counter) = ""
End If
End If
End if
Next
response.cookies("isgood") = ""
End Sub
Function makeQueryOptionBox(strSQL,strAlias)
Dim argtxt
Dim whatnot
Dim counter
Dim strBox
' put alias and sql statement in cookie. the "QOB" acts as filter to keep other cookies out
response.cookies("QOB" & strAlias) = strSQL
' indicates if there are any saved querys
response.cookies("isgood") = "True"
strBox = "" & vbCrLf
For counter = 1 to request.cookies.count()
argtxt = Request.Cookies.Item(counter)
whatnot = Request.Cookies.Key(counter)
If argtxt <> "" Then
' filter the cookies
If instr(whatnot,"QOB")Then
' strip the filtering string - "QOB"
whatnot = replace(whatnot,"QOB","")
If whatnot <> "" Then
If argtxt = strSQL Then
strBox = strBox & ""&whatnot&" " & vbCrLf
Else
strBox = strBox & "" & whatnot & " " & vbCrLf
End If
End If
End If
End if
Next
strBox = strBox & " " & vbCrLf
strBox = strBox & " " & vbCrLf
If instr(strBox,"") > 3 Then
makeQueryOptionBox = strBox
Else
makeQueryOptionBox = ""
End If
End Function
Sub saveQuery(strSQL)
response.write("Pick an alias for your query " & vbCrLf)
response.write("
" & vbCrLf)
End Sub
Function createTableStatement()
Dim dbpath, noOfTables, strtablename, strSQLCreate, i, j, noOfColumns, strName,strType,strNull
Dim strSize, strPK, strFieldNames, strDBname,strDBlink, strUnique, fileName
strtablename = request(i & "tablename")
noOfColumns = request(i & "columnnumber")
strSQLCreate = "CREATE TABLE [" & strtablename & "]" & vbCrLf
For j = 1 to noOfColumns
strName = "[" & request("colum"&j) & "] "
strType = request("dtype"&j) & " "
If strType = "Text " Then
strSize = request("size"&j)
If Not IsNumeric(strSize) Then
strSize = ""
Else
If strSize > 255 Then
strSize = 255
End If
strSize = "(" & strSize & ") "
End If
End If
strNull = request("nullbox"&j)
If strNull = "DISALLOW NULL" then
strNull = " NOT NULL"
Else
strNull = ""
End If
strUnique = request("Unique"&j)
If strUnique <> "" then
strUnique = " UNIQUE"
End If
strPK = request("PK")
If len(strPK) > 2 Then
If CInt(right(strPK,instr(strPK,"PK"))) = j Then
strPK = " PRIMARY KEY"
Else
strPK = ""
End If
End If
If j = 1 Then
strSQLCreate = strSQLCreate & " (" & strName & strType & strSize & strNull & strUnique & strPK&", " & vbCrLf
ElseIf j = Cint(noOfColumns) Then
strSQLCreate = strSQLCreate & " " & strName & strType & strSize & strNull & strUnique & strPK& ") "
Else
strSQLCreate = strSQLCreate & " " & strName & strType & strSize & strNull & strUnique & strPK&", "& vbCrLf
End If
strSize = ""
Next
createTableStatement = strSQLCreate
End Function
Sub createTable()
%>
")
End Sub
Function recursive(strPath,blnSearchSubFolders)
On Error Resume Next
Dim objConn
Dim strdbpath
Dim objFileSysObject
Dim objParentFolder
Dim objSubFolder
Dim objFolder
Dim strBuildPath
Dim objFiles
Dim strTableName
Dim regEx
Dim retVal
Dim strSQL
strdbpath = server.mappath("master.mdb")
Set objConn=Server.CreateObject("ADODB.Connection")
objConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strdbpath & ";"
objConn.Open
Set objFileSysObject = CreateObject("Scripting.FileSystemObject")
Set objParentFolder = objFileSysObject.GetFolder(strPath)
Set objSubFolder = objParentFolder.SubFolders
For each objFiles in objParentFolder.Files
If UCase(right(objFiles.Name,4)) = ".MDB" Then
strBuildPath = strPath & "/"
strBuildPath = strBuildPath & objParentFolder.name
strTableName = objFiles.name & String(20 - Len(objFiles.name), "_") & FormatNumber(Int(objFiles.size) / 1000,0) & " K"
If instr(objFiles.path,"_vti_cnf") = 0 Then
strSQL = "insert into tables" & "(" & "db,dbname "
strSQL = strSQL & ")"
strSQL = strSQL & " values "
strSQL = strSQL & "('" & objFiles.path & "','" & strTableName &" ')"
objConn.Execute strSQL
End If
End If
Next
For Each objFolder in objSubFolder
If blnSearchSubFolders = "true" Then
strBuildPath = strPath & "/"
strBuildPath = strBuildPath & objFolder.name
Call recursive(strBuildPath,blnSearchSubFolders)
End If
Next
objConn.Close
Set objConn = Nothing
End Function
Sub findFolder()
' This Sub allows the user to navigate the file system and
' returns the folder to be searched by recursive.asp
Dim strFolderPath ' string to hold path to folder
Dim strSubFolder
Dim objFileSysObject
Dim objSysDriveObject
Dim strDriveLetter
Dim objSubFolder
Dim objDrive
Dim objFolder
Dim objFile
' On Error Resume Next
If request("selectdrive") = "Select Drive" Then
strSubFolder = ""
strFolderPath = request("drive") & ":/"
else
strSubFolder = request("folders")
End If
if strSubFolder & "x" <> "x" then
strSubFolder = strSubFolder & "\"
strFolderPath = strFolderPath & strSubFolder
end if
Set objFileSysObject = CreateObject("Scripting.FileSystemObject")
response.write("" & vbCrLf)
End If
If strFolderPath <> "" Then
Set objFolder = objFileSysObject.GetFolder(strFolderPath)
Set objSubFolder = objFolder.subfolders
If objSubFolder.count = 0 Then
response.write(" No more folders - Arm Photon Torpedos!" & vbCrLf)
Else
response.write("")
For Each objFile in objSubFolder
response.write("" & objFile.name & " " & vbCrLf)
Next
response.write(" " & vbCrLf)
response.write(" " & vbCrLf)
End If
response.write("" & vbCrLf)
response.write("
<%
End If
End Sub
%>