PureBasic
https://www.purebasic.fr/french/

Problème pour copier lien vers fichier dans presse papier
https://www.purebasic.fr/french/viewtopic.php?f=1&t=17221
Page 1 sur 1

Auteur:  Stefou [ Sam 07/Avr/2018 10:52 ]
Sujet du message:  Problème pour copier lien vers fichier dans presse papier

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:
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

Auteur:  Stefou [ Sam 07/Avr/2018 10:53 ]
Sujet du message:  Re: Problème pour copier lien vers fichier dans presse papie

Citation:
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...

Auteur:  nico [ Dim 08/Avr/2018 15:52 ]
Sujet du message:  Re: Problème pour copier lien vers fichier dans presse papie

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:
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

Auteur:  Zorro [ Dim 08/Avr/2018 16:02 ]
Sujet du message:  Re: Problème pour copier lien vers fichier dans presse papie

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 ...

Auteur:  nico [ Dim 08/Avr/2018 16:34 ]
Sujet du message:  Re: Problème pour copier lien vers fichier dans presse papie

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

Code:
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

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/