[BlueLeaf1336]> PROBLEMS> DownX>
| history | TOP |
2004/04/01:作成
2004/04/08:codeに明らかな誤りがあったので修正しました(Autchさん、ありがとうございます)。
| overview | TOP |
前回の画像回転プログラムGozaの敗北は、やっぱり、使う予定のないものを作ろうとしたことにあったように思います。結局のところ普段自分で使わないものは、作る途中で絶対に飽きるように思います。使うものも実際のところ世間にどっさり転がっているというのもあれなんですが。
で、することもないので、今回は自分で絶対に使うだろうというプログラムを作ることにします。ちょっと考えてみると、非常によく使うのは、UPXMask(UPXというEXE圧縮プログラムの日本語フロントエンド)と気付きました。これからもUPXMaskを使いましょう。終わり。...ではなく、少しばかり使い心地が悪いのを直そうと、自分で使い心地のよいのを作ろうと、そういうことです。
さて、UPXはコマンドラインプログラムなのですが、ダウンロードして説明書(英語!)をなんとなくで読んでみると、非常にたくさんのオプションスイッチがあることが分かります。当然それをラッピングしたUPXMaskにもそれなりにオプションがついているわけで。ただ、そんなのを使ってるか？というとこれがさっぱり使ってません。
つまるところ自分で使っているのは、圧縮率の設定とドラッグ&ドロップ機能だけといってもかまわないでしょう。また、どのぐらいサイズが縮んだか、を表示(UPXもUPXMaskも)してくれるのですが、それもどっちでもかまわない。たいてい500KB程度のDelphi製EXEが200KB程度になってくれるので、それで十分なわけです。
つまるところ、非常にシンプルにできそうな気がします。それからたいてい1回に1つのEXEしか圧縮しないのでリストボックスに溜め込んで順に処理みたいなのもおそらく必要ないです。ただ、画面なしにしてしまうと、いつ処理が終ったのか分からないのでそのあたりも踏まえて作ってみることにします。
| コマンドラインプログラムの実行 | TOP |
ところで、先ほども書いたように、UPX自体はコマンドラインプログラムで、これをDelphiから実行し結果を取り出したいわけなので、それを実現する必要があります。というか一応実現できてますが、その際に参考にさせてもらったURLを次に挙げておきます。またそれぞれのページで紹介されている関数のインターフェースも掲載させてもらいます。
まず、[Delphi-ML:31027] [Tips] ConsoleRedirect Libraryより、コマンドを文字列で渡して、結果を文字列で受けとるタイプのものを。
function RedirectExec(Proc: string; var StdIn,StdOut,StdErr: String): boolean;
それから、[Delphi] GUI アプリからコンソールアプリを実行するにはより、コマンドを文字列で渡して、入力用のストリーム(これが実は何なのか分からないんですが)、結果をやはりストリームでもらうタイプのもの。
function GrabStdOut(CommandLine: string; StdIn: TMemoryStream): TMemoryStream;
どちらも素晴らしいのですが、たとえば「ping localhost」を実行した時にプログラムの実行が全て完了してからでないと結果が見れない(多分)というのは面白くなかったので(とはいえ今回のUPXのフロントエンド作成計画に関していうと全く関係ないのですが)、リアルタイム風に受け取れるように一部を変更したものが次のコードです。なんというかほぼパクリですが。
| code | TOP |
unit GrabConsole;
interface
uses
Forms, Windows, SysUtils, Classes;
procedure PipeConsole(CommandLine: string; StdOut, ErrOut: TStrings);
implementation
(*
=================================================================
[2004/03/19]
-----------------------------------------------------------------
[Delphi] GUI アプリからコンソールアプリを実行するには
http://hp.vector.co.jp/authors/VA026252/tips/delphi_anonymous_pipe.html
=================================================================
*)
procedure PipeConsole(CommandLine: string; StdOut, ErrOut: TStrings);
var
hReadPipe, hWritePipe: THandle;
hStdInReadPipe, hStdInWritePipe, hStdInWritePipeDup: THandle;
hErrReadPipe, hErrWritePipe: THandle;
sa: TSecurityAttributes;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwStdOut, dwErrOut, dwRet: DWord;
Buf: array[0..8192] of Char;
begin
with sa do
begin
nLength := sizeof(TSecurityAttributes);
lpSecurityDescriptor := nil;
bInheritHandle := true;
end;
hReadPipe := 0;
hWritePipe := 0;
hErrReadPipe := 0;
hErrWritePipe := 0;
CreatePipe(hStdInReadPipe, hStdInWritePipe, @sa, 8192);
DuplicateHandle(GetCurrentProcess(), hStdInWritePipe, GetCurrentProcess(),
@hStdInWritePipeDup, 0, false, DUPLICATE_SAME_ACCESS);
CloseHandle(hStdInWritePipe);
CreatePipe(hReadPipe, hWritePipe, @sa, 8192);
try
CreatePipe(hErrReadPipe, hErrWritePipe, @sa, 8192);
try
ZeroMemory(@StartupInfo, sizeof(TStartupInfo));
with StartupInfo do
begin
cb := sizeof(TStartupInfo);
dwFlags := STARTF_USESTDHANDLES;
// これがないと DOS 窓が表示されてしまう
wShowWindow := SW_HIDE;
// 標準 IO にパイプの端っこを指定してやる
hStdInput := hStdInReadPipe;
hStdOutput := hWritePipe;
hStdError := hErrWritePipe;
end;
// コンソールアプリ起動
if CreateProcess(nil, PChar(CommandLine), @sa, nil, true, DETACHED_PROCESS,
nil, nil, StartupInfo, ProcessInfo) then
begin
try
repeat
Application.ProcessMessages;
Sleep(50);
// 標準出力パイプの内容を調べる
PeekNamedPipe(hReadPipe, nil, 0, nil, @dwStdOut, nil);
// 内容が存在すれば、読み取る
if (dwStdOut > 0) then
begin
FillChar(Buf, SizeOf(Buf), 0);
ReadFile(hReadPipe, Buf, SizeOf(Buf) - 1, dwStdOut, nil);
StdOut.Add(Trim(Buf));
end;
// 同様にエラー出力の処理
PeekNamedPipe(hErrReadPipe, nil, 0, nil, @dwErrOut, nil);
// 内容が存在すれば、読み取る
if (dwErrOut > 0) then
begin
FillChar(Buf, SizeOf(Buf), 0);
// [2004/04/08]誤 hReadPipe -> 正 hErrReadPipe
// ReadFile(hReadPipe, Buf, SizeOf(Buf) - 1, dwErrOut, nil);
ReadFile(hErrReadPipe, Buf, SizeOf(Buf) - 1, dwErrOut, nil);
ErrOut.Add(Trim(Buf));
end;
dwRet := WaitForSingleObject(ProcessInfo.hProcess, 0);
// コンソールアプリのプロセスが存在している間
until
(dwRet = WAIT_OBJECT_0);
finally
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hStdInReadPipe);
end;
end;
finally
CloseHandle(hErrReadPipe);
CloseHandle(hErrWritePipe);
end;
finally
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);
end;
end;
end.
MemoryStreamを廃止して、TStringsで受けとるように変更してます。それからタブを2から4に変更してます(が、pascalって2の方が普通なんですかねぇ？結構2タブのコードを見るような気が。IDEのエディタもデフォルトが2だし)。
あまり意味はわかってないのですが(感じとしては、コマンドラインプログラムがDOS窓から入力をもらったりDOS窓に出力しているつもりが、知らないうちに横取りされてた、見たいな感じになるように入り口と出口をすり替えてしまう、ような。CreateHandleを発行しまくっているのはすり替え用のパイプを作ってるらしいです。以前PlatformSDKをさまよって、大まかのイメージまでは掴んだのですが思い出せないので蒸発したようです)、TStrings(実際には、たとえば TMemo.Lines)を渡すことで大体1行ずつ実行結果を取り出せます。
こんな感じで使います。
PipeConsole('.\upx124w\upx.exe -L', Memo1.Lines, Memo2.Lines);
もちろん実行したプログラムのカレントフォルダに左右されるだろうしいろいろと考慮すべきかもしれませんが、とりあえず動きます。というわけで、もっとも重要な部分は人様のコードを再利用することでほぼ終ってます。あとはこれをどう使うか、だけです。
念のため。「大体1行ずつ」というのは他に表現のしようがないのですが、TStringsで受けとるからそうなるのかどうかはっきりしないのですが、実行結果が途中でチギれてしまうことがあるんです。DOS窓で見ると1行なのに、奪いとるとあらぬ所で改行が入ってしまう。けっこうちょくちょくと。まぁ、気持ちは悪いんですが頑張ってもなぁ、ということで今の所は諦めてます。
今日はここまでにしておきますが、タイトルの「DownX」について少し説明を。なんというか「UPX(ユーピーエックス)」＝「Up(アップ) + X(エックス)」と読めなくもないので、これのヘナチョコフロントエンドということで「Down(ダウン) + X(エックス)」ととりあえずしておきます。また、ドラッグ&ドロップの「下に」落とすというイメージの「Down」も少しだけ引っかけているといえなくもないです。
次回は、大量のUPXのオプションスイッチから、サポートするものを抽出するところからやります。
| EOF | TOP |