DirView.pas 100 KB

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