ちっぷす [Delphi Programming]

Delphi 2010 以降で RTTI を無効にする

　Delphi 2010 はデフォルトで RTTI が有効になっており、RTTI が有効のままコンパイルすると、RTTI を用いないコードのみで書かれたソースコードであっても EXE のサイズが肥大化します。

　(恐らく)完全に RTTI をオフにする事はできませんが、*.dpr に以下のコードを記述する事により、RTTI を可能な限り利用しなくする事ができます。

program Project1;

{$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])}
{$WEAKLINKRTTI ON}

...

　プロジェクト内の各ユニットの先頭に記述しても、殆ど効果はないハズです。また、このコードの記述があっても、VCL/RTL の一部に RTTI に依存したコードが含まれるため、特定のユニットを uses すると暗黙的に RTTI が有効になります。

　EXE サイズの肥大化は今となっては大した問題ではなく、RTTI 有効によって肥大化した EXE ファイルのサイズは以降どれだけ RTTI を利用しても極端にサイズが増加する事はありません。また、RTTI を利用する事による "速度面でのペナルティ" は無視できる程度のものだと思います (どういう使い方をするかにも依るでしょうが...)。

Delphi 2009 以降で半角/全角を考慮して文字幅を揃える

　MECSUtils を利用し、MecsStringWidth() を使うのが最も簡単な方法だと思います。サンプルコードも MECSUtils リファレンスにあります。

　但し、文字幅は揃うかもしれませんが、データのサイズはバラバラになります ので注意が必要です。何故そういった事になるのかが理解できない方は、トピック "39.Unicode" をご一読下さい。

DBX で Firebird に接続するには？

　以下、簡単なサンプルコードです。

uses
  ..., DBXFirebird; 

procedure TForm1.Button1Click(Sender: TObject);
var
  DBXC: TSQLConnection;
  QRY: TSQLQuery;
  DataBase: String;
begin
  DBXC := TSQLConnection.Create(Self);
  try
    QRY := TSQLQuery.Create(Self);
    try
      DBXC.LoginPrompt    := False;
      DBXC.DriverName     := 'Firebird';
      DBXC.ConnectionName := 'FBConnection';
      DBXC.GetDriverFunc  := 'getSQLDriverFIREBIRD';
      DBXC.LibraryName    := 'dbxfb.dll';
      DBXC.VendorLib      := 'fbclient.dll';

      DBXC.Params.Clear;
      DBXC.Params.Values['user_name'    ] := 'SYSDBA';   // User Name
      DBXC.Params.Values['password'     ] := 'masterke'; // Password
      DBXC.Params.Values['ServerCharSet'] := 'UTF8';     // CharSet
      DataBase := '127.0.0.1:' +
                  IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) +
                  'DATA\DATA.FDB';
      DBXC.Params.Values['DataBase'     ] := DataBase;   // Database

      QRY.SQLConnection := DBXC;
      DBXC.Connected := True;

      QRY.SQL.Clear;
      QRY.SQL.Add('Select * From MST_EMPLOYEE');
      QRY.SQL.Add('Where                     ');
      QRY.SQL.Add('  NAME = :_NAME           ');
      QRY.ParamByName('_NAME').AsString := Edit1.Text;
      QRY.Open;
      if QRY.IsEmpty then
        ShowMessage('Empty')
      else
        ShowMessage(IntToStr(QRY.FieldByName('CODE').AsInteger));
      QRY.Close;

      DBXC.Connected := False;
    finally
      QRY.Free;
    end;
  finally
    DBXC.Free;
  end;
end;

　Professional 版では Firebird ドライバが提供されない 事に注意して下さい。

See Also:

Firebird のデータベースファイルをバックアップ/リストアするには？

　Delphi 2010 の DBX では対処できません。バックアップ/リストアには IBX Admin の機能を利用します。但し、IBX は Firebird を公式にサポートしていない事だけは覚えておいて下さい。

バックアップ

//バックアップ
IBBackupService1 := TIBBackupService.Create(nil);
try
  IBBackupService1.LoginPrompt := False;
  IBBackupService1.Protocol := TCP;
  IBBackupService1.ServerName := 'localhost';
  IBBackupService1.Params.Values['user_name'] := UserName;
  IBBackupService1.Params.Values['password' ] := PW;
  IBBackupService1.Attach;
  if IBBackupService1.Active then
    begin
      IBBackupService1.DatabaseName := DatabaseName;
      IBBackupService1.BackupFile.Add(BackupFile);
      IBBackupService1.ServiceStart;
      while IBBackupService1.IsServiceRunning do
        Application.ProcessMessages;
    end;
