PureBasic

Forums PureBasic
Nous sommes le Jeu 12/Déc/2019 10:18

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 
Auteur Message
 Sujet du message: Problème pour copier lien vers fichier dans presse papier
MessagePosté: Sam 07/Avr/2018 10:52 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 18/Jan/2007 14:08
Messages: 234
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Problème pour copier lien vers fichier dans presse papie
MessagePosté: Sam 07/Avr/2018 10:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 18/Jan/2007 14:08
Messages: 234
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...


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Problème pour copier lien vers fichier dans presse papie
MessagePosté: Dim 08/Avr/2018 15:52 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 13/Fév/2004 0:57
Messages: 3702
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Problème pour copier lien vers fichier dans presse papie
MessagePosté: Dim 08/Avr/2018 16:02 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Problème pour copier lien vers fichier dans presse papie
MessagePosté: Dim 08/Avr/2018 16:34 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 13/Fév/2004 0:57
Messages: 3702
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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Majestic-12 [Bot] et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye