お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"ドラッグ&ドロップされた圧縮ファイル解凍"





◆解説
ドラッグ&ドロップされた圧縮ファイル(LZH形式)を解凍するサンプルです。
UNLHA32.DLLが存在すればドラッグ&ドロップを許可し、自分自身をアクティブにして
プログラム中で指定したフォルダーに展開します。
空のプロジェクトにFormCreateとFormCloseのイベントを作成後、ソースを下記の物に
全て置き換えてください。

◆動作確認
  Delphi3.1 + Windows98、Delphi5 + Windows98

◆追記
この会議室のログを読み漁って作成しました。
間違いや、改良案が有ればレスをお願いします。

------------------------- これ以降を置き換え ------------------------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    procedure WMDropFiles( var Msg:TWMDropFIles ); message WM_DROPFILES;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
  UNLHA32DLL: THandle;

implementation

{$R *.DFM}

const
    DstPath = 'C:\Work\';       {ファイル解凍先のパス}
var
    _Unlha: function (_hwnd:HWND; szCmdLine,szOutput:PChar; wSize:dword):
                        integer; StdCall;

//======================================================================
//  機能:プログラム開始時の処理
//======================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
    UNLHA32DLL := LoadLibrary( 'UNLHA32.DLL' );
    @_Unlha    := Nil;
    if UNLHA32DLL<>0 then begin     {UNLHA32.DLLが存在する}
        DragAcceptFiles( Handle,TRUE );     {Drag&Drop受取可}
        @_Unlha := GetProcAddress( UNLHA32DLL,'Unlha' );
    end;
end;


//======================================================================
//  機能:プログラム終了時の処理
//======================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if UNLHA32DLL<>0 then FreeLibrary(UNLHA32DLL);
end;


//======================================================================
//  機能:Drag&Dropされた圧縮ファイルをフォルダーに解凍
//======================================================================
procedure TForm1.WMDropFiles( var Msg:TWMDropFIles );
    // 機能:自アプリケーションをアクティブにする
    procedure MyApplicationActivate;
    var
            MyID, ForeID, MyThread, ForeThread: dword;
    begin
        //現在のフォアグランドウィンドウのプロセスIDを取得
        ForeThread := GetWindowThreadProcessId(GetForegroundWindow,@ForeID);
        //自タスクのプロセスIDを取得
        MyThread   := GetWindowThreadProcessId( Handle,@myID );
        //入力スレッドをアッタチする
        if AttachThreadInput(MyThread,ForeThread,TRUE) then begin
            SetForegroundWindow( Handle );
            AttachThreadInput( MyThread,ForeThread,FALSE );
            //ShowMessage( 'このアプリをアクティブにしました。' );
        end;
    end;
var
        fname: array[0..255] of char;
        CmdLine, Output: string;
        iRet: integer;
        ext: string;
begin
    MyApplicationActivate();    {このプログラムをアクティブウィンドウにする}
    // ファイル名を得る
    DragQueryFile( Msg.Drop,0,fname,255 );
    DragFinish( Msg.Drop );
    ext := ExtractFileExt( StrPas(@fname) );
    if LowerCase(ext)='.lzh' then begin
        // 指定ファイルを解凍する
        CmdLine := format( 'e %s %s',[StrPas(@fname),DstPath] );
        SetLength( Output,255 );    {必要なバッファ量を指定}
        iRet := _Unlha( Handle,PChar(Cmdline),PChar(Output),Length(Output) );
        if iRet=0 then
            MessageDlg('正常に解凍しました。',mtInformation,[mbOk],0)
        else begin
            MessageDlg('指定ファイルを解凍出来ません。',mtError,[mbOk],0);
        end;
    end
    else begin
        MessageDlg('LZH形式以外は処理できません。',mtError,[mbOk],0);
    end;
end;

end.
 



Original document by 曽根 清喜    氏 ID:(CQY00065)


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

Copyright 1996-2002 Delphi Users' Forum