It is currently Mon Dec 09, 2019 3:43 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 12 posts ] 
Author Message
 Post subject: SHFile Module (windows only)
PostPosted: Sun Aug 04, 2013 12:51 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
Code:
;======================================================================
; Module:             SHFile.pbi
;
; Author:             Thomas (ts-soft) Schulz
; Clipboardfunction:  based on Code by Sparkie
; Date:               Aug 04, 2013
; Version:            1.0
; Target Compiler:    PureBasic 5.2+
; Target OS:          windows only
; License:            Free, unrestricted, no warranty whatsoever
;                     Use at your own risk

; documentation:      http://msdn.microsoft.com/en-us/library/windows/desktop/bb762164%28v=vs.85%29.aspx
;======================================================================

DeclareModule SHFile
  Declare.i Copy(Array sources.s(1), Array dest.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
  Declare.i Move(Array sources.s(1), Array dest.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
  Declare.i Delete(Array sources.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOERRORUI)
  Declare.i SetClipBoard(Array sources.s(1))
  Declare.s GetClipBoard()
  Declare.i IsClipBoard()
EndDeclareModule

Module SHFile
  EnableExplicit
  ; internal only
  Procedure CreateMem(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
 
  ; public
  Procedure.i Copy(Array sources.s(1), Array dest.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
    Protected info.SHFILEOPSTRUCT
    Protected *source, *dest, result
   
    *source = CreateMem(sources())
    *dest = CreateMem(dest())
   
    If *source And *dest
      With info
        If hWnd = 0
          \hwnd = GetForegroundWindow_()
        Else
          \hwnd = hWnd
        EndIf
        \wFunc = #FO_COPY
        \pFrom = *source
        \pTo = *dest
        \fFlags = flags
        \lpszProgressTitle = @title
        result = Bool(Not SHFileOperation_(info))
        If \fAnyOperationsAborted
          result = 1
        EndIf
        FreeMemory(*source) : FreeMemory(*dest)
        ProcedureReturn result
      EndWith
    Else
      If *source : FreeMemory(*source) : EndIf
      If *dest : FreeMemory(*dest) : EndIf
     
      ProcedureReturn #False
    EndIf
  EndProcedure
 
  Procedure.i Move(Array sources.s(1), Array dest.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
    Protected info.SHFILEOPSTRUCT
    Protected *source, *dest, result
   
    *source = CreateMem(sources())
    *dest = CreateMem(dest())
   
    If *source And *dest
      With info
        If hWnd = 0
          \hwnd = GetForegroundWindow_()
        Else
          \hwnd = hWnd
        EndIf
        \wFunc = #FO_MOVE
        \pFrom = *source
        \pTo = *dest
        \fFlags = flags
        \lpszProgressTitle = @title
       
        result = Bool(Not SHFileOperation_(info))
        If \fAnyOperationsAborted
          result = 1
        EndIf
        FreeMemory(*source) : FreeMemory(*dest)
        ProcedureReturn result
      EndWith
    Else
      If *source : FreeMemory(*source) : EndIf
      If *dest : FreeMemory(*dest) : EndIf
     
      ProcedureReturn #False
    EndIf
  EndProcedure
 
  Procedure.i Delete(Array sources.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOERRORUI)
    Protected info.SHFILEOPSTRUCT
    Protected *mem, result
   
    *mem = CreateMem(sources())
    If *mem
      With info
        If hWnd = 0
          \hwnd = GetForegroundWindow_()
        Else
          \hwnd = hWnd
        EndIf
        \wFunc = #FO_DELETE
        \pFrom = *mem
        \fFlags = flags
        \lpszProgressTitle = @title
        result = Bool(Not SHFileOperation_(info))
        If \fAnyOperationsAborted
          result = 1
        EndIf
        FreeMemory(*mem)
        ProcedureReturn result
      EndWith
    EndIf
  EndProcedure
 
  Procedure.i SetClipBoard(Array sources.s(1))
    Protected clipFile, hGlobal, *lpGlobal.DROPFILES, *mem
   
    *mem = CreateMem(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.s GetClipBoard()
    Protected nFiles, cbFiles, buffSize, f
    Protected file.s, result.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
              file + "\"
            EndIf
            If FileSize(file) <> - 1
              result + file + #LF$
            EndIf
          Next
          If result <> ""
            result = Left(result, Len(result) - 1)
          EndIf
        EndIf
      EndIf
      CloseClipboard_()
    EndIf
    ProcedureReturn result
  EndProcedure 
 
  Procedure.i IsClipBoard()
    Protected result
   
    If OpenClipboard_(0)
      If IsClipboardFormatAvailable_(#CF_HDROP)
        result = #True
      EndIf
      CloseClipboard_()
    EndIf
    ProcedureReturn result
  EndProcedure
 
EndModule

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
 
  Define i, j, files$
  Dim files.s(0)
  If ExamineDirectory(0, #PB_Compiler_Home, "*.*")
    While NextDirectoryEntry(0)
      If DirectoryEntryName(0) <> "." And DirectoryEntryName(0) <> ".."
        files(i) = #PB_Compiler_Home + DirectoryEntryName(0)
        i + 1
        ReDim files(i)
      EndIf
    Wend
    FinishDirectory(0)
  EndIf
 
  If SHFile::SetClipBoard(files.s()) ; set the files from array to clipboard
    files$ = SHFile::GetClipBoard()
    j = CountString(files$, #LF$)
    For i = 0 To j
      Debug StringField(files$, i + 1, #LF$)
    Next
  EndIf
CompilerEndIf

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Last edited by ts-soft on Fri May 10, 2019 8:19 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Tue Aug 20, 2013 10:35 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Aug 08, 2010 3:32 pm
Posts: 349
Location: Manchester UK
What does this do?

_________________
----

R Tape loading error, 0:1


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Tue Aug 20, 2013 10:39 pm 
Offline
666
666

Joined: Mon Sep 01, 2003 2:33 pm
Posts: 1033
em_uk wrote:
What does this do?


ever tried reading the comments in the code? :) (nb. I am joking, just teasing, no offence meant :))

Quote:
;======================================================================
; Module: SHFile.pbi
;
; Author: Thomas (ts-soft) Schulz
; Clipboardfunction: based on Code by Sparkie
; Date: Aug 04, 2013
; Version: 1.0
; Target Compiler: PureBasic 5.2+
; Target OS: windows only
; License: Free, unrestricted, no warranty whatsoever
; Use at your own risk

; documentation: http://msdn.microsoft.com/en-us/library ... 85%29.aspx
;======================================================================


msdn

MSDN wrote:
SHFileOperation function

Copies, moves, renames, or deletes a file system object. This function has been replaced in Windows Vista by IFileOperation.


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Wed Aug 21, 2013 7:48 am 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
em_uk wrote:
What does this do?

Copy, Move and Delete Files with or without GUI and Progress. Delete to RecycleBin.
Uses the same functions as Windows-Explorer.
Copy, Paste Files from Clipboard (from, to Explorer, TotalCommander and so on).

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri Jun 05, 2015 11:29 pm 
Offline
User
User

Joined: Thu Mar 13, 2014 4:31 pm
Posts: 27
big Thanks for the Code @ts-soft

Copy and Paste works but it miss 'cut'. My Solution for the "Procedure SetClipBoard(Array sources.s(1))


Code:
    Procedure.i SetClipBoard(Array sources.s(1),FlagEffect.i = #DROPEFFECT_COPY)
        Protected clipFile, hGlobal, *lpGlobal.DROPFILES, *mem, *pDropEffect
       
             
        *mem = CreateMem(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     
               
                ;
                ; for Cut or Copy change the FlagEffect to DROPEFFECT_MOVE or DROPEFFECT_Copy
                ;
                hGlobal = GlobalAlloc_(#GMEM_SHARE | #GMEM_MOVEABLE | #GMEM_ZEROINIT|#GMEM_DDESHARE, 4)
                If hGlobal
                    pDropEffect = GlobalLock_(hGlobal)         ;
                    *pDropEffect = PokeI(pDropEffect,FlagEffect)      ;
                    GlobalUnlock_(hGlobal)                      ;     
                    SetClipboardData_(RegisterClipboardFormat_(#CFSTR_PREFERREDDROPEFFECT), hGlobal);
                EndIf                                         
            EndIf
            CloseClipboard_()
        EndIf
        FreeMemory(*mem)
    ProcedureReturn clipFile
EndProcedure




Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 5:52 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 434
Hi, this looks interesting and appears to be what I need, but how do you use this?

Code:
Procedure.i Copy(Array sources.s(1), Array dest.s(1), title.s = "", hWnd = 0, flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)

Can you give an example of copying one single file, and then two files? I can't get my head around it.

I tried this, but it says I have to create an array:

Code:
SHFile::Copy(sourcefile$,targetfolder$+GetFilePart(sourcefile$))

Even this fails:

Code:
Dim s$(1)
Dim t$(1)
s$(1)=sourcefile$
t$(1)=targetdir$+GetFilePart(sourcefile$)
SHFile::Copy(s$(1),t$(1))

I'm confused.


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 7:53 am 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
@BarryG
See "Dim" !
https://www.purebasic.com/documentation ... e/dim.html

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 7:57 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 434
I posted an example with Dim before your post. It doesn't work. Can you please show me how to use your module?


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 8:01 am 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
An Array is 0 based so the first element is 0 and not 1
Code:
s$(0)=sourcefile$

_________________
PureBasic 5.71 | SpiderBasic 2.21 | Windows 10 Pro (x64) | Linux Mint 19.2 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 8:08 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 434
Of course! (Slaps forehead). Sorry about that. Thank you, too.


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 8:16 am 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1158
Location: right here
Code:
Copy(s$(), t$())
Pass the array itself instead of some of its elements.
The '(1)' in the procedure declaration after the array parameters tells the compiler the number of dimensions.


Top
 Profile  
Reply with quote  
 Post subject: Re: SHFile Module (windows only)
PostPosted: Fri May 10, 2019 8:24 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 434
Thank you too, #NULL.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 12 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 6 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye