DirView.pas 128 KB

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