Code: Select all
; Explorer Filefunctions (SHFileOperation API)
; Autor: Thomas (ts-soft) Schulz
; Clipboardfunctions from Sparkie with changes by me
; Windows only
; PB 4.3x
#FOF_NOERRORUI = $400
; helpfunction
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 FilesCopy(Array sources.s(1), Array dest.s(1), flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
Protected info.SHFILEOPSTRUCT
Protected *source, *dest, result
*source = FilesCreateMem(sources())
*dest = FilesCreateMem(dest())
If *source And *dest
With info
\hwnd = GetForegroundWindow_()
\wFunc = #FO_COPY
\pFrom = *source
\pTo = *dest
\fFlags = flags
;\lpszProgressTitle = @Titel
result = (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 FilesMove(Array sources.s(1), Array dest.s(1), flags = #FOF_NOCONFIRMATION | #FOF_NOCONFIRMMKDIR | #FOF_NOERRORUI)
Protected info.SHFILEOPSTRUCT
Protected *source, *dest, result
*source = FilesCreateMem(sources())
*dest = FilesCreateMem(dest())
If *source And *dest
With info
\hwnd = GetForegroundWindow_()
\wFunc = #FO_MOVE
\pFrom = *source
\pTo = *dest
\fFlags = flags
;\lpszProgressTitle = @Titel
result = (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 FilesDelete(Array sources.s(1), flags = #FOF_NOCONFIRMATION | #FOF_NOERRORUI)
Protected info.SHFILEOPSTRUCT
Protected *mem, result
*mem = FilesCreateMem(sources())
If *mem
With info
\hwnd = GetForegroundWindow_()
\wFunc = #FO_DELETE
\pFrom = *mem
\fFlags = flags
;\lpszProgressTitle = @Titel
result = (Not SHFileOperation_(info))
If \fAnyOperationsAborted
result = 1
EndIf
FreeMemory(*mem)
ProcedureReturn result
EndWith
EndIf
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(Path.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$))
EndIf
Next
EndIf
EndIf
CloseClipboard_()
EndIf
ProcedureReturn nFiles
EndProcedure
Procedure IsFilesClipBoard()
Protected result
If OpenClipboard_(0)
If IsClipboardFormatAvailable_(#CF_HDROP)
result = #True
EndIf
CloseClipboard_()
EndIf
ProcedureReturn result
EndProcedure
