Problème pour copier lien vers fichier dans presse papier

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Stefou
Messages : 234
Inscription : jeu. 18/janv./2007 14:08

Problème pour copier lien vers fichier dans presse papier

Message par Stefou »

Bonjour à tous,

Je bloque sur un problème depuis quelques heures, alors je viens voir si une personne est plus intelligente que moi :roll:

Je veux copier un lien de fichier dans le presse papier pour pouvoir le coller dans un dossier windows.

J'utilise un code trouvé (de Dobro je crois) que j'ai un petit peu modifié (unicode oblige!)

Cela marche avec un nom de fichier assez cours mais pas lorsque ce nom dépasse un certain nombre de caractère.

On voit sur le debuggeur une suite de caractère apres le nom de fichier qui ne sont pas le bienvenue!

Merci de votre aide

Code : Tout sélectionner

Procedure addClipboardFiles(List files.s())
  Protected hDrop.DROPFILES, *dat, add.i, hMem.i, *buff
  
  If OpenClipboard_(0)
    ;on vide le presse papier
    EmptyClipboard_()
    
    ;on ajoute met tous les fichiers dans une zone mémoire (avec le chr(0))
    FirstElement(files())
    ForEach files()
      *Ascii=Ascii( files())
      If *dat
        add = MemorySize(*dat)
      Else
        add = 0
      EndIf
      Debug Len(files())
      *dat = ReAllocateMemory(*dat, add+Len(files())+1)
      nb=PokeS(*dat+add, PeekS(*Ascii), Len(files()))
      PokeB(*dat+add+Len(files()), 0)
    Next
    hDrop\pFiles = SizeOf(DROPFILES)
    
    hMem = GlobalAlloc_(#GMEM_MOVEABLE, SizeOf(DROPFILES)+MemorySize(*dat))
    *buff = GlobalLock_(hMem)
    CopyMemory(@hDrop, *buff, SizeOf(DROPFILES))
    CopyMemory(*dat, *buff+SizeOf(DROPFILES), MemorySize(*dat))

    GlobalUnlock_(hMem)
    
    SetClipboardData_(#CF_HDROP, hMem)
    CloseClipboard_()
    ProcedureReturn 1
  EndIf
  
  ProcedureReturn 0
EndProcedure

;renvoi les fichiers contenus dans le press-papier dans files()
Procedure getClipboardFiles(List files.s())
  Protected hDrop, i.i, FileName.s
  
  If OpenClipboard_(0) And IsClipboardFormatAvailable_(#CF_HDROP)
    hDrop = GetClipboardData_(#CF_HDROP)
    Repeat
      FileName = Space(1024)
      DragQueryFile_(hDrop, i, @FileName, 1024)
      FileName = Trim(FileName)
      If FileName <> ""
        AddElement(files())
        files() = FileName
      EndIf
      i + 1
    Until FileName = ""
    CloseClipboard_()
    
    ProcedureReturn i
  EndIf
  
  ProcedureReturn 0
EndProcedure



NewList files.s()
AddElement(files())

;files()="F:\124567890124567890124567890\1.txt" ;nom cours -> Fonctionne
files()="F:\124567890124567890124567890124567890124567890124567890124567890124567890\1.txt" ;nom long cours -> plantouille

addClipboardFiles(files.s())


; on récupère le nom de fichier stocker pour vérifier
NewList TestList.s()
getClipboardFiles(TestList.s())

ResetList(TestList())              

While NextElement(TestList())       
  Debug TestList()
Wend
Stefou
Messages : 234
Inscription : jeu. 18/janv./2007 14:08

Re: Problème pour copier lien vers fichier dans presse papie

Message par Stefou »

Bonjour,

Le plus simple est d'utiliser des commandes PureBasic :

Code:
file$ = "F:\124567890124567890124567890124567890124567890124567890124567890124567890\1.txt"
SetClipboardText(file$)

Debug GetClipboardText()


Cordialement,
GallyHC
Merci GallyHC de te soucier de mon problème

Le but est de coller le fichier dans un dossier.

Tu lance la commande dans purebasic, qui enregistre le lien dans le presse papier.... puis tu vas dans l'explorateur windows et tu colle, ce qui a pour effet de copier le fichier.

Par contre dans ma précipitation, je me suis tromper de forum, je vais essayer de le déplacer...
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: Problème pour copier lien vers fichier dans presse papie

Message par nico »

Alors il me semble qu'il y a des problèmes dans tes procédures mais ça fait beaucoup trop longtemps que je n'ai pas programmé; donc j'ai piqué d'autres procédures au forum anglais. Désolé, il y a un mélange de dim et de list, je te laisse modifier ça.

Donc au final, cela semble fonctionner:

Code : Tout sélectionner

Procedure FilesCreateMem(Array files.s(1))

  Protected i, j, size, *mem, *pmem

  j = ArraySize(files())
  For i = 0 To j
    If Right(files(i), 1) = "\" : files(i) = Left(files(i), Len(files(i)) - 1) : EndIf
    size + StringByteLength(files(i)) + 1 * SizeOf(Character)
  Next
  size  + 1 * SizeOf(Character)
  *mem = AllocateMemory(size)
  If *mem
    *pmem = *mem
    For i = 0 To j
      PokeS(*pmem, files(i))
      *pmem + StringByteLength(files(i)) + 1 * SizeOf(Character)
    Next
  EndIf
  ProcedureReturn *mem
EndProcedure

Procedure FilesToClipBoard(Array sources.s(1))
  Protected clipFile, hGlobal, *lpGlobal.DROPFILES, *mem

  *mem = FilesCreateMem(sources())
  If *mem
    If OpenClipboard_(0)
      EmptyClipboard_()
      hGlobal = GlobalAlloc_(#GHND, SizeOf(DROPFILES) + MemorySize(*mem))
      If hGlobal
        *lpGlobal = GlobalLock_(hGlobal)
        ZeroMemory_(*lpGlobal, SizeOf(DROPFILES))
        *lpGlobal\pFiles = SizeOf(DROPFILES)
        CompilerIf #PB_Compiler_Unicode
        *lpGlobal\fWide = 1 ; Unicode
        CompilerEndIf
        *lpGlobal\fNC = 0
        *lpGlobal\pt\x = 0
        *lpGlobal\pt\y = 0
        CopyMemory_((*lpGlobal + SizeOf(DROPFILES)), *mem, MemorySize(*mem))
        GlobalUnlock_(hGlobal)
        If SetClipboardData_(#CF_HDROP, hGlobal)
          clipFile = #True
        EndIf
      EndIf
      CloseClipboard_()
    EndIf
    FreeMemory(*mem)
  EndIf
  ProcedureReturn clipFile
 EndProcedure
 
 Procedure FilesFromClipBoard(List Liste.s())
  Protected nFiles, cbFiles, buffSize, file$, f
  Protected nPath.s
  If OpenClipboard_(0)
    If IsClipboardFormatAvailable_(#CF_HDROP)
      cbFiles = GetClipboardData_(#CF_HDROP)
      If cbFiles
        nFiles = DragQueryFile_(cbFiles, -1, 0, 0)
        For f = 0 To nFiles - 1
          buffSize = DragQueryFile_(cbFiles, f, 0, 0) + 1
          file$ = Space(buffSize)
          DragQueryFile_(cbFiles, f, @file$, buffSize)
          If FileSize(file$) = - 2
            ;nPath = Path + GetFilePart(file$) + "\"
            ;CopyDirectory(file$ + "\", nPath, "", #PB_FileSystem_Recursive)
          ElseIf FileSize(file$) > -1
              ;CopyFile(file$, Path + GetFilePart(File$))
              AddElement(Liste())
              Liste() = file$
          EndIf
        Next
      EndIf
    EndIf
    CloseClipboard_()
  EndIf
  ProcedureReturn nFiles
EndProcedure


Dim arrayfile.s(1)
arrayfile(0) = "H:\124567890124567890124567890\1.txt"
If FileSize(arrayfile(0)) < 0: Debug "Erreur sur le chemin 1" : EndIf 

arrayfile(1) = "H:\124567890124567890124567890124567890124567890124567890124567890124567890\2.txt"
If FileSize(arrayfile(1)) < 0: Debug "Erreur sur le chemin 2" : EndIf 

Debug "Copie des fichiers dans le preese papier, si retourne 1, c'est ok"
Debug FilesToClipBoard(arrayfile()) 



; on récupère le nom de fichier stocker pour vérifier
Debug "Récupération des noms de fichiers"
NewList TestList.s()
FilesFromClipBoard(TestList.s())

ResetList(TestList())              

While NextElement(TestList())       
  Debug TestList()
Wend
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Problème pour copier lien vers fichier dans presse papie

Message par Zorro »

Stefou a écrit :J'utilise un code trouvé (de Dobro je crois) que j'ai un petit peu modifié (unicode oblige!)
je ne pense pas qu'il soit de moi ce code ...
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: Problème pour copier lien vers fichier dans presse papie

Message par nico »

Second code, n'utilise que des newlist mais je n'ai pas gardé la possibilité d'envoyer des chemins.

Code : Tout sélectionner

Procedure FilesToClipBoard(List Liste.s())
    Protected clipFile, hGlobal, *lpGlobal.DROPFILES, *mem
    Protected size, *pmem, file.s
    
    ResetList(Liste()) 
    While NextElement(Liste())       
        file = Liste()
        size =  size + StringByteLength(file) + 1 * SizeOf(Character)
    Wend

    size + 1 * SizeOf(Character)
    Debug size
    
    *mem = AllocateMemory(size)
    
    *pmem = *mem
    
    ResetList(Liste()) 
    While NextElement(Liste())  
        file = Liste()
        CopyMemory(@file, *pmem, StringByteLength(file))
        *pmem = *pmem + StringByteLength(file) + 1 * SizeOf(Character)
    Wend
    
    If *mem
        If OpenClipboard_(0)
            EmptyClipboard_()
            hGlobal = GlobalAlloc_(#GHND, SizeOf(DROPFILES) + MemorySize(*mem))
            If hGlobal
                *lpGlobal = GlobalLock_(hGlobal)
                ZeroMemory_(*lpGlobal, SizeOf(DROPFILES))
                *lpGlobal\pFiles = SizeOf(DROPFILES)
                CompilerIf #PB_Compiler_Unicode
                    *lpGlobal\fWide = 1 ; Unicode
                CompilerEndIf
                *lpGlobal\fNC = 0
                *lpGlobal\pt\x = 0
                *lpGlobal\pt\y = 0
                CopyMemory_((*lpGlobal + SizeOf(DROPFILES)), *mem, MemorySize(*mem))
                GlobalUnlock_(hGlobal)
                If SetClipboardData_(#CF_HDROP, hGlobal)
                    clipFile = #True
                EndIf
            EndIf
            CloseClipboard_()
        EndIf
        FreeMemory(*mem)
    EndIf
    ProcedureReturn clipFile
EndProcedure

Procedure FilesFromClipBoard(List Liste.s())
    Protected nFiles, cbFiles, buffSize, file$, f

    If OpenClipboard_(0)
        If IsClipboardFormatAvailable_(#CF_HDROP)
            cbFiles = GetClipboardData_(#CF_HDROP)
            If cbFiles
                nFiles = DragQueryFile_(cbFiles, -1, 0, 0)
                For f = 0 To nFiles - 1
                    buffSize = DragQueryFile_(cbFiles, f, 0, 0) + 1
                    file$ = Space(buffSize)
                    DragQueryFile_(cbFiles, f, @file$, buffSize)
                    If FileSize(file$) > -1
                        AddElement(Liste())
                        Liste() = file$
                    EndIf
                Next
            EndIf
        EndIf
        CloseClipboard_()
    EndIf
    ProcedureReturn nFiles
EndProcedure


NewList MaList.s()
AddElement(MaList())
MaList() = "H:\124567890124567890124567890\1.txt"
If FileSize(MaList() ) < 0: Debug "Erreur sur le chemin 1" : EndIf 

AddElement(MaList())
MaList() = "H:\124567890124567890124567890124567890124567890124567890124567890124567890\2.txt"
If FileSize(MaList() ) < 0: Debug "Erreur sur le chemin 2" : EndIf 

Debug "Copie des fichiers dans le preese papier, si retourne 1, c'est ok"
Debug FilesToClipBoard(MaList()) 


; on récupère le nom de fichier stocker pour vérifier
Debug "Récupération des noms de fichiers"
NewList TestList.s()
FilesFromClipBoard(TestList.s())

ResetList(TestList())              

While NextElement(TestList())       
    Debug TestList()
Wend
Répondre