Re: DBD::ADO and Access IMAGE (OLE Object) fields...

amonotod wrote:
I'm trying to insert images into an Access database (they're small, and that's how the app
was built, not my choice), but I'm running into errors. I'm using...

Windows XP SP1
ActiveState Perl: This is perl, v5.8.3 built for MSWin32-x86-multi-thread
DBI 1.43
DBD::ADO 2.91
Win32::OLE 0.1701
CGI 3.01
CGI::Carp 1.27
Text::CSV_XS 0.23

I'd appreciate any feedback, and would love to have a solution...

Here's a complete stand-alone script that *should* work, but doesn't, quite...

Hello again,
I'm resending, after adding an additional subroutine to export the images after
importing them to do a quick (-s) size verification. I've also fixed a typo. However,
the script still does not successfully load the data. I'd appreciate any pointers that
anyone may have to offer...

To run this script, you'll need some images (the ones I used are available at
http://geocities.com/amonotod/picsDB_images.zip). Create and load the database
with:

perl myPics.pl load=1

To view the images (if the load works), set up the script to work under your favorite
web server (Apache2 for me), and view myPics.pl

#!perl -w
use strict;

eval { use DBI; };
if ($@) { die "This system does not have the DBI installed!\n"; }
eval { use DBD::ADO; };
if ($@) { die "Database type ADO not supported!\n"; }
eval { use CGI; };
if ($@) { die "CGI module not supported!\n"; }
eval { use CGI::Carp; };
if ($@) { die "CGI::Carp module not supported!\n"; }

my ($dbh, $Access, $AccessDB, $Workspace);
my $db_name = "C:/development/web/PicsDB/myPics.mdb"; # Will be created by doDBLoad()...
my $connStr = "dbi:ADO:Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=$db_name";
my $tempDir = "C:/Temp/dbd_temp/"; # Must pre-exist...
my $status = 1;

my $q = new CGI;
my $load = $q->param('load');
my $showPic = $q->param('showPic');
my $show_picID = $q->param('picID');
if ($load) {
print "Doing database load...\n";
eval { use Text::CSV_XS; };
if ($@) { die "Text::CSV_XS not supported...\n"; }
doDBLoad();
exportDB();
print "All done!\n";
if ($status) { print "\n\tOperation was a success! :-)\n\n"; }
else { print "\n\tOperation was a failure! :-(\n\n"; }
} else {
connectDB();
if (($showPic) && ($show_picID)) {
showPic();
} else {
showPicLinks();
}
}
$dbh->disconnect();
exit;

sub showPic {
my $sqlStatement = "select picType, picData from myPics where picID = ?";
my $sthSelect = $dbh->prepare($sqlStatement);
eval {$sthSelect->execute($show_picID); };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors: $dbh->errstr \n"); exit; }
my ($picType, $picData) = $sthSelect->fetchrow_array;
$sthSelect->finish;
print $q->header($picType);
print $picData;
}

sub showPicLinks {
print $q->header('text/html');
print $q->start_html("myPics DB Display");
my $sqlStatement = "select picID, picComment from myPics";
my $sthSelect = $dbh->prepare($sqlStatement);
eval {$sthSelect->execute; };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors: $dbh->errstr \n"); exit; }
while (my ($picID, $picComment) = $sthSelect->fetchrow_array ) {
print "<a href='myPics.pl?showPic=1&picID=$picID'><b>$picComment:</b></a><br><img src=myPics.pl?showPic=1&picID=$picID><br>\n";
}
$sthSelect->finish;
}

sub connectDB {
eval { $dbh = DBI->connect( $connStr, "Admin", "", {RaiseError => 0, PrintError => 0, AutoCommit => 1} ); };
if ($@) { die("Database connection failed!\n$@\n"); }
$dbh->{LongReadLen} = 2000000;
$dbh->{LongTrun***} = 0;
}

