Perl 从Access 2010 accdb格式数据库访问MSysObjects

Windows XP Pro ActiveState Perl 5.14.4 M$Access 2010

我有一个accdb格式的Access db，其中包含一个数字 存储查询的数量。我想使用Perl将它们提取到平面文件中

查询的名称显示在[MSysObjects].[Name]中，而查询 它们似乎以某种方式存储在MSYSQuery中

但我的问题是上游-我不能阅读这些表格。 我已经确认，当我直接打开数据库时，用户名是“Admin”

谷歌出现了， 这说明“Admin”没有MSysObjects的SELECT权限，因此我需要 执行DDL语句将MSysObjects上的SELECT授予管理员

更多的谷歌搜索出现了，它说 要启用某些管理语句（如GRANT），我需要添加 Uid=管理员；Pwd=；ExtendedAnsiSQL=1； 连接到我的连接字符串

同一个页面有一个特别说明工作组文件所在位置的简介 位于 SystemDB=C:\mydatabase.mdw 在连接字符串中。 请稍后再谈

所以我有这个

#! /home/gnu/bin/perl
#

package main;

use strict;
use autouse 'Data::Dumper' => qw(Dumper);
use DBI;
use DBD::ODBC;    # works for both access and sql server
use Win32::ODBC;
use OLE;
use Win32::OLE;

# prototypes
sub _setUpDatabaseHandle_Access_Local_EnableAdminStatements($);
sub setPermissionsOnTables($);
sub readTableMSysObjects($);

#globals
my $debug = 1;

my $targetDbFile  = undef;
my $dbh_C = undef;

print "version of DBD::ODBC   is ".$DBD::ODBC::VERSION."\n";
print "version of Win32::ODBC is ".$Win32::ODBC::VERSION."\n";
print "version of Win32::OLE  is ".$Win32::OLE::VERSION."\n";

$targetDbFile  = "C:/putyer/msaccessdb/here.accdb";

$dbh_C = _setUpDatabaseHandle_Access_Local_EnableAdminStatements( $targetDbFile);

setPermissionsOnTables( $dbh_C);
readTableMSysObjects( $dbh_C);

$dbh_C->disconnect() if( defined( $dbh_C));

exit(0);
#-------------------------------
#  when you use perl to open an .accdb  Access database the Uid is always Admin
#  But user Admin doesn't have SELECT permission on MSysObjects by default you must first
#  grant the permission on the object for the user
#  to enable certain admin commands like CREATE USER, GRANT, REVOKE, DEFAULTS when using CREATE TABLEs
sub _setUpDatabaseHandle_Access_Local_EnableAdminStatements($)
{
  my ( $dbFile) = @_;

  my $errorHit = 0;

  my $conn_str = "DBI:ODBC:DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};dbq=".$dbFile;
  $conn_str   .= "; Uid=Admin; Pwd=; ExtendedAnsiSQL=1";

  my $dbh = DBI->connect( $conn_str);
  if( !defined( $dbh)) {
    print "db connection failed - ".$DBI::errstr."\n";
    $errorHit = 1;
  }

  print "connection _setUpDatabaseHandle_Access_Local_EnableAdminStatements failed\n" if( $errorHit);

  return $dbh;
}
#-------------------------------
sub setPermissionsOnTables($)
{
  my ( $dbh) = @_;

  print "entering setPermissionsOnTables\n" if $debug;

  my $errorHit = 0;

  my $q   = undef;
  my $sth = undef;

  unless( $errorHit) {
    $q = "GRANT SELECT ON MSysObjects TO Admin";
    $sth = $dbh->prepare($q);
    if( !defined( $sth)) {
      print "sth failed to define - ".$DBI::errstr."\n";
      $errorHit = 1;
    } else {
      $sth->execute();                        # <===  FAILS HERE
      if( my $errorMsg = $dbh->errstr ) {
        print "select statement failed - ".$errorMsg."\n";
        $errorHit = 1;
      }
    }
  }

  unless( $errorHit) {
    $q = "GRANT SELECT ON MSysQueries TO Admin";
    $sth = $dbh->prepare($q);
    if( !defined( $sth)) {
      print "sth failed to define - ".$DBI::errstr."\n";
      $errorHit = 1;
    } else {
      $sth->execute();
      if( my $errorMsg = $dbh->errstr ) {
        print "select statement failed - ".$errorMsg."\n";
        $errorHit = 1;
      }
    }
  }

  print "exiting  setPermissionsOnTables with errorHit=".$errorHit."\n" if $debug;
  return $errorHit;
}
#-------------------------------
sub readTableMSysObjects($)
{
  my ($dbh) = @_;

  print "entering readTableMSysObjects\n" if $debug;

  my $errorHit = 0;

  my $q   = undef;
  my $sth = undef;

  unless( $errorHit) {
    $q = "SELECT * FROM MSysObjects";  # remember that db nulls come over as perl undefs
    $sth = $dbh->prepare($q);
    if( !defined( $sth)) {
      print "sth failed to define - ".$DBI::errstr."\n";
      $errorHit = 1;
    } else {
      $sth->execute();
      if( my $errorMsg = $dbh->errstr ) {
        print "select statement failed - ".$errorMsg."\n";
        $errorHit = 1;
      } else {
        if( $sth->rows == 0 ) {
          print "select statement returned 0 rows\n";
          $errorHit = 1;
        } else {
          my $row_hashref = undef;
          while( $row_hashref = $sth->fetchrow_hashref() ) {
            print Dumper( $row_hashref);
          }
        }
      }
      $sth->finish();
    }
  }

  print "exiting  readTableMSysObjects\n" if $debug;
  return $errorHit;
}

