DriveView.pas 91 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154
  1. unit DriveView;
  2. {==================================================================
  3. Component TDriveView / Version 2.6, January 2000
  4. ==================================================================
  5. Description:
  6. ============
  7. Displays the the directory structure of all drives as treeview
  8. with shell icons. Complete drag&Drop support for files and
  9. directories.
  10. Author:
  11. =======
  12. (c) Ingo Eckel 1998, 1999
  13. Sodener Weg 38
  14. 65812 Bad Soden
  15. Germany
  16. Modifications (for WinSCP):
  17. ===========================
  18. (c) Martin Prikryl 2004
  19. V2.6:
  20. - Shows "shared"-symbol with directories
  21. - Delphi5 compatible
  22. For detailed documentation and history see TDriveView.htm.
  23. {==================================================================}
  24. interface
  25. { Define ENHVALIDATE to scan all existing directories on a detected filesystem change:}
  26. {.$DEFINE ENHVALIDATE}
  27. {Required compiler options for TDriveView:}
  28. {$A+,B-,X+,H+,P+}
  29. {$WARN SYMBOL_PLATFORM OFF}
  30. uses
  31. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComObj,
  32. Dialogs, ComCtrls, ShellApi, CommCtrl, ExtCtrls, ActiveX, ShlObj,
  33. DirView, ShellDialogs, DragDrop, DragDropFilesEx, FileChanges, FileOperator,
  34. DiscMon, IEDriveInfo, IEListView, PIDL, BaseUtils, ListExt, CustomDirView,
  35. CustomDriveView;
  36. {$I ResStrings.pas}
  37. const
  38. {$IFNDEF NO_THREADS}
  39. msThreadChangeDelay = 50;
  40. {$ENDIF}
  41. CInvalidSize = $FFFFFFFF;
  42. ErrorNodeNA = '%s: Node not assigned';
  43. {Flags used by TDriveView.RefreshRootNodes:}
  44. dvdsFloppy = 8; {Include floppy drives}
  45. dvdsRereadAllways = 16; {Refresh drivestatus in any case}
  46. type
  47. ECreateShortCut = class(Exception);
  48. EInvalidDirName = class(Exception);
  49. EInvalidPath = class(Exception);
  50. ENodeNotAssigned = class(Exception);
  51. TDriveStatus = record
  52. Scanned: Boolean; {Drive allready scanned?}
  53. Verified: Boolean; {Drive completly scanned?}
  54. RootNode: TTreeNode; {Rootnode to drive}
  55. RootNodeIndex: Integer;
  56. {$IFNDEF NO_THREADS}
  57. DiscMonitor: TDiscMonitor; {Monitor thread}
  58. {$ENDIF}
  59. ChangeTimer: TTimer; {Change timer for the monitor thread}
  60. DefaultDir: string; {Current directory}
  61. end;
  62. TScanDirInfo = record
  63. SearchNewDirs: Boolean;
  64. StartNode: TTreeNode;
  65. DriveType: Integer;
  66. end;
  67. PScanDirInfo = ^TScanDirInfo;
  68. TDriveViewScanDirEvent = procedure(Sender: TObject; Node: TTreeNode;
  69. var DoScanDir: Boolean) of object;
  70. TDriveViewDiskChangeEvent = procedure(Sender: TObject; Drive: TDrive) of object;
  71. TDriveView = class;
  72. TNodeData = class
  73. private
  74. FDirName: string;
  75. FShortName: string;
  76. FAttr: Integer;
  77. FScanned: Boolean;
  78. FData: Pointer;
  79. FExpanded: Boolean;
  80. FDirSize: Cardinal;
  81. FIsRecycleBin: Boolean;
  82. FIconEmpty: Boolean;
  83. public
  84. shAttr: ULONG;
  85. PIDL: PItemIDList;
  86. ShellFolder: IShellFolder;
  87. constructor Create;
  88. destructor Destroy; override;
  89. property DirName: string read FDirName write FDirName;
  90. property ShortName: string read FShortName write FShortName;
  91. property Attr: Integer read FAttr write FAttr;
  92. property Scanned: Boolean read FScanned write FScanned;
  93. property Data: Pointer read FData write FData;
  94. property Expanded: Boolean read FExpanded write FExpanded;
  95. property DirSize: Cardinal read FDirSize write FDirSize;
  96. property IsRecycleBin: Boolean read FIsRecycleBin;
  97. property IconEmpty: Boolean read FIconEmpty write FIconEmpty;
  98. end;
  99. TDriveTreeNode = class(TTreeNode)
  100. procedure Assign(Source: TPersistent); override;
  101. end;
  102. TDriveView = class(TCustomDriveView)
  103. private
  104. DriveStatus: array[FirstDrive .. LastDrive] of TDriveStatus;
  105. FConfirmDelete: Boolean;
  106. FConfirmOverwrite: Boolean;
  107. FWatchDirectory: Boolean;
  108. FDirectory: string;
  109. FFullDriveScan: Boolean;
  110. FShowDirSize: Boolean;
  111. FShowVolLabel: Boolean;
  112. FVolDisplayStyle: TVolumeDisplayStyle;
  113. FShowAnimation: Boolean;
  114. FChangeFlag: Boolean;
  115. FLastDir: string;
  116. FValidateFlag: Boolean;
  117. FCreating: Boolean;
  118. FForceRename: Boolean;
  119. FRenameNode: TTreeNode;
  120. FLastRenameName: string;
  121. FInternalWindowHandle: HWND;
  122. FPrevSelected: TTreeNode;
  123. FPrevSelectedIndex: Integer;
  124. FDesktop: IShellFolder;
  125. FWorkPlace: IShellFolder;
  126. {Additional events:}
  127. FOnStartScan: TNotifyEvent;
  128. FOnEndScan: TNotifyEvent;
  129. FOnScanDir: TDriveViewScanDirEvent;
  130. FOnDiskChange: TDriveViewDiskChangeEvent;
  131. FOnInsertedDiskChange: TDriveViewDiskChangeEvent;
  132. FOnChangeDetected: TDriveViewDiskChangeEvent;
  133. FOnChangeInvalid: TDriveViewDiskChangeEvent;
  134. FOnDisplayContextMenu: TNotifyEvent;
  135. FOnRefreshDrives: TNotifyEvent;
  136. {used components:}
  137. FDirView: TDirView;
  138. FFileOperator: TFileOperator;
  139. FChangeInterval: Cardinal;
  140. FNoCheckDrives: string;
  141. FCompressedColor: TColor;
  142. FFileNameDisplay: TFileNameDisplay;
  143. {Drag&drop:}
  144. FLastPathCut: string;
  145. {Drag&drop helper functions:}
  146. procedure SignalDirDelete(Sender: TObject; Files: TStringList);
  147. function CheckForSubDirs(Path: string): Boolean;
  148. function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  149. {Callback-functions used by iteratesubtree:}
  150. function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  151. function CallBackSaveNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
  152. function CallBackRestoreNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
  153. function CallBackDisplayName(var Node: TTreeNode; Data: Pointer): Boolean;
  154. function CallBackSetDirSize(var Node: TTreeNode; Data: Pointer): Boolean;
  155. function CallBackExpandLevel(var Node: TTreeNode; Data: Pointer): Boolean;
  156. { Notification procedures used by component TDiscMonitor: }
  157. procedure ChangeDetected(Sender: TObject; const Directory: string;
  158. var SubdirsChanged: Boolean);
  159. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  160. {Notification procedure used by component TTimer:}
  161. procedure ChangeTimerOnTimer(Sender: TObject);
  162. protected
  163. procedure SetSelected(Node: TTreeNode);
  164. procedure SetFullDriveScan(DoFullDriveScan: Boolean);
  165. procedure SetWatchDirectory(Value: Boolean);
  166. procedure SetShowDirSize(ShowIt: Boolean);
  167. procedure SetShowVolLabel(ShowIt: Boolean);
  168. procedure SetVolDisplayStyle(DoStyle: TVolumeDisplayStyle);
  169. procedure SetDirView(Value: TDirView);
  170. procedure SetChangeInterval(Value: Cardinal);
  171. procedure SetNoCheckDrives(Value: string);
  172. procedure SetCompressedColor(Value: TColor);
  173. procedure SetFileNameDisplay(Value: TFileNameDisplay);
  174. procedure SetDirectory(Value: string); override;
  175. procedure SetDrive(Drive: TDrive);
  176. function GetDrive: TDrive;
  177. procedure GetNodeShellAttr(ParentFolder: IShellFolder; NodeData: TNodeData;
  178. Path: string; ContentMask: Boolean = True);
  179. function DoScanDir(FromNode: TTreeNode): Boolean; virtual;
  180. function AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode; virtual;
  181. {$IFNDEF NO_THREADS}
  182. procedure CreateWatchThread(Drive: TDrive); virtual;
  183. {$ENDIF}
  184. procedure InternalWndProc(var Msg: TMessage);
  185. function DirAttrMask: Integer;
  186. procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  187. NewDirs: Boolean); override;
  188. procedure ValidateDirectoryEasy(Node: TTreeNode);
  189. procedure RebuildTree; override;
  190. procedure SetLastPathCut(Path: string);
  191. function GetCanUndoCopyMove: Boolean; virtual;
  192. procedure CreateWnd; override;
  193. procedure DestroyWnd; override;
  194. procedure Edit(const Item: TTVItem); override;
  195. procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
  196. function GetCustomDirView: TCustomDirView; override;
  197. procedure SetCustomDirView(Value: TCustomDirView); override;
  198. function NodePath(Node: TTreeNode): string; override;
  199. function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
  200. function NodePathExists(Node: TTreeNode): Boolean; override;
  201. function NodeColor(Node: TTreeNode): TColor; override;
  202. function FindPathNode(Path: string): TTreeNode; override;
  203. function CreateNode: TTreeNode; override;
  204. function DDSourceEffects: TDropEffectSet; override;
  205. procedure DDChooseEffect(KeyState: Integer; var Effect: Integer); override;
  206. function DragCompleteFileList: Boolean; override;
  207. function DDExecute: TDragResult; override;
  208. public
  209. property Images;
  210. property StateImages;
  211. property Items stored False;
  212. property Selected Write SetSelected stored False;
  213. property WorkPlace: IShellFolder read FWorkPlace;
  214. property DragImageList: TDragImageList read FDragImageList;
  215. property Drive: TDrive read GetDrive write SetDrive stored False;
  216. property DragDrive: TDrive read FDragDrive;
  217. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  218. property DDFileOperator: TFileOperator read FFileOperator;
  219. property LastPathCut: string read FLastPathCut write SetLastPathCut;
  220. function UndoCopyMove: Boolean; dynamic;
  221. procedure EmptyClipboard; dynamic;
  222. function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;
  223. function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;
  224. function CanPasteFromClipBoard: Boolean; dynamic;
  225. function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
  226. procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
  227. {Drive handling:}
  228. function GetDriveStatus(Drive: TDrive): TDriveStatus;
  229. function GetDriveTypetoNode(Node: TTreeNode): Integer; {Returns DRIVE_CDROM etc..}
  230. function GetDriveType(Drive: TDrive): Integer; {Returns DRIVE_CDROM etc..}
  231. function GetDriveToNode(Node: TTreeNode): Char;
  232. function GetDriveText(Drive: TDrive): string;
  233. procedure ScanDrive(Drive: TDrive);
  234. procedure RefreshRootNodes(ScanDirectory: Boolean; dsFlags: Integer);
  235. function GetValidDrivesStr: string;
  236. procedure RefreshDirSize(Node: TTreeNode);
  237. procedure RefreshDriveDirSize(Drive: TDrive);
  238. {Node handling:}
  239. procedure SetImageIndex(Node: TTreeNode); virtual;
  240. function FindNodeToPath(Path: string): TTreeNode;
  241. function NodeVerified(Node: TTreeNode): Boolean;
  242. function NodeAttr(Node: TTreeNode): Integer;
  243. function RootNode(Node: TTreeNode): TTreeNode;
  244. function GetDirName(Node: TTreeNode): string;
  245. function GetDirSize(Node: TTreeNode): Cardinal; virtual;
  246. procedure SetDirSize(Node: TTreeNode); virtual;
  247. function GetDisplayName(Node: TTreeNode): string;
  248. function NodeUpdateAble(Node: TTreeNode): Boolean; virtual;
  249. procedure ExpandLevel(Node: TTreeNode; Level: Integer); virtual;
  250. function NodePathName(Node: TTreeNode): string; override;
  251. function GetFQPIDL(Node: TTreeNode): PItemIDList;
  252. function GetSubTreeSize(Node: TTreeNode): Integer; dynamic;
  253. {Directory update:}
  254. function CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode; dynamic;
  255. function DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean; dynamic;
  256. procedure DeleteSubNodes(Node: TTreeNode); dynamic;
  257. constructor Create(AOwner: TComponent); override;
  258. destructor Destroy; override;
  259. {Save and restore the subnodes expanded state:}
  260. procedure SaveNodesState(Node: TTreeNode);
  261. procedure RestoreNodesState(Node: TTreeNode);
  262. {Menu-handling:}
  263. procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;
  264. procedure DisplayPropertiesMenu(Node: TTreeNode); override;
  265. {$IFNDEF NO_THREADS}
  266. {Watchthread handling:}
  267. procedure StartWatchThread; virtual;
  268. procedure StopWatchThread; virtual;
  269. procedure TerminateWatchThread(Drive: TDrive); virtual;
  270. procedure StartAllWatchThreads; virtual;
  271. procedure StopAllWatchThreads; virtual;
  272. function WatchThreadActive: Boolean; overload;
  273. function WatchThreadActive(Drive: TDrive): Boolean; overload;
  274. function NodeWatched(Node: TTreeNode): Boolean; virtual;
  275. {$ENDIF}
  276. (* Modified Events: *)
  277. procedure GetImageIndex(Node: TTreeNode); override;
  278. function CanEdit(Node: TTreeNode): Boolean; override;
  279. function CanChange(Node: TTreeNode): Boolean; override;
  280. function CanExpand(Node: TTreeNode): Boolean; override;
  281. procedure Delete(Node: TTreeNode); override;
  282. procedure Loaded; override;
  283. procedure KeyPress(var Key: Char); override;
  284. procedure Change(Node: TTreeNode); override;
  285. published
  286. {Additional properties:}
  287. {Current selected directory:}
  288. property Directory;
  289. {Confirm deleting directories:}
  290. property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
  291. {Confirm overwriting directories:}
  292. property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;
  293. {Scan all directories in method ScanDrive:}
  294. property FullDriveScan: Boolean read FFullDriveScan write SetFullDriveScan default False;
  295. {Enable automatic update on filesystem changes:}
  296. property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;
  297. {Peform automatic update after ChangeInterval milliseconds:}
  298. property ChangeInterval: Cardinal read FChangeInterval write SetChangeInterval default MSecsPerSec;
  299. {Linked component TDirView:}
  300. property DirView: TDirView read FDirView write SetDirView;
  301. property ShowDirSize: Boolean read FShowDirSize write SetShowDirSize default False;
  302. {Show the volume labels of drives:}
  303. property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;
  304. {How to display the drives volume labels:}
  305. property VolDisplayStyle: TVolumeDisplayStyle read FVolDisplayStyle write SetVolDisplayStyle default doPrettyName;
  306. {Show AVI-animation when performing a full drive scan:}
  307. property ShowAnimation: Boolean read FShowAnimation write FShowAnimation default False;
  308. {Don't watch these drives for changes:}
  309. property NoCheckDrives: string read FNoCheckDrives write SetNoCheckDrives;
  310. property CompressedColor: TColor read FCompressedColor write SetCompressedColor default clBlue;
  311. property FileNameDisplay: TFileNameDisplay read FFileNameDisplay write SetFileNameDisplay default fndStored;
  312. {Additional events:}
  313. property OnStartScan: TNotifyEvent read FOnStartScan write FOnStartScan;
  314. property OnEndScan: TNotifyEvent read FOnEndScan write FOnEndScan;
  315. property OnScanDir: TDriveViewScanDirEvent read FOnScanDir write FOnScanDir;
  316. property OnDiskChange: TDriveViewDiskChangeEvent read FOnDiskChange write FOnDiskChange;
  317. property OnInsertedDiskChange: TDriveViewDiskChangeEvent read FOnInsertedDiskChange
  318. write FOnInsertedDiskChange;
  319. property OnChangeDetected: TDriveViewDiskChangeEvent read FOnChangeDetected
  320. write FOnChangeDetected;
  321. property OnChangeInvalid: TDriveViewDiskChangeEvent read FOnChangeInvalid
  322. write FOnChangeInvalid;
  323. property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
  324. write FOnDisplayContextMenu;
  325. property OnRefreshDrives: TNotifyEvent read FOnRefreshDrives
  326. write FOnRefreshDrives;
  327. property DDLinkOnExeDrag;
  328. property TargetPopUpMenu;
  329. property OnDDDragEnter;
  330. property OnDDDragLeave;
  331. property OnDDDragOver;
  332. property OnDDDrop;
  333. property OnDDQueryContinueDrag;
  334. property OnDDGiveFeedback;
  335. property OnDDDragDetect;
  336. property OnDDProcessDropped;
  337. property OnDDError;
  338. property OnDDExecuted;
  339. property OnDDFileOperation;
  340. property OnDDFileOperationExecuted;
  341. property OnDDMenuPopup;
  342. property Align;
  343. property Anchors;
  344. property AutoExpand;
  345. property BiDiMode;
  346. property BorderStyle;
  347. property BorderWidth;
  348. property ChangeDelay;
  349. property Color;
  350. property Ctl3D;
  351. property Constraints;
  352. property DoubleBuffered;
  353. {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}
  354. property DragKind;
  355. property DragCursor;
  356. property DragMode Default dmAutomatic;
  357. property OnDragDrop;
  358. property OnDragOver;
  359. property Enabled;
  360. property Font;
  361. property HideSelection;
  362. property HotTrack;
  363. property Indent;
  364. property ParentBiDiMode;
  365. property ParentColor;
  366. property ParentCtl3D;
  367. property ParentDoubleBuffered;
  368. property ParentFont;
  369. property ParentShowHint;
  370. property PopupMenu;
  371. property ReadOnly;
  372. property RightClickSelect;
  373. property RowSelect;
  374. property ShowButtons;
  375. property ShowHint;
  376. property ShowLines;
  377. property TabOrder;
  378. property TabStop default True;
  379. property ToolTips;
  380. property Visible;
  381. property OnChange;
  382. property OnChanging;
  383. property OnClick;
  384. property OnCollapsing;
  385. property OnCollapsed;
  386. property OnCompare;
  387. property OnDblClick;
  388. property OnDeletion;
  389. property OnEdited;
  390. property OnEditing;
  391. property OnEndDock;
  392. property OnEndDrag;
  393. property OnEnter;
  394. property OnExit;
  395. property OnExpanding;
  396. property OnExpanded;
  397. property OnGetImageIndex;
  398. property OnGetSelectedIndex;
  399. property OnKeyDown;
  400. property OnKeyPress;
  401. property OnKeyUp;
  402. property OnMouseDown;
  403. property OnMouseMove;
  404. property OnMouseUp;
  405. property OnStartDock;
  406. property OnStartDrag;
  407. end;
  408. procedure Register;
  409. implementation
  410. uses
  411. CompThread;
  412. resourcestring
  413. SErrorInvalidDirName = 'New name contains invalid characters %s';
  414. type
  415. PInt = ^Integer;
  416. procedure Register;
  417. begin
  418. RegisterComponents('DriveDir', [TDriveView]);
  419. end; {Register}
  420. constructor TNodeData.Create;
  421. begin
  422. inherited;
  423. FAttr := 0;
  424. FExpanded := False;
  425. FScanned := False;
  426. FDirName := '';
  427. FShortName := '';
  428. FDirSize := CInvalidSize;
  429. FIsRecycleBin := False;
  430. FIconEmpty := True;
  431. shAttr := 0;
  432. PIDL := nil;
  433. ShellFolder := nil;
  434. end; {TNodeData.Create}
  435. destructor TNodeData.Destroy;
  436. begin
  437. SetLength(FDirName, 0);
  438. if Assigned(PIDL) then
  439. FreePIDL(PIDL);
  440. inherited;
  441. end; {TNodeData.Destroy}
  442. { TDriveTreeNode }
  443. procedure TDriveTreeNode.Assign(Source: TPersistent);
  444. var
  445. SourceData: TNodeData;
  446. NewData: TNodeData;
  447. begin
  448. inherited Assign(Source);
  449. if not Deleting and (Source is TTreeNode) then
  450. begin
  451. SourceData := TNodeData(TTreeNode(Source).Data);
  452. NewData := TNodeData.Create();
  453. NewData.DirName := SourceData.DirName;
  454. NewData.ShortName := SourceData.ShortName;
  455. NewData.Attr := SourceData.Attr;
  456. NewData.Scanned := SourceData.Scanned;
  457. NewData.Data := SourceData.Data;
  458. NewData.Expanded := SourceData.Expanded;
  459. NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
  460. NewData.IconEmpty := SourceData.IconEmpty;
  461. TTreeNode(Source).Data := NewData;
  462. end;
  463. end;
  464. { TDriveView }
  465. constructor TDriveView.Create(AOwner: TComponent);
  466. var
  467. Drive: TDrive;
  468. begin
  469. inherited;
  470. FCreating := True;
  471. if FChangeInterval = 0 then
  472. FChangeInterval := MSecsPerSec;
  473. for Drive := FirstDrive to LastDrive do
  474. with DriveStatus[Drive] do
  475. begin
  476. Scanned := False;
  477. Verified := False;
  478. RootNode := nil;
  479. RootNodeIndex := -1;
  480. DiscMonitor := nil;
  481. DefaultDir := EmptyStr;
  482. {ChangeTimer: }
  483. ChangeTimer := TTimer.Create(Self);
  484. ChangeTimer.Interval := 0;
  485. ChangeTimer.Enabled := False;
  486. ChangeTimer.OnTimer := ChangeTimerOnTimer;
  487. ChangeTimer.Tag := Ord(Drive);
  488. end;
  489. FFileOperator := TFileOperator.Create(Self);
  490. FFileOperator.ProgressTitle := coFileOperatorTitle;
  491. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  492. FCompressedColor := clBlue;
  493. FShowVolLabel := True;
  494. FChangeFlag := False;
  495. FLastDir := EmptyStr;
  496. FValidateFlag := False;
  497. FConfirmDelete := True;
  498. FShowAnimation := False;
  499. FDirectory := EmptyStr;
  500. FFileNameDisplay := fndStored;
  501. FForceRename := False;
  502. FLastRenameName := '';
  503. FRenameNode := nil;
  504. FPrevSelected := nil;
  505. FPrevSelectedIndex := -1;
  506. FConfirmOverwrite := True;
  507. FLastPathCut := '';
  508. FStartPos.X := -1;
  509. FStartPos.Y := -1;
  510. FDragPos := FStartPos;
  511. FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
  512. with FDragDropFilesEx do
  513. begin
  514. ShellExtensions.DragDropHandler := True;
  515. end;
  516. end; {Create}
  517. destructor TDriveView.Destroy;
  518. var
  519. Drive: TDrive;
  520. begin
  521. Classes.DeallocateHWnd(FInternalWindowHandle);
  522. for Drive := FirstDrive to LastDrive do
  523. with DriveStatus[Drive] do
  524. begin
  525. if Assigned(DiscMonitor) then
  526. DiscMonitor.Free;
  527. if Assigned(ChangeTimer) then
  528. ChangeTimer.Free;
  529. end;
  530. if Assigned(FFileOperator) then
  531. FFileOperator.Free;
  532. inherited Destroy;
  533. end; {Destroy}
  534. procedure TDriveView.InternalWndProc(var Msg: TMessage);
  535. begin
  536. with Msg do
  537. begin
  538. if (Msg = WM_DEVICECHANGE) and
  539. ((wParam = {DBT_CONFIGCHANGED} $0018) or (wParam = {DBT_DEVICEARRIVAL} $8000) or
  540. (wParam = {DBT_DEVICEREMOVECOMPLETE} $8004)) then
  541. begin
  542. try
  543. //DriveInfo.Load;
  544. RefreshRootNodes(False, dsAll);
  545. if Assigned(OnRefreshDrives) then
  546. OnRefreshDrives(Self);
  547. except
  548. Application.HandleException(Self);
  549. end
  550. end;
  551. Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  552. end;
  553. end;
  554. procedure TDriveView.CreateWnd;
  555. var
  556. PIDLWorkPlace: PItemIDList;
  557. Drive: TDrive;
  558. begin
  559. inherited;
  560. if Assigned(PopupMenu) then
  561. PopupMenu.Autopopup := False;
  562. OLECheck(shGetDesktopFolder(FDesktop));
  563. OLECheck(shGetSpecialFolderLocation(Self.Handle, CSIDL_DRIVES, PIDLWorkPlace));
  564. FDesktop.BindToObject(PIDLWorkPlace, nil, IID_IShellFolder, Pointer(FWorkPlace));
  565. FreePIDL(PIDLWorkPlace);
  566. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  567. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  568. if FPrevSelectedIndex >= 0 then
  569. begin
  570. FPrevSelected := Items[FPrevSelectedIndex];
  571. FPrevSelectedIndex := -1;
  572. end;
  573. for Drive := FirstDrive to LastDrive do
  574. with DriveStatus[Drive] do
  575. begin
  576. if RootNodeIndex >= 0 then
  577. begin
  578. RootNode := Items[RootNodeIndex];
  579. RootNodeIndex := -1;
  580. end;
  581. end;
  582. end; {CreateWnd}
  583. procedure TDriveView.DestroyWnd;
  584. var
  585. Drive: TDrive;
  586. begin
  587. if CreateWndRestores and (Items.Count > 0) and (csRecreating in ControlState) then
  588. begin
  589. FPrevSelectedIndex := -1;
  590. if Assigned(FPrevSelected) then
  591. begin
  592. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  593. FPrevSelected := nil;
  594. end;
  595. for Drive := FirstDrive to LastDrive do
  596. with DriveStatus[Drive] do
  597. begin
  598. RootNodeIndex := -1;
  599. if Assigned(RootNode) then
  600. begin
  601. RootNodeIndex := RootNode.AbsoluteIndex;
  602. RootNode := nil;
  603. end;
  604. end;
  605. end;
  606. inherited;
  607. end;
  608. function TDriveView.GetFQPIDL(Node: TTreeNode): PItemIDList;
  609. var
  610. Eaten: ULONG;
  611. shAttr: ULONG;
  612. begin
  613. Result := nil;
  614. if Assigned(Node) then
  615. begin
  616. FDesktop.ParseDisplayName(FParentForm.Handle, nil, PChar(NodePathName(Node)), Eaten,
  617. Result, shAttr);
  618. end;
  619. end; {GetFQPIDL}
  620. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  621. begin
  622. Result := clDefaultItemColor;
  623. with TNodeData(Node.Data) do
  624. if not Node.Selected then
  625. begin
  626. {Colored display of compressed directories:}
  627. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  628. Result := FCompressedColor
  629. else
  630. {Dimmed display, if hidden-atrribut set:}
  631. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  632. Result := clGrayText
  633. end;
  634. end;
  635. function TDriveView.GetCustomDirView: TCustomDirView;
  636. begin
  637. Result := DirView;
  638. end;
  639. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  640. begin
  641. DirView := Value as TDirView;
  642. end;
  643. function TDriveView.NodePath(Node: TTreeNode): string;
  644. var
  645. ParentNode: TTreeNode;
  646. begin
  647. if not Assigned(Node) then
  648. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  649. Result := GetDirName(Node);
  650. ParentNode := Node.Parent;
  651. while (ParentNode <> nil) and (ParentNode.Level >= 0) do
  652. begin
  653. if ParentNode.Level > 0 then
  654. Result := GetDirName(ParentNode) + '\' + Result
  655. else
  656. Result := GetDirName(ParentNode) + Result;
  657. ParentNode := ParentNode.Parent;
  658. end;
  659. if Length(Result) = 3 then
  660. SetLength(Result, 2);
  661. end;
  662. {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
  663. C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
  664. function TDriveView.NodePathName(Node: TTreeNode): string;
  665. begin
  666. Result := NodePath(Node);
  667. if Length(Result) = 2 then
  668. Result := Result + '\';
  669. end; {NodePathName}
  670. function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
  671. begin
  672. Result := TNodeData(Node.Data).IsRecycleBin;
  673. end;
  674. function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
  675. begin
  676. Result := DirExists(NodePathName(Node));
  677. end;
  678. function TDriveView.CanEdit(Node: TTreeNode): Boolean;
  679. begin
  680. Result := inherited CanEdit(Node) or FForceRename;
  681. if Result then
  682. begin
  683. Result := Assigned(Node.Parent) and
  684. (not TNodeData(Node.Data).IsRecycleBin) and
  685. (not ReadOnly) and
  686. (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
  687. ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
  688. (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
  689. end;
  690. FForceRename := False;
  691. end; {CanEdit}
  692. procedure TDriveView.Edit(const Item: TTVItem);
  693. var
  694. NewDirName: string;
  695. SRec: TSearchRec;
  696. Node: TTreeNode;
  697. Info: string;
  698. i: Integer;
  699. begin
  700. Node := GetNodeFromHItem(Item);
  701. if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
  702. begin
  703. if StrContains(coInvalidDosChars, Item.pszText) then
  704. begin
  705. Info := coInvalidDosChars;
  706. for i := Length(Info) downto 1 do
  707. System.Insert(Space, Info, i);
  708. if Assigned(OnEdited) then
  709. begin
  710. NewDirName := Node.Text;
  711. OnEdited(Self, Node, NewDirName);
  712. end;
  713. if Length(Item.pszText) > 0 then
  714. raise EInvalidDirName.CreateFmt(SErrorInvalidDirName, [Info]);
  715. Exit;
  716. end;
  717. {$IFNDEF NO_THREADS}
  718. StopWatchThread;
  719. if Assigned(DirView) then
  720. DirView.StopWatchThread;
  721. {$ENDIF}
  722. with FFileOperator do
  723. begin
  724. Flags := [foAllowUndo, foNoConfirmation];
  725. Operation := foRename;
  726. OperandFrom.Clear;
  727. OperandTo.Clear;
  728. OperandFrom.Add(NodePath(Node));
  729. OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
  730. end;
  731. try
  732. if FFileOperator.Execute then
  733. begin
  734. Node.Text := Item.pszText;
  735. TNodeData(Node.Data).DirName := Item.pszText;
  736. if FindFirst(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText,
  737. faAnyFile, SRec) = 0 then
  738. begin
  739. TNodeData(Node.Data).ShortName := string(SRec.FindData.cAlternateFileName);
  740. end;
  741. FindClose(SRec);
  742. SortChildren(Node.Parent, False);
  743. inherited;
  744. end
  745. else
  746. begin
  747. if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
  748. Info := SErrorRenameFileExists + Item.pszText
  749. else
  750. Info := SErrorRenameFile + Item.pszText;
  751. MessageBeep(MB_ICONHAND);
  752. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  753. begin
  754. FLastRenameName := Item.pszText;
  755. FRenameNode := Node;
  756. PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
  757. end;
  758. end;
  759. finally
  760. {$IFNDEF NO_THREADS}
  761. StartWatchThread;
  762. {$ENDIF}
  763. if Assigned(DirView) then
  764. begin
  765. DirView.Reload2;
  766. {$IFNDEF NO_THREADS}
  767. DirView.StartWatchThread;
  768. {$ENDIF}
  769. end;
  770. end;
  771. end;
  772. end; {Edit}
  773. procedure TDriveView.WMUserRename(var Message: TMessage);
  774. begin
  775. if Assigned(FRenameNode) then
  776. begin
  777. FForceRename := True;
  778. TreeView_EditLabel(Handle, FRenameNode.ItemID);
  779. SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
  780. FRenameNode := nil;
  781. end;
  782. end; {WMUserRename}
  783. function TDriveView.CanExpand(Node: TTreeNode): Boolean;
  784. var
  785. SubNode: TTreeNode;
  786. Drive: TDrive;
  787. SaveCursor: TCursor;
  788. begin
  789. Result := inherited CanExpand(Node);
  790. Drive := GetDriveToNode(Node);
  791. if Node.HasChildren then
  792. begin
  793. if (Node.Level = 0) and
  794. (not DriveStatus[Drive].Scanned) and
  795. (Drive >= FirstFixedDrive) then
  796. begin
  797. SubNode := Node.GetFirstChild;
  798. if not Assigned(SubNode) then
  799. begin
  800. ScanDrive(Drive);
  801. SubNode := Node.GetFirstChild;
  802. Node.HasChildren := Assigned(SubNode);
  803. Result := Node.HasChildren;
  804. {$IFNDEF NO_THREADS}
  805. if not Assigned(DriveStatus[Drive].DiscMonitor) then
  806. CreateWatchThread(Drive);
  807. {$ENDIF}
  808. end;
  809. end
  810. else
  811. begin
  812. SaveCursor := Screen.Cursor;
  813. Screen.Cursor := crHourGlass;
  814. try
  815. if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
  816. begin
  817. ReadSubDirs(Node, DriveInfo[Drive].DriveType);
  818. end;
  819. finally
  820. Screen.Cursor := SaveCursor;
  821. end;
  822. end;
  823. end;
  824. end; {CanExpand}
  825. procedure TDriveView.GetImageIndex(Node: TTreeNode);
  826. begin
  827. if TNodeData(Node.Data).IconEmpty then
  828. SetImageIndex(Node);
  829. inherited;
  830. end; {GetImageIndex}
  831. procedure TDriveView.Loaded;
  832. begin
  833. inherited;
  834. {Create the drive nodes:}
  835. RefreshRootNodes(False, dsDisplayName or dvdsFloppy);
  836. {Set the initial directory:}
  837. if (Length(FDirectory) > 0) and DirExists(FDirectory) then
  838. Directory := FDirectory;
  839. FCreating := False;
  840. end; {Loaded}
  841. function TDriveView.CreateNode: TTreeNode;
  842. begin
  843. Result := TDriveTreeNode.Create(Items);
  844. end;
  845. procedure TDriveView.Delete(Node: TTreeNode);
  846. var
  847. NodeData: TNodeData;
  848. begin
  849. if Node = FPrevSelected then
  850. FPrevSelected := nil;
  851. NodeData := nil;
  852. if Assigned(Node) and Assigned(Node.Data) then
  853. NodeData := TNodeData(Node.Data);
  854. Node.Data := nil;
  855. inherited;
  856. if Assigned(NodeData) and not (csRecreating in ControlState) then
  857. begin
  858. NodeData.Destroy;
  859. end;
  860. end; {OnDelete}
  861. procedure TDriveView.KeyPress(var Key: Char);
  862. begin
  863. inherited;
  864. if Assigned(Selected) then
  865. begin
  866. if Pos(Key, coInvalidDosChars) <> 0 then
  867. begin
  868. Beep;
  869. Key := #0;
  870. end;
  871. end;
  872. end; {KeyPress}
  873. function TDriveView.CanChange(Node: TTreeNode): Boolean;
  874. var
  875. Path: string;
  876. Drive: TDrive;
  877. begin
  878. Result := inherited CanChange(Node);
  879. if not Reading and not (csRecreating in ControlState) then
  880. begin
  881. if Result and Assigned(Node) then
  882. begin
  883. Path := NodePathName(Node);
  884. if Path <> FLastDir then
  885. begin
  886. Drive := Path[1];
  887. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  888. if not DriveInfo[Drive].DriveReady then
  889. begin
  890. MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
  891. Result := False;
  892. end
  893. else
  894. if not DirectoryExists(Path) then
  895. begin
  896. MessageDlg(Format(SDirNotExists, [Path]), mtError, [mbOK], 0);
  897. Result := False;
  898. end;
  899. end;
  900. end;
  901. if Result and (csDestroying in ComponentState) then
  902. Result := False;
  903. if Result and
  904. (not FCanChange) and
  905. Assigned(Node) and
  906. Assigned(Node.Data) and
  907. Assigned(Selected) and
  908. Assigned(Selected.Data) then
  909. begin
  910. DropTarget := Node;
  911. Result := False;
  912. end
  913. else
  914. DropTarget := nil;
  915. end;
  916. end; {CanChange}
  917. procedure TDriveView.Change(Node: TTreeNode);
  918. var
  919. Drive: TDrive;
  920. OldSerial: DWORD;
  921. NewDir: string;
  922. LastDrive: TDrive;
  923. begin
  924. if not Reading and not (csRecreating in ControlState) then
  925. begin
  926. if Assigned(Node) then
  927. begin
  928. NewDir := NodePathName(Node);
  929. if NewDir <> FLastDir then
  930. begin
  931. Drive := NewDir[1];
  932. if Length(FLastDir) > 0 then
  933. LastDrive := FLastDir[1]
  934. else
  935. LastDrive := #0;
  936. FChangeFlag := True;
  937. FLastDir := NewDir;
  938. OldSerial := DriveInfo[Drive].DriveSerial;
  939. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  940. with DriveInfo[Drive]^ do
  941. begin
  942. if Assigned(FDirView) and (FDirView.Path <> NewDir) then
  943. FDirView.Path := NewDir;
  944. if DriveReady then
  945. begin
  946. if not DirExists(NewDir) then
  947. begin
  948. ValidateDirectory(DriveStatus[Upcase(NewDir[1])].RootNode);
  949. Exit;
  950. end;
  951. DriveStatus[Drive].DefaultDir := IncludeTrailingBackslash(NewDir);
  952. if LastDrive <> Drive then
  953. begin
  954. {$IFNDEF NO_THREADS}
  955. if (LastDrive >= FirstDrive) and
  956. (DriveInfo[LastDrive].DriveType = DRIVE_REMOVABLE) then
  957. TerminateWatchThread(LastDrive);
  958. {$ENDIF}
  959. {Drive serial has changed or is missing: allways reread the drive:}
  960. if (DriveSerial <> OldSerial) or (DriveSerial = 0) then
  961. begin
  962. if TNodeData(DriveStatus[Drive].RootNode.Data).Scanned then
  963. ScanDrive(Drive);
  964. if Assigned(FOnInsertedDiskChange) then
  965. FOnInsertedDiskChange(Self, Drive);
  966. end;
  967. if Assigned(FOnDiskChange) then
  968. FOnDiskChange(Self, Drive);
  969. end;
  970. {$IFNDEF NO_THREADS}
  971. StartWatchThread;
  972. {$ENDIF}
  973. end
  974. else {Drive not ready:}
  975. begin
  976. DriveStatus[Drive].RootNode.DeleteChildren;
  977. DriveStatus[Drive].DefaultDir := EmptyStr;
  978. if LastDrive <> Drive then
  979. begin
  980. if Assigned(FOnInsertedDiskChange) then
  981. FOnInsertedDiskChange(Self, Drive);
  982. if Assigned(FOnDiskChange) then
  983. FOnDiskChange(Self, Drive);
  984. end;
  985. end;
  986. end;
  987. end;
  988. if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
  989. Node.Expand(False);
  990. FPrevSelected := Node;
  991. end;
  992. end;
  993. inherited;
  994. end; {Change}
  995. procedure TDriveView.SetImageIndex(Node: TTreeNode);
  996. var
  997. FileInfo: TShFileInfo;
  998. NodePath: string;
  999. begin
  1000. if Assigned(Node) and TNodeData(Node.Data).IconEmpty then
  1001. begin
  1002. NodePath := NodePathName(Node);
  1003. if Node.Level = 0 then
  1004. begin
  1005. with DriveInfo[NodePath[1]]^ do
  1006. begin
  1007. if ImageIndex = 0 then
  1008. begin
  1009. DriveInfo.ReadDriveStatus(NodePath[1], dsImageIndex);
  1010. Node.ImageIndex := DriveInfo[NodePath[1]].ImageIndex;
  1011. end
  1012. else Node.ImageIndex := ImageIndex;
  1013. Node.SelectedIndex := Node.ImageIndex;
  1014. end;
  1015. end
  1016. else
  1017. begin
  1018. if DriveInfo[NodePath[1]].DriveType = DRIVE_REMOTE then
  1019. begin
  1020. Node.ImageIndex := StdDirIcon;
  1021. Node.SelectedIndex := StdDirSelIcon;
  1022. end
  1023. else
  1024. begin
  1025. try
  1026. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1027. SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  1028. if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then
  1029. begin
  1030. Node.ImageIndex := FileInfo.iIcon;
  1031. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1032. SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
  1033. Node.SelectedIndex := FileInfo.iIcon;
  1034. end
  1035. else
  1036. begin
  1037. Node.ImageIndex := StdDirIcon;
  1038. Node.SelectedIndex := StdDirSelIcon;
  1039. end;
  1040. except
  1041. Node.ImageIndex := StdDirIcon;
  1042. Node.SelectedIndex := StdDirSelIcon;
  1043. end;
  1044. end;
  1045. end;
  1046. end; {IconEmpty}
  1047. TNodeData(Node.Data).IconEmpty := False;
  1048. end; {SetImageIndex}
  1049. function TDriveView.GetDriveText(Drive: TDrive): string;
  1050. begin
  1051. if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then
  1052. begin
  1053. case FVolDisplayStyle of
  1054. doPrettyName: Result := DriveInfo.GetPrettyName(Drive);
  1055. doDisplayName: Result := DriveInfo.GetDisplayName(Drive);
  1056. doLongPrettyName: Result := DriveInfo.GetLongPrettyName(Drive);
  1057. end; {Case}
  1058. end
  1059. else Result := Drive + ':';
  1060. end; {GetDriveText}
  1061. function TDriveView.GetValidDrivesStr: String;
  1062. var
  1063. Drive: TDrive;
  1064. begin
  1065. Result := '';
  1066. for Drive := FirstDrive to LastDrive do
  1067. if DriveInfo[Drive].Valid then
  1068. Result := Result + Drive;
  1069. end; {GetValidDriveStr}
  1070. type
  1071. TFolderAttributesGetterThread = class(TCompThread)
  1072. private
  1073. FParentFolder: iShellFolder;
  1074. FPIDL: PItemIDList;
  1075. FshAttr: PUINT;
  1076. protected
  1077. procedure Execute; override;
  1078. public
  1079. constructor Create(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
  1080. class procedure GetFolderAttributes(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
  1081. end;
  1082. class procedure TFolderAttributesGetterThread.GetFolderAttributes(
  1083. ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
  1084. var
  1085. NotResult: Boolean;
  1086. ErrorMode: Word;
  1087. begin
  1088. ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
  1089. try
  1090. try
  1091. NotResult := not Succeeded(ParentFolder.GetAttributesOf(1, PIDL, shAttr^));
  1092. finally
  1093. SetErrorMode(ErrorMode);
  1094. end;
  1095. if NotResult then shAttr^ := 0;
  1096. except
  1097. shAttr^ := 0;
  1098. end;
  1099. end;
  1100. constructor TFolderAttributesGetterThread.Create(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
  1101. begin
  1102. inherited Create(True);
  1103. FParentFolder := ParentFolder;
  1104. FPIDL := PIDL;
  1105. FshAttr := shAttr;
  1106. end;
  1107. procedure TFolderAttributesGetterThread.Execute;
  1108. begin
  1109. GetFolderAttributes(FParentFolder, FPIDL, FshAttr);
  1110. end;
  1111. procedure TDriveView.GetNodeShellAttr(ParentFolder: IShellFolder;
  1112. NodeData: TNodeData; Path: string; ContentMask: Boolean = True);
  1113. var
  1114. {$IFNDEF IDE}
  1115. Thread: TFolderAttributesGetterThread;
  1116. {$ENDIF}
  1117. shAttr: ULONG;
  1118. begin
  1119. if (not Assigned(ParentFolder)) or (not Assigned(NodeData)) then
  1120. Exit;
  1121. if not Assigned(NodeData.PIDL) then
  1122. NodeData.PIDL := PIDL_GetFromParentFolder(ParentFolder, PChar(Path));
  1123. if Assigned(NodeData.PIDL) then
  1124. begin
  1125. if ContentMask then
  1126. shAttr := SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK
  1127. else
  1128. shAttr := SFGAO_DISPLAYATTRMASK;
  1129. // Resoving attributes make take ages, so we run it from a separate thread
  1130. // and timeout waiting for the thread after a second.
  1131. // But when running from IDE, it triggers starting/exiting the thread,
  1132. // again taking ages. So in IDE we revert to single-thread approach
  1133. {$IFDEF IDE}
  1134. TFolderAttributesGetterThread.GetFolderAttributes(ParentFolder, NodeData.PIDL, @shAttr);
  1135. NodeData.shAttr := shAttr;
  1136. {$ELSE}
  1137. Thread := TFolderAttributesGetterThread.Create(ParentFolder, NodeData.PIDL, @shAttr);
  1138. Thread.FreeOnTerminate := True;
  1139. Thread.Resume;
  1140. if Thread.WaitFor(MSecsPerSec) then
  1141. begin
  1142. NodeData.shAttr := shAttr;
  1143. end
  1144. else
  1145. begin
  1146. NodeData.shAttr := 0;
  1147. end;
  1148. {$ENDIF}
  1149. if not ContentMask then
  1150. NodeData.shAttr := NodeData.shAttr or SFGAO_HASSUBFOLDER;
  1151. if not Assigned(NodeData.ShellFolder) then
  1152. begin
  1153. ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder,
  1154. Pointer(NodeData.ShellFolder));
  1155. end;
  1156. end;
  1157. end; {GetNodeAttr}
  1158. procedure TDriveView.RefreshRootNodes(ScanDirectory: Boolean; dsFlags: Integer);
  1159. var
  1160. Drive: Char;
  1161. NewText: string;
  1162. NextDrive: TDrive;
  1163. D: TDrive;
  1164. SaveCursor: TCursor;
  1165. WasValid: Boolean;
  1166. OldSerial: DWORD;
  1167. WFirstDrive: TDrive;
  1168. NodeData: TNodeData;
  1169. begin
  1170. {Fetch disabled drives from the registry:}
  1171. SaveCursor := Screen.Cursor;
  1172. Screen.Cursor := crHourGlass;
  1173. try
  1174. if (dsFlags and dvdsFloppy) <> 0 then
  1175. WFirstDrive := FirstDrive
  1176. else
  1177. WFirstDrive := FirstFixedDrive;
  1178. for Drive := WFirstDrive to LastDrive do
  1179. begin
  1180. with DriveInfo[Drive]^ do
  1181. begin
  1182. WasValid := Assigned(DriveStatus[Drive].RootNode);
  1183. OldSerial := DriveSerial;
  1184. end;
  1185. if ((dsFlags and dvdsReReadAllways) = 0) and
  1186. (Length(DriveInfo[Drive].DisplayName) > 0) then
  1187. dsFlags := dsFlags and (not dsDisplayName);
  1188. DriveInfo.ReadDriveStatus(Drive, dsFlags);
  1189. with DriveInfo[Drive]^, DriveStatus[Drive] do
  1190. begin
  1191. if Valid then
  1192. begin
  1193. if not WasValid then
  1194. {New drive has arrived: insert new rootnode:}
  1195. begin
  1196. NextDrive := LastDrive;
  1197. if not FCreating then
  1198. begin
  1199. for D := Drive to LastDrive do
  1200. begin
  1201. if Assigned(DriveStatus[D].RootNode) then
  1202. begin
  1203. NextDrive := D;
  1204. Break;
  1205. end;
  1206. end;
  1207. end;
  1208. { Create root directory node }
  1209. NodeData := TNodeData.Create;
  1210. NodeData.DirName := Drive + ':\';
  1211. NodeData.ShortName := Drive + ':\';
  1212. {Get the shared attributes:}
  1213. if (Drive >= FirstFixedDrive) and (DriveType <> DRIVE_REMOVABLE) and
  1214. ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive)) then
  1215. begin
  1216. GetNodeShellAttr(FWorkPlace, NodeData, NodeData.DirName);
  1217. end;
  1218. if Assigned(DriveStatus[NextDrive].RootNode) then
  1219. RootNode := Items.InsertObject(DriveStatus[NextDrive].RootNode, '', NodeData)
  1220. else
  1221. RootNode := Items.AddObject(nil, '', NodeData);
  1222. if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
  1223. RootNode.OverlayIndex := 0;
  1224. RootNode.Text := GetDisplayName(RootNode);
  1225. RootNode.HasChildren := True;
  1226. Scanned := False;
  1227. Verified := False;
  1228. end
  1229. else
  1230. if RootNode.ImageIndex <> DriveInfo[Drive].ImageIndex then
  1231. begin {WasValid = True}
  1232. RootNode.ImageIndex := DriveInfo[Drive].ImageIndex;
  1233. RootNode.SelectedIndex := DriveInfo[Drive].ImageIndex;
  1234. end;
  1235. if (Drive >= FirstFixedDrive) and Scanned then
  1236. begin
  1237. if ScanDirectory and (DriveSerial <> OldSerial) then
  1238. begin
  1239. ScanDrive(Drive);
  1240. end;
  1241. end;
  1242. if Assigned(RootNode) then
  1243. begin
  1244. NewText := GetDisplayName(RootNode);
  1245. if RootNode.Text <> NewText then
  1246. RootNode.Text := NewText;
  1247. end;
  1248. end
  1249. else
  1250. if WasValid then
  1251. {Drive has been removed => delete rootnode:}
  1252. begin
  1253. if Directory[1] = Drive then
  1254. begin
  1255. Directory := NodePathName(DriveStatus[Drive].RootNode.GetPrevSibling);
  1256. if not Assigned(Selected) then
  1257. begin
  1258. Directory := NodePathName(DriveStatus[FirstFixedDrive].RootNode);
  1259. end;
  1260. end;
  1261. Scanned := False;
  1262. Verified := False;
  1263. RootNode.Delete;
  1264. RootNode := nil;
  1265. end;
  1266. end;
  1267. end;
  1268. finally
  1269. Screen.Cursor := SaveCursor;
  1270. end;
  1271. end; {RefreshRootNodes}
  1272. function TDriveView.AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
  1273. var
  1274. NewNode: TTreeNode;
  1275. NodeData: TNodeData;
  1276. begin
  1277. NodeData := TNodeData.Create;
  1278. NodeData.Attr := SRec.Attr;
  1279. NodeData.DirName := SRec.Name;
  1280. NodeData.ShortName := SRec.FindData.cAlternateFileName;
  1281. NodeData.FIsRecycleBin :=
  1282. (SRec.Attr and faSysFile <> 0) and
  1283. (ParentNode.Level = 0) and
  1284. ((UpperCase(SRec.Name) = 'RECYCLED') or
  1285. (UpperCase(SRec.Name) = 'RECYCLER'));
  1286. { query content attributes ("has subfolder") only if tree view is visible }
  1287. { to avoid unnecessary scan of subfolders (which may take some time) }
  1288. { if tree view is not visible anyway }
  1289. if not Assigned(TNodeData(ParentNode.Data).ShellFolder) then
  1290. GetNodeShellAttr(FWorkPlace, TNodeData(ParentNode.Data), NodePathName(ParentNode), Visible);
  1291. GetNodeShellAttr(TNodeData(ParentNode.Data).ShellFolder, NodeData, SRec.Name, Visible);
  1292. NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  1293. NewNode.Text := GetDisplayName(NewNode);
  1294. if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
  1295. NewNode.OverlayIndex := 0;
  1296. Result := NewNode;
  1297. end; {AddChildNode}
  1298. function TDriveView.GetDriveStatus(Drive: TDrive): TDriveStatus;
  1299. begin
  1300. Result := DriveStatus[Upcase(Drive)];
  1301. end; {GetDriveStatus}
  1302. function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
  1303. begin
  1304. with TNodeData(FromNode.Data) do
  1305. Result := not IsRecycleBin;
  1306. if Assigned(FOnScanDir) then
  1307. FOnScanDir(Self, FromNode, Result);
  1308. end; {DoScanDir}
  1309. function TDriveView.DirAttrMask: Integer;
  1310. begin
  1311. Result := faDirectory or faSysFile;
  1312. if ShowHiddenDirs then
  1313. Result := Result or faHidden;
  1314. end;
  1315. procedure TDriveView.ScanDrive(Drive: TDrive);
  1316. var
  1317. DosError: Integer;
  1318. RootNode: TTreeNode;
  1319. SaveCursor: TCursor;
  1320. FAnimate: TAnimate;
  1321. procedure ScanPath(const Path: string; ParentNode: TTreeNode);
  1322. var
  1323. SRec: TSearchRec;
  1324. SubNode: TTreeNode;
  1325. begin
  1326. if not DoScanDir(ParentNode) then
  1327. Exit;
  1328. DosError := FindFirst(Path, DirAttrMask, Srec);
  1329. while DosError = 0 do
  1330. begin
  1331. if (SRec.Name <> '.') and
  1332. (SRec.Name <> '..') and
  1333. (SRec.Attr and faDirectory <> 0) then
  1334. begin
  1335. if (SRec.Attr And faDirectory) <> 0 then
  1336. begin { Scan subdirectory }
  1337. SubNode := AddChildNode(ParentNode, SRec);
  1338. TNodeData(SubNode.Data).Scanned := True;
  1339. ScanPath(ExtractFilePath(Path) + SRec.Name + '\*.*', SubNode);
  1340. if not FContinue then
  1341. Break;
  1342. end;
  1343. end;
  1344. DosError := FindNext(SRec);
  1345. end;
  1346. FindClose(Srec);
  1347. if (Items.Count mod 10) = 0 then
  1348. Application.ProcessMessages;
  1349. if not FContinue then
  1350. Exit;
  1351. end; {ScanPath}
  1352. begin {ScanDrive}
  1353. with Self.Items do
  1354. begin
  1355. FContinue := True;
  1356. if not FFullDriveScan then
  1357. begin
  1358. ValidateDirectory(FindNodeToPath(Drive + ':\'));
  1359. DriveStatus[Drive].Scanned := True;
  1360. DriveStatus[Drive].Verified := False;
  1361. end
  1362. else
  1363. begin
  1364. FAnimate := nil;
  1365. SaveCursor := Screen.Cursor;
  1366. Screen.Cursor := crHourGlass;
  1367. Items.BeginUpdate;
  1368. if FShowAnimation then
  1369. begin
  1370. FAnimate := TAnimate.Create(Self);
  1371. FAnimate.Top := (Height - FAnimate.Height) div 2;
  1372. FAnimate.Left := ((Width - FAnimate.Width) * 2) div 3;
  1373. FAnimate.Parent := Self;
  1374. FAnimate.CommonAVI := aviFindFolder;
  1375. FAnimate.Active := True;
  1376. end;
  1377. if Assigned(FOnStartScan) then
  1378. FOnStartScan(Self);
  1379. try
  1380. RootNode := DriveStatus[Drive].RootNode;
  1381. if not Assigned(RootNode) then Exit;
  1382. iF RootNode.HasChildren then
  1383. RootNode.DeleteChildren;
  1384. ScanPath(Drive + ':\*.*', RootNode); { scan subdirectories of rootdir}
  1385. TNodeData(RootNode.Data).Scanned := True;
  1386. DriveStatus[Drive].Scanned := True;
  1387. DriveStatus[Drive].Verified := True;
  1388. finally
  1389. SortChildren(DriveStatus[Drive].RootNode, True);
  1390. EndUpdate;
  1391. if Assigned(FAnimate) then
  1392. FAnimate.Free;
  1393. end;
  1394. RootNode.Expand(False);
  1395. Screen.Cursor := SaveCursor;
  1396. if Assigned(FOnEndScan) then
  1397. FOnEndScan(Self);
  1398. end;
  1399. end;
  1400. end; {ScanDrive}
  1401. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1402. var
  1403. Drive: Char;
  1404. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;
  1405. function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1406. var
  1407. i: Integer;
  1408. Node: TTreeNode;
  1409. Dir: string;
  1410. begin
  1411. {Extract first directory from path:}
  1412. i := Pos('\', Path);
  1413. if i = 0 then
  1414. i := Length(Path);
  1415. Dir := System.Copy(Path, 1, i);
  1416. System.Delete(Path, 1, i);
  1417. if Dir[Length(Dir)] = '\' then
  1418. SetLength(Dir, Pred(Length(Dir)));
  1419. Node := ParentNode.GetFirstChild;
  1420. if not Assigned(Node) then
  1421. begin
  1422. ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
  1423. Node := ParentNode.GetFirstChild;
  1424. end;
  1425. Result := nil;
  1426. while Assigned(Node) do
  1427. begin
  1428. if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
  1429. begin
  1430. if Length(Path) > 0 then
  1431. Result := SearchSubDirs(Node, Path)
  1432. else
  1433. Result := Node;
  1434. Exit;
  1435. end;
  1436. Node := ParentNode.GetNextChild(Node);
  1437. end;
  1438. end;
  1439. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1440. var
  1441. Read: Boolean;
  1442. begin
  1443. Result := nil;
  1444. if Length(Path) > 0 then
  1445. begin
  1446. Read := False;
  1447. if not TNodeData(ParentNode.Data).Scanned then
  1448. begin
  1449. ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
  1450. Read := True;
  1451. end;
  1452. Result := DoSearchSubDirs(ParentNode, Path);
  1453. // reread subfolders, just in case the directory we look for was just created
  1454. // (as can happen when navigating to new remote directory with synchronized
  1455. // browsing enabled and opting to create the non-existing local directory)
  1456. if (not Assigned(Result)) and (not Read) then
  1457. begin
  1458. ValidateDirectoryEx(ParentNode, rsNoRecursive, True);
  1459. Result := DoSearchSubDirs(ParentNode, Path);
  1460. end;
  1461. end;
  1462. end; {SearchSubDirs}
  1463. begin {FindNodeToPath}
  1464. Result := nil;
  1465. if Length(Path) < 3 then
  1466. Exit;
  1467. // Particularly when used by TDirView to delegate browsing to
  1468. // hidden drive view, the handle may not be created
  1469. HandleNeeded;
  1470. Drive := Upcase(Path[1]);
  1471. if (Drive < FirstDrive) or (Drive > LastDrive) then
  1472. EConvertError.Create(Format(ErrorInvalidDrive, [Drive]))
  1473. else
  1474. if Assigned(DriveStatus[Drive].RootNode) then
  1475. begin
  1476. System.Delete(Path, 1, 3);
  1477. if Length(Path) > 0 then
  1478. begin
  1479. if not DriveStatus[Drive].Scanned then
  1480. ScanDrive(Drive);
  1481. Result := SearchSubDirs(DriveStatus[Drive].RootNode, UpperCase(Path));
  1482. end
  1483. else Result := DriveStatus[Drive].RootNode;
  1484. end;
  1485. end; {FindNodetoPath}
  1486. function TDriveView.CheckForSubDirs(Path: string): Boolean;
  1487. var
  1488. DosError: Integer;
  1489. SRec: TSearchRec;
  1490. begin
  1491. Result := False;
  1492. DosError := FindFirst(IncludeTrailingBackslash(Path) + '*.', DirAttrMask, SRec);
  1493. while DosError = 0 do
  1494. begin
  1495. if (SRec.Name <> '.' ) and
  1496. (SRec.Name <> '..') and
  1497. (SRec.Attr and faDirectory <> 0) then
  1498. begin
  1499. Result := True;
  1500. Break;
  1501. end;
  1502. DosError := FindNext(SRec);
  1503. end;
  1504. FindClose(SRec);
  1505. end; {CheckForSubDirs}
  1506. function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  1507. var
  1508. DosError: Integer;
  1509. SRec: TSearchRec;
  1510. NewNode: TTreeNode;
  1511. begin
  1512. Result := False;
  1513. DosError := FindFirst(IncludeTrailingBackslash(NodePath(Node)) + '*.*', DirAttrMask, SRec);
  1514. while DosError = 0 do
  1515. begin
  1516. if (SRec.Name <> '.' ) and
  1517. (SRec.Name <> '..') and
  1518. (SRec.Attr and faDirectory <> 0) then
  1519. begin
  1520. NewNode := AddChildNode(Node, SRec);
  1521. if DoScanDir(NewNode) then
  1522. begin
  1523. NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
  1524. TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
  1525. end
  1526. else
  1527. begin
  1528. NewNode.HasChildren := False;
  1529. TNodeData(NewNode.Data).Scanned := True;
  1530. end;
  1531. Result := True;
  1532. end;
  1533. DosError := FindNext(SRec);
  1534. end; {While DosError = 0}
  1535. FindClose(Srec);
  1536. TNodeData(Node.Data).Scanned := True;
  1537. if Result then SortChildren(Node, False)
  1538. else Node.HasChildren := False;
  1539. Application.ProcessMessages;
  1540. end; {ReadSubDirs}
  1541. function TDriveView.CallBackValidateDir(Var Node: TTreeNode; Data: Pointer): Boolean;
  1542. type
  1543. PSearchRec = ^TSearchRec;
  1544. var
  1545. WorkNode: TTreeNode;
  1546. DelNode: TTreeNode;
  1547. NewNode: TTreeNode;
  1548. SRec: TSearchRec;
  1549. SrecList: TStringList;
  1550. SubDirList: TStringList;
  1551. DosError: Integer;
  1552. Index: Integer;
  1553. NewDirFound: Boolean;
  1554. ParentDir: string;
  1555. begin {CallBackValidateDir}
  1556. Result := True;
  1557. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1558. Exit;
  1559. NewDirFound := False;
  1560. {Check, if directory still exists: (but not with root directory) }
  1561. if Assigned(Node.Parent) and (PScanDirInfo(Data)^.StartNode = Node) then
  1562. if not DirExists(NodePathName(Node)) then
  1563. begin
  1564. WorkNode := Node.Parent;
  1565. if Selected = Node then
  1566. Selected := WorkNode;
  1567. if DropTarget = Node then
  1568. DropTarget := nil;
  1569. Node.Delete;
  1570. Node := nil;
  1571. Exit;
  1572. end;
  1573. WorkNode := Node.GetFirstChild;
  1574. if TNodeData(Node.Data).Scanned and Assigned(WorkNode) then
  1575. {if node was already scanned: check wether the existing subnodes are still alive
  1576. and add all new subdirectories as subnodes:}
  1577. begin
  1578. if DoScanDir(Node) then
  1579. begin
  1580. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  1581. {Build list of existing subnodes:}
  1582. SubDirList := TStringList.Create;
  1583. while Assigned(WorkNode) do
  1584. begin
  1585. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  1586. WorkNode := Node.GetNextChild(WorkNode);
  1587. end;
  1588. {Sorting not required, because the subnodes are already sorted!}
  1589. SRecList := TStringList.Create;
  1590. DosError := FindFirst(ParentDir + '*.*', DirAttrMask, SRec);
  1591. while DosError = 0 do
  1592. begin
  1593. if (Srec.Name <> '.' ) and
  1594. (Srec.Name <> '..') and
  1595. (Srec.Attr and faDirectory <> 0) then
  1596. begin
  1597. SrecList.Add(Srec.Name);
  1598. if not SubDirList.Find(Srec.Name, Index) then
  1599. {Subnode does not exists: add it:}
  1600. begin
  1601. NewNode := AddChildNode(Node, SRec);
  1602. NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
  1603. TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
  1604. NewDirFound := True;
  1605. end;
  1606. end;
  1607. DosError := FindNext(Srec);
  1608. end;
  1609. FindClose(Srec);
  1610. Sreclist.Sort;
  1611. {Remove not existing subnodes:}
  1612. WorkNode := Node.GetFirstChild;
  1613. while Assigned(WorkNode) do
  1614. begin
  1615. if not Assigned(WorkNode.Data) or
  1616. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  1617. begin
  1618. DelNode := WorkNode;
  1619. WorkNode := Node.GetNextChild(WorkNode);
  1620. DelNode.Delete;
  1621. end
  1622. else
  1623. begin
  1624. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  1625. begin
  1626. {Case of directory letters has changed:}
  1627. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  1628. TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
  1629. WorkNode.Text := SrecList[Index];
  1630. end;
  1631. SrecList.Delete(Index);
  1632. WorkNode := Node.GetNextChild(WorkNode);
  1633. end;
  1634. end;
  1635. SrecList.Free;
  1636. SubDirList.Free;
  1637. {Sort subnodes:}
  1638. if NewDirFound then
  1639. SortChildren(Node, False);
  1640. end;
  1641. end
  1642. else
  1643. {Node was not already scanned:}
  1644. if (PScanDirInfo(Data)^.SearchNewDirs or
  1645. TNodeData(Node.Data).Scanned or
  1646. (Node = PScanDirInfo(Data)^.StartNode)) and
  1647. DoScanDir(Node) then
  1648. ReadSubDirs(Node, PScanDirInfo(Data)^.DriveType);
  1649. end; {CallBackValidateDir}
  1650. procedure TDriveView.RebuildTree;
  1651. var
  1652. Drive: TDrive;
  1653. begin
  1654. for Drive := FirstDrive to LastDrive do
  1655. with DriveStatus[Drive] do
  1656. if Assigned(RootNode) and DriveStatus[Drive].Scanned then
  1657. ValidateDirectory(RootNode);
  1658. end;
  1659. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  1660. NewDirs: Boolean);
  1661. var
  1662. Info: PScanDirInfo;
  1663. SelDir: string;
  1664. SaveCursor: TCursor;
  1665. {$IFNDEF NO_THREADS}
  1666. RestartWatchThread: Boolean;
  1667. {$ENDIF}
  1668. SaveCanChange: Boolean;
  1669. CurrentPath: string;
  1670. begin
  1671. if Assigned(Node) and Assigned(Node.Data) and
  1672. (not FValidateFlag) and DoScanDir(Node) then
  1673. begin
  1674. SelDir := Directory;
  1675. SaveCursor := Screen.Cursor;
  1676. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  1677. Screen.Cursor := crHourGlass;
  1678. CurrentPath := NodePath(Node);
  1679. if Node.Level = 0 then
  1680. DriveStatus[CurrentPath[1]].ChangeTimer.Enabled := False;
  1681. {$IFNDEF NO_THREADS}
  1682. RestartWatchThread := WatchThreadActive;
  1683. {$ENDIF}
  1684. try
  1685. {$IFNDEF NO_THREADS}
  1686. if WatchThreadActive then
  1687. StopWatchThread;
  1688. {$ENDIF}
  1689. FValidateFlag := True;
  1690. New(Info);
  1691. Info^.StartNode := Node;
  1692. Info^.SearchNewDirs := NewDirs;
  1693. Info^.DriveType := DriveInfo[CurrentPath[1]].DriveType;
  1694. SaveCanChange := FCanChange;
  1695. FCanChange := True;
  1696. FChangeFlag := False;
  1697. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  1698. FValidateFlag := False;
  1699. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  1700. Directory := Copy(SelDir, 1, 3);
  1701. if (SelDir <> Directory) and (not FChangeFlag) then
  1702. Change(Selected);
  1703. FCanChange := SaveCanChange;
  1704. Dispose(Info);
  1705. finally
  1706. {$IFNDEF NO_THREADS}
  1707. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  1708. StartWatchThread;
  1709. {$ENDIF}
  1710. if Screen.Cursor <> SaveCursor then
  1711. Screen.Cursor := SaveCursor;
  1712. end;
  1713. end;
  1714. end; {ValidateDirectoryEx}
  1715. procedure TDriveView.ValidateDirectoryEasy(Node: TTreeNode);
  1716. begin
  1717. if Assigned(Node) then
  1718. begin
  1719. if not Assigned(Node.Data) or (not TNodeData(Node.Data).Scanned) then
  1720. ValidateDirectoryEx(Node, rsRecursiveExpanded, False);
  1721. end;
  1722. end; {ValidateDirectoryEasy}
  1723. function TDriveView.GetSubTreeSize(Node: TTreeNode): Integer;
  1724. var
  1725. PSubSize: PInt;
  1726. SaveCursor: TCursor;
  1727. begin
  1728. Assert(Assigned(Node));
  1729. SaveCursor := Screen.Cursor;
  1730. Screen.Cursor := crHourGlass;
  1731. ValidateAllDirectories(Node);
  1732. RefreshDirSize(Node);
  1733. New(PSubSize);
  1734. PSubSize^ := 0;
  1735. IterateSubTree(Node, CallBackSetDirSize, rsRecursive, coScanStartNode, PSubSize);
  1736. Result := PSubSize^;
  1737. Dispose(PSubSize);
  1738. Screen.Cursor := SaveCursor;
  1739. end; {GetSubTreeSize}
  1740. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  1741. begin
  1742. Assert(Assigned(Node));
  1743. Result := DriveInfo[NodePath(Node)[1]].DriveType
  1744. end; {GetDriveTypeToNode}
  1745. function TDriveView.GetDriveType(Drive: TDrive): Integer; {Returns DRIVE_CDROM etc..}
  1746. begin
  1747. Result := DriveInfo[UpCase(Drive)].DriveType;
  1748. end; {GetDriveType}
  1749. function TDriveView.NodeUpdateAble(Node: TTreeNode): Boolean;
  1750. begin
  1751. Result := Assigned(Node) and Assigned(Node.Data) and (Node.Level > 0);
  1752. end; {NodeUpdateAble}
  1753. function TDriveView.CallBackSaveNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
  1754. begin
  1755. Result := True;
  1756. TNodeData(Node.Data).Expanded := Node.Expanded;
  1757. end; {CallBackSaveNodeState}
  1758. function TDriveView.CallBackRestoreNodeState(Var Node: TTreeNode; Data: Pointer): Boolean;
  1759. begin
  1760. Result := True;
  1761. Node.Expanded := TNodeData(Node.Data).Expanded;
  1762. end; {CallBackRestoreNodeState}
  1763. procedure TDriveView.SaveNodesState(Node: TTreeNode);
  1764. begin
  1765. IterateSubTree(Node, CallbackSaveNodeState, rsRecursive, coScanStartNode, nil);
  1766. end; {SaveNodesState}
  1767. procedure TDriveView.RestoreNodesState(Node: TTreeNode);
  1768. begin
  1769. Items.BeginUpdate;
  1770. IterateSubTree(Node, CallbackRestoreNodeState, rsRecursive, coScanStartNode, nil);
  1771. Items.EndUpdate;
  1772. end; {RestoreNodesState}
  1773. function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
  1774. var
  1775. SRec: TSearchRec;
  1776. begin
  1777. Assert(Assigned(ParentNode));
  1778. Result := nil;
  1779. if not TNodeData(ParentNode.Data).Scanned then
  1780. ValidateDirectory(ParentNode);
  1781. {$IFNDEF NO_THREADS}
  1782. StopWatchThread;
  1783. {$ENDIF}
  1784. try
  1785. {$IFNDEF NO_THREADS}
  1786. if Assigned(FDirView) then
  1787. FDirView.StopWatchThread;
  1788. {$ENDIF}
  1789. {create phyical directory:}
  1790. LastIOResult := 0;
  1791. if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
  1792. LastIOResult := GetLastError;
  1793. if LastIOResult = 0 then
  1794. begin
  1795. {Create treenode:}
  1796. FindFirst(NodePath(ParentNode) + '\' + NewName, faAnyFile, SRec);
  1797. Result := AddChildNode(ParentNode, Srec);
  1798. FindClose(Srec);
  1799. TNodeData(Result.Data).Scanned := True;
  1800. SortChildren(ParentNode, False);
  1801. ParentNode.Expand(False);
  1802. end;
  1803. finally
  1804. {$IFNDEF NO_THREADS}
  1805. StartWatchThread;
  1806. {$ENDIF}
  1807. if Assigned(FDirView) then
  1808. begin
  1809. {$IFNDEF NO_THREADS}
  1810. FDirView.StartWatchThread;
  1811. {$ENDIF}
  1812. FDirView.Reload2;
  1813. end;
  1814. end;
  1815. end; {CreateDirectory}
  1816. function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
  1817. var
  1818. DelDir: string;
  1819. OperatorResult: Boolean;
  1820. FileOperator: TFileOperator;
  1821. SaveCursor: TCursor;
  1822. begin
  1823. Assert(Assigned(Node));
  1824. Result := False;
  1825. if Assigned(Node) and (Node.Level > 0) then
  1826. begin
  1827. SaveCursor := Screen.Cursor;
  1828. Screen.Cursor := crHourGlass;
  1829. FileOperator := TFileOperator.Create(Self);
  1830. DelDir := NodePathName(Node);
  1831. FileOperator.OperandFrom.Add(DelDir);
  1832. FileOperator.Operation := foDelete;
  1833. if AllowUndo then
  1834. FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
  1835. else
  1836. FileOperator.Flags := FileOperator.Flags - [foAllowUndo];
  1837. if not ConfirmDelete then
  1838. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1839. try
  1840. if DirExists(DelDir) then
  1841. begin
  1842. {$IFNDEF NO_THREADS}
  1843. StopWatchThread;
  1844. {$ENDIF}
  1845. OperatorResult := FileOperator.Execute;
  1846. if OperatorResult and (not FileOperator.OperationAborted) and
  1847. (not DirExists(DelDir)) then
  1848. begin
  1849. Node.Delete
  1850. end
  1851. else
  1852. begin
  1853. Result := False;
  1854. if not AllowUndo then
  1855. begin
  1856. {WinNT4-Bug: FindFirst still returns the directories search record, even if the
  1857. directory was deleted:}
  1858. ChDir(DelDir);
  1859. if IOResult <> 0 then
  1860. Node.Delete;
  1861. end;
  1862. end;
  1863. end
  1864. else
  1865. begin
  1866. Node.Delete;
  1867. Result := True;
  1868. end;
  1869. finally
  1870. {$IFNDEF NO_THREADS}
  1871. StartWatchThread;
  1872. {$ENDIF}
  1873. if Assigned(DirView) and Assigned(Selected) then
  1874. DirView.Path := NodePathName(Selected);
  1875. FileOperator.Free;
  1876. Screen.Cursor := SaveCursor;
  1877. end;
  1878. end;
  1879. end; {DeleteDirectory}
  1880. {$IFNDEF NO_THREADS}
  1881. procedure TDriveView.CreateWatchThread(Drive: TDrive);
  1882. begin
  1883. if csDesigning in ComponentState then
  1884. Exit;
  1885. if (not Assigned(DriveStatus[Drive].DiscMonitor)) and
  1886. FWatchDirectory and
  1887. (DriveInfo[Drive].DriveType <> DRIVE_REMOTE) and
  1888. (Pos(Drive, FNoCheckDrives) = 0) then
  1889. begin
  1890. with DriveStatus[Drive] do
  1891. begin
  1892. DiscMonitor := TDiscMonitor.Create(Self);
  1893. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  1894. DiscMonitor.SubTree := True;
  1895. DiscMonitor.Filters := [moDirName];
  1896. DiscMonitor.OnChange := ChangeDetected;
  1897. DiscMonitor.OnInvalid := ChangeInvalid;
  1898. DiscMonitor.SetDirectory(Drive + ':\');
  1899. DiscMonitor.Open;
  1900. end;
  1901. end;
  1902. end; {CreateWatchThread}
  1903. {$ENDIF}
  1904. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  1905. begin
  1906. if FWatchDirectory <> Value then
  1907. begin
  1908. FWatchDirectory := Value;
  1909. {$IFNDEF NO_THREADS}
  1910. if (not (csDesigning in ComponentState)) and Value then
  1911. StartAllWatchThreads
  1912. else
  1913. StopAllWatchThreads;
  1914. {$ENDIF}
  1915. end;
  1916. end; {SetAutoScan}
  1917. procedure TDriveView.SetDirView(Value: TDirView);
  1918. begin
  1919. if Assigned(FDirView) then
  1920. FDirView.DriveView := nil;
  1921. FDirView := Value;
  1922. if Assigned(FDirView) then
  1923. FDirView.DriveView := Self;
  1924. end; {SetDirView}
  1925. procedure TDriveView.SetChangeInterval(Value: Cardinal);
  1926. var
  1927. Drive: TDrive;
  1928. begin
  1929. if Value > 0 then
  1930. begin
  1931. FChangeInterval := Value;
  1932. for Drive := FirstDrive to LastDrive do
  1933. with DriveStatus[Drive] do
  1934. if Assigned(ChangeTimer) then
  1935. ChangeTimer.Interval := Value;
  1936. end;
  1937. end; {SetChangeInterval}
  1938. procedure TDriveView.SetNoCheckDrives(Value: string);
  1939. begin
  1940. FNoCheckDrives := UpperCase(Value);
  1941. end; {SetNoCheckDrives}
  1942. procedure TDriveView.DeleteSubNodes(Node: TTreeNode);
  1943. begin
  1944. if Assigned(Node) then
  1945. begin
  1946. Node.DeleteChildren;
  1947. if Node.Level = 0 then
  1948. DriveStatus[GetDriveToNode(Node)].Scanned := False;
  1949. Node.HasChildren := False;
  1950. end;
  1951. end; {DeleteSubNodes}
  1952. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  1953. var
  1954. Drive: TDrive;
  1955. begin
  1956. Drive := GetDriveToNode(Node);
  1957. Result := Assigned(DriveStatus[Drive].DiscMonitor) and
  1958. DriveStatus[Drive].DiscMonitor.Active;
  1959. end; {NodeWatched}
  1960. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  1961. const ErrorStr: string);
  1962. var
  1963. Dir: string;
  1964. begin
  1965. Dir := (Sender as TDiscMonitor).Directories[0];
  1966. with DriveStatus[Dir[1]] do
  1967. begin
  1968. DiscMonitor.Close;
  1969. if Assigned(FOnChangeInvalid) then
  1970. FOnChangeInvalid(Self, Dir[1]);
  1971. end;
  1972. end; {DirWatchChangeInvalid}
  1973. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  1974. var SubdirsChanged: Boolean);
  1975. var
  1976. DirChanged: string;
  1977. begin
  1978. if Sender is TDiscMonitor then
  1979. begin
  1980. DirChanged := (Sender as TDiscMonitor).Directories[0];
  1981. if Length(DirChanged) > 0 then
  1982. with DriveStatus[DirChanged[1]] do
  1983. begin
  1984. ChangeTimer.Interval := 0;
  1985. ChangeTimer.Interval := FChangeInterval;
  1986. ChangeTimer.Enabled := True;
  1987. end;
  1988. end;
  1989. end; {DirWatchChangeDetected}
  1990. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  1991. var
  1992. Node: TTreeNode;
  1993. Drive: TDrive;
  1994. begin
  1995. if Sender is TTimer then
  1996. with TTimer(Sender) do
  1997. begin
  1998. Drive := Chr(Tag);
  1999. Node := FindNodeToPath(Drive + ':\');
  2000. Interval := 0;
  2001. Enabled := False;
  2002. if Assigned(Node) then
  2003. begin
  2004. {Check also collapsed (invisible) subdirectories:}
  2005. ValidateDirectory(Node);
  2006. if Assigned(FOnChangeDetected) then
  2007. FOnChangeDetected(Self, Drive);
  2008. end;
  2009. end;
  2010. end; {ChangeTimerOnTimer}
  2011. {$IFNDEF NO_THREADS}
  2012. procedure TDriveView.StartWatchThread;
  2013. var
  2014. NewWatchedDir: string;
  2015. Drive: TDrive;
  2016. begin
  2017. if (csDesigning in ComponentState) or
  2018. not Assigned(Selected) or
  2019. not fWatchDirectory then Exit;
  2020. NewWatchedDir := NodePathName(RootNode(Selected));
  2021. Drive := Upcase(NewWatchedDir[1]);
  2022. with DriveStatus[Drive] do
  2023. begin
  2024. if not Assigned(DiscMonitor) then
  2025. CreateWatchThread(Drive);
  2026. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  2027. DiscMonitor.Enabled := True;
  2028. end;
  2029. end; {StartWatchThread}
  2030. procedure TDriveView.StopWatchThread;
  2031. begin
  2032. if Assigned(Selected) then
  2033. with DriveStatus[GetDriveToNode(Selected)] do
  2034. if Assigned(DiscMonitor) then
  2035. DiscMonitor.Enabled := False;
  2036. end; {StopWatchThread}
  2037. procedure TDriveView.TerminateWatchThread(Drive: TDrive);
  2038. begin
  2039. if Drive >= FirstDrive then
  2040. with DriveStatus[Drive] do
  2041. if Assigned(DiscMonitor) then
  2042. begin
  2043. DiscMonitor.Free;
  2044. DiscMonitor := nil;
  2045. end;
  2046. end; {StopWatchThread}
  2047. procedure TDriveView.StartAllWatchThreads;
  2048. var
  2049. Drive: TDrive;
  2050. begin
  2051. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2052. Exit;
  2053. for Drive := FirstFixedDrive to LastDrive do
  2054. with DriveStatus[Drive] do
  2055. if Scanned then
  2056. begin
  2057. if not Assigned(DiscMonitor) then
  2058. CreateWatchThread(Drive);
  2059. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  2060. DiscMonitor.Open;
  2061. end;
  2062. if Assigned(Selected) and (GetDriveToNode(Selected) < FirstFixedDrive) then
  2063. StartWatchThread;
  2064. end; {StartAllWatchThreads}
  2065. procedure TDriveView.StopAllWatchThreads;
  2066. var
  2067. Drive: TDrive;
  2068. begin
  2069. for Drive := FirstDrive to LastDrive do
  2070. with DriveStatus[Drive] do
  2071. begin
  2072. if Assigned(DiscMonitor) then
  2073. DiscMonitor.Close;
  2074. end;
  2075. end; {StopAllWatchThreads}
  2076. function TDriveView.WatchThreadActive(Drive: TDrive): Boolean;
  2077. begin
  2078. Result := FWatchDirectory and
  2079. Assigned(DriveStatus[Drive].DiscMonitor) and
  2080. DriveStatus[Drive].DiscMonitor.Active;
  2081. end; {WatchThreadActive}
  2082. function TDriveView.WatchThreadActive: Boolean;
  2083. var
  2084. Drive: TDrive;
  2085. begin
  2086. if not Assigned(Selected) then
  2087. begin
  2088. Result := False;
  2089. Exit;
  2090. end;
  2091. Drive := GetDriveToNode(Selected);
  2092. Result := FWatchDirectory and
  2093. Assigned(DriveStatus[Drive].DiscMonitor) and
  2094. DriveStatus[Drive].DiscMonitor.Active;
  2095. end; {WatchThreadActive}
  2096. {$ENDIF}
  2097. procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
  2098. begin
  2099. FFullDriveScan := DoFullDriveScan;
  2100. end; {SetAutoScan}
  2101. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2102. begin
  2103. {Find existing path or parent path of not existing path:}
  2104. repeat
  2105. Result := FindNodeToPath(Path);
  2106. if not Assigned(Result) then
  2107. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2108. until Assigned(Result) or (Length(Path) < 3);
  2109. end;
  2110. procedure TDriveView.SetDirectory(Value: string);
  2111. begin
  2112. Value := IncludeTrailingBackslash(Value);
  2113. FDirectory := Value;
  2114. inherited;
  2115. if Assigned(Selected) and (Selected.Level = 0) then
  2116. begin
  2117. if not DriveStatus[GetDriveToNode(Selected)].Scanned then
  2118. ScanDrive(GetDriveToNode(Selected));
  2119. end;
  2120. end; {SetDirectory}
  2121. procedure TDriveView.SetDrive(Drive: TDrive);
  2122. begin
  2123. if GetDrive <> Drive then
  2124. with DriveStatus[Drive] do
  2125. if Assigned(RootNode) then
  2126. begin
  2127. if DefaultDir = EmptyStr then
  2128. DefaultDir := Drive + ':\';
  2129. if not Scanned then
  2130. RootNode.Expand(False);
  2131. TopItem := RootNode;
  2132. Directory := IncludeTrailingBackslash(DefaultDir);
  2133. end;
  2134. end; {SetDrive}
  2135. function TDriveView.GetDrive: TDrive;
  2136. begin
  2137. if Assigned(Selected) then
  2138. Result := GetDriveToNode(Selected)
  2139. else
  2140. Result := #0;
  2141. end; {GetDrive}
  2142. function TDriveView.GetDirName(Node: TTreeNode): string;
  2143. begin
  2144. if Assigned(Node) and Assigned(Node.Data) then
  2145. Result := TNodeData(Node.Data).DirName
  2146. else
  2147. Result := '';
  2148. end; {GetDirName}
  2149. {GetDrive: returns the driveletter of the Node.}
  2150. function TDriveView.GetDriveToNode(Node: TTreeNode): Char;
  2151. var
  2152. Path: string;
  2153. begin
  2154. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2155. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2156. Path := NodePath(Node);
  2157. if Length(Path) > 0 then
  2158. Result := Upcase(Path[1])
  2159. else
  2160. Result := #0;
  2161. end; {GetDrive}
  2162. {RootNode: returns the rootnode to the Node:}
  2163. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2164. begin
  2165. Result := Node;
  2166. if not Assigned(Node) then
  2167. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2168. while Assigned(Result.Parent) do
  2169. Result := Result.Parent;
  2170. end; {RootNode}
  2171. {NodeAttr: Returns the directory attributes to the node:}
  2172. function TDriveView.NodeAttr(Node: TTreeNode): Integer;
  2173. begin
  2174. if not Assigned(Node) then
  2175. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['NodeAttr']));
  2176. Result := TNodeData(Node.Data).Attr;
  2177. end; {NodeAttr}
  2178. function TDriveView.NodeVerified(Node: TTreeNode): Boolean;
  2179. begin
  2180. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2181. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['NodeVerified']));
  2182. Result := TNodeData(Node.Data).Scanned;
  2183. end; {NodeVerified}
  2184. function TDriveView.CallBackExpandLevel(var Node: TTreeNode; Data: Pointer): Boolean;
  2185. begin
  2186. Result := True;
  2187. if not Assigned(Node) then
  2188. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['CallBackExpandLevel']));
  2189. if (Node.Level <= Integer(Data)) and (not Node.Expanded) then
  2190. Node.Expand(False)
  2191. else if (Node.Level > Integer(Data)) and Node.Expanded then
  2192. Node.Collapse(True);
  2193. end; {CallBackExpandLevel}
  2194. procedure TDriveView.ExpandLevel(Node: TTreeNode; Level: Integer);
  2195. {Purpose: Expands all subnodes of node up to the given level}
  2196. begin
  2197. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2198. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['ExpandLevel']));
  2199. Items.BeginUpdate;
  2200. IterateSubTree(Node, CallBackExpandLevel, rsRecursive, coScanStartNode, Pointer(Level));
  2201. Items.EndUpdate;
  2202. end; {ExpandLevel}
  2203. function TDriveView.CallBackDisplayName(var Node: TTreeNode; Data: Pointer): Boolean;
  2204. begin
  2205. Result := True;
  2206. if not Assigned(Node) then
  2207. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['CallBackDisplayName']));
  2208. Node.Text := GetDisplayName(Node);
  2209. end; {CallBackDisplayName}
  2210. function TDriveView.CallBackSetDirSize(var Node: TTreeNode; Data: Pointer): Boolean;
  2211. begin
  2212. Result := True;
  2213. if Assigned(Node) then
  2214. begin
  2215. SetDirSize(Node);
  2216. if FShowDirSize then
  2217. Node.Text := GetDisplayName(Node);
  2218. if Assigned(Data) then
  2219. Inc(PInt(Data)^, TNodeData(Node.Data).DirSize);
  2220. end;
  2221. Application.ProcessMessages;
  2222. if not FContinue then
  2223. Exit;
  2224. end; {CallBackSetDirSize}
  2225. procedure TDriveView.SetShowDirSize(ShowIt: Boolean);
  2226. var
  2227. Drive: Char;
  2228. RootNode: TTreeNode;
  2229. SaveCursor: TCursor;
  2230. begin
  2231. if ShowIt = FShowDirSize then
  2232. Exit;
  2233. FShowDirSize := ShowIt;
  2234. SaveCursor := Screen.Cursor;
  2235. Screen.Cursor := crHourGlass;
  2236. Items.BeginUpdate;
  2237. for Drive := FirstFixedDrive to LastDrive do
  2238. begin
  2239. if DriveInfo[Drive].Valid then
  2240. begin
  2241. RootNode := DriveStatus[Drive].RootNode;
  2242. if Assigned(RootNode) then
  2243. IterateSubTree(RootNode, CallBackDisplayName, rsRecursive, coScanStartNode, nil);
  2244. end;
  2245. end;
  2246. Items.EndUpdate;
  2247. Screen.Cursor := SaveCursor;
  2248. end; {SetShowDirSize}
  2249. procedure TDriveView.RefreshDirSize(Node: TTreeNode);
  2250. begin
  2251. if not Assigned(Node) then
  2252. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RefreshDirSize']));
  2253. CallBackSetDirSize(Node, nil);
  2254. end; {RefreshDirSize}
  2255. procedure TDriveView.RefreshDriveDirSize(Drive: TDrive);
  2256. var
  2257. SaveCursor: TCursor;
  2258. begin
  2259. SaveCursor := Screen.Cursor;
  2260. Screen.Cursor := crHourGlass;
  2261. Items.BeginUpdate;
  2262. with DriveStatus[Drive] do
  2263. begin
  2264. if Assigned(RootNode) then
  2265. IterateSubTree(RootNode, CallBackSetDirSize, rsRecursive, coScanStartNode, nil);
  2266. end;
  2267. Items.EndUpdate;
  2268. Screen.Cursor := SaveCursor;
  2269. end; {RefreshDriveDirSize}
  2270. function TDriveView.GetDirSize(Node: TTreeNode): Cardinal;
  2271. begin
  2272. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2273. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirSize']));
  2274. if TNodeData(Node.Data).DirSize = CInvalidSize then
  2275. SetDirSize(Node);
  2276. Result := TNodeData(Node.Data).DirSize;
  2277. end; {GetDirSize}
  2278. procedure TDriveView.SetDirSize(Node: TTreeNode);
  2279. var
  2280. SRec: TSearchRec;
  2281. Size: Cardinal;
  2282. begin
  2283. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2284. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['SetDirSize']));
  2285. Size := 0;
  2286. if FindFirst(IncludeTrailingBackslash(NodePath(Node)) + '*.*', faAnyFile, SRec) = 0 then
  2287. begin
  2288. repeat
  2289. if (SRec.Attr and faDirectory) = 0 then
  2290. Inc(Size, SRec.Size);
  2291. until FindNext(SRec) <> 0;
  2292. end;
  2293. FindClose(Srec);
  2294. TNodeData(Node.Data).DirSize := Size;
  2295. end; {SetDirSize}
  2296. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2297. var
  2298. DirName: string;
  2299. begin
  2300. Result := '';
  2301. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2302. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2303. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  2304. else
  2305. begin
  2306. DirName := GetDirName(Node);
  2307. case FFileNameDisplay of
  2308. fndCap: Result := UpperCase(DirName);
  2309. fndNoCap: Result := LowerCase(DirName);
  2310. fndNice: if Length(DirName) <= 8 then
  2311. begin
  2312. Result := LowerCase(DirName);
  2313. Result[1] := Upcase(Result[1]);
  2314. end
  2315. else Result := DirName;
  2316. else
  2317. Result := DirName;
  2318. end; {Case}
  2319. end;
  2320. if FShowDirSize then
  2321. Result := Result + ' = ' + FormatBytes(GetDirSize(Node), True, False);
  2322. end; {GetDisplayName}
  2323. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2324. begin
  2325. IF ShowIt = fShowVolLabel Then
  2326. Exit;
  2327. fShowVolLabel := ShowIt;
  2328. RefreshRootNodes(False, dvdsFloppy);
  2329. End; {SetShowVolLabel}
  2330. procedure TDriveView.SetVolDisplayStyle(DoStyle: TVolumeDisplayStyle);
  2331. var
  2332. Drive: TDrive;
  2333. begin
  2334. if DoStyle <> fVolDisplayStyle then
  2335. begin
  2336. FVolDisplayStyle := DoStyle;
  2337. if not FCreating then
  2338. for Drive := FirstDrive to LastDrive do
  2339. begin
  2340. if DriveInfo[Drive].Valid then
  2341. DriveStatus[Drive].RootNode.Text := GetDisplayName(DriveStatus[Drive].RootNode);
  2342. end;
  2343. end;
  2344. end; {SetVolDisplayStyle}
  2345. procedure TDriveView.SetCompressedColor(Value: TColor);
  2346. begin
  2347. if Value <> FCompressedColor then
  2348. begin
  2349. FCompressedColor := Value;
  2350. Invalidate;
  2351. end;
  2352. end; {SetCompressedColor}
  2353. procedure TDriveView.SetFileNameDisplay(Value: TFileNameDisplay);
  2354. var
  2355. Drive: TDrive;
  2356. begin
  2357. if Value <> FFileNameDisplay then
  2358. begin
  2359. FFileNameDisplay := Value;
  2360. for Drive := FirstDrive to LastDrive do
  2361. with DriveStatus[Drive] do
  2362. if Assigned(RootNode) and DriveStatus[Drive].Scanned then
  2363. IterateSubTree(RootNode, CallBackDisplayName, rsRecursive, coNoScanStartNode, nil);
  2364. end;
  2365. end; {SetFileNameDisplay}
  2366. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2367. var
  2368. Verb: string;
  2369. DirWatched: Boolean;
  2370. begin
  2371. {$IFNDEF NO_THREADS}
  2372. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2373. {$ELSE}
  2374. DirWatched := False;
  2375. {$ENDIF}
  2376. Assert(Node <> nil);
  2377. if Node <> Selected then
  2378. DropTarget := Node;
  2379. Verb := EmptyStr;
  2380. if Assigned(FOnDisplayContextMenu) then
  2381. FOnDisplayContextMenu(Self);
  2382. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2383. CanEdit(Node), Verb, False);
  2384. if Verb = shcRename then Node.EditText
  2385. else
  2386. if Verb = shcCut then
  2387. begin
  2388. LastClipBoardOperation := cboCut;
  2389. LastPathCut := NodePathName(Node);
  2390. end
  2391. else
  2392. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2393. else
  2394. if Verb = shcPaste then
  2395. PasteFromClipBoard(NodePathName(Node));
  2396. DropTarget := nil;
  2397. if not DirWatched then
  2398. ValidateDirectory(Node);
  2399. end; {DisplayContextMenu (2)}
  2400. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2401. begin
  2402. Assert(Assigned(Node));
  2403. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2404. end; {ContextMenu}
  2405. procedure TDriveView.SetSelected(Node: TTreeNode);
  2406. begin
  2407. if Node <> Selected then
  2408. begin
  2409. FChangeFlag := False;
  2410. FCanChange := True;
  2411. inherited Selected := Node;
  2412. if not FChangeFlag then
  2413. Change(Selected);
  2414. end;
  2415. end; {SetSelected}
  2416. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2417. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2418. begin
  2419. if Files.Count > 0 then
  2420. ValidateDirectory(FindNodeToPath(Files[0]));
  2421. end; {SignalDirDelete}
  2422. function TDriveView.DDSourceEffects: TDropEffectSet;
  2423. begin
  2424. if FDragNode.Level = 0 then
  2425. Result := [deLink]
  2426. else
  2427. Result := [deLink, deCopy, deMove];
  2428. end;
  2429. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
  2430. var
  2431. TargetDrive: Char;
  2432. begin
  2433. if DropTarget = nil then Effect := DropEffect_None
  2434. else
  2435. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  2436. begin
  2437. TargetDrive := NodePath(DropTarget)[1];
  2438. if FExeDrag and (TargetDrive >= FirstFixedDrive) and (FDragDrive >= FirstFixedDrive) then
  2439. begin
  2440. Effect := DropEffect_Link;
  2441. end
  2442. else
  2443. if (Effect = DropEffect_Copy) and
  2444. ((DragDrive = GetDriveToNode(DropTarget)) and
  2445. (FDragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0)) then
  2446. begin
  2447. Effect := DropEffect_Move;
  2448. end;
  2449. end;
  2450. inherited;
  2451. end;
  2452. function TDriveView.DragCompleteFileList: Boolean;
  2453. begin
  2454. Result := (GetDriveType(NodePathName(FDragNode)[1]) <> DRIVE_REMOVABLE);
  2455. end;
  2456. function TDriveView.DDExecute: TDragResult;
  2457. {$IFNDEF NO_THREADS}
  2458. var
  2459. WatchThreadOK: Boolean;
  2460. DragParentPath: string;
  2461. DragPath: string;
  2462. {$ENDIF}
  2463. begin
  2464. {$IFNDEF NO_THREADS}
  2465. WatchThreadOK := WatchThreadActive;
  2466. {$ENDIF}
  2467. Result := FDragDropFilesEx.Execute(nil);
  2468. {$IFNDEF NO_THREADS}
  2469. if (Result = drMove) and (not WatchThreadOK) then
  2470. begin
  2471. DragPath := NodePathName(FDragNode);
  2472. if Assigned(FDragNode.Parent) then
  2473. DragParentPath := NodePathName(FDragNode.Parent)
  2474. else
  2475. DragParentPath := DragPath;
  2476. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2477. begin
  2478. FDragNode := FindNodeToPath(DragPath);
  2479. if Assigned(FDragNode) then
  2480. begin
  2481. FDragFileList.Clear;
  2482. FDragFileList.Add(DragPath);
  2483. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2484. end;
  2485. end;
  2486. end;
  2487. {$ENDIF}
  2488. end;
  2489. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2490. var
  2491. i: Integer;
  2492. SourcePath: string;
  2493. SourceParentPath: string;
  2494. SourceFile: string;
  2495. SaveCursor: TCursor;
  2496. DoFileOperation: Boolean;
  2497. TargetNode: TTreeNode;
  2498. FileNamesAreMapped: Boolean;
  2499. TargetPath: string;
  2500. IsRecycleBin: Boolean;
  2501. begin
  2502. TargetPath := NodePathName(Node);
  2503. IsRecycleBin := NodeIsRecycleBin(Node);
  2504. if FDragDropFilesEx.FileList.Count = 0 then
  2505. Exit;
  2506. SaveCursor := Screen.Cursor;
  2507. Screen.Cursor := crHourGlass;
  2508. SourcePath := EmptyStr;
  2509. try
  2510. if (Effect = DropEffect_Copy) or (Effect = DropEffect_Move) then
  2511. begin
  2512. {$IFNDEF NO_THREADS}
  2513. StopAllWatchThreads;
  2514. if Assigned(FDirView) then
  2515. FDirView.StopWatchThread;
  2516. if Assigned(DropSourceControl) and
  2517. (DropSourceControl is TDirView) and
  2518. (DropSourceControl <> FDirView) then
  2519. begin
  2520. TDirView(DropSourceControl).StopWatchThread;
  2521. end;
  2522. {$ENDIF}
  2523. FileNamesAreMapped := (TFDDListItem(FDragDropFilesEx.FileList[0]^).MappedName <> '');
  2524. {Set the source directory:}
  2525. for i := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2526. begin
  2527. FFileOperator.OperandFrom.Add(
  2528. TFDDListItem(FDragDropFilesEx.FileList[i]^).Name);
  2529. if FileNamesAreMapped then
  2530. FFileOperator.OperandTo.Add(IncludeTrailingBackslash(TargetPath) +
  2531. TFDDListItem(FDragDropFilesEx.FileList[i]^).MappedName);
  2532. end;
  2533. SourcePath := TFDDListItem(FDragDropFilesEx.FileList[0]^).Name;
  2534. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2535. ClearDragFileList(FDragDropFilesEx.FileList);
  2536. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  2537. {Set the target directory or target files:}
  2538. if FileNamesAreMapped and (not IsRecycleBin) then
  2539. begin
  2540. FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles]
  2541. end
  2542. else
  2543. begin
  2544. FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
  2545. FFileOperator.OperandTo.Clear;
  2546. FFileOperator.OperandTo.Add(TargetPath);
  2547. end;
  2548. if IsRecycleBin then FFileOperator.Operation := foDelete
  2549. else
  2550. case Effect of
  2551. DropEffect_Copy: FFileOperator.Operation := foCopy;
  2552. DropEffect_Move: FFileOperator.Operation := foMove;
  2553. end; {Case}
  2554. if IsRecycleBin then
  2555. begin
  2556. if not ConfirmDelete then
  2557. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  2558. end
  2559. else
  2560. if not ConfirmOverwrite then
  2561. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  2562. DoFileOperation := True;
  2563. if Assigned(FOnDDFileOperation) then
  2564. FOnDDFileOperation(Self, Effect, SourcePath, TargetPath, DoFileOperation);
  2565. if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
  2566. begin
  2567. FFileOperator.Execute;
  2568. if Assigned(FOnDDFileOperationExecuted) then
  2569. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2570. if FileNamesAreMapped then
  2571. FFileOperator.ClearUndo;
  2572. end;
  2573. end
  2574. else
  2575. if Effect = DropEffect_Link then
  2576. { Create Link requested: }
  2577. begin
  2578. for i := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2579. begin
  2580. SourceFile := TFDDListItem(FDragDropFilesEx.FileList[i]^).Name;
  2581. if Length(SourceFile) = 3 then
  2582. SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
  2583. else
  2584. SourcePath := ExtractFileName(SourceFile);
  2585. if not CreateFileShortCut(SourceFile,
  2586. IncludeTrailingBackslash(TargetPath) + ChangeFileExt(SourcePath, '.lnk'),
  2587. ExtractFileNameOnly(SourceFile)) then
  2588. begin
  2589. DDError(DDCreateShortCutError);
  2590. end;
  2591. end;
  2592. end;
  2593. if Effect = DropEffect_Move then
  2594. Items.BeginUpdate;
  2595. {Update source directory, if move-operation was performed:}
  2596. if ((Effect = DropEffect_Move) or IsRecycleBin) then
  2597. ValidateDirectory(FindNodeToPath(SourceParentPath));
  2598. {Update subdirectories of target directory:}
  2599. TargetNode := FindNodeToPath(TargetPath);
  2600. if Assigned(TargetNode) then
  2601. ValidateDirectory(TargetNode)
  2602. else
  2603. ValidateDirectory(DriveStatus[TargetPath[1]].RootNode);
  2604. if Effect = DropEffect_Move then
  2605. Items.EndUpdate;
  2606. {Update linked component TDirView:}
  2607. if Assigned(FDirView)
  2608. {$IFNDEF NO_THREADS}
  2609. and not FDirView.WatchThreadActive
  2610. {$ENDIF}
  2611. then
  2612. begin
  2613. case Effect of
  2614. DropEffect_Copy,
  2615. DropEffect_Link:
  2616. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2617. FDirView.Reload2;
  2618. DropEffect_Move:
  2619. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2620. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2621. begin
  2622. if FDirView <> DropSourceControl then FDirView.Reload2;
  2623. end;
  2624. end; {Case}
  2625. end;
  2626. {Update the DropSource control, if files are moved and it is a TDirView:}
  2627. if (Effect = DropEffect_Move) and (DropSourceControl is TDirView) then
  2628. TDirView(DropSourceControl).ValidateSelectedFiles;
  2629. finally
  2630. FFileOperator.OperandFrom.Clear;
  2631. FFileOperator.OperandTo.Clear;
  2632. {$IFNDEF NO_THREADS}
  2633. StartAllWatchThreads;
  2634. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2635. FDirView.StartWatchThread;
  2636. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2637. (not TDirView(DropSourceControl).WatchThreadActive) then
  2638. TDirView(DropSourceControl).StartWatchThread;
  2639. {$ENDIF}
  2640. Screen.Cursor := SaveCursor;
  2641. end;
  2642. end; {PerformDragDropFileOperation}
  2643. function TDriveView.GetCanUndoCopyMove: Boolean;
  2644. begin
  2645. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2646. end; {CanUndoCopyMove}
  2647. function TDriveView.UndoCopyMove: Boolean;
  2648. var
  2649. LastTarget: string;
  2650. LastSource: string;
  2651. begin
  2652. Result := False;
  2653. if FFileOperator.CanUndo then
  2654. begin
  2655. Lasttarget := FFileOperator.LastOperandTo[0];
  2656. LastSource := FFileOperator.LastOperandFrom[0];
  2657. {$IFNDEF NO_THREADS}
  2658. StopAllWatchThreads;
  2659. {$ENDIF}
  2660. Result := FFileOperator.UndoExecute;
  2661. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2662. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2663. {$IFNDEF NO_THREADS}
  2664. StartAllWatchThreads;
  2665. {$ENDIF}
  2666. if Assigned(FDirView) then
  2667. with FDirView do
  2668. {$IFNDEF NO_THREADS}
  2669. if not WatchThreadActive then
  2670. {$ENDIF}
  2671. begin
  2672. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2673. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2674. Reload2;
  2675. end;
  2676. end;
  2677. end; {UndoCopyMove}
  2678. {Clipboard operations:}
  2679. procedure TDriveView.SetLastPathCut(Path: string);
  2680. var
  2681. Node: TTreeNode;
  2682. begin
  2683. if FLastPathCut <> Path then
  2684. begin
  2685. Node := FindNodeToPath(FLastPathCut);
  2686. if Assigned(Node) then
  2687. begin
  2688. FLastPathCut := Path;
  2689. Node.Cut := False;
  2690. end;
  2691. Node := FindNodeToPath(Path);
  2692. if Assigned(Node) then
  2693. begin
  2694. FLastPathCut := Path;
  2695. Node.Cut := True;
  2696. end;
  2697. end;
  2698. end; {SetLastNodeCut}
  2699. procedure TDriveView.EmptyClipboard;
  2700. begin
  2701. if Windows.OpenClipBoard(0) then
  2702. begin
  2703. Windows.EmptyClipBoard;
  2704. Windows.CloseClipBoard;
  2705. LastPathCut := '';
  2706. LastClipBoardOperation := cboNone;
  2707. if Assigned(FDirView) then
  2708. FDirView.EmptyClipboard;
  2709. end;
  2710. end; {EmptyClipBoard}
  2711. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2712. begin
  2713. Result := Assigned(Selected);
  2714. if Result then
  2715. begin
  2716. EmptyClipBoard;
  2717. ClearDragFileList(FDragDropFilesEx.FileList);
  2718. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2719. Result := FDragDropFilesEx.CopyToClipBoard;
  2720. LastClipBoardOperation := cboCopy;
  2721. end;
  2722. end; {CopyToClipBoard}
  2723. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2724. begin
  2725. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2726. if Result then
  2727. begin
  2728. LastPathCut := NodePathName(Node);
  2729. LastClipBoardOperation := cboCut;
  2730. end;
  2731. end; {CutToClipBoard}
  2732. function TDriveView.CanPasteFromClipBoard: Boolean;
  2733. begin
  2734. Result := False;
  2735. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2736. begin
  2737. Result := IsClipboardFormatAvailable(CF_HDROP);
  2738. Windows.CloseClipBoard;
  2739. end;
  2740. end; {CanPasteFromClipBoard}
  2741. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2742. begin
  2743. ClearDragFileList(FDragDropFilesEx.FileList);
  2744. Result := False;
  2745. if CanPasteFromClipBoard and
  2746. {MP}{$IFDEF OLD_DND} FDragDropFilesEx.GetFromClipBoard {$ELSE} FDragDropFilesEx.PasteFromClipboard {$ENDIF}{/MP}
  2747. then
  2748. begin
  2749. if TargetPath = '' then
  2750. TargetPath := NodePathName(Selected);
  2751. case LastClipBoardOperation of
  2752. cboCopy,
  2753. cboNone:
  2754. begin
  2755. PerformDragDropFileOperation(Selected, DropEffect_Copy);
  2756. if Assigned(FOnDDExecuted) then
  2757. FOnDDExecuted(Self, DropEffect_Copy);
  2758. end;
  2759. cboCut:
  2760. begin
  2761. PerformDragDropFileOperation(Selected, DropEffect_Move);
  2762. if Assigned(FOnDDExecuted) then
  2763. FOnDDExecuted(Self, DropEffect_Move);
  2764. EmptyClipBoard;
  2765. end;
  2766. end;
  2767. Result := True;
  2768. end;
  2769. end; {PasteFromClipBoard}
  2770. end.