sub doDBLoad {
my $csv = Text::CSV_XS->new;
print "Creating database...";
CreateAccessDB();
print " Done!\n";
connectDB();
eval {
use Win32::OLE;
Win32::OLE->Option(CP => Win32::OLE::CP_UTF8);
};
if ($@) { die "Win32::OLE maybe not supported...?\n"; }
my $create_statement = "create table [myPics] ([picID] INT NOT NULL, [picComment] VARCHAR (50), [picType] VARCHAR (50), [picData] IMAGE , ".
"PRIMARY KEY ([picID] ), CONSTRAINT myPic_PK UNIQUE ([picID] ))";
my $sth = $dbh->prepare($create_statement);
eval {$sth->execute; };
if ($@) { die "Create statement failed!\nErrors: $dbh->errstr \n"; }
my $sqlStatement = "INSERT INTO myPics (picID, picComment, picType, picData) VALUES (?, ?, ?, ?)";
$sth = $dbh->prepare($sqlStatement);
my $picList = PicList();
foreach (split("\n", $picList)) {
if ($csv->parse($_)) {
my ($picID, $picComment, $picType, $picImage) = $csv->fields;
if (-e $picImage) {
print "Loading $picImage into database...";
my $picData = readblobfile($picImage);
$sth->bind_param(1, $picID);
$sth->bind_param(2, $picComment);
$sth->bind_param(3, $picType);
#########
# Errors
# 1) Database seems to load, but has extreme bloat, and images do not work...
# 2) OLE exception from "Microsoft JET Database Engine":\n\nParameter ?_4 has no default value.
# 3) OLE exception from "ADODB.Command":\n\nApplication uses a value of the wrong type for the current operation.
# 4) OLE exception from "ADODB.Parameter":\n\nArguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
# 5) OLE exception from "Microsoft JET Database Engine":\n\nUnspecified error
#Attemped Binding # Error code
$sth->bind_param(4, $picData); # 1
#$sth->bind_param(4, $picData, DBI::SQL_GUID ); # 5
#$sth->bind_param(4, $picData, DBI::SQL_WLONGVARCHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_WVARCHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_WCHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_BIT ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_TINYINT ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_LONGVARBINARY ); # 3
#$sth->bind_param(4, $picData, DBI::SQL_VARBINARY ); # 3
#$sth->bind_param(4, $picData, DBI::SQL_BINARY ); # 3
#$sth->bind_param(4, $picData, DBI::SQL_LONGVARCHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_UNKNOWN_TYPE ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_ALL_TYPES ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_CHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_NUMERIC ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_DECIMAL ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_INTEGER ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_SMALLINT ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_FLOAT ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_REAL ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_DOUBLE ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_DATETIME ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_DATE ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_TIME ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_TIMESTAMP ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_VARCHAR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_BOOLEAN ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_UDT ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_UDT_LOCATOR ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_ROW ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_REF ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_BLOB ); # 3
#$sth->bind_param(4, $picData, DBI::SQL_BLOB_LOCATOR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_CLOB ); # 1
#$sth->bind_param(4, $picData, DBI::SQL_CLOB_LOCATOR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_ARRAY ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_ARRAY_LOCATOR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_MULTISET ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_MULTISET_LOCATOR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_TYPE_DATE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_TYPE_TIME ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_TYPE_TIMESTAMP ); # 2
#$sth->bind_param(4, $picData, DBI::SQL_TYPE_TIME_WITH_TIMEZONE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_TYPE_TIMESTAMP_WITH_TIMEZONE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_YEAR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_MONTH ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_DAY ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_HOUR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_MINUTE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_SECOND ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_YEAR_TO_MONTH ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_DAY_TO_HOUR ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_DAY_TO_MINUTE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_DAY_TO_SECOND ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_HOUR_TO_MINUTE ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_HOUR_TO_SECOND ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTERVAL_MINUTE_TO_SECOND ); # 4
#$sth->bind_param(4, $picData, DBI::SQL_INTEGER); # 4
eval { $sth->execute; };
if ($@) {
print "Graphic import failed for image $picImage\n";
$dbh->disconnect;
exit(255);
}
print " Done!\n";
} else { print "Could not find image $picImage; not loaded!\n"; }
} else { print "CSV parsing failed!\n"; }
}
}

sub exportDB {
print "Exporting grapics to $tempDir\n";
unless (-d $tempDir) { print "Temp dir $tempDir does not exist!\n"; exit(1); }
my $csv = Text::CSV_XS->new;
my $picList = PicList();
my $sqlStatement = "select picData from myPics where picID = ?";
my $sthSelect = $dbh->prepare($sqlStatement);
foreach (split("\n", $picList)) {
if ($csv->parse($_)) {
my ($picID, $picComment, $picType, $picImage) = $csv->fields;
my $picName = $tempDir . substr($picImage,rindex($picImage,"\\")+1,length($picImage));
print "picName is $picName\n";
eval {$sthSelect->execute($picID); };
if ($@) { carp("Select statement '$sqlStatement' failed!\nErrors: $dbh->errstr \n"); exit; }
my ($picData) = $sthSelect->fetchrow;
open(IMAGE, "> $picName") || die("Could not open new image file for write\n");
binmode(IMAGE);
print IMAGE $picData;
close(IMAGE);
$sthSelect->finish;
my $origSize = (-s $picImage);
my $newSize = (-s $picName);
unless ($origSize == $newSize) {
print "\tError: Imported and exported files DO NOT match in size....!\n";
$status = 0;
} else {
print "\tSuccess: Imported and exported files match in size....!\n";
}
}
}
}

sub readblobfile($) {
my $file = shift; #get file name
local( $/, *FILE); #see perldoc perlvar for an explanation here
open(FILE, "$file") or die "$!";
binmode(FILE);
my $content = <FILE>;
close(FILE);
return $content;
}

sub CreateAccessDB {
if ( -e "$db_name") { # if the file already exists, delete it
unlink("$db_name") || die("Could not delete the old database file $db_name\n");
}
eval { use Win32::OLE; };
if ($@) { die "Win32::OLE not supported...\n"; }
eval { use Win32::OLE::Const 'Microsoft ActiveX Data Objects'; };
if ($@) { die "ADO maybe not supported...?\n"; }
eval {
$AccessDB = Win32::OLE->new("ADOX.Catalog");
$AccessDB->Create("Provider='Microsoft.Jet.OLEDB.4.0';Jet OLEDB:Engine Type=5;Data Source='". $db_name ."'");
};
if ($@) { die "Couldn't create the database $db_name...!\n"; }
Win32::OLE->Uninitialize;
}

sub PicList {
my $picList = <<'EOF';
1,The Charter Communications Logo,image/gif,C:\development\web\PicsDB\Charter_Logo.gif
2,The Google Logo,image/gif,C:\development\web\PicsDB\Google_Logo.gif
3,The Yahoo Logo,image/gif,C:\development\web\PicsDB\Yahoo_Logo.gif
4,The AOL Logo,image/gif,C:\development\web\PicsDB\AOL_Logo.gif
EOF
return($picList);
}


Thanks in advance, I appreciate any replies!
amonotod

--

`\|||/ amonotod@ | sun|perl|windows
(@@) charter.net | sysadmin|dba
ooO_(_)_Ooo____________________________________
_____|_____|_____|_____|_____|_____|_____|_____|

.