|
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
|