ショートカットへのドラッグアンドドロップでウムラウトのようなUnicode文字の入ったファイルを受け取り処理したいと思いました。
参考サイト
CommandLineToArgvW
http://msdn.microsoft.com/library/ja/jpdllpro/html/_win32_commandlinetoargvw.asp?frame=true
コマンドライン
http://eternalwindows.jp/winbase/window/window06.html
GetCommandLineWとCommandLineToArgvWという二つのWindows APIを使います。
GetCommandLineWで取得したコマンドラインの文字列をCommandLineToArgvWを使ってParamStrのようにインデックスを指定して取り出せるように分割してリストに格納します。
※CommandLineToArgW APIは二重引用符で区切られた引数の場合、引数の最後の文字が'\'であるとおかしな動作になってしまいます。
具体的には'\'が消えて'"'が残ります。
"C:\Windows\" → C:\Windows"
おそらく'\'はC言語などでは特殊な扱いになっているので'\'が次の'"'をエスケープしてしまい引数の区切りとしてではなく引数内の文字だという扱いになっているのだと思います。
Unicode(WideString)をTStringsに保持できるようにするためUTF-7を利用します。
function gfnsWideToUtf7(sSrc:
WideString): AnsiString;
//WideStringをUTF-7にエンコードして返す
var
li_Len: Integer;
lp_Buff: PAnsiChar;
begin
li_Len := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc),
-1,
nil, 0,
nil,
nil);
lp_Buff := AllocMem(li_Len + 1);
try
WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff,
li_Len,
nil,
nil);
Result := AnsiString(lp_Buff);
finally
FreeMem(lp_Buff);
end;
end;
function gfnsUtf7ToWide(sSrc: AnsiString):
WideString;
//UTF-7でエンコードされている文字列をWideStringにして返す
var
li_Len: Integer;
lp_Buff: PWideChar;
begin
li_Len := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc),
-1,
nil, 0);
lp_Buff := AllocMem((li_Len + 1) * 2);
try
MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff,
li_Len);
Result :=
WideString(lp_Buff);
finally
FreeMem(lp_Buff);
end;
end;
procedure CmdLineToParam(slList: TStrings);
var
i, li_Count: Integer;
lp_WParam, lp_WArg: PPWideChar;
begin
slList.Clear;
//コマンドラインを取得
lp_WParam := CommandLineToArgvW(GetCommandLineW, li_Count);
try
lp_WArg := lp_WParam;
for i := 0
to li_Count -1
do begin
//コマンドラインを分割しUTF-7に変換してリストに追加
slList.Add(
gfnsWideToUtf7(
WideString(lp_WArg^)));
Inc(lp_WArg);
end;
finally
LocalFree(Cardinal(lp_WParam));
end;
end;
function gfniParamCount: Integer;
var
lsl_Param: TStrings;
begin
lsl_Param := TStringList.Create;
try
CmdLineToParam(lsl_Param);
Result := lsl_Param.Count -1; //ParamCountと合わせるため -1
finally
lsl_Param.Free;
end;
end;
function gfnsParamStr(const iIndex: Integer): WideString;
var
lsl_Param: TStrings;
begin
lsl_Param := TStringList.Create;
try
CmdLineToParam(lsl_Param);
if (0 <= iIndex) and (iIndex <= lsl_Param.Count - 1) then begin
Result := gfnsUtf7ToWide(lsl_Param[iIndex]);
end else begin
Result := '';
end;
finally
lsl_Param.Free;
end;
end;
gfniParamCountはParamCountと同じように引数がなければ0を返します。
gfnsParamStr(0)でプログラムのフルパスの実行ファイル名が得られます。
1番目の引数はgfnsParamStr(1)です。このへんはParamStrと同じです。
インデックス(iIndex)が引数の数より多ければ空文字を返します。
gfniParamCountやgfnsParamStrを呼び出すたびに取得、分割処理を行っているので非効率だと思うならFormのprivate部でTStrings型を宣言してFormCreateで取得分割処理して保存しておいてそれを利用するという手もあります。あるいはunitにしてしまうというのも手かと思います。
unitにした場合のソースコード。
unit param;
interface
function gfniParamCount: Integer;
function gfnsParamStr(
const iIndex: Integer):
WideString;
implementation
uses
Classes, Windows, SysUtils, ShellAPI;
var
liParamCount: Integer;
lslParam: TStrings;
//------------------------------------------------------------------------------
function gfnsWideToUtf7(sSrc:
WideString): AnsiString;
//WideStringをUTF-7にエンコードして返す
var
li_Len: Integer;
lp_Buff: PAnsiChar;
begin
li_Len := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc),
-1,
nil, 0,
nil,
nil);
lp_Buff := AllocMem(li_Len + 1);
try
WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff,
li_Len,
nil,
nil);
Result := AnsiString(lp_Buff);
finally
FreeMem(lp_Buff);
end;
end;
function gfnsUtf7ToWide(sSrc: AnsiString):
WideString;
//UTF-7でエンコードされている文字列をWideStringにして返す
var
li_Len: Integer;
lp_Buff: PWideChar;
begin
li_Len := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc),
-1,
nil, 0);
lp_Buff := AllocMem((li_Len + 1) * 2);
try
MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff,
li_Len);
Result :=
WideString(lp_Buff);
finally
FreeMem(lp_Buff);
end;
end;
//------------------------------------------------------------------------------
//http://msdn.microsoft.com/library/ja/jpdllpro/html/_win32_commandlinetoargvw.asp?frame=true
//http://eternalwindows.jp/winbase/window/window06.html
procedure CmdLinetToParam;
var
i: Integer;
lp_WParam, lp_WArg: PPWideChar;
begin
lp_WParam := CommandLineToArgvW(GetCommandLineW, liParamCount);
try
lp_WArg := lp_WParam;
Dec(liParamCount);
for i := 0
to liParamCount
do begin
lslParam.Add(
gfnsWideToUtf7(
WideString(lp_WArg^)));
//UnicodeをAnsiStringに変換
Inc(lp_WArg);
end;
finally
LocalFree(Cardinal(lp_WParam));
end;
end;
//------------------------------------------------------------------------------
function gfniParamCount: Integer;
begin
Result := liParamCount -1;
end;
function gfnsParamStr(
const iIndex: Integer):
WideString;
begin
if (0 <= iIndex)
and (iIndex <= liParamCount)
then begin
Result :=
gfnsUtf7ToWide(lslParam[iIndex]);
//Stringに変換したものをUnicodeに戻す
end else begin
Result := '';
end;
end;
//------------------------------------------------------------------------------
initialization
lslParam := TStringList.Create;
CmdLinetToParam;
finalization
lslParam.Free;
end.
テスト。
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
myDebug.gpcDebugAdd('引数の数は', gfniParamCount);
for i := 0
to gfniParamCount
do begin
myDebug.gpcDebugAdd(WideFormat('%d %s', [i, gfnsParamStr(i)]));
end;
end;
結果
デバッグ用出力フォームに出力させています。
ウムラウトのようなUnicode文字を含んだファイル名をきちんと取得できているのが分かります。
2008-02-22,03-28,04-28,2009-07-19:
2009-07-19:
CommandLineToArgWは二重引用符で囲んだ引数の最後の文字が'\'のときおかしな動作になることを追記。
2008-04-28:CommandLineToArgvW APIがあるのを知ったので書きかえ。
