Top / TIPS / CommandLineToArgvW

うわーしらんかった・・・orz
コマンドラインを分解するのに、自分でコーディングした関数を使いまわしていたのですが、CommandLineToArgvW API を使うとできちゃったりします。

   Option Explicit
   
   Private Declare Function CommandLineToArgvAsPtrW Lib "shell32" Alias "CommandLineToArgvW" (ByVal lpCmdLine As Long, pNumArgs As Integer) As Long
   Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
   Private Declare Function lstrlenAsPtrW Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
   Private Declare Function lstrcpyAsPtrW Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
   Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
   ' 符号なし整数と符号あり整数を変換するための定数
   Private Const OFFSET_4      As Currency = 4294967296@
   Private Const MAXINT_4      As Currency = 2147483647
   
   Sub Main()
       
       Dim v As Variant
       
       For Each v In DivCommand(Command$)
           Debug.Print v
       Next
       
   End Sub
   
   '****************************************************************************
   '   コマンドラインを分解する
   '****************************************************************************
   Public Function DivCommand(ByVal iCommand As String) As String()
       Dim lpszArgs    As Long
       Dim nArgs       As Integer
       Dim i           As Long
       Dim nRet        As Long
       Dim sArgs()     As String
   
       lpszArgs = CommandLineToArgvAsPtrW(StrPtr(iCommand), nArgs)
       If lpszArgs <> 0 Then
           ReDim sArgs(nArgs - 1)
           For i = 0 To nArgs - 1
               sArgs(i) = ToStringW(GetPointer(lpszArgs, i))
           Next
           nRet = LocalFree(lpszArgs)
       End If
       DivCommand = sArgs
   
   End Function
   
   '****************************************************************************
   '   ポインタ配列のアドレスからインデックスを指定してポインタを取得
   '****************************************************************************
   Private Function GetPointer(ByVal iAddress As Long, ByVal iIndex As Long) As Long
   Dim lpAddress As Long
   Dim lpPointer As Long
   
       lpAddress = SLONG(ULONG(iAddress) + iIndex * 4)
       
       CopyMemory lpPointer, ByVal lpAddress, Len(lpPointer)
       GetPointer = lpPointer
   
   End Function
   
   '****************************************************************************
   '   符号なし整数を符号付き整数に変換(4バイト)
   '****************************************************************************
   Private Function SLONG(ByVal Value As Currency) As Long
       If Value < 0 Or Value >= OFFSET_4 Then Error 6
       If Value <= MAXINT_4 Then
           SLONG = Value
       Else
           SLONG = Value - OFFSET_4
       End If
   End Function
   
   '****************************************************************************
   '   符号付き整数を符号なし整数に変換(4バイト)
   '****************************************************************************
   Private Function ULONG(ByVal Value As Long) As Currency
       If Value < 0 Then
           ULONG = Value + OFFSET_4
       Else
           ULONG = Value
       End If
   End Function
   
   '****************************************************************************
   '   指定されたアドレスに格納された Unicode 文字を取得
   '****************************************************************************
   Private Function ToStringW(ByVal lpAddr As Long) As String
   Dim nLen As Long
   Dim strBuffer As String
   
       If lpAddr <> 0 Then
           nLen = lstrlenAsPtrW(lpAddr)
           If nLen > 0 Then
               strBuffer = String(nLen + 1, vbNullChar)
               Call lstrcpyAsPtrW(StrPtr(strBuffer), lpAddr)
               ToStringW = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
           Else
               ToStringW = ""
           End If
       Else
           ToStringW = ""
       End If
   
   End Function
   

VB.NET版

   <DllImport("shell32")> _
   Private Shared Function CommandLineToArgvW(ByVal lpCmdLine As IntPtr, ByRef pNumArgs As Integer) As IntPtr

   End Function

   <DllImport("kernel32")> _
   Private Shared Function LocalFree(ByVal hMem As IntPtr) As IntPtr

   End Function

   '****************************************************************************
   '   コマンドラインを分解する
   '****************************************************************************
   Public Function DivCommand(ByVal iCommand As String) As String()
       Dim lpszArgs As IntPtr
       Dim nArgs As Integer
       Dim i As Integer
       Dim sArgs() As String

       Dim lpCommand As IntPtr = Marshal.StringToHGlobalUni(iCommand)
       Try
           lpszArgs = CommandLineToArgvW(lpCommand, nArgs)
           If lpszArgs <> IntPtr.Zero Then
               ReDim sArgs(nArgs - 1)
               For i = 0 To nArgs - 1
                   sArgs(i) = ToStringW(GetPointer(lpszArgs, i))
               Next
               LocalFree(lpszArgs)
               Return sArgs
           End If
           Return New String() {}

       Finally
           Marshal.FreeHGlobal(lpCommand)
       End Try

   End Function

   '****************************************************************************
   '   ポインタ配列のアドレスからインデックスを指定してポインタを取得
   '****************************************************************************
   Private Function GetPointer(ByVal iAddress As IntPtr, ByVal iIndex As Integer) As IntPtr
       Dim offset As Integer = iIndex * IntPtr.Size
       Return Marshal.ReadIntPtr(iAddress, offset)
   End Function

   '****************************************************************************
   '   指定されたアドレスに格納された Unicode 文字を取得
   '****************************************************************************
   Private Function ToStringW(ByVal lpAddr As IntPtr) As String

       If lpAddr <> IntPtr.Zero Then
           Return Marshal.PtrToStringUni(lpAddr)
       Else
           ToStringW = String.Empty
       End If

   End Function



トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2012-07-02 (月) 12:52:20 (1872d)