この発言に対し以下のコメントが寄せられています

#00819　河邦 正         さん　RE:CAB形式のファイル圧縮・解凍

#01338　河邦 正         さん　RE:CAB形式のファイル圧縮・解凍







【タイトル】CAB 形式の書庫にファイルを圧縮・解凍する例です。

　発言行数の制限をクリアするため、見苦しい部分があります。また、最低限
のコードしか含まれていません。本来は設定することが望ましい部分も一部が
省略されています。
　このサンプルコードは C/C++用の SDK を読解する‘手がかり’として読ん
でください。アプリケーションを構築・配布するためには、必ず SDK を読む
ことをお勧めします。
　でも肝心の SDK の URL が思い出せないので、どなたかコメントでフォロー
していただけると助かります（^^;。
　
interface　// ここから Interface部に書くコードです

type // 使用する構造体などの定義
  TERF = record
    erfOper, erfType: Integer;
    fError: BOOL;
  end;
  PERF = ^TERF;

  TCCAB = record
    cb, cbFolderThresh: ULONG;
    cbReserveCFHeader, cbReserveCFFolder, cbReserveCFData: UINT;
    iCab, iDisk, fFailOnIncompressible: Integer;
    setID: WORD;
    szDisk, szCab, szCabPath: array[0..255] of Char;
  end;
  PCCAB = ^TCCAB;

  TFDICABINETINFO = record
    cbCabinet: Longint;
    cFolders, cFiles, setID, iCabinet: WORD;
    fReserve, hasprev, hasnext: BOOL;
  end;
  TFDINOTIFICATIONTYPE = (fdintCABINET_INFO, fdintPARTIAL_FILE,
    fdintCOPY_FILE, fdintCLOSE_FILE_INFO, fdintNEXT_CABINET,
    fdintENUMERATE);
  PFDICABINETINFO = ^TFDICABINETINFO;
  TFDIERROR = (FDIERROR_NONE, FDIERROR_CABINET_NOT_FOUND,
    FDIERROR_NOT_A_CABINET, FDIERROR_UNKNOWN_CABINET_VERSION,
    FDIERROR_CORRUPT_CABINET, FDIERROR_ALLOC_FAIL,
    FDIERROR_BAD_COMPR_TYPE, FDIERROR_MDI_FAIL, FDIERROR_TARGET_FILE,
    FDIERROR_RESERVE_MISMATCH, FDIERROR_WRONG_CABINET,
    FDIERROR_USER_ABORT);
  TFDINOTIFICATION = record
    cb: Longint;
    psz1, psz2, psz3: PChar;
    pv: Pointer;
    hf: Integer;
    date, time, attribs, setID, iCabinet, iFolder: WORD;
    fdie: TFDIERROR;
  end;
  PFDINOTIFICATION = ^ TFDINOTIFICATION;

// Cabinet.DLL から呼び出す関数の定義
function FCICreate(var erf:TERF; fnFiledest, fnAlloc, fnFree, fnOpen,
  fnRead, fnWrite, fnClose, fnSeek, fnDelete, fnfcigtf: Pointer;
  var ccab: TCCAB; pv: Pointer): THandle; cdecl;
function FCIDestroy(THandle: THandle): BOOL; cdecl;
function FCIAddFile(THandle:THandle; pszSourceFile, pszFileName:PChar;
 fExecute: BOOL; pfnfcignc, pfnfcis, pfnfcigoi: Pointer;
 typeCompress: WORD):BOOL; cdecl;
function FCIFlushCabinet(THandle: THandle; fGetNextCab: BOOL;
  pfnfcignc, pfnfcis: Pointer): BOOL; cdecl;
function FCIFlushFolder(fci: THandle;
  GetNextCab, pfnProgress: Pointer): BOOL; cdecl;
function FDICreate(fnAlloc, fnFree, fnOpen, fnRead, fnWrite, fnClose,
  fnSeek: Pointer; cpuType: Integer; var erf: TERF): THandle; cdecl;
function FDIDestroy(THandle: THandle): BOOL; cdecl;
function FDIIsCabinet(THandle: THandle; hf: Integer;
  pfdici: PFDICABINETINFO): BOOL; cdecl;
function FDICopy(THandle:THandle; pszCabinet:PChar; pszCabPath:PChar;
  flags: Integer; pfnfdin, pfnfdid: Pointer; pvUser: Pointer):
  BOOL; cdecl;

