不通过数据源完全控制MDB数据库

<%

begin user constants

to just use a dsn, the format is shown on the next line:

const dsn_name = "dsn=asp101email"

two other samples i used it with.  left in as syntax examples for dsn-less connections

const dsn_name = "dbq=c:inetpubwwwroot101samplesdatabase.mdb;driver={microsoft access driver (*.mdb)};driverid=25"

const dsn_name = "dbq=c:inetpubdatabasedonations.mdb;driver={microsoft access driver (*.mdb)};driverid=25"

 

dim dsn_name

dsn_name = "dbq=" & server.mappath("db_dsn.mdb") & ";driver={microsoft access driver (*.mdb)};driverid=25;"

const dsn_user = "username"

const dsn_pass = "password"

ok, i know these are poorly named constants, so sue me!

this script can be used without actually setting up a dsn, so

dsn_name as well as the other two constants should really be named

something more generic like connection_string, connection_user, and

connection_pass, but i did it this way without really thinking about

it and im too lazy to change it now.  if it bothers you, you do it!

end user constants

 

begin subs & functions section

sub openconnection

set objdc = server.createobject("adodb.connection")

objdc.connectiontimeout = 15

objdc.commandtimeout = 30

objdc.open dsn_name, dsn_user, dsn_pass

end sub

 

sub openrecordset(stype)

dim ssqlstring as string - building area for sql query

dim scritoperator as string - basically "=" or "like"

dim scritdelimiter as string - parameter delimiter "", "", or "#"

 

set objrs = server.createobject("adodb.recordset")

select case stype

case "listtables" open rs of the tables in the db

set objrs = objdc.openschema(adschematables)

case "viewtable"  open the selected table

set objrs = server.createobject("adodb.recordset")

objrs.open "[" & stablename & "]", objdc, adopenforwardonly, adlockreadonly

case "drilldown"  open the recordset built by the selected options

set objrs = server.createobject("adodb.recordset")

 

build our sql statement

ssqlstring = "select * from [" & stablename & "]"

 

if were limiting records returned - insert the where clause into the sql

if scritfield <> "" then

figure out if were dealinh with numeric, date, or string values

select case icritdatatype

case adsmallint, adinteger, adsingle, addouble, addecimal, adtinyint, adunsignedtinyint, adunsignedsmallint, adunsignedint, adbigint, adunsignedbigint, adbinary, adnumeric, advarbinary, adlongvarbinary, adcurrency, adboolean

scritoperator = "="

scritdelimiter = ""

case addate, addbdate, addbtime, addbtimestamp

scritoperator = "="

scritdelimiter = "#"

case adbstr, adchar, adwchar, advarchar, adlongvarchar, advarwchar, adlongvarwchar

scritoperator = "like"

scritdelimiter = ""

end select

ssqlstring = ssqlstring & " where [" & scritfield & "] " & scritoperator & " " & scritdelimiter & scritvalue & scritdelimiter

end if

 

if were sorting - insert the order by clause

if ssortorder <> "none" then

ssqlstring = ssqlstring & " order by [" & ssortfield & "] " & ssortorder

end if

 

ssqlstring = ssqlstring & ";"

 

open the actual recordset using a forward only cursor in read only mode

objrs.open ssqlstring, objdc, adopenforwardonly, adlockreadonly

end select

end sub

 

sub closerecordset

objrs.close

set objrs = nothing

end sub

 

sub closeconnection

objdc.close

set objdc = nothing

end sub

 

sub writetitle(stitle)

response.write "<h2>" & stitle & "</h2>" & vbcrlf

end sub

 

sub writetableheader

response.write "<table border=1>" & vbcrlf

end sub

 

sub writetablerowopen

response.write "<tr>" & vbcrlf

end sub

 

sub writetablecell(bcellistitle, scontents)

response.write vbtab & "<td>"

if bcellistitle then response.write "<b>"

response.write scontents

if bcellistitle then response.write "</b>"

response.write "</td>" & vbcrlf

end sub

 

sub writetablerowclose

response.write "</tr>" & vbcrlf

end sub

 

sub writetablefooter

response.write "</table>" & vbcrlf

end sub

end subs & functions section

begin runtime code

  before i start with the run-time code, let me clear up a few things.

  ive tried (and succeeded i think!) to keep all the actual html

  formatting contained within subs.  hence things should be relatively

  consistent as well as being easy to change if you say want a larger

  border or perhaps a table background color or whatever...

  this, along with my attempts to try and keep my sanity, have resulted

  in a rather large proportion of sub/function calls to actual code.

  since im sure this is probably confusing to many newcomers to asp

  and/or vb, ive attempted to preface each call with the optional

  call command.  also any sub or function whose name starts with the

  word "write" is basically just an encapsulation of some variation of

  a response.write command, while the remainder of the name represents

  whatever it happens to write.

     ie. writetablerowclose writes the tags used to end (or close) a table row

  the actual html is (as usual) pretty vanilla flavored.  if you want

  rocky-road or mint ting-a-ling (a marvelous piece of ice cream

  craftsmanship i might add), youll need to edit the write functions.

  just be aware of the fact that any change to a sub will affect all

  uses of it, so check the code before you try and make a change to

  just one cell and end up changing them all!

  okay enough of my rambling......onwards to the code!!!

 

dim objdc, objrs dataconnection and recordset

dim i as integer - standard looping var

dim strtemp as string - temporary area for building long strings

 

dim saction as string - action string to choose what to do

dim stablename as string - ...so we know what to do it to

dim ssortfield as string - field to sort by

dim ssortorder as string - ...asc or desc

dim scritfield as string - field for drilldown

dim scritvalue as string - ...value to compare to

dim icritdatatype as integer - so we know how to compare

note to all you programmers out there!

ie4 broke this code when my querystring was named parameter because

it was conv