|
|||||
<このサンプル(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 |