RÉCUPÉRATION/ÉCRITURE DES NOMS DE FICHIERS CONTENUS DANS LE PRESSE-PAPIER

Option Explicit

Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal iFile As Long, ByVal lpszFile As String, ByVal cch As Long) As Long

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const CF_HDROP As Long = 15

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Type DROPFILES
  pFiles As Long
  pt As POINTAPI
  fNC As Long
  fWide As Long
End Type

Public Function ClipboardGetFiles(file_names() As String) As Boolean
Dim drop_handle As Long
Dim num_file_names As Long
'Dim file_names() As String
Dim file_name As String * 1024
Dim i As Long
If Clipboard.GetFormat(vbCFFiles) Then
  If OpenClipboard(0) Then
  drop_handle = GetClipboardData(CF_HDROP)
  If drop_handle = 0 Then
    ClipboardGetFiles = False
    CloseClipboard
    Exit Function
  End If
  ' nombre de noms de fichier dans le presse-papier
  num_file_names = DragQueryFile(drop_handle, -1, _
                vbNullString, 0)
  ' récupération des noms de fichier
  ReDim file_names(1 To num_file_names) As String
  For i = 1 To num_file_names
    DragQueryFile drop_handle, i - 1, _
                   file_name, Len(file_name)
    ' On coupe au niveau du caractère null
    file_names(i) = Left$(file_name, InStr(file_name, vbNullChar) - 1)
  Next
  ' fermeture du presse-papier (important)
  CloseClipboard
  ClipboardGetFiles = True
  End If
Else
  ClipboardGetFiles = False
End If
End Function

' copie des noms de fichiers dans le presse-papier
' retourne vrai en cas de réussite
Public Function ClipboardSetFiles(file_names() As String) As Boolean
Dim file_string As String
Dim drop_files As DROPFILES
Dim memory_handle As Long
Dim memory_pointer As Long
Dim i As Long
'  on vide le presse-papier
Clipboard.Clear
If OpenClipboard(0) Then
  ' construit une liste de noms de fichier terminés par null
  For i = LBound(file_names) To UBound(file_names)
    file_string = file_string & file_names(i) & vbNullChar
  Next i
  file_string = file_string & vbNullChar
  ' Initialise la structure DROPFILES
  drop_files.pFiles = Len(drop_files)
  drop_files.fWide = 0    ' ANSI characters.
  drop_files.fNC = 0      ' Client coordinates.

  ' réservation mémoire pour DROPFILES et la liste des noms de fichier
  memory_handle = GlobalAlloc(GHND, Len(drop_files) + Len(file_string))
  If memory_handle Then
    memory_pointer = GlobalLock(memory_handle)
   
   ' copie en mémoire de la strucure et des noms de fichier
   CopyMem ByVal memory_pointer, drop_files, Len(drop_files)
   CopyMem ByVal memory_pointer + Len(drop_files), ByVal file_string, Len(file_string)
   GlobalUnlock memory_handle
   
   ' copie des données vers le presse-papier
   SetClipboardData CF_HDROP, memory_handle
   ClipboardSetFiles = True
  Else
    ClipboardSetFiles = False
  End If
  CloseClipboard
Else
  ClipboardSetFiles = False
End If
End Function