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

Hello all,
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...
Oh, you'll need to find the graphics located at the end of the script...

#!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';
my $ConnStr = "dbi:ADO:Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=". $db_name;

my $q = new CGI;
my $load = $q->param('load');
my $showPic = $q->param('showPic');
my $show_picID = $q->param('picID');
if ($load) {
doDBLoad();
} 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 "

\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->{LongTruncOk} = 0;
}

sub doDBLoad {
no strict 'subs';
eval { use Text::CSV_XS; };
if ($@) { die "Text::CSV_XS not supported...\n"; }
my $csv = Text::CSV_XS->new;
print "Creating database...\n";
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 staement 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, $ImageFile, 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 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 = ;
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 much!
amonotod

--

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

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 "

\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->{LongTruncOk} = 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 = ;
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____________________________________
_____|_____|_____|_____|_____|_____|_____|_____|

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

amonotod wrote:

> Hello all,
> 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...

I can reproduce this :-(

>
[...]
> eval {
> use Win32::OLE;
> Win32::OLE->Option(CP => Win32::OLE::CP_UTF8);
> };

Looks like is has to do with UTF8. Commenting out (or moving it out of the
eval{}) avoids (or hides?) the problem. Sorry, no further ideas.


Steffen

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

---- Steffen Goeldner wrote:
> amonotod wrote:
> > eval {
> > use Win32::OLE;
> > Win32::OLE->Option(CP => Win32::OLE::CP_UTF8);
> > };
>
> Looks like is has to do with UTF8. Commenting out (or moving it out of the
> eval{}) avoids (or hides?) the problem. Sorry, no further ideas.

The original code (embarrassingly enough) did not have the eval, so I don't think that's it.
I just wanted to make sure that the code I posted to the list was complete and had
some minimal error checking. I actually ginned this code together from it's original
source to be a complete example for the list...

So, might anyone have a snippet of code that does work? It doesn't necessarily need
to use ADO, though it should use DBI and work against Access 97/2000 (Jet 4/5)....

> Steffen

Thanks for giving it a look, I appreciate it....
amonotod

--

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

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

Hello all,
Sometimes it is just more sensible to find a workaround rather than a solution. So,
here is an updated script that uses DBI::ADO to create the database, DBI::ODBC to
populate and test it, and DBI::ADO to retrieve the pics via CGI.

Thanks for the pointer, Bart!

As before, the pics I used are available at http://geocities.com/amonotod/picsDB_images.zip.

Populate the database with "perl myPics.pl load=1", then view the script via a
browser and web server of choice....

And, again, thanks for DBI, DBI::ADO, DBI::ADO, DBI::Sybase, DBI::Oracle and all the
other great modules that are supported by this group...

amonotod

#!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 $connStrODBC = "dbi:ODBC:driver=Microsoft Access Driver (*.mdb); dbq=$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 "

\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->{LongTruncOk} = 0;
}

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

sub doDBLoad {
my $csv = Text::CSV_XS->new;
print "Creating database...";
CreateAccessDB();
print " Done!\n";
connectDBODBC();
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"; }
print "Column is ", $sth->fetchrow, "\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);
$sth->bind_param(4, $picData, DBI::SQL_LONGVARBINARY );
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 = ;
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);
}

--

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

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

Resending because it's been several hours and I haven't seen this show up yet...

Hello all,
Sometimes it is just more sensible to find a workaround rather than a solution.
So, here is an updated script that uses DBI::ADO to create the database, DBI::ODBC
to populate and test it, and DBI::ADO to retrieve the pics via CGI.

Thanks for the pointer, Bart!

As before, the pics I used are available at
http://geocities.com/amonotod/picsDB_images.zip.

Populate the database with "perl myPics.pl load=1", then view the script via a
browser and web server of choice....

And, again, thanks for DBI, DBI::ADO, DBI::ADO, DBI::Sybase, DBI::Oracle and all
the other great modules that are supported by this group...

Steffen, perhaps you could look at the difference in the bind variable code between
DBD::ADO and DBD::ODBC? I'd offer, but my ability with C es even more pitiable
than with Perl...

Thanks again,
amonotod

#!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 $connStrODBC = "dbi:ODBC:driver=Microsoft Access Driver (*.mdb);
dbq=$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 " href='myPics.pl?showPic=1&picID=$picID'>$picComment:
src=myPics.pl?showPic=1&picID=$picID>
\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->{LongTruncOk} = 0;
}

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

sub doDBLoad {
my $csv = Text::CSV_XS->new;
print "Creating database...";
CreateAccessDB();
print " Done!\n";
connectDBODBC();
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"; }
print "Column is ", $sth->fetchrow, "\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);
$sth->bind_param(4, $picData, DBI::SQL_LONGVARBINARY );
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 = ;
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);
}


--

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

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

---- Steffen Goeldner wrote:
> Attached is a fixed implementation for bind_param(). It would be nice if you (and
> others) give it a trial.

Steffen,
I'm at some off-site training all of this week; if I can, I will try this week, otherwise I'll follow up on Monday or Tuesday of next week. Either way, I appreciate your time and work investigating this, and will make sure I let you know how it goes...

> Steffen

Thank you!
amonotod

--

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

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

---- Steffen Goeldner wrote:
> I further investigated your
> test case: the Jet ADO provider creates for the LONGBINARY column a parameter of
> type 202 (adVarWChar) and size 510 - both are wrong. Thus, it's necessary to set
> the type in bind_param() - which you did. However, DBD::ADO did not set the size.
> Attached is a fixed implementation for bind_param(). It would be nice if you (and
> others) give it a trial.

Steffen,
I've tested your fix with my test script (included below), and it seems to work well. I still need to test with the production code, but my confidence level is high. :-)

> Steffen

Thanks again for all your great work with DBD::ADO,
amonotod

#!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 "

\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->{LongTruncOk} = 0;
}

sub doDBLoad {
my $csv = Text::CSV_XS->new;
print "Creating database...";
CreateAccessDB();
print " Done!\n";
connectDB();
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);
$sth->bind_param(4, $picData, DBI::SQL_LONGVARBINARY );
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 = ;
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);
}


--

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