Mam's WebSite
建築CGパース住宅CGパース

Mamの覚書Q&A検索

トップページMamの覚書Q&A検索Delphi(いろいろ)⇒Q&A


大項目:「 Delphi 」 - 中項目:「 いろいろ 」

「 Delphi2009からUNLHA32.DLLを使いたい(UNLHA32.DLLはH, Micco様の著作物です) 」

エンバカデロ社のDelphi2009からUNLHA32.DLLを使いたいのですが、どうすればいいですか?
(UNLHA32.DLLはH, Micco様の著作物です)


回答

DelphiからDLLを扱うことは、静的リンク、動的リンクともに可能です。
UNLHA32.DLL(UNLHA32.DLLはH, Micco様の著作物です)を使う場合は
UNLHA32.DLLをどのような使いたいかによって使用方法が変わりますので、
今回は必要なファイルはすべて1つのフォルダに入れてしまった後にそのフォルダを圧縮するとします。
また、UNLHA32.DLLファイルはパスの通った
フォルダ(Windowsフォルダ、System32フォルダなど)にあるものとします。

ソース

unit Unit2;
 
interface
uses windows;
 
Type
  TUnlhaA=function(
    const _hwnd: HWND;
          _szCmdLine: PAnsiChar;
          _szOutput: PAnsiChar;
    const _wSize: longint): integer; stdcall;
  TUnlhaW=function(
    const _hwnd: HWND;
          _szCmdLine: PChar;
          _szOutput: PChar;
    const _wSize: longint): integer; stdcall;
  TUnlha=TUnlhaA;
 
//AnsiString(SJIS)用の関数
function UnLhaCompress(Handle:THandle;path,srcFolder, DestFile: AnsiString):AnsiString;
//String(Unicode)用の関数
function UnLhaCompressW(Handle:THandle;path,srcFolder, DestFile: string):String;
 
implementation
 
function UnLhaCompress(Handle:THandle;path,srcFolder, DestFile: AnsiString):AnsiString;
var lhaHandle:THandle;
    r:AnsiString;
    comm:AnsiString;
    Unlha:TUnlha;
begin
  lhaHandle:=LoadLibrary('UNLHA32.DLL');//動的リンク
  if lhaHandle=0 then
  begin
    result:='UNLHA32.DLLファイルがありません。';
    exit;
  end
  else
  begin
    @Unlha:=GetProcAddress(lhaHandle,'Unlha');
    if @Unlha=nil then
    begin
      result:='UNLHA32.DLLのバージョンが古い等のエラー';
      FreeLibrary(lhaHandle);
      lhaHandle:=0;
      exit;
    end;
  end;
  comm:='a "'+DestFile+'" -x1r2a2 "'+path+'" "'+srcFolder+'"';
  setlength(r,1024);
  Unlha(Handle,PAnsiChar(comm),PAnsiChar(r),1023);
  result:=PAnsiChar(r);
  if lhaHandle<>0 then
    FreeLibrary(lhaHandle);
  if Pos('Frozen',r)=0 then
  begin
    result:='指定したフォルダが無い、ファイルが生成できない等のエラー';
  end;
end;
 
function UnLhaCompressW(Handle:THandle;path,srcFolder, DestFile: string):String;
var lhaHandle:THandle;
    r:String;
    comm:String;
    UnlhaW:TUnlhaW;
begin
  lhaHandle:=LoadLibrary('UNLHA32.DLL');
  if lhaHandle=0 then
  begin
    result:='UNLHA32.DLLファイルがありません。';
    exit;
  end
  else
  begin
    @UnlhaW:=GetProcAddress(lhaHandle,'UnlhaW');
    if @UnlhaW=nil then
    begin
      result:='UNLHA32.DLLのバージョンが古い等のエラー';
      FreeLibrary(lhaHandle);
      lhaHandle:=0;
      exit;
    end;
  end;
  comm:='a "'+DestFile+'" -x1r2a2 "'+path+'" "'+srcFolder+'"';
  setlength(r,1024);
  UnlhaW(Handle,PChar(comm),PChar(r),1023);
  result:=PChar(r);
  if lhaHandle<>0 then
    FreeLibrary(lhaHandle);
  if Pos('Frozen',r)=0 then
  begin
    result:='指定したフォルダが無い、ファイルが生成できない等のエラー';
  end;
end;
end.
 

//上記関数の使い方
//  Handle:ウィンドウハンドル
//    アイコンが時計になるウィンドウ
//    指定できないときは0を指定
//  path:圧縮するフォルダの存在するフォルダ
//    (例)c:\windows\system32 フォルダを圧縮する場合は
//          c:\windows\
//          と指定する[最後の\を必ず指定すること]
//  srcFolder:圧縮するフォルダを指定する
//    (例)c:\windows\system32 フォルダを圧縮する場合は
//          system32
//          と指定する
//  DestFile:圧縮フォルダ名をフルパスで指定する
//    (例)c:\abc.lzh
//
//C:\Test\テストフォルダ を圧縮して、C:\圧縮後ファイル.LZH ファイルを生成する場合
//最初の引数のHandleはウィンドウハンドルです。ウィンドウハンドルを渡すと、圧縮中に
//マウスカーソルがちゃんと時計になります。
//渡さない場合は0を指定。
procedure TForm1.Button1Click(Sender: TObject);
begin
  //ファイルを事前に消さないと、アーカイブへの追加・更新になります。
  DeleteFile('C:\圧縮後ファイル.LZH');
  showmessage(
    UnLhaCompressW(Self.Handle,'C:\Test\','テストフォルダ','C:\圧縮後ファイル.LZH')
  );
end;


Mam's WebSite