DriveView.pas 87 KB

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