|
|||||
<このサンプルの概要> ファイルをクリップボードにコピーするサンプル(VB6)です。 VB6のアプリケーションでファイル一覧を表示した時、 そのファイルをエクスプローラへ貼り付けたい事があります。 ファイルをクリップボードにコピーする事が出来れば、 ファイル読込やファイル書込をプログラミングせずに、 ファイルをエクスプローラへ貼り付けが出来るので、 便利だと思います。 このサンプルでは次のソケットAPIを使用しています。 1.GlobalAlloc 2.GlobalLock 3.GlobalUnlock 4.RtlMoveMemory 5.OpenClipboard 6.CloseClipboard 7.EmptyClipboard 8.SetClipboardData このサンプルを使用したツールは以下のものがあります。 選択したファイルをクリップボードにコピーし、 エクスプローラに貼り付けたいという要望に対応しました。 フォルダ内のファイル比較ツール ★フォームモジュール(Form1.frm) Option Explicit ' 定数定義 Private Const GMEM_MOVEABLE = &H2 Private Const GMEM_DDESHARE = &H2000 Private Const CF_HDROP = 15 ' 構造体定義 Private Type DROPFILES pFiles As Long x As Long y As Long fNC As Long fWide As Long End Type ' API定義 Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _ ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalLock Lib "kernel32.dll" ( _ ByVal hm As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32.dll" ( _ ByVal hm As Long) As Long Private Declare Function RtlMoveMemory Lib "kernel32.dll" ( _ Dest As Any, Source As Any, ByVal Length As Long) As Long Private Declare Function OpenClipboard Lib "user32.dll" ( _ ByVal hWnd As Long) As Long Private Declare Function CloseClipboard Lib "user32.dll" () As Long Private Declare Function EmptyClipboard Lib "user32.dll" () As Long Private Declare Function SetClipboardData Lib "user32.dll" ( _ ByVal wFormat As Long, ByVal hm As Long) As Long ' ファイルをクリップボードにコピーする Private Sub ClipDropFiles(ByRef files() As String) Dim df As DROPFILES: df.pFiles = LenB(df) Dim bf() As Byte Dim hm As Long Dim pm As Long ' コピーするファイルPATH文字列の作成 Dim sf As String: sf = "" Dim i As Long For i = 0 To UBound(files) sf = sf & files(i) & vbNullChar Next i sf = sf & vbNullChar ' コピーするファイルPATH文字列をバイト配列に変換 bf() = StrConv(sf, vbFromUnicode) ' クリップボードのオープン OpenClipboard 0 ' クリップボードの初期化 EmptyClipboard ' グローバルメモリの確保 hm = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, LenB(df) + UBound(bf) + 1) ' グローバルメモリのロック pm = GlobalLock(hm) ' グローバルメモリへのDROPFILES構造体の書き込み RtlMoveMemory ByVal pm, df, LenB(df) ' グローバルメモリへのコピーファイルPATHの書き込み RtlMoveMemory ByVal pm + LenB(df), bf(0), UBound(bf) + 1 ' クリップボードへのデータ書き込み SetClipboardData CF_HDROP, hm ' グローバルメモリのロック解除 GlobalUnlock hm ' クリップボードのクローズ CloseClipboard End Sub ' ボタンを押した時にファイルをクリップボードにコピーする Private Sub Command1_Click() ' コピーするファイルPATHの設定 Dim files(3) As String files(0) = "c:\temp\a" ' フォルダ files(1) = "c:\temp\b.txt" ' ファイル(半角) files(2) = "c:\temp\c.txt.lnk" ' ショートカット files(3) = "c:\temp\あ.txt" ' ファイル(全角) ' ファイルをクリップボードにコピーする ClipDropFiles files End Sub |