小池啓仁 ヒロヒト応援ブログ By はてな

小池啓仁(コイケヒロヒト)の動画など。

小池啓仁 ヒロヒト応援ブログ By はてな

PerlからSQL Serverへアクセスする(バージョンアップ版)

昨日、ご紹介したヤツは、エラーが起こっても無視する仕様(バグ)になっていました。
以下のように改善いたしました。

改善点

  • Win32::OLE->Option(Warn => 3);を使用することにより、エラー時に本処理を中止し、Perlがエラーメッセージを出力し、本プロセスが終了する。
  • use Win32::OLE::Const 'Microsoft ActiveX Data Objects 2.0 Library';を追加したことにより、指定タイプライブラリのコンスタントadUseServer等が参照可能になる。
  • Select count(*) aru From sysobjects Where NAME = 'test_table'でテーブルの有無チェックが出来る。
  • $rs->{CursorLocation} = adUseClient;で、$rs->{RecordCount}にレコード数がセットされる。尚、ディフォルトのadUseServerでは、セットされない。
# SQL Server のデータベースアクセスサンプル
#[カスタマイズするポイント]
#・SQL Serverのサーバー名を『localhost』を変更する。
#・DB名『test』を変更する。
#・テーブル名『test_table』を変更する。
#・項目名『idやname』を変更する。
#・SQL Server 認証設定の時のID『testid』を変更する。
#・SQL Server 認証設定の時のパスワード『testps』を変更する。
# 補足:
# データ値を求める時の$rs->{Fields}->{id}->{Value}等は、idは各項目名になり、FieldsとValueは固定です。

use strict;
use Win32::OLE;

# 指定タイプライブラリのコンスタントが参照可能
use Win32::OLE::Const 'Microsoft ActiveX Data Objects 2.0 Library';

# エラー時に本処理を中止し、Perlがエラーメッセージを出力し、本プロセスが終了する。
Win32::OLE->Option(Warn => 3);

# DBサーバー名とDB名設定
my $server = "localhost";
my $db = "test";

# WINDOWS 認証設定
my $connStr = "Provider=sqloledb;".
              "Data Source=$server;".
              "Initial Catalog=$db;".
              "Integrated Security=SSPI;";

# SQL Server 認証設定
#my $id = "testid";
#my $ps = "testps";
#my $connStr = "Provider=sqloledb;".
#              "Data Source=$server;".
#              "Initial Catalog=$db;".
#              "User ID=$id;".
#              "Password=$ps;";

# DB接続
my $objDB = Win32::OLE->new("ADODB.Connection");
$objDB->Open($connStr);
$objDB->{Errors}->{Count} and 
    die "cannot connect '$connStr'";

# テーブル有無チェック
my $rs = Win32::OLE->new("ADODB.Recordset");
$rs->Open("Select count(*) aru From sysobjects Where NAME = 'test_table'", $objDB);

# テーブル無しの場合、テーブル作成
if ($rs->{aru}->{Value} == 0) {
    $objDB->Execute(
        "Create Table test_table (id int, name Char(20))" );
}
$rs->Close();

# データ挿入
$objDB->Execute(
    "Insert into test_table  values (1,'ミスチル')");
$objDB->Execute(
    "Insert into test_table  values (2,'中島美華')");
$objDB->Execute(
    "Insert into test_table  values (3,'中島美華')");

# データ更新
$objDB->Execute(
    "Update test_table Set name = '中島美嘉' Where id = 2");

# データ削除
$objDB->Execute(
    "Delete From test_table Where id = 3");

# データ読み出し
$rs = Win32::OLE->new("ADODB.Recordset");
$rs->{CursorLocation} = adUseClient;
$rs->Open("Select * From test_table", $objDB);

while(!$rs->EOF and $rs->{RecordCount} != 0){
    print "$rs->{Fields}->{id}->{Value}, ",
        "$rs->{Fields}->{name}->{Value}\n";
    $rs->MoveNext();
}
$rs->Close();

# DB切断
$objDB->Close();