SHFile Module (windows only)

Share your advanced PureBasic knowledge/code with the community.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

SHFile Module (windows only)

Post by ts-soft »

Code: Select all

;======================================================================
; 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
Last edited by ts-soft on Fri May 10, 2019 8:19 am, edited 1 time in total.
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
em_uk
Enthusiast
Enthusiast
Posts: 366
Joined: Sun Aug 08, 2010 3:32 pm
Location: Manchester UK

Re: SHFile Module (windows only)

Post by em_uk »

What does this do?
----

R Tape loading error, 0:1
LuCiFeR[SD]
666
666
Posts: 1033
Joined: Mon Sep 01, 2003 2:33 pm

Re: SHFile Module (windows only)

Post by LuCiFeR[SD] »

em_uk wrote:What does this do?
ever tried reading the comments in the code? :) (nb. I am joking, just teasing, no offence meant :))
;======================================================================
; 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.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: SHFile Module (windows only)

Post by ts-soft »

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.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Marty2PB
User
User
Posts: 47
Joined: Thu Mar 13, 2014 4:31 pm

Re: SHFile Module (windows only)

Post by Marty2PB »

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

    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


BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: SHFile Module (windows only)

Post by BarryG »

Hi, this looks interesting and appears to be what I need, but how do you use this?

Code: Select all

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

SHFile::Copy(sourcefile$,targetfolder$+GetFilePart(sourcefile$))
Even this fails:

Code: Select all

Dim s$(1)
Dim t$(1)
s$(1)=sourcefile$
t$(1)=targetdir$+GetFilePart(sourcefile$)
SHFile::Copy(s$(1),t$(1))
I'm confused.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: SHFile Module (windows only)

Post by ts-soft »

PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: SHFile Module (windows only)

Post by BarryG »

I posted an example with Dim before your post. It doesn't work. Can you please show me how to use your module?
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: SHFile Module (windows only)

Post by ts-soft »

An Array is 0 based so the first element is 0 and not 1

Code: Select all

s$(0)=sourcefile$
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: SHFile Module (windows only)

Post by BarryG »

Of course! (Slaps forehead). Sorry about that. Thank you, too.
#NULL
Addict
Addict
Posts: 1440
Joined: Thu Aug 30, 2007 11:54 pm
Location: right here

Re: SHFile Module (windows only)

Post by #NULL »

Code: Select all

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.
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: SHFile Module (windows only)

Post by BarryG »

Thank you too, #NULL.
Post Reply