MS Access/ja

SELECT @@IDENTITY

[ODBC]
    DRIVER=Microsoft Access Driver (*.mdb)
    UID=admin
    UserCommitSync=Yes
    Threads=3
    SafeTransactions=0
    PageTimeout=5
    MaxScanRows=8
    MaxBufferSize=2048
    FIL=MS Access
    DriverId=25
    DefaultDir=
    DBQ=YOUR_msaccess.mdb

//注意: ここでは新しいMS Accessドライバを用いている。おそらく古いものも使えるだろう:
      conn.Driver:='Microsoft Access Driver (*.mdb, *.accdb)';
      conn.Params.Add('DBQ=c:\somedirectory\test.mdb');
      ... ������/���������������������������...

procedure TForm1.Button1Click(Sender: TObject);
    begin
      //接続
      ODBCConnection1.Driver := 'Microsoft Access Driver (*.mdb, *.accdb)';
      ODBCConnection1.Params.Add('DBQ='+Application.Location+'test.mdb');      // 必要なmdbファイルの場所
      ODBCConnection1.Params.Add('Locale Identifier=1031');
      ODBCConnection1.Params.Add('ExtendedAnsiSQL=1');
      ODBCConnection1.Params.Add('CHARSET=ansi');
      ODBCConnection1.Connected := True;
      ODBCConnection1.KeepConnection := True;
         
      //トランザクション
      SQLTransaction1.DataBase := ODBCConnection1;
      SQLTransaction1.Action := caCommit;
      SQLTransaction1.Active := True;
         
      SQLQuery1.DataBase := ODBCConnection1;
      SQLQuery1.UsePrimaryKeyAsKey := False;
      SQLQuery1.SQL.Text := 'select * from Customers';
      SQLQuery1.Open;
    end;

unit Unit1; 
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, odbcconn, sqldb, db, FileUtil, LResources, Forms, Controls,
      Graphics, Dialogs, DBGrids, DbCtrls, StdCtrls, Printers, PrintersDlgs;
    
    type
    
      { TForm1 }
    
      TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        Button4: TButton;
        Datasource1: TDatasource;
        DBEdit1: TDBEdit;
        DBEdit2: TDBEdit;
        DBGrid1: TDBGrid;
        ODBCConnection1: TODBCConnection;
        PrintDialog1: TPrintDialog;
        SQLQuery1: TSQLQuery;
        SQLTransaction1: TSQLTransaction;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
        procedure FormShow(Sender: TObject);
      private
        { private declarations }
        procedure PrintDbGrid(dbGrid:TdbGrid);
      public
        { public declarations }
      end; 
    
    var
      Form1: TForm1; 
    
    implementation
    
    { TForm1 }
    
    procedure TForm1.FormShow(Sender: TObject);
    begin
      //接続
      ODBCConnection1.FileDSN := ExtractFilePath(Application.ExeName) + 'file.dsn';
      ODBCConnection1.Connected := True;
      ODBCConnection1.KeepConnection := True;
    
      //トランザクション
      SQLTransaction1.DataBase := ODBCConnection1;
      SQLTransaction1.Action := caCommit;
      SQLTransaction1.Active := True; //not applied to ms access(false)
    
      SQLQuery1.DataBase := ODBCConnection1;
      SQLQuery1.UsePrimaryKeyAsKey := False;
    
      SQLQuery1.SQL.Text := 'select * from table1';
    
      // :id はフィールド名 idのパラメータ
      SQLQuery1.deleteSQL.Text := 'delete from table1 where id=:id';
      //:name はフィールド名 nameのパラメータ
      SQLQuery1.updateSQL.Text := 'update table1 set name=:name where id=:id';
    
      DataSource1.DataSet := SQLQuery1;
      DBGrid1.DataSource := DataSource1;
      DBGrid1.ReadOnly := true;
    
      DBEdit1.DataField := 'id';
      DBEdit1.DataSource := DataSource1;
      DBEdit2.DataField := 'name';
      DBEdit2.DataSource := DataSource1;
    
      SQLQuery1.Open;
    end;
    
    function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
    begin
      Result:=Round(int64(nNumber)*int64(nNumerator)/nDenominator);
    end;
    procedure TForm1.PrintDbGrid(dbGrid:TdbGrid);
    const
      LeftMargin = 0.05;
      TopMargin = 0.05;
      BottomMargin = 0.05;
    var
      i: integer;
      x,y: integer;
    begin
      if PrintDialog1.Execute then
        begin
        Printer.BeginDoc;
        Printer.Canvas.Font.Size := 12;
    
        y := Round(TopMargin*Printer.PageHeight);
        dbGrid.DataSource.DataSet.First;
        while not dbGrid.DataSource.DataSet.Eof do
          begin
          x := Round(LeftMargin*Printer.PageWidth);
          for i := 0 to dbGrid.DataSource.DataSet.FieldCount-1 do
            begin
            printer.Canvas.TextOut(x,y,dbGrid.DataSource.DataSet.Fields[i].AsString);
            x := x + MulDiv(dbGrid.Columns[i].Width,72, dbGrid.Width);
            end;
          dbGrid.DataSource.DataSet.Next;
          y := y + printer.Canvas.TextHeight('A');
          if y > (1-TopMargin-BottomMargin)* Printer.PageHeight then
            begin
            y := Round(TopMargin*Printer.PageHeight);
            Printer.NewPage;
            end;
          end;
        Printer.EndDoc;
        end
        else
        Form1.caption := 'NO PRINTER INSTALLED';
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      PrintDbGrid(DBGrid1);
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
    if button2.Caption = 'new' then
    begin
      SQLQuery1.Insert;
      button2.Caption := 'save';
      exit
      end
      else
      begin
        if (dbedit1.Text = '') or (dbedit2.Text = '')
        then
        begin
        SQLQuery1.Cancel;
        end
        else
        begin
        if SQLQuery1.State = dsInsert then
           begin
           SQLQuery1.Post;
           SQLQuery1.ApplyUpdates;
           Form1.caption := 'ADDED';
           end;
        end;
      end;
    button2.Caption := 'new';
    end;
    
    procedure TForm1.Button3Click(Sender: TObject);
    begin
    if SQLQuery1.RecordCount>0 then
      begin
      SQLQuery1.Delete;
      SQLQuery1.ApplyUpdates;
    
      //もしSQLdBで問題が生じたら、この2行を加える、あるいは除いてみる
      //これら2ラインはMS AccessデータベースのSQLdBのバグに対する手当である
      //**** bugtracker アイテムには見当たらない、bugtrackerを作ってほしい
      //SQLQuery1.Close;
      //SQLQuery1.Open;
    
    
      Form1.caption := 'DELETED';
      end;
    end;
    
    procedure TForm1.Button4Click(Sender: TObject);
    begin
      if SQLQuery1.RecordCount>0 then
      begin
        SQLQuery1.Edit;
        SQLQuery1.Post;
        Sqlquery1.ApplyUpdates;
        Form1.caption := 'UPDATED';
      end;
    end;
    
    procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
    begin
      SQLQuery1.Close;
      CanClose := True;
    end;
    
    initialization
      {$I unit1.lrs}
    
    end.

