DirView.pas 103 KB

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