[Module] File - Dateien suchen und auslesen
Verfasst: 23.03.2018 21:11
Hallo Zusammen,
hier ein Modul um den Umgang mit Dateien (hauptsächlich Windows) zu erweitern.
Für Windows:
hier ein Modul um den Umgang mit Dateien (hauptsächlich Windows) zu erweitern.
Für Windows:
- Datei-Informationen auslesen (Version, Typ, Product, etc.) / nur Kompilate (Exe, DLL, lib, etc.)
Icon laden
Thumbnail (aus Cache) laden
- Dateien Suchen (Rekrusiv, mit Wildcards oder RegEx)
Code: Alles auswählen
DeclareModule FileEx ; for internal or advanced use only ...
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
#PATH_Separator = "\"
Structure STRUCT_Version
Major.l
Minor.l
Patch.l ; swapped with Build in .NET Apps
Build.l
EndStructure
Structure STRUCT_FileType
Type.l
SubType.l
EndStructure
Structure STRUCT_FixedValuesEx
FileVersion.STRUCT_Version
ProductVersion.STRUCT_Version
FileType.STRUCT_FileType
EndStructure
Structure STRUCT_InfoEx
OriginalFilename.s
LegalTrademarks.s
LegalCopyright.s
InternalName.s
CompanyName.s
Comments.s
FileDescription.s
ProductName.s
FileVersion.s
ProductVersion.s
FixedValues.STRUCT_FixedValuesEx
EndStructure
#FILETYPE_App = #VFT_APP
#FILETYPE_Font = #VFT_FONT
#FILETYPE_DLL = #VFT_DLL
#FILETYPE_LIB = #VFT_STATIC_LIB
#FILETYPE_Driver = #VFT_DRV
#FILETYPE_VirtualDevice = #VFT_VXD
#FILETYPE_Unknown = #VFT_UNKNOWN
#FILESUBTYPE_Unknown = #VFT2_UNKNOWN
#FILESUBTYPE_DRV_Comm = #VFT2_DRV_COMM
#FILESUBTYPE_DRV_Display = #VFT2_DRV_DISPLAY
#FILESUBTYPE_DRV_Installable = #VFT2_DRV_INSTALLABLE
#FILESUBTYPE_DRV_InputMethod = #VFT2_DRV_INPUTMETHOD
#FILESUBTYPE_DRV_Keyboard = #VFT2_DRV_KEYBOARD
#FILESUBTYPE_DRV_Language = #VFT2_DRV_LANGUAGE
#FILESUBTYPE_DRV_Mouse = #VFT2_DRV_MOUSE
#FILESUBTYPE_DRV_Network = #VFT2_DRV_NETWORK
#FILESUBTYPE_DRV_Printer = #VFT2_DRV_PRINTER
#FILESUBTYPE_DRV_Sound = #VFT2_DRV_SOUND
#FILESUBTYPE_DRV_System = #VFT2_DRV_SYSTEM
#FILESUBTYPE_DRV_Unknown = #FILESUBTYPE_Unknown
#FILESUBTYPE_FONT_Raster = #VFT2_FONT_RASTER
#FILESUBTYPE_FONT_TrueType = #VFT2_FONT_TRUETYPE
#FILESUBTYPE_FONT_Vector = #VFT2_FONT_VECTOR
#FILESUBTYPE_FONT_Unknown = #FILESUBTYPE_Unknown
Declare.i InfoEx(File.s, *Out.STRUCT_InfoEx)
Declare.i FixedValuesEx(File.s, *Out.STRUCT_FixedValuesEx)
Declare.s Version2String(Major = 0, Minor = 0, Patch = 0, Build = 0)
Declare.s Type2String(Type = #VFT_UNKNOWN, SubType = #VFT2_UNKNOWN)
Declare.s FileInfo_VerQueryValue(*FVI_Buffer, Query.s)
Declare.i FileInfo_GetFileVersionInfo(File.s)
Declare.i FileInfo_GetFixedValues(*FVI_Buffer, *Out.STRUCT_FixedValuesEx)
Declare GetThumbnailEx(FileName.s, Width = 64, Height = 64, Depth = 32, Img = #PB_Any) ; Returns PB-ImageNr (PB_Any)
Declare GetIconEx(FileName.s, Depth = 32, BG_Color = #PB_Image_Transparent, Img = #PB_Any, x = 0, y = 0, Width = 0, Height = 0)
Macro GetIconWidth()
GetSystemMetrics_(#SM_CXICON)
EndMacro
Macro GetIconHeigth()
GetSystemMetrics_(#SM_CYICON)
EndMacro
CompilerElse
#PATH_Separator = "/"
CompilerEndIf
Declare.s Wildcard2RegEx(String.s, MultiLine = #False)
EndDeclareModule
DeclareModule File
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
#QUERY_OriginalFilename = "OriginalFilename"
#QUERY_LegalTrademarks = "LegalTrademarks"
#QUERY_LegalCopyright = "LegalCopyright"
#QUERY_InternalName = "InternalName"
#QUERY_CompanyName = "CompanyName"
#QUERY_Comments = "Comments"
#QUERY_Description = "FileDescription"
#QUERY_ProductName = "ProductName"
#QUERY_Version = "FileVersion"
#QUERY_ProductVersion = "ProductVersion"
; Flags for Search()
EnumerationBinary Search
#SEARCH_Recursiv ; Search recursive
#SEARCH_File ; Search file
#SEARCH_Directory ; Search directory
#SEARCH_CaseSensitive ; Search case sensitive / default: no case
#SEARCH_Regex ; Search String is a regular expression
#SEARCH_CountResults ; Count max results
#SEARCH_CountDirDepth ; Count max directory depth (recursive search)
EndEnumeration
Macro GetProductVersion(__File)
File::Info(__File, File::#QUERY_ProductVersion)
EndMacro
Macro GetVersion(__File)
File::Info(__File, File::#QUERY_Version)
EndMacro
Macro GetProductName(__File)
File::Info(__File, File::#QUERY_ProductName)
EndMacro
Macro GetDescription(__File)
File::Info(__File, File::#QUERY_Description)
EndMacro
Macro GetComments(__File)
File::Info(__File, File::#QUERY_Comments)
EndMacro
Macro GetCompanyName(__File)
File::Info(__File, File::#QUERY_CompanyName)
EndMacro
Macro GetInternalName(__File)
File::Info(__File, File::#QUERY_InternalName)
EndMacro
Macro GetLegalCopyright(__File)
File::Info(__File, File::#QUERY_LegalCopyright)
EndMacro
Macro GetLegalTrademarks(__File)
File::Info(__File, File::#QUERY_LegalTrademarks)
EndMacro
Macro GetOriginalFilename(__File)
File::Info(__File, File::#QUERY_OriginalFilename)
EndMacro
Declare.s Info(File.s, Query.s) ; you can use the macros above or with #QUERY_* constants
Declare.s GetFixedProductVersion(File.s)
Declare.s GetFixedVersion(File.s)
Declare.s GetFixedType(File.s)
; Get the Thumbnails saved from Explorer/Windows
Macro GetThumbnail(__File, __Width = 64, __Height = 64, __Depth = 32)
FileEx::GetThumbnailEx(__File, __Width, __Height, __Depth)
EndMacro
; Get System Icon of the File
Macro GetIcon(__File, __Depth = 32, __BG_Color = #PB_Image_Transparent)
FileEx::GetIconEx(__File, __Depth, __BG_Color)
EndMacro
Macro DrawIcon(__File, __ImageNr, __X = 0, __Y = 0, __Width = 64, __Height = 64, __Depth = 32, __BG_Color = #PB_Image_Transparent)
FileEx::GetIconEx(__File, __Depth, __BG_Color, __ImageNr, __X, __Y, __Width, __Height)
EndMacro
; Macro FreeThumbnail(__Thumbnail)
; FreeImage(__Thumbnail)
; EndMacro
; Macro FreeIcon(__Icon)
; FreeImage(__Icon)
; EndMacro
CompilerEndIf
; Search for Files
Declare.i Search(Dir.s, ; Directory to begin Search
List Out.s(), ; Output (string-)list of files with full path
Name.s, ; (File-)name to search for ... you can use wildcard (*,?) or regex (use Flag: File::#SEARCH_RegEx)
Flags = File::#SEARCH_File|File::#SEARCH_CountResults, ; Flags ... se above
Count = 1, ; count max. entries or max. directory depth ... see Flags
*Break.Integer = #Null) ; you can pass a pointer to an integer-variable ... if this var is true, procedure will return and clean up (use it for threads)
EndDeclareModule
Module FileEx
EnableExplicit
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure.s FileInfo_VerQueryValue(*FVI_Buffer, Query.s)
Protected Ret.s, TranslationCode.s, *Out, Out_Len
VerQueryValue_(*FVI_Buffer, "\\VarFileInfo\\Translation", @*Out, @Out_Len)
If *Out
TranslationCode = RSet(Hex(PeekW(*Out)), 4, "0") + RSet(Hex(PeekW(*Out + 2)), 4, "0")
If VerQueryValue_(*FVI_Buffer,"\\StringFileInfo\\" + TranslationCode + "\\" + Query, @*Out, @Out_Len)
Ret = PeekS(*Out, Out_Len)
Else ; try default
If VerQueryValue_(*FVI_Buffer,"\\StringFileInfo\\040904E4\\" + Query, @*Out, @Out_Len)
Ret = PeekS(*Out, Out_Len)
EndIf
EndIf
EndIf
ProcedureReturn Trim(Ret)
EndProcedure
Procedure.i FileInfo_GetFileVersionInfo(File.s)
Protected BufferSize, *Ret
BufferSize = GetFileVersionInfoSize_(@File, 0)
If BufferSize > 0
*Ret = AllocateMemory(BufferSize)
If *Ret
If GetFileVersionInfo_(@File, 0, BufferSize, *Ret) = #Null
FreeMemory(*Ret)
*Ret = #Null
EndIf
EndIf
EndIf
ProcedureReturn *Ret
EndProcedure
Procedure.i FileInfo_GetFixedValues(*FVI_Buffer, *Out.STRUCT_FixedValuesEx)
Protected Ret, *FixedFileInfo.VS_FIXEDFILEINFO, FixedFileInfo_Len
VerQueryValue_(*FVI_Buffer, "\", @*FixedFileInfo, @FixedFileInfo_Len)
If *FixedFileInfo
*Out\ProductVersion\Major = *FixedFileInfo\dwProductVersionMS >> 16 & $FFFF
*Out\ProductVersion\Minor = *FixedFileInfo\dwProductVersionMS & $FFFF
*Out\ProductVersion\Patch = *FixedFileInfo\dwProductVersionLS >> 16 & $FFFF
*Out\ProductVersion\Build = *FixedFileInfo\dwProductVersionLS & $FFFF
*Out\FileVersion\Major = *FixedFileInfo\dwFileVersionMS >> 16 & $FFFF
*Out\FileVersion\Minor = *FixedFileInfo\dwFileVersionMS & $FFFF
*Out\FileVersion\Patch = *FixedFileInfo\dwFileVersionLS >> 16 & $FFFF
*Out\FileVersion\Build = *FixedFileInfo\dwFileVersionLS & $FFFF
*Out\FileType\Type = *FixedFileInfo\dwFileType
*Out\FileType\SubType = *FixedFileInfo\dwFileSubtype
Ret = #True
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s Version2String(Major = 0, Minor = 0, Patch = 0, Build = 0)
Protected Ret.s
Ret = Str(Major) + "."
Ret + Str(Minor) + "."
Ret + Str(Patch) + "."
Ret + Str(Build)
ProcedureReturn Ret
EndProcedure
Procedure.s Type2String(Type = #VFT_UNKNOWN, SubType = #VFT2_UNKNOWN)
Protected Ret.s
Select Type
Case #VFT_APP
Ret = "Application"
Case #VFT_DLL
Ret = "DLL"
Case #VFT_DRV
Select SubType
Case #VFT2_DRV_COMM
Ret = "Comm"
Case #VFT2_DRV_DISPLAY
Ret = "Display"
Case #VFT2_DRV_INSTALLABLE
Ret = "Installable"
Case #VFT2_DRV_KEYBOARD
Ret = "Keyboard"
Case #VFT2_DRV_LANGUAGE
Ret = "Language"
Case #VFT2_DRV_MOUSE
Ret = "Mouse"
Case #VFT2_DRV_NETWORK
Ret = "Network"
Case #VFT2_DRV_PRINTER
Ret = "Printer"
Case #VFT2_DRV_SOUND
Ret = "Sound"
Case #VFT2_DRV_SYSTEM
Ret = "System"
Case #VFT2_DRV_INPUTMETHOD
Ret = "InputMethod"
;Case #VFT2_UNKNOWN
Default
Ret = "Unkown"
EndSelect
Ret + " Driver"
Case #VFT_FONT
Select SubType
Case #VFT2_FONT_RASTER
Ret = "Raster"
Case #VFT2_FONT_TRUETYPE
Ret = "TrueType"
Case #VFT2_FONT_VECTOR
Ret = "Vector"
;Case #VFT2_UNKNOWN
Default
Ret = "Unkown"
EndSelect
Ret + " Font"
Case #VFT_STATIC_LIB
Ret = "Static LIB"
Case #VFT_VXD
Ret = "Virtual Device"
;Case #VFT_UNKNOWN
Default
Ret = "Unkown"
EndSelect
ProcedureReturn Ret
EndProcedure
Procedure InfoEx(File.s, *Out.STRUCT_InfoEx)
Protected *FVI_Buffer, Ret
Protected *FixedValues.STRUCT_FixedValuesEx = AllocateStructure(STRUCT_FixedValuesEx)
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
*Out\Comments = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_Comments)
*Out\CompanyName = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_CompanyName)
*Out\FileDescription = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_Description)
*Out\FileVersion = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_Version)
*Out\InternalName = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_InternalName)
*Out\LegalCopyright = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_LegalCopyright)
*Out\LegalTrademarks = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_LegalTrademarks)
*Out\OriginalFilename = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_OriginalFilename)
*Out\ProductName = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_ProductName)
*Out\ProductVersion = FileInfo_VerQueryValue(*FVI_Buffer, File::#QUERY_ProductVersion)
CopyStructure(*FixedValues, @*Out\FixedValues, STRUCT_FixedValuesEx)
Ret = #True
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure FixedValuesEx(File.s, *Out.STRUCT_FixedValuesEx)
Protected *FVI_Buffer, Ret
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
If FileInfo_GetFixedValues(*FVI_Buffer, *Out)
Ret = #True
EndIf
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure GetIconEx(FileName.s, Depth = 32, BG_Color = #PB_Image_Transparent, Img = #PB_Any, x = 0, y = 0, Width = 0, Height = 0)
Protected SHFI.SHFILEINFO
Protected Ret = #False
If SHGetFileInfo_(FileName, 0, @SHFI, SizeOf(SHFI), #SHGFI_ICON|#SHGFI_LARGEICON)
If Width < 1
Width = GetIconWidth()
EndIf
If Height < 1
Height = GetIconHeigth()
EndIf
If Img = #PB_Any
Ret = CreateImage(#PB_Any, Width, Height, Depth, BG_Color)
Else
If IsImage(Img)
Ret = Img
EndIf
EndIf
If Ret
If StartDrawing(ImageOutput(Ret))
DrawImage(SHFI\hIcon, x, y, Width, Height)
StopDrawing()
Else
FreeImage(Ret)
Ret = #False
EndIf
EndIf
DestroyIcon_(SHFI\hIcon)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure GetThumbnailEx(Filename.s, Width = 64, Height = 64, Depth = 32, Img = #PB_Any)
Protected Desktop.IShellFolder, Folder.IShellFolder
Protected *ItemIDList_Folder.ITEMIDLIST, *ItemIDList_File.ITEMIDLIST
Protected Extract.IExtractImage
Protected Ret, Priority, Flags, hBitmap, Size.Size, Bitmap.BITMAP
Protected DBP, BuffPos, iy
Size\cx = Width
Size\cy = Height
Flags | $004 ;#IEIFLAG_ASPECT
Flags | $040 ;#IEIFLAG_ORIGSize
;Flags | $020 ;#IEIFLAG_SCREEN
Flags | $200 ;#IEIFLAG_QUALITY
CoInitialize_(0)
If SHGetDesktopFolder_(@Desktop) >= 0
If Desktop\ParseDisplayName(#Null, #Null, GetPathPart(Filename), #Null, @*ItemIDList_Folder, #Null) = #S_OK
If Desktop\BindToObject(*ItemIDList_Folder, #Null, ?IID_IShellFolder, @Folder) = #S_OK
If Folder\ParseDisplayName(#Null, #Null, GetFilePart(Filename) , #Null, @*ItemIDList_File, #Null) = #S_OK
If Folder\GetUIObjectOf(#Null, 1, @*ItemIDList_File, ?IID_IExtractImage, 0, @Extract) = #S_OK
If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @Size, Depth, @Flags) >= 0
If Extract\Extract(@hBitmap) >= 0 And hBitmap
GetObject_(hBitmap, SizeOf(Bitmap), @Bitmap)
If Img = #PB_Any
Ret = CreateImage(#PB_Any, Bitmap\bmWidth, Bitmap\bmHeight, Bitmap\bmBitsPixel, #PB_Image_Transparent)
Else
If IsImage(Img)
Ret = Img
EndIf
EndIf
If Ret
If StartDrawing(ImageOutput(Ret))
; DrawAlphaImage(hBitmap, 0, 0) ; image is drawn in wrong direction .... but Documents not !?!?!?
DBP = DrawingBufferPitch()
BuffPos = DrawingBuffer() + (DBP * Bitmap\bmHeight) - DBP
For iy = 0 To Bitmap\bmHeight - 1
CopyMemory(Bitmap\bmBits + (iy * Bitmap\bmWidthBytes), BuffPos - (iy * DBP), DBP)
Next
StopDrawing()
Else
FreeImage(Ret)
Ret = #False
EndIf
EndIf
DeleteObject_(hBitmap)
EndIf
Extract\Release()
EndIf
EndIf
CoTaskMemFree_(*ItemIDList_File)
EndIf
Folder\Release()
EndIf
CoTaskMemFree_(*ItemIDList_Folder)
EndIf
Desktop\Release()
EndIf
CoUninitialize_()
DataSection
IID_IShellFolder: ; {000214E6-0000-0000-C000-000000000046}
Data.l $000214E6
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IExtractImage: ; {BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}
Data.l $BB2E617C
Data.w $0920, $11D1
Data.b $9A, $0B, $00, $C0, $4F, $C2, $D6, $C1
EndDataSection
ProcedureReturn Ret
EndProcedure
CompilerEndIf
Procedure.s Wildcard2RegEx(String.s, MultiLine = #False)
String = ReplaceString(String, "\", "\\")
String = ReplaceString(String, ".", "\.")
String = ReplaceString(String, "+", "\+")
String = ReplaceString(String, "$", "\$")
String = ReplaceString(String, "^", "\^")
String = ReplaceString(String, "(", "\(")
String = ReplaceString(String, ")", "\)")
String = ReplaceString(String, "[", "\[")
String = ReplaceString(String, "]", "\]")
String = ReplaceString(String, "{", "\{")
String = ReplaceString(String, "}", "\}")
String = ReplaceString(String, "*", ".*")
String = ReplaceString(String, "?", ".")
If MultiLine
ProcedureReturn "^" + String + "$"
EndIf
ProcedureReturn "\A" + String + "\Z"
EndProcedure
EndModule
Module File
EnableExplicit
UseModule FileEx
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure.s GetFixedType(File.s)
Protected *FixedValues.STRUCT_FixedValuesEx = AllocateStructure(STRUCT_FixedValuesEx)
Protected *FVI_Buffer, Ret.s
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
If *FixedValues
If FileInfo_GetFixedValues(*FVI_Buffer, *FixedValues)
Ret = Type2String(*FixedValues\FileType\Type,
*FixedValues\FileType\SubType)
EndIf
FreeStructure(*FixedValues)
EndIf
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s GetFixedVersion(File.s)
Protected *FixedValues.STRUCT_FixedValuesEx = AllocateStructure(STRUCT_FixedValuesEx)
Protected *FVI_Buffer, Ret.s
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
If *FixedValues
If FileInfo_GetFixedValues(*FVI_Buffer, *FixedValues)
Ret = Version2String(*FixedValues\FileVersion\Major,
*FixedValues\FileVersion\Minor,
*FixedValues\FileVersion\Patch,
*FixedValues\FileVersion\Build)
EndIf
FreeStructure(*FixedValues)
EndIf
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s GetFixedProductVersion(File.s)
Protected *FixedValues.STRUCT_FixedValuesEx = AllocateStructure(STRUCT_FixedValuesEx)
Protected *FVI_Buffer, Ret.s
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
If *FixedValues
If FileInfo_GetFixedValues(*FVI_Buffer, *FixedValues)
Ret = Version2String(*FixedValues\ProductVersion\Major,
*FixedValues\ProductVersion\Minor,
*FixedValues\ProductVersion\Patch,
*FixedValues\ProductVersion\Build)
EndIf
FreeStructure(*FixedValues)
EndIf
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s Info(File.s, Query.s)
Protected *FVI_Buffer
Protected Ret.s
*FVI_Buffer = FileInfo_GetFileVersionInfo(File)
If *FVI_Buffer
Ret = FileInfo_VerQueryValue(*FVI_Buffer, Query)
FreeMemory(*FVI_Buffer)
EndIf
ProcedureReturn Ret
EndProcedure
CompilerEndIf
Procedure.i Search(Dir.s, List Out.s(), Name.s, Flags = #SEARCH_File|#SEARCH_CountResults, Count = 1, *Break.Integer = #Null)
Protected Ret, DirID, DirEntryName.s, Match, RegExID, FindFlag
If Dir = ""
Dir = GetCurrentDirectory()
EndIf
; Change Flag to CaseSensitive / NoCase
If Not (Flags & #SEARCH_CaseSensitive)
FindFlag = #PB_RegularExpression_NoCase
EndIf
; Wildcards or Regex ?
If Not (Flags & #SEARCH_Regex)
Name = Wildcard2RegEx(Name)
EndIf
; remove tailing "/" or "\" ----- not needed ... doesnt matter if "\\", "//" or "\/" used in Win ... but Linux/OSX?
If Right(Dir, 1) = #PATH_Separator ;"/" Or Right(Dir, 1) = "\"
Dir = Left(Dir, Len(Dir) - 1)
EndIf
RegExID = CreateRegularExpression(#PB_Any, Name.s, FindFlag)
If RegExID
DirID = ExamineDirectory(#PB_Any, Dir, "")
If DirID
While NextDirectoryEntry(DirID)
Match = #False
DirEntryName = DirectoryEntryName(DirID)
; Check if results reached max count
If Flags & #SEARCH_CountResults
If Ret >= Count
Break
EndIf
EndIf
; test match
If MatchRegularExpression(RegExID, DirEntryName)
Match = #True
EndIf
; test if entry is directory or file
Select DirectoryEntryType(DirID)
Case #PB_DirectoryEntry_Directory
If DirEntryName <> "." And DirEntryName <> ".."
If Flags & #SEARCH_Recursiv
If Flags & #SEARCH_CountResults
If (Count - Ret) > 0
Ret + Search(Dir.s + #PATH_Separator + DirEntryName, Out(), Name, Flags|#SEARCH_Regex, Count - Ret, *Break)
EndIf
ElseIf Flags & #SEARCH_CountDirDepth
If Count > 0
Ret + Search(Dir.s + #PATH_Separator + DirEntryName, Out(), Name, Flags|#SEARCH_Regex, Count - 1, *Break)
EndIf
Else
Ret + Search(Dir.s + #PATH_Separator + DirEntryName, Out(), Name, Flags|#SEARCH_Regex, Count, *Break)
EndIf
EndIf
If Not (Flags & #SEARCH_Directory)
Match = #False
EndIf
Else
Match = #False
EndIf
Case #PB_DirectoryEntry_File
If Not (Flags & #SEARCH_File)
Match = #False
EndIf
EndSelect
; if the entry meets our criteria, add it to the list.
If Match
AddElement(Out())
Out() = Dir + #PATH_Separator + DirEntryName
Ret + 1
EndIf
If *Break
If *Break\i
Break
EndIf
EndIf
Wend
FinishDirectory(DirID)
EndIf
FreeRegularExpression(RegExID)
EndIf
ProcedureReturn Ret
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Enumeration Window
#WND_Main
EndEnumeration
Enumeration Gadget
#GADGET_ExplorerTree
#GADGET_String_Search
#GADGET_ListIcon_Files
#GADGET_Frame_Search
#GADGET_CheckBox_Recursive
#GADGET_CheckBox_RegEx
#GADGET_CheckBox_CaseSensitive
#GADGET_CheckBox_Count
#GADGET_Option_CountResult
#GADGET_Option_CountDirDepth
#GADGET_Spin_Count
#GADGET_Btn_Search
#GADGET_Canvas_Preview
#GADGET_ListIcon_Info
#GADGET_Frame_Preview
#GADGET_ProgessBar
EndEnumeration
Enumeration Events #PB_Event_FirstCustomValue
#EVENT_Search_Finished
#EVENT_FileInfo_Finished
#EVENT_ProgressBar_Update
#EVENT_ListIcon_Update
EndEnumeration
Procedure CreateWindow()
Protected Ret
If OpenWindow(#WND_Main, 0, 0, 1000, 600, "FileModule - Demo - MiniExplorer", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
ExplorerTreeGadget(#GADGET_ExplorerTree,
10,
10,
240,
WindowHeight(#WND_Main) - 20,
#PB_Compiler_Home,
#PB_Explorer_NoFiles|#PB_Explorer_FullRowSelect)
ProgressBarGadget(#GADGET_ProgessBar,
GadgetWidth(#GADGET_ExplorerTree) + 20,
WindowHeight(#WND_Main) - 30,
WindowWidth(#WND_Main) - GadgetWidth(#GADGET_ExplorerTree) - 30,
20,
0,
100)
FrameGadget(#GADGET_Frame_Search,
GadgetWidth(#GADGET_ExplorerTree) + 20,
5,
WindowWidth(#WND_Main) - GadgetWidth(#GADGET_ExplorerTree) - 30,
100,
"Search / Pattern")
StringGadget(#GADGET_String_Search,
GadgetX(#GADGET_Frame_Search) + 10,
GadgetY(#GADGET_Frame_Search) + 15,
GadgetWidth(#GADGET_Frame_Search) - 20,
20,
"*")
CheckBoxGadget(#GADGET_CheckBox_CaseSensitive,
GadgetX(#GADGET_Frame_Search) + 180,
GadgetY(#GADGET_Frame_Search) + 35,
100,
20,
"Case Sensitive")
CheckBoxGadget(#GADGET_CheckBox_RegEx,
GadgetX(#GADGET_Frame_Search) + 180,
GadgetY(#GADGET_Frame_Search) + 55,
150,
20,
"Use Regular Expression")
CheckBoxGadget(#GADGET_CheckBox_Recursive,
GadgetX(#GADGET_Frame_Search) + 180,
GadgetY(#GADGET_Frame_Search) + 75,
80,
20,
"Recursive")
CheckBoxGadget(#GADGET_CheckBox_Count,
GadgetX(#GADGET_Frame_Search) + 360,
GadgetY(#GADGET_Frame_Search) + 35,
100,
20,
"Set Max. Count")
OptionGadget(#GADGET_Option_CountResult,
GadgetX(#GADGET_Frame_Search) + 380,
GadgetY(#GADGET_Frame_Search) + 55,
80,
20,
"Results")
SetGadgetState(#GADGET_Option_CountResult, #True)
DisableGadget(#GADGET_Option_CountResult, #True)
OptionGadget(#GADGET_Option_CountDirDepth,
GadgetX(#GADGET_Frame_Search) + 380,
GadgetY(#GADGET_Frame_Search) + 75,
80,
20,
"Dir. Depth")
DisableGadget(#GADGET_Option_CountDirDepth, #True)
SpinGadget(#GADGET_Spin_Count,
GadgetX(#GADGET_Frame_Search) + 460,
GadgetY(#GADGET_Frame_Search) + 65,
60,
20,
1,
99999,
#PB_Spin_Numeric)
SetGadgetState(#GADGET_Spin_Count, 1)
DisableGadget(#GADGET_Spin_Count, #True)
ButtonGadget(#GADGET_Btn_Search,
GadgetX(#GADGET_Frame_Search) + 10,
GadgetY(#GADGET_Frame_Search) + 45,
140,
45,
"Search",
#PB_Button_Default|#PB_Button_Toggle)
ListIconGadget(#GADGET_ListIcon_Files,
GadgetWidth(#GADGET_ExplorerTree) + 20,
GadgetHeight(#GADGET_Frame_Search) + 15,
(WindowWidth(#WND_Main) - GadgetWidth(#GADGET_ExplorerTree) - 40) / 2,
WindowHeight(#WND_Main) - GadgetHeight(#GADGET_Frame_Search) - GadgetHeight(#GADGET_ProgessBar) - 35,
"FileName",
200,
#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_FullRowSelect)
SetGadgetAttribute(#GADGET_ListIcon_Files, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
FrameGadget(#GADGET_Frame_Preview,
GadgetWidth(#GADGET_ExplorerTree) + GadgetWidth(#GADGET_ListIcon_Files) + 30,
GadgetHeight(#GADGET_Frame_Search) + 10,
(WindowWidth(#WND_Main) - GadgetWidth(#GADGET_ExplorerTree) - 40) / 2,
WindowHeight(#WND_Main) - GadgetHeight(#GADGET_Frame_Search) - GadgetHeight(#GADGET_ProgessBar) - 30,
"Preview")
CanvasGadget(#GADGET_Canvas_Preview,
GadgetX(#GADGET_Frame_Preview) + 10,
GadgetY(#GADGET_Frame_Preview) + 20,
GadgetWidth(#GADGET_Frame_Preview) - 20,
(GadgetHeight(#GADGET_Frame_Preview) - 40) / 2,
#PB_Canvas_Border)
ListIconGadget(#GADGET_ListIcon_Info,
GadgetX(#GADGET_Frame_Preview) + 10,
GadgetY(#GADGET_Frame_Preview) + GadgetHeight(#GADGET_Canvas_Preview) + 30,
GadgetWidth(#GADGET_Frame_Preview) - 20,
(GadgetHeight(#GADGET_Frame_Preview) - 40) / 2,
"Info",
110)
AddGadgetColumn(#GADGET_ListIcon_Info,
1,
"Value",
200)
Ret = #True
EndIf
ProcedureReturn Ret
EndProcedure
Structure STRUCT_File
File.s
Dir.s
Icon.i
Thumbnail.i
Type.s
Info.FileEx::STRUCT_InfoEx
EndStructure
Structure STRUCT_ThreadData_Common
ID.i
Break.i
EndStructure
Structure STRUCT_ThreadData_Search Extends STRUCT_ThreadData_Common
Dir.s
List Out.s()
Name.s
Flags.i
Count.i
EndStructure
Structure STRUCT_ThreadData_FileInfo Extends STRUCT_ThreadData_Common
Progress.i
List In.s()
List Out.STRUCT_File()
EndStructure
Procedure FreeFileList(List Files.STRUCT_File())
With Files()
ForEach Files()
If IsImage(\Icon)
FreeImage(\Icon)
EndIf
If IsImage(\Thumbnail)
FreeImage(\Thumbnail)
EndIf
Next
ClearList(Files())
EndWith
EndProcedure
Procedure FreeThread(ID.i, *Break.Integer)
Protected Ret = #True
If IsThread(ID)
If *Break
*Break\i = #True
EndIf
Ret = WaitThread(ID, 500)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure THREAD_Search(*Data.STRUCT_ThreadData_Search)
With *Data
;Debug "Search STARTED <" + Str(\ID) + ">"
; This is a Demo ... an mutex object is safer
File::Search(\Dir,
\Out(),
\Name,
\Flags,
\Count,
@\Break)
If \Break = #False
;Debug "Search DONE <" + Str(\ID) + ">"
PostEvent(#EVENT_Search_Finished)
Else
Debug "Search ABORTED <" + Str(\ID) + ">"
EndIf
EndWith
EndProcedure
Procedure THREAD_FileInfo(*Data.STRUCT_ThreadData_FileInfo)
With *Data
;Debug "Processing Files STARTED <" + Str(\ID) + ">"
; again ... a Demo ... mutex is safer
ForEach \In()
AddElement(\Out())
\Out()\File = GetFilePart(\In())
\Out()\Dir = GetPathPart(\In())
\Out()\Thumbnail = File::GetThumbnail(\In(), GadgetWidth(#GADGET_Canvas_Preview), GadgetHeight(#GADGET_Canvas_Preview))
\Out()\Icon = File::GetIcon(\In())
\Out()\Type = File::GetFixedType(\In())
FileEx::InfoEx(\In(), @\Out()\Info)
\Progress + 1
PostEvent(#EVENT_ProgressBar_Update, #WND_Main, 0, #EVENT_ProgressBar_Update, \Progress)
PostEvent(#EVENT_ListIcon_Update, #WND_Main, 0, #EVENT_ListIcon_Update, @\Out())
If \Break
Break
EndIf
Next
If \Break = #False
;Debug "Processing DONE <" + Str(\ID) + ">"
PostEvent(#EVENT_FileInfo_Finished)
Else
Debug "Processing ABORTED <" + Str(\ID) + ">"
EndIf
EndWith
EndProcedure
CreateWindow()
HideWindow(#WND_Main, #False)
Define THREAD_Data_Search.STRUCT_ThreadData_Search
Define THREAD_Data_FileInfo.STRUCT_ThreadData_FileInfo
Define *Temp_ListIconData.STRUCT_File
Define Temp, Temp_ImageID.i, Temp_X.i, Temp_Width.i, Temp_Text.s
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #GADGET_CheckBox_Count
DisableGadget(#GADGET_Option_CountDirDepth, GetGadgetState(#GADGET_CheckBox_Count)!1)
DisableGadget(#GADGET_Option_CountResult, GetGadgetState(#GADGET_CheckBox_Count)!1)
DisableGadget(#GADGET_Spin_Count, GetGadgetState(#GADGET_CheckBox_Count)!1)
Case #GADGET_Btn_Search
If GetGadgetState(#GADGET_Btn_Search)
SetGadgetText(#GADGET_Btn_Search, "STOP")
SetGadgetState(#GADGET_ProgessBar, #PB_ProgressBar_Unknown)
With THREAD_Data_Search
ClearList(\Out())
If FreeThread(\ID, @\Break)
\Flags = File::#SEARCH_File
If GetGadgetState(#GADGET_CheckBox_CaseSensitive)
\Flags | File::#SEARCH_CaseSensitive
EndIf
If GetGadgetState(#GADGET_CheckBox_Recursive)
\Flags | File::#SEARCH_Recursiv
EndIf
If GetGadgetState(#GADGET_CheckBox_RegEx)
\Flags | File::#SEARCH_Regex
EndIf
If GetGadgetState(#GADGET_CheckBox_Count)
\Count = GetGadgetState(#GADGET_Spin_Count)
If GetGadgetState(#GADGET_Option_CountResult)
\Flags | File::#SEARCH_CountResults
ElseIf GetGadgetState(#GADGET_Option_CountDirDepth)
\Flags | File::#SEARCH_CountDirDepth
EndIf
EndIf
\Dir = GetGadgetText(#GADGET_ExplorerTree)
\Name = GetGadgetText(#GADGET_String_Search)
\Count = GetGadgetState(#GADGET_Spin_Count)
\Break = #False
\ID = CreateThread(@THREAD_Search(), @THREAD_Data_Search)
EndIf
EndWith
Else
SetGadgetText(#GADGET_Btn_Search, "Search")
SetGadgetState(#GADGET_ProgessBar, 0)
THREAD_Data_Search\Break = #True
THREAD_Data_FileInfo\Break = #True
EndIf
Case #GADGET_ListIcon_Files
Select EventType()
Case #PB_EventType_Change
*Temp_ListIconData = GetGadgetItemData(#GADGET_ListIcon_Files, GetGadgetState(#GADGET_ListIcon_Files))
If *Temp_ListIconData
With *Temp_ListIconData
If IsImage(\Thumbnail)
Temp_ImageID = \Thumbnail
ElseIf IsImage(\Icon)
Temp_ImageID = \Icon
Else
Temp_ImageID = 0
EndIf
If StartDrawing(CanvasOutput(#GADGET_Canvas_Preview))
Box(0, 0, OutputWidth(), OutputHeight(), #White)
If Temp_ImageID
Temp_Width = Round(ImageWidth(Temp_ImageID) * (OutputHeight() / ImageHeight(Temp_ImageID)), #PB_Round_Up)
Temp_X = (OutputWidth() - Temp_Width) / 2
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawImage(ImageID(Temp_ImageID), Temp_X, 0, Temp_Width, OutputHeight())
EndIf
StopDrawing()
EndIf
ClearGadgetItems(#GADGET_ListIcon_Info)
Temp = GetFileAttributes(*Temp_ListIconData\Dir + *Temp_ListIconData\File)
Temp_Text = ""
If Temp & #PB_FileSystem_Hidden
Temp_Text + "Hidden "
EndIf
If Temp & #PB_FileSystem_Archive
Temp_Text + "Archive "
EndIf
If Temp & #PB_FileSystem_Compressed
Temp_Text + "Compressed "
EndIf
If Temp & #PB_FileSystem_Normal
Temp_Text + "Normal"
EndIf
If Temp & #PB_FileSystem_ReadOnly
Temp_Text + "ReadOnly "
EndIf
If Temp & #PB_FileSystem_System
Temp_Text + "System "
EndIf
AddGadgetItem(#GADGET_ListIcon_Info, -1, "File" + #LF$ + *Temp_ListIconData\Dir + *Temp_ListIconData\File)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Directory" + #LF$ + *Temp_ListIconData\Dir)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Attributes" + #LF$ + Temp_Text)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Modified" + #LF$ + FormatDate("%yy-%mm-%dd %hh:%ii:%ss", GetFileDate(*Temp_ListIconData\Dir + *Temp_ListIconData\File, #PB_Date_Modified)))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Accessed" + #LF$ + FormatDate("%yy-%mm-%dd %hh:%ii:%ss", GetFileDate(*Temp_ListIconData\Dir + *Temp_ListIconData\File, #PB_Date_Accessed)))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Created" + #LF$ + FormatDate("%yy-%mm-%dd %hh:%ii:%ss", GetFileDate(*Temp_ListIconData\Dir + *Temp_ListIconData\File, #PB_Date_Created)))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Type" + #LF$ + *Temp_ListIconData\Type)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "CompanyName" + #LF$ + *Temp_ListIconData\Info\CompanyName)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Description" + #LF$ + *Temp_ListIconData\Info\FileDescription)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Version" + #LF$ + *Temp_ListIconData\Info\FileVersion)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "InternalName" + #LF$ + *Temp_ListIconData\Info\InternalName)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "LegalCopyright" + #LF$ + *Temp_ListIconData\Info\LegalCopyright)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "LegalTrademarks" + #LF$ + *Temp_ListIconData\Info\LegalTrademarks)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "OriginalFilename" + #LF$ + *Temp_ListIconData\Info\OriginalFilename)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "ProductName" + #LF$ + *Temp_ListIconData\Info\ProductName)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "ProductVersion" + #LF$ + *Temp_ListIconData\Info\ProductVersion)
AddGadgetItem(#GADGET_ListIcon_Info, -1, "FixedVersion" + #LF$ + File::GetFixedVersion(*Temp_ListIconData\Dir + *Temp_ListIconData\File))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "FixedProductVersion" + #LF$ + File::GetFixedProductVersion(*Temp_ListIconData\Dir + *Temp_ListIconData\File))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "FixedType" + #LF$ + File::GetFixedType(*Temp_ListIconData\Dir + *Temp_ListIconData\File))
AddGadgetItem(#GADGET_ListIcon_Info, -1, "Comments" + #LF$ + *Temp_ListIconData\Info\Comments)
EndWith
EndIf
Case #PB_EventType_LeftDoubleClick
*Temp_ListIconData = GetGadgetItemData(#GADGET_ListIcon_Files, GetGadgetState(#GADGET_ListIcon_Files))
If *Temp_ListIconData
RunProgram(*Temp_ListIconData\Dir + *Temp_ListIconData\File, "", *Temp_ListIconData\Dir)
EndIf
EndSelect
EndSelect
Case #EVENT_Search_Finished
SetGadgetAttribute(#GADGET_ProgessBar, #PB_ProgressBar_Minimum, 0)
SetGadgetAttribute(#GADGET_ProgessBar, #PB_ProgressBar_Maximum, ListSize(THREAD_Data_Search\Out()))
SetGadgetState(#GADGET_ProgessBar, 0)
ClearGadgetItems(#GADGET_ListIcon_Files)
If ListSize(THREAD_Data_Search\Out()) > 0
With THREAD_Data_FileInfo
If FreeThread(\ID, @\Break)
ClearList(\In())
FreeFileList(\Out())
CopyList(THREAD_Data_Search\Out(), \In())
\Progress = 0
\Break = #False
\ID = CreateThread(@THREAD_FileInfo(), @THREAD_Data_FileInfo)
EndIf
EndWith
Else ; nothing to do
PostEvent(#EVENT_FileInfo_Finished)
EndIf
Case #EVENT_ProgressBar_Update
;Debug "ProgressBar UPDATE (" + Str(EventData()) + "/" + GetGadgetAttribute(#GADGET_ProgessBar, #PB_ProgressBar_Maximum) + ")"
SetGadgetState(#GADGET_ProgessBar, EventData())
Case #EVENT_ListIcon_Update
;Debug "ListIcon UPDATE"
*Temp_ListIconData = EventData()
If *Temp_ListIconData
If IsImage(*Temp_ListIconData\Thumbnail)
Temp_ImageID = ImageID(*Temp_ListIconData\Thumbnail)
ElseIf IsImage(*Temp_ListIconData\Icon)
Temp_ImageID = ImageID(*Temp_ListIconData\Icon)
Else
Temp_ImageID = 0
EndIf
AddGadgetItem(#GADGET_ListIcon_Files, -1, *Temp_ListIconData\File, Temp_ImageID)
SetGadgetItemData(#GADGET_ListIcon_Files, CountGadgetItems(#GADGET_ListIcon_Files) - 1, *Temp_ListIconData)
EndIf
Case #EVENT_FileInfo_Finished
;Debug "Process DONE"
;SetGadgetState(#GADGET_ProgessBar, 0)
SetGadgetState(#GADGET_Btn_Search, #False)
PostEvent(#PB_Event_Gadget, #WND_Main, #GADGET_Btn_Search)
EndSelect
ForEver
FreeFileList(THREAD_Data_FileInfo\Out())
CompilerElse
CompilerError "Sorry, the Demo is ONLY for WINDOWS"
CompilerEndIf
CompilerEndIf