1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154 |
- unit DriveView;
- {==================================================================
- Component TDriveView / Version 2.6, January 2000
- ==================================================================
- Description:
- ============
- Displays the the directory structure of all drives as treeview
- with shell icons. Complete drag&Drop support for files and
- directories.
- Author:
- =======
- (c) Ingo Eckel 1998, 1999
- Sodener Weg 38
- 65812 Bad Soden
- Germany
- Modifications (for WinSCP):
- ===========================
- (c) Martin Prikryl 2004
- V2.6:
- - Shows "shared"-symbol with directories
- - Delphi5 compatible
- For detailed documentation and history see TDriveView.htm.
- {==================================================================}
- interface
- { Define ENHVALIDATE to scan all existing directories on a detected filesystem change:}
- {.$DEFINE ENHVALIDATE}
- {Required compiler options for TDriveView:}
- {$A+,B-,X+,H+,P+}
- {$WARN SYMBOL_PLATFORM OFF}
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComObj,
- Dialogs, ComCtrls, ShellApi, CommCtrl, ExtCtrls, ActiveX, ShlObj,
- DirView, ShellDialogs, DragDrop, DragDropFilesEx, FileChanges, FileOperator,
- DiscMon, IEDriveInfo, IEListView, PIDL, BaseUtils, ListExt, CustomDirView,
- CustomDriveView;
- {$I ResStrings.pas}
- const
- {$IFNDEF NO_THREADS}
- msThreadChangeDelay = 50;
- {$ENDIF}
- CInvalidSize = $FFFFFFFF;
- ErrorNodeNA = '%s: Node not assigned';
- {Flags used by TDriveView.RefreshRootNodes:}
- dvdsFloppy = 8; {Include floppy drives}
- dvdsRereadAllways = 16; {Refresh drivestatus in any case}
- type
- ECreateShortCut = class(Exception);
- EInvalidDirName = class(Exception);
- EInvalidPath = class(Exception);
- ENodeNotAssigned = class(Exception);
- TDriveStatus = record
- Scanned: Boolean; {Drive allready scanned?}
- Verified: Boolean; {Drive completly scanned?}
- RootNode: TTreeNode; {Rootnode to drive}
- RootNodeIndex: Integer;
- {$IFNDEF NO_THREADS}
- DiscMonitor: TDiscMonitor; {Monitor thread}
- {$ENDIF}
- ChangeTimer: TTimer; {Change timer for the monitor thread}
- DefaultDir: string; {Current directory}
- end;
- TScanDirInfo = record
- SearchNewDirs: Boolean;
- StartNode: TTreeNode;
- DriveType: Integer;
- end;
- PScanDirInfo = ^TScanDirInfo;
- TDriveViewScanDirEvent = procedure(Sender: TObject; Node: TTreeNode;
- var DoScanDir: Boolean) of object;
- TDriveViewDiskChangeEvent = procedure(Sender: TObject; Drive: TDrive) of object;
- TDriveView = class;
- TNodeData = class
- private
- FDirName: string;
- FShortName: string;
- FAttr: Integer;
- FScanned: Boolean;
- FData: Pointer;
- FExpanded: Boolean;
- FDirSize: Cardinal;
- FIsRecycleBin: Boolean;
- FIconEmpty: Boolean;
- public
- shAttr: ULONG;
- PIDL: PItemIDList;
- ShellFolder: IShellFolder;
- constructor Create;
- destructor Destroy; override;
- property DirName: string read FDirName write FDirName;
- property ShortName: string read FShortName write FShortName;
- property Attr: Integer read FAttr write FAttr;
- property Scanned: Boolean read FScanned write FScanned;
- property Data: Pointer read FData write FData;
- property Expanded: Boolean read FExpanded write FExpanded;
- property DirSize: Cardinal read FDirSize write FDirSize;
- property IsRecycleBin: Boolean read FIsRecycleBin;
- property IconEmpty: Boolean read FIconEmpty write FIconEmpty;
- end;
- TDriveTreeNode = class(TTreeNode)
- procedure Assign(Source: TPersistent); override;
- end;
- TDriveView = class(TCustomDriveView)
- private
- DriveStatus: array[FirstDrive .. LastDrive] of TDriveStatus;
- FConfirmDelete: Boolean;
- FConfirmOverwrite: Boolean;
- FWatchDirectory: Boolean;
- FDirectory: string;
- FFullDriveScan: Boolean;
- FShowDirSize: Boolean;
- FShowVolLabel: Boolean;
- FVolDisplayStyle: TVolumeDisplayStyle;
- FShowAnimation: Boolean;
- FChangeFlag: Boolean;
- FLastDir: string;
- FValidateFlag: Boolean;
- FCreating: Boolean;
- FForceRename: Boolean;
- FRenameNode: TTreeNode;
- FLastRenameName: string;
- FInternalWindowHandle: HWND;
- FPrevSelected: TTreeNode;
- FPrevSelectedIndex: Integer;
- FDesktop: IShellFolder;
- FWorkPlace: IShellFolder;
- {Additional events:}
- FOnStartScan: TNotifyEvent;
- FOnEndScan: TNotifyEvent;
- FOnScanDir: TDriveViewScanDirEvent;
- FOnDiskChange: TDriveViewDiskChangeEvent;
- FOnInsertedDiskChange: TDriveViewDiskChangeEvent;
- FOnChangeDetected: TDriveViewDiskChangeEvent;
- FOnChangeInvalid: TDriveViewDiskChangeEvent;
- FOnDisplayContextMenu: TNotifyEvent;
- FOnRefreshDrives: TNotifyEvent;
- {used components:}
- FDirView: TDirView;
- FFileOperator: TFileOperator;
- FChangeInterval: Cardinal;
- FNoCheckDrives: string;
- FCompressedColor: TColor;
- FFileNameDisplay: TFileNameDisplay;
- {Drag&drop:}
- FLastPathCut: string;
- {Drag&drop helper functions:}
- procedure SignalDirDelete(Sender: TObject; Files: TStringList);
- function CheckForSubDirs(Path: string): Boolean;
- function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
- {Callback-functions used by iteratesubtree:}
- function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
- function CallBackSaveNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
- function CallBackRestoreNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
- function CallBackDisplayName(var Node: TTreeNode; Data: Pointer): Boolean;
- function CallBackSetDirSize(var Node: TTreeNode; Data: Pointer): Boolean;
- function CallBackExpandLevel(var Node: TTreeNode; Data: Pointer): Boolean;
- { Notification procedures used by component TDiscMonitor: }
- procedure ChangeDetected(Sender: TObject; const Directory: string;
- var SubdirsChanged: Boolean);
- procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
- {Notification procedure used by component TTimer:}
- procedure ChangeTimerOnTimer(Sender: TObject);
- protected
- procedure SetSelected(Node: TTreeNode);
- procedure SetFullDriveScan(DoFullDriveScan: Boolean);
- procedure SetWatchDirectory(Value: Boolean);
- procedure SetShowDirSize(ShowIt: Boolean);
- procedure SetShowVolLabel(ShowIt: Boolean);
- procedure SetVolDisplayStyle(DoStyle: TVolumeDisplayStyle);
- procedure SetDirView(Value: TDirView);
- procedure SetChangeInterval(Value: Cardinal);
- procedure SetNoCheckDrives(Value: string);
- procedure SetCompressedColor(Value: TColor);
- procedure SetFileNameDisplay(Value: TFileNameDisplay);
- procedure SetDirectory(Value: string); override;
- procedure SetDrive(Drive: TDrive);
- function GetDrive: TDrive;
- procedure GetNodeShellAttr(ParentFolder: IShellFolder; NodeData: TNodeData;
- Path: string; ContentMask: Boolean = True);
- function DoScanDir(FromNode: TTreeNode): Boolean; virtual;
- function AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode; virtual;
- {$IFNDEF NO_THREADS}
- procedure CreateWatchThread(Drive: TDrive); virtual;
- {$ENDIF}
- procedure InternalWndProc(var Msg: TMessage);
- function DirAttrMask: Integer;
- procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
- NewDirs: Boolean); override;
- procedure ValidateDirectoryEasy(Node: TTreeNode);
- procedure RebuildTree; override;
- procedure SetLastPathCut(Path: string);
- function GetCanUndoCopyMove: Boolean; virtual;
- procedure CreateWnd; override;
- procedure DestroyWnd; override;
- procedure Edit(const Item: TTVItem); override;
- procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
- function GetCustomDirView: TCustomDirView; override;
- procedure SetCustomDirView(Value: TCustomDirView); override;
- function NodePath(Node: TTreeNode): string; override;
- function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
- function NodePathExists(Node: TTreeNode): Boolean; override;
- function NodeColor(Node: TTreeNode): TColor; override;
- function FindPathNode(Path: string): TTreeNode; override;
- function CreateNode: TTreeNode; override;
- function DDSourceEffects: TDropEffectSet; override;
- procedure DDChooseEffect(KeyState: Integer; var Effect: Integer); override;
- function DragCompleteFileList: Boolean; override;
- function DDExecute: TDragResult; override;
- public
- property Images;
- property StateImages;
- property Items stored False;
- property Selected Write SetSelected stored False;
- property WorkPlace: IShellFolder read FWorkPlace;
- property DragImageList: TDragImageList read FDragImageList;
- property Drive: TDrive read GetDrive write SetDrive stored False;
- property DragDrive: TDrive read FDragDrive;
- property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
- property DDFileOperator: TFileOperator read FFileOperator;
- property LastPathCut: string read FLastPathCut write SetLastPathCut;
- function UndoCopyMove: Boolean; dynamic;
- procedure EmptyClipboard; dynamic;
- function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;
- function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;
- function CanPasteFromClipBoard: Boolean; dynamic;
- function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
- procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
- {Drive handling:}
- function GetDriveStatus(Drive: TDrive): TDriveStatus;
- function GetDriveTypetoNode(Node: TTreeNode): Integer; {Returns DRIVE_CDROM etc..}
- function GetDriveType(Drive: TDrive): Integer; {Returns DRIVE_CDROM etc..}
- function GetDriveToNode(Node: TTreeNode): Char;
- function GetDriveText(Drive: TDrive): string;
- procedure ScanDrive(Drive: TDrive);
- procedure RefreshRootNodes(ScanDirectory: Boolean; dsFlags: Integer);
- function GetValidDrivesStr: string;
- procedure RefreshDirSize(Node: TTreeNode);
- procedure RefreshDriveDirSize(Drive: TDrive);
- {Node handling:}
- procedure SetImageIndex(Node: TTreeNode); virtual;
- function FindNodeToPath(Path: string): TTreeNode;
- function NodeVerified(Node: TTreeNode): Boolean;
- function NodeAttr(Node: TTreeNode): Integer;
- function RootNode(Node: TTreeNode): TTreeNode;
- function GetDirName(Node: TTreeNode): string;
- function GetDirSize(Node: TTreeNode): Cardinal; virtual;
- procedure SetDirSize(Node: TTreeNode); virtual;
- function GetDisplayName(Node: TTreeNode): string;
- function NodeUpdateAble(Node: TTreeNode): Boolean; virtual;
- procedure ExpandLevel(Node: TTreeNode; Level: Integer); virtual;
- function NodePathName(Node: TTreeNode): string; override;
- function GetFQPIDL(Node: TTreeNode): PItemIDList;
- function GetSubTreeSize(Node: TTreeNode): Integer; dynamic;
- {Directory update:}
- function CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode; dynamic;
- function DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean; dynamic;
- procedure DeleteSubNodes(Node: TTreeNode); dynamic;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- {Save and restore the subnodes expanded state:}
- procedure SaveNodesState(Node: TTreeNode);
- procedure RestoreNodesState(Node: TTreeNode);
- {Menu-handling:}
- procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;
- procedure DisplayPropertiesMenu(Node: TTreeNode); override;
- {$IFNDEF NO_THREADS}
- {Watchthread handling:}
- procedure StartWatchThread; virtual;
- procedure StopWatchThread; virtual;
- procedure TerminateWatchThread(Drive: TDrive); virtual;
- procedure StartAllWatchThreads; virtual;
- procedure StopAllWatchThreads; virtual;
- function WatchThreadActive: Boolean; overload;
- function WatchThreadActive(Drive: TDrive): Boolean; overload;
- function NodeWatched(Node: TTreeNode): Boolean; virtual;
- {$ENDIF}
- (* Modified Events: *)
- procedure GetImageIndex(Node: TTreeNode); override;
- function CanEdit(Node: TTreeNode): Boolean; override;
- function CanChange(Node: TTreeNode): Boolean; override;
- function CanExpand(Node: TTreeNode): Boolean; override;
- procedure Delete(Node: TTreeNode); override;
- procedure Loaded; override;
- procedure KeyPress(var Key: Char); override;
- procedure Change(Node: TTreeNode); override;
- published
- {Additional properties:}
- {Current selected directory:}
- property Directory;
- {Confirm deleting directories:}
- property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
- {Confirm overwriting directories:}
- property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;
- {Scan all directories in method ScanDrive:}
- property FullDriveScan: Boolean read FFullDriveScan write SetFullDriveScan default False;
- {Enable automatic update on filesystem changes:}
- property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;
- {Peform automatic update after ChangeInterval milliseconds:}
- property ChangeInterval: Cardinal read FChangeInterval write SetChangeInterval default MSecsPerSec;
- {Linked component TDirView:}
- property DirView: TDirView read FDirView write SetDirView;
- property ShowDirSize: Boolean read FShowDirSize write SetShowDirSize default False;
- {Show the volume labels of drives:}
- property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;
- {How to display the drives volume labels:}
- property VolDisplayStyle: TVolumeDisplayStyle read FVolDisplayStyle write SetVolDisplayStyle default doPrettyName;
- {Show AVI-animation when performing a full drive scan:}
- property ShowAnimation: Boolean read FShowAnimation write FShowAnimation default False;
- {Don't watch these drives for changes:}
- property NoCheckDrives: string read FNoCheckDrives write SetNoCheckDrives;
- property CompressedColor: TColor read FCompressedColor write SetCompressedColor default clBlue;
- property FileNameDisplay: TFileNameDisplay read FFileNameDisplay write SetFileNameDisplay default fndStored;
- {Additional events:}
- property OnStartScan: TNotifyEvent read FOnStartScan write FOnStartScan;
- property OnEndScan: TNotifyEvent read FOnEndScan write FOnEndScan;
- property OnScanDir: TDriveViewScanDirEvent read FOnScanDir write FOnScanDir;
- property OnDiskChange: TDriveViewDiskChangeEvent read FOnDiskChange write FOnDiskChange;
- property OnInsertedDiskChange: TDriveViewDiskChangeEvent read FOnInsertedDiskChange
- write FOnInsertedDiskChange;
- property OnChangeDetected: TDriveViewDiskChangeEvent read FOnChangeDetected
- write FOnChangeDetected;
- property OnChangeInvalid: TDriveViewDiskChangeEvent read FOnChangeInvalid
- write FOnChangeInvalid;
- property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
- write FOnDisplayContextMenu;
- property OnRefreshDrives: TNotifyEvent read FOnRefreshDrives
- write FOnRefreshDrives;
- property DDLinkOnExeDrag;
- property TargetPopUpMenu;
- property OnDDDragEnter;
- property OnDDDragLeave;
- property OnDDDragOver;
- property OnDDDrop;
- property OnDDQueryContinueDrag;
- property OnDDGiveFeedback;
- property OnDDDragDetect;
- property OnDDProcessDropped;
- property OnDDError;
- property OnDDExecuted;
- property OnDDFileOperation;
- property OnDDFileOperationExecuted;
- property OnDDMenuPopup;
- property Align;
- property Anchors;
- property AutoExpand;
- property BiDiMode;
- property BorderStyle;
- property BorderWidth;
- property ChangeDelay;
- property Color;
- property Ctl3D;
- property Constraints;
- property DoubleBuffered;
- {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}
- property DragKind;
- property DragCursor;
- property DragMode Default dmAutomatic;
- property OnDragDrop;
- property OnDragOver;
- property Enabled;
- property Font;
- property HideSelection;
- property HotTrack;
- property Indent;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentDoubleBuffered;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly;
- property RightClickSelect;
- property RowSelect;
- property ShowButtons;
- property ShowHint;
- property ShowLines;
- property TabOrder;
- property TabStop default True;
- property ToolTips;
- property Visible;
- property OnChange;
- property OnChanging;
- property OnClick;
- property OnCollapsing;
- property OnCollapsed;
- property OnCompare;
- property OnDblClick;
- property OnDeletion;
- property OnEdited;
- property OnEditing;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnExpanding;
- property OnExpanded;
- property OnGetImageIndex;
- property OnGetSelectedIndex;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- end;
- procedure Register;
- implementation
- uses
- CompThread;
- resourcestring
- SErrorInvalidDirName = 'New name contains invalid characters %s';
- type
- PInt = ^Integer;
- procedure Register;
- begin
- RegisterComponents('DriveDir', [TDriveView]);
- end; {Register}
- constructor TNodeData.Create;
- begin
- inherited;
- FAttr := 0;
- FExpanded := False;
- FScanned := False;
- FDirName := '';
- FShortName := '';
- FDirSize := CInvalidSize;
- FIsRecycleBin := False;
- FIconEmpty := True;
- shAttr := 0;
- PIDL := nil;
- ShellFolder := nil;
- end; {TNodeData.Create}
- destructor TNodeData.Destroy;
- begin
- SetLength(FDirName, 0);
- if Assigned(PIDL) then
- FreePIDL(PIDL);
- inherited;
- end; {TNodeData.Destroy}
- { TDriveTreeNode }
- procedure TDriveTreeNode.Assign(Source: TPersistent);
- var
- SourceData: TNodeData;
- NewData: TNodeData;
- begin
- inherited Assign(Source);
- if not Deleting and (Source is TTreeNode) then
- begin
- SourceData := TNodeData(TTreeNode(Source).Data);
- NewData := TNodeData.Create();
- NewData.DirName := SourceData.DirName;
- NewData.ShortName := SourceData.ShortName;
- NewData.Attr := SourceData.Attr;
- NewData.Scanned := SourceData.Scanned;
- NewData.Data := SourceData.Data;
- NewData.Expanded := SourceData.Expanded;
- NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
- NewData.IconEmpty := SourceData.IconEmpty;
- TTreeNode(Source).Data := NewData;
- end;
- end;
- { TDriveView }
- constructor TDriveView.Create(AOwner: TComponent);
- var
- Drive: TDrive;
- begin
- inherited;
- FCreating := True;
- if FChangeInterval = 0 then
- FChangeInterval := MSecsPerSec;
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- begin
- Scanned := False;
- Verified := False;
- RootNode := nil;
- RootNodeIndex := -1;
- DiscMonitor := nil;
- DefaultDir := EmptyStr;
- {ChangeTimer: }
- ChangeTimer := TTimer.Create(Self);
- ChangeTimer.Interval := 0;
- ChangeTimer.Enabled := False;
- ChangeTimer.OnTimer := ChangeTimerOnTimer;
- ChangeTimer.Tag := Ord(Drive);
- end;
- FFileOperator := TFileOperator.Create(Self);
- FFileOperator.ProgressTitle := coFileOperatorTitle;
- FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
- FCompressedColor := clBlue;
- FShowVolLabel := True;
- FChangeFlag := False;
- FLastDir := EmptyStr;
- FValidateFlag := False;
- FConfirmDelete := True;
- FShowAnimation := False;
- FDirectory := EmptyStr;
- FFileNameDisplay := fndStored;
- FForceRename := False;
- FLastRenameName := '';
- FRenameNode := nil;
- FPrevSelected := nil;
- FPrevSelectedIndex := -1;
- FConfirmOverwrite := True;
- FLastPathCut := '';
- FStartPos.X := -1;
- FStartPos.Y := -1;
- FDragPos := FStartPos;
- FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
- with FDragDropFilesEx do
- begin
- ShellExtensions.DragDropHandler := True;
- end;
- end; {Create}
- destructor TDriveView.Destroy;
- var
- Drive: TDrive;
- begin
- Classes.DeallocateHWnd(FInternalWindowHandle);
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- begin
- if Assigned(DiscMonitor) then
- DiscMonitor.Free;
- if Assigned(ChangeTimer) then
- ChangeTimer.Free;
- end;
- if Assigned(FFileOperator) then
- FFileOperator.Free;
- inherited Destroy;
- end; {Destroy}
- procedure TDriveView.InternalWndProc(var Msg: TMessage);
- begin
- with Msg do
- begin
- if (Msg = WM_DEVICECHANGE) and
- ((wParam = {DBT_CONFIGCHANGED} $0018) or (wParam = {DBT_DEVICEARRIVAL} $8000) or
- (wParam = {DBT_DEVICEREMOVECOMPLETE} $8004)) then
- begin
- try
- //DriveInfo.Load;
- RefreshRootNodes(False, dsAll);
- if Assigned(OnRefreshDrives) then
- OnRefreshDrives(Self);
- except
- Application.HandleException(Self);
- end
- end;
- Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
- end;
- end;
- procedure TDriveView.CreateWnd;
- var
- PIDLWorkPlace: PItemIDList;
- Drive: TDrive;
- begin
- inherited;
- if Assigned(PopupMenu) then
- PopupMenu.Autopopup := False;
- OLECheck(shGetDesktopFolder(FDesktop));
- OLECheck(shGetSpecialFolderLocation(Self.Handle, CSIDL_DRIVES, PIDLWorkPlace));
- FDesktop.BindToObject(PIDLWorkPlace, nil, IID_IShellFolder, Pointer(FWorkPlace));
- FreePIDL(PIDLWorkPlace);
- FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
- FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
- if FPrevSelectedIndex >= 0 then
- begin
- FPrevSelected := Items[FPrevSelectedIndex];
- FPrevSelectedIndex := -1;
- end;
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- begin
- if RootNodeIndex >= 0 then
- begin
- RootNode := Items[RootNodeIndex];
- RootNodeIndex := -1;
- end;
- end;
- end; {CreateWnd}
- procedure TDriveView.DestroyWnd;
- var
- Drive: TDrive;
- begin
- if CreateWndRestores and (Items.Count > 0) and (csRecreating in ControlState) then
- begin
- FPrevSelectedIndex := -1;
- if Assigned(FPrevSelected) then
- begin
- FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
- FPrevSelected := nil;
- end;
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- begin
- RootNodeIndex := -1;
- if Assigned(RootNode) then
- begin
- RootNodeIndex := RootNode.AbsoluteIndex;
- RootNode := nil;
- end;
- end;
- end;
- inherited;
- end;
- function TDriveView.GetFQPIDL(Node: TTreeNode): PItemIDList;
- var
- Eaten: ULONG;
- shAttr: ULONG;
- begin
- Result := nil;
- if Assigned(Node) then
- begin
- FDesktop.ParseDisplayName(FParentForm.Handle, nil, PChar(NodePathName(Node)), Eaten,
- Result, shAttr);
- end;
- end; {GetFQPIDL}
- function TDriveView.NodeColor(Node: TTreeNode): TColor;
- begin
- Result := clDefaultItemColor;
- with TNodeData(Node.Data) do
- if not Node.Selected then
- begin
- {Colored display of compressed directories:}
- if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
- Result := FCompressedColor
- else
- {Dimmed display, if hidden-atrribut set:}
- if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
- Result := clGrayText
- end;
- end;
- function TDriveView.GetCustomDirView: TCustomDirView;
- begin
- Result := DirView;
- end;
- procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
- begin
- DirView := Value as TDirView;
- end;
- function TDriveView.NodePath(Node: TTreeNode): string;
- var
- ParentNode: TTreeNode;
- begin
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
- Result := GetDirName(Node);
- ParentNode := Node.Parent;
- while (ParentNode <> nil) and (ParentNode.Level >= 0) do
- begin
- if ParentNode.Level > 0 then
- Result := GetDirName(ParentNode) + '\' + Result
- else
- Result := GetDirName(ParentNode) + Result;
- ParentNode := ParentNode.Parent;
- end;
- if Length(Result) = 3 then
- SetLength(Result, 2);
- end;
- {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
- C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
- function TDriveView.NodePathName(Node: TTreeNode): string;
- begin
- Result := NodePath(Node);
- if Length(Result) = 2 then
- Result := Result + '\';
- end; {NodePathName}
- function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
- begin
- Result := TNodeData(Node.Data).IsRecycleBin;
- end;
- function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
- begin
- Result := DirExists(NodePathName(Node));
- end;
- function TDriveView.CanEdit(Node: TTreeNode): Boolean;
- begin
- Result := inherited CanEdit(Node) or FForceRename;
- if Result then
- begin
- Result := Assigned(Node.Parent) and
- (not TNodeData(Node.Data).IsRecycleBin) and
- (not ReadOnly) and
- (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
- ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
- (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
- end;
- FForceRename := False;
- end; {CanEdit}
- procedure TDriveView.Edit(const Item: TTVItem);
- var
- NewDirName: string;
- SRec: TSearchRec;
- Node: TTreeNode;
- Info: string;
- i: Integer;
- begin
- Node := GetNodeFromHItem(Item);
- if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
- begin
- if StrContains(coInvalidDosChars, Item.pszText) then
- begin
- Info := coInvalidDosChars;
- for i := Length(Info) downto 1 do
- System.Insert(Space, Info, i);
- if Assigned(OnEdited) then
- begin
- NewDirName := Node.Text;
- OnEdited(Self, Node, NewDirName);
- end;
- if Length(Item.pszText) > 0 then
- raise EInvalidDirName.CreateFmt(SErrorInvalidDirName, [Info]);
- Exit;
- end;
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- if Assigned(DirView) then
- DirView.StopWatchThread;
- {$ENDIF}
- with FFileOperator do
- begin
- Flags := [foAllowUndo, foNoConfirmation];
- Operation := foRename;
- OperandFrom.Clear;
- OperandTo.Clear;
- OperandFrom.Add(NodePath(Node));
- OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
- end;
- try
- if FFileOperator.Execute then
- begin
- Node.Text := Item.pszText;
- TNodeData(Node.Data).DirName := Item.pszText;
- if FindFirst(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText,
- faAnyFile, SRec) = 0 then
- begin
- TNodeData(Node.Data).ShortName := string(SRec.FindData.cAlternateFileName);
- end;
- FindClose(SRec);
- SortChildren(Node.Parent, False);
- inherited;
- end
- else
- begin
- if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
- Info := SErrorRenameFileExists + Item.pszText
- else
- Info := SErrorRenameFile + Item.pszText;
- MessageBeep(MB_ICONHAND);
- if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
- begin
- FLastRenameName := Item.pszText;
- FRenameNode := Node;
- PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
- end;
- end;
- finally
- {$IFNDEF NO_THREADS}
- StartWatchThread;
- {$ENDIF}
- if Assigned(DirView) then
- begin
- DirView.Reload2;
- {$IFNDEF NO_THREADS}
- DirView.StartWatchThread;
- {$ENDIF}
- end;
- end;
- end;
- end; {Edit}
- procedure TDriveView.WMUserRename(var Message: TMessage);
- begin
- if Assigned(FRenameNode) then
- begin
- FForceRename := True;
- TreeView_EditLabel(Handle, FRenameNode.ItemID);
- SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
- FRenameNode := nil;
- end;
- end; {WMUserRename}
- function TDriveView.CanExpand(Node: TTreeNode): Boolean;
- var
- SubNode: TTreeNode;
- Drive: TDrive;
- SaveCursor: TCursor;
- begin
- Result := inherited CanExpand(Node);
- Drive := GetDriveToNode(Node);
- if Node.HasChildren then
- begin
- if (Node.Level = 0) and
- (not DriveStatus[Drive].Scanned) and
- (Drive >= FirstFixedDrive) then
- begin
- SubNode := Node.GetFirstChild;
- if not Assigned(SubNode) then
- begin
- ScanDrive(Drive);
- SubNode := Node.GetFirstChild;
- Node.HasChildren := Assigned(SubNode);
- Result := Node.HasChildren;
- {$IFNDEF NO_THREADS}
- if not Assigned(DriveStatus[Drive].DiscMonitor) then
- CreateWatchThread(Drive);
- {$ENDIF}
- end;
- end
- else
- begin
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
- begin
- ReadSubDirs(Node, DriveInfo[Drive].DriveType);
- end;
- finally
- Screen.Cursor := SaveCursor;
- end;
- end;
- end;
- end; {CanExpand}
- procedure TDriveView.GetImageIndex(Node: TTreeNode);
- begin
- if TNodeData(Node.Data).IconEmpty then
- SetImageIndex(Node);
- inherited;
- end; {GetImageIndex}
- procedure TDriveView.Loaded;
- begin
- inherited;
- {Create the drive nodes:}
- RefreshRootNodes(False, dsDisplayName or dvdsFloppy);
- {Set the initial directory:}
- if (Length(FDirectory) > 0) and DirExists(FDirectory) then
- Directory := FDirectory;
- FCreating := False;
- end; {Loaded}
- function TDriveView.CreateNode: TTreeNode;
- begin
- Result := TDriveTreeNode.Create(Items);
- end;
- procedure TDriveView.Delete(Node: TTreeNode);
- var
- NodeData: TNodeData;
- begin
- if Node = FPrevSelected then
- FPrevSelected := nil;
- NodeData := nil;
- if Assigned(Node) and Assigned(Node.Data) then
- NodeData := TNodeData(Node.Data);
- Node.Data := nil;
- inherited;
- if Assigned(NodeData) and not (csRecreating in ControlState) then
- begin
- NodeData.Destroy;
- end;
- end; {OnDelete}
- procedure TDriveView.KeyPress(var Key: Char);
- begin
- inherited;
- if Assigned(Selected) then
- begin
- if Pos(Key, coInvalidDosChars) <> 0 then
- begin
- Beep;
- Key := #0;
- end;
- end;
- end; {KeyPress}
- function TDriveView.CanChange(Node: TTreeNode): Boolean;
- var
- Path: string;
- Drive: TDrive;
- begin
- Result := inherited CanChange(Node);
- if not Reading and not (csRecreating in ControlState) then
- begin
- if Result and Assigned(Node) then
- begin
- Path := NodePathName(Node);
- if Path <> FLastDir then
- begin
- Drive := Path[1];
- DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
- if not DriveInfo[Drive].DriveReady then
- begin
- MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
- Result := False;
- end
- else
- if not DirectoryExists(Path) then
- begin
- MessageDlg(Format(SDirNotExists, [Path]), mtError, [mbOK], 0);
- Result := False;
- end;
- end;
- end;
- if Result and (csDestroying in ComponentState) then
- Result := False;
- if Result and
- (not FCanChange) and
- Assigned(Node) and
- Assigned(Node.Data) and
- Assigned(Selected) and
- Assigned(Selected.Data) then
- begin
- DropTarget := Node;
- Result := False;
- end
- else
- DropTarget := nil;
- end;
- end; {CanChange}
- procedure TDriveView.Change(Node: TTreeNode);
- var
- Drive: TDrive;
- OldSerial: DWORD;
- NewDir: string;
- LastDrive: TDrive;
- begin
- if not Reading and not (csRecreating in ControlState) then
- begin
- if Assigned(Node) then
- begin
- NewDir := NodePathName(Node);
- if NewDir <> FLastDir then
- begin
- Drive := NewDir[1];
- if Length(FLastDir) > 0 then
- LastDrive := FLastDir[1]
- else
- LastDrive := #0;
- FChangeFlag := True;
- FLastDir := NewDir;
- OldSerial := DriveInfo[Drive].DriveSerial;
- DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
- with DriveInfo[Drive]^ do
- begin
- if Assigned(FDirView) and (FDirView.Path <> NewDir) then
- FDirView.Path := NewDir;
- if DriveReady then
- begin
- if not DirExists(NewDir) then
- begin
- ValidateDirectory(DriveStatus[Upcase(NewDir[1])].RootNode);
- Exit;
- end;
- DriveStatus[Drive].DefaultDir := IncludeTrailingBackslash(NewDir);
- if LastDrive <> Drive then
- begin
- {$IFNDEF NO_THREADS}
- if (LastDrive >= FirstDrive) and
- (DriveInfo[LastDrive].DriveType = DRIVE_REMOVABLE) then
- TerminateWatchThread(LastDrive);
- {$ENDIF}
- {Drive serial has changed or is missing: allways reread the drive:}
- if (DriveSerial <> OldSerial) or (DriveSerial = 0) then
- begin
- if TNodeData(DriveStatus[Drive].RootNode.Data).Scanned then
- ScanDrive(Drive);
- if Assigned(FOnInsertedDiskChange) then
- FOnInsertedDiskChange(Self, Drive);
- end;
- if Assigned(FOnDiskChange) then
- FOnDiskChange(Self, Drive);
- end;
- {$IFNDEF NO_THREADS}
- StartWatchThread;
- {$ENDIF}
- end
- else {Drive not ready:}
- begin
- DriveStatus[Drive].RootNode.DeleteChildren;
- DriveStatus[Drive].DefaultDir := EmptyStr;
- if LastDrive <> Drive then
- begin
- if Assigned(FOnInsertedDiskChange) then
- FOnInsertedDiskChange(Self, Drive);
- if Assigned(FOnDiskChange) then
- FOnDiskChange(Self, Drive);
- end;
- end;
- end;
- end;
- if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
- Node.Expand(False);
- FPrevSelected := Node;
- end;
- end;
- inherited;
- end; {Change}
- procedure TDriveView.SetImageIndex(Node: TTreeNode);
- var
- FileInfo: TShFileInfo;
- NodePath: string;
- begin
- if Assigned(Node) and TNodeData(Node.Data).IconEmpty then
- begin
- NodePath := NodePathName(Node);
- if Node.Level = 0 then
- begin
- with DriveInfo[NodePath[1]]^ do
- begin
- if ImageIndex = 0 then
- begin
- DriveInfo.ReadDriveStatus(NodePath[1], dsImageIndex);
- Node.ImageIndex := DriveInfo[NodePath[1]].ImageIndex;
- end
- else Node.ImageIndex := ImageIndex;
- Node.SelectedIndex := Node.ImageIndex;
- end;
- end
- else
- begin
- if DriveInfo[NodePath[1]].DriveType = DRIVE_REMOTE then
- begin
- Node.ImageIndex := StdDirIcon;
- Node.SelectedIndex := StdDirSelIcon;
- end
- else
- begin
- try
- SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
- if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then
- begin
- Node.ImageIndex := FileInfo.iIcon;
- SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
- Node.SelectedIndex := FileInfo.iIcon;
- end
- else
- begin
- Node.ImageIndex := StdDirIcon;
- Node.SelectedIndex := StdDirSelIcon;
- end;
- except
- Node.ImageIndex := StdDirIcon;
- Node.SelectedIndex := StdDirSelIcon;
- end;
- end;
- end;
- end; {IconEmpty}
- TNodeData(Node.Data).IconEmpty := False;
- end; {SetImageIndex}
- function TDriveView.GetDriveText(Drive: TDrive): string;
- begin
- if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then
- begin
- case FVolDisplayStyle of
- doPrettyName: Result := DriveInfo.GetPrettyName(Drive);
- doDisplayName: Result := DriveInfo.GetDisplayName(Drive);
- doLongPrettyName: Result := DriveInfo.GetLongPrettyName(Drive);
- end; {Case}
- end
- else Result := Drive + ':';
- end; {GetDriveText}
- function TDriveView.GetValidDrivesStr: String;
- var
- Drive: TDrive;
- begin
- Result := '';
- for Drive := FirstDrive to LastDrive do
- if DriveInfo[Drive].Valid then
- Result := Result + Drive;
- end; {GetValidDriveStr}
- type
- TFolderAttributesGetterThread = class(TCompThread)
- private
- FParentFolder: iShellFolder;
- FPIDL: PItemIDList;
- FshAttr: PUINT;
- protected
- procedure Execute; override;
- public
- constructor Create(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
- class procedure GetFolderAttributes(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
- end;
- class procedure TFolderAttributesGetterThread.GetFolderAttributes(
- ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
- var
- NotResult: Boolean;
- ErrorMode: Word;
- begin
- ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
- try
- try
- NotResult := not Succeeded(ParentFolder.GetAttributesOf(1, PIDL, shAttr^));
- finally
- SetErrorMode(ErrorMode);
- end;
- if NotResult then shAttr^ := 0;
- except
- shAttr^ := 0;
- end;
- end;
- constructor TFolderAttributesGetterThread.Create(ParentFolder: iShellFolder; PIDL: PItemIDList; shAttr: PUINT);
- begin
- inherited Create(True);
- FParentFolder := ParentFolder;
- FPIDL := PIDL;
- FshAttr := shAttr;
- end;
- procedure TFolderAttributesGetterThread.Execute;
- begin
- GetFolderAttributes(FParentFolder, FPIDL, FshAttr);
- end;
- procedure TDriveView.GetNodeShellAttr(ParentFolder: IShellFolder;
- NodeData: TNodeData; Path: string; ContentMask: Boolean = True);
- var
- {$IFNDEF IDE}
- Thread: TFolderAttributesGetterThread;
- {$ENDIF}
- shAttr: ULONG;
- begin
- if (not Assigned(ParentFolder)) or (not Assigned(NodeData)) then
- Exit;
- if not Assigned(NodeData.PIDL) then
- NodeData.PIDL := PIDL_GetFromParentFolder(ParentFolder, PChar(Path));
- if Assigned(NodeData.PIDL) then
- begin
- if ContentMask then
- shAttr := SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK
- else
- shAttr := SFGAO_DISPLAYATTRMASK;
- // Resoving attributes make take ages, so we run it from a separate thread
- // and timeout waiting for the thread after a second.
- // But when running from IDE, it triggers starting/exiting the thread,
- // again taking ages. So in IDE we revert to single-thread approach
- {$IFDEF IDE}
- TFolderAttributesGetterThread.GetFolderAttributes(ParentFolder, NodeData.PIDL, @shAttr);
- NodeData.shAttr := shAttr;
- {$ELSE}
- Thread := TFolderAttributesGetterThread.Create(ParentFolder, NodeData.PIDL, @shAttr);
- Thread.FreeOnTerminate := True;
- Thread.Resume;
- if Thread.WaitFor(MSecsPerSec) then
- begin
- NodeData.shAttr := shAttr;
- end
- else
- begin
- NodeData.shAttr := 0;
- end;
- {$ENDIF}
- if not ContentMask then
- NodeData.shAttr := NodeData.shAttr or SFGAO_HASSUBFOLDER;
- if not Assigned(NodeData.ShellFolder) then
- begin
- ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder,
- Pointer(NodeData.ShellFolder));
- end;
- end;
- end; {GetNodeAttr}
- procedure TDriveView.RefreshRootNodes(ScanDirectory: Boolean; dsFlags: Integer);
- var
- Drive: Char;
- NewText: string;
- NextDrive: TDrive;
- D: TDrive;
- SaveCursor: TCursor;
- WasValid: Boolean;
- OldSerial: DWORD;
- WFirstDrive: TDrive;
- NodeData: TNodeData;
- begin
- {Fetch disabled drives from the registry:}
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- if (dsFlags and dvdsFloppy) <> 0 then
- WFirstDrive := FirstDrive
- else
- WFirstDrive := FirstFixedDrive;
- for Drive := WFirstDrive to LastDrive do
- begin
- with DriveInfo[Drive]^ do
- begin
- WasValid := Assigned(DriveStatus[Drive].RootNode);
- OldSerial := DriveSerial;
- end;
- if ((dsFlags and dvdsReReadAllways) = 0) and
- (Length(DriveInfo[Drive].DisplayName) > 0) then
- dsFlags := dsFlags and (not dsDisplayName);
- DriveInfo.ReadDriveStatus(Drive, dsFlags);
- with DriveInfo[Drive]^, DriveStatus[Drive] do
- begin
- if Valid then
- begin
- if not WasValid then
- {New drive has arrived: insert new rootnode:}
- begin
- NextDrive := LastDrive;
- if not FCreating then
- begin
- for D := Drive to LastDrive do
- begin
- if Assigned(DriveStatus[D].RootNode) then
- begin
- NextDrive := D;
- Break;
- end;
- end;
- end;
- { Create root directory node }
- NodeData := TNodeData.Create;
- NodeData.DirName := Drive + ':\';
- NodeData.ShortName := Drive + ':\';
- {Get the shared attributes:}
- if (Drive >= FirstFixedDrive) and (DriveType <> DRIVE_REMOVABLE) and
- ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive)) then
- begin
- GetNodeShellAttr(FWorkPlace, NodeData, NodeData.DirName);
- end;
- if Assigned(DriveStatus[NextDrive].RootNode) then
- RootNode := Items.InsertObject(DriveStatus[NextDrive].RootNode, '', NodeData)
- else
- RootNode := Items.AddObject(nil, '', NodeData);
- if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
- RootNode.OverlayIndex := 0;
- RootNode.Text := GetDisplayName(RootNode);
- RootNode.HasChildren := True;
- Scanned := False;
- Verified := False;
- end
- else
- if RootNode.ImageIndex <> DriveInfo[Drive].ImageIndex then
- begin {WasValid = True}
- RootNode.ImageIndex := DriveInfo[Drive].ImageIndex;
- RootNode.SelectedIndex := DriveInfo[Drive].ImageIndex;
- end;
- if (Drive >= FirstFixedDrive) and Scanned then
- begin
- if ScanDirectory and (DriveSerial <> OldSerial) then
- begin
- ScanDrive(Drive);
- end;
- end;
- if Assigned(RootNode) then
- begin
- NewText := GetDisplayName(RootNode);
- if RootNode.Text <> NewText then
- RootNode.Text := NewText;
- end;
- end
- else
- if WasValid then
- {Drive has been removed => delete rootnode:}
- begin
- if Directory[1] = Drive then
- begin
- Directory := NodePathName(DriveStatus[Drive].RootNode.GetPrevSibling);
- if not Assigned(Selected) then
- begin
- Directory := NodePathName(DriveStatus[FirstFixedDrive].RootNode);
- end;
- end;
- Scanned := False;
- Verified := False;
- RootNode.Delete;
- RootNode := nil;
- end;
- end;
- end;
- finally
- Screen.Cursor := SaveCursor;
- end;
- end; {RefreshRootNodes}
- function TDriveView.AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
- var
- NewNode: TTreeNode;
- NodeData: TNodeData;
- begin
- NodeData := TNodeData.Create;
- NodeData.Attr := SRec.Attr;
- NodeData.DirName := SRec.Name;
- NodeData.ShortName := SRec.FindData.cAlternateFileName;
- NodeData.FIsRecycleBin :=
- (SRec.Attr and faSysFile <> 0) and
- (ParentNode.Level = 0) and
- ((UpperCase(SRec.Name) = 'RECYCLED') or
- (UpperCase(SRec.Name) = 'RECYCLER'));
- { query content attributes ("has subfolder") only if tree view is visible }
- { to avoid unnecessary scan of subfolders (which may take some time) }
- { if tree view is not visible anyway }
- if not Assigned(TNodeData(ParentNode.Data).ShellFolder) then
- GetNodeShellAttr(FWorkPlace, TNodeData(ParentNode.Data), NodePathName(ParentNode), Visible);
- GetNodeShellAttr(TNodeData(ParentNode.Data).ShellFolder, NodeData, SRec.Name, Visible);
- NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
- NewNode.Text := GetDisplayName(NewNode);
- if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
- NewNode.OverlayIndex := 0;
- Result := NewNode;
- end; {AddChildNode}
- function TDriveView.GetDriveStatus(Drive: TDrive): TDriveStatus;
- begin
- Result := DriveStatus[Upcase(Drive)];
- end; {GetDriveStatus}
- function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
- begin
- with TNodeData(FromNode.Data) do
- Result := not IsRecycleBin;
- if Assigned(FOnScanDir) then
- FOnScanDir(Self, FromNode, Result);
- end; {DoScanDir}
- function TDriveView.DirAttrMask: Integer;
- begin
- Result := faDirectory or faSysFile;
- if ShowHiddenDirs then
- Result := Result or faHidden;
- end;
- procedure TDriveView.ScanDrive(Drive: TDrive);
- var
- DosError: Integer;
- RootNode: TTreeNode;
- SaveCursor: TCursor;
- FAnimate: TAnimate;
- procedure ScanPath(const Path: string; ParentNode: TTreeNode);
- var
- SRec: TSearchRec;
- SubNode: TTreeNode;
- begin
- if not DoScanDir(ParentNode) then
- Exit;
- DosError := FindFirst(Path, DirAttrMask, Srec);
- while DosError = 0 do
- begin
- if (SRec.Name <> '.') and
- (SRec.Name <> '..') and
- (SRec.Attr and faDirectory <> 0) then
- begin
- if (SRec.Attr And faDirectory) <> 0 then
- begin { Scan subdirectory }
- SubNode := AddChildNode(ParentNode, SRec);
- TNodeData(SubNode.Data).Scanned := True;
- ScanPath(ExtractFilePath(Path) + SRec.Name + '\*.*', SubNode);
- if not FContinue then
- Break;
- end;
- end;
- DosError := FindNext(SRec);
- end;
- FindClose(Srec);
- if (Items.Count mod 10) = 0 then
- Application.ProcessMessages;
- if not FContinue then
- Exit;
- end; {ScanPath}
- begin {ScanDrive}
- with Self.Items do
- begin
- FContinue := True;
- if not FFullDriveScan then
- begin
- ValidateDirectory(FindNodeToPath(Drive + ':\'));
- DriveStatus[Drive].Scanned := True;
- DriveStatus[Drive].Verified := False;
- end
- else
- begin
- FAnimate := nil;
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- Items.BeginUpdate;
- if FShowAnimation then
- begin
- FAnimate := TAnimate.Create(Self);
- FAnimate.Top := (Height - FAnimate.Height) div 2;
- FAnimate.Left := ((Width - FAnimate.Width) * 2) div 3;
- FAnimate.Parent := Self;
- FAnimate.CommonAVI := aviFindFolder;
- FAnimate.Active := True;
- end;
- if Assigned(FOnStartScan) then
- FOnStartScan(Self);
- try
- RootNode := DriveStatus[Drive].RootNode;
- if not Assigned(RootNode) then Exit;
- iF RootNode.HasChildren then
- RootNode.DeleteChildren;
- ScanPath(Drive + ':\*.*', RootNode); { scan subdirectories of rootdir}
- TNodeData(RootNode.Data).Scanned := True;
- DriveStatus[Drive].Scanned := True;
- DriveStatus[Drive].Verified := True;
- finally
- SortChildren(DriveStatus[Drive].RootNode, True);
- EndUpdate;
- if Assigned(FAnimate) then
- FAnimate.Free;
- end;
- RootNode.Expand(False);
- Screen.Cursor := SaveCursor;
- if Assigned(FOnEndScan) then
- FOnEndScan(Self);
- end;
- end;
- end; {ScanDrive}
- function TDriveView.FindNodeToPath(Path: string): TTreeNode;
- var
- Drive: Char;
- function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;
- function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
- var
- i: Integer;
- Node: TTreeNode;
- Dir: string;
- begin
- {Extract first directory from path:}
- i := Pos('\', Path);
- if i = 0 then
- i := Length(Path);
- Dir := System.Copy(Path, 1, i);
- System.Delete(Path, 1, i);
- if Dir[Length(Dir)] = '\' then
- SetLength(Dir, Pred(Length(Dir)));
- Node := ParentNode.GetFirstChild;
- if not Assigned(Node) then
- begin
- ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
- Node := ParentNode.GetFirstChild;
- end;
- Result := nil;
- while Assigned(Node) do
- begin
- if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
- begin
- if Length(Path) > 0 then
- Result := SearchSubDirs(Node, Path)
- else
- Result := Node;
- Exit;
- end;
- Node := ParentNode.GetNextChild(Node);
- end;
- end;
- function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
- var
- Read: Boolean;
- begin
- Result := nil;
- if Length(Path) > 0 then
- begin
- Read := False;
- if not TNodeData(ParentNode.Data).Scanned then
- begin
- ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
- Read := True;
- end;
- Result := DoSearchSubDirs(ParentNode, Path);
- // reread subfolders, just in case the directory we look for was just created
- // (as can happen when navigating to new remote directory with synchronized
- // browsing enabled and opting to create the non-existing local directory)
- if (not Assigned(Result)) and (not Read) then
- begin
- ValidateDirectoryEx(ParentNode, rsNoRecursive, True);
- Result := DoSearchSubDirs(ParentNode, Path);
- end;
- end;
- end; {SearchSubDirs}
- begin {FindNodeToPath}
- Result := nil;
- if Length(Path) < 3 then
- Exit;
- // Particularly when used by TDirView to delegate browsing to
- // hidden drive view, the handle may not be created
- HandleNeeded;
- Drive := Upcase(Path[1]);
- if (Drive < FirstDrive) or (Drive > LastDrive) then
- EConvertError.Create(Format(ErrorInvalidDrive, [Drive]))
- else
- if Assigned(DriveStatus[Drive].RootNode) then
- begin
- System.Delete(Path, 1, 3);
- if Length(Path) > 0 then
- begin
- if not DriveStatus[Drive].Scanned then
- ScanDrive(Drive);
- Result := SearchSubDirs(DriveStatus[Drive].RootNode, UpperCase(Path));
- end
- else Result := DriveStatus[Drive].RootNode;
- end;
- end; {FindNodetoPath}
- function TDriveView.CheckForSubDirs(Path: string): Boolean;
- var
- DosError: Integer;
- SRec: TSearchRec;
- begin
- Result := False;
- DosError := FindFirst(IncludeTrailingBackslash(Path) + '*.', DirAttrMask, SRec);
- while DosError = 0 do
- begin
- if (SRec.Name <> '.' ) and
- (SRec.Name <> '..') and
- (SRec.Attr and faDirectory <> 0) then
- begin
- Result := True;
- Break;
- end;
- DosError := FindNext(SRec);
- end;
- FindClose(SRec);
- end; {CheckForSubDirs}
- function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
- var
- DosError: Integer;
- SRec: TSearchRec;
- NewNode: TTreeNode;
- begin
- Result := False;
- DosError := FindFirst(IncludeTrailingBackslash(NodePath(Node)) + '*.*', DirAttrMask, SRec);
- while DosError = 0 do
- begin
- if (SRec.Name <> '.' ) and
- (SRec.Name <> '..') and
- (SRec.Attr and faDirectory <> 0) then
- begin
- NewNode := AddChildNode(Node, SRec);
- if DoScanDir(NewNode) then
- begin
- NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
- TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
- end
- else
- begin
- NewNode.HasChildren := False;
- TNodeData(NewNode.Data).Scanned := True;
- end;
- Result := True;
- end;
- DosError := FindNext(SRec);
- end; {While DosError = 0}
- FindClose(Srec);
- TNodeData(Node.Data).Scanned := True;
- if Result then SortChildren(Node, False)
- else Node.HasChildren := False;
- Application.ProcessMessages;
- end; {ReadSubDirs}
- function TDriveView.CallBackValidateDir(Var Node: TTreeNode; Data: Pointer): Boolean;
- type
- PSearchRec = ^TSearchRec;
- var
- WorkNode: TTreeNode;
- DelNode: TTreeNode;
- NewNode: TTreeNode;
- SRec: TSearchRec;
- SrecList: TStringList;
- SubDirList: TStringList;
- DosError: Integer;
- Index: Integer;
- NewDirFound: Boolean;
- ParentDir: string;
- begin {CallBackValidateDir}
- Result := True;
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- Exit;
- NewDirFound := False;
- {Check, if directory still exists: (but not with root directory) }
- if Assigned(Node.Parent) and (PScanDirInfo(Data)^.StartNode = Node) then
- if not DirExists(NodePathName(Node)) then
- begin
- WorkNode := Node.Parent;
- if Selected = Node then
- Selected := WorkNode;
- if DropTarget = Node then
- DropTarget := nil;
- Node.Delete;
- Node := nil;
- Exit;
- end;
- WorkNode := Node.GetFirstChild;
- if TNodeData(Node.Data).Scanned and Assigned(WorkNode) then
- {if node was already scanned: check wether the existing subnodes are still alive
- and add all new subdirectories as subnodes:}
- begin
- if DoScanDir(Node) then
- begin
- ParentDir := IncludeTrailingBackslash(NodePath(Node));
- {Build list of existing subnodes:}
- SubDirList := TStringList.Create;
- while Assigned(WorkNode) do
- begin
- SubDirList.Add(TNodeData(WorkNode.Data).DirName);
- WorkNode := Node.GetNextChild(WorkNode);
- end;
- {Sorting not required, because the subnodes are already sorted!}
- SRecList := TStringList.Create;
- DosError := FindFirst(ParentDir + '*.*', DirAttrMask, SRec);
- while DosError = 0 do
- begin
- if (Srec.Name <> '.' ) and
- (Srec.Name <> '..') and
- (Srec.Attr and faDirectory <> 0) then
- begin
- SrecList.Add(Srec.Name);
- if not SubDirList.Find(Srec.Name, Index) then
- {Subnode does not exists: add it:}
- begin
- NewNode := AddChildNode(Node, SRec);
- NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
- TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
- NewDirFound := True;
- end;
- end;
- DosError := FindNext(Srec);
- end;
- FindClose(Srec);
- Sreclist.Sort;
- {Remove not existing subnodes:}
- WorkNode := Node.GetFirstChild;
- while Assigned(WorkNode) do
- begin
- if not Assigned(WorkNode.Data) or
- not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
- begin
- DelNode := WorkNode;
- WorkNode := Node.GetNextChild(WorkNode);
- DelNode.Delete;
- end
- else
- begin
- if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
- begin
- {Case of directory letters has changed:}
- TNodeData(WorkNode.Data).DirName := SrecList[Index];
- TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
- WorkNode.Text := SrecList[Index];
- end;
- SrecList.Delete(Index);
- WorkNode := Node.GetNextChild(WorkNode);
- end;
- end;
- SrecList.Free;
- SubDirList.Free;
- {Sort subnodes:}
- if NewDirFound then
- SortChildren(Node, False);
- end;
- end
- else
- {Node was not already scanned:}
- if (PScanDirInfo(Data)^.SearchNewDirs or
- TNodeData(Node.Data).Scanned or
- (Node = PScanDirInfo(Data)^.StartNode)) and
- DoScanDir(Node) then
- ReadSubDirs(Node, PScanDirInfo(Data)^.DriveType);
- end; {CallBackValidateDir}
- procedure TDriveView.RebuildTree;
- var
- Drive: TDrive;
- begin
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- if Assigned(RootNode) and DriveStatus[Drive].Scanned then
- ValidateDirectory(RootNode);
- end;
- procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
- NewDirs: Boolean);
- var
- Info: PScanDirInfo;
- SelDir: string;
- SaveCursor: TCursor;
- {$IFNDEF NO_THREADS}
- RestartWatchThread: Boolean;
- {$ENDIF}
- SaveCanChange: Boolean;
- CurrentPath: string;
- begin
- if Assigned(Node) and Assigned(Node.Data) and
- (not FValidateFlag) and DoScanDir(Node) then
- begin
- SelDir := Directory;
- SaveCursor := Screen.Cursor;
- if Self.Focused and (Screen.Cursor <> crHourGlass) then
- Screen.Cursor := crHourGlass;
- CurrentPath := NodePath(Node);
- if Node.Level = 0 then
- DriveStatus[CurrentPath[1]].ChangeTimer.Enabled := False;
- {$IFNDEF NO_THREADS}
- RestartWatchThread := WatchThreadActive;
- {$ENDIF}
- try
- {$IFNDEF NO_THREADS}
- if WatchThreadActive then
- StopWatchThread;
- {$ENDIF}
- FValidateFlag := True;
- New(Info);
- Info^.StartNode := Node;
- Info^.SearchNewDirs := NewDirs;
- Info^.DriveType := DriveInfo[CurrentPath[1]].DriveType;
- SaveCanChange := FCanChange;
- FCanChange := True;
- FChangeFlag := False;
- IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
- FValidateFlag := False;
- if (not Assigned(Selected)) and (Length(SelDir) > 0) then
- Directory := Copy(SelDir, 1, 3);
- if (SelDir <> Directory) and (not FChangeFlag) then
- Change(Selected);
- FCanChange := SaveCanChange;
- Dispose(Info);
- finally
- {$IFNDEF NO_THREADS}
- if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
- StartWatchThread;
- {$ENDIF}
- if Screen.Cursor <> SaveCursor then
- Screen.Cursor := SaveCursor;
- end;
- end;
- end; {ValidateDirectoryEx}
- procedure TDriveView.ValidateDirectoryEasy(Node: TTreeNode);
- begin
- if Assigned(Node) then
- begin
- if not Assigned(Node.Data) or (not TNodeData(Node.Data).Scanned) then
- ValidateDirectoryEx(Node, rsRecursiveExpanded, False);
- end;
- end; {ValidateDirectoryEasy}
- function TDriveView.GetSubTreeSize(Node: TTreeNode): Integer;
- var
- PSubSize: PInt;
- SaveCursor: TCursor;
- begin
- Assert(Assigned(Node));
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- ValidateAllDirectories(Node);
- RefreshDirSize(Node);
- New(PSubSize);
- PSubSize^ := 0;
- IterateSubTree(Node, CallBackSetDirSize, rsRecursive, coScanStartNode, PSubSize);
- Result := PSubSize^;
- Dispose(PSubSize);
- Screen.Cursor := SaveCursor;
- end; {GetSubTreeSize}
- function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
- begin
- Assert(Assigned(Node));
- Result := DriveInfo[NodePath(Node)[1]].DriveType
- end; {GetDriveTypeToNode}
- function TDriveView.GetDriveType(Drive: TDrive): Integer; {Returns DRIVE_CDROM etc..}
- begin
- Result := DriveInfo[UpCase(Drive)].DriveType;
- end; {GetDriveType}
- function TDriveView.NodeUpdateAble(Node: TTreeNode): Boolean;
- begin
- Result := Assigned(Node) and Assigned(Node.Data) and (Node.Level > 0);
- end; {NodeUpdateAble}
- function TDriveView.CallBackSaveNodeState(var Node: TTreeNode; Data: Pointer): Boolean;
- begin
- Result := True;
- TNodeData(Node.Data).Expanded := Node.Expanded;
- end; {CallBackSaveNodeState}
- function TDriveView.CallBackRestoreNodeState(Var Node: TTreeNode; Data: Pointer): Boolean;
- begin
- Result := True;
- Node.Expanded := TNodeData(Node.Data).Expanded;
- end; {CallBackRestoreNodeState}
- procedure TDriveView.SaveNodesState(Node: TTreeNode);
- begin
- IterateSubTree(Node, CallbackSaveNodeState, rsRecursive, coScanStartNode, nil);
- end; {SaveNodesState}
- procedure TDriveView.RestoreNodesState(Node: TTreeNode);
- begin
- Items.BeginUpdate;
- IterateSubTree(Node, CallbackRestoreNodeState, rsRecursive, coScanStartNode, nil);
- Items.EndUpdate;
- end; {RestoreNodesState}
- function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
- var
- SRec: TSearchRec;
- begin
- Assert(Assigned(ParentNode));
- Result := nil;
- if not TNodeData(ParentNode.Data).Scanned then
- ValidateDirectory(ParentNode);
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$ENDIF}
- try
- {$IFNDEF NO_THREADS}
- if Assigned(FDirView) then
- FDirView.StopWatchThread;
- {$ENDIF}
- {create phyical directory:}
- LastIOResult := 0;
- if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
- LastIOResult := GetLastError;
- if LastIOResult = 0 then
- begin
- {Create treenode:}
- FindFirst(NodePath(ParentNode) + '\' + NewName, faAnyFile, SRec);
- Result := AddChildNode(ParentNode, Srec);
- FindClose(Srec);
- TNodeData(Result.Data).Scanned := True;
- SortChildren(ParentNode, False);
- ParentNode.Expand(False);
- end;
- finally
- {$IFNDEF NO_THREADS}
- StartWatchThread;
- {$ENDIF}
- if Assigned(FDirView) then
- begin
- {$IFNDEF NO_THREADS}
- FDirView.StartWatchThread;
- {$ENDIF}
- FDirView.Reload2;
- end;
- end;
- end; {CreateDirectory}
- function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
- var
- DelDir: string;
- OperatorResult: Boolean;
- FileOperator: TFileOperator;
- SaveCursor: TCursor;
- begin
- Assert(Assigned(Node));
- Result := False;
- if Assigned(Node) and (Node.Level > 0) then
- begin
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- FileOperator := TFileOperator.Create(Self);
- DelDir := NodePathName(Node);
- FileOperator.OperandFrom.Add(DelDir);
- FileOperator.Operation := foDelete;
- if AllowUndo then
- FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
- else
- FileOperator.Flags := FileOperator.Flags - [foAllowUndo];
- if not ConfirmDelete then
- FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
- try
- if DirExists(DelDir) then
- begin
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$ENDIF}
- OperatorResult := FileOperator.Execute;
- if OperatorResult and (not FileOperator.OperationAborted) and
- (not DirExists(DelDir)) then
- begin
- Node.Delete
- end
- else
- begin
- Result := False;
- if not AllowUndo then
- begin
- {WinNT4-Bug: FindFirst still returns the directories search record, even if the
- directory was deleted:}
- ChDir(DelDir);
- if IOResult <> 0 then
- Node.Delete;
- end;
- end;
- end
- else
- begin
- Node.Delete;
- Result := True;
- end;
- finally
- {$IFNDEF NO_THREADS}
- StartWatchThread;
- {$ENDIF}
- if Assigned(DirView) and Assigned(Selected) then
- DirView.Path := NodePathName(Selected);
- FileOperator.Free;
- Screen.Cursor := SaveCursor;
- end;
- end;
- end; {DeleteDirectory}
- {$IFNDEF NO_THREADS}
- procedure TDriveView.CreateWatchThread(Drive: TDrive);
- begin
- if csDesigning in ComponentState then
- Exit;
- if (not Assigned(DriveStatus[Drive].DiscMonitor)) and
- FWatchDirectory and
- (DriveInfo[Drive].DriveType <> DRIVE_REMOTE) and
- (Pos(Drive, FNoCheckDrives) = 0) then
- begin
- with DriveStatus[Drive] do
- begin
- DiscMonitor := TDiscMonitor.Create(Self);
- DiscMonitor.ChangeDelay := msThreadChangeDelay;
- DiscMonitor.SubTree := True;
- DiscMonitor.Filters := [moDirName];
- DiscMonitor.OnChange := ChangeDetected;
- DiscMonitor.OnInvalid := ChangeInvalid;
- DiscMonitor.SetDirectory(Drive + ':\');
- DiscMonitor.Open;
- end;
- end;
- end; {CreateWatchThread}
- {$ENDIF}
- procedure TDriveView.SetWatchDirectory(Value: Boolean);
- begin
- if FWatchDirectory <> Value then
- begin
- FWatchDirectory := Value;
- {$IFNDEF NO_THREADS}
- if (not (csDesigning in ComponentState)) and Value then
- StartAllWatchThreads
- else
- StopAllWatchThreads;
- {$ENDIF}
- end;
- end; {SetAutoScan}
- procedure TDriveView.SetDirView(Value: TDirView);
- begin
- if Assigned(FDirView) then
- FDirView.DriveView := nil;
- FDirView := Value;
- if Assigned(FDirView) then
- FDirView.DriveView := Self;
- end; {SetDirView}
- procedure TDriveView.SetChangeInterval(Value: Cardinal);
- var
- Drive: TDrive;
- begin
- if Value > 0 then
- begin
- FChangeInterval := Value;
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- if Assigned(ChangeTimer) then
- ChangeTimer.Interval := Value;
- end;
- end; {SetChangeInterval}
- procedure TDriveView.SetNoCheckDrives(Value: string);
- begin
- FNoCheckDrives := UpperCase(Value);
- end; {SetNoCheckDrives}
- procedure TDriveView.DeleteSubNodes(Node: TTreeNode);
- begin
- if Assigned(Node) then
- begin
- Node.DeleteChildren;
- if Node.Level = 0 then
- DriveStatus[GetDriveToNode(Node)].Scanned := False;
- Node.HasChildren := False;
- end;
- end; {DeleteSubNodes}
- function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
- var
- Drive: TDrive;
- begin
- Drive := GetDriveToNode(Node);
- Result := Assigned(DriveStatus[Drive].DiscMonitor) and
- DriveStatus[Drive].DiscMonitor.Active;
- end; {NodeWatched}
- procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
- const ErrorStr: string);
- var
- Dir: string;
- begin
- Dir := (Sender as TDiscMonitor).Directories[0];
- with DriveStatus[Dir[1]] do
- begin
- DiscMonitor.Close;
- if Assigned(FOnChangeInvalid) then
- FOnChangeInvalid(Self, Dir[1]);
- end;
- end; {DirWatchChangeInvalid}
- procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
- var SubdirsChanged: Boolean);
- var
- DirChanged: string;
- begin
- if Sender is TDiscMonitor then
- begin
- DirChanged := (Sender as TDiscMonitor).Directories[0];
- if Length(DirChanged) > 0 then
- with DriveStatus[DirChanged[1]] do
- begin
- ChangeTimer.Interval := 0;
- ChangeTimer.Interval := FChangeInterval;
- ChangeTimer.Enabled := True;
- end;
- end;
- end; {DirWatchChangeDetected}
- procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
- var
- Node: TTreeNode;
- Drive: TDrive;
- begin
- if Sender is TTimer then
- with TTimer(Sender) do
- begin
- Drive := Chr(Tag);
- Node := FindNodeToPath(Drive + ':\');
- Interval := 0;
- Enabled := False;
- if Assigned(Node) then
- begin
- {Check also collapsed (invisible) subdirectories:}
- ValidateDirectory(Node);
- if Assigned(FOnChangeDetected) then
- FOnChangeDetected(Self, Drive);
- end;
- end;
- end; {ChangeTimerOnTimer}
- {$IFNDEF NO_THREADS}
- procedure TDriveView.StartWatchThread;
- var
- NewWatchedDir: string;
- Drive: TDrive;
- begin
- if (csDesigning in ComponentState) or
- not Assigned(Selected) or
- not fWatchDirectory then Exit;
- NewWatchedDir := NodePathName(RootNode(Selected));
- Drive := Upcase(NewWatchedDir[1]);
- with DriveStatus[Drive] do
- begin
- if not Assigned(DiscMonitor) then
- CreateWatchThread(Drive);
- if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
- DiscMonitor.Enabled := True;
- end;
- end; {StartWatchThread}
- procedure TDriveView.StopWatchThread;
- begin
- if Assigned(Selected) then
- with DriveStatus[GetDriveToNode(Selected)] do
- if Assigned(DiscMonitor) then
- DiscMonitor.Enabled := False;
- end; {StopWatchThread}
- procedure TDriveView.TerminateWatchThread(Drive: TDrive);
- begin
- if Drive >= FirstDrive then
- with DriveStatus[Drive] do
- if Assigned(DiscMonitor) then
- begin
- DiscMonitor.Free;
- DiscMonitor := nil;
- end;
- end; {StopWatchThread}
- procedure TDriveView.StartAllWatchThreads;
- var
- Drive: TDrive;
- begin
- if (csDesigning in ComponentState) or (not FWatchDirectory) then
- Exit;
- for Drive := FirstFixedDrive to LastDrive do
- with DriveStatus[Drive] do
- if Scanned then
- begin
- if not Assigned(DiscMonitor) then
- CreateWatchThread(Drive);
- if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
- DiscMonitor.Open;
- end;
- if Assigned(Selected) and (GetDriveToNode(Selected) < FirstFixedDrive) then
- StartWatchThread;
- end; {StartAllWatchThreads}
- procedure TDriveView.StopAllWatchThreads;
- var
- Drive: TDrive;
- begin
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- begin
- if Assigned(DiscMonitor) then
- DiscMonitor.Close;
- end;
- end; {StopAllWatchThreads}
- function TDriveView.WatchThreadActive(Drive: TDrive): Boolean;
- begin
- Result := FWatchDirectory and
- Assigned(DriveStatus[Drive].DiscMonitor) and
- DriveStatus[Drive].DiscMonitor.Active;
- end; {WatchThreadActive}
- function TDriveView.WatchThreadActive: Boolean;
- var
- Drive: TDrive;
- begin
- if not Assigned(Selected) then
- begin
- Result := False;
- Exit;
- end;
- Drive := GetDriveToNode(Selected);
- Result := FWatchDirectory and
- Assigned(DriveStatus[Drive].DiscMonitor) and
- DriveStatus[Drive].DiscMonitor.Active;
- end; {WatchThreadActive}
- {$ENDIF}
- procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
- begin
- FFullDriveScan := DoFullDriveScan;
- end; {SetAutoScan}
- function TDriveView.FindPathNode(Path: string): TTreeNode;
- begin
- {Find existing path or parent path of not existing path:}
- repeat
- Result := FindNodeToPath(Path);
- if not Assigned(Result) then
- Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
- until Assigned(Result) or (Length(Path) < 3);
- end;
- procedure TDriveView.SetDirectory(Value: string);
- begin
- Value := IncludeTrailingBackslash(Value);
- FDirectory := Value;
- inherited;
- if Assigned(Selected) and (Selected.Level = 0) then
- begin
- if not DriveStatus[GetDriveToNode(Selected)].Scanned then
- ScanDrive(GetDriveToNode(Selected));
- end;
- end; {SetDirectory}
- procedure TDriveView.SetDrive(Drive: TDrive);
- begin
- if GetDrive <> Drive then
- with DriveStatus[Drive] do
- if Assigned(RootNode) then
- begin
- if DefaultDir = EmptyStr then
- DefaultDir := Drive + ':\';
- if not Scanned then
- RootNode.Expand(False);
- TopItem := RootNode;
- Directory := IncludeTrailingBackslash(DefaultDir);
- end;
- end; {SetDrive}
- function TDriveView.GetDrive: TDrive;
- begin
- if Assigned(Selected) then
- Result := GetDriveToNode(Selected)
- else
- Result := #0;
- end; {GetDrive}
- function TDriveView.GetDirName(Node: TTreeNode): string;
- begin
- if Assigned(Node) and Assigned(Node.Data) then
- Result := TNodeData(Node.Data).DirName
- else
- Result := '';
- end; {GetDirName}
- {GetDrive: returns the driveletter of the Node.}
- function TDriveView.GetDriveToNode(Node: TTreeNode): Char;
- var
- Path: string;
- begin
- if (not Assigned (Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
- Path := NodePath(Node);
- if Length(Path) > 0 then
- Result := Upcase(Path[1])
- else
- Result := #0;
- end; {GetDrive}
- {RootNode: returns the rootnode to the Node:}
- function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
- begin
- Result := Node;
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
- while Assigned(Result.Parent) do
- Result := Result.Parent;
- end; {RootNode}
- {NodeAttr: Returns the directory attributes to the node:}
- function TDriveView.NodeAttr(Node: TTreeNode): Integer;
- begin
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['NodeAttr']));
- Result := TNodeData(Node.Data).Attr;
- end; {NodeAttr}
- function TDriveView.NodeVerified(Node: TTreeNode): Boolean;
- begin
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['NodeVerified']));
- Result := TNodeData(Node.Data).Scanned;
- end; {NodeVerified}
- function TDriveView.CallBackExpandLevel(var Node: TTreeNode; Data: Pointer): Boolean;
- begin
- Result := True;
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['CallBackExpandLevel']));
- if (Node.Level <= Integer(Data)) and (not Node.Expanded) then
- Node.Expand(False)
- else if (Node.Level > Integer(Data)) and Node.Expanded then
- Node.Collapse(True);
- end; {CallBackExpandLevel}
- procedure TDriveView.ExpandLevel(Node: TTreeNode; Level: Integer);
- {Purpose: Expands all subnodes of node up to the given level}
- begin
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['ExpandLevel']));
- Items.BeginUpdate;
- IterateSubTree(Node, CallBackExpandLevel, rsRecursive, coScanStartNode, Pointer(Level));
- Items.EndUpdate;
- end; {ExpandLevel}
- function TDriveView.CallBackDisplayName(var Node: TTreeNode; Data: Pointer): Boolean;
- begin
- Result := True;
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['CallBackDisplayName']));
- Node.Text := GetDisplayName(Node);
- end; {CallBackDisplayName}
- function TDriveView.CallBackSetDirSize(var Node: TTreeNode; Data: Pointer): Boolean;
- begin
- Result := True;
- if Assigned(Node) then
- begin
- SetDirSize(Node);
- if FShowDirSize then
- Node.Text := GetDisplayName(Node);
- if Assigned(Data) then
- Inc(PInt(Data)^, TNodeData(Node.Data).DirSize);
- end;
- Application.ProcessMessages;
- if not FContinue then
- Exit;
- end; {CallBackSetDirSize}
- procedure TDriveView.SetShowDirSize(ShowIt: Boolean);
- var
- Drive: Char;
- RootNode: TTreeNode;
- SaveCursor: TCursor;
- begin
- if ShowIt = FShowDirSize then
- Exit;
- FShowDirSize := ShowIt;
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- Items.BeginUpdate;
- for Drive := FirstFixedDrive to LastDrive do
- begin
- if DriveInfo[Drive].Valid then
- begin
- RootNode := DriveStatus[Drive].RootNode;
- if Assigned(RootNode) then
- IterateSubTree(RootNode, CallBackDisplayName, rsRecursive, coScanStartNode, nil);
- end;
- end;
- Items.EndUpdate;
- Screen.Cursor := SaveCursor;
- end; {SetShowDirSize}
- procedure TDriveView.RefreshDirSize(Node: TTreeNode);
- begin
- if not Assigned(Node) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RefreshDirSize']));
- CallBackSetDirSize(Node, nil);
- end; {RefreshDirSize}
- procedure TDriveView.RefreshDriveDirSize(Drive: TDrive);
- var
- SaveCursor: TCursor;
- begin
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- Items.BeginUpdate;
- with DriveStatus[Drive] do
- begin
- if Assigned(RootNode) then
- IterateSubTree(RootNode, CallBackSetDirSize, rsRecursive, coScanStartNode, nil);
- end;
- Items.EndUpdate;
- Screen.Cursor := SaveCursor;
- end; {RefreshDriveDirSize}
- function TDriveView.GetDirSize(Node: TTreeNode): Cardinal;
- begin
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirSize']));
- if TNodeData(Node.Data).DirSize = CInvalidSize then
- SetDirSize(Node);
- Result := TNodeData(Node.Data).DirSize;
- end; {GetDirSize}
- procedure TDriveView.SetDirSize(Node: TTreeNode);
- var
- SRec: TSearchRec;
- Size: Cardinal;
- begin
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['SetDirSize']));
- Size := 0;
- if FindFirst(IncludeTrailingBackslash(NodePath(Node)) + '*.*', faAnyFile, SRec) = 0 then
- begin
- repeat
- if (SRec.Attr and faDirectory) = 0 then
- Inc(Size, SRec.Size);
- until FindNext(SRec) <> 0;
- end;
- FindClose(Srec);
- TNodeData(Node.Data).DirSize := Size;
- end; {SetDirSize}
- function TDriveView.GetDisplayName(Node: TTreeNode): string;
- var
- DirName: string;
- begin
- Result := '';
- if (not Assigned(Node)) or (not Assigned(Node.Data)) then
- raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
- if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
- else
- begin
- DirName := GetDirName(Node);
- case FFileNameDisplay of
- fndCap: Result := UpperCase(DirName);
- fndNoCap: Result := LowerCase(DirName);
- fndNice: if Length(DirName) <= 8 then
- begin
- Result := LowerCase(DirName);
- Result[1] := Upcase(Result[1]);
- end
- else Result := DirName;
- else
- Result := DirName;
- end; {Case}
- end;
- if FShowDirSize then
- Result := Result + ' = ' + FormatBytes(GetDirSize(Node), True, False);
- end; {GetDisplayName}
- procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
- begin
- IF ShowIt = fShowVolLabel Then
- Exit;
- fShowVolLabel := ShowIt;
- RefreshRootNodes(False, dvdsFloppy);
- End; {SetShowVolLabel}
- procedure TDriveView.SetVolDisplayStyle(DoStyle: TVolumeDisplayStyle);
- var
- Drive: TDrive;
- begin
- if DoStyle <> fVolDisplayStyle then
- begin
- FVolDisplayStyle := DoStyle;
- if not FCreating then
- for Drive := FirstDrive to LastDrive do
- begin
- if DriveInfo[Drive].Valid then
- DriveStatus[Drive].RootNode.Text := GetDisplayName(DriveStatus[Drive].RootNode);
- end;
- end;
- end; {SetVolDisplayStyle}
- procedure TDriveView.SetCompressedColor(Value: TColor);
- begin
- if Value <> FCompressedColor then
- begin
- FCompressedColor := Value;
- Invalidate;
- end;
- end; {SetCompressedColor}
- procedure TDriveView.SetFileNameDisplay(Value: TFileNameDisplay);
- var
- Drive: TDrive;
- begin
- if Value <> FFileNameDisplay then
- begin
- FFileNameDisplay := Value;
- for Drive := FirstDrive to LastDrive do
- with DriveStatus[Drive] do
- if Assigned(RootNode) and DriveStatus[Drive].Scanned then
- IterateSubTree(RootNode, CallBackDisplayName, rsRecursive, coNoScanStartNode, nil);
- end;
- end; {SetFileNameDisplay}
- procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
- var
- Verb: string;
- DirWatched: Boolean;
- begin
- {$IFNDEF NO_THREADS}
- DirWatched := NodeWatched(Node) and WatchThreadActive;
- {$ELSE}
- DirWatched := False;
- {$ENDIF}
- Assert(Node <> nil);
- if Node <> Selected then
- DropTarget := Node;
- Verb := EmptyStr;
- if Assigned(FOnDisplayContextMenu) then
- FOnDisplayContextMenu(Self);
- ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
- CanEdit(Node), Verb, False);
- if Verb = shcRename then Node.EditText
- else
- if Verb = shcCut then
- begin
- LastClipBoardOperation := cboCut;
- LastPathCut := NodePathName(Node);
- end
- else
- if Verb = shcCopy then LastClipBoardOperation := cboCopy
- else
- if Verb = shcPaste then
- PasteFromClipBoard(NodePathName(Node));
- DropTarget := nil;
- if not DirWatched then
- ValidateDirectory(Node);
- end; {DisplayContextMenu (2)}
- procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
- begin
- Assert(Assigned(Node));
- ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
- end; {ContextMenu}
- procedure TDriveView.SetSelected(Node: TTreeNode);
- begin
- if Node <> Selected then
- begin
- FChangeFlag := False;
- FCanChange := True;
- inherited Selected := Node;
- if not FChangeFlag then
- Change(Selected);
- end;
- end; {SetSelected}
- {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
- procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
- begin
- if Files.Count > 0 then
- ValidateDirectory(FindNodeToPath(Files[0]));
- end; {SignalDirDelete}
- function TDriveView.DDSourceEffects: TDropEffectSet;
- begin
- if FDragNode.Level = 0 then
- Result := [deLink]
- else
- Result := [deLink, deCopy, deMove];
- end;
- procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
- var
- TargetDrive: Char;
- begin
- if DropTarget = nil then Effect := DropEffect_None
- else
- if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) then
- begin
- TargetDrive := NodePath(DropTarget)[1];
- if FExeDrag and (TargetDrive >= FirstFixedDrive) and (FDragDrive >= FirstFixedDrive) then
- begin
- Effect := DropEffect_Link;
- end
- else
- if (Effect = DropEffect_Copy) and
- ((DragDrive = GetDriveToNode(DropTarget)) and
- (FDragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0)) then
- begin
- Effect := DropEffect_Move;
- end;
- end;
- inherited;
- end;
- function TDriveView.DragCompleteFileList: Boolean;
- begin
- Result := (GetDriveType(NodePathName(FDragNode)[1]) <> DRIVE_REMOVABLE);
- end;
- function TDriveView.DDExecute: TDragResult;
- {$IFNDEF NO_THREADS}
- var
- WatchThreadOK: Boolean;
- DragParentPath: string;
- DragPath: string;
- {$ENDIF}
- begin
- {$IFNDEF NO_THREADS}
- WatchThreadOK := WatchThreadActive;
- {$ENDIF}
- Result := FDragDropFilesEx.Execute(nil);
- {$IFNDEF NO_THREADS}
- if (Result = drMove) and (not WatchThreadOK) then
- begin
- DragPath := NodePathName(FDragNode);
- if Assigned(FDragNode.Parent) then
- DragParentPath := NodePathName(FDragNode.Parent)
- else
- DragParentPath := DragPath;
- if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
- begin
- FDragNode := FindNodeToPath(DragPath);
- if Assigned(FDragNode) then
- begin
- FDragFileList.Clear;
- FDragFileList.Add(DragPath);
- TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
- end;
- end;
- end;
- {$ENDIF}
- end;
- procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
- var
- i: Integer;
- SourcePath: string;
- SourceParentPath: string;
- SourceFile: string;
- SaveCursor: TCursor;
- DoFileOperation: Boolean;
- TargetNode: TTreeNode;
- FileNamesAreMapped: Boolean;
- TargetPath: string;
- IsRecycleBin: Boolean;
- begin
- TargetPath := NodePathName(Node);
- IsRecycleBin := NodeIsRecycleBin(Node);
- if FDragDropFilesEx.FileList.Count = 0 then
- Exit;
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- SourcePath := EmptyStr;
- try
- if (Effect = DropEffect_Copy) or (Effect = DropEffect_Move) then
- begin
- {$IFNDEF NO_THREADS}
- StopAllWatchThreads;
- if Assigned(FDirView) then
- FDirView.StopWatchThread;
- if Assigned(DropSourceControl) and
- (DropSourceControl is TDirView) and
- (DropSourceControl <> FDirView) then
- begin
- TDirView(DropSourceControl).StopWatchThread;
- end;
- {$ENDIF}
- FileNamesAreMapped := (TFDDListItem(FDragDropFilesEx.FileList[0]^).MappedName <> '');
- {Set the source directory:}
- for i := 0 to FDragDropFilesEx.FileList.Count - 1 do
- begin
- FFileOperator.OperandFrom.Add(
- TFDDListItem(FDragDropFilesEx.FileList[i]^).Name);
- if FileNamesAreMapped then
- FFileOperator.OperandTo.Add(IncludeTrailingBackslash(TargetPath) +
- TFDDListItem(FDragDropFilesEx.FileList[i]^).MappedName);
- end;
- SourcePath := TFDDListItem(FDragDropFilesEx.FileList[0]^).Name;
- SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
- ClearDragFileList(FDragDropFilesEx.FileList);
- FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
- {Set the target directory or target files:}
- if FileNamesAreMapped and (not IsRecycleBin) then
- begin
- FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles]
- end
- else
- begin
- FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
- FFileOperator.OperandTo.Clear;
- FFileOperator.OperandTo.Add(TargetPath);
- end;
- if IsRecycleBin then FFileOperator.Operation := foDelete
- else
- case Effect of
- DropEffect_Copy: FFileOperator.Operation := foCopy;
- DropEffect_Move: FFileOperator.Operation := foMove;
- end; {Case}
- if IsRecycleBin then
- begin
- if not ConfirmDelete then
- FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
- end
- else
- if not ConfirmOverwrite then
- FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
- DoFileOperation := True;
- if Assigned(FOnDDFileOperation) then
- FOnDDFileOperation(Self, Effect, SourcePath, TargetPath, DoFileOperation);
- if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
- begin
- FFileOperator.Execute;
- if Assigned(FOnDDFileOperationExecuted) then
- FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
- if FileNamesAreMapped then
- FFileOperator.ClearUndo;
- end;
- end
- else
- if Effect = DropEffect_Link then
- { Create Link requested: }
- begin
- for i := 0 to FDragDropFilesEx.FileList.Count - 1 do
- begin
- SourceFile := TFDDListItem(FDragDropFilesEx.FileList[i]^).Name;
- if Length(SourceFile) = 3 then
- SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
- else
- SourcePath := ExtractFileName(SourceFile);
- if not CreateFileShortCut(SourceFile,
- IncludeTrailingBackslash(TargetPath) + ChangeFileExt(SourcePath, '.lnk'),
- ExtractFileNameOnly(SourceFile)) then
- begin
- DDError(DDCreateShortCutError);
- end;
- end;
- end;
- if Effect = DropEffect_Move then
- Items.BeginUpdate;
- {Update source directory, if move-operation was performed:}
- if ((Effect = DropEffect_Move) or IsRecycleBin) then
- ValidateDirectory(FindNodeToPath(SourceParentPath));
- {Update subdirectories of target directory:}
- TargetNode := FindNodeToPath(TargetPath);
- if Assigned(TargetNode) then
- ValidateDirectory(TargetNode)
- else
- ValidateDirectory(DriveStatus[TargetPath[1]].RootNode);
- if Effect = DropEffect_Move then
- Items.EndUpdate;
- {Update linked component TDirView:}
- if Assigned(FDirView)
- {$IFNDEF NO_THREADS}
- and not FDirView.WatchThreadActive
- {$ENDIF}
- then
- begin
- case Effect of
- DropEffect_Copy,
- DropEffect_Link:
- if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
- FDirView.Reload2;
- DropEffect_Move:
- if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
- (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
- begin
- if FDirView <> DropSourceControl then FDirView.Reload2;
- end;
- end; {Case}
- end;
- {Update the DropSource control, if files are moved and it is a TDirView:}
- if (Effect = DropEffect_Move) and (DropSourceControl is TDirView) then
- TDirView(DropSourceControl).ValidateSelectedFiles;
- finally
- FFileOperator.OperandFrom.Clear;
- FFileOperator.OperandTo.Clear;
- {$IFNDEF NO_THREADS}
- StartAllWatchThreads;
- if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
- FDirView.StartWatchThread;
- if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
- (not TDirView(DropSourceControl).WatchThreadActive) then
- TDirView(DropSourceControl).StartWatchThread;
- {$ENDIF}
- Screen.Cursor := SaveCursor;
- end;
- end; {PerformDragDropFileOperation}
- function TDriveView.GetCanUndoCopyMove: Boolean;
- begin
- Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
- end; {CanUndoCopyMove}
- function TDriveView.UndoCopyMove: Boolean;
- var
- LastTarget: string;
- LastSource: string;
- begin
- Result := False;
- if FFileOperator.CanUndo then
- begin
- Lasttarget := FFileOperator.LastOperandTo[0];
- LastSource := FFileOperator.LastOperandFrom[0];
- {$IFNDEF NO_THREADS}
- StopAllWatchThreads;
- {$ENDIF}
- Result := FFileOperator.UndoExecute;
- ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
- ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
- {$IFNDEF NO_THREADS}
- StartAllWatchThreads;
- {$ENDIF}
- if Assigned(FDirView) then
- with FDirView do
- {$IFNDEF NO_THREADS}
- if not WatchThreadActive then
- {$ENDIF}
- begin
- if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
- (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
- Reload2;
- end;
- end;
- end; {UndoCopyMove}
- {Clipboard operations:}
- procedure TDriveView.SetLastPathCut(Path: string);
- var
- Node: TTreeNode;
- begin
- if FLastPathCut <> Path then
- begin
- Node := FindNodeToPath(FLastPathCut);
- if Assigned(Node) then
- begin
- FLastPathCut := Path;
- Node.Cut := False;
- end;
- Node := FindNodeToPath(Path);
- if Assigned(Node) then
- begin
- FLastPathCut := Path;
- Node.Cut := True;
- end;
- end;
- end; {SetLastNodeCut}
- procedure TDriveView.EmptyClipboard;
- begin
- if Windows.OpenClipBoard(0) then
- begin
- Windows.EmptyClipBoard;
- Windows.CloseClipBoard;
- LastPathCut := '';
- LastClipBoardOperation := cboNone;
- if Assigned(FDirView) then
- FDirView.EmptyClipboard;
- end;
- end; {EmptyClipBoard}
- function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
- begin
- Result := Assigned(Selected);
- if Result then
- begin
- EmptyClipBoard;
- ClearDragFileList(FDragDropFilesEx.FileList);
- AddToDragFileList(FDragDropFilesEx.FileList, Selected);
- Result := FDragDropFilesEx.CopyToClipBoard;
- LastClipBoardOperation := cboCopy;
- end;
- end; {CopyToClipBoard}
- function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
- begin
- Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
- if Result then
- begin
- LastPathCut := NodePathName(Node);
- LastClipBoardOperation := cboCut;
- end;
- end; {CutToClipBoard}
- function TDriveView.CanPasteFromClipBoard: Boolean;
- begin
- Result := False;
- if Assigned(Selected) and Windows.OpenClipboard(0) then
- begin
- Result := IsClipboardFormatAvailable(CF_HDROP);
- Windows.CloseClipBoard;
- end;
- end; {CanPasteFromClipBoard}
- function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
- begin
- ClearDragFileList(FDragDropFilesEx.FileList);
- Result := False;
- if CanPasteFromClipBoard and
- {MP}{$IFDEF OLD_DND} FDragDropFilesEx.GetFromClipBoard {$ELSE} FDragDropFilesEx.PasteFromClipboard {$ENDIF}{/MP}
- then
- begin
- if TargetPath = '' then
- TargetPath := NodePathName(Selected);
- case LastClipBoardOperation of
- cboCopy,
- cboNone:
- begin
- PerformDragDropFileOperation(Selected, DropEffect_Copy);
- if Assigned(FOnDDExecuted) then
- FOnDDExecuted(Self, DropEffect_Copy);
- end;
- cboCut:
- begin
- PerformDragDropFileOperation(Selected, DropEffect_Move);
- if Assigned(FOnDDExecuted) then
- FOnDDExecuted(Self, DropEffect_Move);
- EmptyClipBoard;
- end;
- end;
- Result := True;
- end;
- end; {PasteFromClipBoard}
- end.
|