DirView.pas 122 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194
  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- 2003
  18. V2.6:
  19. - Shows "shared"-symbol with directories
  20. - New property ShowSubDirSize. Displays subdirectories sizes.
  21. - Delphi5 compatible
  22. For detailed documentation and history see TDirView.htm.
  23. ===============================================================}
  24. {Required compiler options for TDirView:}
  25. {$A+,B-,X+,H+,P+}
  26. interface
  27. {$WARN UNIT_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;
  33. {$I ResStrings.pas }
  34. type
  35. TVolumeDisplayStyle = (doPrettyName, doDisplayName, doLongPrettyName); {Diplaytext of drive node}
  36. const
  37. {$IFNDEF NO_THREADS}
  38. msThreadChangeDelay = 10; {TDiscMonitor: change delay}
  39. MaxWaitTimeOut = 10; {TFileDeleteThread: wait nn seconds for deleting files or directories}
  40. {$ENDIF}
  41. FileAttr = SysUtils.faAnyFile and (not SysUtils.faVolumeID);
  42. ExtLen = 4; {Length of extension including '.' => '.EXE'}
  43. SpecialExtensions = 'EXE,LNK,ICO,ANI,CUR,PIF,JOB,CPL';
  44. ExeExtension = 'EXE';
  45. MinDate = $21; {01.01.1980}
  46. MaxDate = $EF9F; {31.12.2099}
  47. MinTime = 0; {00:00:00}
  48. MaxTime = $C000; {24:00:00}
  49. type
  50. {Exceptions:}
  51. {$IFNDEF NO_THREADS}
  52. EIUThread = class(Exception);
  53. {$ENDIF}
  54. EDragDrop = class(Exception);
  55. EInvalidFileName = class(Exception);
  56. ERenameFileFailed = class(Exception);
  57. TClipboardOperation = (cboNone, cboCut, cboCopy);
  58. TFileNameDisplay = (fndStored, fndCap, fndNoCap, fndNice);
  59. TExtStr = string[ExtLen];
  60. {Record for each file item:}
  61. PFileRec = ^TFileRec;
  62. TFileRec = record
  63. Empty: Boolean;
  64. IconEmpty: Boolean;
  65. IsDirectory: Boolean;
  66. IsRecycleBin: Boolean;
  67. IsParentDir: Boolean;
  68. FileName: string;
  69. Displayname: string;
  70. FileExt: TExtStr;
  71. TypeName: string;
  72. ImageIndex: Integer;
  73. Size: Int64;
  74. Attr: LongWord;
  75. FileTime: TFileTime;
  76. PIDL: PItemIDList; {Fully qualified PIDL}
  77. end;
  78. {Record for fileinfo caching:}
  79. PInfoCache = ^TInfoCache;
  80. TInfoCache = record
  81. FileExt: TExtStr;
  82. TypeName: ShortString;
  83. ImageIndex: Integer;
  84. end;
  85. {$IFDEF VER120}
  86. type
  87. TWMContextMenu = packed record
  88. Msg: Cardinal;
  89. hWnd: HWND;
  90. case Integer of
  91. 0: (XPos: Smallint;
  92. YPos: Smallint);
  93. 1: (Pos: TSmallPoint;
  94. Result: Longint);
  95. end;
  96. {$ENDIF}
  97. {Additional events:}
  98. type
  99. TDirViewAddFileEvent = procedure(Sender: TObject; var SearchRec: SysUtils.TSearchRec;
  100. var AddFile : Boolean) of object;
  101. TDirViewFileSizeChanged = procedure(Sender: TObject; Item: TListItem) of object;
  102. type
  103. TDirView = class;
  104. {$IFNDEF NO_THREADS}
  105. TSubDirScanner = class(TCompThread)
  106. private
  107. FOwner: TDirView;
  108. FStartPath: string;
  109. FDirName: string;
  110. FTotalSize: Int64;
  111. procedure ThreadTerminated(Sender: TObject);
  112. protected
  113. constructor Create(Owner: TDirView; Item: TListItem);
  114. procedure DoUpdateItem;
  115. procedure Execute; override;
  116. end;
  117. { TIconUpdateThread (Fetch shell icons via thread) }
  118. TIconUpdateThread = class(TCompThread)
  119. private
  120. FOwner: TDirView;
  121. FIndex: Integer;
  122. FMaxIndex: Integer;
  123. FNewIcons: Boolean;
  124. FSyncIcon: Integer;
  125. CurrentIndex: Integer;
  126. CurrentFilePath: string;
  127. CurrentItemData: TFileRec;
  128. InvalidItem: Boolean;
  129. procedure SetIndex(Value: Integer);
  130. procedure SetMaxIndex(Value: Integer);
  131. protected
  132. constructor Create(Owner: TDirView);
  133. procedure DoFetchData;
  134. procedure DoUpdateIcon;
  135. procedure Execute; override;
  136. procedure Terminate;
  137. property Index: Integer read FIndex write SetIndex;
  138. property MaxIndex: Integer read FMaxIndex write SetMaxIndex;
  139. end;
  140. {$ENDIF}
  141. { TDirView }
  142. TDirView = class(TCustomDirView)
  143. private
  144. FConfirmDelete: Boolean;
  145. FConfirmOverwrite: Boolean;
  146. FUseIconCache: Boolean;
  147. FInfoCacheList: TListExt;
  148. {$IFDEF USE_DRIVEVIEW}
  149. FDriveView: TObject;
  150. {$ENDIF}
  151. FChangeTimer: TTimer;
  152. FChangeInterval: Cardinal;
  153. FUseIconUpdateThread: Boolean;
  154. {$IFNDEF NO_THREADS}
  155. FIUThreadFinished: Boolean;
  156. {$ENDIF}
  157. FDriveType: Integer;
  158. FAttrSpace: string;
  159. FNoCheckDrives: string;
  160. FSortAfterUpdate: Boolean;
  161. FCompressedColor: TColor;
  162. FFileNameDisplay: TFileNameDisplay;
  163. FParentFolder: IShellFolder;
  164. FDesktopFolder: IShellFolder;
  165. FDirOK: Boolean;
  166. FPath: string;
  167. FDrawLinkOverlay: Boolean;
  168. SelectNewFiles: Boolean;
  169. {File selection properties:}
  170. FSelArchive: TSelAttr;
  171. FSelHidden: TSelAttr;
  172. FSelSysFile: TSelAttr;
  173. FSelReadOnly: TSelAttr;
  174. FSelFileSizeFrom: Int64;
  175. FSelFileSizeTo: Int64;
  176. FSelFileDateFrom: Word;
  177. FSelFileDateTo: Word;
  178. FSelFileTimeFrom: Word;
  179. FSelFileTimeTo: Word;
  180. {shFileOperation-shell component TFileOperator:}
  181. FFileOperator: TFileOperator;
  182. {Additional thread components:}
  183. {$IFNDEF NO_THREADS}
  184. FIconUpdateThread: TIconUpdateThread;
  185. {$ENDIF}
  186. FDiscMonitor: TDiscMonitor;
  187. FHomeDirectory: string;
  188. FSubDirScanner: TList;
  189. {Additional events:}
  190. FOnAddFile: TDirViewAddFileEvent;
  191. FOnFileSizeChanged: TDirViewFileSizeChanged;
  192. FOnChangeDetected: TNotifyEvent;
  193. FOnChangeInvalid: TNotifyEvent;
  194. iRecycleFolder: iShellFolder;
  195. PIDLRecycle: PItemIDList;
  196. {Drag&Drop:}
  197. function GetDirColProperties: TDirViewColProperties;
  198. function GetHomeDirectory: string;
  199. {Drag&drop helper functions:}
  200. {$IFNDEF NO_THREADS}
  201. procedure SignalFileDelete(Sender: TObject; Files: TStringList);
  202. {$ENDIF}
  203. procedure PerformDragDropFileOperation(TargetPath: string; dwEffect: Integer;
  204. RenameOnCollision: Boolean);
  205. procedure SetDirColProperties(Value: TDirViewColProperties);
  206. protected
  207. function NewColProperties: TCustomListViewColProperties; override;
  208. procedure SetShowSubDirSize(Value: Boolean); override;
  209. {$IFDEF USE_DRIVEVIEW}
  210. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  211. {$ENDIF}
  212. procedure Delete(Item: TListItem); override;
  213. procedure SetMask(Value: string); override;
  214. procedure DDError(ErrorNo: TDDError);
  215. function GetCanUndoCopyMove: Boolean; virtual;
  216. {Shell namespace functions:}
  217. function GetShellFolder(Dir: string): iShellFolder;
  218. function GetDirOK: Boolean; override;
  219. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItemA); override;
  220. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  221. DragStatus: TDragDetectStatus); override;
  222. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); override;
  223. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  224. Point: TPoint; dwEffect: Longint); override;
  225. procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); override;
  226. function GetPathName: string; override;
  227. procedure SetChangeInterval(Value: Cardinal); virtual;
  228. procedure LoadFromRecycleBin(Dir: string); virtual;
  229. procedure SetLoadEnabled(Value: Boolean); override;
  230. function GetPath: string; override;
  231. procedure SetPath(Value: string); override;
  232. procedure SetItemImageIndex(Item: TListItem; Index: Integer); override;
  233. procedure SetCompressedColor(Value: TColor);
  234. procedure ChangeDetected(Sender: TObject);
  235. procedure ChangeInvalid(Sender: TObject);
  236. procedure TimerOnTimer(Sender: TObject);
  237. procedure ResetItemImage(Index: Integer);
  238. procedure SetAttrSpace(Value: string);
  239. procedure SetNoCheckDrives(Value: string);
  240. procedure SetWatchForChanges(Value: Boolean); override;
  241. procedure AddParentDirItem;
  242. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); override;
  243. procedure SetFileNameDisplay(Value: TFileNameDisplay); virtual;
  244. procedure DisplayContextMenu(Where: TPoint); override;
  245. function DragCompleteFileList: Boolean; override;
  246. procedure ExecuteFile(Item: TListItem); override;
  247. function GetIsRoot: Boolean; override;
  248. procedure InternalEdit(const HItem: TLVItem); override;
  249. function ItemColor(Item: TListItem): TColor; override;
  250. function ItemDisplayName(FileName: string): string; virtual;
  251. function ItemFileExt(Item: TListItem): string;
  252. function ItemFileNameOnly(Item: TListItem): string;
  253. function ItemFileSize(Item: TListItem): Int64; override;
  254. function ItemFileTime(Item: TListItem): TDateTime; override;
  255. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; override;
  256. function ItemIsFile(Item: TListItem): Boolean; override;
  257. function ItemIsRecycleBin(Item: TListItem): Boolean; override;
  258. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; override;
  259. function ItemOverlayIndexes(Item: TListItem): Word; override;
  260. procedure LoadFiles; override;
  261. function MinimizePath(Path: string; Len: Integer): string; override;
  262. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer); override;
  263. procedure SortItems; override;
  264. {$IFNDEF NO_THREADS}
  265. procedure StartFileDeleteThread;
  266. {$ENDIF}
  267. procedure SetShowHiddenFiles(Value: Boolean); override;
  268. procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  269. public
  270. {Runtime, readonly properties:}
  271. property DriveType: Integer read FDriveType;
  272. {$IFDEF USE_DRIVEVIEW}
  273. {Linked component TDriveView:}
  274. property DriveView: TObject read FDriveView write FDriveView;
  275. {$ENDIF}
  276. {It is not required to store the items edited at designtime:}
  277. property Items stored False;
  278. { required, otherwise AV generated, when dragging columns}
  279. property Columns stored False;
  280. property ParentFolder: IShellFolder read FParentFolder;
  281. {Drag&Drop runtime, readonly properties:}
  282. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  283. property DDFileOperator: TFileOperator read FFileOperator;
  284. {Drag&Drop fileoperation methods:}
  285. function UndoCopyMove: Boolean; dynamic;
  286. {Clipboard fileoperation methods (requires drag&drop enabled):}
  287. procedure EmptyClipboard; dynamic;
  288. function CopyToClipBoard: Boolean; dynamic;
  289. function CutToClipBoard: Boolean; dynamic;
  290. function CanPasteFromClipBoard: Boolean; dynamic;
  291. function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
  292. function DuplicateSelectedFiles: Boolean; dynamic;
  293. procedure DisplayPropertiesMenu; override;
  294. procedure ExecuteParentDirectory; override;
  295. procedure ExecuteRootDirectory; override;
  296. function ItemIsDirectory(Item: TListItem): Boolean; override;
  297. function ItemFullFileName(Item: TListItem): string; override;
  298. function ItemIsParentDirectory(Item: TListItem): Boolean; override;
  299. function ItemFileName(Item: TListItem): string; override;
  300. {$IFNDEF NO_THREADS}
  301. {Thread handling: }
  302. procedure StartWatchThread;
  303. procedure StopWatchThread;
  304. function WatchThreadActive: Boolean;
  305. procedure StartIconUpdateThread;
  306. procedure StopIconUpdateThread;
  307. procedure StartSubDirScanner;
  308. procedure StopSubDirScanner;
  309. procedure TerminateThreads;
  310. {$ENDIF}
  311. {Other additional functions: }
  312. procedure Syncronize;
  313. procedure ClearIconCache;
  314. {Create a new file:}
  315. function CreateFile(NewName: string): TListItem; dynamic;
  316. {Create a new subdirectory:}
  317. procedure CreateDirectory(DirName: string); override;
  318. {Delete all selected files:}
  319. function DeleteSelectedFiles(AllowUndo: Boolean): Boolean; dynamic;
  320. {Check, if file or files still exists:}
  321. procedure ValidateFile(Item: TListItem); overload;
  322. procedure ValidateFile(FileName:TFileName); overload;
  323. procedure ValidateSelectedFiles; dynamic;
  324. {Access the internal data-structures:}
  325. function AddItem(SRec: SysUtils.TSearchRec): TListItem; reintroduce;
  326. procedure GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  327. function GetFileRec(Index: Integer): PFileRec;
  328. {Populate / repopulate the filelist:}
  329. procedure Load; override;
  330. procedure ReLoad(CacheIcons : Boolean); override;
  331. procedure Reload2;
  332. function FormatFileTime(FileTime: TFileTime): string; virtual;
  333. function GetAttrString(Attr: Integer): string; virtual;
  334. procedure FetchAllDisplayData;
  335. constructor Create(AOwner: TComponent); override;
  336. destructor Destroy; override;
  337. procedure ExecuteHomeDirectory; override;
  338. procedure ReloadDirectory; override;
  339. property HomeDirectory: string read GetHomeDirectory write FHomeDirectory;
  340. {Redefined functions: }
  341. {Properties for filtering files:}
  342. property SelArchive: TSelAttr
  343. read FSelArchive write FSelArchive default selDontCare;
  344. property SelHidden: TSelAttr
  345. read FSelHidden write FSelHidden default selDontCare;
  346. property SelSysFile: TSelAttr
  347. read FSelSysFile write FSelSysFile default selDontCare;
  348. property SelReadOnly: TSelAttr
  349. read FSelReadOnly write FSelReadOnly default selDontCare;
  350. property SelFileSizeFrom: Int64
  351. read FSelFileSizeFrom write FSelFileSizeFrom;
  352. property SelFileSizeTo: Int64
  353. read FSelFileSizeTo write FSelFileSizeTo default 0;
  354. property SelFileDateFrom: Word
  355. read FSelFileDateFrom write FSelFileDateFrom default MinDate; {01.01.1980}
  356. property SelFileDateTo: Word
  357. read FSelFileDateTo write FSelFileDateTo default MaxDate; {31.12.2099}
  358. property SelFileTimeFrom: Word
  359. read FSelFileTimeFrom write FSelFileTimeFrom;
  360. property SelFileTimeTo: Word
  361. read FSelFileTimeTo write FSelFileTimeTo default MaxTime;
  362. published
  363. property DirColProperties: TDirViewColProperties read GetDirColProperties write SetDirColProperties;
  364. property PathComboBox;
  365. property PathLabel;
  366. property StatusBar;
  367. property OnGetSelectFilter;
  368. property HeaderImages;
  369. property LoadAnimation;
  370. property DimmHiddenFiles;
  371. property ShowDirectories;
  372. property ShowHiddenFiles;
  373. property DirsOnTop;
  374. property ShowSubDirSize;
  375. property SingleClickToExec;
  376. property WantUseDragImages;
  377. property TargetPopupMenu;
  378. property AddParentDir;
  379. property OnSelectItem;
  380. property OnStartLoading;
  381. property OnLoaded;
  382. property OnDDDragEnter;
  383. property OnDDDragLeave;
  384. property OnDDDragOver;
  385. property OnDDDrop;
  386. property OnDDQueryContinueDrag;
  387. property OnDDGiveFeedback;
  388. property OnDDDragDetect;
  389. property OnDDCreateDragFileList;
  390. property OnDDEnd;
  391. property OnDDCreateDataObject;
  392. property OnDDTargetHasDropHandler;
  393. {Drag&Drop:}
  394. property DDLinkOnExeDrag default True;
  395. property OnDDProcessDropped;
  396. property OnDDError;
  397. property OnDDExecuted;
  398. property OnDDFileOperation;
  399. property OnDDFileOperationExecuted;
  400. property OnExecFile;
  401. property CompressedColor: TColor
  402. read FCompressedColor write SetCompressedColor default clBlue;
  403. {Confirm deleting files}
  404. property ConfirmDelete: Boolean
  405. read FConfirmDelete write FConfirmDelete default True;
  406. {Confirm overwriting files}
  407. property ConfirmOverwrite: Boolean
  408. read FConfirmOverwrite write fConfirmOverwrite default True;
  409. property SortAfterUpdate: Boolean
  410. read FSortAfterUpdate write FSortAfterUpdate default True;
  411. {Reload the directory after only the interval:}
  412. property ChangeInterval: Cardinal
  413. read FChangeInterval write SetChangeInterval default 1000;
  414. {Fetch shell icons by thread:}
  415. property UseIconUpdateThread: Boolean
  416. read FUseIconUpdateThread write FUseIconUpdateThread default False;
  417. {Enables or disables icon caching for registered file extensions. Caching enabled
  418. enhances the performance but does not take care about installed icon handlers, wich
  419. may modify the display icon for registered files. Only the iconindex is cached not the
  420. icon itself:}
  421. property UseIconCache: Boolean
  422. read FUseIconCache write FUseIconCache default False;
  423. property FileNameDisplay: TFileNameDisplay
  424. read FFileNameDisplay write SetFileNameDisplay default fndStored;
  425. {Use this string as whitespace in the attribute column:}
  426. property AttrSpace: string read FAttrSpace write SetAttrSpace;
  427. {Don't watch these drives for changes:}
  428. property NoCheckDrives: string read FNoCheckDrives write SetNoCheckDrives;
  429. {Watch current directory for filename changes (create, rename, delete files)}
  430. property WatchForChanges;
  431. {Additional events:}
  432. {The watchthread has detected new, renamed or deleted files}
  433. {$IFNDEF NO_THREADS}
  434. property OnChangeDetected: TNotifyEvent
  435. read FOnChangeDetected write FOnChangeDetected;
  436. {The watchthread can't watch the current directory. Occurs on novell
  437. network drives.}
  438. property OnChangeInvalid: TNotifyEvent
  439. read FOnChangeInvalid write FOnChangeInvalid;
  440. {$ENDIF}
  441. {Set AddFile to false, if actual file should not be added to the filelist:}
  442. property OnAddFile: TDirViewAddFileEvent
  443. read FOnAddFile write FOnAddFile;
  444. property OnFileSizeChanged: TDirViewFileSizeChanged
  445. read FOnFileSizeChanged write FOnFileSizeChanged;
  446. property UseSystemContextMenu;
  447. property OnContextPopup;
  448. property OnBeginRename;
  449. property OnEndRename;
  450. property OnHistoryChange;
  451. property ColumnClick;
  452. property MultiSelect;
  453. property ReadOnly;
  454. end; {Type TDirView}
  455. procedure Register;
  456. {Returns True, if the specified extension matches one of the extensions in ExtList:}
  457. function MatchesFileExt(Ext: TExtStr; const FileExtList: string): Boolean;
  458. var
  459. LastClipBoardOperation: TClipBoardOperation;
  460. LastIOResult: DWORD;
  461. implementation
  462. uses
  463. {$IFDEF USE_DRIVEVIEW}
  464. DriveView,
  465. {$ENDIF}
  466. PIDL, Forms, Dialogs, Controls,
  467. ShellAPI, ComObj,
  468. ActiveX, ImgList,
  469. ShellDialogs, IEDriveInfo,
  470. MaskSearch, FileChanges, BaseUtils, Math;
  471. procedure Register;
  472. begin
  473. RegisterComponents('DriveDir', [TDirView]);
  474. end; {Register}
  475. function CompareInfoCacheItems(I1, I2: Pointer): Integer;
  476. begin
  477. if PInfoCache(I1)^.FileExt < PInfoCache(I2)^.FileExt then Result := fLess
  478. else
  479. if PInfoCache(I1)^.FileExt > PInfoCache(I2)^.FileExt then Result := fGreater
  480. else Result := fEqual;
  481. end; {CompareInfoCacheItems}
  482. function MatchesFileExt(Ext: TExtStr; const FileExtList: string): Boolean;
  483. begin
  484. Result := (Length(Ext) >= Pred(ExtLen)) and (Pos(Ext, FileExtList) <> 0);
  485. end; {MatchesFileExt}
  486. function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
  487. var
  488. SysTime: TSystemTime;
  489. LocalFileTime: TFileTime;
  490. begin
  491. FileTimeToLocalFileTime(FileTime, LocalFileTime);
  492. FileTimeToSystemTime(LocalFileTime, SysTime);
  493. Result := SystemTimeToDateTime(SysTime);
  494. end;
  495. function SizeFromSRec(const SRec: SysUtils.TSearchRec): Int64;
  496. begin
  497. with SRec do
  498. begin
  499. // Hopefuly TSearchRec.FindData is available with all Windows versions
  500. {if Size >= 0 then Result := Size
  501. else}
  502. {$WARNINGS OFF}
  503. Result := Int64(FindData.nFileSizeHigh) shl 32 + FindData.nFileSizeLow;
  504. {$WARNINGS ON}
  505. end;
  506. end;
  507. {function ResolveLink(const Path: string): string;
  508. var
  509. Link: IShellLink;
  510. Storage: IPersistFile;
  511. FileData: TWin32FindData;
  512. Buf: Array[0..MAX_PATH] of Char;
  513. WidePath: WideString;
  514. begin
  515. OleCheck(CoCreateInstance( CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
  516. IShellLink, Link));
  517. OleCheck(Link.QueryInterface(IPersistFile, Storage));
  518. WidePath := Path;
  519. if Succeeded(Storage.Load(@WidePath[1], STGM_READ)) and
  520. Succeeded(Link.Resolve(GetActiveWindow, SLR_NOUPDATE)) and
  521. Succeeded(Link.GetPath(Buf, sizeof(Buf), FileData, SLGP_UNCPRIORITY)) then
  522. begin
  523. Result := Buf;
  524. end
  525. else
  526. begin
  527. raise Exception(Format(SResolveLinkError, [Path]));
  528. end;
  529. Storage := nil;
  530. Link:= nil;
  531. end;}
  532. {$IFNDEF NO_THREADS}
  533. { TSubDirScanner }
  534. constructor TSubDirScanner.Create(Owner: TDirView; Item: TListItem);
  535. begin
  536. inherited Create(True);
  537. FOwner := Owner;
  538. FTotalSize := 0;
  539. FStartPath := FOwner.ItemFullFileName(Item);
  540. FDirName := Item.Caption;
  541. FreeOnTerminate := False;
  542. OnTerminate := ThreadTerminated;
  543. Priority := tpLower;
  544. Resume;
  545. end; {Create}
  546. procedure TSubDirScanner.Execute;
  547. function ScanSubDir(Path: string): Boolean;
  548. var
  549. SRec: SysUtils.TSearchRec;
  550. DosError: Integer;
  551. SubDirs: TStringList;
  552. Index: Integer;
  553. FSize: Int64;
  554. begin
  555. Result := True;
  556. DosError := FindFirst(Path + '*.*', faAnyFile, SRec);
  557. if DosError = 0 then
  558. begin
  559. SubDirs := TStringList.Create;
  560. try
  561. while DosError = 0 do
  562. begin
  563. if Terminated then
  564. Break;
  565. if (SRec.Name <> '.') and (SRec.name <> '..') then
  566. begin
  567. FSize := SizeFromSRec(SRec);
  568. if FSize > 0 then
  569. Inc(FTotalSize, FSize);
  570. if SRec.Attr and faDirectory <> 0 then
  571. SubDirs.Add(IncludeTrailingPathDelimiter(Path + Srec.Name));
  572. end;
  573. if not Terminated then DosError := FindNext(SRec)
  574. else Break;
  575. end; {While}
  576. FindClose(SRec);
  577. finally
  578. try
  579. for Index := 0 to SubDirs.Count - 1 do
  580. begin
  581. Result := ScanSubDir(SubDirs[Index]);
  582. if not Result then Break;
  583. end;
  584. finally
  585. SubDirs.Free;
  586. if Result then
  587. Result := (DosError = ERROR_NO_MORE_FILES);
  588. end;
  589. end;
  590. end;
  591. end; {ScanSubDir}
  592. begin {Execute}
  593. if ScanSubDir(IncludeTrailingPathDelimiter(FStartPath)) and not Terminated then
  594. Synchronize(DoUpdateItem);
  595. end; {Execute}
  596. procedure TSubDirScanner.DoUpdateItem;
  597. var
  598. Item: TListItem;
  599. StartPos: Integer;
  600. begin
  601. if not Terminated then
  602. begin
  603. StartPos := 0;
  604. Item := nil;
  605. while StartPos < FOwner.Items.Count do
  606. begin
  607. Item := FOwner.FindCaption(StartPos, FDirName, False, True, False);
  608. if Assigned(Item) and (FOwner.ItemFullFileName(Item) = FStartPath) then
  609. Break
  610. else
  611. if not Assigned(Item) then Break
  612. else StartPos := Item.Index + 1;
  613. end;
  614. if Assigned(Item) and not Terminated then
  615. begin
  616. PFileRec(Item.Data)^.Size := FTotalSize;
  617. Inc(FOwner.FFilesSize, FTotalSize);
  618. if Item.Selected then
  619. Inc(FOwner.FFilesSelSize, FTotalSize);
  620. FOwner.UpdateItems(Item.Index, Item.Index);
  621. if Assigned(FOwner.OnFileSizeChanged) then
  622. FOwner.OnFileSizeChanged(FOwner, Item);
  623. end;
  624. end;
  625. end; {DoUpdateItem}
  626. procedure TSubDirScanner.ThreadTerminated(Sender: TObject);
  627. var
  628. Index: Integer;
  629. begin
  630. Assert(Assigned(FOwner));
  631. with FOwner do
  632. for Index := 0 to FSubDirScanner.Count - 1 do
  633. if FSubDirScanner[Index] = Self then
  634. begin
  635. try
  636. FSubDirScanner.Delete(Index);
  637. if (FSubDirScanner.Count = 0) and
  638. (FOwner.SortColumn = Integer(dvSize)) and
  639. not Loading then FOwner.SortItems;
  640. finally
  641. inherited Destroy;
  642. end;
  643. Exit;
  644. end;
  645. Assert(False, 'TSubDirScanner failed: ' + FStartPath);
  646. inherited Destroy;
  647. end; {ThreadTerminated}
  648. { TIconUpdateThread }
  649. constructor TIconUpdateThread.Create(Owner: TDirView);
  650. begin
  651. inherited Create(True);
  652. FOwner := Owner;
  653. FIndex := 0;
  654. FNewIcons := False;
  655. if (FOwner.ViewStyle = vsReport) or (FOwner.ViewStyle = vsList) then
  656. FMaxIndex := FOwner.VisibleRowCount
  657. else FMaxIndex := 0;
  658. FOwner.FIUThreadFinished := False;
  659. end; {TIconUpdateThread.Create}
  660. procedure TIconUpdateThread.SetMaxIndex(Value: Integer);
  661. var
  662. Point: TPoint;
  663. Item: TListItem;
  664. begin
  665. if Value <> MaxIndex then
  666. begin
  667. FNewIcons := True;
  668. if Value < FMaxIndex then
  669. begin
  670. if Suspended then FIndex := Value
  671. else
  672. begin
  673. Point.X := 0;
  674. Point.X := 0;
  675. Item := FOwner.GetNearestItem(Point, TSearchDirection(sdAbove));
  676. if Assigned(Item) then FIndex := Item.Index
  677. else FIndex := Value;
  678. end;
  679. end
  680. else FMaxIndex := Value;
  681. end;
  682. end; {SetMaxIndex}
  683. procedure TIconUpdateThread.SetIndex(Value: Integer);
  684. var
  685. PageSize: Integer;
  686. begin
  687. if Value <> Index then
  688. begin
  689. PageSize := FOwner.VisibleRowCount;
  690. FIndex := Value;
  691. FNewIcons := True;
  692. if FOwner.ViewStyle = vsList then FMaxIndex := Value + 2 * PageSize
  693. else FMaxIndex := Value + PageSize;
  694. end;
  695. end; {SetIndex}
  696. procedure TIconUpdateThread.Execute;
  697. var
  698. FileInfo: TShFileInfo;
  699. Count: Integer;
  700. WStr: WideString;
  701. Eaten: ULONG;
  702. ShAttr: ULONG;
  703. begin
  704. if Assigned(FOwner.TopItem) then FIndex := FOwner.TopItem.Index
  705. else FIndex := 0;
  706. FNewIcons := (FIndex > 0);
  707. while not Terminated do
  708. begin
  709. if FIndex > FMaxIndex then Suspend;
  710. Count := FOwner.Items.Count;
  711. if not Terminated and ((FIndex >= Count) or (Count = 0)) then
  712. Suspend;
  713. InvalidItem := True;
  714. if Terminated then Break;
  715. Synchronize(DoFetchData);
  716. if (not InvalidItem) and (not Terminated) and
  717. CurrentItemData.IconEmpty then
  718. begin
  719. try
  720. if not Assigned(CurrentItemData.PIDL) then
  721. begin
  722. WStr := CurrentFilePath;
  723. FOwner.FDesktopFolder.ParseDisplayName(FOwner.ParentForm.Handle, nil,
  724. PWideChar(WStr), Eaten, CurrentItemData.PIDL, ShAttr);
  725. end;
  726. if Assigned(CurrentItemData.PIDL) then
  727. shGetFileInfo(PChar(CurrentItemData.PIDL), 0, FileInfo, SizeOf(FileInfo),
  728. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  729. else
  730. shGetFileInfo(PChar(CurrentFilePath), 0, FileInfo, SizeOf(FileInfo),
  731. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  732. except
  733. {Capture exceptions generated by the shell}
  734. FSyncIcon := UnKnownFileIcon;
  735. end;
  736. if Terminated then
  737. begin
  738. FreePIDL(CurrentItemData.PIDL);
  739. Break;
  740. end;
  741. FSyncIcon := FileInfo.iIcon;
  742. if FSyncIcon <> CurrentItemData.ImageIndex then
  743. FNewIcons := True;
  744. if not Terminated then
  745. Synchronize(DoUpdateIcon);
  746. FreePIDL(CurrentItemData.PIDL);
  747. end;
  748. SetLength(CurrentFilePath, 0);
  749. if CurrentIndex = FIndex then Inc(FIndex);
  750. SetLength(CurrentFilePath, 0);
  751. end;
  752. end; {TIconUpdateThread.Execute}
  753. procedure TIconUpdateThread.DoFetchData;
  754. begin
  755. CurrentIndex := fIndex;
  756. if not Terminated and
  757. (Pred(FOwner.Items.Count) >= CurrentIndex) and
  758. Assigned(FOwner.Items[CurrentIndex]) and
  759. Assigned(FOwner.Items[CurrentIndex].Data) then
  760. begin
  761. CurrentFilePath := FOwner.ItemFullFileName(FOwner.Items[CurrentIndex]);
  762. CurrentItemData := PFileRec(FOwner.Items[CurrentIndex].Data)^;
  763. InvalidItem := False;
  764. end
  765. else InvalidItem := True;
  766. end; {TIconUpdateThread.DoFetchData}
  767. procedure TIconUpdateThread.DoUpdateIcon;
  768. var
  769. LVI: TLVItem;
  770. begin
  771. if (FOwner.Items.Count > CurrentIndex) and
  772. not fOwner.Loading and not Terminated and
  773. Assigned(FOwner.Items[CurrentIndex]) and
  774. Assigned(FOwner.Items[CurrentIndex].Data) then
  775. with FOwner.Items[CurrentIndex] do
  776. begin
  777. if (FSyncIcon >= 0) and (PFileRec(Data)^.ImageIndex <> FSyncIcon) then
  778. begin
  779. with PFileRec(Data)^ do
  780. ImageIndex := FSyncIcon;
  781. {To avoid flickering of the display use Listview_SetItem
  782. instead of using the property ImageIndex:}
  783. LVI.mask := LVIF_IMAGE;
  784. LVI.iItem := CurrentIndex;
  785. LVI.iSubItem := 0;
  786. LVI.iImage := I_IMAGECALLBACK;
  787. if not Terminated then
  788. ListView_SetItem(FOwner.Handle, LVI);
  789. FNewIcons := True;
  790. end;
  791. PFileRec(Data)^.IconEmpty := False;
  792. end;
  793. end; {TIconUpdateThread.DoUpdateIcon}
  794. procedure TIconUpdateThread.Terminate;
  795. begin
  796. FOwner.FIUThreadFinished := True;
  797. inherited;
  798. end; {TIconUpdateThread.Terminate}
  799. {$ENDIF} // NO_THREADS
  800. { TDirView }
  801. constructor TDirView.Create(AOwner: TComponent);
  802. begin
  803. inherited Create(AOwner);
  804. FInfoCacheList := TListExt.Create(SizeOf(TInfoCache));
  805. FDriveType := DRIVE_UNKNOWN;
  806. FUseIconCache := False;
  807. FConfirmDelete := True;
  808. FAttrSpace := EmptyStr;
  809. FSortAfterUpdate := True;
  810. FCompressedColor := clBlue;
  811. FFileNameDisplay := fndStored;
  812. FParentFolder := nil;
  813. FDesktopFolder := nil;
  814. SelectNewFiles := False;
  815. FDrawLinkOverlay := True;
  816. DragOnDriveIsMove := True;
  817. FFileOperator := TFileOperator.Create(Self);
  818. FFileOperator.ProgressTitle := coFileOperatorTitle;
  819. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  820. FDirOK := True;
  821. FPath := '';
  822. FDiscMonitor := nil;
  823. FSubDirScanner := TList.Create;
  824. {ChangeTimer: }
  825. if FChangeInterval = 0 then FChangeInterval := 1000;
  826. FChangeTimer := TTimer.Create(Self);
  827. FChangeTimer.Interval := fChangeInterval;
  828. FChangeTimer.Enabled := False;
  829. FChangeTimer.OnTimer := TimerOnTimer;
  830. FSelArchive := selDontCare;
  831. FSelHidden := selDontCare;
  832. FSelReadOnly := selDontCare;
  833. FSelSysFile := selDontCare;
  834. FSelFileSizeTo := 0;
  835. FSelFileDateFrom := MinDate;
  836. FSelFileDateTo := MaxDate;
  837. FSelFileTimeTo := MaxTime;
  838. {Drag&drop:}
  839. FConfirmOverwrite := True;
  840. DDLinkOnExeDrag := True;
  841. with DragDropFilesEx do
  842. begin
  843. SourceEffects := DragSourceEffects;
  844. TargetEffects := [deCopy, deMove, deLink];
  845. ShellExtensions.DragDropHandler := True;
  846. ShellExtensions.DropHandler := True;
  847. end;
  848. end; {Create}
  849. destructor TDirView.Destroy;
  850. begin
  851. FSubDirScanner.Free;
  852. if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
  853. FInfoCacheList.Free;
  854. FFileOperator.Free;
  855. FChangeTimer.Free;
  856. inherited Destroy;
  857. end; {Destroy}
  858. procedure TDirView.WMDestroy(var Msg: TWMDestroy);
  859. begin
  860. Selected := nil;
  861. ClearItems;
  862. {$IFNDEF NO_THREADS}
  863. TerminateThreads;
  864. {$ENDIF}
  865. inherited;
  866. end; {WMDestroy}
  867. {$IFNDEF NO_THREADS}
  868. procedure TDirView.TerminateThreads;
  869. begin
  870. StopSubDirScanner;
  871. StopIconUpdateThread;
  872. StopWatchThread;
  873. end; {TerminateThreads}
  874. {$ENDIF}
  875. function TDirView.GetHomeDirectory: string;
  876. begin
  877. if FHomeDirectory <> '' then Result := FHomeDirectory
  878. else
  879. begin
  880. Result := UserDocumentDirectory;
  881. if IsUNCPath(Result) then
  882. Result := AnyValidPath;
  883. end;
  884. end; { GetHomeDirectory }
  885. function TDirView.GetIsRoot: Boolean;
  886. begin
  887. Result := (Length(Path) = 2) and (Path[2] = ':');
  888. end;
  889. function TDirView.GetPath: string;
  890. begin
  891. Result := FPath;
  892. end;
  893. procedure TDirView.SetPath(Value: string);
  894. begin
  895. Value := StringReplace(Value, '/', '\', [rfReplaceAll]);
  896. while (Length(Value) > 0) and (Value[Length(Value)] = '\') do
  897. SetLength(Value, Length(Value) - 1);
  898. if FPath <> Value then
  899. try
  900. if IsUncPath(Value) then
  901. raise Exception.CreateFmt(SUcpPathsNotSupported, [Value]);
  902. if not DirectoryExists(Value) then
  903. raise Exception.CreateFmt(SDirNotExists, [Value]);
  904. FLastPath := PathName;
  905. FPath := Value;
  906. Load;
  907. finally
  908. PathChanged;
  909. end;
  910. end;
  911. procedure TDirView.SetLoadEnabled(Value: Boolean);
  912. begin
  913. if Value <> LoadEnabled then
  914. begin
  915. FLoadEnabled := Enabled;
  916. if LoadEnabled and Dirty then
  917. begin
  918. if Items.Count > 100 then Reload2
  919. else Reload(True);
  920. end;
  921. end;
  922. end; {SetLoadEnabled}
  923. procedure TDirView.SetShowHiddenFiles(Value: Boolean);
  924. begin
  925. if Value <> ShowHiddenFiles then
  926. begin
  927. if Value then FSelHidden := selDontCare
  928. else FSelHidden := selNo;
  929. inherited;
  930. end;
  931. end;
  932. procedure TDirView.SetCompressedColor(Value: TColor);
  933. begin
  934. if Value <> CompressedColor then
  935. begin
  936. FCompressedColor := Value;
  937. Invalidate;
  938. end;
  939. end; {SetCompressedColor}
  940. function TDirView.GetPathName: string;
  941. begin
  942. if (Length(Path) = 2) and (Path[2] = ':') then Result := Path + '\'
  943. else Result := Path;
  944. end; {GetPathName}
  945. function TDirView.GetFileRec(Index: Integer): PFileRec;
  946. begin
  947. if Index > Pred(Items.Count) then Result := nil
  948. else Result := Items[index].Data;
  949. end; {GetFileRec}
  950. function TDirView.ItemDisplayName(FileName: string): string;
  951. begin
  952. case FFileNameDisplay of
  953. fndCap: Result := UpperCase(FileName);
  954. fndNoCap: Result := LowerCase(FileName);
  955. fndNice:
  956. if (Length(FileName) > 12) or (Pos(' ', FileName) <> 0) then
  957. Result := FileName
  958. else
  959. begin
  960. Result := LowerCase(FileName);
  961. Result[1] := Upcase(Result[1]);
  962. end;
  963. else
  964. Result := FileName;
  965. end; {Case}
  966. end; {ItemDisplayName}
  967. function TDirView.AddItem(SRec: SysUtils.TSearchRec): TListItem;
  968. var
  969. PItem: PFileRec;
  970. Item: TListItem;
  971. begin
  972. Item := Items.Add;
  973. New(PItem);
  974. with PItem^ do
  975. begin
  976. FileName := SRec.Name;
  977. FileExt := UpperCase(Copy(ExtractFileExt(Srec.Name), 2, Pred(ExtLen)));
  978. DisplayName := ItemDisplayName(FileName);
  979. {$WARNINGS OFF}
  980. Attr := SRec.FindData.dwFileAttributes;
  981. {$WARNINGS ON}
  982. IsParentDir := False;
  983. IsDirectory := ((Attr and SysUtils.faDirectory) <> 0);
  984. IsRecycleBin := IsDirectory and (Length(Path) = 2) and
  985. Bool(Attr and SysUtils.faSysFile) and
  986. ((UpperCase(FileName) = 'RECYCLED') or (UpperCase(FileName) = 'RECYCLER'));
  987. if not IsDirectory then Size := SizeFromSRec(SRec)
  988. else Size := -1;
  989. if not Self.IsRecycleBin then Item.Caption := SRec.Name;
  990. {$WARNINGS OFF}
  991. FileTime := SRec.FindData.ftLastWriteTime;
  992. {$WARNINGS ON}
  993. Empty := True;
  994. IconEmpty := True;
  995. if Size > 0 then Inc(FFilesSize, Size);
  996. PIDL := nil;
  997. Item.Data := PItem;
  998. if FileExt = 'LNK' then Item.OverlayIndex := 1;
  999. end;
  1000. if SelectNewFiles then Item.Selected := True;
  1001. Result := Item;
  1002. end; {AddItem}
  1003. procedure TDirView.AddParentDirItem;
  1004. var
  1005. PItem: PFileRec;
  1006. Item: TListItem;
  1007. SRec: SysUtils.TSearchRec;
  1008. begin
  1009. FHasParentDir := True;
  1010. Item := Items.Add;
  1011. New(PItem);
  1012. if FindFirst(FPath, faAnyFile, SRec) = 0 then
  1013. FindClose(SRec);
  1014. with PItem^ do
  1015. begin
  1016. FileName := '..';
  1017. FileExt := '';
  1018. DisplayName := '..';
  1019. Attr := SRec.Attr;
  1020. IsDirectory := True;
  1021. IsRecycleBin := False;
  1022. IsParentDir := True;
  1023. Size := -1;
  1024. Item.Caption := '..';
  1025. {$WARNINGS OFF}
  1026. FileTime := SRec.FindData.ftLastWriteTime;
  1027. {$WARNINGS ON}
  1028. Empty := True;
  1029. IconEmpty := False;
  1030. PIDL := nil;
  1031. Item.Data := PItem;
  1032. if HasExtendedCOMCTL32 then ImageIndex := StdDirIcon
  1033. else ImageIndex := StdDirSelIcon;
  1034. TypeName := SParentDir;
  1035. Empty := False;
  1036. end;
  1037. end; {AddParentDirItem}
  1038. procedure TDirView.LoadFromRecycleBin(Dir: string);
  1039. var
  1040. PIDLRecycleLocal: PItemIDList;
  1041. PCurrList: PItemIDList;
  1042. FQPIDL: PItemIDList;
  1043. EnumList: IEnumIDList;
  1044. Fetched: ULONG;
  1045. SRec: SysUtils.TSearchRec;
  1046. DisplayName: string;
  1047. FullPath: string;
  1048. NewItem: TListItem;
  1049. FileRec: PFileRec;
  1050. FileInfo: TSHFileInfo;
  1051. FileSel: Boolean;
  1052. MaskList: TStringList;
  1053. DosError: Integer;
  1054. AttrIncludeMask: Integer;
  1055. AttrExcludeMask: Integer;
  1056. FileTimeFrom: LongWord;
  1057. FileTimeTo: LongWord;
  1058. procedure AddToMasks(Attr: TSelAttr; Mask: Word);
  1059. begin
  1060. case Attr of
  1061. selYes: AttrIncludeMask := AttrIncludeMask or Mask;
  1062. selNo: AttrExcludeMask := AttrExcludeMask or Mask;
  1063. end;
  1064. end;
  1065. begin
  1066. if not Assigned(iRecycleFolder) then
  1067. begin
  1068. PIDLRecycleLocal := nil;
  1069. try
  1070. OLECheck(shGetSpecialFolderLocation(Self.Handle,
  1071. CSIDL_BITBUCKET, PIDLRecycleLocal));
  1072. PIDLRecycle := PIDL_Concatenate(nil, PIDLRecycleLocal);
  1073. if not SUCCEEDED(FDesktopFolder.BindToObject(PIDLRecycle, nil,
  1074. IID_IShellFolder, Pointer(iRecycleFolder))) then Exit;
  1075. finally
  1076. if Assigned(PIDLRecycleLocal) then
  1077. FreePIDL(PIDLRecycleLocal);
  1078. end;
  1079. end;
  1080. FParentFolder := iRecycleFolder;
  1081. if AddParentDir then AddParentDirItem;
  1082. MaskList := TStringList.Create;
  1083. BuildMask(Mask, MaskList);
  1084. AttrIncludeMask := 0;
  1085. AttrExcludeMask := 0;
  1086. AddToMasks(FSelArchive, SysUtils.faArchive);
  1087. AddToMasks(FSelHidden, SysUtils.faHidden);
  1088. AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
  1089. AddToMasks(FSelSysFile, SysUtils.faSysFile);
  1090. FileTimeFrom := LongWord(FSelFileDateFrom) shl 16 or FSelFileTimeFrom;
  1091. FileTimeTo := LongWord(FSelFileDateTo) shl 16 or FSelFileTimeTo;
  1092. try
  1093. if SUCCEEDED(iRecycleFolder.EnumObjects(Self.Handle,
  1094. SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList)) then
  1095. begin
  1096. while (EnumList.Next(1, PCurrList, Fetched) = S_OK) and not AbortLoading do
  1097. begin
  1098. if Assigned(PCurrList) then
  1099. try
  1100. FQPIDL := PIDL_Concatenate(PIDLRecycle, PCurrList);
  1101. {Physical filename:}
  1102. SetLength(FullPath, MAX_PATH);
  1103. if shGetPathFromIDList(FQPIDL, PChar(FullPath)) then
  1104. SetLength(FullPath, StrLen(PChar(FullPath)));
  1105. {Filesize, attributes and -date:}
  1106. DosError := FindFirst(FullPath, faAnyFile, SRec);
  1107. FindClose(Srec);
  1108. SRec.Name := ExtractFilePath(FullPath) + SRec.Name;
  1109. {Displayname:}
  1110. GetShellDisplayName(iRecycleFolder, PCurrList, SHGDN_FORPARSING, DisplayName);
  1111. FileSel := (DosError = 0);
  1112. if FileSel and not (Bool(SRec.Attr and faDirectory)) then
  1113. begin
  1114. if (AttrIncludeMask <> 0) then
  1115. FileSel := Srec.Attr and AttrIncludeMask >= AttrIncludeMask;
  1116. if FileSel and (AttrExcludeMask <> 0) then
  1117. FileSel := AttrExcludeMask and Srec.Attr = 0;
  1118. FileSel :=
  1119. FileSel and
  1120. (FileMatches(DisplayName, MaskList) and
  1121. (SRec.Size >= FSelFileSizeFrom) and
  1122. ((FSelFileSizeTo = 0) or
  1123. (SRec.Size <= FSelFileSizeTo)) and
  1124. (LongWord(SRec.Time) >= FileTimeFrom) and
  1125. (LongWord(SRec.Time) <= FileTimeTo));
  1126. end;
  1127. if Assigned(FOnAddFile) then
  1128. FOnAddFile(Self, SRec, FileSel);
  1129. if FileSel then
  1130. begin
  1131. {Filetype and icon:}
  1132. SHGetFileInfo(PChar(FQPIDL), 0, FileInfo, SizeOf(FileInfo),
  1133. SHGFI_PIDL or SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1134. NewItem := AddItem(Srec);
  1135. NewItem.Caption := DisplayName;
  1136. FileRec := NewItem.Data;
  1137. FileRec^.Empty := False;
  1138. FileRec^.IconEmpty := False;
  1139. FileRec^.DisplayName := DisplayName;
  1140. FileRec^.PIDL := FQPIDL;
  1141. FileRec^.TypeName := FileInfo.szTypeName;
  1142. if FileRec^.Typename = EmptyStr then
  1143. FileRec^.TypeName := Format(STextFileExt, [FileRec.FileExt]);
  1144. FileRec^.ImageIndex := FileInfo.iIcon;
  1145. {$IFNDEF NO_THREADS}
  1146. if ShowSubDirSize and FileRec^.isDirectory then
  1147. FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
  1148. {$ENDIF}
  1149. end
  1150. else FreePIDL(FQPIDL);
  1151. FreePIDL(PCurrList);
  1152. except
  1153. if Assigned(PCurrList) then
  1154. try
  1155. FreePIDL(PCurrList);
  1156. except
  1157. end;
  1158. end;
  1159. end; {While EnumList ...}
  1160. end;
  1161. finally
  1162. MaskList.Free;
  1163. end;
  1164. end; {LoadFromRecycleBin}
  1165. function TDirView.GetShellFolder(Dir: string): iShellFolder;
  1166. var
  1167. WDir: WideString;
  1168. Eaten: ULONG;
  1169. Attr: ULONG;
  1170. NewPIDL: PItemIDList;
  1171. begin
  1172. Result := nil;
  1173. if not Assigned(FDesktopFolder) then
  1174. ShGetDesktopFolder(FDesktopFolder);
  1175. WDir := Dir;
  1176. if Assigned(FDesktopFolder) then
  1177. begin
  1178. FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil, PWideChar(WDir), Eaten, NewPIDL, Attr);
  1179. try
  1180. assert(Assigned(NewPIDL));
  1181. FDesktopFolder.BindToObject(NewPidl, nil, IID_IShellFolder, Pointer(Result));
  1182. Assert(Assigned(Result));
  1183. finally
  1184. FreePIDL(NewPidl);
  1185. end;
  1186. end;
  1187. end; {GetShellFolder}
  1188. function TDirView.ItemIsDirectory(Item: TListItem): Boolean;
  1189. begin
  1190. Result :=
  1191. (Assigned(Item) and Assigned(Item.Data) and
  1192. PFileRec(Item.Data)^.IsDirectory);
  1193. end;
  1194. function TDirView.ItemIsFile(Item: TListItem): Boolean;
  1195. begin
  1196. Result :=
  1197. (Assigned(Item) and Assigned(Item.Data) and
  1198. (not PFileRec(Item.Data)^.IsParentDir));
  1199. end;
  1200. function TDirView.ItemIsParentDirectory(Item: TListItem): Boolean;
  1201. begin
  1202. Result :=
  1203. (Assigned(Item) and Assigned(Item.Data) and
  1204. PFileRec(Item.Data)^.IsParentDir);
  1205. end;
  1206. function TDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1207. begin
  1208. Result := (Assigned(Item) and Assigned(Item.Data) and
  1209. PFileRec(Item)^.IsRecycleBin);
  1210. end;
  1211. function TDirView.ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean;
  1212. var
  1213. FileRec: PFileRec;
  1214. Modification: TDateTime;
  1215. begin
  1216. Assert(Assigned(Item) and Assigned(Item.Data));
  1217. FileRec := PFileRec(Item.Data);
  1218. if (Filter.ModificationFrom > 0) or (Filter.ModificationTo > 0) then
  1219. Modification := FileTimeToDateTime(FileRec^.FileTime)
  1220. else
  1221. Modification := 0;
  1222. Result :=
  1223. ((FileRec^.Attr and Filter.IncludeAttr) = Filter.IncludeAttr) and
  1224. ((FileRec^.Attr and Filter.ExcludeAttr) = 0) and
  1225. ((not FileRec^.IsDirectory) or Filter.Directories) and
  1226. ((Filter.FileSizeFrom = 0) or (FileRec^.Size >= Filter.FileSizeFrom)) and
  1227. ((Filter.FileSizeTo = 0) or (FileRec^.Size <= Filter.FileSizeTo)) and
  1228. ((Filter.ModificationFrom = 0) or (Modification >= Filter.ModificationFrom)) and
  1229. ((Filter.ModificationTo = 0) or (Modification <= Filter.ModificationTo)) and
  1230. ((Length(Filter.Masks) = 0) or
  1231. FileNameMatchesMasks(FileRec^.FileName, Filter.Masks));
  1232. end;
  1233. function TDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1234. begin
  1235. Result := oiNoOverlay;
  1236. if Assigned(Item) and Assigned(Item.Data) then
  1237. begin
  1238. if PFileRec(Item.Data)^.IsParentDir then
  1239. Inc(Result, oiDirUp);
  1240. if FDrawLinkOverlay and
  1241. (UpperCase(ItemFileExt(Item)) = '.LNK') then
  1242. Inc(Result, oiLink);
  1243. end;
  1244. end;
  1245. procedure TDirView.Load;
  1246. begin
  1247. try
  1248. {$IFNDEF NO_THREADS}
  1249. StopSubDirScanner;
  1250. StopIconUpdateThread;
  1251. StopWatchThread;
  1252. {$ENDIF}
  1253. FChangeTimer.Enabled := False;
  1254. FChangeTimer.Interval := 0;
  1255. inherited;
  1256. finally
  1257. if DirOK and not AbortLoading then
  1258. begin
  1259. {$IFNDEF NO_THREADS}
  1260. if FUseIconUpdateThread and (not IsRecycleBin) then
  1261. StartIconUpdateThread;
  1262. StartWatchThread;
  1263. {$ENDIF}
  1264. end;
  1265. end;
  1266. end;
  1267. procedure TDirView.LoadFiles;
  1268. var
  1269. SRec: SysUtils.TSearchRec;
  1270. DosError: Integer;
  1271. TempMask: string;
  1272. ActMask: string;
  1273. ScanRun: Integer;
  1274. FileSel: Boolean;
  1275. FileList: TStringList;
  1276. Dummy: Integer;
  1277. FSize: Int64;
  1278. {$IFNDEF NO_THREADS}
  1279. NewItem: TListItem;
  1280. {$ENDIF}
  1281. AttrIncludeMask: Integer;
  1282. AttrExcludeMask: Integer;
  1283. FileTimeFrom: LongWord;
  1284. FileTimeTo: LongWord;
  1285. {$IFDEF USE_DRIVEVIEW}
  1286. DirsCount: Integer;
  1287. SelTreeNode: TTreeNode;
  1288. Node: TTreeNode;
  1289. {$ENDIF}
  1290. procedure AddToMasks(Attr: TSelAttr; Mask: Word);
  1291. begin
  1292. case Attr of
  1293. selYes: AttrIncludeMask := AttrIncludeMask or Mask;
  1294. selNo: AttrExcludeMask := AttrExcludeMask or Mask;
  1295. end;
  1296. end;
  1297. begin
  1298. AttrIncludeMask := 0;
  1299. AttrExcludeMask := 0;
  1300. AddToMasks(FSelArchive, SysUtils.faArchive);
  1301. AddToMasks(FSelHidden, SysUtils.faHidden);
  1302. AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
  1303. AddToMasks(FSelSysFile, SysUtils.faSysFile);
  1304. FileTimeFrom := LongWord(fSelFileDateFrom) shl 16 or fSelFileTimeFrom;
  1305. FileTimeTo := LongWord(fSelFileDateTo) shl 16 or fSelFileTimeTo;
  1306. ScanRun := 0;
  1307. try
  1308. if Length(FPath) > 0 then
  1309. begin
  1310. {$IFDEF USE_DRIVEVIEW}
  1311. if not Assigned(FDriveView) then
  1312. {$ENDIF}
  1313. DriveInfo.ReadDriveStatus(FPath[1], dsSize);
  1314. FDriveType := DriveInfo[FPath[1]].DriveType;
  1315. end
  1316. else FDriveType := DRIVE_UNKNOWN;
  1317. FDirOK := (Length(FPath) > 0) and
  1318. DriveInfo[FPath[1]].DriveReady and DirExists(FPath);
  1319. if DirOK then
  1320. begin
  1321. {$IFDEF USE_DRIVEVIEW}
  1322. if Assigned(FDriveView) then
  1323. SelTreeNode := TDriveView(FDriveView).FindNodeToPath(FPath)
  1324. else SelTreeNode := nil;
  1325. {$ENDIF}
  1326. {$IFDEF USE_DRIVEVIEW}
  1327. if Assigned(FDriveView) and Assigned(SelTreeNode) then
  1328. FIsRecycleBin := TNodeData(SelTreeNode.Data).IsRecycleBin
  1329. else
  1330. {$ENDIF}
  1331. FIsRecycleBin :=
  1332. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLED') or
  1333. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLER');
  1334. if not Assigned(FDesktopFolder) then
  1335. shGetDesktopFolder(FDesktopFolder);
  1336. {$IFNDEF PHYSICALRECYCLEBIN}
  1337. if IsRecycleBin then LoadFromRecycleBin(Path)
  1338. else
  1339. {$ENDIF}
  1340. begin
  1341. FParentFolder := GetShellFolder(PathName);
  1342. TempMask := Mask;
  1343. FileList := TStringList.Create;
  1344. while (Length(TempMask) > 0) and (not AbortLoading) do
  1345. begin
  1346. ActMask := GetNextMask(TempMask);
  1347. Inc(ScanRun);
  1348. //ItemsAdded := 0;
  1349. if Assigned(FileList) and (Length(TempMask) > 0) then
  1350. FileList.Sort;
  1351. DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + ActMask,
  1352. FileAttr, SRec);
  1353. while (DosError = 0) and (not AbortLoading) do
  1354. begin
  1355. FileSel := True;
  1356. FSize := SizeFromSRec(SRec);
  1357. if AttrIncludeMask <> 0 then
  1358. FileSel := (SRec.Attr and AttrIncludeMask) >= AttrIncludeMask;
  1359. if FileSel and (AttrExcludeMask <> 0) then
  1360. FileSel := ((AttrExcludeMask and Srec.Attr) = 0);
  1361. if FileSel and
  1362. ((SRec.Attr and faDirectory) = 0) and
  1363. (FSize >= FSelFileSizeFrom) and
  1364. ((FSelFileSizeTo = 0) or (FSize <= FSelFileSizeTo)) and
  1365. (LongWord(SRec.Time) >= FileTimeFrom) and
  1366. (LongWord(SRec.Time) <= FileTimeTo) then
  1367. begin
  1368. if Assigned(OnAddFile) then
  1369. FOnAddFile(Self, SRec, FileSel);
  1370. if FileSel then
  1371. begin
  1372. if (ScanRun = 1) or
  1373. ((ScanRun > 1) and not FileList.Find(SRec.Name, Dummy)) then
  1374. begin
  1375. AddItem(SRec);
  1376. if Length(TempMask) > 0 then
  1377. FileList.Add(SRec.Name);
  1378. end;
  1379. end;
  1380. end;
  1381. DosError := FindNext(SRec);
  1382. end;
  1383. SysUtils.FindClose(SRec);
  1384. end; {Length (TempMask) > 0}
  1385. if AddParentDir and (Length(FPath) > 2) then
  1386. AddParentDirItem;
  1387. {Search for directories:}
  1388. {$IFDEF USE_DRIVEVIEW}
  1389. DirsCount := 0;
  1390. {$ENDIF}
  1391. if ShowDirectories then
  1392. Begin
  1393. DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + '*.*',
  1394. DirAttrMask, SRec);
  1395. while (DosError = 0) and (not AbortLoading) do
  1396. begin
  1397. FileSel := True;
  1398. if AttrIncludeMask <> 0 then
  1399. FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
  1400. if FileSel and (AttrExcludeMask <> 0) then
  1401. FileSel := ((AttrExcludeMask and SRec.Attr) = 0);
  1402. if (SRec.Name <> '.') and (SRec.Name <> '..') and
  1403. ((Srec.Attr and faDirectory) <> 0) then
  1404. begin
  1405. {$IFDEF USE_DRIVEVIEW}
  1406. Inc(DirsCount);
  1407. {$ENDIF}
  1408. if Assigned(OnAddFile) then
  1409. OnAddFile(Self, SRec, FileSel);
  1410. if FileSel then
  1411. begin
  1412. {$IFNDEF NO_THREADS}
  1413. NewItem :=
  1414. {$ENDIF}
  1415. AddItem(Srec);
  1416. {$IFNDEF NO_THREADS}
  1417. if ShowSubDirSize then
  1418. FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
  1419. {$ENDIF}
  1420. end;
  1421. end;
  1422. DosError := FindNext(SRec);
  1423. end;
  1424. SysUtils.FindClose(SRec);
  1425. {$IFDEF USE_DRIVEVIEW}
  1426. {Update TDriveView's subdir indicator:}
  1427. if Assigned(FDriveView) and (FDriveType = DRIVE_REMOTE) then
  1428. with FDriveView as TDriveView do
  1429. begin
  1430. Node := FindNodeToPath(PathName);
  1431. if Assigned(Node) and Assigned(Node.Data) and
  1432. not TNodeData(Node.Data).Scanned then
  1433. begin
  1434. if DirsCount = 0 then
  1435. begin
  1436. Node.HasChildren := False;
  1437. TNodeData(Node.Data).Scanned := True;
  1438. end;
  1439. end;
  1440. end;
  1441. {$ENDIF}
  1442. end; {If FShowDirectories}
  1443. if Assigned(FileList) then
  1444. FileList.Free;
  1445. end; {not isRecycleBin}
  1446. end
  1447. else FIsRecycleBin := False;
  1448. finally
  1449. //if Assigned(Animate) then Animate.Free;
  1450. SetLength(ActMask, 0);
  1451. FInfoCacheList.Sort(CompareInfoCacheItems);
  1452. end; {Finally}
  1453. end;
  1454. procedure TDirView.Reload2;
  1455. type
  1456. PEFileRec = ^TEFileRec;
  1457. TEFileRec = record
  1458. iSize: Int64;
  1459. iAttr: Integer;
  1460. iFileTime: TFileTime;
  1461. iIndex: Integer;
  1462. end;
  1463. var
  1464. Index: Integer;
  1465. EItems: TStringList;
  1466. FItems: TStringList;
  1467. NewItems: TStringList;
  1468. {$IFNDEF NO_THREADS}
  1469. NewItem: TListItem;
  1470. {$ENDIF}
  1471. Srec: SysUtils.TSearchRec;
  1472. DosError: Integer;
  1473. PSrec: ^SysUtils.TSearchRec;
  1474. Dummy: Integer;
  1475. ItemIndex: Integer;
  1476. PUpdate: Boolean;
  1477. PEFile: PEFileRec;
  1478. SaveCursor: TCursor;
  1479. TempMask: string;
  1480. ActMask: string;
  1481. FileTimeFrom: LongWord;
  1482. FileTimeTo: LongWord;
  1483. AttrIncludeMask: Integer;
  1484. AttrExcludeMask: Integer;
  1485. FileSel: Boolean;
  1486. FSize: Int64;
  1487. procedure AddToMasks(Attr: TSelAttr; Mask: Word);
  1488. begin
  1489. case Attr of
  1490. selYes: AttrIncludeMask := AttrIncludeMask or Mask;
  1491. selNo: AttrExcludeMask := AttrExcludeMask or Mask;
  1492. end;
  1493. end;
  1494. begin
  1495. if not Loading then
  1496. begin
  1497. IF IsRecycleBin then Reload(True)
  1498. else
  1499. begin
  1500. if not DirExists(Path) then
  1501. begin
  1502. ClearItems;
  1503. FDirOK := False;
  1504. end
  1505. else
  1506. begin
  1507. SaveCursor := Screen.Cursor;
  1508. Screen.Cursor := crHourGlass;
  1509. FChangeTimer.Enabled := False;
  1510. FChangeTimer.Interval := 0;
  1511. EItems := TStringlist.Create;
  1512. FItems := TStringlist.Create;
  1513. NewItems := TStringlist.Create;
  1514. PUpdate := False;
  1515. TempMask := Mask;
  1516. AttrIncludeMask := 0;
  1517. AttrExcludeMask := 0;
  1518. AddToMasks(FSelArchive, SysUtils.faArchive);
  1519. AddToMasks(FSelHidden, SysUtils.faHidden);
  1520. AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
  1521. AddToMasks(FSelSysFile, SysUtils.faSysFile);
  1522. FileTimeFrom := LongWord(fSelFileDateFrom) shl 16 or fSelFileTimeFrom;
  1523. FileTimeTo := LongWord(fSelFileDateTo) shl 16 or fSelFileTimeTo;
  1524. try
  1525. {Store existing files and directories:}
  1526. for Index := 0 to Items.Count - 1 do
  1527. begin
  1528. New(PEFile);
  1529. with PFileRec(Items[Index].Data)^ do
  1530. begin
  1531. PEFile^.iSize := Size;
  1532. PEFile^.iAttr := Attr;
  1533. PEFile^.iFileTime := FileTime;
  1534. PEFile^.iIndex := Index;
  1535. end;
  1536. EItems.AddObject(PFileRec(Items[Index].Data)^.FileName, Pointer(PEFile));
  1537. end;
  1538. EItems.Sort;
  1539. {Search new or changed files:}
  1540. while Length(TempMask) > 0 do
  1541. begin
  1542. ActMask := GetNextMask(TempMask);
  1543. if Length(TempMask) > 0 then FItems.Sort;
  1544. DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + ActMask,
  1545. FileAttr, SRec);
  1546. while DosError = 0 do
  1547. begin
  1548. FileSel := True;
  1549. if (AttrIncludeMask <> 0) then
  1550. FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
  1551. if FileSel and (AttrExcludeMask <> 0) then
  1552. FileSel := ((AttrExcludeMask and Srec.Attr) = 0);
  1553. if FileSel and
  1554. ((SRec.Attr and faDirectory) = 0) and
  1555. (SRec.Size >= FSelFileSizeFrom) and
  1556. ((FSelFileSizeTo = 0) or (SRec.Size <= FSelFileSizeTo)) and
  1557. (LongWord(SRec.Time) >= FileTimeFrom) and
  1558. (LongWord(SRec.Time) <= FileTimeTo) then
  1559. begin
  1560. ItemIndex := -1;
  1561. if not EItems.Find(SRec.Name, ItemIndex) then
  1562. begin
  1563. if Assigned(OnAddFile) then
  1564. FOnAddFile(Self, Srec, FileSel);
  1565. if FileSel then
  1566. begin
  1567. New(PSrec);
  1568. PSRec^ := SRec;
  1569. NewItems.AddObject(SRec.Name, Pointer(PSrec));
  1570. end;
  1571. end
  1572. else
  1573. begin
  1574. FSize := SizeFromSRec(SRec);
  1575. with PEFileRec(EItems.Objects[ItemIndex])^ do
  1576. {$WARNINGS OFF}
  1577. if (iSize <> FSize) or (iAttr <> SRec.Attr) or
  1578. not CompareMem(@iFileTime, @SRec.FindData.ftLastWriteTime,
  1579. SizeOf(iFileTime)) Then
  1580. {$WARNINGS ON}
  1581. begin
  1582. with PFileRec(Items[iIndex].Data)^ do
  1583. begin
  1584. Dec(FFilesSize, Size);
  1585. Inc(FFilesSize, FSize);
  1586. if Items[iIndex].Selected then
  1587. begin
  1588. Dec(FFilesSelSize, Size);
  1589. Inc(FFilesSelSize, FSize);
  1590. end;
  1591. Size := FSize;
  1592. Attr := SRec.Attr;
  1593. {$WARNINGS OFF}
  1594. FileTime := SRec.FindData.ftLastWriteTime;
  1595. {$WARNINGS ON}
  1596. if (iSize <> FSize) and Assigned(OnFileSizeChanged) then
  1597. OnFileSizeChanged(Self, Items[iIndex]);
  1598. end;
  1599. if not PUpdate then
  1600. begin
  1601. PUpdate := True;
  1602. Items.BeginUpdate;
  1603. end;
  1604. end;
  1605. end;
  1606. end;
  1607. FItems.Add(Srec.Name);
  1608. DosError := FindNext(Srec);
  1609. end;
  1610. SysUtils.FindClose(Srec);
  1611. end;
  1612. {Search new directories:}
  1613. if ShowDirectories then
  1614. begin
  1615. DosError := SysUtils.FindFirst(FPath + '\*.*', DirAttrMask, SRec);
  1616. while DosError = 0 do
  1617. begin
  1618. FileSel := True;
  1619. if AttrIncludeMask <> 0 then
  1620. FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
  1621. if FileSel and (AttrExcludeMask <> 0) then
  1622. FileSel := ((AttrExcludeMask and SRec.Attr) = 0);
  1623. if (SRec.Name <> '.') and (SRec.Name <> '..') and
  1624. ((Srec.Attr and faDirectory) <> 0) then
  1625. begin
  1626. if not EItems.Find(SRec.Name, ItemIndex) then
  1627. begin
  1628. if Assigned(FOnAddFile) then
  1629. FOnAddFile(Self, SRec, FileSel);
  1630. if FileSel then
  1631. begin
  1632. New(PSrec);
  1633. PSrec^ := SRec;
  1634. NewItems.AddObject(Srec.Name, Pointer(PSrec));
  1635. end;
  1636. end;
  1637. end;
  1638. FItems.Add(SRec.Name);
  1639. DosError := FindNext(SRec);
  1640. end;
  1641. SysUtils.FindClose(SRec);
  1642. End; {If FShowDirectories}
  1643. {Check wether displayed Items still exists:}
  1644. FItems.Sort;
  1645. for Index := Items.Count - 1 downto 0 do
  1646. Begin
  1647. if not FItems.Find(PFileRec(Items[Index].Data)^.FileName, Dummy) then
  1648. begin
  1649. if not PUpdate then
  1650. begin
  1651. PUpdate := True;
  1652. Items.BeginUpdate;
  1653. end;
  1654. Items[Index].Delete;
  1655. end;
  1656. end;
  1657. finally
  1658. try
  1659. for Index := 0 to EItems.Count - 1 do
  1660. Dispose(PEFileRec(EItems.Objects[Index]));
  1661. EItems.Free;
  1662. FItems.Free;
  1663. for Index := 0 to NewItems.Count - 1 do
  1664. begin
  1665. if not PUpdate then
  1666. begin
  1667. PUpdate := True;
  1668. Items.BeginUpdate;
  1669. end;
  1670. PSrec := Pointer(NewItems.Objects[Index]);
  1671. {$IFNDEF NO_THREADS}
  1672. NewItem :=
  1673. {$ENDIF}
  1674. AddItem(PSrec^);
  1675. {$IFNDEF NO_THREADS}
  1676. if ShowSubDirSize and ((PSrec^.Attr and faDirectory) <> 0) then
  1677. FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
  1678. {$ENDIF}
  1679. Dispose(PSrec);
  1680. end;
  1681. NewItems.Free;
  1682. if PUpdate then
  1683. begin
  1684. if SortAfterUpdate then
  1685. SortItems;
  1686. Items.EndUpdate;
  1687. end;
  1688. finally
  1689. FDirOK := True;
  1690. {$IFNDEF NO_THREADS}
  1691. IF fUseIconUpdateThread And (not FisRecycleBin) Then
  1692. StartIconUpdateThread;
  1693. StartWatchThread;
  1694. {$ENDIF}
  1695. IF Assigned(ItemFocused) Then
  1696. ItemFocused.MakeVisible(False);
  1697. IF PUpdate And Assigned(OnDirUpdated) Then
  1698. OnDirUpdated(Self);
  1699. Screen.Cursor := SaveCursor;
  1700. End;
  1701. End; {Finally}
  1702. End;
  1703. end;
  1704. end;
  1705. end; {Reload2}
  1706. procedure TDirView.PerformItemDragDropOperation(Item: TListItem; Effect: Integer);
  1707. begin
  1708. if Assigned(Item) then
  1709. begin
  1710. if Assigned(Item.Data) then
  1711. begin
  1712. if ItemIsParentDirectory(Item) then
  1713. PerformDragDropFileOperation(ExcludeTrailingPathDelimiter(ExtractFilePath(Path)),
  1714. Effect, False)
  1715. else
  1716. PerformDragDropFileOperation(IncludeTrailingPathDelimiter(PathName) +
  1717. ItemFileName(Item), Effect, False);
  1718. end;
  1719. end
  1720. else
  1721. PerformDragDropFileOperation(PathName, Effect,
  1722. DDOwnerIsSource and (Effect = DropEffect_Copy));
  1723. end;
  1724. procedure TDirView.ReLoad(CacheIcons: Boolean);
  1725. begin
  1726. if not FLoadEnabled then FDirty := True
  1727. else inherited;
  1728. end; {ReLoad}
  1729. procedure TDirView.ClearIconCache;
  1730. begin
  1731. if Assigned(FInfoCacheList) then
  1732. FInfoCacheList.Clear;
  1733. end; {ClearIconCache}
  1734. function TDirView.FormatFileTime(FileTime: TFileTime): string;
  1735. begin
  1736. Result := FormatDateTime(DateTimeFormatStr,
  1737. FileTimeToDateTime(FileTime));
  1738. end; {FormatFileTime}
  1739. function TDirView.GetAttrString(Attr: Integer): string;
  1740. const
  1741. Attrs: array[1..5] of Integer =
  1742. (FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_ARCHIVE,
  1743. FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_HIDDEN,
  1744. FILE_ATTRIBUTE_READONLY);
  1745. AttrChars: array[1..5] of Char = ('c', 'a', 's', 'h', 'r');
  1746. var
  1747. Index: Integer;
  1748. LowBound: Integer;
  1749. begin
  1750. Result := '';
  1751. if Attr <> 0 then
  1752. begin
  1753. LowBound := Low(Attrs);
  1754. if Win32PlatForm <> VER_PLATFORM_WIN32_NT then
  1755. Inc(LowBound);
  1756. for Index := LowBound to High(Attrs) do
  1757. if (Attr and Attrs[Index] <> 0) then
  1758. Result := Result + AttrChars[Index]
  1759. else
  1760. Result := Result + FAttrSpace;
  1761. end;
  1762. end; {GetAttrString}
  1763. procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  1764. var
  1765. FileInfo: TShFileInfo;
  1766. Index: Integer;
  1767. PExtItem: PInfoCache;
  1768. CacheItem: TInfoCache;
  1769. IsSpecialExt: Boolean;
  1770. WStr: WideString;
  1771. Eaten: ULONG;
  1772. shAttr: ULONG;
  1773. begin
  1774. Assert(Assigned(Item) and Assigned(Item.Data));
  1775. with PFileRec(Item.Data)^ do
  1776. begin
  1777. IsSpecialExt := MatchesFileExt(FileExt, SpecialExtensions);
  1778. if FUseIconCache and not IsSpecialExt and not IsDirectory then
  1779. begin
  1780. CacheItem.FileExt := FileExt;
  1781. Index := FInfoCacheList.FindSequential(Addr(CacheItem), CompareInfoCacheItems);
  1782. if Index >= 0 then
  1783. begin
  1784. TypeName := PInfoCache(FInfoCacheList[Index])^.TypeName;
  1785. ImageIndex := PInfoCache(FInfoCacheList[Index])^.ImageIndex;
  1786. Empty := False;
  1787. IconEmpty := False;
  1788. end;
  1789. end;
  1790. FetchIcon := IconEmpty and (FetchIcon or not IsSpecialExt);
  1791. if Empty or FetchIcon then
  1792. begin
  1793. if FetchIcon then
  1794. begin
  1795. {Fetch the Item FQ-PIDL:}
  1796. if not Assigned(PIDL) and IsSpecialExt then
  1797. begin
  1798. try
  1799. WStr := FPath + '\' + FileName;
  1800. FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil,
  1801. PWideChar(WStr), Eaten, PIDL, ShAttr);
  1802. {Retrieve the shell display attributes for directories:}
  1803. if IsDirectory and Assigned(PIDL) then
  1804. begin
  1805. shAttr := SFGAO_DISPLAYATTRMASK;
  1806. try
  1807. if Assigned(ParentFolder) and
  1808. Succeeded(ParentFolder.GetAttributesOf(1, PIDL, shAttr)) then
  1809. begin
  1810. if (shAttr and SFGAO_SHARE) <> 0 then
  1811. Item.OverlayIndex := 0;
  1812. end;
  1813. except end;
  1814. end;
  1815. except end;
  1816. end;
  1817. if IsDirectory then
  1818. begin
  1819. if FDriveType = DRIVE_FIXED then
  1820. begin
  1821. try
  1822. {Retrieve icon and typename for the directory}
  1823. if Assigned(PIDL) then
  1824. SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo),
  1825. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  1826. else
  1827. SHGetFileInfo(PChar(FPath + '\' + FileName), 0, FileInfo, SizeOf(FileInfo),
  1828. SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1829. if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
  1830. {Invalid icon returned: retry with access file attribute flag:}
  1831. SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY,
  1832. FileInfo, SizeOf(FileInfo),
  1833. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  1834. TypeName := FileInfo.szTypeName;
  1835. if FetchIcon then
  1836. begin
  1837. ImageIndex := FileInfo.iIcon;
  1838. IconEmpty := False;
  1839. end;
  1840. {Capture exceptions generated by the shell}
  1841. except
  1842. ImageIndex := StdDirIcon;
  1843. IconEmpty := False;
  1844. end; {Except}
  1845. end
  1846. else
  1847. begin
  1848. TypeName := StdDirTypeName;
  1849. ImageIndex := StdDirIcon;
  1850. IconEmpty := False;
  1851. end;
  1852. end
  1853. else
  1854. begin
  1855. {Retrieve icon and typename for the file}
  1856. try
  1857. if Assigned(PIDL) then
  1858. SHGetFileInfo(PChar(PIDL), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1859. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  1860. else
  1861. SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1862. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  1863. TypeName := FileInfo.szTypeName;
  1864. ImageIndex := FileInfo.iIcon;
  1865. IconEmpty := False;
  1866. {Capture exceptions generated by the shell}
  1867. except
  1868. ImageIndex := UnKnownFileIcon;
  1869. IconEmpty := False;
  1870. end; {Except}
  1871. end;
  1872. if (Length(TypeName) > 0) then
  1873. begin
  1874. {Fill FileInfoCache:}
  1875. if FUseIconCache and not IsSpecialExt and not IconEmpty and not IsDirectory then
  1876. begin
  1877. GetMem(PExtItem, SizeOf(TInfoCache));
  1878. PExtItem.FileExt := FileExt;
  1879. PExtItem.TypeName := TypeName;
  1880. PExtItem.ImageIndex := ImageIndex;
  1881. FInfoCacheList.Add(PExtItem);
  1882. end;
  1883. end
  1884. else TypeName := Format(STextFileExt, [FileExt]);
  1885. end {If FetchIcon}
  1886. else
  1887. begin
  1888. try
  1889. if IsDirectory then
  1890. shGetFileInfo(PChar(fPath), FILE_ATTRIBUTE_DIRECTORY, FileInfo, SizeOf(FileInfo),
  1891. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES)
  1892. else
  1893. shGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1894. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  1895. TypeName := FileInfo.szTypeName;
  1896. except
  1897. {Capture exceptions generated by the shell}
  1898. TypeName := '';
  1899. end;
  1900. if IconEmpty then
  1901. begin
  1902. if FileExt = ExeExtension then ImageIndex := DefaultExeIcon
  1903. else ImageIndex := UnKnownFileIcon;
  1904. end;
  1905. end;
  1906. Empty := False;
  1907. end;
  1908. end;
  1909. end; {GetDisplayData}
  1910. function TDirView.GetDirOK: Boolean;
  1911. begin
  1912. Result := FDirOK;
  1913. end;
  1914. function TDirView.ItemFullFileName(Item: TListItem): string;
  1915. begin
  1916. if Assigned(Item) and Assigned(Item.Data) then
  1917. begin
  1918. if not IsRecycleBin then
  1919. begin
  1920. if PFileRec(Item.Data)^.IsParentDir then
  1921. Result := ExcludeTrailingBackslash(ExtractFilePath(FPath))
  1922. else
  1923. Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
  1924. end
  1925. else
  1926. Result := PFileRec(Item.Data)^.FileName;
  1927. end
  1928. else
  1929. Result := EmptyStr;
  1930. end; {ItemFullFileName}
  1931. function TDirView.ItemFileNameOnly(Item: TListItem): string;
  1932. begin
  1933. Assert(Assigned(Item) and Assigned(Item.Data));
  1934. Result := PFileRec(Item.Data)^.FileName;
  1935. SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
  1936. end; {ItemFileNameOnly}
  1937. function TDirView.ItemFileExt(Item: TListItem): string;
  1938. begin
  1939. Assert(Assigned(Item) and Assigned(Item.Data));
  1940. Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
  1941. end; {ItemFileExt}
  1942. procedure TDirView.SetMask(Value: string);
  1943. var
  1944. LastMask: string;
  1945. begin
  1946. LastMask := Mask;
  1947. inherited SetMask(Value);
  1948. if LastMask <> Mask then Reload(True);
  1949. end; {SetMask}
  1950. function TDirView.DeleteSelectedFiles(AllowUndo: Boolean): Boolean;
  1951. const
  1952. MaxSel = 10;
  1953. var
  1954. StartIndex: Integer;
  1955. ItemIndex: Integer;
  1956. Index: Integer;
  1957. FileOperator: TFileOperator;
  1958. UpdateEnabled: Boolean;
  1959. WatchDir: Boolean;
  1960. Updating: Boolean;
  1961. {$IFDEF USE_DRIVEVIEW}
  1962. DirDeleted: Boolean;
  1963. {$ENDIF}
  1964. begin
  1965. AllowUndo := AllowUndo and (not IsRecycleBin);
  1966. {$IFDEF USE_DRIVEVIEW}
  1967. DirDeleted := False;
  1968. {$IFNDEF NO_THREADS}
  1969. if Assigned(FDriveView) then
  1970. TDriveView(FDriveView).StopWatchThread;
  1971. {$ENDIF}
  1972. {$ENDIF}
  1973. WatchDir := WatchForChanges;
  1974. WatchForChanges := False;
  1975. UpdateEnabled := (SelCount < MaxSel);
  1976. if not UpdateEnabled then Items.BeginUpdate;
  1977. FileOperator := TFileOperator.Create(Self);
  1978. try
  1979. ItemIndex := Selected.Index;
  1980. FileOperator.Operation := foDelete;
  1981. FileOperator.Flags := [foNoConfirmMkDir];
  1982. FileOperator.ProgressTitle := coFileOperatorTitle;
  1983. CreateFileList(False, True, FileOperator.OperandFrom);
  1984. if not ConfirmDelete then
  1985. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1986. if AllowUndo then
  1987. FileOperator.Flags := FileOperator.Flags + [foAllowUndo];
  1988. {$IFNDEF NO_THREADS}
  1989. StopIconUpdateThread;
  1990. StopSubDirScanner;
  1991. {$ENDIF}
  1992. Result := FileOperator.Execute;
  1993. Result := Result and (not FileOperator.OperationAborted);
  1994. Sleep(0);
  1995. Updating := False;
  1996. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
  1997. while Index >= 0 do
  1998. begin
  1999. case PFileRec(Items[Index].Data)^.IsDirectory of
  2000. True:
  2001. if not DirExists(ItemFullFileName(Items[Index])) then
  2002. begin
  2003. {$IFDEF USE_DRIVEVIEW}
  2004. DirDeleted := True;
  2005. {$ENDIF}
  2006. Items[Index].Delete;
  2007. Dec(Index);
  2008. end;
  2009. False:
  2010. if not CheckFileExists(ItemFullFileName(Items[Index])) then
  2011. begin
  2012. if (SelCount > 3) and (not Updating) then
  2013. begin
  2014. Items.BeginUpdate;
  2015. Updating := True;
  2016. end;
  2017. Items[Index].Delete;
  2018. Dec(Index);
  2019. end;
  2020. end;
  2021. StartIndex := Index;
  2022. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
  2023. end;
  2024. if Updating then
  2025. Items.EndUpdate;
  2026. finally
  2027. if not UpdateEnabled then
  2028. Items.EndUpdate;
  2029. FileOperator.Free;
  2030. if Assigned(OnDirUpdated) then
  2031. OnDirUpdated(Self);
  2032. end;
  2033. {$IFDEF USE_DRIVEVIEW}
  2034. if Assigned(DriveView) then
  2035. with TDriveView(DriveView) do
  2036. begin
  2037. if DirDeleted and Assigned(Selected) then
  2038. ValidateDirectory(Selected);
  2039. {$IFNDEF NO_THREADS}
  2040. TDriveView(fDriveView).StartWatchThread;
  2041. {$ENDIF}
  2042. end;
  2043. {$ENDIF}
  2044. {$IFNDEF NO_THREADS}
  2045. if UseIconUpdateThread then StartIconUpdateThread;
  2046. if ShowSubDirSize then StartSubDirScanner;
  2047. {$ENDIF}
  2048. WatchForChanges := WatchDir;
  2049. if (not Assigned(Selected)) and (Items.Count > 0) then
  2050. Selected := Items[Min(ItemIndex, Pred(Items.Count))];
  2051. end; {DeleteSelectedFiles}
  2052. Function CompareFileName (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
  2053. Var P1, P2 : PFileRec;
  2054. Begin
  2055. If I1 = I2 then Result := fEqual else
  2056. If I1 = NIL then Result := fLess else
  2057. If I2 = NIL then Result := fGreater else
  2058. Begin
  2059. P1 := PFileRec(I1.Data);
  2060. P2 := PFileRec(I2.Data);
  2061. IF P1.isParentDir Then
  2062. Begin
  2063. Result := fLess;
  2064. Exit;
  2065. End
  2066. Else IF P2.isParentDir Then
  2067. Begin
  2068. Result := fGreater;
  2069. Exit;
  2070. End;
  2071. {Directories allways should appear "grouped":}
  2072. IF P1.isDirectory <> P2.isDirectory Then
  2073. Begin
  2074. IF P1.isDirectory Then
  2075. Begin
  2076. Result := fLess;
  2077. IF AOwner.DirsOnTop Then
  2078. Exit;
  2079. End
  2080. Else
  2081. Begin
  2082. Result := fGreater;
  2083. IF AOwner.DirsOnTop Then
  2084. Exit;
  2085. End;
  2086. End
  2087. Else
  2088. Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
  2089. End;
  2090. IF Not AOwner.SortAscending Then
  2091. Result := -Result;
  2092. End; {CompareFileName}
  2093. function CompareFileSize(I1, I2: TListItem; AOwner : TDirView): Integer; stdcall;
  2094. var
  2095. P1, P2: PFileRec;
  2096. begin
  2097. if I1 = I2 then Result := fEqual
  2098. else
  2099. if I1 = nil then Result := fLess
  2100. else
  2101. if I2 = nil then Result := fGreater
  2102. else
  2103. begin
  2104. P1 := PFileRec(I1.Data);
  2105. P2 := PFileRec(I2.Data);
  2106. if P1.isParentDir then
  2107. begin
  2108. Result := fLess;
  2109. Exit;
  2110. end
  2111. else
  2112. if P2.isParentDir then
  2113. begin
  2114. Result := fGreater;
  2115. Exit;
  2116. end;
  2117. {Directories always should appear "grouped":}
  2118. if P1.isDirectory <> P2.isDirectory then
  2119. begin
  2120. if P1.isDirectory then
  2121. begin
  2122. Result := fLess;
  2123. if AOwner.DirsOnTop then Exit;
  2124. end
  2125. else
  2126. begin
  2127. Result := fGreater;
  2128. if AOwner.DirsOnTop then Exit;
  2129. end;
  2130. end
  2131. else
  2132. begin
  2133. if P1.Size < P2.Size then Result := fLess
  2134. else
  2135. if P1.Size > P2.Size then Result := fGreater
  2136. else
  2137. Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
  2138. end;
  2139. end;
  2140. if not AOwner.SortAscending then
  2141. Result := -Result;
  2142. end; {CompareFileSize}
  2143. Function CompareFileType (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
  2144. Var P1, P2 : PFileRec;
  2145. Begin
  2146. If I1 = I2 then Result := fEqual else
  2147. If I1 = NIL then Result := fLess else
  2148. If I2 = NIL then Result := fGreater else
  2149. begin
  2150. P1 := PFileRec(I1.Data);
  2151. P2 := PFileRec(I2.Data);
  2152. IF P1.isParentDir Then
  2153. Begin
  2154. Result := fLess;
  2155. Exit;
  2156. End
  2157. Else IF P2.isParentDir Then
  2158. Begin
  2159. Result := fGreater;
  2160. Exit;
  2161. End;
  2162. {Directories allways should appear "grouped":}
  2163. IF P1.isDirectory <> P2.isDirectory Then
  2164. Begin
  2165. IF P1.isDirectory Then
  2166. Begin
  2167. Result := fLess;
  2168. IF AOwner.DirsOnTop Then
  2169. Exit;
  2170. End
  2171. Else
  2172. Begin
  2173. Result := fGreater;
  2174. IF AOwner.DirsOnTop Then
  2175. Exit;
  2176. End;
  2177. End
  2178. Else
  2179. Begin
  2180. IF P1.Empty Then TDirView(I1.ListView).GetDisplayData(I1, False);
  2181. IF P2.Empty Then TDirView(I2.ListView).GetDisplayData(I2, False);
  2182. Result := lstrcmpi(PChar(P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName),
  2183. PChar(P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName));
  2184. End;
  2185. End;
  2186. IF Not AOwner.SortAscending Then
  2187. Result := -Result;
  2188. End; {CompareFileType}
  2189. Function CompareFileExt (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
  2190. Var P1, P2 : PFileRec;
  2191. Begin
  2192. If I1 = I2 then Result := fEqual else
  2193. If I1 = NIL then Result := fLess else
  2194. If I2 = NIL then Result := fGreater else
  2195. begin
  2196. P1 := PFileRec(I1.Data);
  2197. P2 := PFileRec(I2.Data);
  2198. IF P1.isParentDir Then
  2199. Begin
  2200. Result := fLess;
  2201. Exit;
  2202. End
  2203. Else IF P2.isParentDir Then
  2204. Begin
  2205. Result := fGreater;
  2206. Exit;
  2207. End;
  2208. {Directories allways should appear "grouped":}
  2209. IF P1.isDirectory <> P2.isDirectory Then
  2210. Begin
  2211. IF P1.isDirectory Then
  2212. Begin
  2213. Result := fLess;
  2214. IF AOwner.DirsOnTop Then
  2215. Exit;
  2216. End
  2217. Else
  2218. Begin
  2219. Result := fGreater;
  2220. IF AOwner.DirsOnTop Then
  2221. Exit;
  2222. End;
  2223. End
  2224. Else
  2225. Result := lstrcmpi(PChar(P1.FileExt + ' ' + P1.DisplayName),
  2226. PChar(P2.FileExt + ' ' + P2.DisplayName));
  2227. End;
  2228. IF Not AOwner.SortAscending Then
  2229. Result := -Result;
  2230. End; {CompareFileExt}
  2231. Function CompareFileAttr (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
  2232. Var P1, P2 : PFileRec;
  2233. Begin
  2234. if I1 = I2 then Result := 0 else
  2235. if I1 = NIL then Result := -1 else
  2236. if I2 = NIL then Result := 1 else
  2237. begin
  2238. P1 := PFileRec(I1.Data);
  2239. P2 := PFileRec(I2.Data);
  2240. IF P1.isParentDir Then
  2241. Begin
  2242. Result := fLess;
  2243. Exit;
  2244. End
  2245. Else IF P2.isParentDir Then
  2246. Begin
  2247. Result := fGreater;
  2248. Exit;
  2249. End;
  2250. {Directories allways should appear "grouped":}
  2251. IF P1.isDirectory <> P2.isDirectory Then
  2252. Begin
  2253. IF P1.isDirectory Then
  2254. Begin
  2255. Result := fLess;
  2256. IF AOwner.DirsOnTop Then
  2257. Exit;
  2258. End
  2259. Else
  2260. Begin
  2261. Result := fGreater;
  2262. IF AOwner.DirsOnTop Then
  2263. Exit;
  2264. End;
  2265. End
  2266. Else
  2267. Begin
  2268. IF P1.Attr < P2.Attr Then Result := fLess Else
  2269. IF P1.Attr > P2.Attr Then Result := fGreater Else
  2270. Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
  2271. End;
  2272. End;
  2273. IF Not AOwner.SortAscending Then
  2274. Result := -Result;
  2275. End; {CompareFileAttr}
  2276. Function CompareFileTime (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
  2277. Var Time1, Time2 : Int64;
  2278. P1, P2 : PFileRec;
  2279. Begin
  2280. If I1 = I2 then Result := fEqual else
  2281. If I1 = NIL then Result := fLess else
  2282. If I2 = NIL then Result := fGreater else
  2283. begin
  2284. P1 := PFileRec(I1.Data);
  2285. P2 := PFileRec(I2.Data);
  2286. IF P1.isParentDir Then
  2287. Begin
  2288. Result := fLess;
  2289. Exit;
  2290. End
  2291. Else IF P2.isParentDir Then
  2292. Begin
  2293. Result := fGreater;
  2294. Exit;
  2295. End;
  2296. {Directories allways should appear "grouped":}
  2297. IF P1.isDirectory <> P2.isDirectory Then
  2298. Begin
  2299. IF P1.isDirectory Then
  2300. Begin
  2301. Result := fLess;
  2302. IF AOwner.DirsOnTop Then
  2303. Exit;
  2304. End
  2305. Else
  2306. Begin
  2307. Result := fGreater;
  2308. IF AOwner.DirsOnTop Then
  2309. Exit;
  2310. End;
  2311. End
  2312. Else
  2313. Begin
  2314. Time1 := Int64(P1.FileTime.dwHighDateTime) Shl 32 + P1.FileTime.dwLowDateTime;
  2315. Time2 := Int64(P2.FileTime.dwHighDateTime) Shl 32 + P2.FileTime.dwLowDateTime;
  2316. IF Time1 < Time2 Then Result := fLess Else
  2317. IF Time1 > Time2 Then Result := fGreater Else
  2318. Result := CompareFileName(I1, I2, AOwner);
  2319. End;
  2320. End;
  2321. IF Not AOwner.SortAscending Then
  2322. Result := -Result;
  2323. End; {CompareFileTime}
  2324. procedure TDirView.SortItems;
  2325. var
  2326. SortProc: TLVCompare;
  2327. begin
  2328. if HandleAllocated then
  2329. begin
  2330. {$IFNDEF NO_THREADS}
  2331. StopIconUpdateThread;
  2332. {$ENDIF}
  2333. try
  2334. case DirColProperties.SortDirColumn of
  2335. dvName: SortProc := @CompareFilename;
  2336. dvSize: SortProc := @CompareFileSize;
  2337. dvType: if not SortByExtension then SortProc := @CompareFileType
  2338. else SortProc := @CompareFileExt;
  2339. dvChanged: SortProc := @CompareFileTime;
  2340. dvAttr: SortProc := @CompareFileAttr;
  2341. dvExt: { !!!!!} SortProc := @CompareFileExt;
  2342. else SortProc := @CompareFilename;
  2343. end;
  2344. CustomSortItems(Pointer(@SortProc));
  2345. finally
  2346. {$IFNDEF NO_THREADS}
  2347. if (not Loading) and FUseIconUpdateThread then
  2348. StartIconUpdateThread;
  2349. {$ENDIF}
  2350. end;
  2351. end
  2352. end;
  2353. procedure TDirView.ValidateFile(Item : TListItem);
  2354. var
  2355. Index: Integer;
  2356. begin
  2357. if Assigned(Item) and Assigned(Item.Data) then
  2358. begin
  2359. Index := Item.Index;
  2360. if not FileExists(ItemFullFileName(Items[Index])) then
  2361. begin
  2362. Item.Delete;
  2363. if Assigned(OnDirUpdated) then
  2364. OnDirUpdated(Self);
  2365. end;
  2366. end;
  2367. end; {ValidateFile}
  2368. procedure TDirView.ValidateFile(FileName: TFileName);
  2369. var
  2370. FilePath: string;
  2371. begin
  2372. FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  2373. if IsRecycleBin then ValidateFile(FindFileItem(FileName))
  2374. else
  2375. if FilePath = Path then
  2376. ValidateFile(FindFileItem(ExtractFileName(FileName)));
  2377. end; {ValidateFile}
  2378. Procedure TDirView.ValidateSelectedFiles;
  2379. Var i : Integer;
  2380. StartIndex : Integer;
  2381. Upd : Boolean;
  2382. LastCount : Integer;
  2383. Begin
  2384. IF SelCount > 50 Then
  2385. Begin
  2386. Reload2;
  2387. Exit;
  2388. End;
  2389. Upd := False;
  2390. LastCount := Items.Count;
  2391. Try
  2392. i := ListView_GetNextItem(Handle, -1, LVNI_ALL Or LVNI_SELECTED);
  2393. While i >= 0 Do
  2394. Begin
  2395. Case PFileRec(Items[i].Data)^.isDirectory Of
  2396. True: Begin
  2397. If Not DirExists(ItemFullFileName(Items[i])) Then
  2398. Begin
  2399. Items[i].Delete;
  2400. Dec(i);
  2401. End;
  2402. End;
  2403. False: IF Not FileExists(ItemFullFileName(Items[i])) Then
  2404. Begin
  2405. IF (SelCount > 10) And Not Upd Then
  2406. Begin
  2407. Items.BeginUpdate;
  2408. Upd := True;
  2409. End;
  2410. Items[i].Delete;
  2411. Dec(i);
  2412. End;
  2413. End;
  2414. StartIndex := i;
  2415. i := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_SELECTED);
  2416. End;
  2417. Finally
  2418. IF Upd Then
  2419. Items.EndUpdate;
  2420. IF (LastCount <> Items.Count) And Assigned(OnDirUpdated) Then
  2421. OnDirUpdated(Self);
  2422. End;
  2423. End; {ValidateSelectedFiles}
  2424. function TDirView.CreateFile(NewName: string): TListItem;
  2425. var
  2426. F: file;
  2427. SRec: SysUtils.TSearchRec;
  2428. begin
  2429. Result := nil;
  2430. {Neue Datei anlegen:}
  2431. NewName := Path + '\' + NewName;
  2432. {Ermitteln des neuen Dateinamens:}
  2433. if not FileExists(NewName) then
  2434. begin
  2435. {$IFNDEF NO_THREADS}
  2436. if FWatchForChanges then
  2437. StopWatchThread;
  2438. StopIconUpdateThread;
  2439. {$ENDIF}
  2440. try
  2441. {Create the desired file as empty file:}
  2442. AssignFile(F, NewName);
  2443. Rewrite(F);
  2444. LastIOResult := IOResult;
  2445. if LastIOResult = 0 then
  2446. begin
  2447. CloseFile(F);
  2448. {Anlegen der Datei als TListItem:}
  2449. if FindFirst(NewName, faAnyFile, SRec) = 0 then
  2450. begin
  2451. Result := AddItem(SRec);
  2452. ItemFocused := FindFileItem(GetFileRec(Result.Index)^.FileName);
  2453. if Assigned(ItemFocused) then
  2454. ItemFocused.MakeVisible(False);
  2455. if Assigned(OnDirUpdated) then
  2456. OnDirUpdated(Self);
  2457. end;
  2458. FindClose(Srec);
  2459. end;
  2460. finally
  2461. {$IFNDEF NO_THREADS}
  2462. if FUseIconUpdateThread then
  2463. StartIconUpdateThread;
  2464. if WatchForChanges then
  2465. StartWatchThread;
  2466. {$ENDIF}
  2467. end;
  2468. end
  2469. else LastIOResult := 183;
  2470. end; {CreateFile}
  2471. procedure TDirView.CreateDirectory(DirName: string);
  2472. var
  2473. SRec: SysUtils.TSearchRec;
  2474. Item: TListItem;
  2475. begin
  2476. DirName := Path + '\' + DirName;
  2477. {Ermitteln des neuen Dateinamens:}
  2478. if FileOrDirExists(DirName) then LastIOResult := 183
  2479. else
  2480. begin
  2481. {$IFNDEF NO_THREADS}
  2482. if WatchForChanges then StopWatchThread;
  2483. {$IFDEF USE_DRIVEVIEW}
  2484. if Assigned(FDriveView) then
  2485. TDriveView(FDriveView).StopWatchThread;
  2486. {$ENDIF}
  2487. StopIconUpdateThread;
  2488. {$ENDIF}
  2489. try
  2490. {create the phyical directory:}
  2491. if Windows.CreateDirectory(PChar(DirName), nil) then LastIOResult := 0 // MP
  2492. else LastIOResult := GetLastError;
  2493. if LastIOResult = 0 then
  2494. begin
  2495. {Create the TListItem:}
  2496. if FindFirst(DirName, faAnyFile, SRec) = 0 then
  2497. begin
  2498. Item := AddItem(SRec);
  2499. ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
  2500. SortItems;
  2501. if Assigned(ItemFocused) then
  2502. ItemFocused.MakeVisible(False);
  2503. if Assigned(OnDirUpdated) then
  2504. OnDirUpdated(Self);
  2505. end;
  2506. FindClose(SRec);
  2507. end;
  2508. finally
  2509. {$IFNDEF NO_THREADS}
  2510. if FUseIconUpdateThread then
  2511. StartIconUpdateThread;
  2512. if WatchForChanges then StartWatchThread;
  2513. {$ENDIF}
  2514. {$IFDEF USE_DRIVEVIEW}
  2515. if Assigned(FDriveView) then
  2516. with FDriveView as TDriveView do
  2517. if not WatchThreadActive and Assigned(Selected) then
  2518. ValidateDirectory(Selected);
  2519. {$ENDIF}
  2520. end;
  2521. end;
  2522. end; {CreateDirectory}
  2523. procedure TDirView.DisplayContextMenu(Where: TPoint);
  2524. var
  2525. FileList : TStringList;
  2526. Index: Integer;
  2527. DefDir: string;
  2528. Verb: string;
  2529. PIDLArray: PPIDLArray;
  2530. Count: Integer;
  2531. DiffSelectedPath: Boolean;
  2532. WithEdit: Boolean;
  2533. StartIndex: Integer;
  2534. PIDLRel: PItemIDList;
  2535. PIDLPath: PItemIDList;
  2536. Handled: Boolean;
  2537. begin
  2538. GetDir(0, DefDir);
  2539. ChDir(PathName);
  2540. Verb := EmptyStr;
  2541. {$IFNDEF NO_THREADS}
  2542. StopWatchThread;
  2543. {$ENDIF}
  2544. try
  2545. if Assigned(OnContextPopup) then
  2546. begin
  2547. Handled := False;
  2548. OnContextPopup(Self, ScreenToClient(Where), Handled);
  2549. if Handled then Abort;
  2550. end;
  2551. if (MarkedCount > 1) and
  2552. ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
  2553. begin
  2554. if FIsRecycleBin then
  2555. begin
  2556. Count := 0;
  2557. GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
  2558. try
  2559. FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
  2560. for Index := Selected.Index to Items.Count - 1 do
  2561. if Items[Index].Selected then
  2562. begin
  2563. PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
  2564. FreePIDL(PIDLPath);
  2565. PIDLArray^[Count] := PIDLRel;
  2566. Inc(Count);
  2567. end;
  2568. try
  2569. ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
  2570. PidlArray^[0], False, Verb, False);
  2571. finally
  2572. for Index := 0 to Count - 1 do
  2573. FreePIDL(PIDLArray[Index]);
  2574. end;
  2575. finally
  2576. FreeMem(PIDLArray, Count);
  2577. end;
  2578. end
  2579. else
  2580. begin
  2581. FileList := TStringList.Create;
  2582. CreateFileList(False, True, FileList);
  2583. for Index := 0 to FileList.Count - 1 do
  2584. FileList[Index] := ExtractFileName(FileList[Index]);
  2585. ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
  2586. FileList, Verb, False);
  2587. FileList.Destroy;
  2588. end;
  2589. {------------ Cut -----------}
  2590. if Verb = shcCut then
  2591. begin
  2592. LastClipBoardOperation := cboCut;
  2593. {Clear items previous marked as cut:}
  2594. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
  2595. while Index >= 0 do
  2596. begin
  2597. Items[Index].Cut := False;
  2598. StartIndex := Index;
  2599. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_CUT);
  2600. end;
  2601. {Set property cut to TRUE for all selected items:}
  2602. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
  2603. while Index >= 0 do
  2604. begin
  2605. Items[Index].Cut := True;
  2606. StartIndex := Index;
  2607. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_SELECTED);
  2608. end;
  2609. end
  2610. else
  2611. {----------- Copy -----------}
  2612. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2613. else
  2614. {----------- Paste ----------}
  2615. if Verb = shcPaste then
  2616. PasteFromClipBoard(ItemFullFileName(Selected))
  2617. else
  2618. if not FIsRecycleBin then Reload2;
  2619. end
  2620. else
  2621. if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
  2622. begin
  2623. Verb := EmptyStr;
  2624. WithEdit := not FisRecycleBin and CanEdit(ItemFocused);
  2625. LoadEnabled := True;
  2626. if FIsRecycleBin then
  2627. begin
  2628. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2629. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2630. iRecycleFolder, 1, PIDLRel, False, Verb, False);
  2631. FreePIDL(PIDLRel);
  2632. FreePIDL(PIDLPath);
  2633. end
  2634. else
  2635. begin
  2636. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2637. ItemFullFileName(ItemFocused), WithEdit, Verb,
  2638. not PFileRec(ItemFocused.Data)^.isDirectory);
  2639. LoadEnabled := True;
  2640. end; {not FisRecycleBin}
  2641. {---------- Rename ----------}
  2642. if Verb = shcRename then ItemFocused.EditCaption
  2643. else
  2644. {------------ Cut -----------}
  2645. if Verb = shcCut then
  2646. begin
  2647. LastClipBoardOperation := cboCut;
  2648. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
  2649. while Index >= 0 do
  2650. begin
  2651. Items[Index].Cut := False;
  2652. StartIndex := Index;
  2653. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_CUT);
  2654. end;
  2655. ItemFocused.Cut := True;
  2656. end
  2657. else
  2658. {----------- Copy -----------}
  2659. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2660. else
  2661. {----------- Paste ----------}
  2662. if Verb = shcPaste then
  2663. begin
  2664. if PFileRec(ItemFocused.Data)^.IsDirectory then
  2665. PasteFromClipBoard(ItemFullFileName(ItemFocused));
  2666. end
  2667. else
  2668. if not FIsRecycleBin then Reload2;
  2669. end;
  2670. ChDir(DefDir);
  2671. if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
  2672. begin
  2673. DiffSelectedPath := False;
  2674. for Index := Selected.Index to Items.Count - 1 do
  2675. if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
  2676. begin
  2677. DiffSelectedPath := True;
  2678. Break;
  2679. end;
  2680. if DiffSelectedPath then
  2681. begin
  2682. {$IFNDEF NO_THREADS}
  2683. StartFileDeleteThread;
  2684. {$ENDIF}
  2685. Exit;
  2686. end;
  2687. end;
  2688. if Win32PlatForm = VER_PLATFORM_WIN32_NT then Sleep(250);
  2689. ValidateSelectedFiles;
  2690. finally
  2691. {$IFNDEF NO_THREADS}
  2692. StartWatchThread;
  2693. {$ENDIF}
  2694. end;
  2695. end;
  2696. procedure TDirView.GetDisplayInfo(ListItem: TListItem;
  2697. var DispInfo: TLVItem);
  2698. begin
  2699. Assert(Assigned(ListItem) and Assigned(ListItem.Data));
  2700. with PFileRec(ListItem.Data)^, DispInfo do
  2701. begin
  2702. {Fetch display data of current file:}
  2703. if Empty then
  2704. GetDisplayData(ListItem, IconEmpty and
  2705. (not FUseIconUpdateThread or
  2706. ((ViewStyle <> vsReport) and (Win32PlatForm = VER_PLATFORM_WIN32_NT))));
  2707. if IconEmpty and
  2708. (not FUseIconUpdateThread or
  2709. ((ViewStyle <> vsReport) and (Win32PlatForm = VER_PLATFORM_WIN32_NT))) and
  2710. ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2711. GetDisplayData(ListItem, True);
  2712. {Set IconUpdatethread :}
  2713. {$IFNDEF NO_THREADS}
  2714. if IconEmpty and Assigned(FIconUpdateThread) then
  2715. begin
  2716. if Assigned(TopItem) then
  2717. {Viewstyle is vsReport or vsList:}
  2718. FIconUpdateThread.Index := Self.TopItem.Index
  2719. else
  2720. {Viewstyle is vsIcon or vsSmallIcon:}
  2721. FIconUpdateThread.MaxIndex := ListItem.Index;
  2722. if FIconUpdateThread.Suspended and not FIsRecycleBin then
  2723. FIconUpdateThread.Resume;
  2724. end;
  2725. {$ENDIF}
  2726. if (DispInfo.Mask and LVIF_TEXT) <> 0 then
  2727. begin
  2728. if iSubItem = 0 then StrPLCopy(pszText, DisplayName, cchTextMax)
  2729. else
  2730. if iSubItem < DirViewColumns then
  2731. begin
  2732. case TDirViewCol(iSubItem) of
  2733. dvSize: {Size: }
  2734. if not IsDirectory or
  2735. (IsDirectory and ShowSubDirSize and (Size >= 0)) then
  2736. StrPLCopy(pszText, FormatSize(Size), cchTextMax);
  2737. dvType: {FileType: }
  2738. if SortByExtension and (not IsDirectory) then
  2739. begin
  2740. case FFileNameDisplay of
  2741. fndNoCap, fndNice: StrPLCopy(pszText, LowerCase(FileExt), cchTextMax);
  2742. else StrPLCopy(pszText, FileExt, cchTextMax);
  2743. end; {Case}
  2744. end
  2745. else StrPLCopy(pszText, TypeName, cchTextMax);
  2746. dvChanged: {Date}
  2747. StrPLCopy(pszText, FormatFileTime(FileTime), cchTextMax);
  2748. dvAttr: {Attrs:}
  2749. if FFileNameDisplay = fndCap then
  2750. StrPLCopy(pszText, UpperCase(GetAttrString(Attr)), cchTextMax)
  2751. else
  2752. StrPLCopy(pszText, GetAttrString(Attr), cchTextMax);
  2753. dvExt:
  2754. StrPLCopy(pszText, FileExt, cchTextMax);
  2755. end {Case}
  2756. end {SubItem}
  2757. else pszText[0] := #0;
  2758. end;
  2759. {Set display icon of current file:}
  2760. if (iSubItem = 0) and ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2761. begin
  2762. iImage := PFileRec(ListItem.Data).ImageIndex;
  2763. Mask := Mask or LVIF_DI_SETITEM;
  2764. end;
  2765. end; {With PFileRec Do}
  2766. {Mask := Mask Or LVIF_DI_SETITEM; {<== causes flickering display and icons not to be updated on renaming the item}
  2767. end;
  2768. function TDirView.ItemColor(Item: TListItem): TColor;
  2769. begin
  2770. if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
  2771. Result := FCompressedColor
  2772. else
  2773. if DimmHiddenFiles and not Item.Selected and
  2774. (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
  2775. Result := clGrayText
  2776. else
  2777. Result := clDefaultItemColor;
  2778. end;
  2779. {$IFNDEF NO_THREADS}
  2780. procedure TDirView.StartFileDeleteThread;
  2781. var
  2782. Files: TStringList;
  2783. begin
  2784. Files := TStringList.Create;
  2785. try
  2786. CreateFileList(False, True, Files);
  2787. TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
  2788. finally
  2789. Files.Free;
  2790. end;
  2791. end;
  2792. procedure TDirView.StartIconUpdateThread;
  2793. begin
  2794. if DirOK then
  2795. begin
  2796. if not Assigned(FIconUpdateThread) then
  2797. begin
  2798. if Items.Count > 0 then
  2799. FIconUpdateThread := TIconUpdateThread.Create(Self);
  2800. end
  2801. else
  2802. begin
  2803. Assert(not FIconUpdateThread.Terminated);
  2804. FIconUpdateThread.Index := 0;
  2805. if ViewStyle = vsReport then
  2806. FIconUpdateThread.Resume;
  2807. end;
  2808. end;
  2809. end; {StartIconUpdateThread}
  2810. procedure TDirView.StartSubDirScanner;
  2811. var
  2812. Index: Integer;
  2813. begin
  2814. if not (csDesigning in ComponentState) and
  2815. DirOk and ShowDirectories and ShowSubDirSize then
  2816. for Index := 0 to Items.Count - 1 do
  2817. with PFileRec(Items[Index].Data)^ do
  2818. if IsDirectory and not isParentDir then
  2819. FSubDirScanner.Add(TSubDirScanner.Create(Self, Items[Index]));
  2820. end; {StartSubDirScanner}
  2821. procedure TDirView.StopSubDirScanner;
  2822. var
  2823. Index: Integer;
  2824. begin
  2825. for Index := 0 To FSubDirScanner.Count - 1 do
  2826. if Assigned(FSubDirScanner[Index]) then
  2827. with TSubDirScanner(FSubDirScanner[Index]) do
  2828. begin
  2829. Priority := tpHigher;
  2830. Resume;
  2831. Terminate;
  2832. end;
  2833. Application.ProcessMessages;
  2834. end; {StopSubDirScanner}
  2835. procedure TDirView.StopIconUpdateThread;
  2836. var
  2837. Counter: Integer;
  2838. begin
  2839. if Assigned(FIconUpdateThread) then
  2840. begin
  2841. Counter := 0;
  2842. FIconUpdateThread.Terminate;
  2843. FIconUpdateThread.Priority := tpHigher;
  2844. if fIconUpdateThread.Suspended then
  2845. FIconUpdateThread.Resume;
  2846. Sleep(0);
  2847. try
  2848. {Wait until the thread has teminated to prevent AVs:}
  2849. while not FIUThreadFinished do
  2850. begin
  2851. Sleep(10);
  2852. Application.ProcessMessages;
  2853. Inc(Counter);
  2854. {Raise an exception after 2 second, if the thread has not terminated:}
  2855. if Counter = 200 then
  2856. begin
  2857. {MP}raise EIUThread.Create(SIconUpdateThreadTerminationError);
  2858. Break;
  2859. end;
  2860. end;
  2861. finally
  2862. FIconUpdateThread.Destroy;
  2863. FIconUpdateThread := nil;
  2864. end;
  2865. end;
  2866. end; {StopIconUpdateThread}
  2867. procedure TDirView.StopWatchThread;
  2868. begin
  2869. if Assigned(FDiscMonitor) then
  2870. begin
  2871. FDiscMonitor.Free;
  2872. FDiscMonitor := nil;
  2873. end;
  2874. end; {StopWatchThread}
  2875. procedure TDirView.StartWatchThread;
  2876. begin
  2877. if (Length(Path) > 0) and WatchForChanges and DirOK and
  2878. (Pos(Path[1], NoCheckDrives) = 0) then
  2879. begin
  2880. if not Assigned(FDiscMonitor) then
  2881. begin
  2882. FDiscMonitor := TDiscMonitor.Create(Self);
  2883. with FDiscMonitor do
  2884. begin
  2885. ChangeDelay := msThreadChangeDelay;
  2886. SubTree := False;
  2887. Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
  2888. Directory := PathName;
  2889. OnChange := ChangeDetected;
  2890. OnInvalid := ChangeInvalid;
  2891. Open;
  2892. end;
  2893. end
  2894. else
  2895. begin
  2896. FDiscMonitor.Directory := PathName;
  2897. FDiscMonitor.Open;
  2898. end;
  2899. end
  2900. end; {StartWatchThread}
  2901. {$ENDIF}
  2902. procedure TDirView.TimerOnTimer(Sender: TObject);
  2903. begin
  2904. if not Loading then
  2905. begin
  2906. // fix by MP: disable timer and reload directory before call to event
  2907. FChangeTimer.Enabled := False;
  2908. FChangeTimer.Interval := 0;
  2909. Reload2;
  2910. if Assigned(FOnChangeDetected) then
  2911. FOnChangeDetected(Self);
  2912. end
  2913. end; {TimerOnTimer}
  2914. procedure TDirView.ChangeDetected(Sender: TObject);
  2915. begin
  2916. FDirty := True;
  2917. FChangeTimer.Enabled := False;
  2918. FChangeTimer.Interval := 0;
  2919. FChangeTimer.Interval := FChangeInterval;
  2920. FChangeTimer.Enabled := True;
  2921. end; {ChangeDetected}
  2922. procedure TDirView.ChangeInvalid(Sender: TObject);
  2923. begin
  2924. FDiscMonitor.Close;
  2925. if Assigned(FOnChangeInvalid) then
  2926. FOnChangeInvalid(Self);
  2927. end; {ChangeInvalid}
  2928. procedure TDirView.Syncronize;
  2929. begin
  2930. Application.ProcessMessages;
  2931. FChangeTimer.Enabled := False;
  2932. FChangeTimer.Interval := 0;
  2933. LoadEnabled := True;
  2934. if Dirty then Reload2;
  2935. end; {Syncronize}
  2936. {$IFNDEF NO_THREADS}
  2937. function TDirView.WatchThreadActive: Boolean;
  2938. Begin
  2939. Result := WatchForChanges and Assigned(FDiscMonitor) and
  2940. FDiscMonitor.Active;
  2941. end; {WatchThreadActive}
  2942. {$ENDIF}
  2943. procedure TDirView.SetChangeInterval(Value: Cardinal);
  2944. begin
  2945. if Value > 0 then
  2946. begin
  2947. FChangeInterval := Value;
  2948. FChangeTimer.Interval := Value;
  2949. end;
  2950. end; {SetChangeInterval}
  2951. procedure TDirView.SetFileNameDisplay(Value: TFileNameDisplay);
  2952. begin
  2953. if Value <> FileNameDisplay then
  2954. begin
  2955. FFileNameDisplay := Value;
  2956. if DirOK then Reload(True);
  2957. end;
  2958. end; {SetFileNameDisplay}
  2959. procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
  2960. begin
  2961. if Value <> ColProperties then
  2962. ColProperties := Value;
  2963. end;
  2964. function TDirView.GetDirColProperties: TDirViewColProperties;
  2965. begin
  2966. Result := TDirViewColProperties(ColProperties);
  2967. end;
  2968. procedure TDirView.SetShowSubDirSize(Value: Boolean);
  2969. begin
  2970. if Value <> ShowSubDirSize then
  2971. begin
  2972. inherited;
  2973. if Value then
  2974. begin
  2975. {$IFNDEF NO_THREADS}
  2976. if ShowDirectories then
  2977. StartSubDirScanner;
  2978. {$ENDIF}
  2979. end
  2980. else
  2981. begin
  2982. {$IFNDEF NO_THREADS}
  2983. StopSubDirScanner;
  2984. {$ENDIF}
  2985. Invalidate;
  2986. end;
  2987. end;
  2988. end; {SetShowSubDirSize}
  2989. procedure TDirView.SetWatchForChanges(Value: Boolean);
  2990. begin
  2991. if WatchForChanges <> Value then
  2992. begin
  2993. FWatchForChanges := Value;
  2994. if not (csDesigning in ComponentState) then
  2995. begin
  2996. {$IFNDEF NO_THREADS}
  2997. if Value then StartWatchThread
  2998. else StopWatchThread;
  2999. {$ENDIF}
  3000. end;
  3001. end;
  3002. end; {SetWatchForChanges}
  3003. procedure TDirView.DisplayPropertiesMenu;
  3004. var
  3005. FileList: TStringList;
  3006. Index: Integer;
  3007. PIDLRel: PItemIDList;
  3008. PIDLPath: PItemIDList;
  3009. begin
  3010. if not Assigned(ItemFocused) then
  3011. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
  3012. else
  3013. if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
  3014. begin
  3015. FileList := TStringList.Create;
  3016. try
  3017. CreateFileList(False, True, FileList);
  3018. for Index := 0 to Pred(FileList.Count) do
  3019. FileList[Index] := ExtractFileName(FileList[Index]);
  3020. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  3021. PathName, FileList);
  3022. finally
  3023. FileList.Free;
  3024. end;
  3025. end
  3026. else
  3027. if Assigned(ItemFocused.Data) then
  3028. begin
  3029. if IsRecycleBin then
  3030. begin
  3031. if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
  3032. begin
  3033. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  3034. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
  3035. FreePIDL(PIDLRel);
  3036. FreePIDL(PIDLPath);
  3037. end;
  3038. end
  3039. else
  3040. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  3041. ItemFullFileName(ItemFocused));
  3042. end;
  3043. end;
  3044. procedure TDirView.ExecuteFile(Item: TListItem);
  3045. var
  3046. DefDir: string;
  3047. FileName: string;
  3048. {$IFDEF USE_DRIVEVIEW}
  3049. Node: TTreeNode;
  3050. {$ENDIF}
  3051. begin
  3052. if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
  3053. PFileRec(Item.Data)^.IsDirectory then
  3054. begin
  3055. if PFileRec(Item.Data)^.IsDirectory then
  3056. begin
  3057. FileName := ItemFullFileName(Item);
  3058. if not DirExists(FileName) then
  3059. begin
  3060. Reload2;
  3061. {$IFDEF USE_DRIVEVIEW}
  3062. if Assigned(FDriveView) and Assigned(TDriveView(FDriveView).Selected) then
  3063. with FDriveView as TDriveView do
  3064. ValidateDirectory(Selected);
  3065. {$ENDIF}
  3066. Exit;
  3067. end;
  3068. end
  3069. else
  3070. FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
  3071. if DirExists(FileName) then
  3072. begin
  3073. {$IFDEF USE_DRIVEVIEW}
  3074. if Assigned(FDriveView) then
  3075. with (FDriveView as TDriveView) do
  3076. begin
  3077. Node := FindNodeToPath(FileName);
  3078. if not Assigned(Node) then
  3079. begin
  3080. ValidateDirectory(GetDriveStatus(FileName[1]).RootNode);
  3081. Node := FindNodeToPath(FileName);
  3082. end;
  3083. if Assigned(Node) then
  3084. begin
  3085. Directory := FileName;
  3086. CenterNode(Selected);
  3087. end;
  3088. Exit;
  3089. end
  3090. else
  3091. {$ENDIF}
  3092. begin
  3093. Path := FileName;
  3094. Exit;
  3095. end;
  3096. end
  3097. else
  3098. if not FileExists(FileName) then Exit;
  3099. end;
  3100. GetDir(0, DefDir);
  3101. ChDir(PathName);
  3102. try
  3103. ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
  3104. ItemFullFileName(Item));
  3105. finally
  3106. ChDir(DefDir);
  3107. end;
  3108. end;
  3109. procedure TDirView.ExecuteHomeDirectory;
  3110. begin
  3111. Path := HomeDirectory;
  3112. end;
  3113. procedure TDirView.ExecuteParentDirectory;
  3114. begin
  3115. if Valid then
  3116. begin
  3117. {$IFDEF USE_DRIVEVIEW}
  3118. if Assigned(DriveView) and Assigned(TDriveView(DriveView).Selected) then
  3119. TDriveView(DriveView).Selected := TDriveView(DriveView).Selected.Parent
  3120. else
  3121. {$ENDIF}
  3122. Path := ExtractFilePath(Path);
  3123. end;
  3124. end;
  3125. procedure TDirView.ExecuteRootDirectory;
  3126. begin
  3127. if Valid then
  3128. try
  3129. FLastPath := PathName;
  3130. FPath := ExtractFileDrive(Path);
  3131. Load;
  3132. finally
  3133. PathChanged;
  3134. end;
  3135. end;
  3136. procedure TDirView.Delete(Item: TListItem);
  3137. begin
  3138. if Assigned(Item) and Assigned(Item.Data) then
  3139. with PFileRec(Item.Data)^ do
  3140. begin
  3141. SetLength(FileName, 0);
  3142. SetLength(TypeName, 0);
  3143. SetLength(DisplayName, 0);
  3144. if Assigned(PIDL) then FreePIDL(PIDL);
  3145. Dispose(PFileRec(Item.Data));
  3146. Item.Data := nil;
  3147. end;
  3148. inherited Delete(Item);
  3149. end; {Delete}
  3150. procedure TDirView.InternalEdit(const HItem: TLVItem);
  3151. var
  3152. Item: TListItem;
  3153. Info: string;
  3154. NewCaption: string;
  3155. {$IFDEF USE_DRIVEVIEW}
  3156. IsDirectory: Boolean;
  3157. {$ENDIF}
  3158. begin
  3159. Item := GetItemFromHItem(HItem);
  3160. {$IFDEF USE_DRIVEVIEW}
  3161. IsDirectory := DirExists(ItemFullFileName(Item));
  3162. {$ENDIF}
  3163. NewCaption := HItem.pszText;
  3164. {$IFNDEF NO_THREADS}
  3165. StopWatchThread;
  3166. {$IFDEF USE_DRIVEVIEW}
  3167. if IsDirectory and Assigned(FDriveView) then
  3168. TDriveView(FDriveView).StopWatchThread;
  3169. {$ENDIF}
  3170. {$ENDIF}
  3171. with FFileOperator do
  3172. begin
  3173. Flags := [foAllowUndo, foNoConfirmation];
  3174. Operation := foRename;
  3175. OperandFrom.Clear;
  3176. OperandTo.Clear;
  3177. OperandFrom.Add(ItemFullFileName(Item));
  3178. OperandTo.Add(fPath + '\' + HItem.pszText);
  3179. end;
  3180. try
  3181. if FFileOperator.Execute then
  3182. begin
  3183. {$IFDEF USE_DRIVEVIEW}
  3184. if IsDirectory and Assigned(FDriveView) then
  3185. with (FDriveView as TDriveView) do
  3186. if Assigned(Selected) then
  3187. ValidateDirectory(Selected);
  3188. {$ENDIF}
  3189. with GetFileRec(Item.Index)^ do
  3190. begin
  3191. Empty := True;
  3192. IconEmpty := True;
  3193. FileName := NewCaption;
  3194. DisplayName := FileName;
  3195. FileExt := UpperCase(Copy(ExtractFileExt(HItem.pszText), 2, Pred(ExtLen)));
  3196. TypeName := EmptyStr;
  3197. if Assigned(PIDL) then
  3198. FreePIDL(PIDL);
  3199. end;
  3200. GetDisplayData(Item, True);
  3201. ResetItemImage(Item.Index);
  3202. UpdateItems(Item.Index, Item.Index);
  3203. if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
  3204. if Item <> nil then Item.Caption := NewCaption;
  3205. SortItems;
  3206. if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
  3207. end
  3208. else
  3209. begin
  3210. Item.Caption := GetFileRec(Item.Index)^.FileName;
  3211. Item.Update;
  3212. if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
  3213. Info := SErrorRenameFileExists + HItem.pszText
  3214. else
  3215. Info := SErrorRenameFile + HItem.pszText;
  3216. MessageBeep(MB_ICONHAND);
  3217. if MessageDlg(Info, mtError, [mbOK, mbAbort], 0) = mrOK then
  3218. RetryRename(HItem.pszText);
  3219. end;
  3220. finally
  3221. Sleep(0);
  3222. LoadEnabled := True;
  3223. {$IFNDEF NO_THREADS}
  3224. if FWatchForChanges and (not WatchThreadActive) then
  3225. StartWatchThread;
  3226. {$IFDEF USE_DRIVEVIEW}
  3227. if Assigned(FDriveView) then
  3228. TDriveView(FDriveView).StartWatchThread;
  3229. {$ENDIF}
  3230. {$ENDIF}
  3231. end;
  3232. end;
  3233. function TDirView.ItemFileName(Item: TListItem): string;
  3234. begin
  3235. if Assigned(Item) and Assigned(Item.Data) then
  3236. Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
  3237. else
  3238. Result := '';
  3239. end;
  3240. function TDirView.ItemFileSize(Item: TListItem): Int64;
  3241. begin
  3242. Result := 0;
  3243. if Assigned(Item) and Assigned(Item.Data) then
  3244. with PFileRec(Item.Data)^ do
  3245. if Size >= 0 then Result := Size;
  3246. end;
  3247. function TDirView.ItemFileTime(Item: TListItem): TDateTime;
  3248. begin
  3249. Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
  3250. end;
  3251. function TDirView.ItemImageIndex(Item: TListItem;
  3252. Cache: Boolean): Integer;
  3253. begin
  3254. if Assigned(Item) and Assigned(Item.Data) then
  3255. begin
  3256. if PFileRec(Item.Data)^.IconEmpty then
  3257. begin
  3258. if Cache then Result := -1
  3259. else Result := UnknownFileIcon;
  3260. end
  3261. else
  3262. begin
  3263. if (not Cache) or (Pos(PFileRec(Item.Data)^.FileExt, SpecialExtensions) <> 0) then
  3264. Result := PFileRec(Item.Data)^.ImageIndex
  3265. else
  3266. Result := -1
  3267. end;
  3268. end
  3269. else Result := -1;
  3270. end;
  3271. {$IFDEF USE_DRIVEVIEW}
  3272. procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
  3273. begin
  3274. inherited Notification(AComponent, Operation);
  3275. if (Operation = opRemove) and (AComponent = FDriveView) then
  3276. FDriveView := nil;
  3277. end; {Notification}
  3278. {$ENDIF}
  3279. procedure TDirView.ReloadDirectory;
  3280. begin
  3281. Reload(True);
  3282. end;
  3283. procedure TDirView.ResetItemImage(Index: Integer);
  3284. var
  3285. LVI: TLVItem;
  3286. begin
  3287. with PFileRec(Items[Index].Data)^, LVI do
  3288. begin
  3289. {Update imageindex:}
  3290. Mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
  3291. iItem := Index;
  3292. iSubItem := 0;
  3293. if ListView_GetItem(Handle, LVI) then
  3294. begin
  3295. iImage := I_IMAGECALLBACK;
  3296. Mask := Mask and (not LVIF_DI_SETITEM);
  3297. ListView_SetItem(Handle, LVI);
  3298. end;
  3299. end; {With}
  3300. end; {ResetItemImage}
  3301. procedure TDirView.SetAttrSpace(Value: string);
  3302. begin
  3303. if Value <> FAttrSpace then
  3304. begin
  3305. FAttrSpace := Value;
  3306. Invalidate;
  3307. end;
  3308. end; {SetAttrSpace}
  3309. procedure TDirView.SetNoCheckDrives(Value: string);
  3310. begin
  3311. FNoCheckDrives := UpperCase(Value);
  3312. end; {SetNoCheckDrives}
  3313. { Drag&Drop handling }
  3314. {$IFNDEF NO_THREADS}
  3315. procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
  3316. {Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:}
  3317. var
  3318. Index: Integer;
  3319. begin
  3320. if Files.Count > 0 then
  3321. for Index := 0 to Files.Count - 1 do
  3322. ValidateFile(Files[Index]);
  3323. end;
  3324. {$ENDIF}
  3325. procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  3326. begin
  3327. {$IFNDEF NO_THREADS}
  3328. if not WatchThreadActive then
  3329. {$ENDIF}
  3330. begin
  3331. FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
  3332. FChangeTimer.Enabled := True;
  3333. end;
  3334. inherited;
  3335. end;
  3336. procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  3337. Point: TPoint; dwEffect: Longint);
  3338. begin
  3339. {$IFNDEF NO_THREADS}
  3340. if not WatchThreadActive then
  3341. {$ENDIF}
  3342. begin
  3343. FChangeTimer.Interval := FChangeInterval;
  3344. FChangeTimer.Enabled := True;
  3345. end;
  3346. inherited;
  3347. end;
  3348. procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  3349. begin
  3350. Assert(Assigned(Item));
  3351. if IsRecycleBin then
  3352. begin
  3353. if Assigned(Item.Data) then
  3354. begin
  3355. if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
  3356. ('.' + PFileRec(Item.Data)^.FileExt) then
  3357. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  3358. ItemDragFileName(Item), PFileRec(Item.Data)^.DisplayName)
  3359. else
  3360. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  3361. ItemDragFileName(Item), PFileRec(Item.Data)^.DisplayName +
  3362. ExtractFileExt(PFileRec(Item.Data)^.FileName));
  3363. end;
  3364. end
  3365. else inherited;
  3366. end;
  3367. procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  3368. DragStatus:TDragDetectStatus);
  3369. {$IFNDEF NO_THREADS}
  3370. var
  3371. WasWatchThreadActive: Boolean;
  3372. {$ENDIF}
  3373. begin
  3374. if (DragStatus = ddsDrag) and (MarkedCount > 0) then
  3375. begin
  3376. {$IFNDEF NO_THREADS}
  3377. WasWatchThreadActive := WatchThreadActive;
  3378. {$ENDIF}
  3379. inherited;
  3380. {$IFNDEF NO_THREADS}
  3381. if (LastDDResult = drMove) and (not WasWatchThreadActive) then
  3382. StartFileDeleteThread;
  3383. {$ENDIF}
  3384. end;
  3385. end; {DDDragDetect}
  3386. procedure TDirView.DDChooseEffect(grfKeyState: Integer;
  3387. var dwEffect: Integer);
  3388. begin
  3389. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  3390. begin
  3391. if ExeDrag and (Path[1] >= FirstFixedDrive) and
  3392. (DragDrive >= FirstFixedDrive) then dwEffect := DropEffect_Link
  3393. else
  3394. if DragOnDriveIsMove and
  3395. (not DDOwnerIsSource or Assigned(DropTarget)) and
  3396. (((DragDrive = Upcase(Path[1])) and (dwEffect = DropEffect_Copy) and
  3397. (DragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0))
  3398. or IsRecycleBin) then dwEffect := DropEffect_Move;
  3399. end;
  3400. end;
  3401. procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
  3402. dwEffect: Integer; RenameOnCollision: Boolean);
  3403. var
  3404. Index: Integer;
  3405. SourcePath: string;
  3406. SourceFile: string;
  3407. OldCursor: TCursor;
  3408. OldWatchForChanges: Boolean;
  3409. DoFileOperation: Boolean;
  3410. IsRecycleBin: Boolean;
  3411. {$IFDEF USE_DRIVEVIEW}
  3412. SourceIsDirectory: Boolean;
  3413. Node: TTreeNode;
  3414. {$ENDIF}
  3415. begin
  3416. if DragDropFilesEx.FileList.Count > 0 then
  3417. begin
  3418. if not DirExists(TargetPath) then
  3419. begin
  3420. Reload(True);
  3421. DDError(DDPathNotFoundError);
  3422. end
  3423. else
  3424. begin
  3425. IsRecycleBin := Self.IsRecycleBin or ItemIsRecycleBin(DropTarget);
  3426. if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
  3427. begin
  3428. OldCursor := Screen.Cursor;
  3429. OldWatchForChanges := WatchForChanges;
  3430. {$IFDEF USE_DRIVEVIEW}
  3431. SourceIsDirectory := True;
  3432. {$ENDIF}
  3433. SourcePath := EmptyStr;
  3434. try
  3435. Screen.Cursor := crHourGlass;
  3436. WatchForChanges := False;
  3437. if (dwEffect in [DropEffect_Copy, DropEffect_Move]) then
  3438. begin
  3439. {$IFNDEF NO_THREADS}
  3440. StopWatchThread;
  3441. {$IFDEF USE_DRIVEVIEW}
  3442. if Assigned(DriveView) then
  3443. TDriveView(DriveView).StopWatchThread;
  3444. {$ENDIF}
  3445. if (DropSourceControl <> Self) and
  3446. (DropSourceControl is TDirView) then
  3447. TDirView(DropSourceControl).StopWatchThread;
  3448. {$ENDIF}
  3449. SourcePath := '';
  3450. {Set the source filenames:}
  3451. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  3452. begin
  3453. FFileOperator.OperandFrom.Add(
  3454. TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  3455. if DragDropFilesEx.FileNamesAreMapped then
  3456. FFileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
  3457. TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
  3458. if SourcePath = '' then
  3459. begin
  3460. if DirExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  3461. begin
  3462. SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  3463. {$IFDEF USE_DRIVEVIEW}
  3464. SourceIsDirectory := True;
  3465. {$ENDIF}
  3466. end
  3467. else
  3468. begin
  3469. SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  3470. {$IFDEF USE_DRIVEVIEW}
  3471. SourceIsDirectory := False;
  3472. {$ENDIF}
  3473. end;
  3474. end;
  3475. end;
  3476. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  3477. if RenameOnCollision then
  3478. Begin
  3479. FFileOperator.Flags := FFileOperator.Flags + [foRenameOnCollision];
  3480. FFileOperator.WantMappingHandle := True;
  3481. end
  3482. else FFileOperator.WantMappingHandle := False;
  3483. {Set the target directory or the target filenames:}
  3484. if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
  3485. FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles]
  3486. else
  3487. begin
  3488. FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
  3489. FFileOperator.OperandTo.Clear;
  3490. FFileOperator.OperandTo.Add(TargetPath);
  3491. end;
  3492. {if the target directory is the recycle bin, then delete the selected files:}
  3493. if IsRecycleBin then FFileOperator.Operation := foDelete
  3494. else
  3495. case dwEffect of
  3496. DropEffect_Copy: FFileOperator.Operation := foCopy;
  3497. DropEffect_Move: FFileOperator.Operation := foMove;
  3498. end;
  3499. if IsRecycleBin then
  3500. begin
  3501. if not ConfirmDelete then
  3502. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  3503. end
  3504. else
  3505. if not ConfirmOverwrite then
  3506. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  3507. DoFileOperation := True;
  3508. if Assigned(OnDDFileOperation) then
  3509. OnDDFileOperation(Self, dwEffect, SourcePath, TargetPath,
  3510. DoFileOperation);
  3511. if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
  3512. begin
  3513. FFileOperator.Execute;
  3514. ReLoad2;
  3515. if DragDropFilesEx.FileNamesAreMapped then
  3516. FFileOperator.ClearUndo;
  3517. if Assigned(OnDDFileOperationExecuted) then
  3518. OnDDFileOperationExecuted(Self, dwEffect, SourcePath, TargetPath);
  3519. end;
  3520. end
  3521. else
  3522. if dwEffect = DropEffect_Link then
  3523. (* Create Link requested: *)
  3524. begin
  3525. {$IFNDEF NO_THREADS}
  3526. StopWatchThread;
  3527. {$ENDIF}
  3528. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  3529. begin
  3530. SourceFile := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  3531. if Length(SourceFile) = 3 then
  3532. {Create a link to a drive:}
  3533. SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
  3534. else
  3535. {Create a link to a file or directory:}
  3536. SourcePath := ExtractFileName(SourceFile);
  3537. if not CreateFileShortCut(SourceFile, IncludeTrailingPathDelimiter(TargetPath) +
  3538. ChangeFileExt(SourcePath,'.lnk'),
  3539. ExtractFileNameOnly(SourceFile)) then
  3540. DDError(DDCreateShortCutError);
  3541. end;
  3542. ReLoad2;
  3543. end;
  3544. if Assigned(DropSourceControl) and
  3545. (DropSourceControl is TDirView) and
  3546. (DropSourceControl <> Self) and
  3547. (dwEffect = DropEffect_Move) then
  3548. TDirView(DropSourceControl).ValidateSelectedFiles;
  3549. {$IFDEF USE_DRIVEVIEW}
  3550. if Assigned(FDriveView) and SourceIsDirectory then
  3551. with TDriveView(FDriveView) do
  3552. begin
  3553. try
  3554. ValidateDirectory(FindNodeToPath(TargetPath));
  3555. except
  3556. end;
  3557. if (dwEffect = DropEffect_Move) or IsRecycleBin then
  3558. try
  3559. Node := FindNodeToPath(SourcePath);
  3560. if Assigned(Node) and Assigned(Node.Parent) then
  3561. Node := Node.Parent;
  3562. ValidateDirectory(Node);
  3563. except
  3564. end;
  3565. end;
  3566. {$ENDIF}
  3567. finally
  3568. FFileOperator.OperandFrom.Clear;
  3569. FFileOperator.OperandTo.Clear;
  3570. {$IFDEF USE_DRIVEVIEW}
  3571. {$IFNDEF NO_THREADS}
  3572. if Assigned(FDriveView) then
  3573. TDriveView(FDriveView).StartWatchThread;
  3574. {$ENDIF}
  3575. {$ENDIF}
  3576. Sleep(0);
  3577. WatchForChanges := OldWatchForChanges;
  3578. {$IFNDEF NO_THREADS}
  3579. if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
  3580. TDirView(DropSourceControl).StartWatchThread;
  3581. {$ENDIF}
  3582. Screen.Cursor := OldCursor;
  3583. end;
  3584. end;
  3585. end;
  3586. end;
  3587. end; {PerformDragDropFileOperation}
  3588. procedure TDirView.DDError(ErrorNo: TDDError);
  3589. begin
  3590. if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
  3591. else
  3592. raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
  3593. end; {DDError}
  3594. function TDirView.GetCanUndoCopyMove: Boolean;
  3595. begin
  3596. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  3597. end; {CanUndoCopyMove}
  3598. function TDirView.UndoCopyMove : Boolean;
  3599. var
  3600. LastTarget: string;
  3601. LastSource: string;
  3602. begin
  3603. Result := False;
  3604. if FFileOperator.CanUndo then
  3605. begin
  3606. Lasttarget := FFileOperator.LastOperandTo[0];
  3607. LastSource := FFileOperator.LastOperandFrom[0];
  3608. {$IFNDEF NO_THREADS}
  3609. {$IFDEF USE_DRIVEVIEW}
  3610. if Assigned(FDriveView) then
  3611. TDriveView(FDriveView).StopAllWatchThreads;
  3612. {$ENDIF}
  3613. {$ENDIF}
  3614. Result := FFileOperator.UndoExecute;
  3615. {$IFNDEF NO_THREADS}
  3616. if not WatchthreadActive then
  3617. {$ENDIF}
  3618. Reload2;
  3619. {$IFDEF USE_DRIVEVIEW}
  3620. if Assigned(FDriveView) then
  3621. with TDriveView(FDriveView) do
  3622. begin
  3623. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  3624. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  3625. {$IFNDEF NO_THREADS}
  3626. StartAllWatchThreads;
  3627. {$ENDIF}
  3628. end;
  3629. {$ENDIF}
  3630. end;
  3631. end; {UndoCopyMove}
  3632. procedure TDirView.EmptyClipboard;
  3633. var
  3634. Index: Integer;
  3635. StartIndex: Integer;
  3636. begin
  3637. if Windows.OpenClipBoard(0) then
  3638. begin
  3639. Windows.EmptyClipBoard;
  3640. Windows.CloseClipBoard;
  3641. if LastClipBoardOperation <> cboNone then
  3642. begin
  3643. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
  3644. while Index >= 0 do
  3645. begin
  3646. Items[Index].Cut := False;
  3647. StartIndex := Index;
  3648. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_CUT);
  3649. end;
  3650. end;
  3651. LastClipBoardOperation := cboNone;
  3652. {$IFDEF USE_DRIVEVIEW}
  3653. if Assigned(FDriveView) then
  3654. TDriveView(FDriveView).LastPathCut := '';
  3655. {$ENDIF}
  3656. end;
  3657. end; {EmptyClipBoard}
  3658. function TDirView.CopyToClipBoard : Boolean;
  3659. var
  3660. Index: Integer;
  3661. SaveCursor: TCursor;
  3662. StartIndex: Integer;
  3663. begin
  3664. SaveCursor := Screen.Cursor;
  3665. Screen.Cursor := crHourGlass;
  3666. try
  3667. Result := False;
  3668. EmptyClipBoard;
  3669. DragDropFilesEx.FileList.Clear;
  3670. if SelCount > 0 then
  3671. begin
  3672. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
  3673. while Index >= 0 do
  3674. begin
  3675. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Items[Index]));
  3676. StartIndex := Index;
  3677. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
  3678. end;
  3679. Result := DragDropFilesEx.CopyToClipBoard;
  3680. LastClipBoardOperation := cboCopy;
  3681. end;
  3682. finally
  3683. Screen.Cursor := SaveCursor;
  3684. end;
  3685. end; {CopyToClipBoard}
  3686. function TDirView.CutToClipBoard : Boolean;
  3687. var
  3688. Index: Integer;
  3689. StartIndex: Integer;
  3690. begin
  3691. Result := False;
  3692. EmptyClipBoard;
  3693. DragDropFilesEx.FileList.Clear;
  3694. if SelCount > 0 then
  3695. begin
  3696. Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
  3697. while Index >= 0 do
  3698. begin
  3699. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Items[Index]));
  3700. Items[Index].Cut := True;
  3701. StartIndex := Index;
  3702. Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
  3703. end;
  3704. Result := DragDropFilesEx.CopyToClipBoard;
  3705. LastClipBoardOperation := cboCut;
  3706. end;
  3707. end; {CutToClipBoard}
  3708. function TDirView.CanPasteFromClipBoard: Boolean;
  3709. begin
  3710. Result := False;
  3711. if DirOK and (Path <> '') and Windows.OpenClipboard(0) then
  3712. begin
  3713. Result := IsClipboardFormatAvailable(CF_HDROP);
  3714. Windows.CloseClipBoard;
  3715. end;
  3716. end; {CanPasteFromClipBoard}
  3717. function TDirView.PasteFromClipBoard(TargetPath: string = ''): Boolean;
  3718. begin
  3719. DragDropFilesEx.FileList.Clear;
  3720. Result := False;
  3721. if CanPasteFromClipBoard and
  3722. {MP}{$IFDEF OLD_DND} DragDropFilesEx.GetFromClipBoard {$ELSE} DragDropFilesEx.PasteFromClipboard {$ENDIF}{/MP}
  3723. then
  3724. begin
  3725. if TargetPath = '' then
  3726. TargetPath := PathName;
  3727. case LastClipBoardOperation of
  3728. cboNone:
  3729. begin
  3730. PerformDragDropFileOperation(TargetPath, DropEffect_Copy, False);
  3731. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
  3732. end;
  3733. cboCopy:
  3734. begin
  3735. PerformDragDropFileOperation(TargetPath, DropEffect_Copy,
  3736. ExcludeTrailingPathDelimiter(ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[0]^).Name)) = Path);
  3737. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
  3738. end;
  3739. cboCut:
  3740. begin
  3741. PerformDragDropFileOperation(TargetPath, DropEffect_Move, False);
  3742. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Move);
  3743. EmptyClipBoard;
  3744. end;
  3745. end;
  3746. Result := True;
  3747. end;
  3748. end; {PasteFromClipBoard}
  3749. function TDirView.DragCompleteFileList: Boolean;
  3750. begin
  3751. Result := inherited DragCompleteFileList and
  3752. (FDriveType <> DRIVE_REMOVABLE);
  3753. end;
  3754. function TDirView.DuplicateSelectedFiles: Boolean;
  3755. begin
  3756. Result := False;
  3757. if SelCount > 0 then
  3758. begin
  3759. Result := CopyToClipBoard;
  3760. if Result then
  3761. try
  3762. SelectNewFiles := True;
  3763. Selected := nil;
  3764. Result := PasteFromClipBoard;
  3765. finally
  3766. SelectNewFiles := False;
  3767. if Assigned(Selected) then
  3768. begin
  3769. ItemFocused := Selected;
  3770. Selected.MakeVisible(False);
  3771. if SelCount = 1 then
  3772. Selected.EditCaption;
  3773. end;
  3774. end;
  3775. end;
  3776. EmptyClipBoard;
  3777. end; {DuplicateFiles}
  3778. procedure TDirView.FetchAllDisplayData;
  3779. var
  3780. Index: Integer;
  3781. begin
  3782. for Index := 0 to Items.Count - 1 do
  3783. if Assigned(Items[Index]) and Assigned(Items[Index].Data) then
  3784. if PFileRec(Items[Index].Data)^.Empty then
  3785. GetDisplayData(Items[Index], False);
  3786. end; {FetchAllDisplayData}
  3787. function TDirView.MinimizePath(Path: string; Len: Integer): string;
  3788. begin
  3789. Result := MinimizeName(Path, Canvas, Len);
  3790. end; { MinimizePath }
  3791. function TDirView.NewColProperties: TCustomListViewColProperties;
  3792. begin
  3793. Result := TDirViewColProperties.Create(Self);
  3794. end;
  3795. procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
  3796. begin
  3797. Assert(Assigned(Item));
  3798. if Assigned(Item.Data) then
  3799. with PFileRec(Item.Data)^ do
  3800. begin
  3801. ImageIndex := Index;
  3802. IconEmpty := (ImageIndex < 0);
  3803. end;
  3804. end;
  3805. {=================================================================}
  3806. initialization
  3807. LastClipBoardOperation := cboNone;
  3808. LastIOResult := 0;
  3809. end.