DirView.pas 102 KB

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