Please be aware of the latest fixes as described below. Source
code is also below for latest beta release 1.2 (July 9, 1999).
Feedback(i.e. suggestions, bug reports) appreciated. send to
[EMAIL PROTECTED] Many Thanks. If you do not see
END SCRIPT at the bottom of this message, then it was
truncated, in which case, please request source from email
address shown above.
Beta 1.2 - Last column in query was not being shown for each row.
Column headings were not cleared from previous query.
Added a Listbox for selecting DSN at program startup.
Added a check for the ability of the ODBC driver to
supply row numbers. Aborts if it does not. Submit a
query to find out.
Beta 1.1 - Added RichEdit control for entering an SQL query on
the fly instead of reading in an SQL query statement
from a textfile. Added additional navigation besides:
Next, Prev. Added: First, Last, and Goto functionality.
Beta 1.0 - N/A
#---------------------------------------------------------------------
# Name: dbscrollgrid.pl
#
# Version: Beta 1.2 (b1.2) July 9, 1999
#
# Purpose: Database Scroll Cursor Grid (Perl Win32::ODBC,GUI)
#
# Author: Eric Hansen, Copyright 1999, Information
# Technology Services, Inc. Dallas, TX
#
# Contact: [EMAIL PROTECTED]
#
# Description: User selects an available DataSourceName to connect to.
# User enters an SQL query statement and clicks a button
# to submit the query. The query returns the first 100
# rows, which are loaded to the ListView control for
# browsing. The user can then use the: First,Next,Prev,
# Goto, and Last buttons to display other rows in the
# result set (not currently shown in the ListView), or
# the user can enter another SQL query statement and
# submit it.
#
# Required: Your ODBC driver must support scrolling cursors.
# You may need to configure your DSN to enable scrolling
# cursors.
# i.e. Informix Driver has a checkbox you must check
# to enable scrolling cursors.
# Your ODBC driver must return rows numbers from a query.
# Note: you may need to submit a query to find out.
# You must have installed the Perl Win32::GUI package.
#---------------------------------------------------------------------
# Bug Fixes &
# Enhancements:
#
# Beta 1.2 - Last column in query was not being shown for each row.
# Column headings were not cleared from previous query.
# Added a Listbox for selecting DSN at program startup.
# Added a check for the ability of the ODBC driver to
# supply row numbers. Aborts if it does not. Submit a
# query to find out.
# Beta 1.1 - Added RichEdit control for entering an SQL query on
# the fly instead of reading in an SQL query statement
# from a textfile. Added additional navigation besides:
# Next, Prev. Added: First, Last, and Goto functionality.
# Beta 1.0 - N/A
######################################################################
use Win32::GUI;
use Win32::ODBC;
# Hide the Dos Window
($DOShwnd, $DOShinstance) = GUI::GetPerlWindow();
GUI::Hide($DOShwnd);
$Font = new GUI::Font(
-name => "Tahoma",
-size => 8,
-weight => 700,
-height => -11,
);
#------------------------#
# FIRST DIALOG BOX #
#------------------------#
$W = new GUI::DialogBox(
-name => "Window",
-font => $Font,
-text => "dbscrollgrid.pl (b1.2) - Database Scroll Grid (Win32::ODBC,Win32::GUI)",
-width => 700,
-height => 550,
-left => 50,
-top => 15,
);
$Status = new GUI::StatusBar($W,
-font => $Font,
-width => $W->ScaleWidth,
);
$LV = new GUI::ListView($W,
-name => "ListView",
-font => $Font,
-left => 10,
-top => 10,
-group => 1,
-tabstop => 1,
-width => $W->ScaleWidth-20,
-height => $W->ScaleHeight-140,
);
$LV->TextColor(hex("0000FF")); # red
$LV->View(1); # detailed listing
$LV->Disable();
$LV->Hide();
$LB = new GUI::Listbox($W,
-name => "ListBox",
-font => $Font,
-style => WS_CHILD | WS_VISIBLE | WS_VSCROLL | 1,
-left => 10,
-top => 10,
-foreground => 0x0000FF, # red
-height => ($W->ScaleHeight-15)-$Status->Height,
-width => $W->ScaleWidth-20,
);
$First = $W->AddButton(-name => "First",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "First",
-width => 45,
-height => 18,
-left => 15,
-top => 404,
);
$First->Disable();
$First->Hide();
$Prev = $W->AddButton(-name => "Prev",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "Prev",
-width => 45,
-height => 18,
-left => 15,
-top => 424,
);
$Prev->Disable();
$Prev->Hide();
$Next = $W->AddButton(-name => "Next",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "Next",
-width => 45,
-height => 18,
-left => 15,
-top => 444,
);
$Next->Disable();
$Next->Hide();
$Goto = $W->AddButton(-name => "Goto",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "Goto",
-width => 45,
-height => 18,
-left => 15,
-top => 464,
);
$Goto->Disable();
$Goto->Hide();
$Last = $W->AddButton(-name => "Last",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "Last",
-width => 45,
-height => 18,
-left => 15,
-top => 484,
);
$Last->Disable();
$Last->Hide();
$SqlText = $W->AddRichEdit(-name => "SqlText",
-text => "Enter an SQL Statement here, then click 'Go Sql'",
-font => $Font,
-group => 1,
-tabstop => 1,
-width => 560,
-height => 100,
-left => 70,
-style => WS_VISIBLE | ES_MULTILINE | WS_TABSTOP,
-top => 402,
);
$SqlText->SendMessage(197, 1024, 0); # limit to 1024 character input
$SqlText->Disable();
$SqlText->Hide();
$SqlGo = $W->AddButton(-name => "SqlGo",
-font => $Font,
-group => 1,
-tabstop => 1,
-text => "Go Sql",
-width => 45,
-height => 18,
-left => 635,
-top => 440,
);
$SqlGo->Disable();
$SqlGo->Hide();
#------------------------#
# SECOND DIALOG BOX #
#------------------------#
$W2 = new GUI::DialogBox(
-owner => $W1,
-name => "Window2",
-font => $Font,
-text => "Enter a Row Number to Goto",
-width => 235,
-height => 150,
-style => ws_sysmenu,
-left => 300,
-top => 200,
);
$W2->Disable();
$W2->Hide();
$GotoBox = $W2->AddTextfield(-name => "GotoBox",
-font => $Font,
-width => 60,
-height => 20,
-group => 1,
-tabstop => 1,
-background => [255,255,255],
-foreground => [80,80,255],
-left => 65,
-top => 50,
);
$GotoBox->SendMessage(197, 7, 0); # limit to 7 character input
$OK = $W2->AddButton(-name => "OK",
-text => "OK",
-font => $Font,
-group => 1,
-tabstop => 1,
-width => 25,
-height => 18,
-left => 135,
-top => 50,
);
#----------------------------#
# Window Dialog
#----------------------------#
$W->Show;
Load_DSNs();
GUI::Dialog;
#----------------------------#
# Non-Event Subroutines
#----------------------------#
END {
if ($db) {$db->Close();}
GUI::Show($DOShwnd);
}
sub Load_DSNs {
if (%DSNList=ODBC::DataSources()) {
foreach $Name (keys(%DSNList)) {
$Desc = $DSNList{$Name};
$LB->AddString("[$Name] $Desc");
}
$Status->Text("Double Click a DataSourceName[DSN] from the List above");
$Status->Update;
} else {
GUI::MessageBox($W,"Can't Determine Available DSN's","Error",16,);
GUI::MessageBox($W,"Shutting Down the Application","Status",64,);
exit;
}
}
sub Connect_To_DSN {
$Status->Text("Connecting to Database...");
$Status->Update;
sleep 1;
$db = new ODBC($DSN);
if (! $db) {
GUI::MessageBox($W,"Can't Establish Database Connection to DSN '$DSN'",
"Error",16,);
GUI::MessageBox($W,"Shutting Down the Application","Status",64,);
exit;
}
$Status->Text("DataSourceName=$DSN");
$Status->Update;
$SqlText->SetFocus();
$SqlText->Select(0,length($SqlText->Text()));
}
sub Execute_SQL {
$LV->Clear();
$Status->Text("Running SQL Statement...");
$Status->Update;
sleep 1;
$sqltxt=$SqlText->Text();
$ret = $db->Sql($sqltxt);
$Status->Text("DataSourceName=$DSN");
$Status->Update;
}
sub Load_Table_Column_Headings {
$Status->Text("Loading Column Headings to Grid...");
$Status->Update;
sleep 1;
$lastcol+=1;
for($i=$lastcol;$i>=0;$i--) {
$LV->DeleteColumn($i);
}
$LV->InsertColumn(-index => 0,-width => 50, -text => "Row#");
@Cols=(); # clear the array
@Cols = $db->FieldNames();
$lastcol=$#Cols; # zero based
for($i=0;$i<=$lastcol;$i++) {
$columname=$Cols[$i];
$j = ($i + 1);
$LV->InsertColumn(-index => $j, -width => 100, -text => $columname);
}
$Status->Text("DataSourceName=$DSN");
$Status->Update;
}
sub Load_Table_Data {
$Status->Text("Loading Database Grid...");
$Status->Update;
$itemcnt=0;
$rowcnt=$db->GetStmtOption($db->SQL_ROW_NUMBER());
if ($rowcnt < 1) {
GUI::MessageBox($W,"Can't determine Result Set row numbers",
"Error",16,);
GUI::MessageBox($W,"Shutting Down the Application","Status",64,);
exit;
}
$LV->InsertItem(-item => $itemcnt, -text => $rowcnt);
@Data=(); # clear the data array
@Data = $db->Data();
$lastfld=$#Data;
$subitemcnt=1;
for($i=0;$i<=$lastfld;$i++) {
$fieldvalue=$Data[$i];
$LV->SetItem(-item => $itemcnt,
-subitem => $subitemcnt,
-text => $fieldvalue,
);
$subitemcnt++;
}
$itemcnt++;
while ($db->FetchRow()) {
$rowcnt=$db->GetStmtOption($db->SQL_ROW_NUMBER());
$LV->InsertItem(-item => $itemcnt, -text => $rowcnt);
@Data=(); # clear the data array
@Data = $db->Data();
$lastfld=$#Data; # zero based
$subitemcnt=1;
for($i=0;$i<=$lastfld;$i++) {
$fieldvalue=$Data[$i];
$LV->SetItem(-item => $itemcnt,
-subitem => $subitemcnt,
-text => $fieldvalue,
);
$subitemcnt++;
}
$itemcnt++;
if ($itemcnt == 100) {last;}
}
if ($itemcnt < 100) {
$db->FetchRow(0,SQL_FETCH_LAST);
$rowcnt=$db->GetStmtOption($db->SQL_ROW_NUMBER());
}
$Status->Text("DataSourceName=$DSN");
$Status->Update;
}
sub Adjust_Cursor {
$rowcnt=$db->GetStmtOption($db->SQL_ROW_NUMBER());
$pos=($rowcnt % 100);
if ($rowcnt > 100) {
$pos=($rowcnt % 100);
if ($pos == 0) {$pos=100;}
$pos -= 1;
$db->FetchRow(($pos * -1),SQL_FETCH_RELATIVE);
}
else {
$db->FetchRow(0,SQL_FETCH_FIRST);
}
}
sub Verify_Pos {
if ($pos=~/^[0-9]+$/) {;} # must be all digits
else {return 1;}
if ($pos == 0) {return 1;}
return 0;
}
#----------------------------#
# Window Events
#----------------------------#
sub Window_Terminate {
if ($db) {$db->Close();}
GUI::Show($DOShwnd);
exit;
}
sub First_Click {
$LV->Clear();
$Status->Text("Fetching First Rowset...");
$Status->Update;
sleep 1;
$db->FetchRow(0,SQL_FETCH_FIRST);
Load_Table_Data();
}
sub Prev_Click {
$LV->Clear();
$Status->Text("Fetching Previous Rowset...");
$Status->Update;
sleep 1;
if ($rowcnt > 200) {
$pos=($rowcnt % 100);
if ($pos == 0) {$pos=199;}
else {$pos += 99;}
$db->FetchRow(($pos * -1),SQL_FETCH_RELATIVE);
}
else {
$Status->Text("Fetching First Rowset...");
$Status->Update;
sleep 1;
$db->FetchRow(0,SQL_FETCH_FIRST);
}
Load_Table_Data();
}
sub Next_Click {
$LV->Clear();
$Status->Text("Fetching Next Rowset...");
$Status->Update;
sleep 1;
if (! $db->FetchRow()) {
Last_Click();
}
else {
Load_Table_Data();
}
}
sub Last_Click {
$LV->Clear();
$Status->Text("Fetching Last Rowset...");
$Status->Update;
sleep 1;
$db->FetchRow(0,SQL_FETCH_LAST);
Adjust_Cursor();
Load_Table_Data();
}
sub Goto_Click {
$W->Disable();
$W2->Show();
$W2->Enable();
$GotoBox->SetFocus();
$GotoBox->Select(0,length($GotoBox->Text()));
}
sub OK_Click {
$pos=$GotoBox->Text();
if (Verify_Pos()) {
GUI::MessageBox($W2,"Enter a positve integer > 0","Error",16,);
$GotoBox->SetFocus();
$GotoBox->Select(0,length($GotoBox->Text()));
return;
}
$LV->Clear();
$W->Enable();
$W2->Hide();
$W2->Disable();
$Status->Text("Fetching Rowset with Row ($pos) ...");
$Status->Update;
sleep 2;
if (! $db->FetchRow($pos,SQL_FETCH_ABSOLUTE)) {
$Status->Text("Fetching Current Rowset Instead ...");
$Status->Update;
sleep 2;
$db->FetchRow($rowcnt,SQL_FETCH_ABSOLUTE);
}
Adjust_Cursor;
Load_Table_Data();
}
sub SqlGo_Click {
$First->Disable();
$Prev->Disable();
$Next->Disable();
$Goto->Disable();
$Last->Disable();
$db->DropCursor();
$db->SetStmtCloseType(SQL_DONT_CLOSE);
$db->SetStmtOption($db->SQL_CURSOR_TYPE,$db->SQL_CURSOR_STATIC);
Execute_SQL();
if ($ret != 0) {
$error=$db->Error(); # database error msg
Win32::GUI::MessageBox($W,$error,"SQL Error",16,);
$SqlText->SetFocus();
$SqlText->Select(0,length($SqlText->Text()));
return;
}
Load_Table_Column_Headings();
First_Click();
$First->Enable();
$Prev->Enable();
$Next->Enable();
$Goto->Enable();
$Last->Enable();
}
sub ListBox_DblClick {
$sel = $LB->SelectedItem(); # sel is zero based index
if($sel >= 0) {
$item = $LB->GetString($sel);
@items = split(/]/,$item);
$DSN = $items[0];
$DSN=~s/\[//g;
$DSN=~s/\]//g;
$LB->Disable(); $LB->Hide();
$LV->Enable(); $LV->Show();
$First->Show(); $Prev->Show();
$Next->Show(); $Goto->Show(); $Last->Show();
$SqlText->Enable(); $SqlText->Show();
$SqlGo->Enable(); $SqlGo->Show();
Connect_To_DSN();
}
}
##############
# END SCRIPT #
##############
