| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194 |
- unit DirView;
- {===============================================================
- Component TDirView / Version 2.6, January 2000
- ===============================================================
- Description:
- ============
- Displays files of a single directory as listview 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 2001- 2003
- V2.6:
- - Shows "shared"-symbol with directories
- - New property ShowSubDirSize. Displays subdirectories sizes.
- - Delphi5 compatible
- For detailed documentation and history see TDirView.htm.
- ===============================================================}
- {Required compiler options for TDirView:}
- {$A+,B-,X+,H+,P+}
- interface
- {$WARN UNIT_PLATFORM OFF}
- uses
- Windows, ShlObj, ComCtrls, CompThread, CustomDirView, ListExt,
- ExtCtrls, Graphics, FileOperator, DiscMon, Classes, DirViewColProperties,
- DragDrop, Messages, ListViewColProperties, CommCtrl, DragDropFilesEx,
- FileCtrl, SysUtils;
- {$I ResStrings.pas }
- type
- TVolumeDisplayStyle = (doPrettyName, doDisplayName, doLongPrettyName); {Diplaytext of drive node}
- const
- {$IFNDEF NO_THREADS}
- msThreadChangeDelay = 10; {TDiscMonitor: change delay}
- MaxWaitTimeOut = 10; {TFileDeleteThread: wait nn seconds for deleting files or directories}
- {$ENDIF}
- FileAttr = SysUtils.faAnyFile and (not SysUtils.faVolumeID);
- ExtLen = 4; {Length of extension including '.' => '.EXE'}
- SpecialExtensions = 'EXE,LNK,ICO,ANI,CUR,PIF,JOB,CPL';
- ExeExtension = 'EXE';
- MinDate = $21; {01.01.1980}
- MaxDate = $EF9F; {31.12.2099}
- MinTime = 0; {00:00:00}
- MaxTime = $C000; {24:00:00}
- type
- {Exceptions:}
- {$IFNDEF NO_THREADS}
- EIUThread = class(Exception);
- {$ENDIF}
- EDragDrop = class(Exception);
- EInvalidFileName = class(Exception);
- ERenameFileFailed = class(Exception);
- TClipboardOperation = (cboNone, cboCut, cboCopy);
- TFileNameDisplay = (fndStored, fndCap, fndNoCap, fndNice);
- TExtStr = string[ExtLen];
- {Record for each file item:}
- PFileRec = ^TFileRec;
- TFileRec = record
- Empty: Boolean;
- IconEmpty: Boolean;
- IsDirectory: Boolean;
- IsRecycleBin: Boolean;
- IsParentDir: Boolean;
- FileName: string;
- Displayname: string;
- FileExt: TExtStr;
- TypeName: string;
- ImageIndex: Integer;
- Size: Int64;
- Attr: LongWord;
- FileTime: TFileTime;
- PIDL: PItemIDList; {Fully qualified PIDL}
- end;
- {Record for fileinfo caching:}
- PInfoCache = ^TInfoCache;
- TInfoCache = record
- FileExt: TExtStr;
- TypeName: ShortString;
- ImageIndex: Integer;
- end;
- {$IFDEF VER120}
- type
- TWMContextMenu = packed record
- Msg: Cardinal;
- hWnd: HWND;
- case Integer of
- 0: (XPos: Smallint;
- YPos: Smallint);
- 1: (Pos: TSmallPoint;
- Result: Longint);
- end;
- {$ENDIF}
- {Additional events:}
- type
- TDirViewAddFileEvent = procedure(Sender: TObject; var SearchRec: SysUtils.TSearchRec;
- var AddFile : Boolean) of object;
- TDirViewFileSizeChanged = procedure(Sender: TObject; Item: TListItem) of object;
- type
- TDirView = class;
- {$IFNDEF NO_THREADS}
- TSubDirScanner = class(TCompThread)
- private
- FOwner: TDirView;
- FStartPath: string;
- FDirName: string;
- FTotalSize: Int64;
- procedure ThreadTerminated(Sender: TObject);
- protected
- constructor Create(Owner: TDirView; Item: TListItem);
- procedure DoUpdateItem;
- procedure Execute; override;
- end;
- { TIconUpdateThread (Fetch shell icons via thread) }
- TIconUpdateThread = class(TCompThread)
- private
- FOwner: TDirView;
- FIndex: Integer;
- FMaxIndex: Integer;
- FNewIcons: Boolean;
- FSyncIcon: Integer;
- CurrentIndex: Integer;
- CurrentFilePath: string;
- CurrentItemData: TFileRec;
- InvalidItem: Boolean;
- procedure SetIndex(Value: Integer);
- procedure SetMaxIndex(Value: Integer);
- protected
- constructor Create(Owner: TDirView);
- procedure DoFetchData;
- procedure DoUpdateIcon;
- procedure Execute; override;
- procedure Terminate;
- property Index: Integer read FIndex write SetIndex;
- property MaxIndex: Integer read FMaxIndex write SetMaxIndex;
- end;
- {$ENDIF}
- { TDirView }
- TDirView = class(TCustomDirView)
- private
- FConfirmDelete: Boolean;
- FConfirmOverwrite: Boolean;
- FUseIconCache: Boolean;
- FInfoCacheList: TListExt;
- {$IFDEF USE_DRIVEVIEW}
- FDriveView: TObject;
- {$ENDIF}
- FChangeTimer: TTimer;
- FChangeInterval: Cardinal;
- FUseIconUpdateThread: Boolean;
- {$IFNDEF NO_THREADS}
- FIUThreadFinished: Boolean;
- {$ENDIF}
- FDriveType: Integer;
- FAttrSpace: string;
- FNoCheckDrives: string;
- FSortAfterUpdate: Boolean;
- FCompressedColor: TColor;
- FFileNameDisplay: TFileNameDisplay;
- FParentFolder: IShellFolder;
- FDesktopFolder: IShellFolder;
- FDirOK: Boolean;
- FPath: string;
- FDrawLinkOverlay: Boolean;
- SelectNewFiles: Boolean;
- {File selection properties:}
- FSelArchive: TSelAttr;
- FSelHidden: TSelAttr;
- FSelSysFile: TSelAttr;
- FSelReadOnly: TSelAttr;
- FSelFileSizeFrom: Int64;
- FSelFileSizeTo: Int64;
- FSelFileDateFrom: Word;
- FSelFileDateTo: Word;
- FSelFileTimeFrom: Word;
- FSelFileTimeTo: Word;
- {shFileOperation-shell component TFileOperator:}
- FFileOperator: TFileOperator;
- {Additional thread components:}
- {$IFNDEF NO_THREADS}
- FIconUpdateThread: TIconUpdateThread;
- {$ENDIF}
- FDiscMonitor: TDiscMonitor;
- FHomeDirectory: string;
- FSubDirScanner: TList;
- {Additional events:}
- FOnAddFile: TDirViewAddFileEvent;
- FOnFileSizeChanged: TDirViewFileSizeChanged;
- FOnChangeDetected: TNotifyEvent;
- FOnChangeInvalid: TNotifyEvent;
- iRecycleFolder: iShellFolder;
- PIDLRecycle: PItemIDList;
- {Drag&Drop:}
- function GetDirColProperties: TDirViewColProperties;
- function GetHomeDirectory: string;
- {Drag&drop helper functions:}
- {$IFNDEF NO_THREADS}
- procedure SignalFileDelete(Sender: TObject; Files: TStringList);
- {$ENDIF}
- procedure PerformDragDropFileOperation(TargetPath: string; dwEffect: Integer;
- RenameOnCollision: Boolean);
- procedure SetDirColProperties(Value: TDirViewColProperties);
- protected
- function NewColProperties: TCustomListViewColProperties; override;
- procedure SetShowSubDirSize(Value: Boolean); override;
- {$IFDEF USE_DRIVEVIEW}
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- {$ENDIF}
- procedure Delete(Item: TListItem); override;
- procedure SetMask(Value: string); override;
- procedure DDError(ErrorNo: TDDError);
- function GetCanUndoCopyMove: Boolean; virtual;
- {Shell namespace functions:}
- function GetShellFolder(Dir: string): iShellFolder;
- function GetDirOK: Boolean; override;
- procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItemA); override;
- procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
- DragStatus: TDragDetectStatus); override;
- procedure DDMenuDone(Sender: TObject; AMenu: HMenu); override;
- procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
- Point: TPoint; dwEffect: Longint); override;
- procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); override;
- function GetPathName: string; override;
- procedure SetChangeInterval(Value: Cardinal); virtual;
- procedure LoadFromRecycleBin(Dir: string); virtual;
- procedure SetLoadEnabled(Value: Boolean); override;
- function GetPath: string; override;
- procedure SetPath(Value: string); override;
- procedure SetItemImageIndex(Item: TListItem; Index: Integer); override;
- procedure SetCompressedColor(Value: TColor);
- procedure ChangeDetected(Sender: TObject);
- procedure ChangeInvalid(Sender: TObject);
- procedure TimerOnTimer(Sender: TObject);
- procedure ResetItemImage(Index: Integer);
- procedure SetAttrSpace(Value: string);
- procedure SetNoCheckDrives(Value: string);
- procedure SetWatchForChanges(Value: Boolean); override;
- procedure AddParentDirItem;
- procedure AddToDragFileList(FileList: TFileList; Item: TListItem); override;
- procedure SetFileNameDisplay(Value: TFileNameDisplay); virtual;
- procedure DisplayContextMenu(Where: TPoint); override;
- function DragCompleteFileList: Boolean; override;
- procedure ExecuteFile(Item: TListItem); override;
- function GetIsRoot: Boolean; override;
- procedure InternalEdit(const HItem: TLVItem); override;
- function ItemColor(Item: TListItem): TColor; override;
- function ItemDisplayName(FileName: string): string; virtual;
- function ItemFileExt(Item: TListItem): string;
- function ItemFileNameOnly(Item: TListItem): string;
- function ItemFileSize(Item: TListItem): Int64; override;
- function ItemFileTime(Item: TListItem): TDateTime; override;
- function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; override;
- function ItemIsFile(Item: TListItem): Boolean; override;
- function ItemIsRecycleBin(Item: TListItem): Boolean; override;
- function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; override;
- function ItemOverlayIndexes(Item: TListItem): Word; override;
- procedure LoadFiles; override;
- function MinimizePath(Path: string; Len: Integer): string; override;
- procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer); override;
- procedure SortItems; override;
- {$IFNDEF NO_THREADS}
- procedure StartFileDeleteThread;
- {$ENDIF}
- procedure SetShowHiddenFiles(Value: Boolean); override;
- procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
- public
- {Runtime, readonly properties:}
- property DriveType: Integer read FDriveType;
- {$IFDEF USE_DRIVEVIEW}
- {Linked component TDriveView:}
- property DriveView: TObject read FDriveView write FDriveView;
- {$ENDIF}
- {It is not required to store the items edited at designtime:}
- property Items stored False;
- { required, otherwise AV generated, when dragging columns}
- property Columns stored False;
- property ParentFolder: IShellFolder read FParentFolder;
- {Drag&Drop runtime, readonly properties:}
- property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
- property DDFileOperator: TFileOperator read FFileOperator;
- {Drag&Drop fileoperation methods:}
- function UndoCopyMove: Boolean; dynamic;
- {Clipboard fileoperation methods (requires drag&drop enabled):}
- procedure EmptyClipboard; dynamic;
- function CopyToClipBoard: Boolean; dynamic;
- function CutToClipBoard: Boolean; dynamic;
- function CanPasteFromClipBoard: Boolean; dynamic;
- function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
- function DuplicateSelectedFiles: Boolean; dynamic;
- procedure DisplayPropertiesMenu; override;
- procedure ExecuteParentDirectory; override;
- procedure ExecuteRootDirectory; override;
- function ItemIsDirectory(Item: TListItem): Boolean; override;
- function ItemFullFileName(Item: TListItem): string; override;
- function ItemIsParentDirectory(Item: TListItem): Boolean; override;
- function ItemFileName(Item: TListItem): string; override;
- {$IFNDEF NO_THREADS}
- {Thread handling: }
- procedure StartWatchThread;
- procedure StopWatchThread;
- function WatchThreadActive: Boolean;
- procedure StartIconUpdateThread;
- procedure StopIconUpdateThread;
- procedure StartSubDirScanner;
- procedure StopSubDirScanner;
- procedure TerminateThreads;
- {$ENDIF}
- {Other additional functions: }
- procedure Syncronize;
- procedure ClearIconCache;
- {Create a new file:}
- function CreateFile(NewName: string): TListItem; dynamic;
- {Create a new subdirectory:}
- procedure CreateDirectory(DirName: string); override;
- {Delete all selected files:}
- function DeleteSelectedFiles(AllowUndo: Boolean): Boolean; dynamic;
- {Check, if file or files still exists:}
- procedure ValidateFile(Item: TListItem); overload;
- procedure ValidateFile(FileName:TFileName); overload;
- procedure ValidateSelectedFiles; dynamic;
- {Access the internal data-structures:}
- function AddItem(SRec: SysUtils.TSearchRec): TListItem; reintroduce;
- procedure GetDisplayData(Item: TListItem; FetchIcon: Boolean);
- function GetFileRec(Index: Integer): PFileRec;
- {Populate / repopulate the filelist:}
- procedure Load; override;
- procedure ReLoad(CacheIcons : Boolean); override;
- procedure Reload2;
- function FormatFileTime(FileTime: TFileTime): string; virtual;
- function GetAttrString(Attr: Integer): string; virtual;
- procedure FetchAllDisplayData;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure ExecuteHomeDirectory; override;
- procedure ReloadDirectory; override;
- property HomeDirectory: string read GetHomeDirectory write FHomeDirectory;
- {Redefined functions: }
- {Properties for filtering files:}
- property SelArchive: TSelAttr
- read FSelArchive write FSelArchive default selDontCare;
- property SelHidden: TSelAttr
- read FSelHidden write FSelHidden default selDontCare;
- property SelSysFile: TSelAttr
- read FSelSysFile write FSelSysFile default selDontCare;
- property SelReadOnly: TSelAttr
- read FSelReadOnly write FSelReadOnly default selDontCare;
- property SelFileSizeFrom: Int64
- read FSelFileSizeFrom write FSelFileSizeFrom;
- property SelFileSizeTo: Int64
- read FSelFileSizeTo write FSelFileSizeTo default 0;
- property SelFileDateFrom: Word
- read FSelFileDateFrom write FSelFileDateFrom default MinDate; {01.01.1980}
- property SelFileDateTo: Word
- read FSelFileDateTo write FSelFileDateTo default MaxDate; {31.12.2099}
- property SelFileTimeFrom: Word
- read FSelFileTimeFrom write FSelFileTimeFrom;
- property SelFileTimeTo: Word
- read FSelFileTimeTo write FSelFileTimeTo default MaxTime;
- published
- property DirColProperties: TDirViewColProperties read GetDirColProperties write SetDirColProperties;
- property PathComboBox;
- property PathLabel;
- property StatusBar;
- property OnGetSelectFilter;
- property HeaderImages;
- property LoadAnimation;
- property DimmHiddenFiles;
- property ShowDirectories;
- property ShowHiddenFiles;
- property DirsOnTop;
- property ShowSubDirSize;
- property SingleClickToExec;
- property WantUseDragImages;
- property TargetPopupMenu;
- property AddParentDir;
- property OnSelectItem;
- property OnStartLoading;
- property OnLoaded;
- property OnDDDragEnter;
- property OnDDDragLeave;
- property OnDDDragOver;
- property OnDDDrop;
- property OnDDQueryContinueDrag;
- property OnDDGiveFeedback;
- property OnDDDragDetect;
- property OnDDCreateDragFileList;
- property OnDDEnd;
- property OnDDCreateDataObject;
- property OnDDTargetHasDropHandler;
- {Drag&Drop:}
- property DDLinkOnExeDrag default True;
- property OnDDProcessDropped;
- property OnDDError;
- property OnDDExecuted;
- property OnDDFileOperation;
- property OnDDFileOperationExecuted;
- property OnExecFile;
- property CompressedColor: TColor
- read FCompressedColor write SetCompressedColor default clBlue;
- {Confirm deleting files}
- property ConfirmDelete: Boolean
- read FConfirmDelete write FConfirmDelete default True;
- {Confirm overwriting files}
- property ConfirmOverwrite: Boolean
- read FConfirmOverwrite write fConfirmOverwrite default True;
- property SortAfterUpdate: Boolean
- read FSortAfterUpdate write FSortAfterUpdate default True;
- {Reload the directory after only the interval:}
- property ChangeInterval: Cardinal
- read FChangeInterval write SetChangeInterval default 1000;
- {Fetch shell icons by thread:}
- property UseIconUpdateThread: Boolean
- read FUseIconUpdateThread write FUseIconUpdateThread default False;
- {Enables or disables icon caching for registered file extensions. Caching enabled
- enhances the performance but does not take care about installed icon handlers, wich
- may modify the display icon for registered files. Only the iconindex is cached not the
- icon itself:}
- property UseIconCache: Boolean
- read FUseIconCache write FUseIconCache default False;
- property FileNameDisplay: TFileNameDisplay
- read FFileNameDisplay write SetFileNameDisplay default fndStored;
- {Use this string as whitespace in the attribute column:}
- property AttrSpace: string read FAttrSpace write SetAttrSpace;
- {Don't watch these drives for changes:}
- property NoCheckDrives: string read FNoCheckDrives write SetNoCheckDrives;
- {Watch current directory for filename changes (create, rename, delete files)}
- property WatchForChanges;
- {Additional events:}
- {The watchthread has detected new, renamed or deleted files}
- {$IFNDEF NO_THREADS}
- property OnChangeDetected: TNotifyEvent
- read FOnChangeDetected write FOnChangeDetected;
- {The watchthread can't watch the current directory. Occurs on novell
- network drives.}
- property OnChangeInvalid: TNotifyEvent
- read FOnChangeInvalid write FOnChangeInvalid;
- {$ENDIF}
- {Set AddFile to false, if actual file should not be added to the filelist:}
- property OnAddFile: TDirViewAddFileEvent
- read FOnAddFile write FOnAddFile;
- property OnFileSizeChanged: TDirViewFileSizeChanged
- read FOnFileSizeChanged write FOnFileSizeChanged;
- property UseSystemContextMenu;
- property OnContextPopup;
- property OnBeginRename;
- property OnEndRename;
- property OnHistoryChange;
- property ColumnClick;
- property MultiSelect;
- property ReadOnly;
- end; {Type TDirView}
- procedure Register;
- {Returns True, if the specified extension matches one of the extensions in ExtList:}
- function MatchesFileExt(Ext: TExtStr; const FileExtList: string): Boolean;
- var
- LastClipBoardOperation: TClipBoardOperation;
- LastIOResult: DWORD;
- implementation
- uses
- {$IFDEF USE_DRIVEVIEW}
- DriveView,
- {$ENDIF}
- PIDL, Forms, Dialogs, Controls,
- ShellAPI, ComObj,
- ActiveX, ImgList,
- ShellDialogs, IEDriveInfo,
- MaskSearch, FileChanges, BaseUtils, Math;
- procedure Register;
- begin
- RegisterComponents('DriveDir', [TDirView]);
- end; {Register}
- function CompareInfoCacheItems(I1, I2: Pointer): Integer;
- begin
- if PInfoCache(I1)^.FileExt < PInfoCache(I2)^.FileExt then Result := fLess
- else
- if PInfoCache(I1)^.FileExt > PInfoCache(I2)^.FileExt then Result := fGreater
- else Result := fEqual;
- end; {CompareInfoCacheItems}
- function MatchesFileExt(Ext: TExtStr; const FileExtList: string): Boolean;
- begin
- Result := (Length(Ext) >= Pred(ExtLen)) and (Pos(Ext, FileExtList) <> 0);
- end; {MatchesFileExt}
- function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
- var
- SysTime: TSystemTime;
- LocalFileTime: TFileTime;
- begin
- FileTimeToLocalFileTime(FileTime, LocalFileTime);
- FileTimeToSystemTime(LocalFileTime, SysTime);
- Result := SystemTimeToDateTime(SysTime);
- end;
- function SizeFromSRec(const SRec: SysUtils.TSearchRec): Int64;
- begin
- with SRec do
- begin
- // Hopefuly TSearchRec.FindData is available with all Windows versions
- {if Size >= 0 then Result := Size
- else}
- {$WARNINGS OFF}
- Result := Int64(FindData.nFileSizeHigh) shl 32 + FindData.nFileSizeLow;
- {$WARNINGS ON}
- end;
- end;
- {function ResolveLink(const Path: string): string;
- var
- Link: IShellLink;
- Storage: IPersistFile;
- FileData: TWin32FindData;
- Buf: Array[0..MAX_PATH] of Char;
- WidePath: WideString;
- begin
- OleCheck(CoCreateInstance( CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
- IShellLink, Link));
- OleCheck(Link.QueryInterface(IPersistFile, Storage));
- WidePath := Path;
- if Succeeded(Storage.Load(@WidePath[1], STGM_READ)) and
- Succeeded(Link.Resolve(GetActiveWindow, SLR_NOUPDATE)) and
- Succeeded(Link.GetPath(Buf, sizeof(Buf), FileData, SLGP_UNCPRIORITY)) then
- begin
- Result := Buf;
- end
- else
- begin
- raise Exception(Format(SResolveLinkError, [Path]));
- end;
- Storage := nil;
- Link:= nil;
- end;}
- {$IFNDEF NO_THREADS}
- { TSubDirScanner }
- constructor TSubDirScanner.Create(Owner: TDirView; Item: TListItem);
- begin
- inherited Create(True);
- FOwner := Owner;
- FTotalSize := 0;
- FStartPath := FOwner.ItemFullFileName(Item);
- FDirName := Item.Caption;
- FreeOnTerminate := False;
- OnTerminate := ThreadTerminated;
- Priority := tpLower;
- Resume;
- end; {Create}
- procedure TSubDirScanner.Execute;
- function ScanSubDir(Path: string): Boolean;
- var
- SRec: SysUtils.TSearchRec;
- DosError: Integer;
- SubDirs: TStringList;
- Index: Integer;
- FSize: Int64;
- begin
- Result := True;
- DosError := FindFirst(Path + '*.*', faAnyFile, SRec);
- if DosError = 0 then
- begin
- SubDirs := TStringList.Create;
- try
- while DosError = 0 do
- begin
- if Terminated then
- Break;
- if (SRec.Name <> '.') and (SRec.name <> '..') then
- begin
- FSize := SizeFromSRec(SRec);
- if FSize > 0 then
- Inc(FTotalSize, FSize);
- if SRec.Attr and faDirectory <> 0 then
- SubDirs.Add(IncludeTrailingPathDelimiter(Path + Srec.Name));
- end;
- if not Terminated then DosError := FindNext(SRec)
- else Break;
- end; {While}
- FindClose(SRec);
- finally
- try
- for Index := 0 to SubDirs.Count - 1 do
- begin
- Result := ScanSubDir(SubDirs[Index]);
- if not Result then Break;
- end;
- finally
- SubDirs.Free;
- if Result then
- Result := (DosError = ERROR_NO_MORE_FILES);
- end;
- end;
- end;
- end; {ScanSubDir}
- begin {Execute}
- if ScanSubDir(IncludeTrailingPathDelimiter(FStartPath)) and not Terminated then
- Synchronize(DoUpdateItem);
- end; {Execute}
- procedure TSubDirScanner.DoUpdateItem;
- var
- Item: TListItem;
- StartPos: Integer;
- begin
- if not Terminated then
- begin
- StartPos := 0;
- Item := nil;
- while StartPos < FOwner.Items.Count do
- begin
- Item := FOwner.FindCaption(StartPos, FDirName, False, True, False);
- if Assigned(Item) and (FOwner.ItemFullFileName(Item) = FStartPath) then
- Break
- else
- if not Assigned(Item) then Break
- else StartPos := Item.Index + 1;
- end;
- if Assigned(Item) and not Terminated then
- begin
- PFileRec(Item.Data)^.Size := FTotalSize;
- Inc(FOwner.FFilesSize, FTotalSize);
- if Item.Selected then
- Inc(FOwner.FFilesSelSize, FTotalSize);
- FOwner.UpdateItems(Item.Index, Item.Index);
- if Assigned(FOwner.OnFileSizeChanged) then
- FOwner.OnFileSizeChanged(FOwner, Item);
- end;
- end;
- end; {DoUpdateItem}
- procedure TSubDirScanner.ThreadTerminated(Sender: TObject);
- var
- Index: Integer;
- begin
- Assert(Assigned(FOwner));
- with FOwner do
- for Index := 0 to FSubDirScanner.Count - 1 do
- if FSubDirScanner[Index] = Self then
- begin
- try
- FSubDirScanner.Delete(Index);
- if (FSubDirScanner.Count = 0) and
- (FOwner.SortColumn = Integer(dvSize)) and
- not Loading then FOwner.SortItems;
- finally
- inherited Destroy;
- end;
- Exit;
- end;
- Assert(False, 'TSubDirScanner failed: ' + FStartPath);
- inherited Destroy;
- end; {ThreadTerminated}
- { TIconUpdateThread }
- constructor TIconUpdateThread.Create(Owner: TDirView);
- begin
- inherited Create(True);
- FOwner := Owner;
- FIndex := 0;
- FNewIcons := False;
- if (FOwner.ViewStyle = vsReport) or (FOwner.ViewStyle = vsList) then
- FMaxIndex := FOwner.VisibleRowCount
- else FMaxIndex := 0;
- FOwner.FIUThreadFinished := False;
- end; {TIconUpdateThread.Create}
- procedure TIconUpdateThread.SetMaxIndex(Value: Integer);
- var
- Point: TPoint;
- Item: TListItem;
- begin
- if Value <> MaxIndex then
- begin
- FNewIcons := True;
- if Value < FMaxIndex then
- begin
- if Suspended then FIndex := Value
- else
- begin
- Point.X := 0;
- Point.X := 0;
- Item := FOwner.GetNearestItem(Point, TSearchDirection(sdAbove));
- if Assigned(Item) then FIndex := Item.Index
- else FIndex := Value;
- end;
- end
- else FMaxIndex := Value;
- end;
- end; {SetMaxIndex}
- procedure TIconUpdateThread.SetIndex(Value: Integer);
- var
- PageSize: Integer;
- begin
- if Value <> Index then
- begin
- PageSize := FOwner.VisibleRowCount;
- FIndex := Value;
- FNewIcons := True;
- if FOwner.ViewStyle = vsList then FMaxIndex := Value + 2 * PageSize
- else FMaxIndex := Value + PageSize;
- end;
- end; {SetIndex}
- procedure TIconUpdateThread.Execute;
- var
- FileInfo: TShFileInfo;
- Count: Integer;
- WStr: WideString;
- Eaten: ULONG;
- ShAttr: ULONG;
- begin
- if Assigned(FOwner.TopItem) then FIndex := FOwner.TopItem.Index
- else FIndex := 0;
- FNewIcons := (FIndex > 0);
- while not Terminated do
- begin
- if FIndex > FMaxIndex then Suspend;
- Count := FOwner.Items.Count;
- if not Terminated and ((FIndex >= Count) or (Count = 0)) then
- Suspend;
- InvalidItem := True;
- if Terminated then Break;
- Synchronize(DoFetchData);
- if (not InvalidItem) and (not Terminated) and
- CurrentItemData.IconEmpty then
- begin
- try
- if not Assigned(CurrentItemData.PIDL) then
- begin
- WStr := CurrentFilePath;
- FOwner.FDesktopFolder.ParseDisplayName(FOwner.ParentForm.Handle, nil,
- PWideChar(WStr), Eaten, CurrentItemData.PIDL, ShAttr);
- end;
- if Assigned(CurrentItemData.PIDL) then
- shGetFileInfo(PChar(CurrentItemData.PIDL), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL)
- else
- shGetFileInfo(PChar(CurrentFilePath), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
- except
- {Capture exceptions generated by the shell}
- FSyncIcon := UnKnownFileIcon;
- end;
- if Terminated then
- begin
- FreePIDL(CurrentItemData.PIDL);
- Break;
- end;
- FSyncIcon := FileInfo.iIcon;
- if FSyncIcon <> CurrentItemData.ImageIndex then
- FNewIcons := True;
- if not Terminated then
- Synchronize(DoUpdateIcon);
- FreePIDL(CurrentItemData.PIDL);
- end;
- SetLength(CurrentFilePath, 0);
- if CurrentIndex = FIndex then Inc(FIndex);
- SetLength(CurrentFilePath, 0);
- end;
- end; {TIconUpdateThread.Execute}
- procedure TIconUpdateThread.DoFetchData;
- begin
- CurrentIndex := fIndex;
- if not Terminated and
- (Pred(FOwner.Items.Count) >= CurrentIndex) and
- Assigned(FOwner.Items[CurrentIndex]) and
- Assigned(FOwner.Items[CurrentIndex].Data) then
- begin
- CurrentFilePath := FOwner.ItemFullFileName(FOwner.Items[CurrentIndex]);
- CurrentItemData := PFileRec(FOwner.Items[CurrentIndex].Data)^;
- InvalidItem := False;
- end
- else InvalidItem := True;
- end; {TIconUpdateThread.DoFetchData}
- procedure TIconUpdateThread.DoUpdateIcon;
- var
- LVI: TLVItem;
- begin
- if (FOwner.Items.Count > CurrentIndex) and
- not fOwner.Loading and not Terminated and
- Assigned(FOwner.Items[CurrentIndex]) and
- Assigned(FOwner.Items[CurrentIndex].Data) then
- with FOwner.Items[CurrentIndex] do
- begin
- if (FSyncIcon >= 0) and (PFileRec(Data)^.ImageIndex <> FSyncIcon) then
- begin
- with PFileRec(Data)^ do
- ImageIndex := FSyncIcon;
- {To avoid flickering of the display use Listview_SetItem
- instead of using the property ImageIndex:}
- LVI.mask := LVIF_IMAGE;
- LVI.iItem := CurrentIndex;
- LVI.iSubItem := 0;
- LVI.iImage := I_IMAGECALLBACK;
- if not Terminated then
- ListView_SetItem(FOwner.Handle, LVI);
- FNewIcons := True;
- end;
- PFileRec(Data)^.IconEmpty := False;
- end;
- end; {TIconUpdateThread.DoUpdateIcon}
- procedure TIconUpdateThread.Terminate;
- begin
- FOwner.FIUThreadFinished := True;
- inherited;
- end; {TIconUpdateThread.Terminate}
- {$ENDIF} // NO_THREADS
- { TDirView }
- constructor TDirView.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FInfoCacheList := TListExt.Create(SizeOf(TInfoCache));
- FDriveType := DRIVE_UNKNOWN;
- FUseIconCache := False;
- FConfirmDelete := True;
- FAttrSpace := EmptyStr;
- FSortAfterUpdate := True;
- FCompressedColor := clBlue;
- FFileNameDisplay := fndStored;
- FParentFolder := nil;
- FDesktopFolder := nil;
- SelectNewFiles := False;
- FDrawLinkOverlay := True;
- DragOnDriveIsMove := True;
- FFileOperator := TFileOperator.Create(Self);
- FFileOperator.ProgressTitle := coFileOperatorTitle;
- FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
- FDirOK := True;
- FPath := '';
- FDiscMonitor := nil;
- FSubDirScanner := TList.Create;
- {ChangeTimer: }
- if FChangeInterval = 0 then FChangeInterval := 1000;
- FChangeTimer := TTimer.Create(Self);
- FChangeTimer.Interval := fChangeInterval;
- FChangeTimer.Enabled := False;
- FChangeTimer.OnTimer := TimerOnTimer;
- FSelArchive := selDontCare;
- FSelHidden := selDontCare;
- FSelReadOnly := selDontCare;
- FSelSysFile := selDontCare;
- FSelFileSizeTo := 0;
- FSelFileDateFrom := MinDate;
- FSelFileDateTo := MaxDate;
- FSelFileTimeTo := MaxTime;
- {Drag&drop:}
- FConfirmOverwrite := True;
- DDLinkOnExeDrag := True;
- with DragDropFilesEx do
- begin
- SourceEffects := DragSourceEffects;
- TargetEffects := [deCopy, deMove, deLink];
- ShellExtensions.DragDropHandler := True;
- ShellExtensions.DropHandler := True;
- end;
- end; {Create}
- destructor TDirView.Destroy;
- begin
- FSubDirScanner.Free;
- if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
- FInfoCacheList.Free;
- FFileOperator.Free;
- FChangeTimer.Free;
- inherited Destroy;
- end; {Destroy}
- procedure TDirView.WMDestroy(var Msg: TWMDestroy);
- begin
- Selected := nil;
- ClearItems;
- {$IFNDEF NO_THREADS}
- TerminateThreads;
- {$ENDIF}
- inherited;
- end; {WMDestroy}
- {$IFNDEF NO_THREADS}
- procedure TDirView.TerminateThreads;
- begin
- StopSubDirScanner;
- StopIconUpdateThread;
- StopWatchThread;
- end; {TerminateThreads}
- {$ENDIF}
- function TDirView.GetHomeDirectory: string;
- begin
- if FHomeDirectory <> '' then Result := FHomeDirectory
- else
- begin
- Result := UserDocumentDirectory;
- if IsUNCPath(Result) then
- Result := AnyValidPath;
- end;
- end; { GetHomeDirectory }
- function TDirView.GetIsRoot: Boolean;
- begin
- Result := (Length(Path) = 2) and (Path[2] = ':');
- end;
- function TDirView.GetPath: string;
- begin
- Result := FPath;
- end;
- procedure TDirView.SetPath(Value: string);
- begin
- Value := StringReplace(Value, '/', '\', [rfReplaceAll]);
- while (Length(Value) > 0) and (Value[Length(Value)] = '\') do
- SetLength(Value, Length(Value) - 1);
- if FPath <> Value then
- try
- if IsUncPath(Value) then
- raise Exception.CreateFmt(SUcpPathsNotSupported, [Value]);
- if not DirectoryExists(Value) then
- raise Exception.CreateFmt(SDirNotExists, [Value]);
- FLastPath := PathName;
- FPath := Value;
- Load;
- finally
- PathChanged;
- end;
- end;
- procedure TDirView.SetLoadEnabled(Value: Boolean);
- begin
- if Value <> LoadEnabled then
- begin
- FLoadEnabled := Enabled;
- if LoadEnabled and Dirty then
- begin
- if Items.Count > 100 then Reload2
- else Reload(True);
- end;
- end;
- end; {SetLoadEnabled}
- procedure TDirView.SetShowHiddenFiles(Value: Boolean);
- begin
- if Value <> ShowHiddenFiles then
- begin
- if Value then FSelHidden := selDontCare
- else FSelHidden := selNo;
- inherited;
- end;
- end;
- procedure TDirView.SetCompressedColor(Value: TColor);
- begin
- if Value <> CompressedColor then
- begin
- FCompressedColor := Value;
- Invalidate;
- end;
- end; {SetCompressedColor}
- function TDirView.GetPathName: string;
- begin
- if (Length(Path) = 2) and (Path[2] = ':') then Result := Path + '\'
- else Result := Path;
- end; {GetPathName}
- function TDirView.GetFileRec(Index: Integer): PFileRec;
- begin
- if Index > Pred(Items.Count) then Result := nil
- else Result := Items[index].Data;
- end; {GetFileRec}
- function TDirView.ItemDisplayName(FileName: string): string;
- begin
- case FFileNameDisplay of
- fndCap: Result := UpperCase(FileName);
- fndNoCap: Result := LowerCase(FileName);
- fndNice:
- if (Length(FileName) > 12) or (Pos(' ', FileName) <> 0) then
- Result := FileName
- else
- begin
- Result := LowerCase(FileName);
- Result[1] := Upcase(Result[1]);
- end;
- else
- Result := FileName;
- end; {Case}
- end; {ItemDisplayName}
- function TDirView.AddItem(SRec: SysUtils.TSearchRec): TListItem;
- var
- PItem: PFileRec;
- Item: TListItem;
- begin
- Item := Items.Add;
- New(PItem);
- with PItem^ do
- begin
- FileName := SRec.Name;
- FileExt := UpperCase(Copy(ExtractFileExt(Srec.Name), 2, Pred(ExtLen)));
- DisplayName := ItemDisplayName(FileName);
- {$WARNINGS OFF}
- Attr := SRec.FindData.dwFileAttributes;
- {$WARNINGS ON}
- IsParentDir := False;
- IsDirectory := ((Attr and SysUtils.faDirectory) <> 0);
- IsRecycleBin := IsDirectory and (Length(Path) = 2) and
- Bool(Attr and SysUtils.faSysFile) and
- ((UpperCase(FileName) = 'RECYCLED') or (UpperCase(FileName) = 'RECYCLER'));
- if not IsDirectory then Size := SizeFromSRec(SRec)
- else Size := -1;
- if not Self.IsRecycleBin then Item.Caption := SRec.Name;
- {$WARNINGS OFF}
- FileTime := SRec.FindData.ftLastWriteTime;
- {$WARNINGS ON}
- Empty := True;
- IconEmpty := True;
- if Size > 0 then Inc(FFilesSize, Size);
- PIDL := nil;
- Item.Data := PItem;
- if FileExt = 'LNK' then Item.OverlayIndex := 1;
- end;
- if SelectNewFiles then Item.Selected := True;
- Result := Item;
- end; {AddItem}
- procedure TDirView.AddParentDirItem;
- var
- PItem: PFileRec;
- Item: TListItem;
- SRec: SysUtils.TSearchRec;
- begin
- FHasParentDir := True;
- Item := Items.Add;
- New(PItem);
- if FindFirst(FPath, faAnyFile, SRec) = 0 then
- FindClose(SRec);
- with PItem^ do
- begin
- FileName := '..';
- FileExt := '';
- DisplayName := '..';
- Attr := SRec.Attr;
- IsDirectory := True;
- IsRecycleBin := False;
- IsParentDir := True;
- Size := -1;
- Item.Caption := '..';
- {$WARNINGS OFF}
- FileTime := SRec.FindData.ftLastWriteTime;
- {$WARNINGS ON}
- Empty := True;
- IconEmpty := False;
- PIDL := nil;
- Item.Data := PItem;
- if HasExtendedCOMCTL32 then ImageIndex := StdDirIcon
- else ImageIndex := StdDirSelIcon;
- TypeName := SParentDir;
- Empty := False;
- end;
- end; {AddParentDirItem}
- procedure TDirView.LoadFromRecycleBin(Dir: string);
- var
- PIDLRecycleLocal: PItemIDList;
- PCurrList: PItemIDList;
- FQPIDL: PItemIDList;
- EnumList: IEnumIDList;
- Fetched: ULONG;
- SRec: SysUtils.TSearchRec;
- DisplayName: string;
- FullPath: string;
- NewItem: TListItem;
- FileRec: PFileRec;
- FileInfo: TSHFileInfo;
- FileSel: Boolean;
- MaskList: TStringList;
- DosError: Integer;
- AttrIncludeMask: Integer;
- AttrExcludeMask: Integer;
- FileTimeFrom: LongWord;
- FileTimeTo: LongWord;
- procedure AddToMasks(Attr: TSelAttr; Mask: Word);
- begin
- case Attr of
- selYes: AttrIncludeMask := AttrIncludeMask or Mask;
- selNo: AttrExcludeMask := AttrExcludeMask or Mask;
- end;
- end;
- begin
- if not Assigned(iRecycleFolder) then
- begin
- PIDLRecycleLocal := nil;
- try
- OLECheck(shGetSpecialFolderLocation(Self.Handle,
- CSIDL_BITBUCKET, PIDLRecycleLocal));
- PIDLRecycle := PIDL_Concatenate(nil, PIDLRecycleLocal);
- if not SUCCEEDED(FDesktopFolder.BindToObject(PIDLRecycle, nil,
- IID_IShellFolder, Pointer(iRecycleFolder))) then Exit;
- finally
- if Assigned(PIDLRecycleLocal) then
- FreePIDL(PIDLRecycleLocal);
- end;
- end;
- FParentFolder := iRecycleFolder;
- if AddParentDir then AddParentDirItem;
- MaskList := TStringList.Create;
- BuildMask(Mask, MaskList);
- AttrIncludeMask := 0;
- AttrExcludeMask := 0;
- AddToMasks(FSelArchive, SysUtils.faArchive);
- AddToMasks(FSelHidden, SysUtils.faHidden);
- AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
- AddToMasks(FSelSysFile, SysUtils.faSysFile);
- FileTimeFrom := LongWord(FSelFileDateFrom) shl 16 or FSelFileTimeFrom;
- FileTimeTo := LongWord(FSelFileDateTo) shl 16 or FSelFileTimeTo;
- try
- if SUCCEEDED(iRecycleFolder.EnumObjects(Self.Handle,
- SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList)) then
- begin
- while (EnumList.Next(1, PCurrList, Fetched) = S_OK) and not AbortLoading do
- begin
- if Assigned(PCurrList) then
- try
- FQPIDL := PIDL_Concatenate(PIDLRecycle, PCurrList);
- {Physical filename:}
- SetLength(FullPath, MAX_PATH);
- if shGetPathFromIDList(FQPIDL, PChar(FullPath)) then
- SetLength(FullPath, StrLen(PChar(FullPath)));
- {Filesize, attributes and -date:}
- DosError := FindFirst(FullPath, faAnyFile, SRec);
- FindClose(Srec);
- SRec.Name := ExtractFilePath(FullPath) + SRec.Name;
- {Displayname:}
- GetShellDisplayName(iRecycleFolder, PCurrList, SHGDN_FORPARSING, DisplayName);
- FileSel := (DosError = 0);
- if FileSel and not (Bool(SRec.Attr and faDirectory)) then
- begin
- if (AttrIncludeMask <> 0) then
- FileSel := Srec.Attr and AttrIncludeMask >= AttrIncludeMask;
- if FileSel and (AttrExcludeMask <> 0) then
- FileSel := AttrExcludeMask and Srec.Attr = 0;
- FileSel :=
- FileSel and
- (FileMatches(DisplayName, MaskList) and
- (SRec.Size >= FSelFileSizeFrom) and
- ((FSelFileSizeTo = 0) or
- (SRec.Size <= FSelFileSizeTo)) and
- (LongWord(SRec.Time) >= FileTimeFrom) and
- (LongWord(SRec.Time) <= FileTimeTo));
- end;
- if Assigned(FOnAddFile) then
- FOnAddFile(Self, SRec, FileSel);
- if FileSel then
- begin
- {Filetype and icon:}
- SHGetFileInfo(PChar(FQPIDL), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_PIDL or SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
- NewItem := AddItem(Srec);
- NewItem.Caption := DisplayName;
- FileRec := NewItem.Data;
- FileRec^.Empty := False;
- FileRec^.IconEmpty := False;
- FileRec^.DisplayName := DisplayName;
- FileRec^.PIDL := FQPIDL;
- FileRec^.TypeName := FileInfo.szTypeName;
- if FileRec^.Typename = EmptyStr then
- FileRec^.TypeName := Format(STextFileExt, [FileRec.FileExt]);
- FileRec^.ImageIndex := FileInfo.iIcon;
- {$IFNDEF NO_THREADS}
- if ShowSubDirSize and FileRec^.isDirectory then
- FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
- {$ENDIF}
- end
- else FreePIDL(FQPIDL);
- FreePIDL(PCurrList);
- except
- if Assigned(PCurrList) then
- try
- FreePIDL(PCurrList);
- except
- end;
- end;
- end; {While EnumList ...}
- end;
- finally
- MaskList.Free;
- end;
- end; {LoadFromRecycleBin}
- function TDirView.GetShellFolder(Dir: string): iShellFolder;
- var
- WDir: WideString;
- Eaten: ULONG;
- Attr: ULONG;
- NewPIDL: PItemIDList;
- begin
- Result := nil;
- if not Assigned(FDesktopFolder) then
- ShGetDesktopFolder(FDesktopFolder);
- WDir := Dir;
- if Assigned(FDesktopFolder) then
- begin
- FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil, PWideChar(WDir), Eaten, NewPIDL, Attr);
- try
- assert(Assigned(NewPIDL));
- FDesktopFolder.BindToObject(NewPidl, nil, IID_IShellFolder, Pointer(Result));
- Assert(Assigned(Result));
- finally
- FreePIDL(NewPidl);
- end;
- end;
- end; {GetShellFolder}
- function TDirView.ItemIsDirectory(Item: TListItem): Boolean;
- begin
- Result :=
- (Assigned(Item) and Assigned(Item.Data) and
- PFileRec(Item.Data)^.IsDirectory);
- end;
- function TDirView.ItemIsFile(Item: TListItem): Boolean;
- begin
- Result :=
- (Assigned(Item) and Assigned(Item.Data) and
- (not PFileRec(Item.Data)^.IsParentDir));
- end;
- function TDirView.ItemIsParentDirectory(Item: TListItem): Boolean;
- begin
- Result :=
- (Assigned(Item) and Assigned(Item.Data) and
- PFileRec(Item.Data)^.IsParentDir);
- end;
- function TDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
- begin
- Result := (Assigned(Item) and Assigned(Item.Data) and
- PFileRec(Item)^.IsRecycleBin);
- end;
- function TDirView.ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean;
- var
- FileRec: PFileRec;
- Modification: TDateTime;
- begin
- Assert(Assigned(Item) and Assigned(Item.Data));
- FileRec := PFileRec(Item.Data);
- if (Filter.ModificationFrom > 0) or (Filter.ModificationTo > 0) then
- Modification := FileTimeToDateTime(FileRec^.FileTime)
- else
- Modification := 0;
- Result :=
- ((FileRec^.Attr and Filter.IncludeAttr) = Filter.IncludeAttr) and
- ((FileRec^.Attr and Filter.ExcludeAttr) = 0) and
- ((not FileRec^.IsDirectory) or Filter.Directories) and
- ((Filter.FileSizeFrom = 0) or (FileRec^.Size >= Filter.FileSizeFrom)) and
- ((Filter.FileSizeTo = 0) or (FileRec^.Size <= Filter.FileSizeTo)) and
- ((Filter.ModificationFrom = 0) or (Modification >= Filter.ModificationFrom)) and
- ((Filter.ModificationTo = 0) or (Modification <= Filter.ModificationTo)) and
- ((Length(Filter.Masks) = 0) or
- FileNameMatchesMasks(FileRec^.FileName, Filter.Masks));
- end;
- function TDirView.ItemOverlayIndexes(Item: TListItem): Word;
- begin
- Result := oiNoOverlay;
- if Assigned(Item) and Assigned(Item.Data) then
- begin
- if PFileRec(Item.Data)^.IsParentDir then
- Inc(Result, oiDirUp);
- if FDrawLinkOverlay and
- (UpperCase(ItemFileExt(Item)) = '.LNK') then
- Inc(Result, oiLink);
- end;
- end;
- procedure TDirView.Load;
- begin
- try
- {$IFNDEF NO_THREADS}
- StopSubDirScanner;
- StopIconUpdateThread;
- StopWatchThread;
- {$ENDIF}
- FChangeTimer.Enabled := False;
- FChangeTimer.Interval := 0;
- inherited;
- finally
- if DirOK and not AbortLoading then
- begin
- {$IFNDEF NO_THREADS}
- if FUseIconUpdateThread and (not IsRecycleBin) then
- StartIconUpdateThread;
- StartWatchThread;
- {$ENDIF}
- end;
- end;
- end;
- procedure TDirView.LoadFiles;
- var
- SRec: SysUtils.TSearchRec;
- DosError: Integer;
- TempMask: string;
- ActMask: string;
- ScanRun: Integer;
- FileSel: Boolean;
- FileList: TStringList;
- Dummy: Integer;
- FSize: Int64;
- {$IFNDEF NO_THREADS}
- NewItem: TListItem;
- {$ENDIF}
- AttrIncludeMask: Integer;
- AttrExcludeMask: Integer;
- FileTimeFrom: LongWord;
- FileTimeTo: LongWord;
- {$IFDEF USE_DRIVEVIEW}
- DirsCount: Integer;
- SelTreeNode: TTreeNode;
- Node: TTreeNode;
- {$ENDIF}
- procedure AddToMasks(Attr: TSelAttr; Mask: Word);
- begin
- case Attr of
- selYes: AttrIncludeMask := AttrIncludeMask or Mask;
- selNo: AttrExcludeMask := AttrExcludeMask or Mask;
- end;
- end;
- begin
- AttrIncludeMask := 0;
- AttrExcludeMask := 0;
- AddToMasks(FSelArchive, SysUtils.faArchive);
- AddToMasks(FSelHidden, SysUtils.faHidden);
- AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
- AddToMasks(FSelSysFile, SysUtils.faSysFile);
- FileTimeFrom := LongWord(fSelFileDateFrom) shl 16 or fSelFileTimeFrom;
- FileTimeTo := LongWord(fSelFileDateTo) shl 16 or fSelFileTimeTo;
- ScanRun := 0;
- try
- if Length(FPath) > 0 then
- begin
- {$IFDEF USE_DRIVEVIEW}
- if not Assigned(FDriveView) then
- {$ENDIF}
- DriveInfo.ReadDriveStatus(FPath[1], dsSize);
- FDriveType := DriveInfo[FPath[1]].DriveType;
- end
- else FDriveType := DRIVE_UNKNOWN;
- FDirOK := (Length(FPath) > 0) and
- DriveInfo[FPath[1]].DriveReady and DirExists(FPath);
- if DirOK then
- begin
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- SelTreeNode := TDriveView(FDriveView).FindNodeToPath(FPath)
- else SelTreeNode := nil;
- {$ENDIF}
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) and Assigned(SelTreeNode) then
- FIsRecycleBin := TNodeData(SelTreeNode.Data).IsRecycleBin
- else
- {$ENDIF}
- FIsRecycleBin :=
- (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLED') or
- (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLER');
- if not Assigned(FDesktopFolder) then
- shGetDesktopFolder(FDesktopFolder);
- {$IFNDEF PHYSICALRECYCLEBIN}
- if IsRecycleBin then LoadFromRecycleBin(Path)
- else
- {$ENDIF}
- begin
- FParentFolder := GetShellFolder(PathName);
- TempMask := Mask;
- FileList := TStringList.Create;
- while (Length(TempMask) > 0) and (not AbortLoading) do
- begin
- ActMask := GetNextMask(TempMask);
- Inc(ScanRun);
- //ItemsAdded := 0;
- if Assigned(FileList) and (Length(TempMask) > 0) then
- FileList.Sort;
- DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + ActMask,
- FileAttr, SRec);
- while (DosError = 0) and (not AbortLoading) do
- begin
- FileSel := True;
- FSize := SizeFromSRec(SRec);
- if AttrIncludeMask <> 0 then
- FileSel := (SRec.Attr and AttrIncludeMask) >= AttrIncludeMask;
- if FileSel and (AttrExcludeMask <> 0) then
- FileSel := ((AttrExcludeMask and Srec.Attr) = 0);
- if FileSel and
- ((SRec.Attr and faDirectory) = 0) and
- (FSize >= FSelFileSizeFrom) and
- ((FSelFileSizeTo = 0) or (FSize <= FSelFileSizeTo)) and
- (LongWord(SRec.Time) >= FileTimeFrom) and
- (LongWord(SRec.Time) <= FileTimeTo) then
- begin
- if Assigned(OnAddFile) then
- FOnAddFile(Self, SRec, FileSel);
- if FileSel then
- begin
- if (ScanRun = 1) or
- ((ScanRun > 1) and not FileList.Find(SRec.Name, Dummy)) then
- begin
- AddItem(SRec);
- if Length(TempMask) > 0 then
- FileList.Add(SRec.Name);
- end;
- end;
- end;
- DosError := FindNext(SRec);
- end;
- SysUtils.FindClose(SRec);
- end; {Length (TempMask) > 0}
- if AddParentDir and (Length(FPath) > 2) then
- AddParentDirItem;
- {Search for directories:}
- {$IFDEF USE_DRIVEVIEW}
- DirsCount := 0;
- {$ENDIF}
- if ShowDirectories then
- Begin
- DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + '*.*',
- DirAttrMask, SRec);
- while (DosError = 0) and (not AbortLoading) do
- begin
- FileSel := True;
- if AttrIncludeMask <> 0 then
- FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
- if FileSel and (AttrExcludeMask <> 0) then
- FileSel := ((AttrExcludeMask and SRec.Attr) = 0);
- if (SRec.Name <> '.') and (SRec.Name <> '..') and
- ((Srec.Attr and faDirectory) <> 0) then
- begin
- {$IFDEF USE_DRIVEVIEW}
- Inc(DirsCount);
- {$ENDIF}
- if Assigned(OnAddFile) then
- OnAddFile(Self, SRec, FileSel);
- if FileSel then
- begin
- {$IFNDEF NO_THREADS}
- NewItem :=
- {$ENDIF}
- AddItem(Srec);
- {$IFNDEF NO_THREADS}
- if ShowSubDirSize then
- FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
- {$ENDIF}
- end;
- end;
- DosError := FindNext(SRec);
- end;
- SysUtils.FindClose(SRec);
- {$IFDEF USE_DRIVEVIEW}
- {Update TDriveView's subdir indicator:}
- if Assigned(FDriveView) and (FDriveType = DRIVE_REMOTE) then
- with FDriveView as TDriveView do
- begin
- Node := FindNodeToPath(PathName);
- if Assigned(Node) and Assigned(Node.Data) and
- not TNodeData(Node.Data).Scanned then
- begin
- if DirsCount = 0 then
- begin
- Node.HasChildren := False;
- TNodeData(Node.Data).Scanned := True;
- end;
- end;
- end;
- {$ENDIF}
- end; {If FShowDirectories}
- if Assigned(FileList) then
- FileList.Free;
- end; {not isRecycleBin}
- end
- else FIsRecycleBin := False;
- finally
- //if Assigned(Animate) then Animate.Free;
- SetLength(ActMask, 0);
- FInfoCacheList.Sort(CompareInfoCacheItems);
- end; {Finally}
- end;
- procedure TDirView.Reload2;
- type
- PEFileRec = ^TEFileRec;
- TEFileRec = record
- iSize: Int64;
- iAttr: Integer;
- iFileTime: TFileTime;
- iIndex: Integer;
- end;
- var
- Index: Integer;
- EItems: TStringList;
- FItems: TStringList;
- NewItems: TStringList;
- {$IFNDEF NO_THREADS}
- NewItem: TListItem;
- {$ENDIF}
- Srec: SysUtils.TSearchRec;
- DosError: Integer;
- PSrec: ^SysUtils.TSearchRec;
- Dummy: Integer;
- ItemIndex: Integer;
- PUpdate: Boolean;
- PEFile: PEFileRec;
- SaveCursor: TCursor;
- TempMask: string;
- ActMask: string;
- FileTimeFrom: LongWord;
- FileTimeTo: LongWord;
- AttrIncludeMask: Integer;
- AttrExcludeMask: Integer;
- FileSel: Boolean;
- FSize: Int64;
- procedure AddToMasks(Attr: TSelAttr; Mask: Word);
- begin
- case Attr of
- selYes: AttrIncludeMask := AttrIncludeMask or Mask;
- selNo: AttrExcludeMask := AttrExcludeMask or Mask;
- end;
- end;
- begin
- if not Loading then
- begin
- IF IsRecycleBin then Reload(True)
- else
- begin
- if not DirExists(Path) then
- begin
- ClearItems;
- FDirOK := False;
- end
- else
- begin
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- FChangeTimer.Enabled := False;
- FChangeTimer.Interval := 0;
- EItems := TStringlist.Create;
- FItems := TStringlist.Create;
- NewItems := TStringlist.Create;
- PUpdate := False;
- TempMask := Mask;
- AttrIncludeMask := 0;
- AttrExcludeMask := 0;
- AddToMasks(FSelArchive, SysUtils.faArchive);
- AddToMasks(FSelHidden, SysUtils.faHidden);
- AddToMasks(FSelReadOnly, SysUtils.faReadOnly);
- AddToMasks(FSelSysFile, SysUtils.faSysFile);
- FileTimeFrom := LongWord(fSelFileDateFrom) shl 16 or fSelFileTimeFrom;
- FileTimeTo := LongWord(fSelFileDateTo) shl 16 or fSelFileTimeTo;
- try
- {Store existing files and directories:}
- for Index := 0 to Items.Count - 1 do
- begin
- New(PEFile);
- with PFileRec(Items[Index].Data)^ do
- begin
- PEFile^.iSize := Size;
- PEFile^.iAttr := Attr;
- PEFile^.iFileTime := FileTime;
- PEFile^.iIndex := Index;
- end;
- EItems.AddObject(PFileRec(Items[Index].Data)^.FileName, Pointer(PEFile));
- end;
- EItems.Sort;
- {Search new or changed files:}
- while Length(TempMask) > 0 do
- begin
- ActMask := GetNextMask(TempMask);
- if Length(TempMask) > 0 then FItems.Sort;
- DosError := SysUtils.FindFirst(IncludeTrailingPathDelimiter(FPath) + ActMask,
- FileAttr, SRec);
- while DosError = 0 do
- begin
- FileSel := True;
- if (AttrIncludeMask <> 0) then
- FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
- if FileSel and (AttrExcludeMask <> 0) then
- FileSel := ((AttrExcludeMask and Srec.Attr) = 0);
- if FileSel and
- ((SRec.Attr and faDirectory) = 0) and
- (SRec.Size >= FSelFileSizeFrom) and
- ((FSelFileSizeTo = 0) or (SRec.Size <= FSelFileSizeTo)) and
- (LongWord(SRec.Time) >= FileTimeFrom) and
- (LongWord(SRec.Time) <= FileTimeTo) then
- begin
- ItemIndex := -1;
- if not EItems.Find(SRec.Name, ItemIndex) then
- begin
- if Assigned(OnAddFile) then
- FOnAddFile(Self, Srec, FileSel);
- if FileSel then
- begin
- New(PSrec);
- PSRec^ := SRec;
- NewItems.AddObject(SRec.Name, Pointer(PSrec));
- end;
- end
- else
- begin
- FSize := SizeFromSRec(SRec);
- with PEFileRec(EItems.Objects[ItemIndex])^ do
- {$WARNINGS OFF}
- if (iSize <> FSize) or (iAttr <> SRec.Attr) or
- not CompareMem(@iFileTime, @SRec.FindData.ftLastWriteTime,
- SizeOf(iFileTime)) Then
- {$WARNINGS ON}
- begin
- with PFileRec(Items[iIndex].Data)^ do
- begin
- Dec(FFilesSize, Size);
- Inc(FFilesSize, FSize);
- if Items[iIndex].Selected then
- begin
- Dec(FFilesSelSize, Size);
- Inc(FFilesSelSize, FSize);
- end;
- Size := FSize;
- Attr := SRec.Attr;
- {$WARNINGS OFF}
- FileTime := SRec.FindData.ftLastWriteTime;
- {$WARNINGS ON}
- if (iSize <> FSize) and Assigned(OnFileSizeChanged) then
- OnFileSizeChanged(Self, Items[iIndex]);
- end;
- if not PUpdate then
- begin
- PUpdate := True;
- Items.BeginUpdate;
- end;
- end;
- end;
- end;
- FItems.Add(Srec.Name);
- DosError := FindNext(Srec);
- end;
- SysUtils.FindClose(Srec);
- end;
- {Search new directories:}
- if ShowDirectories then
- begin
- DosError := SysUtils.FindFirst(FPath + '\*.*', DirAttrMask, SRec);
- while DosError = 0 do
- begin
- FileSel := True;
- if AttrIncludeMask <> 0 then
- FileSel := ((SRec.Attr and AttrIncludeMask) = AttrIncludeMask);
- if FileSel and (AttrExcludeMask <> 0) then
- FileSel := ((AttrExcludeMask and SRec.Attr) = 0);
- if (SRec.Name <> '.') and (SRec.Name <> '..') and
- ((Srec.Attr and faDirectory) <> 0) then
- begin
- if not EItems.Find(SRec.Name, ItemIndex) then
- begin
- if Assigned(FOnAddFile) then
- FOnAddFile(Self, SRec, FileSel);
- if FileSel then
- begin
- New(PSrec);
- PSrec^ := SRec;
- NewItems.AddObject(Srec.Name, Pointer(PSrec));
- end;
- end;
- end;
- FItems.Add(SRec.Name);
- DosError := FindNext(SRec);
- end;
- SysUtils.FindClose(SRec);
- End; {If FShowDirectories}
- {Check wether displayed Items still exists:}
- FItems.Sort;
- for Index := Items.Count - 1 downto 0 do
- Begin
- if not FItems.Find(PFileRec(Items[Index].Data)^.FileName, Dummy) then
- begin
- if not PUpdate then
- begin
- PUpdate := True;
- Items.BeginUpdate;
- end;
- Items[Index].Delete;
- end;
- end;
- finally
- try
- for Index := 0 to EItems.Count - 1 do
- Dispose(PEFileRec(EItems.Objects[Index]));
- EItems.Free;
- FItems.Free;
- for Index := 0 to NewItems.Count - 1 do
- begin
- if not PUpdate then
- begin
- PUpdate := True;
- Items.BeginUpdate;
- end;
- PSrec := Pointer(NewItems.Objects[Index]);
- {$IFNDEF NO_THREADS}
- NewItem :=
- {$ENDIF}
- AddItem(PSrec^);
- {$IFNDEF NO_THREADS}
- if ShowSubDirSize and ((PSrec^.Attr and faDirectory) <> 0) then
- FSubDirScanner.Add(TSubDirScanner.Create(Self, NewItem));
- {$ENDIF}
- Dispose(PSrec);
- end;
- NewItems.Free;
- if PUpdate then
- begin
- if SortAfterUpdate then
- SortItems;
- Items.EndUpdate;
- end;
- finally
- FDirOK := True;
- {$IFNDEF NO_THREADS}
- IF fUseIconUpdateThread And (not FisRecycleBin) Then
- StartIconUpdateThread;
- StartWatchThread;
- {$ENDIF}
- IF Assigned(ItemFocused) Then
- ItemFocused.MakeVisible(False);
- IF PUpdate And Assigned(OnDirUpdated) Then
- OnDirUpdated(Self);
- Screen.Cursor := SaveCursor;
- End;
- End; {Finally}
- End;
- end;
- end;
- end; {Reload2}
- procedure TDirView.PerformItemDragDropOperation(Item: TListItem; Effect: Integer);
- begin
- if Assigned(Item) then
- begin
- if Assigned(Item.Data) then
- begin
- if ItemIsParentDirectory(Item) then
- PerformDragDropFileOperation(ExcludeTrailingPathDelimiter(ExtractFilePath(Path)),
- Effect, False)
- else
- PerformDragDropFileOperation(IncludeTrailingPathDelimiter(PathName) +
- ItemFileName(Item), Effect, False);
- end;
- end
- else
- PerformDragDropFileOperation(PathName, Effect,
- DDOwnerIsSource and (Effect = DropEffect_Copy));
- end;
- procedure TDirView.ReLoad(CacheIcons: Boolean);
- begin
- if not FLoadEnabled then FDirty := True
- else inherited;
- end; {ReLoad}
- procedure TDirView.ClearIconCache;
- begin
- if Assigned(FInfoCacheList) then
- FInfoCacheList.Clear;
- end; {ClearIconCache}
- function TDirView.FormatFileTime(FileTime: TFileTime): string;
- begin
- Result := FormatDateTime(DateTimeFormatStr,
- FileTimeToDateTime(FileTime));
- end; {FormatFileTime}
- function TDirView.GetAttrString(Attr: Integer): string;
- const
- Attrs: array[1..5] of Integer =
- (FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_ARCHIVE,
- FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_HIDDEN,
- FILE_ATTRIBUTE_READONLY);
- AttrChars: array[1..5] of Char = ('c', 'a', 's', 'h', 'r');
- var
- Index: Integer;
- LowBound: Integer;
- begin
- Result := '';
- if Attr <> 0 then
- begin
- LowBound := Low(Attrs);
- if Win32PlatForm <> VER_PLATFORM_WIN32_NT then
- Inc(LowBound);
- for Index := LowBound to High(Attrs) do
- if (Attr and Attrs[Index] <> 0) then
- Result := Result + AttrChars[Index]
- else
- Result := Result + FAttrSpace;
- end;
- end; {GetAttrString}
- procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
- var
- FileInfo: TShFileInfo;
- Index: Integer;
- PExtItem: PInfoCache;
- CacheItem: TInfoCache;
- IsSpecialExt: Boolean;
- WStr: WideString;
- Eaten: ULONG;
- shAttr: ULONG;
- begin
- Assert(Assigned(Item) and Assigned(Item.Data));
- with PFileRec(Item.Data)^ do
- begin
- IsSpecialExt := MatchesFileExt(FileExt, SpecialExtensions);
- if FUseIconCache and not IsSpecialExt and not IsDirectory then
- begin
- CacheItem.FileExt := FileExt;
- Index := FInfoCacheList.FindSequential(Addr(CacheItem), CompareInfoCacheItems);
- if Index >= 0 then
- begin
- TypeName := PInfoCache(FInfoCacheList[Index])^.TypeName;
- ImageIndex := PInfoCache(FInfoCacheList[Index])^.ImageIndex;
- Empty := False;
- IconEmpty := False;
- end;
- end;
- FetchIcon := IconEmpty and (FetchIcon or not IsSpecialExt);
- if Empty or FetchIcon then
- begin
- if FetchIcon then
- begin
- {Fetch the Item FQ-PIDL:}
- if not Assigned(PIDL) and IsSpecialExt then
- begin
- try
- WStr := FPath + '\' + FileName;
- FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil,
- PWideChar(WStr), Eaten, PIDL, ShAttr);
- {Retrieve the shell display attributes for directories:}
- if IsDirectory and Assigned(PIDL) then
- begin
- shAttr := SFGAO_DISPLAYATTRMASK;
- try
- if Assigned(ParentFolder) and
- Succeeded(ParentFolder.GetAttributesOf(1, PIDL, shAttr)) then
- begin
- if (shAttr and SFGAO_SHARE) <> 0 then
- Item.OverlayIndex := 0;
- end;
- except end;
- end;
- except end;
- end;
- if IsDirectory then
- begin
- if FDriveType = DRIVE_FIXED then
- begin
- try
- {Retrieve icon and typename for the directory}
- if Assigned(PIDL) then
- SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_PIDL)
- else
- SHGetFileInfo(PChar(FPath + '\' + FileName), 0, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
- if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
- {Invalid icon returned: retry with access file attribute flag:}
- SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY,
- FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
- TypeName := FileInfo.szTypeName;
- if FetchIcon then
- begin
- ImageIndex := FileInfo.iIcon;
- IconEmpty := False;
- end;
- {Capture exceptions generated by the shell}
- except
- ImageIndex := StdDirIcon;
- IconEmpty := False;
- end; {Except}
- end
- else
- begin
- TypeName := StdDirTypeName;
- ImageIndex := StdDirIcon;
- IconEmpty := False;
- end;
- end
- else
- begin
- {Retrieve icon and typename for the file}
- try
- if Assigned(PIDL) then
- SHGetFileInfo(PChar(PIDL), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL)
- else
- SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
- TypeName := FileInfo.szTypeName;
- ImageIndex := FileInfo.iIcon;
- IconEmpty := False;
- {Capture exceptions generated by the shell}
- except
- ImageIndex := UnKnownFileIcon;
- IconEmpty := False;
- end; {Except}
- end;
- if (Length(TypeName) > 0) then
- begin
- {Fill FileInfoCache:}
- if FUseIconCache and not IsSpecialExt and not IconEmpty and not IsDirectory then
- begin
- GetMem(PExtItem, SizeOf(TInfoCache));
- PExtItem.FileExt := FileExt;
- PExtItem.TypeName := TypeName;
- PExtItem.ImageIndex := ImageIndex;
- FInfoCacheList.Add(PExtItem);
- end;
- end
- else TypeName := Format(STextFileExt, [FileExt]);
- end {If FetchIcon}
- else
- begin
- try
- if IsDirectory then
- shGetFileInfo(PChar(fPath), FILE_ATTRIBUTE_DIRECTORY, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES)
- else
- shGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
- SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
- TypeName := FileInfo.szTypeName;
- except
- {Capture exceptions generated by the shell}
- TypeName := '';
- end;
- if IconEmpty then
- begin
- if FileExt = ExeExtension then ImageIndex := DefaultExeIcon
- else ImageIndex := UnKnownFileIcon;
- end;
- end;
- Empty := False;
- end;
- end;
- end; {GetDisplayData}
- function TDirView.GetDirOK: Boolean;
- begin
- Result := FDirOK;
- end;
- function TDirView.ItemFullFileName(Item: TListItem): string;
- begin
- if Assigned(Item) and Assigned(Item.Data) then
- begin
- if not IsRecycleBin then
- begin
- if PFileRec(Item.Data)^.IsParentDir then
- Result := ExcludeTrailingBackslash(ExtractFilePath(FPath))
- else
- Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
- end
- else
- Result := PFileRec(Item.Data)^.FileName;
- end
- else
- Result := EmptyStr;
- end; {ItemFullFileName}
- function TDirView.ItemFileNameOnly(Item: TListItem): string;
- begin
- Assert(Assigned(Item) and Assigned(Item.Data));
- Result := PFileRec(Item.Data)^.FileName;
- SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
- end; {ItemFileNameOnly}
- function TDirView.ItemFileExt(Item: TListItem): string;
- begin
- Assert(Assigned(Item) and Assigned(Item.Data));
- Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
- end; {ItemFileExt}
- procedure TDirView.SetMask(Value: string);
- var
- LastMask: string;
- begin
- LastMask := Mask;
- inherited SetMask(Value);
- if LastMask <> Mask then Reload(True);
- end; {SetMask}
- function TDirView.DeleteSelectedFiles(AllowUndo: Boolean): Boolean;
- const
- MaxSel = 10;
- var
- StartIndex: Integer;
- ItemIndex: Integer;
- Index: Integer;
- FileOperator: TFileOperator;
- UpdateEnabled: Boolean;
- WatchDir: Boolean;
- Updating: Boolean;
- {$IFDEF USE_DRIVEVIEW}
- DirDeleted: Boolean;
- {$ENDIF}
- begin
- AllowUndo := AllowUndo and (not IsRecycleBin);
- {$IFDEF USE_DRIVEVIEW}
- DirDeleted := False;
- {$IFNDEF NO_THREADS}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).StopWatchThread;
- {$ENDIF}
- {$ENDIF}
- WatchDir := WatchForChanges;
- WatchForChanges := False;
- UpdateEnabled := (SelCount < MaxSel);
- if not UpdateEnabled then Items.BeginUpdate;
- FileOperator := TFileOperator.Create(Self);
- try
- ItemIndex := Selected.Index;
- FileOperator.Operation := foDelete;
- FileOperator.Flags := [foNoConfirmMkDir];
- FileOperator.ProgressTitle := coFileOperatorTitle;
- CreateFileList(False, True, FileOperator.OperandFrom);
- if not ConfirmDelete then
- FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
- if AllowUndo then
- FileOperator.Flags := FileOperator.Flags + [foAllowUndo];
- {$IFNDEF NO_THREADS}
- StopIconUpdateThread;
- StopSubDirScanner;
- {$ENDIF}
- Result := FileOperator.Execute;
- Result := Result and (not FileOperator.OperationAborted);
- Sleep(0);
- Updating := False;
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
- while Index >= 0 do
- begin
- case PFileRec(Items[Index].Data)^.IsDirectory of
- True:
- if not DirExists(ItemFullFileName(Items[Index])) then
- begin
- {$IFDEF USE_DRIVEVIEW}
- DirDeleted := True;
- {$ENDIF}
- Items[Index].Delete;
- Dec(Index);
- end;
- False:
- if not CheckFileExists(ItemFullFileName(Items[Index])) then
- begin
- if (SelCount > 3) and (not Updating) then
- begin
- Items.BeginUpdate;
- Updating := True;
- end;
- Items[Index].Delete;
- Dec(Index);
- end;
- end;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
- end;
- if Updating then
- Items.EndUpdate;
- finally
- if not UpdateEnabled then
- Items.EndUpdate;
- FileOperator.Free;
- if Assigned(OnDirUpdated) then
- OnDirUpdated(Self);
- end;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(DriveView) then
- with TDriveView(DriveView) do
- begin
- if DirDeleted and Assigned(Selected) then
- ValidateDirectory(Selected);
- {$IFNDEF NO_THREADS}
- TDriveView(fDriveView).StartWatchThread;
- {$ENDIF}
- end;
- {$ENDIF}
- {$IFNDEF NO_THREADS}
- if UseIconUpdateThread then StartIconUpdateThread;
- if ShowSubDirSize then StartSubDirScanner;
- {$ENDIF}
- WatchForChanges := WatchDir;
- if (not Assigned(Selected)) and (Items.Count > 0) then
- Selected := Items[Min(ItemIndex, Pred(Items.Count))];
- end; {DeleteSelectedFiles}
- Function CompareFileName (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
- Var P1, P2 : PFileRec;
- Begin
- If I1 = I2 then Result := fEqual else
- If I1 = NIL then Result := fLess else
- If I2 = NIL then Result := fGreater else
- Begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- IF P1.isParentDir Then
- Begin
- Result := fLess;
- Exit;
- End
- Else IF P2.isParentDir Then
- Begin
- Result := fGreater;
- Exit;
- End;
- {Directories allways should appear "grouped":}
- IF P1.isDirectory <> P2.isDirectory Then
- Begin
- IF P1.isDirectory Then
- Begin
- Result := fLess;
- IF AOwner.DirsOnTop Then
- Exit;
- End
- Else
- Begin
- Result := fGreater;
- IF AOwner.DirsOnTop Then
- Exit;
- End;
- End
- Else
- Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
- End;
- IF Not AOwner.SortAscending Then
- Result := -Result;
- End; {CompareFileName}
- function CompareFileSize(I1, I2: TListItem; AOwner : TDirView): Integer; stdcall;
- var
- P1, P2: PFileRec;
- begin
- if I1 = I2 then Result := fEqual
- else
- if I1 = nil then Result := fLess
- else
- if I2 = nil then Result := fGreater
- else
- begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- if P1.isParentDir then
- begin
- Result := fLess;
- Exit;
- end
- else
- if P2.isParentDir then
- begin
- Result := fGreater;
- Exit;
- end;
- {Directories always should appear "grouped":}
- if P1.isDirectory <> P2.isDirectory then
- begin
- if P1.isDirectory then
- begin
- Result := fLess;
- if AOwner.DirsOnTop then Exit;
- end
- else
- begin
- Result := fGreater;
- if AOwner.DirsOnTop then Exit;
- end;
- end
- else
- begin
- if P1.Size < P2.Size then Result := fLess
- else
- if P1.Size > P2.Size then Result := fGreater
- else
- Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
- end;
- end;
- if not AOwner.SortAscending then
- Result := -Result;
- end; {CompareFileSize}
- Function CompareFileType (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
- Var P1, P2 : PFileRec;
- Begin
- If I1 = I2 then Result := fEqual else
- If I1 = NIL then Result := fLess else
- If I2 = NIL then Result := fGreater else
- begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- IF P1.isParentDir Then
- Begin
- Result := fLess;
- Exit;
- End
- Else IF P2.isParentDir Then
- Begin
- Result := fGreater;
- Exit;
- End;
- {Directories allways should appear "grouped":}
- IF P1.isDirectory <> P2.isDirectory Then
- Begin
- IF P1.isDirectory Then
- Begin
- Result := fLess;
- IF AOwner.DirsOnTop Then
- Exit;
- End
- Else
- Begin
- Result := fGreater;
- IF AOwner.DirsOnTop Then
- Exit;
- End;
- End
- Else
- Begin
- IF P1.Empty Then TDirView(I1.ListView).GetDisplayData(I1, False);
- IF P2.Empty Then TDirView(I2.ListView).GetDisplayData(I2, False);
- Result := lstrcmpi(PChar(P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName),
- PChar(P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName));
- End;
- End;
- IF Not AOwner.SortAscending Then
- Result := -Result;
- End; {CompareFileType}
- Function CompareFileExt (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
- Var P1, P2 : PFileRec;
- Begin
- If I1 = I2 then Result := fEqual else
- If I1 = NIL then Result := fLess else
- If I2 = NIL then Result := fGreater else
- begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- IF P1.isParentDir Then
- Begin
- Result := fLess;
- Exit;
- End
- Else IF P2.isParentDir Then
- Begin
- Result := fGreater;
- Exit;
- End;
- {Directories allways should appear "grouped":}
- IF P1.isDirectory <> P2.isDirectory Then
- Begin
- IF P1.isDirectory Then
- Begin
- Result := fLess;
- IF AOwner.DirsOnTop Then
- Exit;
- End
- Else
- Begin
- Result := fGreater;
- IF AOwner.DirsOnTop Then
- Exit;
- End;
- End
- Else
- Result := lstrcmpi(PChar(P1.FileExt + ' ' + P1.DisplayName),
- PChar(P2.FileExt + ' ' + P2.DisplayName));
- End;
- IF Not AOwner.SortAscending Then
- Result := -Result;
- End; {CompareFileExt}
- Function CompareFileAttr (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
- Var P1, P2 : PFileRec;
- Begin
- if I1 = I2 then Result := 0 else
- if I1 = NIL then Result := -1 else
- if I2 = NIL then Result := 1 else
- begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- IF P1.isParentDir Then
- Begin
- Result := fLess;
- Exit;
- End
- Else IF P2.isParentDir Then
- Begin
- Result := fGreater;
- Exit;
- End;
- {Directories allways should appear "grouped":}
- IF P1.isDirectory <> P2.isDirectory Then
- Begin
- IF P1.isDirectory Then
- Begin
- Result := fLess;
- IF AOwner.DirsOnTop Then
- Exit;
- End
- Else
- Begin
- Result := fGreater;
- IF AOwner.DirsOnTop Then
- Exit;
- End;
- End
- Else
- Begin
- IF P1.Attr < P2.Attr Then Result := fLess Else
- IF P1.Attr > P2.Attr Then Result := fGreater Else
- Result := lstrcmpi(PChar(P1.DisplayName), PChar(P2.DisplayName));
- End;
- End;
- IF Not AOwner.SortAscending Then
- Result := -Result;
- End; {CompareFileAttr}
- Function CompareFileTime (I1, I2: TListItem; AOwner : TDirView): Integer; StdCall;
- Var Time1, Time2 : Int64;
- P1, P2 : PFileRec;
- Begin
- If I1 = I2 then Result := fEqual else
- If I1 = NIL then Result := fLess else
- If I2 = NIL then Result := fGreater else
- begin
- P1 := PFileRec(I1.Data);
- P2 := PFileRec(I2.Data);
- IF P1.isParentDir Then
- Begin
- Result := fLess;
- Exit;
- End
- Else IF P2.isParentDir Then
- Begin
- Result := fGreater;
- Exit;
- End;
- {Directories allways should appear "grouped":}
- IF P1.isDirectory <> P2.isDirectory Then
- Begin
- IF P1.isDirectory Then
- Begin
- Result := fLess;
- IF AOwner.DirsOnTop Then
- Exit;
- End
- Else
- Begin
- Result := fGreater;
- IF AOwner.DirsOnTop Then
- Exit;
- End;
- End
- Else
- Begin
- Time1 := Int64(P1.FileTime.dwHighDateTime) Shl 32 + P1.FileTime.dwLowDateTime;
- Time2 := Int64(P2.FileTime.dwHighDateTime) Shl 32 + P2.FileTime.dwLowDateTime;
- IF Time1 < Time2 Then Result := fLess Else
- IF Time1 > Time2 Then Result := fGreater Else
- Result := CompareFileName(I1, I2, AOwner);
- End;
- End;
- IF Not AOwner.SortAscending Then
- Result := -Result;
- End; {CompareFileTime}
- procedure TDirView.SortItems;
- var
- SortProc: TLVCompare;
- begin
- if HandleAllocated then
- begin
- {$IFNDEF NO_THREADS}
- StopIconUpdateThread;
- {$ENDIF}
- try
- case DirColProperties.SortDirColumn of
- dvName: SortProc := @CompareFilename;
- dvSize: SortProc := @CompareFileSize;
- dvType: if not SortByExtension then SortProc := @CompareFileType
- else SortProc := @CompareFileExt;
- dvChanged: SortProc := @CompareFileTime;
- dvAttr: SortProc := @CompareFileAttr;
- dvExt: { !!!!!} SortProc := @CompareFileExt;
- else SortProc := @CompareFilename;
- end;
- CustomSortItems(Pointer(@SortProc));
- finally
- {$IFNDEF NO_THREADS}
- if (not Loading) and FUseIconUpdateThread then
- StartIconUpdateThread;
- {$ENDIF}
- end;
- end
- end;
- procedure TDirView.ValidateFile(Item : TListItem);
- var
- Index: Integer;
- begin
- if Assigned(Item) and Assigned(Item.Data) then
- begin
- Index := Item.Index;
- if not FileExists(ItemFullFileName(Items[Index])) then
- begin
- Item.Delete;
- if Assigned(OnDirUpdated) then
- OnDirUpdated(Self);
- end;
- end;
- end; {ValidateFile}
- procedure TDirView.ValidateFile(FileName: TFileName);
- var
- FilePath: string;
- begin
- FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
- if IsRecycleBin then ValidateFile(FindFileItem(FileName))
- else
- if FilePath = Path then
- ValidateFile(FindFileItem(ExtractFileName(FileName)));
- end; {ValidateFile}
- Procedure TDirView.ValidateSelectedFiles;
- Var i : Integer;
- StartIndex : Integer;
- Upd : Boolean;
- LastCount : Integer;
- Begin
- IF SelCount > 50 Then
- Begin
- Reload2;
- Exit;
- End;
- Upd := False;
- LastCount := Items.Count;
- Try
- i := ListView_GetNextItem(Handle, -1, LVNI_ALL Or LVNI_SELECTED);
- While i >= 0 Do
- Begin
- Case PFileRec(Items[i].Data)^.isDirectory Of
- True: Begin
- If Not DirExists(ItemFullFileName(Items[i])) Then
- Begin
- Items[i].Delete;
- Dec(i);
- End;
- End;
- False: IF Not FileExists(ItemFullFileName(Items[i])) Then
- Begin
- IF (SelCount > 10) And Not Upd Then
- Begin
- Items.BeginUpdate;
- Upd := True;
- End;
- Items[i].Delete;
- Dec(i);
- End;
- End;
- StartIndex := i;
- i := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_SELECTED);
- End;
- Finally
- IF Upd Then
- Items.EndUpdate;
- IF (LastCount <> Items.Count) And Assigned(OnDirUpdated) Then
- OnDirUpdated(Self);
- End;
- End; {ValidateSelectedFiles}
- function TDirView.CreateFile(NewName: string): TListItem;
- var
- F: file;
- SRec: SysUtils.TSearchRec;
- begin
- Result := nil;
- {Neue Datei anlegen:}
- NewName := Path + '\' + NewName;
- {Ermitteln des neuen Dateinamens:}
- if not FileExists(NewName) then
- begin
- {$IFNDEF NO_THREADS}
- if FWatchForChanges then
- StopWatchThread;
- StopIconUpdateThread;
- {$ENDIF}
- try
- {Create the desired file as empty file:}
- AssignFile(F, NewName);
- Rewrite(F);
- LastIOResult := IOResult;
- if LastIOResult = 0 then
- begin
- CloseFile(F);
- {Anlegen der Datei als TListItem:}
- if FindFirst(NewName, faAnyFile, SRec) = 0 then
- begin
- Result := AddItem(SRec);
- ItemFocused := FindFileItem(GetFileRec(Result.Index)^.FileName);
- if Assigned(ItemFocused) then
- ItemFocused.MakeVisible(False);
- if Assigned(OnDirUpdated) then
- OnDirUpdated(Self);
- end;
- FindClose(Srec);
- end;
- finally
- {$IFNDEF NO_THREADS}
- if FUseIconUpdateThread then
- StartIconUpdateThread;
- if WatchForChanges then
- StartWatchThread;
- {$ENDIF}
- end;
- end
- else LastIOResult := 183;
- end; {CreateFile}
- procedure TDirView.CreateDirectory(DirName: string);
- var
- SRec: SysUtils.TSearchRec;
- Item: TListItem;
- begin
- DirName := Path + '\' + DirName;
- {Ermitteln des neuen Dateinamens:}
- if FileOrDirExists(DirName) then LastIOResult := 183
- else
- begin
- {$IFNDEF NO_THREADS}
- if WatchForChanges then StopWatchThread;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).StopWatchThread;
- {$ENDIF}
- StopIconUpdateThread;
- {$ENDIF}
- try
- {create the phyical directory:}
- if Windows.CreateDirectory(PChar(DirName), nil) then LastIOResult := 0 // MP
- else LastIOResult := GetLastError;
- if LastIOResult = 0 then
- begin
- {Create the TListItem:}
- if FindFirst(DirName, faAnyFile, SRec) = 0 then
- begin
- Item := AddItem(SRec);
- ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
- SortItems;
- if Assigned(ItemFocused) then
- ItemFocused.MakeVisible(False);
- if Assigned(OnDirUpdated) then
- OnDirUpdated(Self);
- end;
- FindClose(SRec);
- end;
- finally
- {$IFNDEF NO_THREADS}
- if FUseIconUpdateThread then
- StartIconUpdateThread;
- if WatchForChanges then StartWatchThread;
- {$ENDIF}
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- with FDriveView as TDriveView do
- if not WatchThreadActive and Assigned(Selected) then
- ValidateDirectory(Selected);
- {$ENDIF}
- end;
- end;
- end; {CreateDirectory}
- procedure TDirView.DisplayContextMenu(Where: TPoint);
- var
- FileList : TStringList;
- Index: Integer;
- DefDir: string;
- Verb: string;
- PIDLArray: PPIDLArray;
- Count: Integer;
- DiffSelectedPath: Boolean;
- WithEdit: Boolean;
- StartIndex: Integer;
- PIDLRel: PItemIDList;
- PIDLPath: PItemIDList;
- Handled: Boolean;
- begin
- GetDir(0, DefDir);
- ChDir(PathName);
- Verb := EmptyStr;
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$ENDIF}
- try
- if Assigned(OnContextPopup) then
- begin
- Handled := False;
- OnContextPopup(Self, ScreenToClient(Where), Handled);
- if Handled then Abort;
- end;
- if (MarkedCount > 1) and
- ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
- begin
- if FIsRecycleBin then
- begin
- Count := 0;
- GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
- try
- FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
- for Index := Selected.Index to Items.Count - 1 do
- if Items[Index].Selected then
- begin
- PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
- FreePIDL(PIDLPath);
- PIDLArray^[Count] := PIDLRel;
- Inc(Count);
- end;
- try
- ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
- PidlArray^[0], False, Verb, False);
- finally
- for Index := 0 to Count - 1 do
- FreePIDL(PIDLArray[Index]);
- end;
- finally
- FreeMem(PIDLArray, Count);
- end;
- end
- else
- begin
- FileList := TStringList.Create;
- CreateFileList(False, True, FileList);
- for Index := 0 to FileList.Count - 1 do
- FileList[Index] := ExtractFileName(FileList[Index]);
- ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
- FileList, Verb, False);
- FileList.Destroy;
- end;
- {------------ Cut -----------}
- if Verb = shcCut then
- begin
- LastClipBoardOperation := cboCut;
- {Clear items previous marked as cut:}
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
- while Index >= 0 do
- begin
- Items[Index].Cut := False;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_CUT);
- end;
- {Set property cut to TRUE for all selected items:}
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
- while Index >= 0 do
- begin
- Items[Index].Cut := True;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_SELECTED);
- end;
- end
- else
- {----------- Copy -----------}
- if Verb = shcCopy then LastClipBoardOperation := cboCopy
- else
- {----------- Paste ----------}
- if Verb = shcPaste then
- PasteFromClipBoard(ItemFullFileName(Selected))
- else
- if not FIsRecycleBin then Reload2;
- end
- else
- if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
- begin
- Verb := EmptyStr;
- WithEdit := not FisRecycleBin and CanEdit(ItemFocused);
- LoadEnabled := True;
- if FIsRecycleBin then
- begin
- PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
- ShellDisplayContextMenu(ParentForm.Handle, Where,
- iRecycleFolder, 1, PIDLRel, False, Verb, False);
- FreePIDL(PIDLRel);
- FreePIDL(PIDLPath);
- end
- else
- begin
- ShellDisplayContextMenu(ParentForm.Handle, Where,
- ItemFullFileName(ItemFocused), WithEdit, Verb,
- not PFileRec(ItemFocused.Data)^.isDirectory);
- LoadEnabled := True;
- end; {not FisRecycleBin}
- {---------- Rename ----------}
- if Verb = shcRename then ItemFocused.EditCaption
- else
- {------------ Cut -----------}
- if Verb = shcCut then
- begin
- LastClipBoardOperation := cboCut;
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
- while Index >= 0 do
- begin
- Items[Index].Cut := False;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_CUT);
- end;
- ItemFocused.Cut := True;
- end
- else
- {----------- Copy -----------}
- if Verb = shcCopy then LastClipBoardOperation := cboCopy
- else
- {----------- Paste ----------}
- if Verb = shcPaste then
- begin
- if PFileRec(ItemFocused.Data)^.IsDirectory then
- PasteFromClipBoard(ItemFullFileName(ItemFocused));
- end
- else
- if not FIsRecycleBin then Reload2;
- end;
- ChDir(DefDir);
- if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
- begin
- DiffSelectedPath := False;
- for Index := Selected.Index to Items.Count - 1 do
- if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
- begin
- DiffSelectedPath := True;
- Break;
- end;
- if DiffSelectedPath then
- begin
- {$IFNDEF NO_THREADS}
- StartFileDeleteThread;
- {$ENDIF}
- Exit;
- end;
- end;
- if Win32PlatForm = VER_PLATFORM_WIN32_NT then Sleep(250);
- ValidateSelectedFiles;
- finally
- {$IFNDEF NO_THREADS}
- StartWatchThread;
- {$ENDIF}
- end;
- end;
- procedure TDirView.GetDisplayInfo(ListItem: TListItem;
- var DispInfo: TLVItem);
- begin
- Assert(Assigned(ListItem) and Assigned(ListItem.Data));
- with PFileRec(ListItem.Data)^, DispInfo do
- begin
- {Fetch display data of current file:}
- if Empty then
- GetDisplayData(ListItem, IconEmpty and
- (not FUseIconUpdateThread or
- ((ViewStyle <> vsReport) and (Win32PlatForm = VER_PLATFORM_WIN32_NT))));
- if IconEmpty and
- (not FUseIconUpdateThread or
- ((ViewStyle <> vsReport) and (Win32PlatForm = VER_PLATFORM_WIN32_NT))) and
- ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
- GetDisplayData(ListItem, True);
- {Set IconUpdatethread :}
- {$IFNDEF NO_THREADS}
- if IconEmpty and Assigned(FIconUpdateThread) then
- begin
- if Assigned(TopItem) then
- {Viewstyle is vsReport or vsList:}
- FIconUpdateThread.Index := Self.TopItem.Index
- else
- {Viewstyle is vsIcon or vsSmallIcon:}
- FIconUpdateThread.MaxIndex := ListItem.Index;
- if FIconUpdateThread.Suspended and not FIsRecycleBin then
- FIconUpdateThread.Resume;
- end;
- {$ENDIF}
- if (DispInfo.Mask and LVIF_TEXT) <> 0 then
- begin
- if iSubItem = 0 then StrPLCopy(pszText, DisplayName, cchTextMax)
- else
- if iSubItem < DirViewColumns then
- begin
- case TDirViewCol(iSubItem) of
- dvSize: {Size: }
- if not IsDirectory or
- (IsDirectory and ShowSubDirSize and (Size >= 0)) then
- StrPLCopy(pszText, FormatSize(Size), cchTextMax);
- dvType: {FileType: }
- if SortByExtension and (not IsDirectory) then
- begin
- case FFileNameDisplay of
- fndNoCap, fndNice: StrPLCopy(pszText, LowerCase(FileExt), cchTextMax);
- else StrPLCopy(pszText, FileExt, cchTextMax);
- end; {Case}
- end
- else StrPLCopy(pszText, TypeName, cchTextMax);
- dvChanged: {Date}
- StrPLCopy(pszText, FormatFileTime(FileTime), cchTextMax);
- dvAttr: {Attrs:}
- if FFileNameDisplay = fndCap then
- StrPLCopy(pszText, UpperCase(GetAttrString(Attr)), cchTextMax)
- else
- StrPLCopy(pszText, GetAttrString(Attr), cchTextMax);
- dvExt:
- StrPLCopy(pszText, FileExt, cchTextMax);
- end {Case}
- end {SubItem}
- else pszText[0] := #0;
- end;
- {Set display icon of current file:}
- if (iSubItem = 0) and ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
- begin
- iImage := PFileRec(ListItem.Data).ImageIndex;
- Mask := Mask or LVIF_DI_SETITEM;
- end;
- end; {With PFileRec Do}
- {Mask := Mask Or LVIF_DI_SETITEM; {<== causes flickering display and icons not to be updated on renaming the item}
- end;
- function TDirView.ItemColor(Item: TListItem): TColor;
- begin
- if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
- Result := FCompressedColor
- else
- if DimmHiddenFiles and not Item.Selected and
- (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
- Result := clGrayText
- else
- Result := clDefaultItemColor;
- end;
- {$IFNDEF NO_THREADS}
- procedure TDirView.StartFileDeleteThread;
- var
- Files: TStringList;
- begin
- Files := TStringList.Create;
- try
- CreateFileList(False, True, Files);
- TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
- finally
- Files.Free;
- end;
- end;
- procedure TDirView.StartIconUpdateThread;
- begin
- if DirOK then
- begin
- if not Assigned(FIconUpdateThread) then
- begin
- if Items.Count > 0 then
- FIconUpdateThread := TIconUpdateThread.Create(Self);
- end
- else
- begin
- Assert(not FIconUpdateThread.Terminated);
- FIconUpdateThread.Index := 0;
- if ViewStyle = vsReport then
- FIconUpdateThread.Resume;
- end;
- end;
- end; {StartIconUpdateThread}
- procedure TDirView.StartSubDirScanner;
- var
- Index: Integer;
- begin
- if not (csDesigning in ComponentState) and
- DirOk and ShowDirectories and ShowSubDirSize then
- for Index := 0 to Items.Count - 1 do
- with PFileRec(Items[Index].Data)^ do
- if IsDirectory and not isParentDir then
- FSubDirScanner.Add(TSubDirScanner.Create(Self, Items[Index]));
- end; {StartSubDirScanner}
- procedure TDirView.StopSubDirScanner;
- var
- Index: Integer;
- begin
- for Index := 0 To FSubDirScanner.Count - 1 do
- if Assigned(FSubDirScanner[Index]) then
- with TSubDirScanner(FSubDirScanner[Index]) do
- begin
- Priority := tpHigher;
- Resume;
- Terminate;
- end;
- Application.ProcessMessages;
- end; {StopSubDirScanner}
- procedure TDirView.StopIconUpdateThread;
- var
- Counter: Integer;
- begin
- if Assigned(FIconUpdateThread) then
- begin
- Counter := 0;
- FIconUpdateThread.Terminate;
- FIconUpdateThread.Priority := tpHigher;
- if fIconUpdateThread.Suspended then
- FIconUpdateThread.Resume;
- Sleep(0);
- try
- {Wait until the thread has teminated to prevent AVs:}
- while not FIUThreadFinished do
- begin
- Sleep(10);
- Application.ProcessMessages;
- Inc(Counter);
- {Raise an exception after 2 second, if the thread has not terminated:}
- if Counter = 200 then
- begin
- {MP}raise EIUThread.Create(SIconUpdateThreadTerminationError);
- Break;
- end;
- end;
- finally
- FIconUpdateThread.Destroy;
- FIconUpdateThread := nil;
- end;
- end;
- end; {StopIconUpdateThread}
- procedure TDirView.StopWatchThread;
- begin
- if Assigned(FDiscMonitor) then
- begin
- FDiscMonitor.Free;
- FDiscMonitor := nil;
- end;
- end; {StopWatchThread}
- procedure TDirView.StartWatchThread;
- begin
- if (Length(Path) > 0) and WatchForChanges and DirOK and
- (Pos(Path[1], NoCheckDrives) = 0) then
- begin
- if not Assigned(FDiscMonitor) then
- begin
- FDiscMonitor := TDiscMonitor.Create(Self);
- with FDiscMonitor do
- begin
- ChangeDelay := msThreadChangeDelay;
- SubTree := False;
- Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
- Directory := PathName;
- OnChange := ChangeDetected;
- OnInvalid := ChangeInvalid;
- Open;
- end;
- end
- else
- begin
- FDiscMonitor.Directory := PathName;
- FDiscMonitor.Open;
- end;
- end
- end; {StartWatchThread}
- {$ENDIF}
- procedure TDirView.TimerOnTimer(Sender: TObject);
- begin
- if not Loading then
- begin
- // fix by MP: disable timer and reload directory before call to event
- FChangeTimer.Enabled := False;
- FChangeTimer.Interval := 0;
- Reload2;
- if Assigned(FOnChangeDetected) then
- FOnChangeDetected(Self);
- end
- end; {TimerOnTimer}
- procedure TDirView.ChangeDetected(Sender: TObject);
- begin
- FDirty := True;
- FChangeTimer.Enabled := False;
- FChangeTimer.Interval := 0;
- FChangeTimer.Interval := FChangeInterval;
- FChangeTimer.Enabled := True;
- end; {ChangeDetected}
- procedure TDirView.ChangeInvalid(Sender: TObject);
- begin
- FDiscMonitor.Close;
- if Assigned(FOnChangeInvalid) then
- FOnChangeInvalid(Self);
- end; {ChangeInvalid}
- procedure TDirView.Syncronize;
- begin
- Application.ProcessMessages;
- FChangeTimer.Enabled := False;
- FChangeTimer.Interval := 0;
- LoadEnabled := True;
- if Dirty then Reload2;
- end; {Syncronize}
- {$IFNDEF NO_THREADS}
- function TDirView.WatchThreadActive: Boolean;
- Begin
- Result := WatchForChanges and Assigned(FDiscMonitor) and
- FDiscMonitor.Active;
- end; {WatchThreadActive}
- {$ENDIF}
- procedure TDirView.SetChangeInterval(Value: Cardinal);
- begin
- if Value > 0 then
- begin
- FChangeInterval := Value;
- FChangeTimer.Interval := Value;
- end;
- end; {SetChangeInterval}
- procedure TDirView.SetFileNameDisplay(Value: TFileNameDisplay);
- begin
- if Value <> FileNameDisplay then
- begin
- FFileNameDisplay := Value;
- if DirOK then Reload(True);
- end;
- end; {SetFileNameDisplay}
- procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
- begin
- if Value <> ColProperties then
- ColProperties := Value;
- end;
- function TDirView.GetDirColProperties: TDirViewColProperties;
- begin
- Result := TDirViewColProperties(ColProperties);
- end;
- procedure TDirView.SetShowSubDirSize(Value: Boolean);
- begin
- if Value <> ShowSubDirSize then
- begin
- inherited;
- if Value then
- begin
- {$IFNDEF NO_THREADS}
- if ShowDirectories then
- StartSubDirScanner;
- {$ENDIF}
- end
- else
- begin
- {$IFNDEF NO_THREADS}
- StopSubDirScanner;
- {$ENDIF}
- Invalidate;
- end;
- end;
- end; {SetShowSubDirSize}
- procedure TDirView.SetWatchForChanges(Value: Boolean);
- begin
- if WatchForChanges <> Value then
- begin
- FWatchForChanges := Value;
- if not (csDesigning in ComponentState) then
- begin
- {$IFNDEF NO_THREADS}
- if Value then StartWatchThread
- else StopWatchThread;
- {$ENDIF}
- end;
- end;
- end; {SetWatchForChanges}
- procedure TDirView.DisplayPropertiesMenu;
- var
- FileList: TStringList;
- Index: Integer;
- PIDLRel: PItemIDList;
- PIDLPath: PItemIDList;
- begin
- if not Assigned(ItemFocused) then
- ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
- else
- if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
- begin
- FileList := TStringList.Create;
- try
- CreateFileList(False, True, FileList);
- for Index := 0 to Pred(FileList.Count) do
- FileList[Index] := ExtractFileName(FileList[Index]);
- ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
- PathName, FileList);
- finally
- FileList.Free;
- end;
- end
- else
- if Assigned(ItemFocused.Data) then
- begin
- if IsRecycleBin then
- begin
- if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
- begin
- PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
- ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
- FreePIDL(PIDLRel);
- FreePIDL(PIDLPath);
- end;
- end
- else
- ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
- ItemFullFileName(ItemFocused));
- end;
- end;
- procedure TDirView.ExecuteFile(Item: TListItem);
- var
- DefDir: string;
- FileName: string;
- {$IFDEF USE_DRIVEVIEW}
- Node: TTreeNode;
- {$ENDIF}
- begin
- if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
- PFileRec(Item.Data)^.IsDirectory then
- begin
- if PFileRec(Item.Data)^.IsDirectory then
- begin
- FileName := ItemFullFileName(Item);
- if not DirExists(FileName) then
- begin
- Reload2;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) and Assigned(TDriveView(FDriveView).Selected) then
- with FDriveView as TDriveView do
- ValidateDirectory(Selected);
- {$ENDIF}
- Exit;
- end;
- end
- else
- FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
- if DirExists(FileName) then
- begin
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- with (FDriveView as TDriveView) do
- begin
- Node := FindNodeToPath(FileName);
- if not Assigned(Node) then
- begin
- ValidateDirectory(GetDriveStatus(FileName[1]).RootNode);
- Node := FindNodeToPath(FileName);
- end;
- if Assigned(Node) then
- begin
- Directory := FileName;
- CenterNode(Selected);
- end;
- Exit;
- end
- else
- {$ENDIF}
- begin
- Path := FileName;
- Exit;
- end;
- end
- else
- if not FileExists(FileName) then Exit;
- end;
- GetDir(0, DefDir);
- ChDir(PathName);
- try
- ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
- ItemFullFileName(Item));
- finally
- ChDir(DefDir);
- end;
- end;
- procedure TDirView.ExecuteHomeDirectory;
- begin
- Path := HomeDirectory;
- end;
- procedure TDirView.ExecuteParentDirectory;
- begin
- if Valid then
- begin
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(DriveView) and Assigned(TDriveView(DriveView).Selected) then
- TDriveView(DriveView).Selected := TDriveView(DriveView).Selected.Parent
- else
- {$ENDIF}
- Path := ExtractFilePath(Path);
- end;
- end;
- procedure TDirView.ExecuteRootDirectory;
- begin
- if Valid then
- try
- FLastPath := PathName;
- FPath := ExtractFileDrive(Path);
- Load;
- finally
- PathChanged;
- end;
- end;
- procedure TDirView.Delete(Item: TListItem);
- begin
- if Assigned(Item) and Assigned(Item.Data) then
- with PFileRec(Item.Data)^ do
- begin
- SetLength(FileName, 0);
- SetLength(TypeName, 0);
- SetLength(DisplayName, 0);
- if Assigned(PIDL) then FreePIDL(PIDL);
- Dispose(PFileRec(Item.Data));
- Item.Data := nil;
- end;
- inherited Delete(Item);
- end; {Delete}
- procedure TDirView.InternalEdit(const HItem: TLVItem);
- var
- Item: TListItem;
- Info: string;
- NewCaption: string;
- {$IFDEF USE_DRIVEVIEW}
- IsDirectory: Boolean;
- {$ENDIF}
- begin
- Item := GetItemFromHItem(HItem);
- {$IFDEF USE_DRIVEVIEW}
- IsDirectory := DirExists(ItemFullFileName(Item));
- {$ENDIF}
- NewCaption := HItem.pszText;
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$IFDEF USE_DRIVEVIEW}
- if IsDirectory and Assigned(FDriveView) then
- TDriveView(FDriveView).StopWatchThread;
- {$ENDIF}
- {$ENDIF}
- with FFileOperator do
- begin
- Flags := [foAllowUndo, foNoConfirmation];
- Operation := foRename;
- OperandFrom.Clear;
- OperandTo.Clear;
- OperandFrom.Add(ItemFullFileName(Item));
- OperandTo.Add(fPath + '\' + HItem.pszText);
- end;
- try
- if FFileOperator.Execute then
- begin
- {$IFDEF USE_DRIVEVIEW}
- if IsDirectory and Assigned(FDriveView) then
- with (FDriveView as TDriveView) do
- if Assigned(Selected) then
- ValidateDirectory(Selected);
- {$ENDIF}
- with GetFileRec(Item.Index)^ do
- begin
- Empty := True;
- IconEmpty := True;
- FileName := NewCaption;
- DisplayName := FileName;
- FileExt := UpperCase(Copy(ExtractFileExt(HItem.pszText), 2, Pred(ExtLen)));
- TypeName := EmptyStr;
- if Assigned(PIDL) then
- FreePIDL(PIDL);
- end;
- GetDisplayData(Item, True);
- ResetItemImage(Item.Index);
- UpdateItems(Item.Index, Item.Index);
- if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
- if Item <> nil then Item.Caption := NewCaption;
- SortItems;
- if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
- end
- else
- begin
- Item.Caption := GetFileRec(Item.Index)^.FileName;
- Item.Update;
- if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
- Info := SErrorRenameFileExists + HItem.pszText
- else
- Info := SErrorRenameFile + HItem.pszText;
- MessageBeep(MB_ICONHAND);
- if MessageDlg(Info, mtError, [mbOK, mbAbort], 0) = mrOK then
- RetryRename(HItem.pszText);
- end;
- finally
- Sleep(0);
- LoadEnabled := True;
- {$IFNDEF NO_THREADS}
- if FWatchForChanges and (not WatchThreadActive) then
- StartWatchThread;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).StartWatchThread;
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- function TDirView.ItemFileName(Item: TListItem): string;
- begin
- if Assigned(Item) and Assigned(Item.Data) then
- Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
- else
- Result := '';
- end;
- function TDirView.ItemFileSize(Item: TListItem): Int64;
- begin
- Result := 0;
- if Assigned(Item) and Assigned(Item.Data) then
- with PFileRec(Item.Data)^ do
- if Size >= 0 then Result := Size;
- end;
- function TDirView.ItemFileTime(Item: TListItem): TDateTime;
- begin
- Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
- end;
- function TDirView.ItemImageIndex(Item: TListItem;
- Cache: Boolean): Integer;
- begin
- if Assigned(Item) and Assigned(Item.Data) then
- begin
- if PFileRec(Item.Data)^.IconEmpty then
- begin
- if Cache then Result := -1
- else Result := UnknownFileIcon;
- end
- else
- begin
- if (not Cache) or (Pos(PFileRec(Item.Data)^.FileExt, SpecialExtensions) <> 0) then
- Result := PFileRec(Item.Data)^.ImageIndex
- else
- Result := -1
- end;
- end
- else Result := -1;
- end;
- {$IFDEF USE_DRIVEVIEW}
- procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = FDriveView) then
- FDriveView := nil;
- end; {Notification}
- {$ENDIF}
- procedure TDirView.ReloadDirectory;
- begin
- Reload(True);
- end;
- procedure TDirView.ResetItemImage(Index: Integer);
- var
- LVI: TLVItem;
- begin
- with PFileRec(Items[Index].Data)^, LVI do
- begin
- {Update imageindex:}
- Mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
- iItem := Index;
- iSubItem := 0;
- if ListView_GetItem(Handle, LVI) then
- begin
- iImage := I_IMAGECALLBACK;
- Mask := Mask and (not LVIF_DI_SETITEM);
- ListView_SetItem(Handle, LVI);
- end;
- end; {With}
- end; {ResetItemImage}
- procedure TDirView.SetAttrSpace(Value: string);
- begin
- if Value <> FAttrSpace then
- begin
- FAttrSpace := Value;
- Invalidate;
- end;
- end; {SetAttrSpace}
- procedure TDirView.SetNoCheckDrives(Value: string);
- begin
- FNoCheckDrives := UpperCase(Value);
- end; {SetNoCheckDrives}
- { Drag&Drop handling }
- {$IFNDEF NO_THREADS}
- procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
- {Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:}
- var
- Index: Integer;
- begin
- if Files.Count > 0 then
- for Index := 0 to Files.Count - 1 do
- ValidateFile(Files[Index]);
- end;
- {$ENDIF}
- procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
- begin
- {$IFNDEF NO_THREADS}
- if not WatchThreadActive then
- {$ENDIF}
- begin
- FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
- FChangeTimer.Enabled := True;
- end;
- inherited;
- end;
- procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
- Point: TPoint; dwEffect: Longint);
- begin
- {$IFNDEF NO_THREADS}
- if not WatchThreadActive then
- {$ENDIF}
- begin
- FChangeTimer.Interval := FChangeInterval;
- FChangeTimer.Enabled := True;
- end;
- inherited;
- end;
- procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
- begin
- Assert(Assigned(Item));
- if IsRecycleBin then
- begin
- if Assigned(Item.Data) then
- begin
- if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
- ('.' + PFileRec(Item.Data)^.FileExt) then
- FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
- ItemDragFileName(Item), PFileRec(Item.Data)^.DisplayName)
- else
- FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
- ItemDragFileName(Item), PFileRec(Item.Data)^.DisplayName +
- ExtractFileExt(PFileRec(Item.Data)^.FileName));
- end;
- end
- else inherited;
- end;
- procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
- DragStatus:TDragDetectStatus);
- {$IFNDEF NO_THREADS}
- var
- WasWatchThreadActive: Boolean;
- {$ENDIF}
- begin
- if (DragStatus = ddsDrag) and (MarkedCount > 0) then
- begin
- {$IFNDEF NO_THREADS}
- WasWatchThreadActive := WatchThreadActive;
- {$ENDIF}
- inherited;
- {$IFNDEF NO_THREADS}
- if (LastDDResult = drMove) and (not WasWatchThreadActive) then
- StartFileDeleteThread;
- {$ENDIF}
- end;
- end; {DDDragDetect}
- procedure TDirView.DDChooseEffect(grfKeyState: Integer;
- var dwEffect: Integer);
- begin
- if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
- begin
- if ExeDrag and (Path[1] >= FirstFixedDrive) and
- (DragDrive >= FirstFixedDrive) then dwEffect := DropEffect_Link
- else
- if DragOnDriveIsMove and
- (not DDOwnerIsSource or Assigned(DropTarget)) and
- (((DragDrive = Upcase(Path[1])) and (dwEffect = DropEffect_Copy) and
- (DragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0))
- or IsRecycleBin) then dwEffect := DropEffect_Move;
- end;
- end;
- procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
- dwEffect: Integer; RenameOnCollision: Boolean);
- var
- Index: Integer;
- SourcePath: string;
- SourceFile: string;
- OldCursor: TCursor;
- OldWatchForChanges: Boolean;
- DoFileOperation: Boolean;
- IsRecycleBin: Boolean;
- {$IFDEF USE_DRIVEVIEW}
- SourceIsDirectory: Boolean;
- Node: TTreeNode;
- {$ENDIF}
- begin
- if DragDropFilesEx.FileList.Count > 0 then
- begin
- if not DirExists(TargetPath) then
- begin
- Reload(True);
- DDError(DDPathNotFoundError);
- end
- else
- begin
- IsRecycleBin := Self.IsRecycleBin or ItemIsRecycleBin(DropTarget);
- if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
- begin
- OldCursor := Screen.Cursor;
- OldWatchForChanges := WatchForChanges;
- {$IFDEF USE_DRIVEVIEW}
- SourceIsDirectory := True;
- {$ENDIF}
- SourcePath := EmptyStr;
- try
- Screen.Cursor := crHourGlass;
- WatchForChanges := False;
- if (dwEffect in [DropEffect_Copy, DropEffect_Move]) then
- begin
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(DriveView) then
- TDriveView(DriveView).StopWatchThread;
- {$ENDIF}
- if (DropSourceControl <> Self) and
- (DropSourceControl is TDirView) then
- TDirView(DropSourceControl).StopWatchThread;
- {$ENDIF}
- SourcePath := '';
- {Set the source filenames:}
- for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
- begin
- FFileOperator.OperandFrom.Add(
- TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
- if DragDropFilesEx.FileNamesAreMapped then
- FFileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
- TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
- if SourcePath = '' then
- begin
- if DirExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
- begin
- SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
- {$IFDEF USE_DRIVEVIEW}
- SourceIsDirectory := True;
- {$ENDIF}
- end
- else
- begin
- SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
- {$IFDEF USE_DRIVEVIEW}
- SourceIsDirectory := False;
- {$ENDIF}
- end;
- end;
- end;
- FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
- if RenameOnCollision then
- Begin
- FFileOperator.Flags := FFileOperator.Flags + [foRenameOnCollision];
- FFileOperator.WantMappingHandle := True;
- end
- else FFileOperator.WantMappingHandle := False;
- {Set the target directory or the target filenames:}
- if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
- FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles]
- else
- begin
- FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
- FFileOperator.OperandTo.Clear;
- FFileOperator.OperandTo.Add(TargetPath);
- end;
- {if the target directory is the recycle bin, then delete the selected files:}
- if IsRecycleBin then FFileOperator.Operation := foDelete
- else
- case dwEffect of
- DropEffect_Copy: FFileOperator.Operation := foCopy;
- DropEffect_Move: FFileOperator.Operation := foMove;
- end;
- 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(OnDDFileOperation) then
- OnDDFileOperation(Self, dwEffect, SourcePath, TargetPath,
- DoFileOperation);
- if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
- begin
- FFileOperator.Execute;
- ReLoad2;
- if DragDropFilesEx.FileNamesAreMapped then
- FFileOperator.ClearUndo;
- if Assigned(OnDDFileOperationExecuted) then
- OnDDFileOperationExecuted(Self, dwEffect, SourcePath, TargetPath);
- end;
- end
- else
- if dwEffect = DropEffect_Link then
- (* Create Link requested: *)
- begin
- {$IFNDEF NO_THREADS}
- StopWatchThread;
- {$ENDIF}
- for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
- begin
- SourceFile := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
- if Length(SourceFile) = 3 then
- {Create a link to a drive:}
- SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
- else
- {Create a link to a file or directory:}
- SourcePath := ExtractFileName(SourceFile);
- if not CreateFileShortCut(SourceFile, IncludeTrailingPathDelimiter(TargetPath) +
- ChangeFileExt(SourcePath,'.lnk'),
- ExtractFileNameOnly(SourceFile)) then
- DDError(DDCreateShortCutError);
- end;
- ReLoad2;
- end;
- if Assigned(DropSourceControl) and
- (DropSourceControl is TDirView) and
- (DropSourceControl <> Self) and
- (dwEffect = DropEffect_Move) then
- TDirView(DropSourceControl).ValidateSelectedFiles;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) and SourceIsDirectory then
- with TDriveView(FDriveView) do
- begin
- try
- ValidateDirectory(FindNodeToPath(TargetPath));
- except
- end;
- if (dwEffect = DropEffect_Move) or IsRecycleBin then
- try
- Node := FindNodeToPath(SourcePath);
- if Assigned(Node) and Assigned(Node.Parent) then
- Node := Node.Parent;
- ValidateDirectory(Node);
- except
- end;
- end;
- {$ENDIF}
- finally
- FFileOperator.OperandFrom.Clear;
- FFileOperator.OperandTo.Clear;
- {$IFDEF USE_DRIVEVIEW}
- {$IFNDEF NO_THREADS}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).StartWatchThread;
- {$ENDIF}
- {$ENDIF}
- Sleep(0);
- WatchForChanges := OldWatchForChanges;
- {$IFNDEF NO_THREADS}
- if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
- TDirView(DropSourceControl).StartWatchThread;
- {$ENDIF}
- Screen.Cursor := OldCursor;
- end;
- end;
- end;
- end;
- end; {PerformDragDropFileOperation}
- procedure TDirView.DDError(ErrorNo: TDDError);
- begin
- if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
- else
- raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
- end; {DDError}
- function TDirView.GetCanUndoCopyMove: Boolean;
- begin
- Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
- end; {CanUndoCopyMove}
- function TDirView.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}
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).StopAllWatchThreads;
- {$ENDIF}
- {$ENDIF}
- Result := FFileOperator.UndoExecute;
- {$IFNDEF NO_THREADS}
- if not WatchthreadActive then
- {$ENDIF}
- Reload2;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- with TDriveView(FDriveView) do
- begin
- ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
- ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
- {$IFNDEF NO_THREADS}
- StartAllWatchThreads;
- {$ENDIF}
- end;
- {$ENDIF}
- end;
- end; {UndoCopyMove}
- procedure TDirView.EmptyClipboard;
- var
- Index: Integer;
- StartIndex: Integer;
- begin
- if Windows.OpenClipBoard(0) then
- begin
- Windows.EmptyClipBoard;
- Windows.CloseClipBoard;
- if LastClipBoardOperation <> cboNone then
- begin
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_CUT);
- while Index >= 0 do
- begin
- Items[Index].Cut := False;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL Or LVNI_CUT);
- end;
- end;
- LastClipBoardOperation := cboNone;
- {$IFDEF USE_DRIVEVIEW}
- if Assigned(FDriveView) then
- TDriveView(FDriveView).LastPathCut := '';
- {$ENDIF}
- end;
- end; {EmptyClipBoard}
- function TDirView.CopyToClipBoard : Boolean;
- var
- Index: Integer;
- SaveCursor: TCursor;
- StartIndex: Integer;
- begin
- SaveCursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- Result := False;
- EmptyClipBoard;
- DragDropFilesEx.FileList.Clear;
- if SelCount > 0 then
- begin
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
- while Index >= 0 do
- begin
- DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Items[Index]));
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
- end;
- Result := DragDropFilesEx.CopyToClipBoard;
- LastClipBoardOperation := cboCopy;
- end;
- finally
- Screen.Cursor := SaveCursor;
- end;
- end; {CopyToClipBoard}
- function TDirView.CutToClipBoard : Boolean;
- var
- Index: Integer;
- StartIndex: Integer;
- begin
- Result := False;
- EmptyClipBoard;
- DragDropFilesEx.FileList.Clear;
- if SelCount > 0 then
- begin
- Index := ListView_GetNextItem(Handle, -1, LVNI_ALL or LVNI_SELECTED);
- while Index >= 0 do
- begin
- DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Items[Index]));
- Items[Index].Cut := True;
- StartIndex := Index;
- Index := ListView_GetNextItem(Handle, StartIndex, LVNI_ALL or LVNI_SELECTED);
- end;
- Result := DragDropFilesEx.CopyToClipBoard;
- LastClipBoardOperation := cboCut;
- end;
- end; {CutToClipBoard}
- function TDirView.CanPasteFromClipBoard: Boolean;
- begin
- Result := False;
- if DirOK and (Path <> '') and Windows.OpenClipboard(0) then
- begin
- Result := IsClipboardFormatAvailable(CF_HDROP);
- Windows.CloseClipBoard;
- end;
- end; {CanPasteFromClipBoard}
- function TDirView.PasteFromClipBoard(TargetPath: string = ''): Boolean;
- begin
- DragDropFilesEx.FileList.Clear;
- Result := False;
- if CanPasteFromClipBoard and
- {MP}{$IFDEF OLD_DND} DragDropFilesEx.GetFromClipBoard {$ELSE} DragDropFilesEx.PasteFromClipboard {$ENDIF}{/MP}
- then
- begin
- if TargetPath = '' then
- TargetPath := PathName;
- case LastClipBoardOperation of
- cboNone:
- begin
- PerformDragDropFileOperation(TargetPath, DropEffect_Copy, False);
- if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
- end;
- cboCopy:
- begin
- PerformDragDropFileOperation(TargetPath, DropEffect_Copy,
- ExcludeTrailingPathDelimiter(ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[0]^).Name)) = Path);
- if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
- end;
- cboCut:
- begin
- PerformDragDropFileOperation(TargetPath, DropEffect_Move, False);
- if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Move);
- EmptyClipBoard;
- end;
- end;
- Result := True;
- end;
- end; {PasteFromClipBoard}
- function TDirView.DragCompleteFileList: Boolean;
- begin
- Result := inherited DragCompleteFileList and
- (FDriveType <> DRIVE_REMOVABLE);
- end;
- function TDirView.DuplicateSelectedFiles: Boolean;
- begin
- Result := False;
- if SelCount > 0 then
- begin
- Result := CopyToClipBoard;
- if Result then
- try
- SelectNewFiles := True;
- Selected := nil;
- Result := PasteFromClipBoard;
- finally
- SelectNewFiles := False;
- if Assigned(Selected) then
- begin
- ItemFocused := Selected;
- Selected.MakeVisible(False);
- if SelCount = 1 then
- Selected.EditCaption;
- end;
- end;
- end;
- EmptyClipBoard;
- end; {DuplicateFiles}
- procedure TDirView.FetchAllDisplayData;
- var
- Index: Integer;
- begin
- for Index := 0 to Items.Count - 1 do
- if Assigned(Items[Index]) and Assigned(Items[Index].Data) then
- if PFileRec(Items[Index].Data)^.Empty then
- GetDisplayData(Items[Index], False);
- end; {FetchAllDisplayData}
- function TDirView.MinimizePath(Path: string; Len: Integer): string;
- begin
- Result := MinimizeName(Path, Canvas, Len);
- end; { MinimizePath }
- function TDirView.NewColProperties: TCustomListViewColProperties;
- begin
- Result := TDirViewColProperties.Create(Self);
- end;
- procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
- begin
- Assert(Assigned(Item));
- if Assigned(Item.Data) then
- with PFileRec(Item.Data)^ do
- begin
- ImageIndex := Index;
- IconEmpty := (ImageIndex < 0);
- end;
- end;
- {=================================================================}
- initialization
- LastClipBoardOperation := cboNone;
- LastIOResult := 0;
- end.
|