DirView.pas 128 KB

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