finally
  if IBBackupService1.Active then
    IBBackupService1.Detach;
  IBBackupService1.Free;
end;

リストア

//リストア
IBRestoreService1 := TIBRestoreService.Create(nil);
try
  IBRestoreService1.LoginPrompt := False;
  IBRestoreService1.Protocol := TCP;
  IBRestoreService1.ServerName := 'Localhost';
  IBRestoreService1.Params.Values['user_name'] := UserName;
  IBRestoreService1.Params.Values['password' ] := PW;
  IBRestoreService1.Attach;
  if IBRestoreService1.Active then
    begin
      IBRestoreService1.Options := IBRestoreService1.Options + [Replace];
      IBRestoreService1.DatabaseName.Add(DatabaseName);
      IBRestoreService1.BackupFile.Add(BackupFile);
      IBRestoreService1.ServiceStart;
      while IBRestoreService1.IsServiceRunning do
        Application.ProcessMessages;
    end;
finally
  if IBRestoreService1.Active then
    IBRestoreService1.Detach;
  IBRestoreService1.Free;
end;

　バックアップ/リストアの際には、DB へのコネクションが存在しない事を確認して下さい。コネクションがある場合、バックアップ/リストアは失敗してしまいます。

　また、バックアップファイルは Firebird サーバでのパスを指定する必要があります。Firebird サーバとクライアントが別の PC の場合、クライアント PC からクライアント PC のローカルフォルダへバックアップを行う事はできません。

See Also:

InterBase / Firebird のデータベースへ接続されているセッションが存在するかを調べるには？

　"Firebird のデータベースファイルをバックアップ/リストアするには？" にあるように、InterBase / Firebird では DB に接続された状態でバックアップ/リストアする事はできません。例え可能であってもそれは避けるべきです。

function SessionExists: Boolean;
var
  IBSP: TIBServerProperties;
  i: Integer;
begin
  IBSP := TIBServerProperties.Create(nil);
  try
    IBSP.LoginPrompt := False;
    IBSP.Protocol := TCP;
    IBSP.ServerName := 'Localhost';
    IBSP.Params.Values['user_name'] := UserName;
    IBSP.Params.Values['password' ] := PW;
    IBSP.Options := [Database];
    IBSP.Active := True;
    IBSP.FetchDatabaseInfo;
    result := False;
    if IBSP.DatabaseInfo.NoOfAttachments > 0 then
      for i:=0 to High(IBSP.DatabaseInfo.DbName) do
        if AnsiUpperCase(IBSP.DatabaseInfo.DbName[i]) = AnsiUpperCase(DatabaseName) then
          begin
            result := True;
            Exit;
          end;
    IBSP.Active := False;
  finally
    IBSP.Free;
  end;
end;

　上記コードは、データベースへ接続されているセッションが存在するかどうかを返します。

　補足しますと、サーバへ接続されているセッション数は DatabaseInfo.NoOfAttachments で調べることができますが、これはあくまでも サーバに接続されているセッション数 であり、データベースへの接続セッション数ではありません。特定のデータベースのセッションが存在するかどうかは DatabaseInfo.DbName を調べる必要があります。ここに、指定されたデータベースが存在すればセッションが存在するという事になります。

　なお、上記コードではデータベース名を AnsiUpperCase で処理していますが、サーバが Linux 等の場合、この処理は不適切です。

See Also:

Indy 10 を使って GMail を送受信するには？ (Delphi 2009 以降)

　UTF-8、SSL を使って GMail を送受信するサンプルです。

Indy 10 のインストール

　インストール方法は "62. Delphi 2009 に最新版の Indy10 をインストールする" を参考にして下さい。

　また、POP3/SMTP に SSL を利用する場合には、"Indy用 OpenSSL DLL" が別途必要となります。アーカイブを解凍して得られる DLL をプロジェクトフォルダ以下に配置して下さい。

サンプルコード(送信)

