DirView.pas 103 KB

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