DirView.pas 101 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452
  1. unit DirView;
  2. {===============================================================
  3. Component TDirView / Version 2.6, January 2000
  4. ===============================================================
  5. Description:
  6. ============
  7. Displays files of a single directory as listview with shell
  8. icons. Complete drag&Drop support for files and directories.
  9. Author:
  10. =======
  11. (c) Ingo Eckel 1998, 1999
  12. Sodener Weg 38
  13. 65812 Bad Soden
  14. Germany
  15. Modifications (for WinSCP):
  16. ===========================
  17. (c) Martin Prikryl 2001- 2004
  18. V2.6:
  19. - Shows "shared"-symbol with directories
  20. - Delphi5 compatible
  21. For detailed documentation and history see TDirView.htm.
  22. ===============================================================}
  23. {Required compiler options for TDirView:}
  24. {$A+,B-,X+,H+,P+}
  25. interface
  26. {$WARN UNIT_PLATFORM OFF}
  27. {$WARN SYMBOL_PLATFORM OFF}
  28. uses
  29. Windows, ShlObj, ComCtrls, CompThread, CustomDirView, ListExt,
  30. ExtCtrls, Graphics, FileOperator, DiscMon, Classes, DirViewColProperties,
  31. DragDrop, Messages, ListViewColProperties, CommCtrl, DragDropFilesEx,
  32. FileCtrl, SysUtils, BaseUtils, Controls, CustomDriveView, System.Generics.Collections, Winapi.ShellAPI;
  33. {$I ResStrings.pas }
  34. type
  35. TVolumeDisplayStyle = (doPrettyName, doDisplayName); {Diplaytext of drive node}
  36. const
  37. msThreadChangeDelay = 10; {TDiscMonitor: change delay}
  38. MaxWaitTimeOut = 10; {TFileDeleteThread: wait nn seconds for deleting files or directories}
  39. {$WARN SYMBOL_DEPRECATED OFF}
  40. FileAttr = SysUtils.faAnyFile and (not SysUtils.faVolumeID);
  41. {$WARN SYMBOL_DEPRECATED ON}
  42. SpecialExtensions = 'EXE,LNK,ICO,ANI,CUR,PIF,JOB,CPL';
  43. ExeExtension = 'EXE';
  44. type
  45. {Exceptions:}
  46. EIUThread = class(Exception);
  47. EDragDrop = class(Exception);
  48. EInvalidFileName = class(Exception);
  49. ERenameFileFailed = class(Exception);
  50. TClipboardOperation = (cboNone, cboCut, cboCopy);
  51. {Record for each file item:}
  52. PFileRec = ^TFileRec;
  53. TFileRec = record
  54. Empty: Boolean;
  55. IconEmpty: Boolean;
  56. IsDirectory: Boolean;
  57. IsRecycleBin: Boolean;
  58. IsParentDir: Boolean;
  59. FileName: string;
  60. Displayname: string;
  61. FileExt: string;
  62. TypeName: string;
  63. ImageIndex: Integer;
  64. Size: Int64;
  65. Attr: LongWord;
  66. FileTime: TFileTime;
  67. PIDL: PItemIDList; {Fully qualified PIDL}
  68. end;
  69. {Record for fileinfo caching:}
  70. PInfoCache = ^TInfoCache;
  71. TInfoCache = record
  72. FileExt: string;
  73. TypeName: string;
  74. ImageIndex: Integer;
  75. end;
  76. {Additional events:}
  77. type
  78. TDirViewFileSizeChanged = procedure(Sender: TObject; Item: TListItem) of object;
  79. TDirViewFileIconForName = procedure(Sender: TObject; Item: TListItem; var FileName: string) of object;
  80. type
  81. TDirView = class;
  82. { TIconUpdateThread (Fetch shell icons via thread) }
  83. TIconUpdateThread = class(TCompThread)
  84. private
  85. FOwner: TDirView;
  86. FIndex: Integer;
  87. FMaxIndex: Integer;
  88. FNewIcons: Boolean;
  89. FSyncIcon: Integer;
  90. CurrentIndex: Integer;
  91. CurrentFilePath: string;
  92. CurrentItemData: TFileRec;
  93. InvalidItem: Boolean;
  94. procedure SetIndex(Value: Integer);
  95. procedure SetMaxIndex(Value: Integer);
  96. protected
  97. constructor Create(Owner: TDirView);
  98. procedure DoFetchData;
  99. procedure DoUpdateIcon;
  100. procedure Execute; override;
  101. property Index: Integer read FIndex write SetIndex;
  102. property MaxIndex: Integer read FMaxIndex write SetMaxIndex;
  103. public
  104. procedure Terminate; override;
  105. end;
  106. { TDirView }
  107. TDirView = class(TCustomDirView)
  108. private
  109. FConfirmDelete: Boolean;
  110. FConfirmOverwrite: Boolean;
  111. FUseIconCache: Boolean;
  112. FInfoCacheList: TListExt;
  113. FDriveView: TCustomDriveView;
  114. FChangeTimer: TTimer;
  115. FChangeInterval: Cardinal;
  116. FUseIconUpdateThread: Boolean;
  117. FIUThreadFinished: Boolean;
  118. FDriveType: Integer;
  119. FParentFolder: IShellFolder;
  120. FDesktopFolder: IShellFolder;
  121. FDirOK: Boolean;
  122. FPath: string;
  123. SelectNewFiles: Boolean;
  124. FHiddenCount: Integer;
  125. FFilteredCount: Integer;
  126. {shFileOperation-shell component TFileOperator:}
  127. FFileOperator: TFileOperator;
  128. {Additional thread components:}
  129. FIconUpdateThread: TIconUpdateThread;
  130. FDiscMonitor: TDiscMonitor;
  131. FHomeDirectory: string;
  132. {Additional events:}
  133. FOnFileIconForName: TDirViewFileIconForName;
  134. iRecycleFolder: iShellFolder;
  135. PIDLRecycle: PItemIDList;
  136. FLastPath: TDictionary<string, string>;
  137. FTimeoutShellIconRetrieval: Boolean;
  138. {Drag&Drop:}
  139. function GetDirColProperties: TDirViewColProperties;
  140. function GetHomeDirectory: string;
  141. {Drag&drop helper functions:}
  142. procedure SignalFileDelete(Sender: TObject; Files: TStringList);
  143. procedure PerformDragDropFileOperation(TargetPath: string; Effect: Integer;
  144. RenameOnCollision: Boolean; Paste: Boolean);
  145. procedure SetDirColProperties(Value: TDirViewColProperties);
  146. protected
  147. function NewColProperties: TCustomListViewColProperties; override;
  148. function SortAscendingByDefault(Index: Integer): Boolean; override;
  149. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  150. procedure Delete(Item: TListItem); override;
  151. procedure DDError(ErrorNo: TDDError);
  152. function GetCanUndoCopyMove: Boolean; virtual;
  153. {Shell namespace functions:}
  154. function GetShellFolder(Dir: string): iShellFolder;
  155. function GetDirOK: Boolean; override;
  156. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItem); override;
  157. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  158. DragStatus: TDragDetectStatus); override;
  159. procedure DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  160. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint); override;
  161. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); override;
  162. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  163. Point: TPoint; dwEffect: Longint); override;
  164. procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); override;
  165. function GetPathName: string; override;
  166. procedure SetChangeInterval(Value: Cardinal); virtual;
  167. procedure LoadFromRecycleBin(Dir: string); virtual;
  168. procedure SetLoadEnabled(Value: Boolean); override;
  169. function GetPath: string; override;
  170. procedure SetPath(Value: string); override;
  171. procedure PathChanged; override;
  172. procedure SetItemImageIndex(Item: TListItem; Index: Integer); override;
  173. procedure ChangeDetected(Sender: TObject; const Directory: string;
  174. var SubdirsChanged: Boolean);
  175. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  176. procedure TimerOnTimer(Sender: TObject);
  177. procedure ResetItemImage(Index: Integer);
  178. procedure SetWatchForChanges(Value: Boolean); override;
  179. procedure AddParentDirItem;
  180. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); override;
  181. function DragCompleteFileList: Boolean; override;
  182. procedure ExecuteFile(Item: TListItem); override;
  183. function GetIsRoot: Boolean; override;
  184. procedure InternalEdit(const HItem: TLVItem); override;
  185. function ItemColor(Item: TListItem): TColor; override;
  186. function ItemFileExt(Item: TListItem): string;
  187. function ItemFileNameOnly(Item: TListItem): string;
  188. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; override;
  189. function ItemIsFile(Item: TListItem): Boolean; override;
  190. function ItemIsRecycleBin(Item: TListItem): Boolean; override;
  191. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; override;
  192. function FileMatches(FileName: string; const SearchRec: TSearchRec): Boolean;
  193. function ItemOverlayIndexes(Item: TListItem): Word; override;
  194. procedure LoadFiles; override;
  195. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean); override;
  196. procedure SortItems; override;
  197. procedure StartFileDeleteThread;
  198. procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  199. procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
  200. procedure Load(DoFocusSomething: Boolean); override;
  201. function GetFileInfo(pszPath: LPCWSTR; dwFileAttributes: DWORD; var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD_PTR;
  202. function DoCopyToClipboard(Focused: Boolean; Cut: Boolean; Operation: TClipBoardOperation): Boolean;
  203. function HiddenCount: Integer; override;
  204. function FilteredCount: Integer; override;
  205. public
  206. {Runtime, readonly properties:}
  207. property DriveType: Integer read FDriveType;
  208. {Linked component TDriveView:}
  209. property DriveView: TCustomDriveView read FDriveView write FDriveView;
  210. { required, otherwise AV generated, when dragging columns}
  211. property Columns stored False;
  212. property ParentFolder: IShellFolder read FParentFolder;
  213. {Drag&Drop runtime, readonly properties:}
  214. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  215. property DDFileOperator: TFileOperator read FFileOperator;
  216. {Drag&Drop fileoperation methods:}
  217. function UndoCopyMove: Boolean; dynamic;
  218. {Clipboard fileoperation methods (requires drag&drop enabled):}
  219. procedure EmptyClipboard; dynamic;
  220. function CopyToClipBoard(Focused: Boolean): Boolean; dynamic;
  221. function CutToClipBoard(Focused: Boolean): Boolean; dynamic;
  222. function PasteFromClipBoard(TargetPath: string = ''): Boolean; override;
  223. function DuplicateSelectedFiles: Boolean; dynamic;
  224. procedure DisplayPropertiesMenu; override;
  225. procedure DisplayContextMenu(Where: TPoint); override;
  226. procedure ExecuteParentDirectory; override;
  227. procedure ExecuteRootDirectory; override;
  228. function ItemIsDirectory(Item: TListItem): Boolean; override;
  229. function ItemFullFileName(Item: TListItem): string; override;
  230. function ItemIsParentDirectory(Item: TListItem): Boolean; override;
  231. function ItemFileName(Item: TListItem): string; override;
  232. function ItemFileSize(Item: TListItem): Int64; override;
  233. function ItemFileTime(Item: TListItem; var Precision: TDateTimePrecision): TDateTime; override;
  234. {Thread handling: }
  235. procedure StartWatchThread;
  236. procedure StopWatchThread;
  237. function WatchThreadActive: Boolean;
  238. procedure StartIconUpdateThread;
  239. procedure StopIconUpdateThread;
  240. procedure TerminateThreads;
  241. {Other additional functions: }
  242. procedure ClearIconCache;
  243. {Create a new file:}
  244. function CreateFile(NewName: string): TListItem; dynamic;
  245. {Create a new subdirectory:}
  246. procedure CreateDirectory(DirName: string); override;
  247. {Delete all selected files:}
  248. {Check, if file or files still exists:}
  249. procedure ValidateFile(Item: TListItem); overload;
  250. procedure ValidateFile(FileName:TFileName); overload;
  251. procedure ValidateSelectedFiles; dynamic;
  252. {Access the internal data-structures:}
  253. function AddItem(SRec: SysUtils.TSearchRec): TListItem; reintroduce;
  254. procedure GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  255. function GetFileRec(Index: Integer): PFileRec;
  256. {Populate / repopulate the filelist:}
  257. procedure Reload(CacheIcons : Boolean); override;
  258. procedure Reload2;
  259. function FormatFileTime(FileTime: TFileTime): string; virtual;
  260. function GetAttrString(Attr: Integer): string; virtual;
  261. constructor Create(AOwner: TComponent); override;
  262. destructor Destroy; override;
  263. procedure ExecuteHomeDirectory; override;
  264. procedure ReloadDirectory; override;
  265. procedure ExecuteDrive(Drive: string);
  266. property HomeDirectory: string read GetHomeDirectory write FHomeDirectory;
  267. property TimeoutShellIconRetrieval: Boolean read FTimeoutShellIconRetrieval write FTimeoutShellIconRetrieval;
  268. published
  269. property DirColProperties: TDirViewColProperties read GetDirColProperties write SetDirColProperties;
  270. property PathLabel;
  271. property OnUpdateStatusBar;
  272. property DimmHiddenFiles;
  273. property ShowHiddenFiles;
  274. property WantUseDragImages;
  275. property TargetPopupMenu;
  276. property AddParentDir;
  277. property OnSelectItem;
  278. property OnStartLoading;
  279. property OnLoaded;
  280. property OnDDDragEnter;
  281. property OnDDDragLeave;
  282. property OnDDDragOver;
  283. property OnDDDrop;
  284. property OnDDQueryContinueDrag;
  285. property OnDDGiveFeedback;
  286. property OnDDDragDetect;
  287. property OnDDCreateDragFileList;
  288. property OnDDEnd;
  289. property OnDDCreateDataObject;
  290. property OnDDTargetHasDropHandler;
  291. {Drag&Drop:}
  292. property DDLinkOnExeDrag default True;
  293. property OnDDProcessDropped;
  294. property OnDDError;
  295. property OnDDExecuted;
  296. property OnDDFileOperation;
  297. property OnDDFileOperationExecuted;
  298. property OnExecFile;
  299. property OnMatchMask;
  300. property OnGetOverlay;
  301. property OnGetItemColor;
  302. {Confirm deleting files}
  303. property ConfirmDelete: Boolean
  304. read FConfirmDelete write FConfirmDelete default True;
  305. {Confirm overwriting files}
  306. property ConfirmOverwrite: Boolean
  307. read FConfirmOverwrite write fConfirmOverwrite default True;
  308. {Reload the directory after only the interval:}
  309. property ChangeInterval: Cardinal
  310. read FChangeInterval write SetChangeInterval default MSecsPerSec;
  311. {Fetch shell icons by thread:}
  312. property UseIconUpdateThread: Boolean
  313. read FUseIconUpdateThread write FUseIconUpdateThread default False;
  314. {Enables or disables icon caching for registered file extensions. Caching enabled
  315. enhances the performance but does not take care about installed icon handlers, wich
  316. may modify the display icon for registered files. Only the iconindex is cached not the
  317. icon itself:}
  318. property UseIconCache: Boolean
  319. read FUseIconCache write FUseIconCache default False;
  320. {Watch current directory for filename changes (create, rename, delete files)}
  321. property WatchForChanges;
  322. {Additional events:}
  323. property OnFileIconForName: TDirViewFileIconForName
  324. read FOnFileIconForName write FOnFileIconForName;
  325. property UseSystemContextMenu;
  326. property OnContextPopup;
  327. property OnHistoryChange;
  328. property OnHistoryGo;
  329. property OnPathChange;
  330. property OnBusy;
  331. property OnChangeFocus;
  332. property ColumnClick;
  333. property MultiSelect;
  334. property ReadOnly;
  335. // The only way to make Items stored automatically and survive handle recreation.
  336. // Though we should implement custom persisting to avoid publishing this
  337. property Items;
  338. end; {Type TDirView}
  339. procedure Register;
  340. {Returns True, if the specified extension matches one of the extensions in ExtList:}
  341. function MatchesFileExt(Ext: string; const FileExtList: string): Boolean;
  342. function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
  343. function DropFiles(
  344. DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
  345. RenameOnCollision: Boolean; IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean; Paste: Boolean;
  346. Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
  347. out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
  348. var
  349. LastClipBoardOperation: TClipBoardOperation;
  350. LastIOResult: DWORD;
  351. implementation
  352. uses
  353. DriveView, OperationWithTimeout,
  354. PIDL, Forms, Dialogs,
  355. ComObj,
  356. ActiveX, ImgList,
  357. ShellDialogs, IEDriveInfo,
  358. FileChanges, Math, PasTools, StrUtils, Types, UITypes;
  359. var
  360. DaylightHack: Boolean;
  361. procedure Register;
  362. begin
  363. RegisterComponents('DriveDir', [TDirView]);
  364. end; {Register}
  365. function CompareInfoCacheItems(I1, I2: Pointer): Integer;
  366. begin
  367. if PInfoCache(I1)^.FileExt < PInfoCache(I2)^.FileExt then Result := fLess
  368. else
  369. if PInfoCache(I1)^.FileExt > PInfoCache(I2)^.FileExt then Result := fGreater
  370. else Result := fEqual;
  371. end; {CompareInfoCacheItems}
  372. function MatchesFileExt(Ext: string; const FileExtList: string): Boolean;
  373. begin
  374. Result := (Length(Ext) = 3) and (Pos(Ext, FileExtList) <> 0);
  375. end; {MatchesFileExt}
  376. function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
  377. var
  378. SysTime: TSystemTime;
  379. UniverzalSysTime: TSystemTime;
  380. LocalFileTime: TFileTime;
  381. begin
  382. // duplicated in Common.cpp
  383. // The 0xFFF... is sometime seen for invalid timestamps,
  384. // it would cause failure in SystemTimeToDateTime below
  385. if FileTime.dwLowDateTime = High(DWORD) then
  386. begin
  387. Result := MinDateTime;
  388. end
  389. else
  390. begin
  391. if not DaylightHack then
  392. begin
  393. FileTimeToSystemTime(FileTime, UniverzalSysTime);
  394. SystemTimeToTzSpecificLocalTime(nil, UniverzalSysTime, SysTime);
  395. end
  396. else
  397. begin
  398. FileTimeToLocalFileTime(FileTime, LocalFileTime);
  399. FileTimeToSystemTime(LocalFileTime, SysTime);
  400. end;
  401. Result := SystemTimeToDateTime(SysTime);
  402. end;
  403. end;
  404. function SizeFromSRec(const SRec: SysUtils.TSearchRec): Int64;
  405. begin
  406. with SRec do
  407. begin
  408. // Hopefuly TSearchRec.FindData is available with all Windows versions
  409. {if Size >= 0 then Result := Size
  410. else}
  411. {$WARNINGS OFF}
  412. Result := Int64(FindData.nFileSizeHigh) shl 32 + FindData.nFileSizeLow;
  413. {$WARNINGS ON}
  414. end;
  415. end;
  416. function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
  417. var
  418. Drive: string;
  419. SourcePath: string;
  420. SourceFile: string;
  421. begin
  422. SourceFile := Item.Name;
  423. if IsRootPath(SourceFile) then
  424. begin
  425. Drive := DriveInfo.GetDriveKey(SourceFile);
  426. SourcePath := Copy(DriveInfo.Get(Drive).PrettyName, 4, 255) + ' (' + Drive + ')'
  427. end
  428. else
  429. begin
  430. SourcePath := ExtractFileName(SourceFile);
  431. end;
  432. Result :=
  433. CreateFileShortCut(SourceFile,
  434. IncludeTrailingBackslash(TargetPath) + ChangeFileExt(SourcePath, '.lnk'),
  435. ExtractFileNameOnly(SourceFile));
  436. end;
  437. function DropFiles(
  438. DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
  439. RenameOnCollision: Boolean; IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean; Paste: Boolean;
  440. Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
  441. out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
  442. var
  443. Index: Integer;
  444. DoFileOperation: Boolean;
  445. begin
  446. SourcePath := '';
  447. {Set the source filenames:}
  448. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  449. begin
  450. FileOperator.OperandFrom.Add(
  451. TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  452. if DragDropFilesEx.FileNamesAreMapped then
  453. FileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
  454. TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
  455. if SourcePath = '' then
  456. begin
  457. if DirectoryExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  458. begin
  459. SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  460. SourceIsDirectory := True;
  461. end
  462. else
  463. begin
  464. SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  465. SourceIsDirectory := False;
  466. end;
  467. end;
  468. end;
  469. FileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  470. if RenameOnCollision then
  471. begin
  472. FileOperator.Flags := FileOperator.Flags + [foRenameOnCollision];
  473. FileOperator.WantMappingHandle := True;
  474. end
  475. else FileOperator.WantMappingHandle := False;
  476. {Set the target directory or the target filenames:}
  477. if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
  478. begin
  479. FileOperator.Flags := FileOperator.Flags + [foMultiDestFiles];
  480. end
  481. else
  482. begin
  483. FileOperator.Flags := FileOperator.Flags - [foMultiDestFiles];
  484. FileOperator.OperandTo.Clear;
  485. FileOperator.OperandTo.Add(TargetPath);
  486. end;
  487. {if the target directory is the recycle bin, then delete the selected files:}
  488. if IsRecycleBin then
  489. begin
  490. FileOperator.Operation := foDelete;
  491. end
  492. else
  493. begin
  494. case Effect of
  495. DROPEFFECT_COPY: FileOperator.Operation := foCopy;
  496. DROPEFFECT_MOVE: FileOperator.Operation := foMove;
  497. end;
  498. end;
  499. if IsRecycleBin then
  500. begin
  501. if not ConfirmDelete then
  502. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  503. end
  504. else
  505. begin
  506. if not ConfirmOverwrite then
  507. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  508. end;
  509. DoFileOperation := True;
  510. if Assigned(OnDDFileOperation) then
  511. begin
  512. OnDDFileOperation(Sender, Effect, SourcePath, TargetPath, False, DoFileOperation);
  513. end;
  514. Result := DoFileOperation and (FileOperator.OperandFrom.Count > 0);
  515. if Result then
  516. begin
  517. FileOperator.Execute;
  518. if DragDropFilesEx.FileNamesAreMapped then
  519. FileOperator.ClearUndo;
  520. end;
  521. end;
  522. function GetShellDisplayName(
  523. const ShellFolder: IShellFolder; IDList: PItemIDList; Flags: DWORD; var Name: string): Boolean;
  524. var
  525. Str: TStrRet;
  526. begin
  527. Result := True;
  528. Name := '';
  529. if ShellFolder.GetDisplayNameOf(IDList, Flags, Str) = NOERROR then
  530. begin
  531. case Str.uType of
  532. STRRET_WSTR: Name := WideCharToString(Str.pOleStr);
  533. STRRET_OFFSET: Name := PChar(UINT(IDList) + Str.uOffset);
  534. STRRET_CSTR: Name := string(Str.cStr);
  535. else Result := False;
  536. end;
  537. end
  538. else Result := False;
  539. end; {GetShellDisplayName}
  540. { TIconUpdateThread }
  541. constructor TIconUpdateThread.Create(Owner: TDirView);
  542. begin
  543. inherited Create(True);
  544. FOwner := Owner;
  545. FIndex := 0;
  546. FNewIcons := False;
  547. if (FOwner.ViewStyle = vsReport) or (FOwner.ViewStyle = vsList) then
  548. FMaxIndex := FOwner.VisibleRowCount
  549. else FMaxIndex := 0;
  550. FOwner.FIUThreadFinished := False;
  551. end; {TIconUpdateThread.Create}
  552. procedure TIconUpdateThread.SetMaxIndex(Value: Integer);
  553. var
  554. Point: TPoint;
  555. Item: TListItem;
  556. begin
  557. if Value <> MaxIndex then
  558. begin
  559. FNewIcons := True;
  560. if Value < FMaxIndex then
  561. begin
  562. if Suspended then FIndex := Value
  563. else
  564. begin
  565. Point.X := 0;
  566. Point.X := 0;
  567. Item := FOwner.GetNearestItem(Point, TSearchDirection(sdAbove));
  568. if Assigned(Item) then FIndex := Item.Index
  569. else FIndex := Value;
  570. end;
  571. end
  572. else FMaxIndex := Value;
  573. end;
  574. end; {SetMaxIndex}
  575. procedure TIconUpdateThread.SetIndex(Value: Integer);
  576. var
  577. PageSize: Integer;
  578. begin
  579. if Value <> Index then
  580. begin
  581. PageSize := FOwner.VisibleRowCount;
  582. FIndex := Value;
  583. FNewIcons := True;
  584. if FOwner.ViewStyle = vsList then FMaxIndex := Value + 2 * PageSize
  585. else FMaxIndex := Value + PageSize;
  586. end;
  587. end; {SetIndex}
  588. procedure TIconUpdateThread.Execute;
  589. var
  590. FileInfo: TShFileInfo;
  591. Count: Integer;
  592. Eaten: ULONG;
  593. ShAttr: ULONG;
  594. FileIconForName: string;
  595. ForceByName: Boolean;
  596. begin
  597. if Assigned(FOwner.TopItem) then FIndex := FOwner.TopItem.Index
  598. else FIndex := 0;
  599. FNewIcons := (FIndex > 0);
  600. while not Terminated do
  601. begin
  602. if FIndex > FMaxIndex then Suspend;
  603. Count := FOwner.Items.Count;
  604. if not Terminated and ((FIndex >= Count) or (Count = 0)) then
  605. Suspend;
  606. InvalidItem := True;
  607. if Terminated then Break;
  608. Synchronize(DoFetchData);
  609. if (not InvalidItem) and (not Terminated) and
  610. CurrentItemData.IconEmpty then
  611. begin
  612. try
  613. ForceByName := False;
  614. FileIconForName := CurrentFilePath;
  615. if Assigned(FOwner.FOnFileIconForName) then
  616. begin
  617. FOwner.FOnFileIconForName(FOwner, nil, FileIconForName);
  618. ForceByName := (FileIconForName <> CurrentFilePath);
  619. end;
  620. if not Assigned(CurrentItemData.PIDL) then
  621. begin
  622. ShAttr := 0;
  623. FOwner.FDesktopFolder.ParseDisplayName(FOwner.ParentForm.Handle, nil,
  624. PChar(CurrentFilePath), Eaten, CurrentItemData.PIDL, ShAttr);
  625. end;
  626. if (not ForceByName) and Assigned(CurrentItemData.PIDL) then
  627. begin
  628. SHGetFileInfo(PChar(CurrentItemData.PIDL), 0, FileInfo, SizeOf(FileInfo),
  629. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  630. end
  631. else
  632. begin
  633. SHGetFileInfo(PChar(FileIconForName), 0, FileInfo, SizeOf(FileInfo),
  634. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  635. end;
  636. except
  637. {Capture exceptions generated by the shell}
  638. FSyncIcon := UnKnownFileIcon;
  639. end;
  640. if Terminated then
  641. begin
  642. FreePIDL(CurrentItemData.PIDL);
  643. Break;
  644. end;
  645. FSyncIcon := FileInfo.iIcon;
  646. if FSyncIcon <> CurrentItemData.ImageIndex then
  647. FNewIcons := True;
  648. if not Terminated then
  649. begin
  650. Synchronize(DoUpdateIcon);
  651. end;
  652. FreePIDL(CurrentItemData.PIDL);
  653. end;
  654. SetLength(CurrentFilePath, 0);
  655. if CurrentIndex = FIndex then Inc(FIndex);
  656. SetLength(CurrentFilePath, 0);
  657. end;
  658. end; {TIconUpdateThread.Execute}
  659. procedure TIconUpdateThread.DoFetchData;
  660. begin
  661. CurrentIndex := fIndex;
  662. if not Terminated and
  663. (Pred(FOwner.Items.Count) >= CurrentIndex) and
  664. Assigned(FOwner.Items[CurrentIndex]) and
  665. Assigned(FOwner.Items[CurrentIndex].Data) then
  666. begin
  667. CurrentFilePath := FOwner.ItemFullFileName(FOwner.Items[CurrentIndex]);
  668. CurrentItemData := PFileRec(FOwner.Items[CurrentIndex].Data)^;
  669. InvalidItem := False;
  670. end
  671. else InvalidItem := True;
  672. end; {TIconUpdateThread.DoFetchData}
  673. procedure TIconUpdateThread.DoUpdateIcon;
  674. var
  675. LVI: TLVItem;
  676. begin
  677. if (FOwner.Items.Count > CurrentIndex) and
  678. not fOwner.Loading and not Terminated and
  679. Assigned(FOwner.Items[CurrentIndex]) and
  680. Assigned(FOwner.Items[CurrentIndex].Data) then
  681. with FOwner.Items[CurrentIndex] do
  682. begin
  683. if (FSyncIcon >= 0) and (PFileRec(Data)^.ImageIndex <> FSyncIcon) then
  684. begin
  685. with PFileRec(Data)^ do
  686. ImageIndex := FSyncIcon;
  687. {To avoid flickering of the display use Listview_SetItem
  688. instead of using the property ImageIndex:}
  689. LVI.mask := LVIF_IMAGE;
  690. LVI.iItem := CurrentIndex;
  691. LVI.iSubItem := 0;
  692. LVI.iImage := I_IMAGECALLBACK;
  693. if not Terminated then
  694. ListView_SetItem(FOwner.Handle, LVI);
  695. FNewIcons := True;
  696. end;
  697. PFileRec(Data)^.IconEmpty := False;
  698. end;
  699. end; {TIconUpdateThread.DoUpdateIcon}
  700. procedure TIconUpdateThread.Terminate;
  701. begin
  702. FOwner.FIUThreadFinished := True;
  703. inherited;
  704. end; {TIconUpdateThread.Terminate}
  705. { TDirView }
  706. constructor TDirView.Create(AOwner: TComponent);
  707. begin
  708. inherited Create(AOwner);
  709. FInfoCacheList := TListExt.Create(SizeOf(TInfoCache));
  710. FDriveType := DRIVE_UNKNOWN;
  711. FUseIconCache := False;
  712. FConfirmDelete := True;
  713. FParentFolder := nil;
  714. FDesktopFolder := nil;
  715. SelectNewFiles := False;
  716. DragOnDriveIsMove := True;
  717. FHiddenCount := 0;
  718. FFilteredCount := 0;
  719. FFileOperator := TFileOperator.Create(Self);
  720. FFileOperator.ProgressTitle := coFileOperatorTitle;
  721. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  722. FDirOK := True;
  723. FPath := '';
  724. FDiscMonitor := nil;
  725. {ChangeTimer: }
  726. if FChangeInterval = 0 then FChangeInterval := MSecsPerSec;
  727. FChangeTimer := TTimer.Create(Self);
  728. FChangeTimer.Interval := FChangeInterval;
  729. FChangeTimer.Enabled := False;
  730. FChangeTimer.OnTimer := TimerOnTimer;
  731. {Drag&drop:}
  732. FConfirmOverwrite := True;
  733. DDLinkOnExeDrag := True;
  734. with DragDropFilesEx do
  735. begin
  736. SourceEffects := DragSourceEffects;
  737. TargetEffects := [deCopy, deMove, deLink];
  738. ShellExtensions.DragDropHandler := True;
  739. ShellExtensions.DropHandler := True;
  740. end;
  741. FLastPath := nil;
  742. end; {Create}
  743. destructor TDirView.Destroy;
  744. begin
  745. if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
  746. FLastPath.Free;
  747. FInfoCacheList.Free;
  748. FFileOperator.Free;
  749. FChangeTimer.Free;
  750. inherited Destroy;
  751. FPath := '';
  752. end; {Destroy}
  753. procedure TDirView.WMDestroy(var Msg: TWMDestroy);
  754. begin
  755. Selected := nil;
  756. ClearItems;
  757. TerminateThreads;
  758. inherited;
  759. end; {WMDestroy}
  760. procedure TDirView.CMRecreateWnd(var Message: TMessage);
  761. begin
  762. // see comment in TDirView.StopIconUpdateThread
  763. if not (csRecreating in ControlState) then
  764. begin
  765. inherited;
  766. end;
  767. end;
  768. procedure TDirView.TerminateThreads;
  769. begin
  770. StopIconUpdateThread;
  771. StopWatchThread;
  772. if Assigned(FDiscMonitor) then
  773. begin
  774. FDiscMonitor.Free;
  775. FDiscMonitor := nil;
  776. end;
  777. end; {TerminateThreads}
  778. function TDirView.GetHomeDirectory: string;
  779. begin
  780. if FHomeDirectory <> '' then Result := FHomeDirectory
  781. else
  782. begin
  783. Result := UserDocumentDirectory;
  784. // in rare case the CSIDL_PERSONAL cannot be resolved
  785. if Result = '' then
  786. begin
  787. Result := DriveInfo.AnyValidPath;
  788. end;
  789. end;
  790. end; { GetHomeDirectory }
  791. function TDirView.GetIsRoot: Boolean;
  792. begin
  793. Result := IsRootPath(Path);
  794. end;
  795. function TDirView.GetPath: string;
  796. begin
  797. Result := FPath;
  798. end;
  799. procedure TDirView.PathChanged;
  800. var
  801. Expanded: string;
  802. begin
  803. inherited;
  804. // make sure to use PathName as Path maybe just X: what
  805. // ExpandFileName resolves to current working directory
  806. // on the drive, not to root path
  807. Expanded := ExpandFileName(PathName);
  808. if not Assigned(FLastPath) then
  809. begin
  810. FLastPath := TDictionary<string, string>.Create;
  811. end;
  812. FLastPath.AddOrSetValue(DriveInfo.GetDriveKey(Expanded), Expanded);
  813. end;
  814. procedure TDirView.SetPath(Value: string);
  815. begin
  816. // do checks before passing directory to drive view, because
  817. // it would truncate non-existing directory to first superior existing
  818. Value := ReplaceStr(Value, '/', '\');
  819. if not DirectoryExists(ApiPath(Value)) then
  820. raise Exception.CreateFmt(SDirNotExists, [Value]);
  821. if Assigned(FDriveView) and
  822. (FDriveView.Directory <> Value) then
  823. begin
  824. FDriveView.Directory := Value;
  825. end
  826. else
  827. if FPath <> Value then
  828. try
  829. while (Length(Value) > 0) and (Value[Length(Value)] = '\') do
  830. SetLength(Value, Length(Value) - 1);
  831. PathChanging(True);
  832. FPath := Value;
  833. Load(True);
  834. finally
  835. PathChanged;
  836. end;
  837. end;
  838. procedure TDirView.SetLoadEnabled(Value: Boolean);
  839. begin
  840. if Value <> LoadEnabled then
  841. begin
  842. FLoadEnabled := Enabled;
  843. if LoadEnabled and Dirty then
  844. begin
  845. if Items.Count > 100 then Reload2
  846. else Reload(True);
  847. end;
  848. end;
  849. end; {SetLoadEnabled}
  850. function TDirView.GetPathName: string;
  851. begin
  852. if IsRoot then Result := IncludeTrailingBackslash(Path)
  853. else Result := Path;
  854. end; {GetPathName}
  855. function TDirView.GetFileRec(Index: Integer): PFileRec;
  856. begin
  857. if Index > Pred(Items.Count) then Result := nil
  858. else Result := Items[index].Data;
  859. end; {GetFileRec}
  860. function TDirView.HiddenCount: Integer;
  861. begin
  862. Result := FHiddenCount;
  863. end;
  864. function TDirView.FilteredCount: Integer;
  865. begin
  866. Result := FFilteredCount;
  867. end;
  868. function TDirView.AddItem(SRec: SysUtils.TSearchRec): TListItem;
  869. var
  870. PItem: PFileRec;
  871. Item: TListItem;
  872. begin
  873. Item := TListItem.Create(Items);
  874. New(PItem);
  875. with PItem^ do
  876. begin
  877. // must be set as soon as possible, at least before Caption is set,
  878. // because if come column is "autosized" setting Caption invokes some callbacks
  879. Item.Data := PItem;
  880. FileName := SRec.Name;
  881. FileExt := UpperCase(ExtractFileExt(Srec.Name));
  882. FileExt := Copy(FileExt, 2, Length(FileExt) - 1);
  883. DisplayName := FileName;
  884. {$WARNINGS OFF}
  885. Attr := SRec.FindData.dwFileAttributes;
  886. {$WARNINGS ON}
  887. IsParentDir := False;
  888. IsDirectory := ((Attr and SysUtils.faDirectory) <> 0);
  889. IsRecycleBin := IsDirectory and (Length(Path) = 2) and
  890. Bool(Attr and SysUtils.faSysFile) and
  891. ((UpperCase(FileName) = 'RECYCLED') or (UpperCase(FileName) = 'RECYCLER'));
  892. if not IsDirectory then Size := SizeFromSRec(SRec)
  893. else Size := -1;
  894. {$WARNINGS OFF}
  895. FileTime := SRec.FindData.ftLastWriteTime;
  896. {$WARNINGS ON}
  897. Empty := True;
  898. IconEmpty := True;
  899. if Size > 0 then Inc(FFilesSize, Size);
  900. PIDL := nil;
  901. // Need to add before assigning to .Caption and .OverlayIndex,
  902. // as the setters these call back to owning view.
  903. // Assignment is redundant
  904. Item := Items.AddItem(Item);
  905. if not Self.IsRecycleBin then Item.Caption := SRec.Name;
  906. if FileExt = 'LNK' then Item.OverlayIndex := 1;
  907. end;
  908. if SelectNewFiles then Item.Selected := True;
  909. Result := Item;
  910. end; {AddItem}
  911. procedure TDirView.AddParentDirItem;
  912. var
  913. PItem: PFileRec;
  914. Item: TListItem;
  915. SRec: SysUtils.TSearchRec;
  916. begin
  917. FHasParentDir := True;
  918. Item := Items.Add;
  919. New(PItem);
  920. if FindFirst(ApiPath(FPath), faAnyFile, SRec) = 0 then
  921. FindClose(SRec);
  922. with PItem^ do
  923. begin
  924. Item.Data := PItem;
  925. FileName := '..';
  926. FileExt := '';
  927. DisplayName := '..';
  928. Attr := SRec.Attr;
  929. IsDirectory := True;
  930. IsRecycleBin := False;
  931. IsParentDir := True;
  932. Size := -1;
  933. Item.Caption := '..';
  934. {$WARNINGS OFF}
  935. FileTime := SRec.FindData.ftLastWriteTime;
  936. {$WARNINGS ON}
  937. Empty := True;
  938. IconEmpty := False;
  939. PIDL := nil;
  940. ImageIndex := StdDirIcon;
  941. TypeName := SParentDir;
  942. Empty := False;
  943. end;
  944. end; {AddParentDirItem}
  945. procedure TDirView.LoadFromRecycleBin(Dir: string);
  946. var
  947. PIDLRecycleLocal: PItemIDList;
  948. PCurrList: PItemIDList;
  949. FQPIDL: PItemIDList;
  950. EnumList: IEnumIDList;
  951. Fetched: ULONG;
  952. SRec: SysUtils.TSearchRec;
  953. DisplayName: string;
  954. FullPath: string;
  955. NewItem: TListItem;
  956. FileRec: PFileRec;
  957. FileInfo: TSHFileInfo;
  958. DosError: Integer;
  959. begin
  960. if not Assigned(iRecycleFolder) then
  961. begin
  962. PIDLRecycleLocal := nil;
  963. try
  964. OLECheck(SHGetSpecialFolderLocation(Self.Handle,
  965. CSIDL_BITBUCKET, PIDLRecycleLocal));
  966. PIDLRecycle := PIDL_Concatenate(nil, PIDLRecycleLocal);
  967. if not SUCCEEDED(FDesktopFolder.BindToObject(PIDLRecycle, nil,
  968. IID_IShellFolder, Pointer(iRecycleFolder))) then Exit;
  969. finally
  970. if Assigned(PIDLRecycleLocal) then
  971. FreePIDL(PIDLRecycleLocal);
  972. end;
  973. end;
  974. FParentFolder := iRecycleFolder;
  975. if AddParentDir then AddParentDirItem;
  976. FHiddenCount := 0;
  977. FFilteredCount := 0;
  978. if SUCCEEDED(iRecycleFolder.EnumObjects(Self.Handle,
  979. SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList)) then
  980. begin
  981. while (EnumList.Next(1, PCurrList, Fetched) = S_OK) and not AbortLoading do
  982. begin
  983. if Assigned(PCurrList) then
  984. try
  985. FQPIDL := PIDL_Concatenate(PIDLRecycle, PCurrList);
  986. {Physical filename:}
  987. SetLength(FullPath, MAX_PATH);
  988. if shGetPathFromIDList(FQPIDL, PChar(FullPath)) then
  989. SetLength(FullPath, StrLen(PChar(FullPath)));
  990. {Filesize, attributes and -date:}
  991. DosError := FindFirst(ApiPath(FullPath), faAnyFile, SRec);
  992. FindClose(Srec);
  993. SRec.Name := ExtractFilePath(FullPath) + SRec.Name;
  994. {Displayname:}
  995. GetShellDisplayName(iRecycleFolder, PCurrList, SHGDN_FORPARSING, DisplayName);
  996. if (DosError = 0) and
  997. (((SRec.Attr and faDirectory) <> 0) or
  998. FileMatches(DisplayName, SRec)) then
  999. begin
  1000. {Filetype and icon:}
  1001. SHGetFileInfo(PChar(FQPIDL), 0, FileInfo, SizeOf(FileInfo),
  1002. SHGFI_PIDL or SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1003. NewItem := AddItem(Srec);
  1004. NewItem.Caption := DisplayName;
  1005. FileRec := NewItem.Data;
  1006. FileRec^.Empty := False;
  1007. FileRec^.IconEmpty := False;
  1008. FileRec^.DisplayName := DisplayName;
  1009. FileRec^.PIDL := FQPIDL;
  1010. FileRec^.TypeName := FileInfo.szTypeName;
  1011. if FileRec^.Typename = EmptyStr then
  1012. FileRec^.TypeName := Format(STextFileExt, [FileRec.FileExt]);
  1013. FileRec^.ImageIndex := FileInfo.iIcon;
  1014. end
  1015. else
  1016. begin
  1017. FreePIDL(FQPIDL);
  1018. end;
  1019. FreePIDL(PCurrList);
  1020. except
  1021. if Assigned(PCurrList) then
  1022. try
  1023. FreePIDL(PCurrList);
  1024. except
  1025. end;
  1026. end;
  1027. end; {While EnumList ...}
  1028. end;
  1029. end; {LoadFromRecycleBin}
  1030. function TDirView.GetShellFolder(Dir: string): iShellFolder;
  1031. var
  1032. Eaten: ULONG;
  1033. Attr: ULONG;
  1034. NewPIDL: PItemIDList;
  1035. begin
  1036. Result := nil;
  1037. if not Assigned(FDesktopFolder) then
  1038. SHGetDesktopFolder(FDesktopFolder);
  1039. if Assigned(FDesktopFolder) then
  1040. begin
  1041. Attr := 0;
  1042. if Succeeded(FDesktopFolder.ParseDisplayName(
  1043. ParentForm.Handle, nil, PChar(Dir), Eaten, NewPIDL, Attr)) then
  1044. begin
  1045. try
  1046. assert(Assigned(NewPIDL));
  1047. FDesktopFolder.BindToObject(NewPIDL, nil, IID_IShellFolder, Pointer(Result));
  1048. Assert(Assigned(Result));
  1049. finally
  1050. FreePIDL(NewPIDL);
  1051. end;
  1052. end;
  1053. end;
  1054. end; {GetShellFolder}
  1055. function TDirView.ItemIsDirectory(Item: TListItem): Boolean;
  1056. begin
  1057. Result :=
  1058. (Assigned(Item) and Assigned(Item.Data) and
  1059. PFileRec(Item.Data)^.IsDirectory);
  1060. end;
  1061. function TDirView.ItemIsFile(Item: TListItem): Boolean;
  1062. begin
  1063. Result :=
  1064. (Assigned(Item) and Assigned(Item.Data) and
  1065. (not PFileRec(Item.Data)^.IsParentDir));
  1066. end;
  1067. function TDirView.ItemIsParentDirectory(Item: TListItem): Boolean;
  1068. begin
  1069. Result :=
  1070. (Assigned(Item) and Assigned(Item.Data) and
  1071. PFileRec(Item.Data)^.IsParentDir);
  1072. end;
  1073. function TDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1074. begin
  1075. Result := (Assigned(Item) and Assigned(Item.Data) and
  1076. PFileRec(Item.Data)^.IsRecycleBin);
  1077. end;
  1078. function TDirView.ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean;
  1079. var
  1080. FileRec: PFileRec;
  1081. begin
  1082. Assert(Assigned(Item) and Assigned(Item.Data));
  1083. FileRec := PFileRec(Item.Data);
  1084. Result :=
  1085. ((Filter.Masks = '') or
  1086. FileNameMatchesMasks(FileRec^.FileName, FileRec^.IsDirectory,
  1087. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False) or
  1088. (FileRec^.IsDirectory and Filter.Directories and
  1089. FileNameMatchesMasks(FileRec^.FileName, False,
  1090. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False)));
  1091. end;
  1092. function TDirView.FileMatches(FileName: string; const SearchRec: TSearchRec): Boolean;
  1093. var
  1094. Directory: Boolean;
  1095. FileSize: Int64;
  1096. begin
  1097. Result := (ShowHiddenFiles or ((SearchRec.Attr and SysUtils.faHidden) = 0));
  1098. if not Result then
  1099. begin
  1100. Inc(FHiddenCount);
  1101. end
  1102. else
  1103. if Mask <> '' then
  1104. begin
  1105. Directory := ((SearchRec.Attr and faDirectory) <> 0);
  1106. if Directory then FileSize := 0
  1107. else FileSize := SizeFromSRec(SearchRec);
  1108. Result :=
  1109. FileNameMatchesMasks(
  1110. FileName,
  1111. Directory,
  1112. FileSize,
  1113. FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime),
  1114. Mask, True);
  1115. if not Result then
  1116. begin
  1117. Inc(FFilteredCount);
  1118. end;
  1119. end;
  1120. end;
  1121. function TDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1122. begin
  1123. Result := inherited ItemOverlayIndexes(Item);
  1124. if Assigned(Item) and Assigned(Item.Data) then
  1125. begin
  1126. if PFileRec(Item.Data)^.IsParentDir then
  1127. Inc(Result, oiDirUp);
  1128. end;
  1129. end;
  1130. procedure TDirView.Load(DoFocusSomething: Boolean);
  1131. begin
  1132. try
  1133. StopIconUpdateThread;
  1134. StopWatchThread;
  1135. FChangeTimer.Enabled := False;
  1136. FChangeTimer.Interval := 0;
  1137. inherited;
  1138. finally
  1139. if DirOK and not AbortLoading then
  1140. begin
  1141. if FUseIconUpdateThread and (not IsRecycleBin) then
  1142. StartIconUpdateThread;
  1143. StartWatchThread;
  1144. end;
  1145. end;
  1146. end;
  1147. procedure TDirView.LoadFiles;
  1148. var
  1149. SRec: SysUtils.TSearchRec;
  1150. DosError: Integer;
  1151. DirsCount: Integer;
  1152. SelTreeNode: TTreeNode;
  1153. Node: TTreeNode;
  1154. Drive: string;
  1155. begin
  1156. FHiddenCount := 0;
  1157. FFilteredCount := 0;
  1158. try
  1159. if Length(FPath) > 0 then
  1160. begin
  1161. Drive := DriveInfo.GetDriveKey(FPath);
  1162. DriveInfo.ReadDriveStatus(Drive, dsSize);
  1163. FDriveType := DriveInfo.Get(Drive).DriveType;
  1164. FDirOK := DriveInfo.Get(Drive).DriveReady and DirectoryExists(FPath);
  1165. end
  1166. else
  1167. begin
  1168. FDriveType := DRIVE_UNKNOWN;
  1169. FDirOK := False;
  1170. end;
  1171. if DirOK then
  1172. begin
  1173. if Assigned(FDriveView) then
  1174. SelTreeNode := TDriveView(FDriveView).FindNodeToPath(FPath)
  1175. else SelTreeNode := nil;
  1176. if Assigned(FDriveView) and Assigned(SelTreeNode) then
  1177. FIsRecycleBin := TNodeData(SelTreeNode.Data).IsRecycleBin
  1178. else
  1179. FIsRecycleBin :=
  1180. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLED') or
  1181. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLER');
  1182. if not Assigned(FDesktopFolder) then
  1183. SHGetDesktopFolder(FDesktopFolder);
  1184. if IsRecycleBin then LoadFromRecycleBin(Path)
  1185. else
  1186. begin
  1187. FParentFolder := GetShellFolder(PathName);
  1188. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1189. FileAttr, SRec);
  1190. while (DosError = 0) and (not AbortLoading) do
  1191. begin
  1192. if (SRec.Attr and faDirectory) = 0 then
  1193. begin
  1194. if FileMatches(SRec.Name, SRec) then
  1195. begin
  1196. AddItem(SRec);
  1197. end;
  1198. end;
  1199. DosError := FindNext(SRec);
  1200. end;
  1201. SysUtils.FindClose(SRec);
  1202. if AddParentDir and (not IsRoot) then
  1203. begin
  1204. AddParentDirItem;
  1205. end;
  1206. {Search for directories:}
  1207. DirsCount := 0;
  1208. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1209. DirAttrMask, SRec);
  1210. while (DosError = 0) and (not AbortLoading) do
  1211. begin
  1212. if (SRec.Name <> '.') and (SRec.Name <> '..') and
  1213. ((Srec.Attr and faDirectory) <> 0) then
  1214. begin
  1215. Inc(DirsCount);
  1216. if FileMatches(SRec.Name, SRec) then
  1217. begin
  1218. AddItem(Srec);
  1219. end;
  1220. end;
  1221. DosError := FindNext(SRec);
  1222. end;
  1223. SysUtils.FindClose(SRec);
  1224. {Update TDriveView's subdir indicator:}
  1225. if Assigned(FDriveView) and (FDriveType = DRIVE_REMOTE) then
  1226. with TDriveView(FDriveView) do
  1227. begin
  1228. Node := FindNodeToPath(PathName);
  1229. if Assigned(Node) and Assigned(Node.Data) and
  1230. not TNodeData(Node.Data).Scanned then
  1231. begin
  1232. if DirsCount = 0 then
  1233. begin
  1234. Node.HasChildren := False;
  1235. TNodeData(Node.Data).Scanned := True;
  1236. end;
  1237. end;
  1238. end;
  1239. end; {not isRecycleBin}
  1240. end
  1241. else FIsRecycleBin := False;
  1242. finally
  1243. //if Assigned(Animate) then Animate.Free;
  1244. FInfoCacheList.Sort(CompareInfoCacheItems);
  1245. end; {Finally}
  1246. end;
  1247. procedure TDirView.Reload2;
  1248. type
  1249. PEFileRec = ^TEFileRec;
  1250. TEFileRec = record
  1251. iSize: Int64;
  1252. iAttr: Integer;
  1253. iFileTime: TFileTime;
  1254. iIndex: Integer;
  1255. end;
  1256. var
  1257. Index: Integer;
  1258. EItems: TStringList;
  1259. FItems: TStringList;
  1260. NewItems: TStringList;
  1261. Srec: SysUtils.TSearchRec;
  1262. DosError: Integer;
  1263. PSrec: ^SysUtils.TSearchRec;
  1264. Dummy: Integer;
  1265. ItemIndex: Integer;
  1266. AnyUpdate: Boolean;
  1267. PUpdate: Boolean;
  1268. PEFile: PEFileRec;
  1269. SaveCursor: TCursor;
  1270. FSize: Int64;
  1271. FocusedIsVisible: Boolean;
  1272. R: TRect;
  1273. begin
  1274. if (not Loading) and LoadEnabled then
  1275. begin
  1276. if IsRecycleBin then Reload(True)
  1277. else
  1278. begin
  1279. if not DirectoryExists(Path) then
  1280. begin
  1281. ClearItems;
  1282. FDirOK := False;
  1283. FDirty := False;
  1284. end
  1285. else
  1286. begin
  1287. if Assigned(ItemFocused) then
  1288. begin
  1289. R := ItemFocused.DisplayRect(drBounds);
  1290. // btw, we use vsReport only, nothing else was tested
  1291. Assert(ViewStyle = vsReport);
  1292. case ViewStyle of
  1293. vsReport:
  1294. FocusedIsVisible := (TopItem.Index <= ItemFocused.Index) and
  1295. (ItemFocused.Index < TopItem.Index + VisibleRowCount);
  1296. vsList:
  1297. // do not know how to implement that
  1298. FocusedIsVisible := False;
  1299. else // vsIcon and vsSmallIcon
  1300. FocusedIsVisible :=
  1301. IntersectRect(R,
  1302. Classes.Rect(ViewOrigin, Point(ViewOrigin.X + ClientWidth, ViewOrigin.Y + ClientHeight)),
  1303. ItemFocused.DisplayRect(drBounds));
  1304. end;
  1305. end
  1306. else FocusedIsVisible := False; // shut up
  1307. SaveCursor := Screen.Cursor;
  1308. Screen.Cursor := crHourGlass;
  1309. FChangeTimer.Enabled := False;
  1310. FChangeTimer.Interval := 0;
  1311. EItems := TStringlist.Create;
  1312. FItems := TStringlist.Create;
  1313. NewItems := TStringlist.Create;
  1314. PUpdate := False;
  1315. AnyUpdate := False;
  1316. FHiddenCount := 0;
  1317. FFilteredCount := 0;
  1318. try
  1319. {Store existing files and directories:}
  1320. for Index := 0 to Items.Count - 1 do
  1321. begin
  1322. New(PEFile);
  1323. with PFileRec(Items[Index].Data)^ do
  1324. begin
  1325. PEFile^.iSize := Size;
  1326. PEFile^.iAttr := Attr;
  1327. PEFile^.iFileTime := FileTime;
  1328. PEFile^.iIndex := Index;
  1329. end;
  1330. EItems.AddObject(PFileRec(Items[Index].Data)^.FileName, Pointer(PEFile));
  1331. end;
  1332. EItems.Sort;
  1333. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1334. FileAttr, SRec);
  1335. while DosError = 0 do
  1336. begin
  1337. if (SRec.Attr and faDirectory) = 0 then
  1338. begin
  1339. if FileMatches(SRec.Name, SRec) then
  1340. begin
  1341. ItemIndex := -1;
  1342. if not EItems.Find(SRec.Name, ItemIndex) then
  1343. begin
  1344. New(PSrec);
  1345. PSRec^ := SRec;
  1346. NewItems.AddObject(SRec.Name, Pointer(PSrec));
  1347. FItems.Add(Srec.Name);
  1348. end
  1349. else
  1350. begin
  1351. FSize := SizeFromSRec(SRec);
  1352. with PEFileRec(EItems.Objects[ItemIndex])^ do
  1353. {$WARNINGS OFF}
  1354. if (iSize <> FSize) or (iAttr <> SRec.Attr) or
  1355. not CompareMem(@iFileTime, @SRec.FindData.ftLastWriteTime,
  1356. SizeOf(iFileTime)) Then
  1357. {$WARNINGS ON}
  1358. begin
  1359. with PFileRec(Items[iIndex].Data)^ do
  1360. begin
  1361. Dec(FFilesSize, Size);
  1362. Inc(FFilesSize, FSize);
  1363. if Items[iIndex].Selected then
  1364. begin
  1365. Dec(FFilesSelSize, Size);
  1366. Inc(FFilesSelSize, FSize);
  1367. end;
  1368. Size := FSize;
  1369. Attr := SRec.Attr;
  1370. {$WARNINGS OFF}
  1371. FileTime := SRec.FindData.ftLastWriteTime;
  1372. {$WARNINGS ON}
  1373. end;
  1374. // alternative to TListItem.Update (which causes flicker)
  1375. R := Items[iIndex].DisplayRect(drBounds);
  1376. InvalidateRect(Handle, @R, True);
  1377. AnyUpdate := True;
  1378. end;
  1379. FItems.Add(Srec.Name);
  1380. end;
  1381. end;
  1382. end;
  1383. DosError := FindNext(Srec);
  1384. end;
  1385. SysUtils.FindClose(Srec);
  1386. {Search new directories:}
  1387. DosError := SysUtils.FindFirst(ApiPath(FPath + '\*.*'), DirAttrMask, SRec);
  1388. while DosError = 0 do
  1389. begin
  1390. if (Srec.Attr and faDirectory) <> 0 then
  1391. begin
  1392. if (SRec.Name <> '.') and (SRec.Name <> '..') then
  1393. begin
  1394. if not EItems.Find(SRec.Name, ItemIndex) then
  1395. begin
  1396. if FileMatches(SRec.Name, SRec) then
  1397. begin
  1398. New(PSrec);
  1399. PSrec^ := SRec;
  1400. NewItems.AddObject(Srec.Name, Pointer(PSrec));
  1401. FItems.Add(SRec.Name);
  1402. end;
  1403. end
  1404. else
  1405. begin
  1406. FItems.Add(SRec.Name);
  1407. end;
  1408. end
  1409. else
  1410. begin
  1411. FItems.Add(SRec.Name);
  1412. end;
  1413. end;
  1414. DosError := FindNext(SRec);
  1415. end;
  1416. SysUtils.FindClose(SRec);
  1417. {Check wether displayed Items still exists:}
  1418. FItems.Sort;
  1419. for Index := Items.Count - 1 downto 0 do
  1420. begin
  1421. if not FItems.Find(PFileRec(Items[Index].Data)^.FileName, Dummy) then
  1422. begin
  1423. if not PUpdate then
  1424. begin
  1425. PUpdate := True;
  1426. Items.BeginUpdate;
  1427. end;
  1428. AnyUpdate := True;
  1429. with PFileRec(Items[Index].Data)^ do
  1430. begin
  1431. Dec(FFilesSize, Size);
  1432. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1433. // is called for item being deleted
  1434. end;
  1435. Items[Index].Delete;
  1436. end;
  1437. end;
  1438. finally
  1439. try
  1440. for Index := 0 to EItems.Count - 1 do
  1441. Dispose(PEFileRec(EItems.Objects[Index]));
  1442. EItems.Free;
  1443. FItems.Free;
  1444. for Index := 0 to NewItems.Count - 1 do
  1445. begin
  1446. if not PUpdate then
  1447. begin
  1448. PUpdate := True;
  1449. Items.BeginUpdate;
  1450. end;
  1451. AnyUpdate := True;
  1452. PSrec := Pointer(NewItems.Objects[Index]);
  1453. AddItem(PSrec^);
  1454. Dispose(PSrec);
  1455. end;
  1456. NewItems.Free;
  1457. // if we are sorted by name and there were only updates to existing
  1458. // items, there is no need for sorting
  1459. if PUpdate or
  1460. (AnyUpdate and (DirColProperties.SortDirColumn <> dvName)) then
  1461. begin
  1462. SortItems;
  1463. end;
  1464. if PUpdate then
  1465. Items.EndUpdate;
  1466. finally
  1467. FDirOK := True;
  1468. FDirty := false;
  1469. if FUseIconUpdateThread and (not FisRecycleBin) then
  1470. StartIconUpdateThread;
  1471. StartWatchThread;
  1472. // make focused item visible, only if it was before
  1473. if FocusedIsVisible and Assigned(ItemFocused) then
  1474. ItemFocused.MakeVisible(False);
  1475. DoUpdateStatusBar;
  1476. Screen.Cursor := SaveCursor;
  1477. end;
  1478. end; {Finally}
  1479. end;
  1480. if Assigned(FDriveView) then
  1481. begin
  1482. TDriveView(FDriveView).ValidateCurrentDirectoryIfNotMonitoring;
  1483. end;
  1484. end;
  1485. end;
  1486. end; {Reload2}
  1487. procedure TDirView.PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean);
  1488. var
  1489. TargetPath: string;
  1490. RenameOnCollision: Boolean;
  1491. begin
  1492. TargetPath := '';
  1493. RenameOnCollision := False;
  1494. if Assigned(Item) then
  1495. begin
  1496. if Assigned(Item.Data) then
  1497. begin
  1498. if ItemIsParentDirectory(Item) then
  1499. TargetPath := ExcludeTrailingPathDelimiter(ExtractFilePath(Path))
  1500. else
  1501. TargetPath := IncludeTrailingPathDelimiter(PathName) + ItemFileName(Item);
  1502. end;
  1503. end
  1504. else
  1505. begin
  1506. TargetPath := PathName;
  1507. RenameOnCollision := DDOwnerIsSource and (Effect = DROPEFFECT_COPY);
  1508. end;
  1509. if TargetPath <> '' then
  1510. PerformDragDropFileOperation(TargetPath, Effect, RenameOnCollision, Paste);
  1511. end;
  1512. procedure TDirView.ReLoad(CacheIcons: Boolean);
  1513. begin
  1514. if not FLoadEnabled then FDirty := True
  1515. else inherited;
  1516. end; {ReLoad}
  1517. procedure TDirView.ClearIconCache;
  1518. begin
  1519. if Assigned(FInfoCacheList) then
  1520. FInfoCacheList.Clear;
  1521. end; {ClearIconCache}
  1522. function TDirView.FormatFileTime(FileTime: TFileTime): string;
  1523. begin
  1524. Result := FormatDateTime(DateTimeFormatStr,
  1525. FileTimeToDateTime(FileTime));
  1526. end; {FormatFileTime}
  1527. function TDirView.GetAttrString(Attr: Integer): string;
  1528. const
  1529. Attrs: array[1..5] of Integer =
  1530. (FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_ARCHIVE,
  1531. FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_HIDDEN,
  1532. FILE_ATTRIBUTE_READONLY);
  1533. AttrChars: array[1..5] of Char = ('c', 'a', 's', 'h', 'r');
  1534. var
  1535. Index: Integer;
  1536. LowBound: Integer;
  1537. begin
  1538. Result := '';
  1539. if Attr <> 0 then
  1540. begin
  1541. LowBound := Low(Attrs);
  1542. for Index := LowBound to High(Attrs) do
  1543. if (Attr and Attrs[Index] <> 0) then
  1544. Result := Result + AttrChars[Index]
  1545. else
  1546. Result := Result;
  1547. end;
  1548. end; {GetAttrString}
  1549. function TDirView.GetFileInfo(
  1550. pszPath: LPCWSTR; dwFileAttributes: DWORD; var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD_PTR;
  1551. begin
  1552. if TimeoutShellIconRetrieval then
  1553. begin
  1554. Result := SHGetFileInfoWithTimeout(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags, MSecsPerSec div 4);
  1555. end
  1556. else
  1557. begin
  1558. Result := SHGetFileInfo(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags);
  1559. end;
  1560. end;
  1561. procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  1562. var
  1563. FileInfo: TShFileInfo;
  1564. Index: Integer;
  1565. PExtItem: PInfoCache;
  1566. CacheItem: TInfoCache;
  1567. IsSpecialExt: Boolean;
  1568. ForceByName: Boolean;
  1569. Eaten: ULONG;
  1570. shAttr: ULONG;
  1571. FileIconForName, FullName: string;
  1572. begin
  1573. Assert(Assigned(Item) and Assigned(Item.Data));
  1574. with PFileRec(Item.Data)^ do
  1575. begin
  1576. IsSpecialExt := MatchesFileExt(FileExt, SpecialExtensions);
  1577. if FUseIconCache and not IsSpecialExt and not IsDirectory then
  1578. begin
  1579. CacheItem.FileExt := FileExt;
  1580. Index := FInfoCacheList.FindSequential(Addr(CacheItem), CompareInfoCacheItems);
  1581. if Index >= 0 then
  1582. begin
  1583. TypeName := PInfoCache(FInfoCacheList[Index])^.TypeName;
  1584. ImageIndex := PInfoCache(FInfoCacheList[Index])^.ImageIndex;
  1585. Empty := False;
  1586. IconEmpty := False;
  1587. end;
  1588. end;
  1589. FetchIcon := IconEmpty and (FetchIcon or not IsSpecialExt);
  1590. if Empty or FetchIcon then
  1591. begin
  1592. if FetchIcon then
  1593. begin
  1594. {Fetch the Item FQ-PIDL:}
  1595. if not Assigned(PIDL) and IsSpecialExt then
  1596. begin
  1597. try
  1598. ShAttr := 0;
  1599. FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil,
  1600. PChar(FPath + '\' + FileName), Eaten, PIDL, ShAttr);
  1601. except
  1602. end;
  1603. end;
  1604. if IsDirectory then
  1605. begin
  1606. if FDriveType = DRIVE_FIXED then
  1607. begin
  1608. try
  1609. {Retrieve icon and typename for the directory}
  1610. if Assigned(PIDL) then
  1611. begin
  1612. SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo),
  1613. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  1614. end
  1615. else
  1616. begin
  1617. SHGetFileInfo(PChar(FPath + '\' + FileName), 0, FileInfo, SizeOf(FileInfo),
  1618. SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1619. end;
  1620. if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
  1621. begin
  1622. {Invalid icon returned: retry with access file attribute flag:}
  1623. SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY,
  1624. FileInfo, SizeOf(FileInfo),
  1625. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  1626. end;
  1627. TypeName := FileInfo.szTypeName;
  1628. if FetchIcon then
  1629. begin
  1630. ImageIndex := FileInfo.iIcon;
  1631. IconEmpty := False;
  1632. end;
  1633. {Capture exceptions generated by the shell}
  1634. except
  1635. ImageIndex := StdDirIcon;
  1636. IconEmpty := False;
  1637. end; {Except}
  1638. end
  1639. else
  1640. begin
  1641. TypeName := StdDirTypeName;
  1642. ImageIndex := StdDirIcon;
  1643. IconEmpty := False;
  1644. end;
  1645. end
  1646. else
  1647. begin
  1648. {Retrieve icon and typename for the file}
  1649. try
  1650. ForceByName := False;
  1651. FullName := FPath + '\' + FileName;
  1652. FileIconForName := FullName;
  1653. if Assigned(OnFileIconForName) then
  1654. begin
  1655. OnFileIconForName(Self, Item, FileIconForName);
  1656. ForceByName := (FileIconForName <> FullName);
  1657. end;
  1658. if (not ForceByName) and Assigned(PIDL) then
  1659. begin
  1660. // Files with PIDL are typically .exe files.
  1661. // It may take long to retrieve an icon from exe file.
  1662. // We typically do not get here, now that we have UseIconUpdateThread enabled.
  1663. if GetFileInfo(
  1664. PChar(PIDL), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1665. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL) = 0 then
  1666. begin
  1667. FileInfo.szTypeName[0] := #0;
  1668. FileInfo.iIcon := DefaultExeIcon;
  1669. end;
  1670. end
  1671. else
  1672. begin
  1673. GetFileInfo(PChar(FileIconForName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1674. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  1675. end;
  1676. TypeName := FileInfo.szTypeName;
  1677. ImageIndex := FileInfo.iIcon;
  1678. IconEmpty := False;
  1679. {Capture exceptions generated by the shell}
  1680. except
  1681. ImageIndex := UnKnownFileIcon;
  1682. IconEmpty := False;
  1683. end; {Except}
  1684. end;
  1685. if (Length(TypeName) > 0) then
  1686. begin
  1687. {Fill FileInfoCache:}
  1688. if FUseIconCache and not IsSpecialExt and not IconEmpty and not IsDirectory then
  1689. begin
  1690. GetMem(PExtItem, SizeOf(TInfoCache));
  1691. PExtItem.FileExt := FileExt;
  1692. PExtItem.TypeName := TypeName;
  1693. PExtItem.ImageIndex := ImageIndex;
  1694. FInfoCacheList.Add(PExtItem);
  1695. end;
  1696. end
  1697. else TypeName := Format(STextFileExt, [FileExt]);
  1698. end {If FetchIcon}
  1699. else
  1700. begin
  1701. try
  1702. if IsDirectory then
  1703. SHGetFileInfo(PChar(FPath), FILE_ATTRIBUTE_DIRECTORY, FileInfo, SizeOf(FileInfo),
  1704. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES)
  1705. else
  1706. SHGetFileInfo(PChar(FPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1707. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  1708. TypeName := FileInfo.szTypeName;
  1709. except
  1710. {Capture exceptions generated by the shell}
  1711. TypeName := '';
  1712. end;
  1713. if IconEmpty then
  1714. begin
  1715. if FileExt = ExeExtension then ImageIndex := DefaultExeIcon
  1716. else ImageIndex := UnKnownFileIcon;
  1717. end;
  1718. end;
  1719. Empty := False;
  1720. end;
  1721. end;
  1722. end; {GetDisplayData}
  1723. function TDirView.GetDirOK: Boolean;
  1724. begin
  1725. Result := FDirOK;
  1726. end;
  1727. function TDirView.ItemFullFileName(Item: TListItem): string;
  1728. begin
  1729. if Assigned(Item) and Assigned(Item.Data) then
  1730. begin
  1731. if not IsRecycleBin then
  1732. begin
  1733. if PFileRec(Item.Data)^.IsParentDir then
  1734. begin
  1735. Result := ExcludeTrailingBackslash(ExtractFilePath(FPath));
  1736. end
  1737. else
  1738. begin
  1739. Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
  1740. end;
  1741. end
  1742. else
  1743. Result := PFileRec(Item.Data)^.FileName;
  1744. end
  1745. else
  1746. Result := EmptyStr;
  1747. end; {ItemFullFileName}
  1748. function TDirView.ItemFileNameOnly(Item: TListItem): string;
  1749. begin
  1750. Assert(Assigned(Item) and Assigned(Item.Data));
  1751. Result := PFileRec(Item.Data)^.FileName;
  1752. SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
  1753. end; {ItemFileNameOnly}
  1754. function TDirView.ItemFileExt(Item: TListItem): string;
  1755. begin
  1756. Assert(Assigned(Item) and Assigned(Item.Data));
  1757. Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
  1758. end; {ItemFileExt}
  1759. function CompareFileType(I1, I2: TListItem; P1, P2: PFileRec): Integer;
  1760. var
  1761. Key1, Key2: string;
  1762. begin
  1763. if P1.Empty then TDirView(I1.ListView).GetDisplayData(I1, False);
  1764. if P2.Empty then TDirView(I2.ListView).GetDisplayData(I2, False);
  1765. if P1.IsDirectory then
  1766. begin
  1767. Key1 := P1.TypeName + ' ' + P1.DisplayName;
  1768. Key2 := P2.TypeName + ' ' + P2.DisplayName;
  1769. end
  1770. else
  1771. begin
  1772. Key1 := P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName;
  1773. Key2 := P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName;
  1774. end;
  1775. Result := CompareLogicalTextPas(Key1, Key2, TDirView(I1.ListView).NaturalOrderNumericalSorting);
  1776. end;
  1777. function CompareFileTime(P1, P2: PFileRec): Integer;
  1778. var
  1779. Time1, Time2: Int64;
  1780. begin
  1781. Time1 := Int64(P1.FileTime.dwHighDateTime) shl 32 + P1.FileTime.dwLowDateTime;
  1782. Time2 := Int64(P2.FileTime.dwHighDateTime) shl 32 + P2.FileTime.dwLowDateTime;
  1783. if Time1 < Time2 then Result := fLess
  1784. else
  1785. if Time1 > Time2 then Result := fGreater
  1786. else Result := fEqual; // fallback
  1787. end;
  1788. function CompareFile(I1, I2: TListItem; AOwner: TDirView): Integer; stdcall;
  1789. var
  1790. ConsiderDirection: Boolean;
  1791. P1, P2: PFileRec;
  1792. begin
  1793. ConsiderDirection := True;
  1794. if I1 = I2 then Result := fEqual
  1795. else
  1796. if I1 = nil then Result := fLess
  1797. else
  1798. if I2 = nil then Result := fGreater
  1799. else
  1800. begin
  1801. P1 := PFileRec(I1.Data);
  1802. P2 := PFileRec(I2.Data);
  1803. if P1.isParentDir then
  1804. begin
  1805. Result := fLess;
  1806. ConsiderDirection := False;
  1807. end
  1808. else
  1809. if P2.isParentDir then
  1810. begin
  1811. Result := fGreater;
  1812. ConsiderDirection := False;
  1813. end
  1814. else
  1815. {Directories should always appear "grouped":}
  1816. if P1.isDirectory <> P2.isDirectory then
  1817. begin
  1818. if P1.isDirectory then
  1819. begin
  1820. Result := fLess;
  1821. ConsiderDirection := False;
  1822. end
  1823. else
  1824. begin
  1825. Result := fGreater;
  1826. ConsiderDirection := False;
  1827. end;
  1828. end
  1829. else
  1830. begin
  1831. Result := fEqual;
  1832. case AOwner.DirColProperties.SortDirColumn of
  1833. dvName:
  1834. ; // fallback
  1835. dvSize:
  1836. if P1.Size < P2.Size then Result := fLess
  1837. else
  1838. if P1.Size > P2.Size then Result := fGreater
  1839. else ; // fallback
  1840. dvType:
  1841. Result := CompareFileType(I1, I2, P1, P2);
  1842. dvChanged:
  1843. Result := CompareFileTime(P1, P2);
  1844. dvAttr:
  1845. if P1.Attr < P2.Attr then Result := fLess
  1846. else
  1847. if P1.Attr > P2.Attr then Result := fGreater
  1848. else ; // fallback
  1849. dvExt:
  1850. if not P1.isDirectory then
  1851. begin
  1852. Result := CompareLogicalTextPas(
  1853. P1.FileExt + ' ' + P1.DisplayName, P2.FileExt + ' ' + P2.DisplayName,
  1854. AOwner.NaturalOrderNumericalSorting);
  1855. end
  1856. else ; //fallback
  1857. else
  1858. ; // fallback
  1859. end;
  1860. if Result = fEqual then
  1861. begin
  1862. Result := CompareLogicalTextPas(P1.DisplayName, P2.DisplayName, AOwner.NaturalOrderNumericalSorting)
  1863. end;
  1864. end;
  1865. end;
  1866. if ConsiderDirection and (not AOwner.SortAscending) then
  1867. begin
  1868. Result := -Result;
  1869. end;
  1870. end;
  1871. procedure TDirView.SortItems;
  1872. begin
  1873. if HandleAllocated then
  1874. begin
  1875. StopIconUpdateThread;
  1876. try
  1877. CustomSortItems(@CompareFile);
  1878. finally
  1879. if (not Loading) and FUseIconUpdateThread then
  1880. StartIconUpdateThread;
  1881. end;
  1882. end
  1883. end;
  1884. procedure TDirView.ValidateFile(Item : TListItem);
  1885. var
  1886. Index: Integer;
  1887. begin
  1888. if Assigned(Item) and Assigned(Item.Data) then
  1889. begin
  1890. Index := Item.Index;
  1891. if not FileExists(ApiPath(ItemFullFileName(Items[Index]))) then
  1892. begin
  1893. Item.Delete;
  1894. end;
  1895. end;
  1896. end; {ValidateFile}
  1897. procedure TDirView.ValidateFile(FileName: TFileName);
  1898. var
  1899. FilePath: string;
  1900. begin
  1901. FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  1902. if IsRecycleBin then ValidateFile(FindFileItem(FileName))
  1903. else
  1904. if FilePath = Path then
  1905. ValidateFile(FindFileItem(ExtractFileName(FileName)));
  1906. end; {ValidateFile}
  1907. procedure TDirView.ValidateSelectedFiles;
  1908. var
  1909. FileList: TStrings;
  1910. i: Integer;
  1911. ToDelete: Boolean;
  1912. Updating: Boolean;
  1913. Updated: Boolean;
  1914. Item: TListItem;
  1915. begin
  1916. if SelCount > 50 then Reload2
  1917. else
  1918. begin
  1919. Updating := False;
  1920. Updated := False;
  1921. FileList := CustomCreateFileList(True, False, True, nil, True);
  1922. try
  1923. for i := 0 to FileList.Count - 1 do
  1924. begin
  1925. Item := TListItem(FileList.Objects[i]);
  1926. if ItemIsDirectory(Item) then
  1927. ToDelete := not DirectoryExists(ApiPath(FileList[i]))
  1928. else
  1929. ToDelete := not FileExists(ApiPath(FileList[i]));
  1930. if ToDelete then
  1931. begin
  1932. if (SelCount > 10) and (not Updating) then
  1933. begin
  1934. Items.BeginUpdate;
  1935. Updating := True;
  1936. end;
  1937. with PFileRec(Item.Data)^ do
  1938. begin
  1939. Dec(FFilesSize, Size);
  1940. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1941. // is called for item being deleted
  1942. end;
  1943. Item.Delete;
  1944. Updated := True;
  1945. end;
  1946. end;
  1947. finally
  1948. if Updating then
  1949. Items.EndUpdate;
  1950. if Updated then
  1951. DoUpdateStatusBar;
  1952. FileList.Free;
  1953. end;
  1954. end;
  1955. end; {ValidateSelectedFiles}
  1956. function TDirView.CreateFile(NewName: string): TListItem;
  1957. var
  1958. F: file;
  1959. SRec: SysUtils.TSearchRec;
  1960. begin
  1961. Result := nil;
  1962. {Neue Datei anlegen:}
  1963. NewName := Path + '\' + NewName;
  1964. {Ermitteln des neuen Dateinamens:}
  1965. if not FileExists(ApiPath(NewName)) then
  1966. begin
  1967. if FWatchForChanges then
  1968. StopWatchThread;
  1969. StopIconUpdateThread;
  1970. try
  1971. {Create the desired file as empty file:}
  1972. AssignFile(F, ApiPath(NewName));
  1973. Rewrite(F);
  1974. LastIOResult := IOResult;
  1975. if LastIOResult = 0 then
  1976. begin
  1977. CloseFile(F);
  1978. {Anlegen der Datei als TListItem:}
  1979. if FindFirst(ApiPath(NewName), faAnyFile, SRec) = 0 then
  1980. begin
  1981. Result := AddItem(SRec);
  1982. ItemFocused := FindFileItem(GetFileRec(Result.Index)^.FileName);
  1983. if Assigned(ItemFocused) then
  1984. ItemFocused.MakeVisible(False);
  1985. end;
  1986. FindClose(Srec);
  1987. end;
  1988. finally
  1989. if FUseIconUpdateThread then
  1990. StartIconUpdateThread;
  1991. if WatchForChanges then
  1992. StartWatchThread;
  1993. end;
  1994. end
  1995. else LastIOResult := 183;
  1996. end; {CreateFile}
  1997. procedure TDirView.CreateDirectory(DirName: string);
  1998. var
  1999. SRec: SysUtils.TSearchRec;
  2000. Item: TListItem;
  2001. begin
  2002. // keep absolute path as is
  2003. if ExtractFileDrive(DirName) = '' then
  2004. DirName := Path + '\' + DirName;
  2005. if WatchForChanges then StopWatchThread;
  2006. if Assigned(FDriveView) then
  2007. TDriveView(FDriveView).StopWatchThread;
  2008. StopIconUpdateThread;
  2009. try
  2010. {create the physical directory:}
  2011. Win32Check(Windows.CreateDirectory(PChar(ApiPath(DirName)), nil));
  2012. if IncludeTrailingBackslash(ExtractFilePath(ExpandFileName(DirName))) =
  2013. IncludeTrailingBackslash(Path) then
  2014. begin
  2015. {Create the TListItem:}
  2016. if FindFirst(ApiPath(DirName), faAnyFile, SRec) = 0 then
  2017. begin
  2018. Item := AddItem(SRec);
  2019. ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
  2020. SortItems;
  2021. if Assigned(ItemFocused) then
  2022. begin
  2023. ItemFocused.MakeVisible(False);
  2024. end;
  2025. end;
  2026. FindClose(SRec);
  2027. end;
  2028. finally
  2029. if FUseIconUpdateThread then
  2030. StartIconUpdateThread;
  2031. if WatchForChanges then StartWatchThread;
  2032. if Assigned(DriveView) then
  2033. with DriveView do
  2034. begin
  2035. if Assigned(Selected) then
  2036. ValidateDirectory(Selected);
  2037. TDriveView(FDriveView).StartWatchThread;
  2038. end;
  2039. end;
  2040. end; {CreateDirectory}
  2041. procedure TDirView.DisplayContextMenu(Where: TPoint);
  2042. var
  2043. FileList: TStringList;
  2044. Index: Integer;
  2045. Item: TListItem;
  2046. DefDir: string;
  2047. Verb: string;
  2048. PIDLArray: PPIDLArray;
  2049. Count: Integer;
  2050. DiffSelectedPath: Boolean;
  2051. WithEdit: Boolean;
  2052. PIDLRel: PItemIDList;
  2053. PIDLPath: PItemIDList;
  2054. Handled: Boolean;
  2055. begin
  2056. GetDir(0, DefDir);
  2057. ChDir(PathName);
  2058. Verb := EmptyStr;
  2059. StopWatchThread;
  2060. try
  2061. try
  2062. if Assigned(OnContextPopup) then
  2063. begin
  2064. Handled := False;
  2065. OnContextPopup(Self, ScreenToClient(Where), Handled);
  2066. if Handled then Abort;
  2067. end;
  2068. if (MarkedCount > 1) and
  2069. ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
  2070. begin
  2071. if FIsRecycleBin then
  2072. begin
  2073. Count := 0;
  2074. GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
  2075. try
  2076. FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
  2077. for Index := Selected.Index to Items.Count - 1 do
  2078. if Items[Index].Selected then
  2079. begin
  2080. PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
  2081. FreePIDL(PIDLPath);
  2082. PIDLArray^[Count] := PIDLRel;
  2083. Inc(Count);
  2084. end;
  2085. try
  2086. ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
  2087. PidlArray^[0], False, Verb, False);
  2088. finally
  2089. for Index := 0 to Count - 1 do
  2090. FreePIDL(PIDLArray[Index]);
  2091. end;
  2092. finally
  2093. FreeMem(PIDLArray, Count);
  2094. end;
  2095. end
  2096. else
  2097. begin
  2098. FileList := TStringList.Create;
  2099. CreateFileList(False, True, FileList);
  2100. for Index := 0 to FileList.Count - 1 do
  2101. FileList[Index] := ExtractFileName(FileList[Index]);
  2102. ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
  2103. FileList, Verb, False);
  2104. FileList.Destroy;
  2105. end;
  2106. {------------ Cut -----------}
  2107. if Verb = shcCut then
  2108. begin
  2109. LastClipBoardOperation := cboCut;
  2110. {Clear items previous marked as cut:}
  2111. Item := GetNextItem(nil, sdAll, [isCut]);
  2112. while Assigned(Item) do
  2113. begin
  2114. Item.Cut := False;
  2115. Item := GetNextItem(Item, sdAll, [isCut]);
  2116. end;
  2117. {Set property cut to TRUE for all selected items:}
  2118. Item := GetNextItem(nil, sdAll, [isSelected]);
  2119. while Assigned(Item) do
  2120. begin
  2121. Item.Cut := True;
  2122. Item := GetNextItem(Item, sdAll, [isSelected]);
  2123. end;
  2124. end
  2125. else
  2126. {----------- Copy -----------}
  2127. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2128. else
  2129. {----------- Paste ----------}
  2130. if Verb = shcPaste then
  2131. PasteFromClipBoard(ItemFullFileName(Selected))
  2132. else
  2133. if not FIsRecycleBin then Reload2;
  2134. end
  2135. else
  2136. if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
  2137. begin
  2138. Verb := EmptyStr;
  2139. WithEdit := not FisRecycleBin and CanEdit(ItemFocused);
  2140. LoadEnabled := True;
  2141. if FIsRecycleBin then
  2142. begin
  2143. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2144. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2145. iRecycleFolder, 1, PIDLRel, False, Verb, False);
  2146. FreePIDL(PIDLRel);
  2147. FreePIDL(PIDLPath);
  2148. end
  2149. else
  2150. begin
  2151. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2152. ItemFullFileName(ItemFocused), WithEdit, Verb,
  2153. not PFileRec(ItemFocused.Data)^.isDirectory);
  2154. LoadEnabled := True;
  2155. end; {not FisRecycleBin}
  2156. {---------- Rename ----------}
  2157. if Verb = shcRename then ItemFocused.EditCaption
  2158. else
  2159. {------------ Cut -----------}
  2160. if Verb = shcCut then
  2161. begin
  2162. LastClipBoardOperation := cboCut;
  2163. Item := GetNextItem(nil, sdAll, [isCut]);
  2164. while Assigned(Item) do
  2165. begin
  2166. Item.Cut := False;
  2167. Item := GetNextItem(ITem, sdAll, [isCut]);
  2168. end;
  2169. ItemFocused.Cut := True;
  2170. end
  2171. else
  2172. {----------- Copy -----------}
  2173. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2174. else
  2175. {----------- Paste ----------}
  2176. if Verb = shcPaste then
  2177. begin
  2178. if PFileRec(ItemFocused.Data)^.IsDirectory then
  2179. PasteFromClipBoard(ItemFullFileName(ItemFocused));
  2180. end
  2181. else
  2182. if not FIsRecycleBin then Reload2;
  2183. end;
  2184. finally
  2185. ChDir(DefDir);
  2186. end;
  2187. if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
  2188. begin
  2189. DiffSelectedPath := False;
  2190. for Index := Selected.Index to Items.Count - 1 do
  2191. if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
  2192. begin
  2193. DiffSelectedPath := True;
  2194. Break;
  2195. end;
  2196. if DiffSelectedPath then
  2197. begin
  2198. StartFileDeleteThread;
  2199. Exit;
  2200. end;
  2201. end;
  2202. Sleep(250);
  2203. ValidateSelectedFiles;
  2204. finally
  2205. StartWatchThread;
  2206. end;
  2207. end;
  2208. procedure TDirView.GetDisplayInfo(ListItem: TListItem;
  2209. var DispInfo: TLVItem);
  2210. begin
  2211. Assert(Assigned(ListItem) and Assigned(ListItem.Data));
  2212. with PFileRec(ListItem.Data)^, DispInfo do
  2213. begin
  2214. {Fetch display data of current file:}
  2215. if Empty then
  2216. GetDisplayData(ListItem, IconEmpty and
  2217. (not FUseIconUpdateThread or
  2218. (ViewStyle <> vsReport)));
  2219. if IconEmpty and
  2220. (not FUseIconUpdateThread or
  2221. (ViewStyle <> vsReport)) and
  2222. ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2223. GetDisplayData(ListItem, True);
  2224. {Set IconUpdatethread :}
  2225. if IconEmpty and Assigned(FIconUpdateThread) then
  2226. begin
  2227. if Assigned(TopItem) then
  2228. {Viewstyle is vsReport or vsList:}
  2229. FIconUpdateThread.Index := Self.TopItem.Index
  2230. else
  2231. {Viewstyle is vsIcon or vsSmallIcon:}
  2232. FIconUpdateThread.MaxIndex := ListItem.Index;
  2233. if FIconUpdateThread.Suspended and not FIsRecycleBin then
  2234. FIconUpdateThread.Resume;
  2235. end;
  2236. if (DispInfo.Mask and LVIF_TEXT) <> 0 then
  2237. begin
  2238. if iSubItem = 0 then StrPLCopy(pszText, DisplayName, cchTextMax)
  2239. else
  2240. if iSubItem < DirViewColumns then
  2241. begin
  2242. case TDirViewCol(iSubItem) of
  2243. dvSize: {Size: }
  2244. if not IsDirectory then
  2245. StrPLCopy(pszText, FormatPanelBytes(Size, FormatSizeBytes), cchTextMax);
  2246. dvType: {FileType: }
  2247. StrPLCopy(pszText, TypeName, cchTextMax);
  2248. dvChanged: {Date}
  2249. StrPLCopy(pszText, FormatFileTime(FileTime), cchTextMax);
  2250. dvAttr: {Attrs:}
  2251. StrPLCopy(pszText, GetAttrString(Attr), cchTextMax);
  2252. dvExt:
  2253. StrPLCopy(pszText, FileExt, cchTextMax);
  2254. end {Case}
  2255. end {SubItem}
  2256. else pszText[0] := #0;
  2257. end;
  2258. {Set display icon of current file:}
  2259. if (iSubItem = 0) and ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2260. begin
  2261. iImage := PFileRec(ListItem.Data).ImageIndex;
  2262. Mask := Mask or LVIF_DI_SETITEM;
  2263. end;
  2264. end; {With PFileRec Do}
  2265. {Mask := Mask Or LVIF_DI_SETITEM; {<== causes flickering display and icons not to be updated on renaming the item}
  2266. end;
  2267. function TDirView.ItemColor(Item: TListItem): TColor;
  2268. begin
  2269. if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
  2270. begin
  2271. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  2272. else Result := clBlue;
  2273. end
  2274. else
  2275. if DimmHiddenFiles and not Item.Selected and
  2276. (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
  2277. Result := clGrayText
  2278. else
  2279. Result := clDefaultItemColor;
  2280. end;
  2281. procedure TDirView.StartFileDeleteThread;
  2282. var
  2283. Files: TStringList;
  2284. begin
  2285. Files := TStringList.Create;
  2286. try
  2287. CreateFileList(False, True, Files);
  2288. TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
  2289. finally
  2290. Files.Free;
  2291. end;
  2292. end;
  2293. procedure TDirView.StartIconUpdateThread;
  2294. begin
  2295. if DirOK then
  2296. begin
  2297. if not Assigned(FIconUpdateThread) then
  2298. begin
  2299. if Items.Count > 0 then
  2300. FIconUpdateThread := TIconUpdateThread.Create(Self);
  2301. end
  2302. else
  2303. begin
  2304. Assert(not FIconUpdateThread.Terminated);
  2305. FIconUpdateThread.Index := 0;
  2306. if ViewStyle = vsReport then
  2307. FIconUpdateThread.Resume;
  2308. end;
  2309. end;
  2310. end; {StartIconUpdateThread}
  2311. procedure TDirView.StopIconUpdateThread;
  2312. begin
  2313. if Assigned(FIconUpdateThread) then
  2314. begin
  2315. FIconUpdateThread.Terminate;
  2316. FIconUpdateThread.Priority := tpHigher;
  2317. if FIconUpdateThread.Suspended then
  2318. FIconUpdateThread.Resume;
  2319. if not FIconUpdateThread.WaitFor(MSecsPerSec div 4) then
  2320. begin
  2321. // This prevents Destroy from waiting for (stalled) thread
  2322. FIconUpdateThread.Suspend;
  2323. end;
  2324. FIconUpdateThread.Destroy;
  2325. FIconUpdateThread := nil;
  2326. end;
  2327. end; {StopIconUpdateThread}
  2328. procedure TDirView.StopWatchThread;
  2329. begin
  2330. if Assigned(FDiscMonitor) then
  2331. begin
  2332. FDiscMonitor.Enabled := False;
  2333. end;
  2334. end; {StopWatchThread}
  2335. procedure TDirView.StartWatchThread;
  2336. begin
  2337. if (Length(Path) > 0) and WatchForChanges and DirOK then
  2338. begin
  2339. if not Assigned(FDiscMonitor) then
  2340. begin
  2341. FDiscMonitor := TDiscMonitor.Create(Self);
  2342. with FDiscMonitor do
  2343. begin
  2344. ChangeDelay := msThreadChangeDelay;
  2345. SubTree := False;
  2346. Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
  2347. SetDirectory(PathName);
  2348. OnChange := ChangeDetected;
  2349. OnInvalid := ChangeInvalid;
  2350. Open;
  2351. end;
  2352. end
  2353. else
  2354. begin
  2355. FDiscMonitor.SetDirectory(PathName);
  2356. FDiscMonitor.Enabled := True;
  2357. end;
  2358. end;
  2359. end; {StartWatchThread}
  2360. procedure TDirView.TimerOnTimer(Sender: TObject);
  2361. begin
  2362. if not Loading then
  2363. begin
  2364. // fix by MP: disable timer and reload directory before call to event
  2365. FChangeTimer.Enabled := False;
  2366. FChangeTimer.Interval := 0;
  2367. Reload2;
  2368. end;
  2369. end; {TimerOnTimer}
  2370. procedure TDirView.ChangeDetected(Sender: TObject; const Directory: string;
  2371. var SubdirsChanged: Boolean);
  2372. begin
  2373. // avoid prolonging the actual update with each change, as if continous change
  2374. // is occuring in current directory, the panel will never be updated
  2375. if not FChangeTimer.Enabled then
  2376. begin
  2377. FDirty := True;
  2378. FChangeTimer.Interval := FChangeInterval;
  2379. FChangeTimer.Enabled := True;
  2380. end;
  2381. end; {ChangeDetected}
  2382. procedure TDirView.ChangeInvalid(Sender: TObject; const Directory: string;
  2383. const ErrorStr: string);
  2384. begin
  2385. FDiscMonitor.Close;
  2386. end; {ChangeInvalid}
  2387. function TDirView.WatchThreadActive: Boolean;
  2388. begin
  2389. Result := WatchForChanges and Assigned(FDiscMonitor) and
  2390. FDiscMonitor.Active and FDiscMonitor.Enabled;
  2391. end; {WatchThreadActive}
  2392. procedure TDirView.SetChangeInterval(Value: Cardinal);
  2393. begin
  2394. if Value > 0 then
  2395. begin
  2396. FChangeInterval := Value;
  2397. FChangeTimer.Interval := Value;
  2398. end;
  2399. end; {SetChangeInterval}
  2400. procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
  2401. begin
  2402. if Value <> ColProperties then
  2403. ColProperties := Value;
  2404. end;
  2405. function TDirView.GetDirColProperties: TDirViewColProperties;
  2406. begin
  2407. Result := TDirViewColProperties(ColProperties);
  2408. end;
  2409. procedure TDirView.SetWatchForChanges(Value: Boolean);
  2410. begin
  2411. if WatchForChanges <> Value then
  2412. begin
  2413. FWatchForChanges := Value;
  2414. if not (csDesigning in ComponentState) then
  2415. begin
  2416. if Value then StartWatchThread
  2417. else StopWatchThread;
  2418. end;
  2419. end;
  2420. end; {SetWatchForChanges}
  2421. procedure TDirView.DisplayPropertiesMenu;
  2422. var
  2423. FileList: TStringList;
  2424. Index: Integer;
  2425. PIDLRel: PItemIDList;
  2426. PIDLPath: PItemIDList;
  2427. begin
  2428. if not Assigned(ItemFocused) then
  2429. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
  2430. else
  2431. if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
  2432. begin
  2433. FileList := TStringList.Create;
  2434. try
  2435. CreateFileList(False, True, FileList);
  2436. for Index := 0 to Pred(FileList.Count) do
  2437. FileList[Index] := ExtractFileName(FileList[Index]);
  2438. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2439. PathName, FileList);
  2440. finally
  2441. FileList.Free;
  2442. end;
  2443. end
  2444. else
  2445. if Assigned(ItemFocused.Data) then
  2446. begin
  2447. if IsRecycleBin then
  2448. begin
  2449. if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
  2450. begin
  2451. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2452. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
  2453. FreePIDL(PIDLRel);
  2454. FreePIDL(PIDLPath);
  2455. end;
  2456. end
  2457. else
  2458. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2459. ItemFullFileName(ItemFocused));
  2460. end;
  2461. end;
  2462. procedure TDirView.ExecuteFile(Item: TListItem);
  2463. var
  2464. DefDir: string;
  2465. FileName: string;
  2466. begin
  2467. if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
  2468. PFileRec(Item.Data)^.IsDirectory then
  2469. begin
  2470. if PFileRec(Item.Data)^.IsDirectory then
  2471. begin
  2472. FileName := ItemFullFileName(Item);
  2473. if not DirectoryExists(FileName) then
  2474. begin
  2475. Reload2;
  2476. if Assigned(FDriveView) and Assigned(FDriveView.Selected) then
  2477. with FDriveView do
  2478. ValidateDirectory(Selected);
  2479. Exit;
  2480. end;
  2481. end
  2482. else
  2483. FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
  2484. if DirectoryExists(FileName) then
  2485. begin
  2486. Path := FileName;
  2487. Exit;
  2488. end
  2489. else
  2490. if not FileExists(ApiPath(FileName)) then
  2491. begin
  2492. Exit;
  2493. end;
  2494. end;
  2495. GetDir(0, DefDir);
  2496. ChDir(PathName);
  2497. try
  2498. ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
  2499. ItemFullFileName(Item));
  2500. finally
  2501. ChDir(DefDir);
  2502. end;
  2503. end;
  2504. procedure TDirView.ExecuteDrive(Drive: string);
  2505. var
  2506. APath: string;
  2507. begin
  2508. if Assigned(FLastPath) and FLastPath.ContainsKey(Drive) then
  2509. begin
  2510. APath := FLastPath[Drive];
  2511. if not DirectoryExists(ApiPath(APath)) then
  2512. begin
  2513. if DriveInfo.IsRealDrive(Drive) then
  2514. APath := Format('%s:', [Drive])
  2515. else
  2516. APath := Drive;
  2517. end;
  2518. end
  2519. else
  2520. begin
  2521. if DriveInfo.IsRealDrive(Drive) then
  2522. begin
  2523. GetDir(Integer(Drive[1]) - Integer('A') + 1, APath);
  2524. APath := ExcludeTrailingPathDelimiter(APath);
  2525. end
  2526. else
  2527. begin
  2528. APath := Drive;
  2529. end;
  2530. end;
  2531. if Path <> APath then
  2532. Path := APath;
  2533. end;
  2534. procedure TDirView.ExecuteHomeDirectory;
  2535. begin
  2536. Path := HomeDirectory;
  2537. end;
  2538. procedure TDirView.ExecuteParentDirectory;
  2539. begin
  2540. if Valid then
  2541. begin
  2542. if Assigned(DriveView) and Assigned(DriveView.Selected) then
  2543. begin
  2544. DriveView.Selected := DriveView.Selected.Parent
  2545. end
  2546. else
  2547. begin
  2548. Path := ExtractFilePath(Path);
  2549. end;
  2550. end;
  2551. end;
  2552. procedure TDirView.ExecuteRootDirectory;
  2553. begin
  2554. if Valid then
  2555. try
  2556. PathChanging(False);
  2557. FPath := ExtractFileDrive(Path);
  2558. Load(True);
  2559. finally
  2560. PathChanged;
  2561. end;
  2562. end;
  2563. procedure TDirView.Delete(Item: TListItem);
  2564. begin
  2565. if Assigned(Item) and Assigned(Item.Data) and not (csRecreating in ControlState) then
  2566. with PFileRec(Item.Data)^ do
  2567. begin
  2568. SetLength(FileName, 0);
  2569. SetLength(TypeName, 0);
  2570. SetLength(DisplayName, 0);
  2571. if Assigned(PIDL) then FreePIDL(PIDL);
  2572. Dispose(PFileRec(Item.Data));
  2573. Item.Data := nil;
  2574. end;
  2575. inherited Delete(Item);
  2576. end; {Delete}
  2577. procedure TDirView.InternalEdit(const HItem: TLVItem);
  2578. var
  2579. Item: TListItem;
  2580. Info: string;
  2581. NewCaption: string;
  2582. IsDirectory: Boolean;
  2583. begin
  2584. Item := GetItemFromHItem(HItem);
  2585. IsDirectory := DirectoryExists(ItemFullFileName(Item));
  2586. NewCaption := HItem.pszText;
  2587. StopWatchThread;
  2588. if IsDirectory and Assigned(FDriveView) then
  2589. TDriveView(FDriveView).StopWatchThread;
  2590. with FFileOperator do
  2591. begin
  2592. Flags := [foAllowUndo, foNoConfirmation];
  2593. Operation := foRename;
  2594. OperandFrom.Clear;
  2595. OperandTo.Clear;
  2596. OperandFrom.Add(ItemFullFileName(Item));
  2597. OperandTo.Add(FPath + '\' + HItem.pszText);
  2598. end;
  2599. try
  2600. if FFileOperator.Execute then
  2601. begin
  2602. if IsDirectory and Assigned(FDriveView) then
  2603. with FDriveView do
  2604. if Assigned(Selected) then
  2605. ValidateDirectory(Selected);
  2606. with GetFileRec(Item.Index)^ do
  2607. begin
  2608. Empty := True;
  2609. IconEmpty := True;
  2610. FileName := NewCaption;
  2611. DisplayName := FileName;
  2612. FileExt := UpperCase(ExtractFileExt(HItem.pszText));
  2613. FileExt := Copy(FileExt, 2, Length(FileExt) - 1);
  2614. TypeName := EmptyStr;
  2615. if Assigned(PIDL) then
  2616. FreePIDL(PIDL);
  2617. end;
  2618. GetDisplayData(Item, True);
  2619. ResetItemImage(Item.Index);
  2620. UpdateItems(Item.Index, Item.Index);
  2621. if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
  2622. if Item <> nil then Item.Caption := NewCaption;
  2623. SortItems;
  2624. if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
  2625. end
  2626. else
  2627. begin
  2628. Item.Caption := GetFileRec(Item.Index)^.FileName;
  2629. Item.Update;
  2630. if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
  2631. Info := SErrorRenameFileExists + HItem.pszText
  2632. else
  2633. Info := SErrorRenameFile + HItem.pszText;
  2634. MessageBeep(MB_ICONHAND);
  2635. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  2636. RetryRename(HItem.pszText);
  2637. end;
  2638. finally
  2639. Sleep(0);
  2640. LoadEnabled := True;
  2641. if FWatchForChanges and (not WatchThreadActive) then
  2642. StartWatchThread;
  2643. if Assigned(FDriveView) then
  2644. TDriveView(FDriveView).StartWatchThread;
  2645. end;
  2646. end;
  2647. function TDirView.ItemFileName(Item: TListItem): string;
  2648. begin
  2649. if Assigned(Item) and Assigned(Item.Data) then
  2650. Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
  2651. else
  2652. Result := '';
  2653. end;
  2654. function TDirView.ItemFileSize(Item: TListItem): Int64;
  2655. begin
  2656. Result := 0;
  2657. if Assigned(Item) and Assigned(Item.Data) then
  2658. with PFileRec(Item.Data)^ do
  2659. if Size >= 0 then Result := Size;
  2660. end;
  2661. function TDirView.ItemFileTime(Item: TListItem;
  2662. var Precision: TDateTimePrecision): TDateTime;
  2663. begin
  2664. Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
  2665. Precision := tpMillisecond;
  2666. end;
  2667. function TDirView.ItemImageIndex(Item: TListItem;
  2668. Cache: Boolean): Integer;
  2669. begin
  2670. if Assigned(Item) and Assigned(Item.Data) then
  2671. begin
  2672. if PFileRec(Item.Data)^.IconEmpty then
  2673. begin
  2674. if Cache then Result := -1
  2675. else Result := UnknownFileIcon;
  2676. end
  2677. else
  2678. begin
  2679. if (not Cache) or MatchesFileExt(PFileRec(Item.Data)^.FileExt, SpecialExtensions) then
  2680. Result := PFileRec(Item.Data)^.ImageIndex
  2681. else
  2682. Result := -1
  2683. end;
  2684. end
  2685. else Result := -1;
  2686. end;
  2687. procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2688. begin
  2689. inherited Notification(AComponent, Operation);
  2690. if (Operation = opRemove) and (AComponent = FDriveView) then
  2691. FDriveView := nil;
  2692. end; {Notification}
  2693. procedure TDirView.ReloadDirectory;
  2694. begin
  2695. Reload(True);
  2696. end;
  2697. procedure TDirView.ResetItemImage(Index: Integer);
  2698. var
  2699. LVI: TLVItem;
  2700. begin
  2701. with PFileRec(Items[Index].Data)^, LVI do
  2702. begin
  2703. {Update imageindex:}
  2704. Mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
  2705. iItem := Index;
  2706. iSubItem := 0;
  2707. if ListView_GetItem(Handle, LVI) then
  2708. begin
  2709. iImage := I_IMAGECALLBACK;
  2710. Mask := Mask and (not LVIF_DI_SETITEM);
  2711. ListView_SetItem(Handle, LVI);
  2712. end;
  2713. end; {With}
  2714. end; {ResetItemImage}
  2715. { Drag&Drop handling }
  2716. procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
  2717. {Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:}
  2718. var
  2719. Index: Integer;
  2720. begin
  2721. if Files.Count > 0 then
  2722. for Index := 0 to Files.Count - 1 do
  2723. ValidateFile(Files[Index]);
  2724. end;
  2725. procedure TDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  2726. AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2727. begin
  2728. if Assigned(FDriveView) then
  2729. begin
  2730. // When a change is detected while menu is popped up
  2731. // it loses focus (or something similar)
  2732. // preventing it from handling subsequent click.
  2733. // This typically happens when right-dragging from remote to local panel,
  2734. // what causes temp directory being created+deleted.
  2735. // This is HACK, we should implement some uniform watch disabling/enabling
  2736. TDriveView(FDriveView).SuspendChangeTimer;
  2737. end;
  2738. inherited;
  2739. end;
  2740. procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2741. begin
  2742. if not WatchThreadActive then
  2743. begin
  2744. FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
  2745. FChangeTimer.Enabled := True;
  2746. end;
  2747. if Assigned(FDriveView) then
  2748. begin
  2749. TDriveView(FDriveView).ResumeChangeTimer;
  2750. end;
  2751. inherited;
  2752. end;
  2753. procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  2754. Point: TPoint; dwEffect: Longint);
  2755. begin
  2756. // Not sure why is this here. There's no "disable" counterparty.
  2757. if not WatchThreadActive then
  2758. begin
  2759. FChangeTimer.Interval := FChangeInterval;
  2760. FChangeTimer.Enabled := True;
  2761. end;
  2762. inherited;
  2763. end;
  2764. procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2765. begin
  2766. Assert(Assigned(Item));
  2767. if IsRecycleBin then
  2768. begin
  2769. if Assigned(Item.Data) then
  2770. begin
  2771. if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
  2772. ('.' + PFileRec(Item.Data)^.FileExt) then
  2773. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2774. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName)
  2775. else
  2776. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2777. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName +
  2778. ExtractFileExt(PFileRec(Item.Data)^.FileName));
  2779. end;
  2780. end
  2781. else inherited;
  2782. end;
  2783. procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  2784. DragStatus: TDragDetectStatus);
  2785. var
  2786. WasWatchThreadActive: Boolean;
  2787. begin
  2788. if (DragStatus = ddsDrag) and (MarkedCount > 0) then
  2789. begin
  2790. WasWatchThreadActive := WatchThreadActive;
  2791. inherited;
  2792. if (LastDDResult = drMove) and (not WasWatchThreadActive) then
  2793. StartFileDeleteThread;
  2794. end;
  2795. end; {DDDragDetect}
  2796. procedure TDirView.DDChooseEffect(grfKeyState: Integer;
  2797. var dwEffect: Integer);
  2798. begin
  2799. if DragDropFilesEx.OwnerIsSource and
  2800. (dwEffect = DROPEFFECT_COPY) and (not Assigned(DropTarget)) then
  2801. begin
  2802. dwEffect := DROPEFFECT_NONE
  2803. end
  2804. else
  2805. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  2806. begin
  2807. if FDragDrive <> '' then
  2808. begin
  2809. if ExeDrag and DriveInfo.IsFixedDrive(DriveInfo.GetDriveKey(Path)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2810. begin
  2811. dwEffect := DROPEFFECT_LINK;
  2812. end
  2813. else
  2814. begin
  2815. if DragOnDriveIsMove and
  2816. (not DDOwnerIsSource or Assigned(DropTarget)) and
  2817. ((SameText(FDragDrive, DriveInfo.GetDriveKey(Path)) and (dwEffect = DROPEFFECT_COPY) and
  2818. (DragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0))
  2819. or IsRecycleBin) then
  2820. begin
  2821. dwEffect := DROPEFFECT_MOVE;
  2822. end;
  2823. end;
  2824. end;
  2825. end;
  2826. inherited;
  2827. end;
  2828. procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
  2829. Effect: Integer; RenameOnCollision: Boolean; Paste: Boolean);
  2830. var
  2831. Index: Integer;
  2832. SourcePath: string;
  2833. OldCursor: TCursor;
  2834. OldWatchForChanges: Boolean;
  2835. IsRecycleBin: Boolean;
  2836. SourceIsDirectory: Boolean;
  2837. Node: TTreeNode;
  2838. begin
  2839. if DragDropFilesEx.FileList.Count > 0 then
  2840. begin
  2841. if not DirectoryExists(TargetPath) then
  2842. begin
  2843. Reload(True);
  2844. DDError(DDPathNotFoundError);
  2845. end
  2846. else
  2847. begin
  2848. IsRecycleBin := Self.IsRecycleBin or
  2849. ((DropTarget <> nil) and ItemIsRecycleBin(DropTarget));
  2850. if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
  2851. begin
  2852. OldCursor := Screen.Cursor;
  2853. OldWatchForChanges := WatchForChanges;
  2854. SourceIsDirectory := True;
  2855. SourcePath := EmptyStr;
  2856. try
  2857. Screen.Cursor := crHourGlass;
  2858. WatchForChanges := False;
  2859. if Effect in [DROPEFFECT_COPY, DROPEFFECT_MOVE] then
  2860. begin
  2861. StopWatchThread;
  2862. if Assigned(DriveView) then
  2863. TDriveView(DriveView).StopWatchThread;
  2864. if (DropSourceControl <> Self) and
  2865. (DropSourceControl is TDirView) then
  2866. TDirView(DropSourceControl).StopWatchThread;
  2867. if DropFiles(
  2868. DragDropFilesEx, Effect, FFileOperator, TargetPath, RenameOnCollision, IsRecycleBin,
  2869. ConfirmDelete, ConfirmOverwrite, Paste,
  2870. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2871. begin
  2872. ReLoad2;
  2873. if Assigned(OnDDFileOperationExecuted) then
  2874. OnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2875. end;
  2876. end
  2877. else
  2878. if Effect = DROPEFFECT_LINK then
  2879. (* Create Link requested: *)
  2880. begin
  2881. StopWatchThread;
  2882. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2883. begin
  2884. if not DropLink(PFDDListItem(DragDropFilesEx.FileList[Index]), TargetPath) then
  2885. begin
  2886. DDError(DDCreateShortCutError);
  2887. end;
  2888. end;
  2889. ReLoad2;
  2890. end;
  2891. if Assigned(DropSourceControl) and
  2892. (DropSourceControl is TDirView) and
  2893. (DropSourceControl <> Self) and
  2894. (Effect = DROPEFFECT_MOVE) then
  2895. begin
  2896. TDirView(DropSourceControl).ValidateSelectedFiles;
  2897. end;
  2898. if Assigned(FDriveView) and SourceIsDirectory then
  2899. begin
  2900. with TDriveView(FDriveView) do
  2901. begin
  2902. try
  2903. ValidateDirectory(FindNodeToPath(TargetPath));
  2904. except
  2905. end;
  2906. if (Effect = DROPEFFECT_MOVE) or IsRecycleBin then
  2907. try
  2908. Node := FindNodeToPath(SourcePath);
  2909. if Assigned(Node) and Assigned(Node.Parent) then
  2910. Node := Node.Parent;
  2911. ValidateDirectory(Node);
  2912. except
  2913. end;
  2914. end;
  2915. end;
  2916. finally
  2917. FFileOperator.OperandFrom.Clear;
  2918. FFileOperator.OperandTo.Clear;
  2919. if Assigned(FDriveView) then
  2920. TDriveView(FDriveView).StartWatchThread;
  2921. Sleep(0);
  2922. WatchForChanges := OldWatchForChanges;
  2923. if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
  2924. TDirView(DropSourceControl).StartWatchThread;
  2925. Screen.Cursor := OldCursor;
  2926. end;
  2927. end;
  2928. end;
  2929. end;
  2930. end; {PerformDragDropFileOperation}
  2931. procedure TDirView.DDError(ErrorNo: TDDError);
  2932. begin
  2933. if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
  2934. else
  2935. raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
  2936. end; {DDError}
  2937. function TDirView.GetCanUndoCopyMove: Boolean;
  2938. begin
  2939. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2940. end; {CanUndoCopyMove}
  2941. function TDirView.UndoCopyMove : Boolean;
  2942. var
  2943. LastTarget: string;
  2944. LastSource: string;
  2945. begin
  2946. Result := False;
  2947. if FFileOperator.CanUndo then
  2948. begin
  2949. Lasttarget := FFileOperator.LastOperandTo[0];
  2950. LastSource := FFileOperator.LastOperandFrom[0];
  2951. if Assigned(FDriveView) then
  2952. TDriveView(FDriveView).StopAllWatchThreads;
  2953. Result := FFileOperator.UndoExecute;
  2954. if not WatchthreadActive then
  2955. Reload2;
  2956. if Assigned(FDriveView) then
  2957. with TDriveView(FDriveView) do
  2958. begin
  2959. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2960. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2961. StartAllWatchThreads;
  2962. end;
  2963. end;
  2964. end; {UndoCopyMove}
  2965. procedure TDirView.EmptyClipboard;
  2966. var
  2967. Item: TListItem;
  2968. begin
  2969. if Windows.OpenClipBoard(0) then
  2970. begin
  2971. Windows.EmptyClipBoard;
  2972. Windows.CloseClipBoard;
  2973. if LastClipBoardOperation <> cboNone then
  2974. begin
  2975. Item := GetNextItem(nil, sdAll, [isCut]);
  2976. while Assigned(Item) do
  2977. begin
  2978. Item.Cut := False;
  2979. Item := GetNextItem(Item, sdAll, [isCut]);
  2980. end;
  2981. end;
  2982. LastClipBoardOperation := cboNone;
  2983. if Assigned(FDriveView) then
  2984. TDriveView(FDriveView).LastPathCut := '';
  2985. end;
  2986. end; {EmptyClipBoard}
  2987. function TDirView.DoCopyToClipboard(Focused: Boolean; Cut: Boolean; Operation: TClipBoardOperation): Boolean;
  2988. var
  2989. Item: TListItem;
  2990. SaveCursor: TCursor;
  2991. begin
  2992. SaveCursor := Screen.Cursor;
  2993. Screen.Cursor := crHourGlass;
  2994. try
  2995. Result := False;
  2996. EmptyClipBoard;
  2997. DragDropFilesEx.FileList.Clear;
  2998. if OperateOnFocusedFile(Focused) or (SelCount > 0) then
  2999. begin
  3000. if OperateOnFocusedFile(Focused) then
  3001. begin
  3002. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(ItemFocused));
  3003. end
  3004. else
  3005. begin
  3006. Item := GetNextItem(nil, sdAll, [isSelected]);
  3007. while Assigned(Item) do
  3008. begin
  3009. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Item));
  3010. Item.Cut := Cut;
  3011. Item := GetNextItem(Item, sdAll, [isSelected]);
  3012. end;
  3013. end;
  3014. Result := DragDropFilesEx.CopyToClipBoard;
  3015. LastClipBoardOperation := Operation;
  3016. end;
  3017. finally
  3018. Screen.Cursor := SaveCursor;
  3019. end;
  3020. end; {DoCopyToClipBoard}
  3021. function TDirView.CopyToClipBoard(Focused: Boolean): Boolean;
  3022. begin
  3023. Result := DoCopyToClipboard(Focused, False, cboCopy);
  3024. end;
  3025. function TDirView.CutToClipBoard(Focused: Boolean): Boolean;
  3026. begin
  3027. Result := DoCopyToClipboard(Focused, True, cboCut);
  3028. end;
  3029. function TDirView.PasteFromClipBoard(TargetPath: string): Boolean;
  3030. begin
  3031. DragDropFilesEx.FileList.Clear;
  3032. Result := False;
  3033. if CanPasteFromClipBoard and {MP}DragDropFilesEx.GetFromClipBoard{/MP}
  3034. then
  3035. begin
  3036. if TargetPath = '' then
  3037. TargetPath := PathName;
  3038. case LastClipBoardOperation of
  3039. cboNone:
  3040. begin
  3041. PerformDragDropFileOperation(TargetPath, DROPEFFECT_COPY, False, True);
  3042. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_COPY);
  3043. end;
  3044. cboCopy:
  3045. begin
  3046. PerformDragDropFileOperation(TargetPath, DROPEFFECT_COPY,
  3047. ExcludeTrailingPathDelimiter(ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[0]^).Name)) = Path, True);
  3048. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_COPY);
  3049. end;
  3050. cboCut:
  3051. begin
  3052. PerformDragDropFileOperation(TargetPath, DROPEFFECT_MOVE, False, True);
  3053. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_MOVE);
  3054. EmptyClipBoard;
  3055. end;
  3056. end;
  3057. Result := True;
  3058. end;
  3059. end; {PasteFromClipBoard}
  3060. function TDirView.DragCompleteFileList: Boolean;
  3061. begin
  3062. Result := inherited DragCompleteFileList and
  3063. (FDriveType <> DRIVE_REMOVABLE);
  3064. end;
  3065. function TDirView.DuplicateSelectedFiles: Boolean;
  3066. begin
  3067. Result := False;
  3068. if SelCount > 0 then
  3069. begin
  3070. Result := CopyToClipBoard(False);
  3071. if Result then
  3072. try
  3073. SelectNewFiles := True;
  3074. Selected := nil;
  3075. Result := PasteFromClipBoard();
  3076. finally
  3077. SelectNewFiles := False;
  3078. if Assigned(Selected) then
  3079. begin
  3080. ItemFocused := Selected;
  3081. Selected.MakeVisible(False);
  3082. if SelCount = 1 then
  3083. Selected.EditCaption;
  3084. end;
  3085. end;
  3086. end;
  3087. EmptyClipBoard;
  3088. end; {DuplicateFiles}
  3089. function TDirView.NewColProperties: TCustomListViewColProperties;
  3090. begin
  3091. Result := TDirViewColProperties.Create(Self);
  3092. end;
  3093. function TDirView.SortAscendingByDefault(Index: Integer): Boolean;
  3094. begin
  3095. Result := not (TDirViewCol(Index) in [dvSize, dvChanged]);
  3096. end;
  3097. procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
  3098. begin
  3099. Assert(Assigned(Item));
  3100. if Assigned(Item.Data) then
  3101. with PFileRec(Item.Data)^ do
  3102. begin
  3103. ImageIndex := Index;
  3104. IconEmpty := (ImageIndex < 0);
  3105. end;
  3106. end;
  3107. {=================================================================}
  3108. initialization
  3109. LastClipBoardOperation := cboNone;
  3110. LastIOResult := 0;
  3111. DaylightHack := (not IsWin7);
  3112. end.