implementation // ここから Implementation部に書くコードです

// Cabinet.DLL から呼び出す関数の定義
const CAB_DLL = 'CABINET.DLL';
function FCICreate; external CAB_DLL name 'FCICreate';
function FCIDestroy; external CAB_DLL name 'FCIDestroy';
function FCIAddFile; external CAB_DLL name 'FCIAddFile';
function FCIFlushCabinet; external CAB_DLL name 'FCIFlushCabinet';
function FCIFlushFolder; external CAB_DLL name 'FCIFlushFolder';
function FDICreate; external CAB_DLL name 'FDICreate';
function FDIDestroy; external CAB_DLL name 'FDIDestroy';
function FDIIsCabinet; external CAB_DLL name 'FDIIsCabinet';
function FDICopy; external CAB_DLL name 'FDICopy';

// ここから、コンテキスト構築に用いるコールバック関数の例です
function fnFilePlaced(var ccab:TCCAB; pszFile:PChar; cbFile:Longint;
  fContinuation: BOOL; pv: Pointer): THandle; cdecl;
begin
  Result := 0;
end;

function fnAlloc(Size: ULONG): Pointer; cdecl;
begin
  GetMem(Result, Size);
end;

procedure fnFree(memory: Pointer); cdecl;
begin
  FreeMem(memory);
end;

function fnOpen(pszFile: PChar; oflag: Integer; pmode: Integer;
  err: PInteger; pv: Pointer): Integer; cdecl;
const
  O_RDONLY  = $0000;
  O_WRONLY  = $0001;
  O_RDWR    = $0002;
  O_CREAT   = $0100;
  O_EXCL    = $0400;
var
  Style: UINT;
  os: OFSTRUCT;
begin
  if(oflag and O_CREAT) <> 0 then Style := OF_CREATE
  else
  case(oflag and 3)of
  0: Style := OF_Read;
  1: Style := OF_Write;
  else Style := OF_ReadWrite;
  end;
  if(oflag and O_EXCL) <> 0 then Style := Style or OF_Share_Exclusive;
  Result := OpenFile(pszFile, os, Style); // 行数節約して旧APIを使用
end;

function fnRead(hf:Integer; memory:Pointer; cb:UINT; err:PInteger;
  pv: Pointer): UINT; cdecl;
begin
  Result := _lread(hf, memory, cb);
end;

function fnWrite(hf:Integer; memory:Pointer; cb:UINT; err:PInteger;
  pv: Pointer): UINT; cdecl;
begin
  Result := _lwrite(hf, memory, cb);
end;

function fnClose(hf: Integer; err, pv: Pointer): Integer; cdecl;
begin
  Result := _lclose(hf);
end;

function fnSeek(hf: Integer; dist: Longint; seektype: Integer;
  err: PInteger; pv: Pointer): Longint; cdecl;
begin
  Result := _llseek(hf, dist, seektype);
end;

function fnDelete(pszFile: PChar; err: PInteger; pv: Pointer):
  Integer; cdecl;
begin
  Result := Integer(DeleteFile(pszFile));
end;

function fnFciGTF(pszTempName: PChar; cbTempName: Integer;
  pv: Pointer): BOOL; cdecl;
var
  pPath: array[0..255]of Char;
begin
  Result := (GetTempPath(sizeof(pPath), pPath) <> 0) and
            (GetTempFileName(pPath, 'cab', 0, pszTempName) <> 0);
end;

function fnGetNextCabinet(var ccab: TCCAB; cbPrevCab: ULONG;
  pv: Pointer): BOOL; cdecl;
begin
  // この部分は手抜きです。ごめんなさい。
end;

function fnStatus(typeStatus: UINT; cb1, cb2: ULONG; pv: Pointer):
  Longint; cdecl;
begin
  // この部分は手抜きです。ごめんなさい。
end;

function fnOpenInfo(pszName:PChar; var pDate:WORD; var pTime:WORD;
  var pAttrib: WORD; err: PInteger; pv: Pointer): Integer; cdecl;
var
  os: OFSTRUCT;
begin // 本来はここでファイルの属性なども取得します
  Result := OpenFile(pszName, os, OF_READ);
end;

// 簡単に利用するために２つの関数にまとめてみました
// CabinetAddFiles    ：リスト中のファイルを CAB に圧縮します
// CabinetExtractFile ：CAB からファイルを解凍します

