DirView.pas 102 KB

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