uses
      ..., sysutils, odbcsqldyn;
    
    const
       ODBC_ADD_DSN=1;
       { just for reference...
       ODBC_CONFIG_DSN=2;
       ODBC_REMOVE_DSN=3;
       ODBC_ADD_SYS_DSN=4;
       ODBC_CONFIG_SYS_DSN=5;
       ODBC_REMOVE_SYS_DSN=6;
       ODBC_REMOVE_DEFAULT_DSN=7; }
    
    function SQLConfigDataSource(hwndParent: Integer; fRequest: Integer;
      lpszDriverString: PChar; lpszAttributes: PChar): Integer; stdcall;
      external 'odbccp32.dll';
    
    function SQLInstallerError(iError: integer; pfErrorCode: PInteger;
      lpszErrorMsg: String; cbErrorMsgMax: integer; pcbErrorMsg: PInteger): integer; stdcall;
      external 'odbccp32.dll';
    
    procedure CreateAccessDatabase(DatabaseFile: string);
    var
      cmd: String;
      driver: String;
      errCode, errMsgLength: DWord;
      errMsg: String;
      retCode: integer;
      ext: String;
    begin
      ext := Lowercase(ExtractFileExt(DatabaseFile));
    
      driver := 'Microsoft Access Driver (*.mdb, *.accdb)';
      { このドライバで
        CREATE_DBV12 は .accdbフォーマットデータベースができる
        CREATE_DBV4 は.mdbフォーマットデータベースができる
        //stackoverflow.com/questions/9205633/how-do-i-specify-the-odbc-access-driver-format-when-creating-the-database
      }
      if ext = '.mdb' then
        cmd := 'CREATE_DBV4="' + DatabaseFile + '"'
      else if ext = '.accdb' then
        cmd := 'CREATE_DBV12="' + DatabaseFile + '"'
      else
        raise Exception.Create('Invalid database file extension.');
    
      retCode := SQLConfigDataSource(0, ODBC_ADD_DSN, PChar(driver), PChar(cmd));
      if not (retCode in [SQL_SUCCESS, SQL_SUCCESS_WITH_INFO]) then
      begin
        //別のドライバを試す
        driver := 'Microsoft Access Driver (*.mdb)';
        cmd := 'CREATE_DB="' + DatabaseFile + '"';
        retCode := SQLConfigDataSource(0, ODBC_ADD_DSN, PChar(driver), PChar(cmd));
      end;
    
      if not (retCode in [SQL_SUCCESS, SQL_SUCCESS_WITH_INFO]) then
      begin
        errCode := 0;
        errMsgLength := 0;
        SetLength(errMsg, SQL_MAX_MESSAGE_LENGTH);
        SQLInstallerError(1, @errCode, PChar(errMsg), Length(errMsg), @errMsgLength);
        SetLength(errMsg, errMsgLength);
        raise Exception.CreateFmt('Error creating Access database: %s', [errMsg]);
      end;
    end;

uses
      lconvencoding;
     
    procedure TForm1.SQLQuery1AfterOpen(DataSet: TDataSet);
    var
      i: Integer;  
    begin
      for i:=0 to DataSet.Fields.Count-1 do
      begin
        if DataSet.Fields[i].DataType=ftString then
        begin
          DataSet.Fields[i].OnGetText := @ConvertFromDB;
          DataSet.Fields[i].OnSetText := @ConvertToDB;
        end;
      end;
    end;
     
    procedure TForm1.ConvertFromDB(Sender: TField; var aText: string; DisplayText: Boolean);
    begin
      if not Sender.IsNull then
        aText := WinCPToUTF8(Sender.AsString);  // もしWindowsのデフォルトコードページの場合
    end;
     
    procedure TForm1.ConvertToDB(Sender: TField; const aText: string);
    begin
      if aText <> '' then 
        Sender.Value := UTF8ToWinCP(aText);
    end;