procedure TForm1.IdMessage_InitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
begin
  VHeaderEncoding := 'B';
  VCharSet := 'UTF-8';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SMTP: TIdSMTP;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
  Msg : TIdMessage;
begin
  SMTP := TIdSMTP.Create(nil);
  try
    SMTP.Host     := 'smtp.gmail.com';
    SMTP.Port     := 587;
    SMTP.Username := 'hoge@gmail.com'; // UserName
    SMTP.Password := 'hogehoge';       // Password
    SSL := TIdSSLIOHandlerSocketOpenSSL.Create;
    try
      SSL.Host := SMTP.Host;
      SSL.Port := SMTP.Port;
      SSL.Destination := SSL.Host + ':' + IntToStr(SSL.Port);
      SMTP.IOHandler := SSL;
      SMTP.UseTLS := utUseExplicitTLS;
      SMTP.Connect;
      Msg := TIdMessage.Create(SMTP);
      try
        Msg.OnInitializeISO           := IdMessage_InitializeISO;
        Msg.ContentType               := 'text/plain';
        Msg.CharSet                   := 'UTF-8';
        Msg.ContentTransferEncoding   := 'BASE64'; // BASE64 (7bit)
      //Msg.ContentTransferEncoding   := '8bit';   // RAW(8bit)       
        Msg.From.Name                 := 'hoge@gmail.com';
        Msg.From.Address              := 'hoge@gmail.com';
        Msg.Recipients.EMailAddresses := 'hoge@gmail.com';
        Msg.Subject                   := 'Unicode String (subject)';
        Msg.Body.Text                 := 'Unicode String (body)';
        SMTP.Send(Msg);
      finally
        Msg.Free;
      end;
      SMTP.Disconnect;
    finally
      SSL.Free;
    end;
  finally
    SMTP.Free;
  end;
end;

サンプルコード(受信)

procedure TForm1.Button2Click(Sender: TObject);
var
  POP3: TIdPOP3;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
  Msg : TIdMessage;
  MsgCnt: Integer;
  i: Integer;
begin
  Memo1.Clear;
  POP3 := TIdPOP3.Create(nil);
  try
    POP3.Host     := 'pop.gmail.com';
    POP3.Port     := 995;
    POP3.Username := 'hoge@gmail.com'; // UserName
    POP3.Password := 'hogehoge';       // Password
    SSL := TIdSSLIOHandlerSocketOpenSSL.Create;
    try
      SSL.Host := POP3.Host;
      SSL.Port := POP3.Port;
      SSL.Destination := SSL.Host + ':' + IntToStr(SSL.Port);
      POP3.IOHandler := SSL;
      POP3.UseTLS := utUseImplicitTLS;
      POP3.Connect;
      Msg := TIdMessage.Create(nil);
      try
        MsgCnt := POP3.CheckMessages;
        for i:=1 to MsgCnt do
          begin
            POP3.RetrieveHeader(i, Msg);
            Msg.NoDecode := (LowerCase(Msg.ContentTransferEncoding) <> 'base64') and
                            (LowerCase(Msg.ContentTransferEncoding) <> 'quoted-printable');
            POP3.Retrieve(i, Msg);
            Memo1.Lines.Add('Subject: ' + Msg.Subject);
            Memo1.Lines.Add('Body:');
            Memo1.Lines.Add(Msg.Body.Text);
          end;
      finally
        Msg.Free;
      end;
      POP3.Disconnect;
    finally
      SSL.Free;
    end;
  finally
    POP3.Free;
  end;
end;

See Also:

Indy 10 を使ってメール(ISO-2022-JP)を送受信するには？ (Delphi 2009 以降)

　ISO-2022-JP を使って Mail を送受信するサンプルです。

Indy 10 のインストール

　インストール方法は "62. Delphi 2009 に最新版の Indy10 をインストールする" を参考にして下さい。特に Delphi 2009 は最新版の Indy をインストールしないと、理不尽なコードを記述するハメになります。

サンプルコード(送信)

procedure TForm1.IdMessage_InitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
begin
  VHeaderEncoding := 'B'; // 念のために BASE64 エンコーディング
  VCharSet := 'ISO-2022-JP';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SMTP: TIdSMTP;
  Msg : TIdMessage;
