DirView.pas 127 KB

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