ＤＥＫＯのざつだん

ざつだん。 (12/11/01～)

・文字列プロパティエディタ
　以前、delfusa 氏がラベルの改行についての記事をブログに書いていました。とある調査の副産物で文字列プロパティエディタを作る事になってしまったので公開しておきます...何番煎じなんでしょうね？でも、QC に入れられるくらいだから、それなりに需要はあるのでしょう。

StringPropertyEditor.zip

　アーカイブを解凍し、PkgCustomPropertyEditor.dpk を Delphi で開いてインストールすれば使えるようになります。オブジェクトインスペクタで string あるいは TCaption のプロパティをダブルクリックするか、[…] ボタンを押下するとプロパティエディタが開きます。

　画像のように、TLabel の Caption を改行する事ができます。ソースは長くないので、個別に解説してみます。

・ PkgCustomPropertyEditor.dpk
　プロパティエディタ登録専用のパッケージのユニットです。他の (設計時) パッケージにインストールするのであれば、このファイルは不要です。

{*******************************************************}
{                                                       }
{      カスタムプロパティエディタ登録用パッケージ       }
{                                                       }
{*******************************************************}
package PkgCustomPropertyEditor;

{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'Custom Property Editor'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  vcl,
  designide,
  xmlrtl,
  vclactnband,
  vclx;

contains
  frmuStringPropertyEditor in 'frmuStringPropertyEditor.pas' {frmStringPropertyEditor},
  uRegCustomPropertyeditor in 'uRegCustomPropertyEditor.pas';

end.

　{$DESIGNONLY} コンパイル指令が記述されている事でも解りますが、プロパティエディタのパッケージは設計時パッケージとなります。知ってるヒトには何を今更ですが、Delphi 6 で行われた "実行時パッケージと設計時パッケージの分離" とは、誤解を恐れずに言えば「"コンポーネント" と "プロパティエディタ / コンポーネントエディタ" は別パッケージにしなさい」という事です。実行時ライブラリにプロパティエディタ / コンポーネントエディタのコードが含まれるとアプリケーションのサイズが大きくなるだけで、メリットは何もありませんからね。

・ uRegCustomPropertyEditor.pas
　プロパティエディタを登録するためのユニットです。

{*******************************************************}
{                                                       }
{        カスタムプロパティエディタ登録用ユニット       }
{                                                       }
{*******************************************************}
unit uRegCustomPropertyEditor;

interface

uses
  Controls,
  DesignIntf;

procedure register;

implementation

uses
  frmuStringPropertyEditor; // 文字列用プロパティエディタ

procedure register;
begin
  // string 型のプロパティ (すべて) に関連付け
  RegisterPropertyEditor(TypeInfo(string), nil, '', TCustomizedStringProperty);

  // TCaption 型のプロパティ (すべて) に関連付け
  RegisterPropertyEditor(TypeInfo(TCaption), nil, '', TCustomizedStringProperty);
end;
end.

　TCustomizedStringProperty というプロパティエディタを、すべての string プロパティと TCaption プロパティに割り当てています。他に割り当てたい "string と互換性のある型" があれば (TFileName とか？) 追記してください。

・ frmuStringPropertyEditor.dfm
　DFM のコードを貼り付けても面白くないと思うので、ここは画像を。

　ボタン 2 個とメモ一つ、レイアウト用にパネルが一つあるだけの、何の変哲もないフォームです。キャプション類はすべて空にしてあります。

・ frmuStringPropertyEditor.pas
　プロパティエディタ本体と、プロパティエディタ用ダイアログのソースコードです。

{*******************************************************}
{                                                       }
{       文字列用プロパティエディタ / ダイアログ         }
{                                                       }
{*******************************************************}
unit frmuStringPropertyEditor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Consts, Dialogs, StdCtrls, ExtCtrls, DesignIntf, DesignEditors;

type
  {TfrmStringPropertyEditor}
  TfrmStringPropertyEditor = class(TForm)
    pnlBottom: TPanel;
    mmString: TMemo;
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure mmStringKeyPress(Sender: TObject; var Key: Char);
  public
    function ShowModal(PropName: string): Integer; reintroduce; overload;
  end;

  { TCustomizedStringProperty }
  TCustomizedStringProperty = class (TStringProperty)
    public
      procedure Edit; override;
      function GetAttributes: TPropertyAttributes; override;
  end;

implementation

{$R *.dfm}

{TfrmStringPropertyEditor}
// -----------------------------------------------------------------------------
procedure TfrmStringPropertyEditor.FormCreate(Sender: TObject);
// フォーム作成時
begin
  btnOK.Caption := SOKButton;
  btnCancel.Caption := SCancelButton;
  mmString.Font.Size := mmString.Font.Size + 1; // 好みで調整してください
end;

procedure TfrmStringPropertyEditor.mmStringKeyPress(Sender: TObject;
  var Key: Char);
// TMemo で 〔Ctrl〕+〔A〕による全選択を可能にする
begin
  if Key = ^A then
    begin
      (Sender as TMemo).SelectAll;
      Key := #$00;
    end;
end;

function TfrmStringPropertyEditor.ShowModal(PropName: string): Integer;
// ShowModal オーバーロードメソッド
begin
  Caption := Format('%s: %s', [SPropertiesVerb, PropName]);
  result := inherited ShowModal;
end;

{ TCustomizedStringProperty }
// -----------------------------------------------------------------------------
procedure TCustomizedStringProperty.Edit;
// プロパティ編集用メソッド
var
  StringPropertyEditor: TfrmStringPropertyEditor;
begin
  inherited;
  StringPropertyEditor := TfrmStringPropertyEditor.Create(nil);
  try
    StringPropertyEditor.mmString.Text := Self.GetStrValue;
    if StringPropertyEditor.ShowModal(Self.GetName) = mrOK then
      SetStrValue(StringPropertyEditor.mmString.Text);
  finally
    StringPropertyEditor.Free;
  end;
end;

function TCustomizedStringProperty.GetAttributes: TPropertyAttributes;
// プロパティエディタ属性取得メソッド
begin
  result := [paDialog, paMultiSelect]; // ダイアログ形式プロパティエディタ, 複数選択対応
end;

end.

　これまた大した事は何もやってありませんね。プロパティエディタは TStringProperty から派生しています。入力欄 (TMemo) を〔Ctrl〕+〔A〕で全選択できるようにしてありますが、"^ はべき乗の演算子ではない" というトピックに出てきたコントロールコードが使われています。

　ダイアログのキャプションやボタンのキャプションは文字列定数 (Consts.pas) から持ってきていますので、Delphi 2010 以降ならライブラリの言語を切り替えれば英語版が作れたりします。ソースコードのコメントは日本語ですが、ソースファイルは UTF-8 なのでガイジンサンでもそのままインストールできます。

12/11/07

・ Delphi で & は "ビット AND" の演算子ではないけれど？
　Delphi での & は "ビット AND" の演算子ではありません。「そもそも Delphi で & なんて使ったっけ？」と思われるかもしれませんが、2 つの使用法があります。

　一つはインラインアセンブラの識別子のオーバーライド演算子としてです。

var
  Ch: Char;
begin  
  ...
  asm
    MOV     &CH,1
  end;
  ...
end;

　この場合の &CH は Char 型変数の CH を指します。

　もう一つは、拡張識別子 (Delphi 2005 以降で利用可能) としてです。例えば次のようなレコードがあったとすると、

type
  // TMyRecord
  TMyRecord = record
    Code: Integer;
    Type: Integer;
    Name: String;
  end;

　このままでは Type が予約語とカブっているのでエラーになりますが、次のようにするとこの問題を回避できます。

type
  // TMyRecord
  TMyRecord = record
    Code: Integer;
    &Type: Integer;
    Name: String;
  end;

　他言語のクラスの互換クラスを作ろうとした時や、構造体を作ろうとした時にメンバの名前が Delphi の予約語とカブってしまった時に使えます...まぁ、そんな時は大抵メンバの名前を変えるので拡張識別子のお世話になることはあまりないのですが。

　実用性は皆無に等しいですが、予約語とカブっていなくても拡張識別子を使える事を利用して、次のようなキモいコードを書く事もできます。

var
  &i: Integer;
  &s: string;
begin
  &s := '';
  for &i:=0 to 9 do
    &s := &s + IntToStr(&i);
  ShowMessage(&s);
end;

　それと、面白いことに演算子のオーバーロードで使われる In 演算子の定義部には & が必要ありません (IDE のコードエディタはたまに & を付けようとしますが)。汎用ビットフィールド操作レコードの定義部を確認してみてください。

12/11/08

・ Delphi で { } は (* *) で置き換えられるけど？
　Delphi のブロックコメントは { } という特殊シンボルで記述しますが、(* *) で置き換える事もできます。

var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
{
    SL.Add('ABC');
    SL.Add('DEF');
}
    SL.Add('GHI');
    SL.Add('JKL');
    ShowMessage(SL([0]));
  finally
    SL.Free;
  end;
end;

　こんな感じですね。

var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
(*
    SL.Add('ABC');
    SL.Add('DEF');
*)
    SL.Add('GHI');
    SL.Add('JKL');
    ShowMessage(SL([0]));
  finally
    SL.Free;
  end;
end;

　{ } は (* *) と (特殊シンボルとしては) 完全代替可能なので (*$IFDEF DEBUG*) なんてのも可能です。では次のコードはどうでしょう？

var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Add('ABC');
    SL.Add('DEF');
    SL.Add('GHI');
    SL.Add('JKL');
    ShowMessage(SL(.0.));
  finally
    SL.Free;
  end;
end;

　Delphi の [ ] は (. .) で完全代替可能です。(.0.) は [0] と同じなのですが、なんとなくカワイイですね。なお、コードエディタはこの特殊シンボルの代替の件を完全に忘れているので赤波線を引いてくれます (w

12/11/17

・ System.Zip.TZipFile を改変して Shift_JIS な Zip ファイルを扱えるようにする (XE2)
　経緯は Delphi Q&A の "ZipFileによるZip圧縮時の日本語ファイル名文字化け対処方法" を参照してください。僕の個人的な言い分は既に書いてありますのでこちらではあえて説明しません。

　Shift_JIS な Zip ファイルを扱うためには、継承クラスやクラスヘルパで対処する等の簡単な措置では無理です。現状、(恐らく) System.Zip を書き換えるしかないのですが、直接書き換えるのはオススメしません。

　それと、単に Shift_JIS な ZIP を扱うだけであれば、

 type                                    
   TOem437String = type AnsiString(932); // MOD

　TOem437String の定義を書き換え、ハードコードされている数値定数 437 を 932 に置換するだけでいいのですが、これでは根本的な解決には至りません (他のコードページの ZIP に対処できないので)。そこで現実的な実装を考えてみました。以下に System.Zip を改変したユニット System.ZipEx の作成方法を記します。

System.Zip.pas を適当なプロジェクトフォルダへコピー
コピーした System.Zip.pas を System.ZipEx.pas にリネーム
System.ZipEx.pas をエディタで開く

ユニット名を変更します。

// unit System.Zip;
unit System.ZipEx; // MOD

オリジナルのクラスと混同しないようにするため、ソースコード中の TZipFile を TZipFileEx でリファクタリングで全置換 (この作業は必須ではありません)。

宣言部に定数 ZIP_NATIVE_CODEPAGE を追加

  ...
uses
  System.SysUtils,
  System.IOUtils,
  System.Generics.Collections,
  System.Classes;

const                        // ADD
  ZIP_NATIVE_CODEPAGE = 437; // ADD

type
  /// <summary> Zip Compression Method Enumeration </summary>
  TZipCompression = (
  ...

TZipFileEx の Private フィールドに FCodePage を追加

  TZipFileEx = class
  ...
  private            
    FCodePage: Word; // ADD
  ...

ハードコードされた 437 という数値定数を FCodePage で置換。ReadCentralHeader() メソッドと Read() メソッドの実装部にあります。

procedure TZipFile.ReadCentralHeader;
begin
  ...
    if LHeader.FileNameLength > 0 then
    begin
      ...
//      SetCodepage(LHeader.FileName, 437, False);
        SetCodepage(LHeader.FileName, FCodepage, False); // MOD
      ...
    end;
    if LHeader.ExtraFieldLength > 0 then
    begin
      ...
    end;
    if LHeader.FileCommentLength > 0 then
    begin
      ...
//      SetCodepage(LHeader.FileName, 437, False);
        SetCodepage(LHeader.FileName, FCodepage, False); // MOD
      ...
    end;
  ...
end;

procedure TZipFile.Read(Index: Integer; out Stream: TStream; out LocalHeader: TZipHeader);
begin
  ...
//  SetCodepage(LocalHeader.FileName, 437, False);
    SetCodepage(LocalHeader.FileName, FCodepage, False); // MOD
  ...
end;

実装部の TOem437String をコメントアウト

// type                                    // DEL
//   TOem437String = type AnsiString(437); // DEL

TZipFileEx.SetFileComment メソッドの実装部を書き換え

procedure TZipFileEx.SetFileComment(Index: Integer; Value: string);
begin
  ...
{
  if UTF8Support then
    LFile.FileComment := UTF8Encode(Value)
  else
    LFile.FileComment := TOem437String(Value);
}
  // MOD From Here
  LFile.FileComment := UTF8Encode(Value);
  if not UTF8Support then
    SetCodepage(LFile.FileComment, FCodePage);
  // MOD Until Here 
  ...
end;

TZipFileEx.Add メソッドの実装部を書き換え (オーバーロードされた 4 つの Add メソッドがあります。引数で判断して下さい)

procedure TZipFileEx.Add(FileName: string; ArchiveFileName: string;
  Compression: TZipCompression);
begin
  ...
{
    if FUTF8Support then
    begin
      LHeader.Flag := LHeader.Flag or (1 SHL 11); // Language encoding flag, UTF8
      LHeader.FileName := UTF8Encode(ArchiveFileName);
    end
    else
      LHeader.FileName := TOem437String(ArchiveFileName);
}
    // MOD From Here
    LHeader.FileName := UTF8Encode(ArchiveFileName);
    if FUTF8Support then
      LHeader.Flag := LHeader.Flag or (1 SHL 11)  // Language encoding flag, UTF8
    else
      SetCodePage(LHeader.FileName, FCodePage);
    // MOD Until Here 
  ...
end;

オーバーロードされた、もう一つの TZipFileEx.Add メソッドの実装部を書き換え (オーバーロードされた 4 つの Add メソッドがあります。引数で判断して下さい)

procedure TZipFileEx.Add(Data: TStream; ArchiveFileName: string;
  Compression: TZipCompression);
begin
  ...
{
  if FUTF8Support then
  begin
    LHeader.Flag := LHeader.Flag or (1 SHL 11); // Language encoding flag, UTF8
    LHeader.FileName := UTF8Encode(ArchiveFileName);
  end
  else
    LHeader.FileName := TOem437String(ArchiveFileName);
}
  // MOD From Here
  LHeader.FileName := UTF8Encode(ArchiveFileName);
  if FUTF8Support then
    LHeader.Flag := LHeader.Flag or (1 SHL 11)  // Language encoding flag, UTF8
  else
    SetCodepage(LHeader.FileName, FCodePage);
  // MOD Until Here
  ...
end;

TZipFileEx.Open メソッドの定義部と実装部を書き換え

//  procedure Open(ZipFileName: string; OpenMode: TZipMode); overload;
    procedure Open(ZipFileName: string; OpenMode: TZipMode;                       // MOD
      IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); overload;    // MOD

// procedure TZipFileEx.Open(ZipFileName: string; OpenMode: TZipMode);
procedure TZipFileEx.Open(ZipFileName: string; OpenMode: TZipMode; // MOD
  IsUTF8: Boolean; CodePage: word);                                // MOD
begin
  ...
//  Open(LFileStream, OpenMode);
    Open(LFileStream, OpenMode, IsUTF8, CodePage); // MOD
  ...  
end;

オーバーロードされた、もう一つの TZipFileEx.Open メソッドの定義部と実装部を書き換え

//  procedure Open(ZipFileStream: TStream; OpenMode: TZipMode); overload;
    procedure Open(ZipFileStream: TStream; OpenMode: TZipMode;                 // MOD
      IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); overload; // MOD

// procedure TZipFileEx.Open(ZipFileStream: TStream; OpenMode: TZipMode);
procedure TZipFileEx.Open(ZipFileStream: TStream; OpenMode: TZipMode; IsUTF8: Boolean; CodePage: word); // MOD
begin
  ...
  if OpenMode in [zmRead, zmReadWrite] then
  try
    // Read the Central Header to verify it's a valid zipfile
    FCodePage := CodePage; // ADD
    ReadCentralHeader;
  except
    // If it's an invalid zipfile, cleanup
    FStream := nil;
    raise;
  end;
  FMode := OpenMode;

  // ADD From Here
  if OpenMode in [zmWrite, zmReadWrite] then
    begin
      UTF8Support := IsUTF8;
      FCodePage := CodePage;
    end;
  // ADD Until Here
end;

クラスメソッド TZipFileEx.ExtractZipFile の定義部と実装部を書き換え

//  class procedure ExtractZipFile(ZipFileName: string; Path: string); static;
    class procedure ExtractZipFile(ZipFileName: string; Path: string;         // MOD
       IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); static; // MOD

// class procedure TZipFileEx.ExtractZipFile(ZipFileName: string; Path: string);
class procedure TZipFileEx.ExtractZipFile(ZipFileName: string; Path: string; // MOD
  IsUTF8: Boolean; CodePage: word);                                          // MOD
var
  LZip: TZipFileEx;
begin
  LZip := TZipFileEx.Create;
  try
//  LZip.Open(ZipFileName, zmRead);
    LZip.Open(ZipFileName, zmRead, IsUTF8, CodePage); // MOD
    LZip.ExtractAll(Path);
    LZip.Close;
  finally
    LZip.Free;
  end;
end;

クラスメソッド TZipFileEx.ZipDirectoryContents の定義部と実装部を書き換え

//  class procedure ZipDirectoryContents(ZipFileName: string; Path: string;
//    Compression: TZipCompression = zcDeflate); static;
    class procedure ZipDirectoryContents(ZipFileName: string; Path: string; // MOD
       IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE;        // MOD
       Compression: TZipCompression = zcDeflate); static;                   // MOD

// class procedure TZipFileEx.ZipDirectoryContents(ZipFileName: string; Path: string;
//   Compression: TZipCompression);
class procedure TZipFileEx.ZipDirectoryContents(ZipFileName: string; Path: string; // MOD
  IsUTF8: Boolean; CodePage: word; Compression: TZipCompression);                  // MOD
begin
  ...
//  LZipFile.Open(ZipFileName, zmWrite);
    LZipFile.Open(ZipFileName, zmWrite, IsUTF8, CodePage); // MOD
  ...
end;

コンストラクタの実装部にフィールド初期化を追加

constructor TZipFileEx.Create;
begin
  ...
  FUTF8Support := True;
  FCodePage := ZIP_NATIVE_CODEPAGE; // ADD
end;

TZipFileEx.ReadCentralHeader メソッドの実装部を書き換え - QC#104695 関連バグ修正 (2)

procedure TZipFileEx.ReadCentralHeader;
begin
  ...
    if LHeader.FileCommentLength > 0 then
    begin
      SetLength(LHeader.FileComment, LHeader.FileCommentLength);
      if (LHeader.Flag and (1 SHL 11)) <> 0 then
//      SetCodepage(LHeader.FileName, 65001, False)
        SetCodepage(LHeader.FileComment, 65001, False) // MOD
      else
//      SetCodepage(LHeader.FileName, 437, False);
        SetCodepage(LHeader.FileComment, FCodepage, False); // MOD
      VerifyRead(FStream, LHeader.FileComment[1], LHeader.FileCommentLength);
    end;
  ...  
end;

引数が (Index, Path, CreateSubdirs) な TZipFileEx.Extract メソッドの実装部を書き換え (if 文の begin end が追加されています) - QC#104695 関連バグ修正 (3)

procedure TZipFileEx.Extract(Index: Integer; Path: string; CreateSubdirs: Boolean);
begin
  ...
      if (LHeader.Flag and (1 SHL 3)) = 0 then
{
        if FFiles[Index].UncompressedSize > 0 then // Special case for empty files.
          LOutStream.CopyFrom(LInStream, FFiles[Index].UncompressedSize)
}
        begin                                                                         // MOD
          if FFiles[Index].UncompressedSize > 0 then // Special case for empty files. // MOD
            LOutStream.CopyFrom(LInStream, FFiles[Index].UncompressedSize)            // MOD
        end                                                                          // MOD
        else
        begin
          //CRC, Uncompressed, and Compressed Size follow the compressed data.
  ...
end;

　上記修正方法は XE2 用なので XE3 では多少異なるかもしれません...ですが、やる事は同じです。

・ System.ZipEx.TZipFileEx の使い方
　使い方と言っても従来と同じ書き方なら TZipFile と同じ動作になるので悩む事はないと思います。Shift_JIS なファイル / フォルダの ZIP を扱う場合など、TZipFile と異なる動作をさせたい場合にはメソッドに追加された引数に値を設定します。例えば Tips にあるユニットと同等のものは次のようになります。

unit ZipFiles;

interface

uses
  System.SysUtils, System.ZipEx;

  procedure CompressZipFile(const aFileName, aSrcDir: TFileName;
    IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE);
  procedure DecompressZipFile(const aFileName, aDstDir: TFileName;
    IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE);

implementation

procedure CompressZipFile(const aFileName, aSrcDir: TFileName;
  IsUTF8: Boolean; CodePage: word);
begin
  TZipFileEx.ZipDirectoryContents(aFileName, IncludeTrailingPathDelimiter(aSrcDir), IsUTF8, CodePage);
end;

procedure DecompressZipFile(const aFileName, aDstDir: TFileName;
  IsUTF8: Boolean; CodePage: word);
begin
  TZipFileEx.ExtractZipFile(aFileName, IncludeTrailingPathDelimiter(aDstDir), IsUTF8, CodePage);
end;

end.

　UTF-8 フォルダ / ファイル名を使う場合には従来と同じ記述になります。

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressZipFile('C:\test_UTF8.zip', 'C:\TEST');
end;

　規格通りな CodePage 437 のフォルダ / ファイル名を使う場合には第 3 引数を False にします。

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressZipFile('C:\test_ANSI.zip', 'C:\TEST', False); // Codepage 437
end;

　Shift_JIS なフォルダ / ファイル名を使う場合には第 3 引数を False にし、第 4 引数にコードページとして 932 を渡します。

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressZipFile('C:\test_SJIS.zip', 'C:\TEST', False, 932);
end;

　第 3 引数が False で、第 4 引数に何も指定しなかった場合には (PK)ZIP の仕様通り Codepage 437 なフォルダ / ファイル名になります。つまり、第 4 引数を指定した場合には規格外の ZIP ファイルとなる訳です。また、第 3 引数が True の場合、第 4 引数のコードページ指定は無視されます。

　TZipFileEx をインスタンス化して使う場合には、Open() メソッドで UTF-8 形式か否かと、コードページを指定できます。指定しなければ従来通りです。これにより、UTF8Support プロパティを単独で使う機会がほぼなくなったと思われますが、互換性のために残してあります。

　ZIP はファイルフォーマットとして "UTF-8 か？それ以外 (Codepage 437) か？" というフラグしか持っていないため、IsUTF8 でそれを指定し、規格外の ZIP を扱う場合には CodePage でコードページを指定するような実装になっています。CodePage だけにして、指定されなかったら (65001 だったら) UTF-8、それ以外だったら指定したコードページという実装でもよかったのですが、これだと CodePage 437 の意味がなくなってしまう (規格のハズの CodePage 437 をわざわざ指定しなくてはならない) ので現状の実装になっています。

　System.ZipEx は System.Zip を丸パクリに近い状態で改変しますので、「改変がメンドイので出来上がった System.ZipEx.pas くれ！」と仰られても差し上げる事はできません...ご了承ください。

・ System.Zip.TZipFile 関連情報
　関連情報を載せておきます。

山本隆さんのブログエントリ "Java・.Net Framework・DelphiのZIPファイル中のファイル名の文字コードを調べる" では、他言語での実装状況が詳細に説明されています。
(PK)ZIP のファイルフォーマットは、本家 PKAWARE のものを参照してください。UTF-8 / Codepage 437 の件は 4.4.4 や APPENDIX D に書いてあります。
QC#104695 は、この件を含めたバグの報告です (Kenjiro Fukumitsu さんによる投稿です)。Workarounds には対処方法が書かれています。
(2) は 18. で修正しています。ReadCentralHeader でコメントファイルが正しく処理されない (FileComment ではなく FileName を処理してしまっている) というものです。
(3) は 19. で修正しています。Extract で if 文の begin と end を削りすぎて条件式がおかしくなっているというものです。

　(派生クラスやクラスヘルパで対応できないという意味で) 修正が容易ではないのと、(パクリですから) 修正ファイルを配布できないため、個人的には QC の Vote をお願いしたいトコロです。

12/11/28

・ System.Zip.TZipFile を改変して Shift_JIS な Zip ファイルを扱えるようにする (XE3)
　仕事とデブキャン資料作りで手一杯でこちらにまで手が回らなかったのですが、一息ついたのでやってみました。

　XE3 の場合も単に Shift_JIS な ZIP を扱うだけであれば、ハードコードされている数値定数 437 を 932 に置換するだけでいいです。ただ、前回も書いたようにこれでは根本的な解決には至りません。以下に System.Zip を改変したユニット System.ZipEx の作成方法 (XE3 用) を記します。

System.Zip.pas を適当なプロジェクトフォルダへコピー
コピーした System.Zip.pas を System.ZipEx.pas にリネーム
System.ZipEx.pas をエディタで開く

ユニット名を変更します。

// unit System.Zip;
unit System.ZipEx; // MOD

オリジナルのクラスと混同しないようにするため、ソースコード中の TZipFile を TZipFileEx でリファクタリングで全置換 (この作業は必須ではありません)。

宣言部に定数 ZIP_NATIVE_CODEPAGE を追加

  ...
uses
  System.SysUtils,
  System.IOUtils,
  System.Generics.Collections,
  System.Classes;

const                        // ADD
  ZIP_NATIVE_CODEPAGE = 437; // ADD

type
  /// <summary> Zip Compression Method Enumeration </summary>
  TZipCompression = (
  ...

TZipFileEx の Private フィールドに FCodePage を追加

  TZipFileEx = class
  ...
  private            
    FCodePage: Word; // ADD
  ...

ハードコードされた 437 という数値定数を FCodePage で置換。TBytesToString() メソッドと StringToTBytes() メソッドの実装部にあります。

function TZipFile.TBytesToString(B: TBytes) : string;
begin
  if FUTF8Support then
    E := TEncoding.GetEncoding(65001)
  else
//  E := TEncoding.GetEncoding(437);
    E := TEncoding.GetEncoding(FCodePage); // MOD
    ...
end;

function TZipFile.StringToTBytes(S: string): TBytes;
var
  E: TEncoding;
begin
  if FUTF8Support then
    E := TEncoding.GetEncoding(65001)
  else
//  E := TEncoding.GetEncoding(437);
    E := TEncoding.GetEncoding(FCodepage); // MOD
  ...  
end;

TZipFileEx.Open メソッドの定義部と実装部を書き換え

//  procedure Open(ZipFileName: string; OpenMode: TZipMode); overload;
    procedure Open(ZipFileName: string; OpenMode: TZipMode;                       // MOD
      IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); overload;    // MOD

// procedure TZipFileEx.Open(ZipFileName: string; OpenMode: TZipMode);
procedure TZipFileEx.Open(ZipFileName: string; OpenMode: TZipMode; // MOD
  IsUTF8: Boolean; CodePage: word);                                // MOD
begin
  ...
//  Open(LFileStream, OpenMode);
    Open(LFileStream, OpenMode, IsUTF8, CodePage); // MOD
  ...  
end;

オーバーロードされた、もう一つの TZipFileEx.Open メソッドの定義部と実装部を書き換え

//  procedure Open(ZipFileStream: TStream; OpenMode: TZipMode); overload;
    procedure Open(ZipFileStream: TStream; OpenMode: TZipMode;                 // MOD
      IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); overload; // MOD

// procedure TZipFileEx.Open(ZipFileStream: TStream; OpenMode: TZipMode);
procedure TZipFileEx.Open(ZipFileStream: TStream; OpenMode: TZipMode; IsUTF8: Boolean; CodePage: word); // MOD
begin
  ...
  if OpenMode in [zmRead, zmReadWrite] then
  try
    // Read the Central Header to verify it's a valid zipfile
    FCodePage := CodePage; // ADD
    ReadCentralHeader;
  except
    // If it's an invalid zipfile, cleanup
    FStream := nil;
    raise;
  end;
  FMode := OpenMode;

  // ADD From Here
  if OpenMode in [zmWrite, zmReadWrite] then
    begin
      UTF8Support := IsUTF8;
      FCodePage := CodePage;
    end;
  // ADD Until Here
end;

クラスメソッド TZipFileEx.ExtractZipFile の定義部と実装部を書き換え

//  class procedure ExtractZipFile(ZipFileName: string; Path: string); static;
    class procedure ExtractZipFile(ZipFileName: string; Path: string;         // MOD
       IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE); static; // MOD

// class procedure TZipFileEx.ExtractZipFile(ZipFileName: string; Path: string);
class procedure TZipFileEx.ExtractZipFile(ZipFileName: string; Path: string; // MOD
  IsUTF8: Boolean; CodePage: word);                                          // MOD
var
  LZip: TZipFileEx;
begin
  LZip := TZipFileEx.Create;
  try
//  LZip.Open(ZipFileName, zmRead);
    LZip.Open(ZipFileName, zmRead, IsUTF8, CodePage); // MOD
    LZip.ExtractAll(Path);
    LZip.Close;
  finally
    LZip.Free;
  end;
end;

クラスメソッド TZipFileEx.ZipDirectoryContents の定義部と実装部を書き換え

//  class procedure ZipDirectoryContents(ZipFileName: string; Path: string;
//    Compression: TZipCompression = zcDeflate); static;
    class procedure ZipDirectoryContents(ZipFileName: string; Path: string; // MOD
       IsUTF8: Boolean = True; CodePage: word = ZIP_NATIVE_CODEPAGE;        // MOD
       Compression: TZipCompression = zcDeflate); static;                   // MOD

// class procedure TZipFileEx.ZipDirectoryContents(ZipFileName: string; Path: string;
//   Compression: TZipCompression);
class procedure TZipFileEx.ZipDirectoryContents(ZipFileName: string; Path: string; // MOD
  IsUTF8: Boolean; CodePage: word; Compression: TZipCompression);                  // MOD
begin
  ...
//  LZipFile.Open(ZipFileName, zmWrite);
    LZipFile.Open(ZipFileName, zmWrite, IsUTF8, CodePage); // MOD
  ...
end;

コンストラクタの実装部にフィールド初期化を追加

constructor TZipFileEx.Create;
begin
  ...
  FUTF8Support := True;
  FCodePage := ZIP_NATIVE_CODEPAGE; // ADD
end;

　頑なに Codepage 437 がハードコードされていますが、修正箇所は減っています。QC#104695 の (2) と (3) の件は XE3 で修正されていますね。TZipFileEx の使い方は先日の記事と全く同じです。

　派生クラスやクラスヘルパで対応できない構造だと、このようにバージョン別にパッチしなくてはならないので困るのですよねぇ...ソースコードが付属しない Starter 版では打つ手がないし。XE3 も XE2 も持っているのなら、XE3 の System.Zip.pas を書き換えて XE2 へ (バックアップは取った上で) 書き戻すと手間が少なくて済みます。

BACK

古いのを読む

新しいのを読む