# Example 1: Creating an instance of the Connection object and returning a
# recordset that is looped until end of file.
<%@language=PerlScript%>
<%
my $SQL = "SELECT * FROM Members";
my $Connection = $Server->CreateObject("ADODB.Connection");
my $Result = $Connection->Execute($SQL);
# List all ID's while Result is not equal to end of file
while(!$Result->eof) {
$Response->Write($Result->Fields("ID")->{'Value'});
$Result->movenext;
}
# Close the objects
$Result->Close;
$Connection->Close;
%>
Figure 4 Using the $_ Variable
#: Case-switch string-matching of the value in the $_-variable
$_ = $Request->QueryString(Action)->Item;
CASE: {
/Add/ && do {
… perform this block of code …
last CASE;
};
/Delete/ && do {
… perform this block of code …
last CASE;
};
/Modify/ && do {
… perform this block of code …
last CASE;
};
}
Figure 5 Using $Recordset
# Example 1: Looping a recordset and printing the fields by
# name-lookup in array @Fld
Pseudocode:
… Open a Connection and Execute "SELECT * FROM table" to get all fields …
… Iterate the fields-collection and store the names in the array Fld …
End Pseudocode;
# Next we need to move back to the first set in our records
# because we had to loop one record to get the Field-names
$Recordset->movefirst;
# Loop the recordset until end of file is reached
while(!$Recordset->eof) {
# For each element in the array field, write out the
# associated value in the recordset
for(@Fld) {
$Response->Write($Recordset->Fields($_)->{'Value'});
}
$Recordset->movenext;
}
# … Close objects …
Figure 6 default.asp
<%@Language=PerlScript%><%
#================================================================================
# Name: Default.asp
# Description: Allow user to enter name of System DSN and database table to open
#================================================================================
# The following code is executed if data is present in the QueryString.
# (i.e. a variable was passed with the QueryString)
if( $Request->QueryString->Item )
{
# Set the name of a DSN and TABLE, plus a Connection object in the
# contents-collection of the Session-object.
#
# Not recommended for a site with 50,000 hits per hour since it
# would be a lot of wasted bytes, cycles, and connections. But for
# an application that is made only with this in mind, we can do it
# with no remorse.
$Session->Contents->SetProperty('Item', 'DSN',
$Request->QueryString('DSN')->Item);
$Session->Contents->SetProperty('Item', 'TABLE',
$Request->QueryString('TABLE')->Item);
$Session->Contents->SetProperty('Item', 'Conn',
$Server->CreateObject('ADODB.Connection'));
# Call the method "open" of the connection object; note that both the
# parameter(DSN) and connection-object are in the session-object.
$Session->Contents('Conn')->Open( $Session->Contents('DSN') );
# Error-check. If state of connection is not true(1), we do not have a
# connection.
if($Session->Contents('Conn')->{'State'} == 1) {
# Create a recordset so that we can take the fieldnames.
my $RecordSet = $Session->Contents('Conn')->Execute(
$Session->Contents('TABLE') );
# Not a recordset?
if(!$RecordSet) {
$Response->Write("<CENTER>Wrong tablename? No records found.
</CENTER>");
}
# Use the count-property to count the number of fields, and
# then get each field by name and store in an array names
# Fields.
else {
for( $i=0, $m=$RecordSet->Fields->{'Count'}; $i<$m; $i++ ) {
$Fields[$i] = $RecordSet->Fields($i)->{'Name'};
}
# Store in the session-object the max-number of fields and a
# reference to the Fields array. Then redirect to the
# controlpanel.
$Session->Contents->SetProperty('Item', 'MAX', $m);
$Session->Contents->SetProperty('Item', 'FLD', \@Fields);
$Response->Redirect("controlpanel.asp");
}
}
# This is what is printed if the state-property was not equal to 1
else {
$Response->Write("<CENTER>Could not create a database session.
Does the DSN exist?</CENTER>");
}
# End the whole if-thing.
}
%>
<TITLE>Database Administrator - Perlscript/Activeserverpages - Login systemDSN
</TITLE>
<FORM ACTION = "default.asp" METHOD = GET>
<TABLE WIDTH="100%" HEIGHT="100%">
<TR>
<TD WIDTH="100%" HEIGHT="100%" ALIGN="CENTER" VALIGN="MIDDLE">
<TABLE>
<TR><TD WIDTH=100>SystemDSN:</TD><TD WIDTH=100>
<input type="textfield" Name="DSN"> </TD></TR>
<TR><TD WIDTH=100>Table: </TD><TD WIDTH=100>
<input type="textfield" Name="TABLE"> </TD></TR>
<TR><TD COLSPAN=2 ALIGN="center">
<input type="submit" value="Open Database"> </TD></TR>
</TABLE>
</TD>
</TR>
</TABLE>
</FORM>
Figure 7 controlpanel.asp
<!--#include virtual="/mind/perlscript.inc"-->
<FORM ACTION="controlpanel.asp" METHOD="GET">
<TABLE WIDTH="80%" BORDER="0" CELLSPACING="1" CELLPADDING="3" ALIGN="CENTER">
<TR>
<TD COLSPAN=4 BGCOLOR="BLACK" ALIGN="CENTER">
<%=$head%>Database Information </TD></TR><TR>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%>Working Location: </TD>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%>
<%=$Session->Contents('DSN')%> </TD></TR><TR>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%>Current Table: </TD>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%>
<%=$Session->Contents('TABLE')%> </TD></TR><TR>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%>Available Fields: </TD>
<TD colspan=2 bgcolor=<%=$bg%>><%=$font%><%
for( @{$Session->Contents('FLD')} ) {
$Response->write("$_ ");
}
%></TD></TR><TR>
<TD COLSPAN=4 BGCOLOR="BLACK" ALIGN="CENTER">
<%=$head%>Database Administration</TD></TR><tr>
<TD bgcolor=<%=$bg%>><%=$font%>Create Table: </TD>
<TD bgcolor=<%=$bg%>>
<input type="textfield" name="createtable" size=25></TD>
<TD bgcolor=<%=$bg%>>
<font face=verdana,arial size=-1 color=white><B>Fields:</B>
</FONT>
<input type="textfield" size=2 maxlength="2" name="tablefields"></TD>
<TD bgcolor=<%=$bg%> align=center>
<input type="submit" name="admin" value="Create Table"></TD></TR><TR>
<TD bgcolor=<%=$bg%>><%=$font%>Delete Table:</TD>
<TD colspan=2 bgcolor=<%=$bg%>>
<input type="textfield" name="deletetable" size=25></TD>
<TD bgcolor=<%=$bg%> align=center>
<input type="submit" name="admin" value="Delete Table"></TD>
</TR><TR>
<TD COLSPAN=4 BGCOLOR="BLACK" ALIGN="CENTER"><%=$head%>
Table Administration</TD></TR><tr>
<TD bgcolor=<%=$bg%>><%=$font%>Available Entries:</TD>
<TD colspan=2 bgcolor=<%=$bg%>>
<SELECT NAME="Field_ID">
<%=$FIELD_ID=$Request->QueryString("Field_ID")->Item%>
<option selected value=<%=$FIELD_ID%>><%=$FIELD_ID%><%
# Create the drop-down selection menu
$Recordset->MoveFirst;
while(!$Recordset->EOF) { %>
<OPTION VALUE=<%=$Recordset->Fields(0)->Item%>>
<%=$Recordset->Fields(1)->Item%>
</OPTION><%
$Recordset->movenext;
}
%>
</SELECT>
</TD>
<TD align=center bgcolor=<%=$bg%>>
<input type="submit" name="admin" value="View Entry"></TD>
</TD>
</tr>
<TD COLSPAN=4 BGCOLOR="BLACK" ALIGN="center"><%=$head%>Current Selection.
<%="ID: ".$Recordset->Fields(0)->{'Value'}%></TD></TR><TR>
<%
# The filter-property is applied to filter out a selected ID if there was one.
# The database happened to sort by the ID. :)
if($Filter) {
$Recordset->{'Filter'} = "ID=$Filter";
}
# Loop the Fields array of the contents-collection to display the values
# of the current record
for( @{$Session->Contents('FLD')} ) {
my $value=$Recordset->Fields($_)->{'Value'};
%>
<TD bgcolor="<%=$bg%>"><%=$font%>
<%="$_:"%></TD>
<TD colspan=3 bgcolor="<%=$bg%>">
<%="<input type=textfield name=$_ value=$value>"%>
</TD></TR><TR>
<%
}
%>
<TD COLSPAN=4 BGCOLOR="BLACK" ALIGN="center">
<input type="submit" name="admin" value="Add Entry">
<input type="submit" name="admin" value="Delete Entry">
<input type="submit" name="admin" value="Modify Entry">
</TD>
</TR>
</table>
</FORM>
<%
$Recordset->Close;
%>
Figure 8 tablemaker.asp
<%@Language=Perlscript%><%
#========================================================================================================
# tablemaker.asp
#
# Specifications for the new table; name, fields, fieldtypes. Limit to the
# fieldtypes by Integer and char (80). However, adding more types is only
# to add more checkboxes.
#========================================================================================================
# Background color for tablecells and some font-specifications
my $bg = '#C00000';
my $font = '<font face="verdana,arial" size="-1" color="white"><B>';
my $head = '<font face="verdana,arial" color="white"><B>';
# Name of table to create, and number of fields for the table
my $table_name = $Request->Querystring("createtable")->Item;
my $table_number = $Request->Querystring("tablefields")->Item();
# If table_number is equal to anything but digits, we message our request.
# Else, launch the program.
if($table_number =~ /\D/) {
$Response->Write("You must enter number");
}
else {
%>
<TITLE> Create a Table </TITLE>
<FORM ACTION="generate_tables.asp" METHOD=GET>
<TABLE width=80% ALIGN="CENTER" cellspacing=0 cellpadding=3>
<TR>
<TD COLSPAN=3 BGCOLOR="BLACK" ALIGN="CENTER"><%=$head%>
Create a new table in DSN: <%=$Session->Contents('DSN')%>
</TD>
</TR>
<TR>
<TD BGCOLOR=<%=$bg%> COLSPAN=3 ALIGN="CENTER">
<font face=arial size=-1 color="white">
<B>Tablename:
<input type="textfield" name="createtable" value=<%=$table_name%>>
</B>
</td>
</TR>
<TD COLSPAN=3 BGCOLOR="#000000" ALIGN="CENTER">
<%=$head%>Set Fieldname and Fieldtype:</B></TD>
</TR>
<%
for($a=0; $a<$table_number; $a++)
{
%>
<TR>
<TD WIDTH=150 BGCOLOR=#C00000><font face=arial size=-1 color=white>
FieldName:</TD>
<TD WIDTH=150 BGCOLOR=#C00000><font face=arial size=-1 color=white>
<input type=textfield name="<%=$a%>"></TD>
<TD WIDTH=250 BGCOLOR=#C00000><font face=arial size=-1 color=white>
Text <input type=checkbox value="CHAR(80)" name="<%=$a%>">
Integer <input type=checkbox value="INTEGER" name="<%=$a%>">
</TD>
</TR>
<%
}
%>
<TR>
<TD COLSPAN="3" ALIGN="MIDDLE" BGCOLOR="Black">
<input type=submit value="Create the table">
</TD>
</TR>
</TABLE>
</FORM>
<%
}
%>
Figure 9 generate_tables.asp
<%@Language=PerlScript%><%
#========================================================================================================
# generate_tables.asp
#
# Does the actual creating of a table.
#========================================================================================================
# Maxfields is each value in the querystring minus the tablename.
my $Maxfields = ( $Request->QueryString->{'Count'} - 1 );
my @QueryString = GetQueryString();
my $Table_Name = shift @QueryString;
# Start putting the layout for the new table together in a quick and dirty way
for ( $i=0; $i<=$Maxfields; $i++ ) {
if($QueryString[$i]) {
$Layout.="$QueryString[$i],";
}
}
# Quick and dirty ways leave a mess, so chop off the trailing comma
chop $Layout;
# Execute a CREATE TABLE statement so the new table is placed
$Session->Contents('Conn')->Execute("CREATE TABLE $Table_Name ($Layout)");
# Redirect the browser back to the controlpanel
$Response->Redirect("controlpanel.asp");
#========================================================================================================
# Name: GetQueryString
#
# Get the values in the querystring and chop off the commas that become in the
# variable collection of the querystring due to name-sharing. When finished,
# return the array @qs (short for querystring)
#========================================================================================================
sub GetQueryString
{
my $c=0;
foreach my $i ( Win32::OLE::in($Request->QueryString) ) {
$qs[$c] = $Request->QueryString($i)->Item;
$qs[$c] =~ s/\,//;
$c++;
}
return @qs;
}
%>
Figure 10 perlscript.inc
<%@Language=PerlScript%><%
#========================================================================================================
# Perlscript.inc
#
# Include file with responses to the requested actions. Container of
# SQL-statements, and prepares strings for each SQL-statement.
#========================================================================================================
# Background color for table cells and font specifications
my $bg = '#C000000';
my $font = '<font face="Verdana, Arial" size="-1" color="White"><B>';
my $head = '<font face="Verdana, Arial" color="White"><B>';
# ID: Possible variable passed with the querystring, used when modifying and
# deleting entries.
# TABLE: The table-name stored in the session. Just put in here to make the
# SQL-statements more readable.
# STRINGS: Preparation of strings before they are used in the SQL-statements.
my $ID = int($Request->QueryString("ID")->Item);
my $Table = $Session->Contents('TABLE');
my @STRINGS = prepare_strings();
# Get the admin-variable and see what it was requested of the program to do.
# Store its value in the $_ variable and do a switch-case string matching
# operation.
$_ = $Request->QueryString("admin")->Item;
CASE:
{
/Create Table/ && do {
$Response->Redirect(
"Tablemaker.asp?".$Request->QueryString->Item() );
};
/Delete Table/ && do {
$Session->Contents('Conn')->Execute(
"DROP TABLE ".$Request->QueryString("deletetable")->Item);
};
/Add Entry/ && do {
$Session->Contents('Conn')->Execute("INSERT INTO $Table ($STRINGS[0])
VALUES ($STRINGS[1])");
};
/Delete Entry/ && do {
$Session->Contents('Conn')->Execute(
"DELETE FROM $Table WHERE ID=$ID");
};
/Modify Entry/ && do {
$Session->Contents('Conn')->Execute("UPDATE $Table SET $STRINGS[2]
WHERE ID=$ID");
};
/View Entry/ && do {
$Filter = int($Request->QueryString("Field_ID")->Item);
};
}
# Either way it goes, we execute the same recordset command. This recordset
# could be stored in a session-variable too, but the methods of the recordset
# would take the fun out of SQL.
my $Recordset=$Session->Contents('Conn')->Execute(
$Session->Contents('TABLE') );
#========================================================================================================
# Name: prepare_strings
# Description: Quick and dirty! In SQL all text-based entries should be
# enclosed by single quotes and numeric entries. (fields) should not, so in very
# general terms everything that has anything but digits is enclosed by single
# quotation marks and everything else is not. That is what this subroutine takes
# care of! It prepares the strings. In the real world, this is not an ideal way to
# do it, but in the real world it is more likely that you know your database
# fieldtypes and do not need to make this check. :)
#
# In either case, FORM is the form values passed with the request, and COMBO is
# "FIELD='FORMVALUE'". FIELDS are the fieldnames. Quick and dirty is the keyword,
# so with "chop" we cut off the trailing commas, then return it in the form of an
# array rather than separate strings; the result from that is readability and
# less typing.
#========================================================================================================
sub prepare_strings
{
for($i=1; $i<$Session->Contents('MAX'); $i++) {
my ($Active_Field, $Active_Elmnt) = ($Session->Contents('FLD')->[$i],
$Request->QueryString( $Session->Contents('FLD')->[$i] )->Item);
$FIELDS .= "$Active_Field,";
if( $Active_Elmnt =~ /\D/ ) {
$FORM .= "'$Active_Elmnt',";
$COMBO .= "$Active_Field='$Active_Elmnt',";
}
else {
$FORM .= "$Active_Elmnt,";
$COMBO .= "$Active_Field=$Active_Elmnt,";
}
}
chop $FIELDS;
chop $FORM;
chop $COMBO;
return @Prepared_strings = ($FIELDS, $FORM, $COMBO);
}
%>