NonSoft

ファイルをクリップボードにコピーするサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
ファイルをクリップボードにコピーするサンプル(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