ホーム >プログラム >Delphi 6 ローテクTips >Unicode対応のParamStr

ショートカットへのドラッグアンドドロップでウムラウトのようなUnicode文字の入ったファイルを受け取り処理したいと思いました。



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があるのを知ったので書きかえ。