DirView.pas 122 KB

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