NonSoft

別EXEからのファイル ドロップを受け取るサンプル(VB6)


 サンプル(ソース/コード)
<このサンプル(VB6)の概要>
このサンプルは、別アプリケーション(ファイラ等)からのファイルドロップを受け付ける
VB6版のサンプルです。

OLEDropModeを手動にしてOLEDragDropを実装しても、
別アプリケーション(ファイラ等)からのファイルドロップを受け取れませんので、
DragAcceptFilesによりファイルドロップを受け取れるようにアピールし、
ドロップされたファイルをDragQueryFileで取得する必要があります。

VB.NET版はこちらです。
別EXEからのファイル ドロップを受け取るサンプル(VB.NET)

C#.NET版はこちらです。
別EXEからのファイル ドロップを受け取るサンプル(C#.NET)

このサンプルを使用したツールは以下のものがあります。ファイラーを使用している方からファイラから
送ったファイルを受け取れるようにして欲しいと言う要望があり、実装しました。
フォルダ内のファイル比較ツール
テキスト差分表示ツール

★標準モジュール(Module1.bas)
Option Explicit

' APIの定義
Private Const WM_DROPFILES = &H233
Private Const GWL_WNDPROC = -4
Private Declare Sub DragAcceptFiles Lib "shell32.dll" _
    (ByVal hWnd As Long, ByVal fAccept As Long)
Private Declare Sub DragFinish Lib "shell32.dll" _
    (ByVal HDROP As Long)
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" _
    (ByVal HDROP As Long, ByVal UINT As Long, _
     ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
     ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Msg_Proc As Long    'メッセージ関数アドレスの保存
Private Hook_hWnd As Long   'ウインドウのハンドルの保存

' 別アプリケーション(ファイラ等)からのドロップ許可開始
Public Sub DropStart(hWnd As Long)
    If hWnd <> 0 Then
        If Msg_Proc <> 0 Then DropEnd
        Hook_hWnd = hWnd
        Call DragAcceptFiles(Hook_hWnd, 1)
        Msg_Proc = SetWindowLong(Hook_hWnd, GWL_WNDPROC, AddressOf DropWndProc)
    End If
End Sub

' 別アプリケーション(ファイラ等)からのドロップ許可終了
Public Sub DropEnd()
    If Hook_hWnd <> 0 And Msg_Proc <> 0 Then
        Call SetWindowLong(Hook_hWnd, GWL_WNDPROC, Msg_Proc)
    End If
End Sub

' メッセージ処理関数
Private Function DropWndProc( _
    ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_DROPFILES Then
        ' ファイルドロップのメッセージ
        Call DropFilesProc(wParam)
    Else
        ' その他のメッセージ
        DropWndProc = CallWindowProc(Msg_Proc, hWnd, uMsg, wParam, lParam)
    End If
End Function

' ファイルドロップ処理関数
Private Sub DropFilesProc(ByVal hDropFile As Long)
    On Error Resume Next
    
    Dim dropNum As Long
    Dim dropFile As String * 512
    
    ' ドロップされたファイル/フォルダ数を取得
    dropNum = DragQueryFile(hDropFile, -1, 0, 0)
    
    ReDim dropFiles(dropNum - 1) As String
    
    Dim i As Long
    For i = 0 To dropNum - 1
        ' ドロップされたファイル/フォルダの取得
        Call DragQueryFile(hDropFile, i, dropFile, 512)
        dropFiles(i) = dropFile
        
        ' ファイル/フォルダPATH文字列の後のNULLを削除
        Dim p As Integer: p = InStr(dropFiles(i), Chr$(0))
        If p > 0 Then dropFiles(i) = Left$(dropFiles(i), p - 1)
    Next i
    
    ' ファイル/フォルダPATHをテキストボックスへ設定
    Form1.Text1_DropFiles dropFiles
    
    ' ドロップされたファイル/フォルダの取得終了
    Call DragFinish(hDropFile)
End Sub

★フォームモジュール(Form1.frm)
Option Explicit

' フォーム・ロード
Private Sub Form_Load()
    DropStart Text1.hWnd
End Sub

' フォーム・アンロード
Private Sub Form_Unload(Cancel As Integer)
    DropEnd
End Sub

' テキストボックスへのファイルドロップ処理
Public Sub Text1_DropFiles(files() As String)
    ' ファイル/フォルダPATHをテキストボックスへ設定
    ' このサンプルは1個だけ
    If UBound(files) >= 0 Then
        Form1.Text1.Text = files(0)
    End If
End Sub