SHFile Module (windows only)
Posted: Sun Aug 04, 2013 12:51 pm
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
(nb. I am joking, just teasing, no offence meant