DirView.pas 101 KB

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