procedure CabinetAddFiles(Cabinet: string; Files: TStrings);
var
  fci: THandle;
  erf: TERF;
  ccab: TCCAB;
  i: Integer;
begin
  ZeroMemory(@erf, sizeof(erf));
  ZeroMemory(@ccab, sizeof(ccab));
  with ccab do
  begin
    cb := $1000000;
    StrPCopy(szDisk, 'DISK1');
    StrPCopy(szCab, PChar(ExtractFileName(Cabinet)));
    StrPCopy(szCabPath, PChar(ExtractFilePath(Cabinet)));
  end;
  // コンテキストの構築にコールバック関数を用います
  fci := FCICreate(erf, @fnFilePlaced, @fnAlloc, @fnFree,
    @fnOpen, @fnRead, @fnWrite, @fnClose, @fnSeek, @fnDelete,
    @fnFciGTF, ccab, nil);
  if fci <> 0 then
  try
    for i := 0 to Files.Count -1 do
    // ファイル名と別な名前を指定して格納することもできます
    // 圧縮形式は MS-ZIP にしています（最後の引数 1）。
    if FCIAddFile(fci, PChar(Files[i]), PChar(Files[i]), FALSE,
      @fnGetNextCabinet, @fnStatus, @fnOpenInfo, 1) = FALSE then
      ShowMessage('ERROR: FCIAddFile');

    if FCIFlushCabinet(fci, FALSE, @fnGetNextCabinet, @fnStatus)
       = FALSE then ShowMessage('ERROR: FCIFlushCabinet');
  finally
    // 使用済みコンテキストの破棄
    FCIDestroy(fci);
  end;
end;

procedure CabinetExtractFile(Cabinet, Item, ExtractName: string);

  function fnFDINotify(fdint: TFDINOTIFICATIONTYPE;
    pfdin: PFDINOTIFICATION): Integer; cdecl;
  var
    os: OFSTRUCT;
  begin
    case(fdint)of
    fdintCOPY_FILE:
      if CompareText(pfdin^.psz1, Item) = 0 then
        Result := OpenFile(PChar(ExtractName), os, OF_CREATE)
      else
        Result := 0;
    fdintCLOSE_FILE_INFO:
      begin // 本来はここでファイルの属性などを設定します
        _lclose(pfdin^.hf);
        pfdin^.cb := 1; // continue
        Result := 1;    // こっちが continue の指定？
      end;
    else // できれば他の　NotificationType にも応答する方が良いはず
      Result := 0;
    end;
  end;

var
  fdi: THandle;
  erf: TERF;
begin
  ZeroMemory(@erf, sizeof(erf));
  // コンテキストの構築にコールバック関数を用います
  fdi := FDICreate(@fnAlloc, @fnFree, @fnOpen, @fnRead, @fnWrite,
    @fnClose, @fnSeek,-1, erf);
  if fdi <> 0 then
  try
    FDICopy(fdi, PChar(ExtractFileName(Cabinet)),
      PChar(ExtractFilePath(Cabinet)), 0, @fnFDINotify, nil, nil);
  finally
    // 使用済みコンテキストの破棄
    FDIDestroy(fdi);
  end;
end;

// 以下はボタンのイベントハンドラに用いる例です。
// ２個のファイル（FCI.H & FDI.H）を TEST.CAB に圧縮します
procedure TForm1.Button1Click(Sender: TObject);
var
  Files: TStringList;
begin
  Files := TStringList.Create;
  Files.Add('FCI.H');
  Files.Add('FDI.H');
  CabinetAddFiles('TEST.CAB', Files);
  Files.Free;
end;

// TEST.CAB から２個のファイル（FCI.H & FDI.H）を解凍します
procedure TForm1.Button2Click(Sender: TObject);
begin
  // 拡張子を *.TXT に変更して解凍します
  CabinetExtractFile('TEST.CAB', 'FCI.H', 'FCI.TXT');
  CabinetExtractFile('TEST.CAB', 'FDI.H', 'FDI.TXT');
end;

Ｐ．Ｓ．
　私自身もＣＡＢを使いはじめたばかりなので、質問されても「ＳＤＫを
読んでね」としか答えられない場合があります。ご容赦ください。

        1999/02/10、河邦 正（GCC02240@nifty.ne.jp）

Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。