begin
  SMTP := TIdSMTP.Create(nil);
  try
    SMTP.Host     := 'smtp.hogehoge.com';
    SMTP.Port     := 25;
    SMTP.Connect;
    Msg := TIdMessage.Create(SMTP);
    try
      Msg.OnInitializeISO           := IdMessage_InitializeISO;
      Msg.ContentType               := 'text/plain';
      Msg.CharSet                   := 'ISO-2022-JP';
      Msg.ContentTransferEncoding   := 'BASE64';            // 念のために BASE64 エンコーディング
      Msg.From.Name                 := 'from@hogehoge.com'; // 送信者のメールアドレス
      Msg.From.Address              := 'from@hogehoge.com'; // 送信者のメールアドレス
      Msg.Recipients.EMailAddresses := 'to@hogehoge.com';   // 送信先のメールアドレス
      Msg.Subject                   := '件名です';
      Msg.Body.Text                 := '本文です';
      SMTP.Send(Msg);
    finally
      Msg.Free;
    end;
    SMTP.Disconnect;
  finally
    SMTP.Free;
  end;
end;

　所謂、"波ダッシュ問題" を解決するには一工夫必要になります。

uses
  ..., MECSUtils;

procedure TForm1.IdMessage_InitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
begin
  VHeaderEncoding := 'B'; // 念のために BASE64 エンコーディング
  VCharSet := 'ISO-2022-JP';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SMTP: TIdSMTP;
  Msg : TIdMessage;
begin
  SMTP := TIdSMTP.Create(nil);
  try
    SMTP.Host     := 'smtp.hogehoge.com';
    SMTP.Port     := 25;
    SMTP.Connect;
    Msg := TIdMessage.Create(SMTP);
    try
      Msg.OnInitializeISO           := IdMessage_InitializeISO;
      Msg.ContentType               := 'text/plain';
      Msg.CharSet                   := 'ISO-2022-JP';
      Msg.ContentTransferEncoding   := 'BASE64';            // 念のために BASE64 エンコーディング
      Msg.From.Name                 := 'from@hogehoge.com'; // 送信者のメールアドレス
      Msg.From.Address              := 'from@hogehoge.com'; // 送信者のメールアドレス
      Msg.Recipients.EMailAddresses := 'to@hogehoge.com';   // 送信先のメールアドレス
      Msg.Subject                   := MecsMappingFix_UnicodeToJISX0208('件名です');
      Msg.Body.Text                 := MecsMappingFix_UnicodeToJISX0208('本文です');
      SMTP.Send(Msg);
    finally
      Msg.Free;
    end;
    SMTP.Disconnect;
  finally
    SMTP.Free;
  end;
end;

サンプルコード(受信)

procedure TForm1.Button2Click(Sender: TObject);
var
  POP3: TIdPOP3;
  Msg : TIdMessage;
  i, MsgCnt: Integer;
begin
  Memo1.Clear;
  POP3 := TIdPOP3.Create(nil);
  try
    POP3.Host     := 'pop.hogehoge.com';
    POP3.Port     := 110;
    POP3.Username := 'user_hoge'; // UserName
    POP3.Password := 'pass_hoge'; // Password
    POP3.Connect;
    Msg := TIdMessage.Create(nil);
    try
      MsgCnt := POP3.CheckMessages;
      for i:=1 to MsgCnt do
        begin
          POP3.RetrieveHeader(i, Msg);
          Msg.NoDecode :=
            (LowerCase(Msg.ContentTransferEncoding) <> 'base64') and
            (LowerCase(Msg.ContentTransferEncoding) <> 'quoted-printable');
          POP3.Retrieve(i, Msg);
          Memo1.Lines.Add('Subject: ' + Msg.Subject);
          Memo1.Lines.Add('Body:');
          Memo1.Lines.Add(Msg.Body.Text);
        end;
    finally
      Msg.Free;
    end;
    POP3.Disconnect;
  finally
    POP3.Free;
  end;
end;

　Indy 10 では ISO-2022-JP のメールを送信する際に文字コードの変換をする必要はありません。単純に String で受け渡し可能です。また、ISO-2022-JP は 7bit エンコーディングなので、本来 BASE64 で改めて 7bit 化する事に意味はありません(少なくとも仕様上は)。しかし、現実問題として Mail サーバ/クライアントの仕様により文字化けを起こす場合がありますので、なるべく BASE64 化するようにしてください。

See Also:

BACK