DirView.pas 127 KB

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