欢迎任何指点/提示/建设性批评，尤其是示例

蒂亚

---

仍在学习Steve

我的经验是Access数据库引擎和相关驱动程序似乎可以访问ADO和OleDb中非常紧密锁定的[MSys…]表。它们似乎仍然可以通过DAO访问，但是如果您使用DAO，那么您就不需要对[MSysObjects]大惊小怪，因为您可以通过

QueryDefs

集合进行迭代

以下VBScript将每个查询的SQL代码转储到单独的文本文件中。您可以通过以下两种方式将其集成到Perl项目中：

• 将代码移植到Perl（并使用Perl中可用的任何机制来操作COM对象），或
• 从Perl脚本中剥离并运行VBScript本身（通过

  cscript.exe

  ）

选项显式
Dim dbe'作为DAO.DBEngine
Dim db'作为DAO.Database
Dim qdf'作为DAO.QueryDef
Dim fso'作为文件系统对象
将f'变暗为文本流
设置fso=CreateObject（“Scripting.FileSystemObject”）'新的FileSystemObject
设置dbe=CreateObject（“DAO.DBEngine.120”）'新建DAO.DBEngine
Set db=dbe.OpenDatabase（“C:\\uu tmp\main.accdb”）
对于db.querydfs中的每个qdf
设置f=fso.CreateTextFile（“C:\\\\\\\\\”&qdf.Name&“.sql”）
f、 WriteLine qdf.SQL
f、 接近
设置f=无
下一个
db.关闭
Set db=Nothing
设置dbe=Nothing
设置fso=无

感谢您的回复和示例！我将在第二天左右试一试。

#-------------------------------
sub _setUpDatabaseHandle_Access_Local_ADO_ACE($)
{
  my ( $dbFile) = @_;

  my $errorHit = 0;

  my $conn_str = "DBI:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=".$dbFile;
  $conn_str   .= "; Persist Security Info=False";
# print $conn_str."\n";

  my $dbh = DBI->connect( $conn_str);
  if( !defined( $dbh)) {
    _pushErrorMsg("db connection failed - ".$DBI::errstr);
    $errorHit = 1;
  }

  print "connection _setUpDatabaseHandle_Access_Local_ACE failed\n" if( $errorHit);

  return $dbh;
}
#-------------------------------
sub _setUpDatabaseHandle_Access_Local_ADO($)
{
  my ( $dbFile) = @_;

  my $errorHit = 0;

  my $conn_str = "DBI:ADO:File Name=".$dbFile;

  my $username = undef;
  my $password = undef;

  my $dbh = DBI->connect( $conn_str, $username, $password);
  if( !defined( $dbh)) {
    _pushErrorMsg("db connection failed - ".$DBI::errstr);
    $errorHit = 1;
  }

  print "connection _setUpDatabaseHandle_Access_Local_ADO failed\n" if( $errorHit);

  return $dbh;
}