<%
Response.Write logState
'Response.Write " admin=" & Session("admin")
'Response.Write " enabled=" & Session("enabled") & " "
if isAdmin then
Response.Write " Sei loggato come amministratore"
%> <%
Dim Action 'as string
Dim myPath 'as string
Dim myDBName 'as string
'Obtention des variables
Action = Request.QueryString("Action")
myPath = Request.QueryString("Path")
myDBName = Request.QueryString("DBName")
If myPath = "" then myPath = Server.MapPath("_private")
If myDBName = "" then Action = "ListDBinDir"
'Affichage de la page selon Action
Select Case Action
Case "LogIn" : subDoLogIn
Case "ListDBinDir" subListDBinDirPage MyPath
Case "ViewDB" : subShowDBTablesPage MyPath, MyDBName
Case "AddTable" : 'available in version 2
Case "ViewTable" : subViewTablePage MyPath, MyDBName
Case "ModTable" : subModTablePage MyPath, MyDBName
Case "DelTable" : subDelTablePage MyPath, MyDBName
Case "AddRecord" : subAddRecordPage MyPath, MyDBName
Case "ModRecord" : subModRecordPage MyPath, MyDBName
Case "UpdateRecord" : subUpdateRecordPage MyPath, MyDBName
Case "DelRecord" : subDelRecordPage MyPath, MyDBName
Case Else : subListDBinDirPage MyPath
End Select
Response.End
'DO NOT CHANGE THE ABOVE CODE
'************************************************
'SUBS AND FUNCTIONS
'************************************************
' HiddenErrMsg(ValidationType, FieldName, ErrMsg)
' FormValidate()
' subCreateDB(DBpath, DBName)
' subCreateTable(DBPath, DBName, TableName)
' fncListTables(DBPath,DBName)
' fncListColumns(DBPath,DBName,TableName)
' subShowDBTablesPage(DBPath, DBName)
' subViewTablePage(DBPath, DBName)
' subModRecordPage(DBPath, DBName)
' subUpdateRecordPage(DBPath, DBName)
' subAddRecordPage(DBPath, DBName)
' subDelRecordPage(DBPath, DBName)
' subModTablePage (DBPath, DBName)
' subDelTablePage(DBPath, DBName)
' subListDBinDirPage(DBPath)
'************************************************
'---- DataTypeEnum Values ----
Const adEmpty = 0
Const adTinyInt = 16
Const adSmallInt = 2
Const adInteger = 3
Const adBigInt = 20
Const adUnsignedTinyInt = 17
Const adUnsignedSmallInt = 18
Const adUnsignedInt = 19
Const adUnsignedBigInt = 21
Const adSingle = 4
Const adDouble = 5
Const adCurrency = 6
Const adDecimal = 14
Const adNumeric = 131
Const adBoolean = 11
Const adError = 10
Const adUserDefined = 132
Const adVariant = 12
Const adIDispatch = 9
Const adIUnknown = 13
Const adGUID = 72
Const adDate = 7
Const adDBDate = 133
Const adDBTime = 134
Const adDBTimeStamp = 135
Const adBSTR = 8
Const adChar = 129
Const adVarChar = 200
Const adLongVarChar = 201
Const adWChar = 130
Const adVarWChar = 202
Const adLongVarWChar = 203
Const adBinary = 128
Const adVarBinary = 204
Const adLongVarBinary = 205
'Arrays (for new table structure)
Dim Cols(100) 'as string
Dim ColTypes(100) 'as integer
Dim ColLens(100) 'as integer
Dim Keys(10) 'as string
Dim KeyNames(10) 'as string
Sub HiddenErrMsg(ValidationType, FieldName, ErrMsg)
'Validation Types:
' r = Required
' i = Integer
' d = Date (MM/DD/YY)
' e = Email
Response.Write "" & vbCrLf
End Sub
Sub subCreateDB(DBpath, DBName)
Dim objADOXDatabase
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog")
objADOXDatabase.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath & "\" & DBName & ".mdb"
Set objADOXDatabase = Nothing
End Sub
Sub subCreateTable(DBPath, DBName, TableName)
Dim objADOXDatabase
Dim objTable
Dim i 'as integer
'Ouverture de l'objet Database
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog")
objADOXDatabase.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath & "\" & DBName & ".mdb"
'Ouverture de l'objet Table
Set objTable = Server.CreateObject("ADOX.Table")
'Nom de la table
objTable.Name = TableName
'Ajout des columns
For i = 0 to 100
If Cols(i) = "" then exit for
'Ajout selon le type de column
Select Case ColTypes(i)
Case adEmpty
Case adTinyInt
Case adSmallInt
Case adInteger : objTable.Columns.Append Cols(i), ColTypes(i)
Case adBigInt
Case adUnsignedTinyInt
Case adUnsignedSmallInt
Case adUnsignedInt
Case adUnsignedBigInt
Case adSingle
Case adDouble
Case adCurrency
Case adDecimal
Case adNumeric
Case adBoolean
Case adError
Case adUserDefined
Case adVariant
Case adIDispatch
Case adIUnknown
Case adGUID
Case adDate
Case adDBDate
Case adDBTime
Case adDBTimeStamp
Case adBSTR
Case adChar
Case adVarChar
Case adLongVarChar
Case adWChar
Case adVarWChar : objTable.Columns.Append Cols(i), ColTypes(i), ColLens(i)
Case adLongVarWChar
Case adBinary
Case adVarBinary
Case adLongVarBinary
End Select
Next
'Ajout des keys
For i = 0 to 10
If Keys(i) = "" then exit for
objTable.Keys.Append Keys(i), 1, KeyNames(i)
Next
'Ajout de la table
objADOXDatabase.Tables.Append objTable
'Close up !
Set objTable = Nothing
Set objADOXDatabase = Nothing
End Sub
Function fncListTables(DBPath,DBName)
Dim objADOXDatabase
Dim objTable
Dim myStr 'as string
myStr = ""
'Ouverture de la db
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog")
objADOXDatabase.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath & "\" & DBName & ".mdb"
For Each objTable in objADOXDatabase.Tables
'Only display user-created tables...
If objTable.Type = "TABLE" then
myStr = myStr & objTable.Name & ","
End If
Next
fncListTables = myStr
'Close up !
Set objTable = Nothing
Set objADOXDatabase = Nothing
End Function
Function fncListColumns(DBPath,DBName,TableName)
Dim objADOXDatabase
Dim objTable
Dim objColumn
Dim myStr 'as string
myStr = ""
'Ouverture de la db
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog")
objADOXDatabase.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath & "\" & DBName & ".mdb"
'Obtention des nom de columns
For Each objTable in objADOXDatabase.Tables
If objTable.Name = TableName then
For Each objColumn in objTable.Columns
myStr = myStr & objColumn.Name & ","
Next
Exit for
End If
Next
fncListColumns = myStr
'Close up !
Set objColumn = Nothing
Set objTable = Nothing
Set objADOXDatabase = Nothing
End Function
Sub subShowDBTablesPage(DBPath, DBName)
Dim TableList
Dim i 'as integer
Dim bolPair 'as boolean
If DBPath = "" then exit sub
If DBName = "" then exit sub
'En-tête
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Modifica il database degli utenti logon.mdb.
"
'Haut du tableau
Response.Write ""
End If
objRS.Close
'End With
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'SCRIPT POUR VALIDER MA FORM
FormValidate
'BAS DE PAGE
'CLOSE UP
objCN.Close
Set objRS = Nothing
Set objCN = Nothing
End Sub
Sub FormValidate()
%>
<%
End Sub
Sub subUpdateRecordPage(DBPath, DBName)
Dim TableName 'as string
Dim FieldName 'as string
Dim FieldValue 'as long
Dim objCN 'as adodb.connection
Dim objRS 'as adodb.recordset
Dim strSQL 'as string
Dim i 'as integer
Dim bolPair 'as boolean
'OBTENTION DES VARIABLES
TableName = Request.QueryString("TableName")
FieldName = Request.QueryString("FieldName")
FieldValue = Request.QueryString("FieldValue")
'EN-TÊTE
Response.Write "Access DB Manager"
Response.Write ""
Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Modifica gli utenti.
"
'CONSTRUCTION DE LA REQUÊTE SQL
strSQL = "SELECT * FROM " & TableName & " WHERE " & FieldName & "=" & FieldValue
'OUVERTURE DE LA CONNECTION
Set objCN = Server.CreateObject("ADODB.Connection")
objCN.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & DBPath & "\" & DBName & ".mdb"
Set objRS = Server.CreateObject("ADODB.Recordset")
'With objRS
objRS.Open strSQL, objCN, 3, 3
If objRS.EOF then
objRS.AddNew
Response.Write "
RECORD ADDED !
"
Else
Response.Write "
UPDATE DONE !
"
End If
'Début de la table confirmant les infos
Response.Write "
" & _
"
" & _
"
Field Name
" & _
"
Value
" & _
"
Field Type
"
bolPair = false
For i = 0 to (objRS.Fields.Count - 1)
'bgcolor
if bolPair then
Response.Write "
"
bolPair = false
else
Response.Write "
"
bolPair = true
end if
'Mise à jour du champ selon le type de champ
Select Case objRS.Fields(i).Type
Case adTinyInt
If objRS.Fields(i).Properties("ISAUTOINCREMENT") then
'Autonumber
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
AutoNumber
"
Else
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = cint(Request("my" & objRS.Fields(i).Name))
End If
'Affichage
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Tiny integer
"
End If
Case adSmallInt 'integer
If objRS.Fields(i).Properties("ISAUTOINCREMENT") then
'Autonumber
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
AutoNumber
"
Else
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = cint(Request("my" & objRS.Fields(i).Name))
End If
'Affichage
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Integer
"
End If
Case adInteger 'long
If objRS.Fields(i).Properties("ISAUTOINCREMENT") then
'Autonumber
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
AutoNumber
"
Else
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = clng(Request("my" & objRS.Fields(i).Name))
End If
'Affichage
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Long integer
"
End If
Case adBigInt
If objRS.Fields(i).Properties("ISAUTOINCREMENT") then
'Autonumber
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
AutoNumber
"
Else
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = (Request("my" & objRS.Fields(i).Name))
End If
'Affichage
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Big integer
"
End If
Case adChar
objRS.Fields(i).Value = (Request("my" & objRS.Fields(i).Name))
Response.Write "
"
Case adBoolean 'boolean
objRS.Fields(i).Value = (Request("my" & objRS.Fields(i).Name) = "TRUE")
If objRS.Fields(i) = True then
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
True
" & _
"
Boolean Value
"
Else
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
False
" & _
"
Boolean Value
"
End If
Case adDate 'date/heure
If isDate(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = cdate(Request("my" & objRS.Fields(i).Name))
End If
'Affichage
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Date/time
"
Case adSingle
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = csng(Request("my" & objRS.Fields(i).Name))
End If
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Single number
"
Case adDouble
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = cdbl(Request("my" & objRS.Fields(i).Name))
End If
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Double number
"
Case adCurrency 'currency
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = ccur(Request("my" & objRS.Fields(i).Name))
End If
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Currency number
"
Case adDecimal
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = (Request("my" & objRS.Fields(i).Name))
End If
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Decimal number
"
Case adNumeric
If isNumeric(Request("my" & objRS.Fields(i).Name)) then
'Mise à jour
objRS.Fields(i).Value = (Request("my" & objRS.Fields(i).Name))
End If
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Numeric number
"
Case else 'autres
Response.Write "
" & objRS.Fields(i).Name & "
" & _
"
" & objRS.Fields(i) & "
" & _
"
Other
"
End Select
Response.Write "
"
Next
'Fin de la table
Response.Write "
"
objRS.Update
objRS.Close
'End With
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'BAS DE PAGE
'CLOSE UP
objCN.Close
Set objRS = Nothing
Set objCN = Nothing
End Sub
Sub subAddRecordPage(DBPath, DBName)
Dim TableName 'as string
Dim FieldName 'as string
Dim objCN 'as adodb.connection
Dim objRS 'as adodb.recordset
Dim strSQL 'as string
Dim i 'as integer
Dim bolPair 'as boolean
'OBTENTION DES VARIABLES
TableName = Request.QueryString("TableName")
'EN-TÊTE
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Use this page to add, delete or revise an access database on this web site.
"
'CONSTRUCTION DE LA REQUÊTE SQL
strSQL = "SELECT * FROM " & TableName
'OUVERTURE DE LA CONNECTION
Set objCN = Server.CreateObject("ADODB.Connection")
objCN.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & DBPath & "\" & DBName & ".mdb"
Set objRS = Server.CreateObject("ADODB.Recordset")
'OBTENTION DU RECORDSET
'With objRS
objRS.Open strSQL, objCN, 3, 3
'objRS.AddNew
'Obtention de FieldName
For i = 0 to (objRS.Fields.count - 1)
If objRS.Fields(i).Properties("ISAUTOINCREMENT") then
FieldName = objRS.Fields(i).Name
Exit for
End if
Next
'Début du formulaire
Response.Write ""
objRS.Close
'End With
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'SCRIPT POUR VALIDER MA FORM
FormValidate
'BAS DE PAGE
'CLOSE UP
objCN.Close
Set objRS = Nothing
Set objCN = Nothing
End Sub
Sub subDelRecordPage(DBPath, DBName)
Dim TableName 'as string
Dim FieldName 'as string
Dim FieldValue 'as string
Dim DelNow 'as boolean
Dim objCN 'as adodb.connection
Dim objRS 'as adodb.recordset
Dim strSQL 'as string
Dim i 'as integer
Dim bolPair 'as boolean
'OBTENTION DES VARIABLES
TableName = Request.QueryString("TableName")
FieldName = Request.QueryString("FieldName")
FieldValue = Request.QueryString("FieldValue")
DelNow = (Request("DelNow") = "TRUE")
'OUVERTURE DE LA CONNECTION
Set objCN = Server.CreateObject("ADODB.Connection")
objCN.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & DBPath & "\" & DBName & ".mdb"
Set objRS = Server.CreateObject("ADODB.Recordset")
If DelNow then
'Supprimer maintenant
strSQL = "DELETE FROM " & TableName & " WHERE " & FieldName & "=" & FieldValue
objCN.Execute strSQL
objCN.Close
set objRS = Nothing
set objCN = Nothing
Response.redirect "DBmanager.asp?Action=ViewTable&Path=" & Server.UrlEncode(DBPath) & "&DBName=" & Server.UrlEncode(DBName) & "&TableName=" & Server.UrlEncode(TableName)
End If
'CONSTRUCTION DE LA REQUÊTE SQL
strSQL = "SELECT * FROM " & TableName & " WHERE " & FieldName & "=" & FieldValue
'EN-TÊTE
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Use this page to add, delete or revise an access database on this web site.
"
'OBTENTION DU RECORDSET
'With objRS
objRS.Open strSQL, objCN, 0, 1
'Début du formulaire
Response.Write ""
objRS.Close
'End With
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'SCRIPT POUR VALIDER MA FORM
FormValidate
'BAS DE PAGE
'CLOSE UP
objCN.Close
Set objRS = Nothing
Set objCN = Nothing
End Sub
Sub subModTablePage (DBPath, DBName)
Dim TableName 'as string
Dim objADOXDatabase
Dim bolPair 'as boolean
Dim UpdateNow 'as boolean
Dim ColName 'as string
'OBTENTION DES VARIABLES
TableName = Request.QueryString("TableName")
UpdateNow = (Request("UpdateNow") = "TRUE")
'EN-TÊTE
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Use this page to add, delete or revise an access database on this web site.
"
'Message d'avertissement
Response.Write "
Please note : On this version, you can't change Type, Length, AutoNum and Null properties.
"
'Début du formulaire
Response.Write "
"
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'SCRIPT POUR VALIDER MA FORM
FormValidate
'BAS DE PAGE
'Close up !
Set objADOXDatabase = Nothing
End Sub
Sub subDelTablePage(DBPath, DBName)
Dim TableName 'as string
Dim DelNow 'as boolean
Dim objADOXDatabase
Dim objCN 'as adodb.connection
Dim strSQL 'as string
Dim i 'as integer
Dim bolPair 'as boolean
'OBTENTION DES VARIABLES
TableName = Request.QueryString("TableName")
DelNow = (Request("DelNow") = "TRUE")
'Ouverture de la db
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog")
objADOXDatabase.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath & "\" & DBName & ".mdb"
If DelNow then
'Supprimer le contenu
Set objCN = Server.CreateObject("ADODB.Connection")
objCN.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & DBPath & "\" & DBName & ".mdb"
strSQL = "DELETE FROM " & TableName
objCN.Execute strSQL
objCN.Close
set objCN = Nothing
'Supprimer le contenant
objADOXDatabase.Tables(Tablename).Delete
Set objADOXDatabase = Nothing
Response.redirect "DBmanager.asp"
End If
'EN-TÊTE
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBName &" (" & DBPath & "\" & DBName & ".mdb)
Use this page to add, delete or revise an access database on this web site.
"
'DÉBUT DU FORMULAIRE
Response.Write ""
'LINK POUR AJOUT ET RETOUR AU MENU PRINCIPAL
Response.Write "
"
'BAS DE PAGE
'CLOSE UP
Set objADOXDatabase = Nothing
End Sub
Sub subListDBinDirPage(DBPath)
Dim objFSO 'as object
Dim objFolder 'as object
Dim objSubFolder 'as object
Dim objFile 'as object
Dim bolPair 'as boolean
dim ParentDir 'as string
' if no directory was submitted, use the current folder
If DBPath = "" Then DBPath = Server.MapPath(".")
' create file I/O objects
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(DBPath)
'En-tête
Response.Write "Access DB Manager"
Response.Write ""
'Response.Write "
" & DBPath &"
Use this page to add, delete or revise an access database on this web site.
"
'Bas du tableau
Response.Write " "
'Haut du tableau
Response.Write "
" & _
"
" & _
"
DATABASE UTENTI entra per gestire
"
'Obtention des fichier .MDB du path actuel
bolPair = false
For Each objFile In objFolder.Files
If right(objFile.Name,3) = "mdb" then
If bolPair then
Response.Write "