Rev 76 | Go to most recent revision | Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 75 | daniel-mar | 1 | unit RecBinUnit2 platform; |
| 2 | |||
| 3 | //////////////////////////////////////////////////////////////////////////////////// |
||
| 4 | // RECYCLE-BIN-FUNCTIONS V2 BY DANIEL MARSCHALL // |
||
| 5 | // E-MAIL: info@daniel-marschall.de // |
||
| 6 | // WEB: www.daniel-marschall.de // |
||
| 7 | //////////////////////////////////////////////////////////////////////////////////// |
||
| 8 | // Revision: 02 JUL 2016 // |
||
| 9 | // This unit is freeware, but please link to my website if you are using it! // |
||
| 10 | //////////////////////////////////////////////////////////////////////////////////// |
||
| 11 | // Successfully tested with: // |
||
| 12 | // Windows 95b (without IE4 Shell Extensions) // |
||
| 13 | // Windows 95b (with IE4 Shell Extensions) // |
||
| 14 | // Windows 98-SE // |
||
| 15 | // Windows NT4 SP6 // |
||
| 16 | // Windows XP-SP3 // |
||
| 17 | // Windows 2000-SP4 // |
||
| 18 | // Windows 2003 Server EE SP1 // |
||
| 19 | // Windows Vista // |
||
| 20 | // Windows 7 // |
||
| 21 | // Windows 10 // |
||
| 22 | //////////////////////////////////////////////////////////////////////////////////// |
||
| 23 | |||
| 24 | // Delphi 7 Compatibility: (TODO: compiler switches) |
||
| 25 | // - Remove "static" |
||
| 26 | // - Remove "strict" |
||
| 27 | // - Remove "$REGION" |
||
| 28 | |||
| 29 | // TODO: "blind reading" feature: read also INFO and INFO2 records mixed in one file (win2000 multiboot conflict) |
||
| 30 | // TODO: ReadBuffer überall try-except |
||
| 31 | // TODO: Win7 : Drive GUIDs |
||
| 32 | // TODO: Win7 : Absolute vs. Relative size limitations |
||
| 33 | // TODO: Always check EOF before reading anything? |
||
| 34 | // TODO: Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext? |
||
| 35 | // TODO: RecyclerGetInfofiles() check additionally for removable device? |
||
| 36 | // RecyclerIsValid() is false. |
||
| 37 | // TODO: Make it possible to empty the recycle bin of one specific drive! |
||
| 38 | // TODO: Unknown! Do you know the answer? |
||
| 39 | // - How does Windows 9x/NT manage the daylight saving time (if it does)? |
||
| 40 | // - How does Windows Vista+ react to a RECYCLER\ folder on a NTFS device? |
||
| 41 | // - How does Windows Vista+ react to a RECYCLED\ folder on a FAT device? ==> Win7: is ignored! |
||
| 42 | // - How does Windows XP react to RECYCLED\ folder on a FAT device? |
||
| 43 | // TODO: Translate all comments from German to English |
||
| 44 | // TODO: do we need this (maybe not all drives have A: till Z:?) http://stackoverflow.com/questions/17110543/how-to-retrieve-the-disk-signature-of-all-the-disks-in-windows-using-delphi-7 |
||
| 45 | |||
| 46 | // If enabled, the deletion timestamps will not be converted by the WinAPI. |
||
| 47 | {.$DEFINE FILETIME_DELPHI_CODE} |
||
| 48 | |||
| 49 | // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, even if gpedit.msc shows "Not configured"! |
||
| 50 | {$DEFINE GroupPolicyAcceptHKLMTrick} |
||
| 51 | |||
| 52 | interface |
||
| 53 | |||
| 54 | uses |
||
| 55 | Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages; |
||
| 56 | |||
| 57 | const |
||
| 58 | RECBINUNIT_VERSION = '2016-07-02'; |
||
| 59 | |||
| 60 | RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}'; |
||
| 61 | NULL_GUID: TGUID = '{00000000-0000-0000-0000-000000000000}'; |
||
| 62 | |||
| 63 | type |
||
| 64 | EAPICallError = class(Exception); |
||
| 65 | EEventCategoryNotDefined = class(Exception); |
||
| 66 | EInvalidDrive = class(Exception); |
||
| 67 | |||
| 68 | PSHQueryRBInfo = ^TSHQueryRBInfo; |
||
| 69 | TSHQueryRBInfo = packed record |
||
| 70 | cbSize : dword; |
||
| 71 | i64Size : int64; |
||
| 72 | i64NumItems : int64; |
||
| 73 | end; |
||
| 74 | |||
| 75 | TRbRecycleBinItem = class(TObject) |
||
| 76 | strict private |
||
| 77 | function GetSource: string; |
||
| 78 | strict protected |
||
| 79 | FSourceAnsi: AnsiString; |
||
| 80 | FSourceUnicode: WideString; |
||
| 81 | FID: string; |
||
| 82 | FSourceDrive: Char; |
||
| 83 | FDeletionTime: TDateTime; |
||
| 84 | FOriginalSize: int64; |
||
| 85 | FIndexFile: string; |
||
| 86 | FRemovedEntry: boolean; |
||
| 87 | procedure ReadFromStream(stream: TStream); virtual; abstract; |
||
| 88 | function GetPhysicalFile: string; virtual; abstract; // protected, because it will be read by "property" |
||
| 89 | public |
||
| 90 | property PhysicalFile: string read GetPhysicalFile; |
||
| 91 | property SourceAnsi: AnsiString read FSourceAnsi; |
||
| 92 | property SourceUnicode: WideString read FSourceUnicode; |
||
| 93 | property Source: string read GetSource; // will bei either ANSI or Unicode, sepending on the Delphi version |
||
| 94 | property ID: string read FID; |
||
| 95 | property SourceDrive: Char read FSourceDrive; |
||
| 96 | property DeletionTime: TDateTime read FDeletionTime; |
||
| 97 | property OriginalSize: int64 read FOriginalSize; |
||
| 98 | property IndexFile: string read FIndexFile; |
||
| 99 | property RemovedEntry: boolean read FRemovedEntry; // the file is NOT in the recycle bin anymore! |
||
| 100 | |||
| 101 | // Attention: There are not an official API calls. The delete and recover |
||
| 102 | // functions might fail and/or damage the shell cache. Handle with care! |
||
| 103 | function DeleteFile: boolean; virtual; abstract; |
||
| 104 | function RecoverFile: boolean; virtual; abstract; |
||
| 105 | function OpenFile: boolean; virtual; abstract; |
||
| 106 | end; |
||
| 107 | |||
| 108 | TRbInfo1Item = class(TRbRecycleBinItem) |
||
| 109 | strict protected |
||
| 110 | procedure ReadFromStream(stream: TStream); override; |
||
| 111 | function GetPhysicalFile: string; override; |
||
| 112 | public |
||
| 113 | constructor Create(fs: TStream; AIndexFile: string); |
||
| 114 | function DeleteFile: boolean; override; |
||
| 115 | // TODO: function RecoverFile: boolean; override; |
||
| 116 | // TODO: function OpenFile: boolean; override; |
||
| 117 | end; |
||
| 118 | |||
| 119 | TRbInfo2Item = class(TRbRecycleBinItem) |
||
| 120 | strict protected |
||
| 121 | procedure ReadFromStream(stream: TStream); override; |
||
| 122 | function GetPhysicalFile: string; override; |
||
| 123 | public |
||
| 124 | constructor Create(fs: TStream; AIndexFile: string); |
||
| 125 | function DeleteFile: boolean; override; |
||
| 126 | // TODO: function RecoverFile: boolean; override; |
||
| 127 | // TODO: function OpenFile: boolean; override; |
||
| 128 | end; |
||
| 129 | |||
| 130 | TRbVistaItem = class(TRbRecycleBinItem) |
||
| 131 | strict protected |
||
| 132 | procedure ReadFromStream(stream: TStream); override; |
||
| 133 | function GetPhysicalFile: string; override; |
||
| 134 | public |
||
| 135 | constructor Create(fs: TStream; AIndexFile, AID: string); |
||
| 136 | function DeleteFile: boolean; override; |
||
| 137 | // TODO: function RecoverFile: boolean; override; |
||
| 138 | // TODO: function OpenFile: boolean; override; |
||
| 139 | end; |
||
| 140 | |||
| 141 | TRbRecycleBin = class(TObject) |
||
| 142 | strict private |
||
| 143 | FFileOrDirectory: string; |
||
| 144 | FSID: string; |
||
| 145 | public |
||
| 146 | constructor Create(AFileOrDirectory: string; ASID: string=''); |
||
| 147 | |||
| 148 | function GetItem(id: string): TRbRecycleBinItem; |
||
| 149 | procedure ListItems(list: TObjectList{TRbRecycleBinItem}); |
||
| 150 | function CheckIndexes(slErrors: TStrings): boolean; |
||
| 151 | |||
| 152 | property FileOrDirectory: string read FFileOrDirectory; |
||
| 153 | property SID: string read FSID; |
||
| 154 | end; |
||
| 155 | |||
| 156 | // TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind? |
||
| 157 | TRbDrive = class(TObject) |
||
| 158 | strict private |
||
| 159 | FDriveLetter: Char; |
||
| 160 | |||
| 161 | // will return NULL_GUID in case of an error or if it is not supported |
||
| 162 | function GetVolumeGUID: TGUID; |
||
| 163 | strict protected |
||
| 164 | function IsFAT: boolean; |
||
| 165 | procedure CheckDriveExisting; |
||
| 166 | public |
||
| 167 | constructor Create(ADriveLetter: Char); |
||
| 168 | |||
| 169 | // Wenn UserSID='', dann werden alle Recycler gefunden |
||
| 170 | procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string=''); |
||
| 171 | |||
| 172 | property DriveLetter: Char read FDriveLetter; |
||
| 173 | property VolumeGUID: TGUID read GetVolumeGUID; |
||
| 174 | function GetAPIInfo: TSHQueryRBInfo; |
||
| 175 | function GetSize: int64; |
||
| 176 | function GetNumItems: int64; |
||
| 177 | function IsEmpty: boolean; |
||
| 178 | |||
| 179 | function GetMaxPercentUsage: integer; |
||
| 180 | function GetNukeOnDelete: boolean; |
||
| 181 | |||
| 182 | // These functions will check the global configuration and group policy, too. |
||
| 183 | function RecyclerGetPercentUsageAutoDeterminate: integer; |
||
| 184 | function RecyclerIsNukeOnDeleteAutoDeterminate: boolean; |
||
| 185 | end; |
||
| 186 | |||
| 187 | GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled); |
||
| 188 | |||
| 189 | TRecycleBinManager = class(TObject) |
||
| 190 | public |
||
| 191 | class procedure ListDrives(list: TObjectList{TRbDrive}); static; |
||
| 192 | class function RecycleBinPossible(Drive: Char): boolean; static; |
||
| 193 | |||
| 194 | class function OwnRecyclersSize: int64; static; |
||
| 195 | class function OwnRecyclersNumItems: int64; static; |
||
| 196 | class function OwnRecyclersEmpty: boolean; static; |
||
| 197 | |||
| 198 | class function EmptyOwnRecyclers(flags: cardinal): boolean; overload; static; |
||
| 199 | class function EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean; overload; static; |
||
| 200 | |||
| 201 | class function RecyclerGetCurrentIconString: string; static; |
||
| 202 | class function RecyclerGetDefaultIconString: string; static; |
||
| 203 | class function RecyclerGetEmptyIconString: string; static; |
||
| 204 | class function RecyclerGetFullIconString: string; static; |
||
| 205 | |||
| 206 | class function GetGlobalMaxPercentUsage: integer; static; // TODO: In Win Vista: absolute and not relative sizes |
||
| 207 | class function GetGlobalNukeOnDelete: boolean; static; |
||
| 208 | class function UsesGlobalSettings: boolean; static; |
||
| 209 | |||
| 210 | class function RecyclerGetName: string; static; |
||
| 211 | class function RecyclerGetInfoTip: string; static; |
||
| 212 | class function RecyclerGetIntroText: string; static; |
||
| 213 | |||
| 214 | class function RecyclerEmptyEventGetCurrentSound: string; static; |
||
| 215 | class function RecyclerEmptyEventGetDefaultSound: string; static; |
||
| 216 | class function RecyclerEmptyEventGetName: string; static; |
||
| 217 | class function RecyclerEmptyEventGetSound(ACategory: string): string; static; |
||
| 218 | class procedure RecyclerEmptyEventGetSoundCategories(AStringList: TStringList); static; |
||
| 219 | |||
| 220 | // TODO: In future also detect for other users |
||
| 221 | // TODO: Also make a setter (incl. Message to Windows Explorer?) |
||
| 222 | class function RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL; static; |
||
| 223 | class function RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL; static; |
||
| 224 | class function RecyclerGroupPolicyRecycleBinSize: integer; static; |
||
| 225 | |||
| 226 | class function RecyclerConfirmationDialogEnabled: boolean; static; |
||
| 227 | class procedure RecyclerConfirmationDialogSetEnabled(NewSetting: boolean); static; |
||
| 228 | class function RecyclerShellStateConfirmationDialogEnabled: boolean; static; |
||
| 229 | |||
| 230 | // Diese Funktion ist false, wenn sie z.B. unter Windows 95 ohne Internet Explorer |
||
| 231 | // 4.0 Shell Extension ausgeführt wird. Wenn abwärtskompatibler Code geschrieben |
||
| 232 | // werden soll, sollte RecyclerQueryFunctionAvailable() verwendet werden, da |
||
| 233 | // unter Windows 95 folgende Funktionalitäten NICHT vorhanden sind: |
||
| 234 | // - RecyclerIsEmpty |
||
| 235 | // - RecyclerGetNumItems |
||
| 236 | // - RecyclerGetSize |
||
| 237 | // - RecyclerGetAPIInfo |
||
| 238 | class function RecyclerQueryFunctionAvailable: boolean; static; |
||
| 239 | |||
| 240 | class function RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean; static; |
||
| 241 | end; |
||
| 242 | |||
| 243 | function GPBoolToString(value: GPOLICYBOOL): string; |
||
| 244 | |||
| 245 | implementation |
||
| 246 | |||
| 247 | uses |
||
| 248 | RecBinUnitLowLvl; |
||
| 249 | |||
| 250 | {$REGION 'WinAPI/RTL declarations'} |
||
| 251 | (* |
||
| 252 | const |
||
| 253 | {$IFDEF MSWINDOWS} |
||
| 254 | shell32 = 'shell32.dll'; |
||
| 255 | advapi32 = 'advapi32.dll'; |
||
| 256 | kernel32 = 'kernel32.dll'; |
||
| 257 | {$ENDIF} |
||
| 258 | {$IFDEF LINUX} |
||
| 259 | shell32 = 'libshell32.borland.so'; |
||
| 260 | advapi32 = 'libwine.borland.so'; |
||
| 261 | kernel32 = 'libwine.borland.so'; |
||
| 262 | {$ENDIF} |
||
| 263 | *) |
||
| 264 | |||
| 265 | type |
||
| 266 | SHELLSTATE = record |
||
| 267 | Flags1: DWORD; |
||
| 268 | (* |
||
| 269 | BOOL fShowAllObjects : 1; |
||
| 270 | BOOL fShowExtensions : 1; |
||
| 271 | BOOL fNoConfirmRecycle : 1; |
||
| 272 | |||
| 273 | BOOL fShowSysFiles : 1; |
||
| 274 | BOOL fShowCompColor : 1; |
||
| 275 | BOOL fDoubleClickInWebView : 1; |
||
| 276 | BOOL fDesktopHTML : 1; |
||
| 277 | BOOL fWin95Classic : 1; |
||
| 278 | BOOL fDontPrettyPath : 1; |
||
| 279 | BOOL fShowAttribCol : 1; // No longer used, dead bit |
||
| 280 | BOOL fMapNetDrvBtn : 1; |
||
| 281 | BOOL fShowInfoTip : 1; |
||
| 282 | BOOL fHideIcons : 1; |
||
| 283 | BOOL fWebView : 1; |
||
| 284 | BOOL fFilter : 1; |
||
| 285 | BOOL fShowSuperHidden : 1; |
||
| 286 | BOOL fNoNetCrawling : 1; |
||
| 287 | *) |
||
| 288 | dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts |
||
| 289 | uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts |
||
| 290 | |||
| 291 | // Note: Not a typo! This is a persisted structure so we cannot use LPARAM |
||
| 292 | lParamSort: Integer; |
||
| 293 | iSortDirection: Integer; |
||
| 294 | |||
| 295 | version: UINT; |
||
| 296 | |||
| 297 | // new for win2k. need notUsed var to calc the right size of ie4 struct |
||
| 298 | // FIELD_OFFSET does not work on bit fields |
||
| 299 | uNotUsed: UINT; // feel free to rename and use |
||
| 300 | Flags2: DWORD; |
||
| 301 | (* |
||
| 302 | BOOL fSepProcess: 1; |
||
| 303 | // new for Whistler. |
||
| 304 | BOOL fStartPanelOn: 1; //Indicates if the Whistler StartPanel mode is ON or OFF. |
||
| 305 | BOOL fShowStartPage: 1; //Indicates if the Whistler StartPage on desktop is ON or OFF. |
||
| 306 | UINT fSpareFlags : 13; |
||
| 307 | *) |
||
| 308 | end; |
||
| 309 | LPSHELLSTATE = ^SHELLSTATE; |
||
| 310 | |||
| 311 | const |
||
| 312 | // Masks for the SHELLSTATE |
||
| 313 | SSF_SHOWALLOBJECTS = $00000001; |
||
| 314 | SSF_SHOWEXTENSIONS = $00000002; |
||
| 315 | SSF_HIDDENFILEEXTS = $00000004; |
||
| 316 | SSF_SERVERADMINUI = $00000004; |
||
| 317 | SSF_SHOWCOMPCOLOR = $00000008; |
||
| 318 | SSF_SORTCOLUMNS = $00000010; |
||
| 319 | SSF_SHOWSYSFILES = $00000020; |
||
| 320 | SSF_DOUBLECLICKINWEBVIEW = $00000080; |
||
| 321 | SSF_SHOWATTRIBCOL = $00000100; |
||
| 322 | SSF_DESKTOPHTML = $00000200; |
||
| 323 | SSF_WIN95CLASSIC = $00000400; |
||
| 324 | SSF_DONTPRETTYPATH = $00000800; |
||
| 325 | SSF_SHOWINFOTIP = $00002000; |
||
| 326 | SSF_MAPNETDRVBUTTON = $00001000; |
||
| 327 | SSF_NOCONFIRMRECYCLE = $00008000; |
||
| 328 | SSF_HIDEICONS = $00004000; |
||
| 329 | SSF_FILTER = $00010000; |
||
| 330 | SSF_WEBVIEW = $00020000; |
||
| 331 | SSF_SHOWSUPERHIDDEN = $00040000; |
||
| 332 | SSF_SEPPROCESS = $00080000; |
||
| 333 | SSF_NONETCRAWLING = $00100000; |
||
| 334 | SSF_STARTPANELON = $00200000; |
||
| 335 | SSF_SHOWSTARTPAGE = $00400000; |
||
| 336 | {$ENDREGION} |
||
| 337 | |||
| 338 | resourcestring |
||
| 339 | LNG_API_CALL_ERROR = 'Error while calling the API. Additional information: "%s".'; |
||
| 340 | LNG_NOT_CALLABLE = '%s not callable'; |
||
| 341 | LNG_ERROR_CODE = '%s (Arguments: %s) returns error code %s'; |
||
| 342 | LNG_FILE_NOT_FOUND = 'File not found: %s'; |
||
| 343 | LNG_INVALID_INFO_FORMAT = 'Is not INFO or INFO2: %s'; |
||
| 344 | LNG_DRIVE_NOT_EXISTING = 'Drive %s does not exist.'; |
||
| 345 | |||
| 346 | const |
||
| 347 | C_SHQueryRecycleBin = 'SHQueryRecycleBinA'; |
||
| 348 | C_GetVolumeNameForVolumeMountPoint = 'GetVolumeNameForVolumeMountPointA'; |
||
| 349 | C_SHEmptyRecycleBinA = 'SHEmptyRecycleBinA'; |
||
| 350 | C_SHGetSettings = 'SHGetSettings'; |
||
| 351 | C_SHGetSetSettings = 'SHGetSetSettings'; |
||
| 352 | |||
| 353 | type |
||
| 354 | TSHQueryRecycleBin = function(pszRootPath: LPCTSTR; var pSHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall; |
||
| 355 | TGetVolumeNameForVolumeMountPoint = function(lpszVolumeMountPoint: LPCTSTR; lpszVolumeName: LPTSTR; cchBufferLength: DWORD): BOOL; stdcall; |
||
| 356 | TSHEmptyRecycleBin = function(Wnd: HWND; pszRootPath: PChar; dwFlags: DWORD): HRESULT; stdcall; |
||
| 357 | TSHGetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD) stdcall; |
||
| 358 | TSHGetSetSettings = procedure(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL) stdcall; |
||
| 359 | |||
| 360 | function GetDriveGUID(driveLetter: Char; var guid: TGUID): DWORD; |
||
| 361 | var |
||
| 362 | Buffer: array[0..50] of AnsiChar; |
||
| 363 | x: string; |
||
| 364 | PGetVolumeNameForVolumeMountPoint: TGetVolumeNameForVolumeMountPoint; |
||
| 365 | RBHandle: THandle; |
||
| 366 | begin |
||
| 367 | RBHandle := LoadLibrary(kernel32); |
||
| 368 | try |
||
| 369 | if RBHandle <> 0 then |
||
| 370 | begin |
||
| 371 | PGetVolumeNameForVolumeMountPoint := GetProcAddress(RBHandle, C_GetVolumeNameForVolumeMountPoint); |
||
| 372 | if not Assigned(@PGetVolumeNameForVolumeMountPoint) then |
||
| 373 | begin |
||
| 374 | result := GetLastError; |
||
| 375 | FreeLibrary(RBHandle); |
||
| 376 | RBHandle := 0; |
||
| 377 | end |
||
| 378 | else |
||
| 379 | begin |
||
| 380 | if PGetVolumeNameForVolumeMountPoint(PAnsiChar(driveLetter+':\'), Buffer, SizeOf(Buffer)) then |
||
| 381 | begin |
||
| 382 | x := buffer; |
||
| 383 | x := copy(x, 11, 38); |
||
| 384 | guid := StringToGUID(x); |
||
| 385 | result := ERROR_SUCCESS; |
||
| 386 | end |
||
| 387 | else |
||
| 388 | result := GetLastError; |
||
| 389 | end; |
||
| 390 | end |
||
| 391 | else result := GetLastError; |
||
| 392 | finally |
||
| 393 | if RBHandle <> 0 then FreeLibrary(RBHandle); |
||
| 394 | end; |
||
| 395 | end; |
||
| 396 | |||
| 397 | function FileTimeToDateTime(FileTime: FILETIME): TDateTime; |
||
| 398 | {$IFDEF FILETIME_DELPHI_CODE} |
||
| 399 | var |
||
| 400 | SystemTime: TSystemTime; |
||
| 401 | nowUTC: TDateTime; |
||
| 402 | gmtDifference: int64; |
||
| 403 | begin |
||
| 404 | GetSystemTime(SystemTime); |
||
| 405 | with SystemTime do |
||
| 406 | begin |
||
| 407 | // http://www.delphipraxis.net/post340194.html#34019 |
||
| 408 | nowUTC := EncodeDate(wYear, wMonth, wDay) + |
||
| 409 | EncodeTime(wHour, wMinute, wSecond, wMilliseconds); |
||
| 410 | end; |
||
| 411 | |||
| 412 | gmtDifference := datetimetounix(nowUTC) - datetimetounix(Now); |
||
| 413 | |||
| 414 | // http://www.e-fense.com/helix/Docs/Recycler_Bin_Record_Reconstruction.pdf states: |
||
| 415 | // UnixTime = 0.0000001 * NTTime + 11644473600 |
||
| 416 | // This is wrong! The correct formula is: |
||
| 417 | // UnixTime = 0.0000001 * NTTime - 11644473600 + c * 3600 |
||
| 418 | // c = GMT-Difference (MEZ = 1) inclusive daylight saving time (+3600 seconds) |
||
| 419 | result := unixtodatetime(round(0.0000001 * int64(FileTime)) - 11644473600 - gmtDifference); |
||
| 420 | {$ELSE} |
||
| 421 | var |
||
| 422 | LocalTime: TFileTime; |
||
| 423 | DOSTime: Integer; |
||
| 424 | begin |
||
| 425 | FileTimeToLocalFileTime(FileTime, LocalTime); |
||
| 426 | FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo); |
||
| 427 | Result := FileDateToDateTime(DOSTime); |
||
| 428 | {$ENDIF} |
||
| 429 | end; |
||
| 430 | |||
| 431 | function DeleteDirectory(const Name: string): boolean; |
||
| 432 | var |
||
| 433 | F: TSearchRec; |
||
| 434 | begin |
||
| 435 | result := true; |
||
| 436 | if FindFirst(IncludeTrailingPathDelimiter(Name) + '*', faAnyFile, F) = 0 then |
||
| 437 | begin |
||
| 438 | try |
||
| 439 | repeat |
||
| 440 | if F.Attr and faDirectory <> 0 then |
||
| 441 | begin |
||
| 442 | if (F.Name <> '.') and (F.Name <> '..') then |
||
| 443 | begin |
||
| 444 | result := result and DeleteDirectory(IncludeTrailingPathDelimiter(Name) + F.Name); |
||
| 445 | end; |
||
| 446 | end |
||
| 447 | else |
||
| 448 | begin |
||
| 449 | if not DeleteFile(IncludeTrailingPathDelimiter(Name) + F.Name) then result := false; |
||
| 450 | end; |
||
| 451 | until FindNext(F) <> 0; |
||
| 452 | finally |
||
| 453 | FindClose(F); |
||
| 454 | end; |
||
| 455 | if not RemoveDir(Name) then result := false; |
||
| 456 | end; |
||
| 457 | end; |
||
| 458 | |||
| 459 | function DriveLetterToDriveNumber(driveLetter: Char): integer; |
||
| 460 | var |
||
| 461 | tmp: string; |
||
| 462 | begin |
||
| 463 | tmp := LowerCase(driveLetter); |
||
| 464 | result := Ord(tmp[1])-Ord('a'); |
||
| 465 | end; |
||
| 466 | |||
| 467 | function GetStringFromDLL(filename: string; num: integer): string; |
||
| 468 | const |
||
| 469 | // Source: http://www.eggheadcafe.com/forumarchives/vcmfc/sep2005/post23917443.asp |
||
| 470 | MAX_BUF = 4097; // OK? |
||
| 471 | var |
||
| 472 | hLib: THandle; |
||
| 473 | buf: array[0..MAX_BUF] of char; |
||
| 474 | begin |
||
| 475 | hLib := LoadLibrary(PChar(filename)); |
||
| 476 | try |
||
| 477 | LoadString(hLib, num, buf, sizeof(buf)); |
||
| 478 | result := buf; |
||
| 479 | finally |
||
| 480 | FreeLibrary(hLib); |
||
| 481 | end; |
||
| 482 | end; |
||
| 483 | |||
| 484 | function ExpandEnvStr(const szInput: string): string; |
||
| 485 | const |
||
| 486 | MAXSIZE = 32768; // laut PSDK sind 32k das Maximum |
||
| 487 | begin |
||
| 488 | // Source: http://www.delphi-library.de/topic_Umgebungsvariable+in+einem+String+aufloesen_20516,0.html |
||
| 489 | SetLength(Result,MAXSIZE); |
||
| 490 | SetLength(Result,ExpandEnvironmentStrings(pchar(szInput), |
||
| 491 | @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen |
||
| 492 | end; |
||
| 493 | |||
| 494 | function DecodeReferenceString(s: string): string; |
||
| 495 | var |
||
| 496 | dll, id, lang, cache: string; |
||
| 497 | sl, sl2: tstringlist; |
||
| 498 | begin |
||
| 499 | // Beispiele |
||
| 500 | // Papierkorb -- Windows 95 |
||
| 501 | // @C:\WINNT\system32\shell32.dll,-8964@1031,Papierkorb -- Windows 2000 |
||
| 502 | |||
| 503 | if Copy(s, 1, 1) = '@' then |
||
| 504 | begin |
||
| 505 | // Referenz auf eine DLL |
||
| 506 | // @<dll>,-<id>[@<lang>][,<cache>] |
||
| 507 | |||
| 508 | sl := TStringList.Create; |
||
| 509 | try |
||
| 510 | // '@' am Anfang entfernen |
||
| 511 | s := Copy(s, 2, length(s)-1); |
||
| 512 | |||
| 513 | // Nach ',' auftrennen |
||
| 514 | // sl[0] --> dll |
||
| 515 | // sl[1] --> -id@lang |
||
| 516 | // sl[2] --> cache |
||
| 517 | sl.CommaText := s; |
||
| 518 | |||
| 519 | if sl.Count > 2 then |
||
| 520 | begin |
||
| 521 | // Das Ergebnis ist bereits im Klartext vorhanden und muss nicht extrahiert werden |
||
| 522 | // Ist bei Windows 2000 der Fall |
||
| 523 | cache := sl[2]; |
||
| 524 | result := cache; |
||
| 525 | exit; |
||
| 526 | end; |
||
| 527 | |||
| 528 | if sl.Count > 1 then |
||
| 529 | begin |
||
| 530 | dll := sl[0]; |
||
| 531 | |||
| 532 | sl2 := TStringList.Create; |
||
| 533 | try |
||
| 534 | // Nach '@' auftrennen |
||
| 535 | // sl2[0] --> id |
||
| 536 | // sl2[1] --> lang |
||
| 537 | sl2.CommaText := StringReplace(sl[1], '@', ',', [rfReplaceAll]); |
||
| 538 | |||
| 539 | id := sl2[0]; |
||
| 540 | |||
| 541 | if sl2.Count > 1 then |
||
| 542 | begin |
||
| 543 | // ToDo: In Zukunft beachten, sofern möglich |
||
| 544 | lang := sl2[1]; |
||
| 545 | end; |
||
| 546 | |||
| 547 | // Umgebungsvariablen erkennen und Minuszeichen entfernen |
||
| 548 | result := GetStringFromDLL(ExpandEnvStr(dll), -StrToInt(id)); |
||
| 549 | finally |
||
| 550 | sl2.Free; |
||
| 551 | end; |
||
| 552 | end |
||
| 553 | else |
||
| 554 | begin |
||
| 555 | // Zu wenige Informationen! |
||
| 556 | |||
| 557 | result := ''; |
||
| 558 | end; |
||
| 559 | finally |
||
| 560 | sl.Free; |
||
| 561 | end; |
||
| 562 | end |
||
| 563 | else |
||
| 564 | begin |
||
| 565 | // Kein Hinweis auf eine Referenz |
||
| 566 | result := s; |
||
| 567 | end; |
||
| 568 | end; |
||
| 569 | |||
| 570 | function GPBoolToString(value: GPOLICYBOOL): string; |
||
| 571 | begin |
||
| 572 | case value of |
||
| 573 | gpUndefined: result := 'Not configured'; |
||
| 574 | gpEnabled: result := 'Enabled'; |
||
| 575 | gpDisabled: result := 'Disabled'; |
||
| 576 | end; |
||
| 577 | end; |
||
| 578 | |||
| 579 | { TRbRecycleBin } |
||
| 580 | |||
| 581 | constructor TRbRecycleBin.Create(AFileOrDirectory: string; ASID: string=''); |
||
| 582 | begin |
||
| 583 | inherited Create; |
||
| 584 | |||
| 585 | FFileOrDirectory := AFileOrDirectory; |
||
| 586 | FSID := ASID; |
||
| 587 | end; |
||
| 588 | |||
| 589 | // TODO: also a function that tests if the data files are still existing |
||
| 590 | function TRbRecycleBin.CheckIndexes(slErrors: TStrings): boolean; |
||
| 591 | |||
| 592 | procedure _Assert(assertion: boolean; msg: string; args: array of const); |
||
| 593 | begin |
||
| 594 | if not assertion then |
||
| 595 | begin |
||
| 596 | slErrors.Add(Format(msg, args)); |
||
| 597 | result := false; |
||
| 598 | end; |
||
| 599 | end; |
||
| 600 | |||
| 601 | procedure _HandleIndexFile(AFile: string); |
||
| 602 | var |
||
| 603 | fs: TFileStream; |
||
| 604 | infoHdr: TRbInfo12Header; |
||
| 605 | resourcestring |
||
| 606 | LNG_IDXERR_VISTA_FILESIZE = '%s: Vista index file has wrong size'; |
||
| 607 | LNG_IDXERR_INFO_RECSIZE_UNEXPECTED = '%s: record size unexpected'; |
||
| 608 | LNG_IDXERR_INFO_UNEXPECTED_EOF = '%s: file size wrong'; |
||
| 609 | begin |
||
| 610 | fs := TFileStream.Create(AFile, fmOpenRead); |
||
| 611 | try |
||
| 612 | fs.Seek(0, soFromBeginning); |
||
| 613 | |||
| 614 | // TODO: LNG_* |
||
| 615 | |||
| 616 | if SameText(copy(ExtractFileName(AFile), 1, 2), '$I') then |
||
| 617 | begin |
||
| 618 | _Assert(fs.Size = SizeOf(TRbVistaItem), LNG_IDXERR_VISTA_FILESIZE, [AFile]); |
||
| 619 | end |
||
| 620 | else if SameText(ExtractFileName(AFile), 'INFO') then |
||
| 621 | begin |
||
| 622 | fs.ReadBuffer(infoHdr, SizeOf(infoHdr)); |
||
| 623 | _Assert(infoHdr.recordLength = SizeOf(TRbInfoRecord), LNG_IDXERR_INFO_RECSIZE_UNEXPECTED, [AFile]); |
||
| 624 | _Assert((fs.Size-fs.Position) mod infoHdr.recordLength = 0, LNG_IDXERR_INFO_UNEXPECTED_EOF, [AFile]); |
||
| 625 | // TODO: we can also check infoHdr.totalSize |
||
| 626 | end |
||
| 627 | else if SameText(ExtractFileName(AFile), 'INFO2') then |
||
| 628 | begin |
||
| 629 | fs.ReadBuffer(infoHdr, SizeOf(infoHdr)); |
||
| 630 | _Assert(infoHdr.recordLength = SizeOf(TRbInfo2Record), LNG_IDXERR_INFO_RECSIZE_UNEXPECTED, [AFile]); |
||
| 631 | _Assert((fs.Size-fs.Position) mod infoHdr.recordLength = 0, LNG_IDXERR_INFO_UNEXPECTED_EOF, [AFile]); |
||
| 632 | end; |
||
| 633 | |||
| 634 | // TODO: we could check each item for invalid stuff...? |
||
| 635 | finally |
||
| 636 | FreeAndNil(fs); |
||
| 637 | end; |
||
| 638 | end; |
||
| 639 | |||
| 640 | procedure _HandleVistaDir(ADirectory: string); |
||
| 641 | var |
||
| 642 | SR: TSearchRec; |
||
| 643 | begin |
||
| 644 | ADirectory := IncludeTrailingPathDelimiter(ADirectory); |
||
| 645 | |||
| 646 | if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then |
||
| 647 | begin |
||
| 648 | repeat |
||
| 649 | _HandleIndexFile(ADirectory+sr.Name); |
||
| 650 | until FindNext(SR) <> 0; |
||
| 651 | end; |
||
| 652 | FindClose(SR); |
||
| 653 | end; |
||
| 654 | |||
| 655 | begin |
||
| 656 | result := true; |
||
| 657 | |||
| 658 | if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2 |
||
| 659 | begin |
||
| 660 | _HandleVistaDir(FFileOrDirectory); |
||
| 661 | |||
| 662 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then |
||
| 663 | begin |
||
| 664 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2'); |
||
| 665 | end; |
||
| 666 | |||
| 667 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then |
||
| 668 | begin |
||
| 669 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO'); |
||
| 670 | end; |
||
| 671 | end |
||
| 672 | else if FileExists(FFileOrDirectory) then |
||
| 673 | begin |
||
| 674 | _HandleIndexFile(FFileOrDirectory); |
||
| 675 | end |
||
| 676 | else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]); |
||
| 677 | end; |
||
| 678 | |||
| 679 | function TRbRecycleBin.GetItem(id: string): TRbRecycleBinItem; |
||
| 680 | |||
| 681 | procedure _HandleIndexFile(AFile: string); |
||
| 682 | var |
||
| 683 | fs: TFileStream; |
||
| 684 | infoHdr: TRbInfo12Header; |
||
| 685 | testItem: TRbRecycleBinItem; |
||
| 686 | begin |
||
| 687 | fs := TFileStream.Create(AFile, fmOpenRead); |
||
| 688 | try |
||
| 689 | fs.Seek(0, soFromBeginning); |
||
| 690 | |||
| 691 | if fs.Size = SizeOf(TRbVistaRecord) then |
||
| 692 | begin |
||
| 693 | if SameText(ExtractFileName(AFile), '$I'+id) then |
||
| 694 | begin |
||
| 695 | result := TRbVistaItem.Create(fs, AFile, id); |
||
| 696 | end; |
||
| 697 | end |
||
| 698 | else |
||
| 699 | begin |
||
| 700 | fs.ReadBuffer(infoHdr, SizeOf(infoHdr)); |
||
| 701 | case infoHdr.recordLength of |
||
| 702 | SizeOf(TRbInfoRecord): |
||
| 703 | begin |
||
| 704 | while fs.Position < fs.size do |
||
| 705 | begin |
||
| 706 | testItem := TRbInfo1Item.Create(fs, AFile); |
||
| 707 | if testItem.ID = id then |
||
| 708 | begin |
||
| 709 | result := testItem; |
||
| 710 | break; |
||
| 711 | end; |
||
| 712 | end; |
||
| 713 | end; |
||
| 714 | SizeOf(TRbInfo2Record): |
||
| 715 | begin |
||
| 716 | while fs.Position < fs.size do |
||
| 717 | begin |
||
| 718 | testItem := TRbInfo2Item.Create(fs, AFile); |
||
| 719 | if testItem.ID = id then |
||
| 720 | begin |
||
| 721 | result := testItem; |
||
| 722 | break; |
||
| 723 | end; |
||
| 724 | end; |
||
| 725 | end |
||
| 726 | else |
||
| 727 | begin |
||
| 728 | raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]); |
||
| 729 | end; |
||
| 730 | end; |
||
| 731 | end; |
||
| 732 | finally |
||
| 733 | FreeAndNil(fs); |
||
| 734 | end; |
||
| 735 | end; |
||
| 736 | |||
| 737 | procedure _HandleVistaDir(ADirectory: string); |
||
| 738 | var |
||
| 739 | SR: TSearchRec; |
||
| 740 | fs: TFileStream; |
||
| 741 | id: string; |
||
| 742 | begin |
||
| 743 | ADirectory := IncludeTrailingPathDelimiter(ADirectory); |
||
| 744 | |||
| 745 | if FileExists(ADirectory + '$I' + id) then |
||
| 746 | begin |
||
| 747 | fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead); |
||
| 748 | try |
||
| 749 | fs.Seek(0, soFromBeginning); |
||
| 750 | result := TRbVistaItem.Create(fs, ADirectory+sr.Name, id); |
||
| 751 | finally |
||
| 752 | FreeAndNil(fs); |
||
| 753 | end; |
||
| 754 | end; |
||
| 755 | end; |
||
| 756 | |||
| 757 | begin |
||
| 758 | result := nil; |
||
| 759 | |||
| 760 | if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2 |
||
| 761 | begin |
||
| 762 | _HandleVistaDir(FFileOrDirectory); |
||
| 763 | if Assigned(result) then exit; |
||
| 764 | |||
| 765 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then |
||
| 766 | begin |
||
| 767 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2'); |
||
| 768 | if Assigned(result) then exit; |
||
| 769 | end; |
||
| 770 | |||
| 771 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then |
||
| 772 | begin |
||
| 773 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO'); |
||
| 774 | if Assigned(result) then exit; |
||
| 775 | end; |
||
| 776 | end |
||
| 777 | else if FileExists(FFileOrDirectory) then |
||
| 778 | begin |
||
| 779 | _HandleIndexFile(FFileOrDirectory); |
||
| 780 | if Assigned(result) then exit; |
||
| 781 | end |
||
| 782 | else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]); |
||
| 783 | end; |
||
| 784 | |||
| 785 | procedure TRbRecycleBin.ListItems(list: TObjectList{TRbRecycleBinItem}); |
||
| 786 | |||
| 787 | procedure _HandleIndexFile(AFile: string); |
||
| 788 | var |
||
| 789 | fs: TFileStream; |
||
| 790 | infoHdr: TRbInfo12Header; |
||
| 791 | testID: string; |
||
| 792 | begin |
||
| 793 | fs := TFileStream.Create(AFile, fmOpenRead); |
||
| 794 | try |
||
| 795 | fs.Seek(0, soFromBeginning); |
||
| 796 | |||
| 797 | if fs.Size = SizeOf(TRbVistaRecord) then |
||
| 798 | begin |
||
| 799 | testID := ExtractFileName(AFile); |
||
| 800 | if SameText(copy(testID, 1, 2), '$I') then |
||
| 801 | testID := copy(testID, 3, Length(testID)-2) |
||
| 802 | else |
||
| 803 | testID := ''; |
||
| 804 | |||
| 805 | list.Add(TRbVistaItem.Create(fs, AFile, testID)); |
||
| 806 | end |
||
| 807 | else |
||
| 808 | begin |
||
| 809 | fs.ReadBuffer(infoHdr, SizeOf(infoHdr)); |
||
| 810 | case infoHdr.recordLength of |
||
| 811 | SizeOf(TRbInfoRecord): |
||
| 812 | begin |
||
| 813 | while fs.Position < fs.size do |
||
| 814 | begin |
||
| 815 | list.Add(TRbInfo1Item.Create(fs, AFile)); |
||
| 816 | end; |
||
| 817 | end; |
||
| 818 | SizeOf(TRbInfo2Record): |
||
| 819 | begin |
||
| 820 | while fs.Position < fs.size do |
||
| 821 | begin |
||
| 822 | list.Add(TRbInfo2Item.Create(fs, AFile)); |
||
| 823 | end; |
||
| 824 | end |
||
| 825 | else |
||
| 826 | begin |
||
| 827 | raise Exception.CreateFmt(LNG_INVALID_INFO_FORMAT, [AFile]); |
||
| 828 | end; |
||
| 829 | end; |
||
| 830 | end; |
||
| 831 | finally |
||
| 832 | FreeAndNil(fs); |
||
| 833 | end; |
||
| 834 | end; |
||
| 835 | |||
| 836 | procedure _HandleVistaDir(ADirectory: string); |
||
| 837 | var |
||
| 838 | SR: TSearchRec; |
||
| 839 | fs: TFileStream; |
||
| 840 | id: string; |
||
| 841 | begin |
||
| 842 | ADirectory := IncludeTrailingPathDelimiter(ADirectory); |
||
| 843 | |||
| 844 | if FindFirst(ADirectory + '$I*', faAnyFile, SR) = 0 then |
||
| 845 | begin |
||
| 846 | repeat |
||
| 847 | id := sr.Name; |
||
| 848 | { id := ChangeFileExt(id, ''); } // Removed code: We keep the file extention as part of the ID, because we do not know if the ID is otherwise unique |
||
| 849 | id := Copy(id, 3, Length(id)-2); |
||
| 850 | |||
| 851 | fs := TFileStream.Create(ADirectory+sr.Name, fmOpenRead); |
||
| 852 | try |
||
| 853 | fs.Seek(0, soFromBeginning); |
||
| 854 | list.Add(TRbVistaItem.Create(fs, ADirectory+sr.Name, id)); |
||
| 855 | finally |
||
| 856 | FreeAndNil(fs); |
||
| 857 | end; |
||
| 858 | until FindNext(SR) <> 0; |
||
| 859 | end; |
||
| 860 | FindClose(SR); |
||
| 861 | end; |
||
| 862 | |||
| 863 | begin |
||
| 864 | if DirectoryExists(FFileOrDirectory) then // Vista, as well as directories with INFO and INFO2 |
||
| 865 | begin |
||
| 866 | _HandleVistaDir(FFileOrDirectory); |
||
| 867 | |||
| 868 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2') then |
||
| 869 | begin |
||
| 870 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO2'); |
||
| 871 | end; |
||
| 872 | |||
| 873 | if FileExists(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO') then |
||
| 874 | begin |
||
| 875 | _HandleIndexFile(IncludeTrailingPathDelimiter(FFileOrDirectory) + 'INFO'); |
||
| 876 | end; |
||
| 877 | end |
||
| 878 | else if FileExists(FFileOrDirectory) then |
||
| 879 | begin |
||
| 880 | _HandleIndexFile(FFileOrDirectory); |
||
| 881 | end |
||
| 882 | else raise Exception.CreateFmt(LNG_FILE_NOT_FOUND, [FFileOrDirectory]); |
||
| 883 | end; |
||
| 884 | |||
| 885 | { TRbDrive } |
||
| 886 | |||
| 887 | procedure TRbDrive.CheckDriveExisting; |
||
| 888 | begin |
||
| 889 | // Does the drive exist? |
||
| 890 | // see http://www.delphipraxis.net/post2933.html |
||
| 891 | if not GetLogicalDrives and (1 shl DriveLetterToDriveNumber(FDriveLetter)) <> 0 then |
||
| 892 | begin |
||
| 893 | raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(FDriveLetter)+':']); |
||
| 894 | end; |
||
| 895 | end; |
||
| 896 | |||
| 897 | constructor TRbDrive.Create(ADriveLetter: Char); |
||
| 898 | begin |
||
| 899 | inherited Create; |
||
| 900 | |||
| 901 | FDriveLetter := ADriveLetter; |
||
| 902 | CheckDriveExisting; |
||
| 903 | end; |
||
| 904 | |||
| 905 | function TRbDrive.GetAPIInfo: TSHQueryRBInfo; |
||
| 906 | var |
||
| 907 | PSHQueryRecycleBin: TSHQueryRecycleBin; |
||
| 908 | RBHandle: THandle; |
||
| 909 | res: HRESULT; |
||
| 910 | Path: string; |
||
| 911 | begin |
||
| 912 | Path := FDriveLetter + ':\'; |
||
| 913 | |||
| 914 | // Ref: http://www.delphipraxis.net/post1291.html |
||
| 915 | |||
| 916 | RBHandle := LoadLibrary(shell32); |
||
| 917 | try |
||
| 918 | PSHQueryRecycleBin := nil; |
||
| 919 | if RBHandle <> 0 then |
||
| 920 | begin |
||
| 921 | PSHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin); |
||
| 922 | if not Assigned(@PSHQueryRecycleBin) then |
||
| 923 | begin |
||
| 924 | FreeLibrary(RBHandle); |
||
| 925 | RBHandle := 0; |
||
| 926 | end; |
||
| 927 | end; |
||
| 928 | |||
| 929 | FillChar(result, SizeOf(TSHQueryRBInfo), 0); |
||
| 930 | result.cbSize := SizeOf(TSHQueryRBInfo); |
||
| 931 | |||
| 932 | if (RBHandle <> 0) and Assigned(PSHQueryRecycleBin) then |
||
| 933 | begin |
||
| 934 | res := PSHQueryRecycleBin(PChar(Path), result); |
||
| 935 | // if Succeeded(res) then |
||
| 936 | if res = S_OK then |
||
| 937 | begin |
||
| 938 | // Alles OK, unser result hat nun die gewünschten Daten. |
||
| 939 | end |
||
| 940 | else |
||
| 941 | begin |
||
| 942 | // Since Windows Vista, SHQueryRecycleBin will fail with E_FAIL (80004005) |
||
| 943 | // if Path is a floppy or CD drive... |
||
| 944 | raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_ERROR_CODE, [C_SHQueryRecycleBin, Path, '0x'+IntToHex(res, 2*SizeOf(HRESULT))])]); |
||
| 945 | end; |
||
| 946 | end |
||
| 947 | else |
||
| 948 | raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHQueryRecycleBin])]); |
||
| 949 | finally |
||
| 950 | if RBHandle <> 0 then FreeLibrary(RBHandle); |
||
| 951 | end; |
||
| 952 | end; |
||
| 953 | |||
| 954 | function TRbDrive.GetMaxPercentUsage: integer; |
||
| 955 | var |
||
| 956 | reg: TRegistry; |
||
| 957 | purgeInfo: TRbWin95PurgeInfo; |
||
| 958 | const |
||
| 959 | RES_DEFAULT = 10; // Windows 95 - Standardwert |
||
| 960 | begin |
||
| 961 | result := RES_DEFAULT; |
||
| 962 | |||
| 963 | reg := TRegistry.Create; |
||
| 964 | try |
||
| 965 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 966 | |||
| 967 | // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden. |
||
| 968 | // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt. |
||
| 969 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then |
||
| 970 | begin |
||
| 971 | if reg.OpenKeyReadOnly(FDriveLetter) then |
||
| 972 | begin |
||
| 973 | if reg.ValueExists('Percent') then |
||
| 974 | begin |
||
| 975 | // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry |
||
| 976 | |||
| 977 | result := reg.ReadInteger('Percent'); |
||
| 978 | end; |
||
| 979 | end |
||
| 980 | else |
||
| 981 | begin |
||
| 982 | if reg.ValueExists('PurgeInfo') then |
||
| 983 | begin |
||
| 984 | // Windows 95 - Kodierte Informationen liegen in PurgeInfo |
||
| 985 | |||
| 986 | reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo)); |
||
| 987 | |||
| 988 | result := purgeInfo.percentDrive[FDriveLetter]; |
||
| 989 | end; |
||
| 990 | end; |
||
| 991 | |||
| 992 | reg.CloseKey; |
||
| 993 | end; |
||
| 994 | finally |
||
| 995 | reg.Free; |
||
| 996 | end; |
||
| 997 | end; |
||
| 998 | |||
| 999 | function TRbDrive.RecyclerGetPercentUsageAutoDeterminate: integer; |
||
| 1000 | var |
||
| 1001 | gpSetting: integer; |
||
| 1002 | begin |
||
| 1003 | gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize; |
||
| 1004 | if gpSetting <> -1 then |
||
| 1005 | result := gpSetting |
||
| 1006 | else if TRecycleBinManager.UsesGlobalSettings then |
||
| 1007 | result := TRecycleBinManager.GetGlobalMaxPercentUsage |
||
| 1008 | else |
||
| 1009 | result := GetMaxPercentUsage; |
||
| 1010 | end; |
||
| 1011 | |||
| 1012 | function TRbDrive.RecyclerIsNukeOnDeleteAutoDeterminate: boolean; |
||
| 1013 | begin |
||
| 1014 | if TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles = gpEnabled then |
||
| 1015 | result := true |
||
| 1016 | else if TRecycleBinManager.UsesGlobalSettings then |
||
| 1017 | result := TRecycleBinManager.GetGlobalNukeOnDelete |
||
| 1018 | else |
||
| 1019 | result := GetNukeOnDelete; |
||
| 1020 | end; |
||
| 1021 | |||
| 1022 | function TRbDrive.GetNukeOnDelete: boolean; |
||
| 1023 | var |
||
| 1024 | reg: TRegistry; |
||
| 1025 | purgeInfo: TRbWin95PurgeInfo; |
||
| 1026 | const |
||
| 1027 | RES_DEFAULT = false; // Windows 95 - Standardwert |
||
| 1028 | begin |
||
| 1029 | result := RES_DEFAULT; |
||
| 1030 | |||
| 1031 | reg := TRegistry.Create; |
||
| 1032 | try |
||
| 1033 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1034 | |||
| 1035 | // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden. |
||
| 1036 | // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt. |
||
| 1037 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then |
||
| 1038 | begin |
||
| 1039 | if reg.OpenKeyReadOnly(FDriveLetter) then |
||
| 1040 | begin |
||
| 1041 | if reg.ValueExists('NukeOnDelete') then |
||
| 1042 | begin |
||
| 1043 | // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry |
||
| 1044 | |||
| 1045 | result := reg.ReadBool('NukeOnDelete'); |
||
| 1046 | end; |
||
| 1047 | end |
||
| 1048 | else |
||
| 1049 | begin |
||
| 1050 | if reg.ValueExists('PurgeInfo') then |
||
| 1051 | begin |
||
| 1052 | // Windows 95 - Kodierte Informationen liegen in PurgeInfo |
||
| 1053 | |||
| 1054 | reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo)); |
||
| 1055 | |||
| 1056 | result := ((purgeInfo.NukeOnDeleteBits shr DriveLetterToDriveNumber(FDriveLetter)) and 1) = 1; |
||
| 1057 | end; |
||
| 1058 | end; |
||
| 1059 | |||
| 1060 | reg.CloseKey; |
||
| 1061 | end; |
||
| 1062 | finally |
||
| 1063 | reg.Free; |
||
| 1064 | end; |
||
| 1065 | end; |
||
| 1066 | |||
| 1067 | function TRbDrive.GetNumItems: int64; |
||
| 1068 | begin |
||
| 1069 | result := GetAPIInfo.i64NumItems; |
||
| 1070 | end; |
||
| 1071 | |||
| 1072 | function TRbDrive.GetSize: int64; |
||
| 1073 | begin |
||
| 1074 | result := GetAPIInfo.i64Size; |
||
| 1075 | end; |
||
| 1076 | |||
| 1077 | function TRbDrive.GetVolumeGUID: TGUID; |
||
| 1078 | begin |
||
| 1079 | if GetDriveGUID(FDriveLetter, result) <> ERROR_SUCCESS then |
||
| 1080 | begin |
||
| 1081 | result := NULL_GUID; |
||
| 1082 | end; |
||
| 1083 | end; |
||
| 1084 | |||
| 1085 | function TRbDrive.IsEmpty: boolean; |
||
| 1086 | begin |
||
| 1087 | result := GetNumItems = 0; |
||
| 1088 | end; |
||
| 1089 | |||
| 1090 | function TRbDrive.IsFAT: boolean; |
||
| 1091 | var |
||
| 1092 | Dummy2: DWORD; |
||
| 1093 | Dummy3: DWORD; |
||
| 1094 | FileSystem: array[0..MAX_PATH] of char; |
||
| 1095 | VolumeName: array[0..MAX_PATH] of char; |
||
| 1096 | s: string; |
||
| 1097 | begin |
||
| 1098 | s := FDriveLetter + DriveDelim + PathDelim; // ohne die Auslagerung in einen String kommt es zu einer AV in ntdll |
||
| 1099 | GetVolumeInformation(PChar(s), VolumeName, |
||
| 1100 | SizeOf(VolumeName), nil, Dummy2, Dummy3, FileSystem, SizeOf(FileSystem)); |
||
| 1101 | result := uppercase(copy(FileSystem, 0, 3)) = 'FAT'; |
||
| 1102 | end; |
||
| 1103 | |||
| 1104 | procedure TRbDrive.ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string=''); |
||
| 1105 | |||
| 1106 | procedure _AddSIDFolders(dir: string; wholeFolder: boolean); |
||
| 1107 | var |
||
| 1108 | SR: TSearchRec; |
||
| 1109 | begin |
||
| 1110 | dir := IncludeTrailingPathDelimiter(dir); |
||
| 1111 | if FindFirst(dir+'S-*', faAnyFile, SR) = 0 then |
||
| 1112 | begin |
||
| 1113 | try |
||
| 1114 | repeat |
||
| 1115 | if (SR.Name = '.') or (SR.Name = '..') or not DirectoryExists(dir + SR.Name) then continue; |
||
| 1116 | |||
| 1117 | if wholeFolder then |
||
| 1118 | begin |
||
| 1119 | // Vista |
||
| 1120 | list.Add(TRbRecycleBin.Create(dir+SR.Name, SR.Name)); |
||
| 1121 | end |
||
| 1122 | else |
||
| 1123 | begin |
||
| 1124 | // Win95 .. WinXP |
||
| 1125 | if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2') then |
||
| 1126 | list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO2', SR.Name)); |
||
| 1127 | if FileExists(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO') then |
||
| 1128 | list.Add(TRbRecycleBin.Create(IncludeTrailingPathDelimiter(dir+SR.Name) + 'INFO', SR.Name)); |
||
| 1129 | end; |
||
| 1130 | until FindNext(SR) <> 0; |
||
| 1131 | finally |
||
| 1132 | FindClose(SR); |
||
| 1133 | end; |
||
| 1134 | end; |
||
| 1135 | end; |
||
| 1136 | |||
| 1137 | var |
||
| 1138 | dir: string; |
||
| 1139 | begin |
||
| 1140 | // Find recyclers from Windows Vista or higher |
||
| 1141 | |||
| 1142 | if IsFAT then |
||
| 1143 | begin |
||
| 1144 | dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim; |
||
| 1145 | if DirectoryExists(dir) then |
||
| 1146 | begin |
||
| 1147 | list.Add(TRbRecycleBin.Create(dir)); |
||
| 1148 | end; |
||
| 1149 | end |
||
| 1150 | else |
||
| 1151 | begin |
||
| 1152 | if UserSID <> '' then |
||
| 1153 | begin |
||
| 1154 | dir := FDriveLetter + DriveDelim + PathDelim + '$recycle.bin' + PathDelim + UserSID + PathDelim; |
||
| 1155 | if DirectoryExists(dir) then |
||
| 1156 | begin |
||
| 1157 | list.Add(TRbRecycleBin.Create(dir, UserSID)); |
||
| 1158 | end; |
||
| 1159 | end |
||
| 1160 | else |
||
| 1161 | begin |
||
| 1162 | _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + '$recycle.bin', true); |
||
| 1163 | end; |
||
| 1164 | end; |
||
| 1165 | |||
| 1166 | // Find recyclers from Windows before Vista |
||
| 1167 | |||
| 1168 | if IsFAT then |
||
| 1169 | begin |
||
| 1170 | dir := FDriveLetter + DriveDelim + PathDelim + 'Recycled' + PathDelim; |
||
| 1171 | |||
| 1172 | // Both "recycle bins" are possible if you have multiboot (but do overwrite themselfes if you empty them) |
||
| 1173 | if FileExists(dir + 'INFO2') then |
||
| 1174 | list.Add(TRbRecycleBin.Create(dir + 'INFO2')); // Windows 95 with Internet Explorer 4 Extension or higher Windows versions |
||
| 1175 | if FileExists(dir + 'INFO') then |
||
| 1176 | list.Add(TRbRecycleBin.Create(dir + 'INFO')); // Windows 95 native |
||
| 1177 | end |
||
| 1178 | else |
||
| 1179 | begin |
||
| 1180 | if UserSID <> '' then |
||
| 1181 | begin |
||
| 1182 | dir := FDriveLetter + DriveDelim + PathDelim + 'Recycler' + PathDelim + UserSID + PathDelim; |
||
| 1183 | |||
| 1184 | if FileExists(dir + 'INFO2') then |
||
| 1185 | list.Add(TRbRecycleBin.Create(dir + 'INFO2', UserSID)); |
||
| 1186 | if FileExists(dir + 'INFO') then |
||
| 1187 | list.Add(TRbRecycleBin.Create(dir + 'INFO', UserSID)); // Windows NT 4 |
||
| 1188 | end |
||
| 1189 | else |
||
| 1190 | begin |
||
| 1191 | _AddSIDFolders(FDriveLetter + DriveDelim + PathDelim + 'Recycler', false); |
||
| 1192 | end; |
||
| 1193 | end; |
||
| 1194 | end; |
||
| 1195 | |||
| 1196 | { TRbInfo1Item } |
||
| 1197 | |||
| 1198 | procedure TRbInfo1Item.ReadFromStream(stream: TStream); |
||
| 1199 | var |
||
| 1200 | r: TRbInfoRecord; |
||
| 1201 | begin |
||
| 1202 | stream.ReadBuffer(r, SizeOf(r)); |
||
| 1203 | |||
| 1204 | FSourceDrive := Chr(Ord('A') + r.sourceDrive); |
||
| 1205 | |||
| 1206 | // This behavior will probably only happen with INFO2 files. Just to be sure, |
||
| 1207 | // we will also include the code here. |
||
| 1208 | if r.sourceAnsi[0] = #0 then |
||
| 1209 | begin |
||
| 1210 | FRemovedEntry := true; |
||
| 1211 | r.sourceAnsi[0] := FSourceDrive; |
||
| 1212 | end; |
||
| 1213 | |||
| 1214 | FSourceAnsi := r.sourceAnsi; |
||
| 1215 | FSourceUnicode := r.sourceAnsi; // Unicode does not exist in INFO(1) structure |
||
| 1216 | FID := IntToStr(r.recordNumber); |
||
| 1217 | FDeletionTime := FileTimeToDateTime(r.deletionTime); |
||
| 1218 | FOriginalSize := r.originalSize; |
||
| 1219 | end; |
||
| 1220 | |||
| 1221 | function TRbInfo1Item.DeleteFile: boolean; |
||
| 1222 | var |
||
| 1223 | r: string; |
||
| 1224 | begin |
||
| 1225 | r := GetPhysicalFile; |
||
| 1226 | if DirectoryExists(r) then |
||
| 1227 | result := DeleteDirectory(r) // Usually, the old recycle bin does not allow folders. Just to be sure, we include the code. |
||
| 1228 | else |
||
| 1229 | result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung? --> Win95: Funktioniert |
||
| 1230 | |||
| 1231 | // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Datei neu schreiben) |
||
| 1232 | end; |
||
| 1233 | |||
| 1234 | function TRbInfo1Item.GetPhysicalFile: string; |
||
| 1235 | begin |
||
| 1236 | if FRemovedEntry then |
||
| 1237 | begin |
||
| 1238 | result := ''; |
||
| 1239 | Exit; |
||
| 1240 | end; |
||
| 1241 | |||
| 1242 | // e.g. C:\...\DC0.doc |
||
| 1243 | result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) + |
||
| 1244 | 'D' + SourceDrive + ID + ExtractFileExt(SourceAnsi); |
||
| 1245 | end; |
||
| 1246 | |||
| 1247 | constructor TRbInfo1Item.Create(fs: TStream; AIndexFile: string); |
||
| 1248 | begin |
||
| 1249 | inherited Create; |
||
| 1250 | ReadFromStream(fs); |
||
| 1251 | FIndexFile := AIndexFile; |
||
| 1252 | end; |
||
| 1253 | |||
| 1254 | { TRbInfo2Item } |
||
| 1255 | |||
| 1256 | procedure TRbInfo2Item.ReadFromStream(stream: TStream); |
||
| 1257 | var |
||
| 1258 | r: TRbInfo2Record; |
||
| 1259 | begin |
||
| 1260 | stream.ReadBuffer(r, SizeOf(r)); |
||
| 1261 | |||
| 1262 | // Wenn ein Eintrag aus der INFO2 gelöscht wird, dann wird das erste Byte |
||
| 1263 | // von sourceAnsi auf Null gesetzt, damit die ganze INFO2 Datei nicht |
||
| 1264 | // ständig neu geschrieben werden muss. |
||
| 1265 | // Bei Win95/INFO wird der Eintrag komplett rausgelöscht und die INFO-Datei |
||
| 1266 | // daher neu geschrieben. |
||
| 1267 | // Wir lesen den Eintrag trotzdem, da unsere Software ja auch zu forensischen |
||
| 1268 | // Zwecken eingesetzt werden soll. |
||
| 1269 | if r.sourceAnsi[0] = #0 then |
||
| 1270 | begin |
||
| 1271 | FRemovedEntry := true; |
||
| 1272 | r.sourceAnsi[0] := AnsiChar(r.sourceUnicode[0]); |
||
| 1273 | end; |
||
| 1274 | |||
| 1275 | FSourceAnsi := r.sourceAnsi; |
||
| 1276 | FSourceUnicode := r.sourceUnicode; |
||
| 1277 | FID := IntToStr(r.recordNumber); |
||
| 1278 | FSourceDrive := Chr(Ord('A') + r.sourceDrive); |
||
| 1279 | FDeletionTime := FileTimeToDateTime(r.deletionTime); |
||
| 1280 | FOriginalSize := r.originalSize; |
||
| 1281 | end; |
||
| 1282 | |||
| 1283 | function TRbInfo2Item.DeleteFile: boolean; |
||
| 1284 | var |
||
| 1285 | r: string; |
||
| 1286 | begin |
||
| 1287 | r := GetPhysicalFile; |
||
| 1288 | if DirectoryExists(r) then |
||
| 1289 | result := DeleteDirectory(r) |
||
| 1290 | else |
||
| 1291 | result := SysUtils.DeleteFile(r); // TODO: geht das oder gibt es zugriffsverletzung? |
||
| 1292 | |||
| 1293 | // TODO: nun auch den eintrag aus der INFO-Datei rausschmeißen (Erstes Byte auf 0 setzen) |
||
| 1294 | end; |
||
| 1295 | |||
| 1296 | function TRbInfo2Item.GetPhysicalFile: string; |
||
| 1297 | begin |
||
| 1298 | if FRemovedEntry then |
||
| 1299 | begin |
||
| 1300 | result := ''; |
||
| 1301 | Exit; |
||
| 1302 | end; |
||
| 1303 | |||
| 1304 | // e.g. C:\...\DC0.doc |
||
| 1305 | result := IncludeTrailingPathDelimiter(ExtractFilePath(IndexFile)) + |
||
| 1306 | 'D' + SourceDrive + ID + ExtractFileExt(SourceUnicode); |
||
| 1307 | end; |
||
| 1308 | |||
| 1309 | constructor TRbInfo2Item.Create(fs: TStream; AIndexFile: string); |
||
| 1310 | begin |
||
| 1311 | inherited Create; |
||
| 1312 | ReadFromStream(fs); |
||
| 1313 | FIndexFile := AIndexFile; |
||
| 1314 | end; |
||
| 1315 | |||
| 1316 | { TRbVistaItem } |
||
| 1317 | |||
| 1318 | procedure TRbVistaItem.ReadFromStream(stream: TStream); |
||
| 1319 | var |
||
| 1320 | r: TRbVistaRecord; |
||
| 1321 | begin |
||
| 1322 | stream.ReadBuffer(r, SizeOf(r)); |
||
| 1323 | |||
| 1324 | FSourceAnsi := AnsiString(r.sourceUnicode); // Invalid chars are automatically converted into '?' |
||
| 1325 | FSourceUnicode := r.sourceUnicode; |
||
| 1326 | FID := ''; // will be added manually (at the constructor) |
||
| 1327 | FSourceDrive := AnsiChar(r.sourceUnicode[1]); |
||
| 1328 | FDeletionTime := FileTimeToDateTime(r.deletionTime); |
||
| 1329 | FOriginalSize := r.originalSize; |
||
| 1330 | end; |
||
| 1331 | |||
| 1332 | function TRbVistaItem.DeleteFile: boolean; |
||
| 1333 | var |
||
| 1334 | r: string; |
||
| 1335 | begin |
||
| 1336 | r := GetPhysicalFile; |
||
| 1337 | if DirectoryExists(r) then |
||
| 1338 | result := DeleteDirectory(r) |
||
| 1339 | else |
||
| 1340 | result := SysUtils.DeleteFile(r); |
||
| 1341 | |||
| 1342 | SysUtils.DeleteFile(FIndexFile); |
||
| 1343 | end; |
||
| 1344 | |||
| 1345 | function TRbVistaItem.GetPhysicalFile: string; |
||
| 1346 | begin |
||
| 1347 | result := FIndexFile; |
||
| 1348 | result := StringReplace(Result, '$I', '$R', [rfIgnoreCase]); |
||
| 1349 | end; |
||
| 1350 | |||
| 1351 | constructor TRbVistaItem.Create(fs: TStream; AIndexFile, AID: string); |
||
| 1352 | begin |
||
| 1353 | inherited Create; |
||
| 1354 | ReadFromStream(fs); |
||
| 1355 | FIndexFile := AIndexFile; |
||
| 1356 | FID := AID; |
||
| 1357 | end; |
||
| 1358 | |||
| 1359 | { TRecycleBinManager } |
||
| 1360 | |||
| 1361 | class function TRecycleBinManager.EmptyOwnRecyclers(flags: cardinal): boolean; |
||
| 1362 | var |
||
| 1363 | PSHEmptyRecycleBin: TSHEmptyRecycleBin; |
||
| 1364 | LibHandle: THandle; |
||
| 1365 | begin |
||
| 1366 | // Source: http://www.dsdt.info/tipps/?id=176 |
||
| 1367 | result := true; |
||
| 1368 | LibHandle := LoadLibrary(shell32); |
||
| 1369 | try |
||
| 1370 | if LibHandle <> 0 then |
||
| 1371 | begin |
||
| 1372 | @PSHEmptyRecycleBin := GetProcAddress(LibHandle, C_SHEmptyRecycleBinA); |
||
| 1373 | if @PSHEmptyRecycleBin <> nil then |
||
| 1374 | begin |
||
| 1375 | PSHEmptyRecycleBin(hInstance, nil, flags); |
||
| 1376 | end |
||
| 1377 | else |
||
| 1378 | result := false; |
||
| 1379 | end |
||
| 1380 | else |
||
| 1381 | result := false; |
||
| 1382 | finally |
||
| 1383 | @PSHEmptyRecycleBin := nil; |
||
| 1384 | if LibHandle <> 0 then FreeLibrary(LibHandle); |
||
| 1385 | end; |
||
| 1386 | end; |
||
| 1387 | |||
| 1388 | class function TRecycleBinManager.EmptyOwnRecyclers(sound, progress, confirmation: boolean): boolean; |
||
| 1389 | const |
||
| 1390 | SHERB_NOCONFIRMATION = $00000001; |
||
| 1391 | SHERB_NOPROGRESSUI = $00000002; |
||
| 1392 | SHERB_NOSOUND = $00000004; |
||
| 1393 | var |
||
| 1394 | flags: cardinal; |
||
| 1395 | begin |
||
| 1396 | flags := 0; |
||
| 1397 | |||
| 1398 | if not progress then |
||
| 1399 | flags := flags or SHERB_NOPROGRESSUI; |
||
| 1400 | if not confirmation then |
||
| 1401 | flags := flags or SHERB_NOCONFIRMATION; |
||
| 1402 | if not sound then |
||
| 1403 | flags := flags or SHERB_NOSOUND; |
||
| 1404 | |||
| 1405 | result := EmptyOwnRecyclers(flags); |
||
| 1406 | end; |
||
| 1407 | |||
| 1408 | class function TRecycleBinManager.GetGlobalMaxPercentUsage: integer; |
||
| 1409 | var |
||
| 1410 | reg: TRegistry; |
||
| 1411 | purgeInfo: TRbWin95PurgeInfo; |
||
| 1412 | const |
||
| 1413 | RES_DEFAULT = 10; // Windows 95 - Standardwert |
||
| 1414 | begin |
||
| 1415 | result := RES_DEFAULT; |
||
| 1416 | |||
| 1417 | reg := TRegistry.Create; |
||
| 1418 | try |
||
| 1419 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1420 | |||
| 1421 | // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden. |
||
| 1422 | // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt. |
||
| 1423 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then |
||
| 1424 | begin |
||
| 1425 | if reg.ValueExists('Percent') then |
||
| 1426 | begin |
||
| 1427 | // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry |
||
| 1428 | |||
| 1429 | result := reg.ReadInteger('Percent'); |
||
| 1430 | end |
||
| 1431 | else if reg.ValueExists('PurgeInfo') then |
||
| 1432 | begin |
||
| 1433 | // Windows 95 - Kodierte Informationen liegen in PurgeInfo |
||
| 1434 | |||
| 1435 | reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo)); |
||
| 1436 | result := purgeInfo.percentGlobal; |
||
| 1437 | end; |
||
| 1438 | |||
| 1439 | reg.CloseKey; |
||
| 1440 | end; |
||
| 1441 | finally |
||
| 1442 | reg.Free; |
||
| 1443 | end; |
||
| 1444 | end; |
||
| 1445 | |||
| 1446 | class function TRecycleBinManager.GetGlobalNukeOnDelete: boolean; |
||
| 1447 | var |
||
| 1448 | reg: TRegistry; |
||
| 1449 | purgeInfo: TRbWin95PurgeInfo; |
||
| 1450 | const |
||
| 1451 | RES_DEFAULT = false; // Windows 95 - Standardwert |
||
| 1452 | begin |
||
| 1453 | result := RES_DEFAULT; |
||
| 1454 | |||
| 1455 | reg := TRegistry.Create; |
||
| 1456 | try |
||
| 1457 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1458 | |||
| 1459 | // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden. |
||
| 1460 | // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt. |
||
| 1461 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then |
||
| 1462 | begin |
||
| 1463 | if reg.ValueExists('NukeOnDelete') then |
||
| 1464 | begin |
||
| 1465 | // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry |
||
| 1466 | |||
| 1467 | result := reg.ReadBool('NukeOnDelete'); |
||
| 1468 | end |
||
| 1469 | else if reg.ValueExists('PurgeInfo') then |
||
| 1470 | begin |
||
| 1471 | // Windows 95 - Kodierte Informationen liegen in PurgeInfo |
||
| 1472 | |||
| 1473 | reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo)); |
||
| 1474 | result := (purgeInfo.NukeOnDeleteBits and $8000000) = $8000000; // bit 27 |
||
| 1475 | end; |
||
| 1476 | |||
| 1477 | reg.CloseKey; |
||
| 1478 | end; |
||
| 1479 | finally |
||
| 1480 | reg.Free; |
||
| 1481 | end; |
||
| 1482 | end; |
||
| 1483 | |||
| 1484 | class function TRecycleBinManager.UsesGlobalSettings: boolean; |
||
| 1485 | var |
||
| 1486 | reg: TRegistry; |
||
| 1487 | purgeInfo: TRbWin95PurgeInfo; |
||
| 1488 | const |
||
| 1489 | RES_DEFAULT = true; // Windows 95 - Standardwert |
||
| 1490 | begin |
||
| 1491 | result := RES_DEFAULT; |
||
| 1492 | |||
| 1493 | reg := TRegistry.Create; |
||
| 1494 | try |
||
| 1495 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1496 | |||
| 1497 | // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden. |
||
| 1498 | // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt. |
||
| 1499 | if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then |
||
| 1500 | begin |
||
| 1501 | if reg.ValueExists('UseGlobalSettings') then |
||
| 1502 | begin |
||
| 1503 | // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry |
||
| 1504 | |||
| 1505 | result := reg.ReadBool('UseGlobalSettings'); |
||
| 1506 | end |
||
| 1507 | else if reg.ValueExists('PurgeInfo') then |
||
| 1508 | begin |
||
| 1509 | // Windows 95 - Kodierte Informationen liegen in PurgeInfo |
||
| 1510 | |||
| 1511 | reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo)); |
||
| 1512 | result := purgeInfo.bGlobalSettings; |
||
| 1513 | end; |
||
| 1514 | |||
| 1515 | reg.CloseKey; |
||
| 1516 | end; |
||
| 1517 | finally |
||
| 1518 | reg.Free; |
||
| 1519 | end; |
||
| 1520 | end; |
||
| 1521 | |||
| 1522 | class procedure TRecycleBinManager.ListDrives(list: TObjectList{TRbDrive}); |
||
| 1523 | var |
||
| 1524 | drive: Char; |
||
| 1525 | begin |
||
| 1526 | for drive := 'A' to 'Z' do |
||
| 1527 | if RecycleBinPossible(drive) then |
||
| 1528 | list.Add(TRbDrive.Create(drive)); |
||
| 1529 | end; |
||
| 1530 | |||
| 1531 | class function TRecycleBinManager.OwnRecyclersEmpty: boolean; |
||
| 1532 | var |
||
| 1533 | drives: TObjectList; |
||
| 1534 | i: integer; |
||
| 1535 | begin |
||
| 1536 | result := true; |
||
| 1537 | |||
| 1538 | drives := TObjectList.Create(true); |
||
| 1539 | try |
||
| 1540 | ListDrives(drives); |
||
| 1541 | for i := 0 to drives.Count - 1 do |
||
| 1542 | begin |
||
| 1543 | result := result and TRbDrive(drives.Items[i]).IsEmpty; |
||
| 1544 | if not result then break; |
||
| 1545 | end; |
||
| 1546 | finally |
||
| 1547 | drives.Free; |
||
| 1548 | end; |
||
| 1549 | end; |
||
| 1550 | |||
| 1551 | class function TRecycleBinManager.OwnRecyclersNumItems: int64; |
||
| 1552 | var |
||
| 1553 | drives: TObjectList; |
||
| 1554 | i: integer; |
||
| 1555 | begin |
||
| 1556 | result := 0; |
||
| 1557 | |||
| 1558 | drives := TObjectList.Create(true); |
||
| 1559 | try |
||
| 1560 | ListDrives(drives); |
||
| 1561 | for i := 0 to drives.Count - 1 do |
||
| 1562 | begin |
||
| 1563 | result := result + TRbDrive(drives.Items[i]).GetNumItems; |
||
| 1564 | end; |
||
| 1565 | finally |
||
| 1566 | drives.Free; |
||
| 1567 | end; |
||
| 1568 | end; |
||
| 1569 | |||
| 1570 | class function TRecycleBinManager.OwnRecyclersSize: int64; |
||
| 1571 | var |
||
| 1572 | drives: TObjectList; |
||
| 1573 | i: integer; |
||
| 1574 | begin |
||
| 1575 | result := 0; |
||
| 1576 | |||
| 1577 | drives := TObjectList.Create(true); |
||
| 1578 | try |
||
| 1579 | ListDrives(drives); |
||
| 1580 | for i := 0 to drives.Count - 1 do |
||
| 1581 | begin |
||
| 1582 | result := result + TRbDrive(drives.Items[i]).GetSize; |
||
| 1583 | end; |
||
| 1584 | finally |
||
| 1585 | drives.Free; |
||
| 1586 | end; |
||
| 1587 | end; |
||
| 1588 | |||
| 1589 | class function TRecycleBinManager.RecycleBinPossible(Drive: Char): boolean; |
||
| 1590 | var |
||
| 1591 | typ: Integer; |
||
| 1592 | begin |
||
| 1593 | // Does the drive exist? |
||
| 1594 | // see http://www.delphipraxis.net/post2933.html |
||
| 1595 | result := GetLogicalDrives and (1 shl DriveLetterToDriveNumber(Drive)) <> 0; |
||
| 1596 | if not result then exit; |
||
| 1597 | |||
| 1598 | // Is it a fixed drive? (Only they can have recycle bins) |
||
| 1599 | // TODO: is that correct, or can also have other drive types have recyclers? |
||
| 1600 | typ := GetDriveType(PChar(Drive + ':\')); |
||
| 1601 | result := typ = DRIVE_FIXED; |
||
| 1602 | end; |
||
| 1603 | |||
| 1604 | class function TRecycleBinManager.RecyclerGetCurrentIconString: string; |
||
| 1605 | begin |
||
| 1606 | if OwnRecyclersEmpty then |
||
| 1607 | result := RecyclerGetEmptyIconString |
||
| 1608 | else |
||
| 1609 | result := RecyclerGetFullIconString; |
||
| 1610 | end; |
||
| 1611 | |||
| 1612 | class function TRecycleBinManager.RecyclerGetDefaultIconString: string; |
||
| 1613 | var |
||
| 1614 | reg: TRegistry; |
||
| 1615 | begin |
||
| 1616 | // Please note: The "default" icon is not always the icon of the |
||
| 1617 | // current recycle bin in its current state (full, empty) |
||
| 1618 | // At Windows 95b, the registry value actually did change every time the |
||
| 1619 | // recycle bin state did change, but at Windows 2000 I could not see any |
||
| 1620 | // update, even after reboot. So, the registry value is possible fixed as |
||
| 1621 | // default = empty on newer OS versions. |
||
| 1622 | |||
| 1623 | reg := TRegistry.Create; |
||
| 1624 | try |
||
| 1625 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1626 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then |
||
| 1627 | begin |
||
| 1628 | result := reg.ReadString(''); |
||
| 1629 | reg.CloseKey; |
||
| 1630 | end; |
||
| 1631 | finally |
||
| 1632 | reg.Free; |
||
| 1633 | end; |
||
| 1634 | end; |
||
| 1635 | |||
| 1636 | class function TRecycleBinManager.RecyclerGetEmptyIconString: string; |
||
| 1637 | var |
||
| 1638 | reg: TRegistry; |
||
| 1639 | begin |
||
| 1640 | reg := TRegistry.Create; |
||
| 1641 | try |
||
| 1642 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1643 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then |
||
| 1644 | begin |
||
| 1645 | result := reg.ReadString('Empty'); |
||
| 1646 | reg.CloseKey; |
||
| 1647 | end; |
||
| 1648 | finally |
||
| 1649 | reg.Free; |
||
| 1650 | end; |
||
| 1651 | end; |
||
| 1652 | |||
| 1653 | class function TRecycleBinManager.RecyclerGetFullIconString: string; |
||
| 1654 | var |
||
| 1655 | reg: TRegistry; |
||
| 1656 | begin |
||
| 1657 | reg := TRegistry.Create; |
||
| 1658 | try |
||
| 1659 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1660 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)+'\DefaultIcon') then |
||
| 1661 | begin |
||
| 1662 | result := reg.ReadString('Full'); |
||
| 1663 | reg.CloseKey; |
||
| 1664 | end; |
||
| 1665 | finally |
||
| 1666 | reg.Free; |
||
| 1667 | end; |
||
| 1668 | end; |
||
| 1669 | |||
| 1670 | class function TRecycleBinManager.RecyclerGetInfoTip: string; |
||
| 1671 | var |
||
| 1672 | reg: TRegistry; |
||
| 1673 | begin |
||
| 1674 | // Not available in some older versions of Windows |
||
| 1675 | |||
| 1676 | reg := TRegistry.Create; |
||
| 1677 | try |
||
| 1678 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1679 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then |
||
| 1680 | begin |
||
| 1681 | result := reg.ReadString('InfoTip'); |
||
| 1682 | result := DecodeReferenceString(result); |
||
| 1683 | |||
| 1684 | reg.CloseKey; |
||
| 1685 | end; |
||
| 1686 | finally |
||
| 1687 | reg.Free; |
||
| 1688 | end; |
||
| 1689 | end; |
||
| 1690 | |||
| 1691 | class function TRecycleBinManager.RecyclerGetIntroText: string; |
||
| 1692 | var |
||
| 1693 | reg: TRegistry; |
||
| 1694 | begin |
||
| 1695 | // Not available in some older versions of Windows |
||
| 1696 | |||
| 1697 | reg := TRegistry.Create; |
||
| 1698 | try |
||
| 1699 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1700 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then |
||
| 1701 | begin |
||
| 1702 | result := reg.ReadString('IntroText'); |
||
| 1703 | result := DecodeReferenceString(result); |
||
| 1704 | |||
| 1705 | reg.CloseKey; |
||
| 1706 | end; |
||
| 1707 | finally |
||
| 1708 | reg.Free; |
||
| 1709 | end; |
||
| 1710 | end; |
||
| 1711 | |||
| 1712 | class function TRecycleBinManager.RecyclerGetName: string; |
||
| 1713 | var |
||
| 1714 | reg: TRegistry; |
||
| 1715 | begin |
||
| 1716 | // Windows 95b: |
||
| 1717 | // Change of CLSID\{645FF040-5081-101B-9F08-00AA002F954E} will change the desktop name of the recycle bin. |
||
| 1718 | |||
| 1719 | // Windows 2000: If LocalizedString is available, the 3rd argument will be parsed |
||
| 1720 | // (if the third argument will removed, it will be read out from the DLL resource string automatically) |
||
| 1721 | |||
| 1722 | reg := TRegistry.Create; |
||
| 1723 | try |
||
| 1724 | reg.RootKey := HKEY_CLASSES_ROOT; |
||
| 1725 | if reg.OpenKeyReadOnly('CLSID\'+GUIDToString(RECYCLER_CLSID)) then |
||
| 1726 | begin |
||
| 1727 | if reg.ValueExists('LocalizedString') then |
||
| 1728 | begin |
||
| 1729 | result := reg.ReadString('LocalizedString'); |
||
| 1730 | result := DecodeReferenceString(result); |
||
| 1731 | end |
||
| 1732 | else |
||
| 1733 | begin |
||
| 1734 | result := reg.ReadString(''); |
||
| 1735 | end; |
||
| 1736 | |||
| 1737 | reg.CloseKey; |
||
| 1738 | end; |
||
| 1739 | finally |
||
| 1740 | reg.Free; |
||
| 1741 | end; |
||
| 1742 | end; |
||
| 1743 | |||
| 1744 | class function TRecycleBinManager.RecyclerEmptyEventGetName: string; |
||
| 1745 | var |
||
| 1746 | reg: TRegistry; |
||
| 1747 | begin |
||
| 1748 | reg := TRegistry.Create; |
||
| 1749 | try |
||
| 1750 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1751 | if reg.OpenKeyReadOnly('AppEvents\EventLabels\EmptyRecycleBin') then |
||
| 1752 | begin |
||
| 1753 | result := reg.ReadString(''); |
||
| 1754 | reg.CloseKey; |
||
| 1755 | end; |
||
| 1756 | finally |
||
| 1757 | reg.Free; |
||
| 1758 | end; |
||
| 1759 | end; |
||
| 1760 | |||
| 1761 | class function TRecycleBinManager.RecyclerEmptyEventGetCurrentSound: string; |
||
| 1762 | begin |
||
| 1763 | result := RecyclerEmptyEventGetSound('.Current'); |
||
| 1764 | end; |
||
| 1765 | |||
| 1766 | class function TRecycleBinManager.RecyclerEmptyEventGetDefaultSound: string; |
||
| 1767 | begin |
||
| 1768 | result := RecyclerEmptyEventGetSound('.Default'); |
||
| 1769 | end; |
||
| 1770 | |||
| 1771 | class procedure TRecycleBinManager.RecyclerEmptyEventGetSoundCategories(AStringList: TStringList); |
||
| 1772 | var |
||
| 1773 | reg: TRegistry; |
||
| 1774 | begin |
||
| 1775 | reg := TRegistry.Create; |
||
| 1776 | try |
||
| 1777 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1778 | if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then |
||
| 1779 | begin |
||
| 1780 | reg.GetKeyNames(AStringList); |
||
| 1781 | reg.CloseKey; |
||
| 1782 | end; |
||
| 1783 | finally |
||
| 1784 | reg.Free; |
||
| 1785 | end; |
||
| 1786 | end; |
||
| 1787 | |||
| 1788 | class function TRecycleBinManager.RecyclerEmptyEventGetSound(ACategory: string): string; |
||
| 1789 | var |
||
| 1790 | reg: TRegistry; |
||
| 1791 | resourcestring |
||
| 1792 | LNG_SND_EVENT_CAT_ERROR = 'The category "%s" is not available for the notification event "%s".'; |
||
| 1793 | begin |
||
| 1794 | // Outputs an filename or empty string for no sound defined. |
||
| 1795 | |||
| 1796 | reg := TRegistry.Create; |
||
| 1797 | try |
||
| 1798 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1799 | if reg.OpenKeyReadOnly('AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin') then |
||
| 1800 | begin |
||
| 1801 | if reg.OpenKeyReadOnly(ACategory) then |
||
| 1802 | begin |
||
| 1803 | result := reg.ReadString(''); |
||
| 1804 | reg.CloseKey; |
||
| 1805 | end |
||
| 1806 | else |
||
| 1807 | raise EEventCategoryNotDefined.CreateFmt(LNG_SND_EVENT_CAT_ERROR, [ACategory, 'EmptyRecycleBin']); |
||
| 1808 | reg.CloseKey; |
||
| 1809 | end; |
||
| 1810 | finally |
||
| 1811 | reg.Free; |
||
| 1812 | end; |
||
| 1813 | end; |
||
| 1814 | |||
| 1815 | class function TRecycleBinManager.RecyclerQueryFunctionAvailable: boolean; |
||
| 1816 | var |
||
| 1817 | RBHandle: THandle; |
||
| 1818 | SHQueryRecycleBin: TSHQueryRecycleBin; |
||
| 1819 | begin |
||
| 1820 | // Windows 95 without Internet Explorer 4 has no SHQueryRecycleBinA. |
||
| 1821 | RBHandle := LoadLibrary(shell32); |
||
| 1822 | try |
||
| 1823 | if RBHandle <> 0 then |
||
| 1824 | begin |
||
| 1825 | SHQueryRecycleBin := GetProcAddress(RBHandle, C_SHQueryRecycleBin); |
||
| 1826 | if not Assigned(@SHQueryRecycleBin) then |
||
| 1827 | begin |
||
| 1828 | FreeLibrary(RBHandle); |
||
| 1829 | RBHandle := 0; |
||
| 1830 | end; |
||
| 1831 | end; |
||
| 1832 | |||
| 1833 | result := RBHandle <> 0; |
||
| 1834 | finally |
||
| 1835 | if RBHandle <> 0 then FreeLibrary(RBHandle); |
||
| 1836 | end; |
||
| 1837 | end; |
||
| 1838 | |||
| 1839 | class function TRecycleBinManager.RecyclerAddFileOrFolder(FileOrFolder: string; confirmation: boolean=false): boolean; |
||
| 1840 | var |
||
| 1841 | Operation: TSHFileOpStruct; |
||
| 1842 | begin |
||
| 1843 | // Template: http://www.dsdt.info/tipps/?id=116 |
||
| 1844 | with Operation do |
||
| 1845 | begin |
||
| 1846 | Wnd := hInstance; // OK? |
||
| 1847 | wFunc := FO_DELETE; |
||
| 1848 | pFrom := PChar(FileOrFolder + #0); |
||
| 1849 | pTo := nil; |
||
| 1850 | fFlags := FOF_ALLOWUNDO; |
||
| 1851 | if not confirmation then fFlags := fFlags or FOF_NOCONFIRMATION; |
||
| 1852 | end; |
||
| 1853 | Result := SHFileOperation(Operation) = 0; |
||
| 1854 | end; |
||
| 1855 | |||
| 1856 | class function TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles: GPOLICYBOOL; |
||
| 1857 | var |
||
| 1858 | reg: TRegistry; |
||
| 1859 | begin |
||
| 1860 | result := gpUndefined; |
||
| 1861 | |||
| 1862 | reg := TRegistry.Create; |
||
| 1863 | try |
||
| 1864 | // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, |
||
| 1865 | // even if gpedit.msc shows "Not configured"! |
||
| 1866 | {$IFDEF GroupPolicyAcceptHKLMTrick} |
||
| 1867 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1868 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1869 | begin |
||
| 1870 | if reg.ValueExists('NoRecycleFiles') then |
||
| 1871 | begin |
||
| 1872 | if reg.ReadBool('NoRecycleFiles') then |
||
| 1873 | result := gpEnabled |
||
| 1874 | else |
||
| 1875 | result := gpDisabled; |
||
| 1876 | Exit; |
||
| 1877 | end; |
||
| 1878 | reg.CloseKey; |
||
| 1879 | end; |
||
| 1880 | {$ENDIF} |
||
| 1881 | |||
| 1882 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1883 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1884 | begin |
||
| 1885 | if reg.ValueExists('NoRecycleFiles') then |
||
| 1886 | begin |
||
| 1887 | if reg.ReadBool('NoRecycleFiles') then |
||
| 1888 | result := gpEnabled |
||
| 1889 | else |
||
| 1890 | result := gpDisabled; |
||
| 1891 | end; |
||
| 1892 | reg.CloseKey; |
||
| 1893 | end; |
||
| 1894 | finally |
||
| 1895 | reg.Free; |
||
| 1896 | end; |
||
| 1897 | end; |
||
| 1898 | |||
| 1899 | class function TRecycleBinManager.RecyclerGroupPolicyConfirmFileDelete: GPOLICYBOOL; |
||
| 1900 | var |
||
| 1901 | reg: TRegistry; |
||
| 1902 | begin |
||
| 1903 | result := gpUndefined; |
||
| 1904 | reg := TRegistry.Create; |
||
| 1905 | try |
||
| 1906 | // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, |
||
| 1907 | // even if gpedit.msc shows "Not configured"! |
||
| 1908 | {$IFDEF GroupPolicyAcceptHKLMTrick} |
||
| 1909 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1910 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1911 | begin |
||
| 1912 | if reg.ValueExists('ConfirmFileDelete') then |
||
| 1913 | begin |
||
| 1914 | if reg.ReadBool('ConfirmFileDelete') then |
||
| 1915 | result := gpEnabled |
||
| 1916 | else |
||
| 1917 | result := gpDisabled; |
||
| 1918 | Exit; |
||
| 1919 | end; |
||
| 1920 | reg.CloseKey; |
||
| 1921 | end; |
||
| 1922 | {$ENDIF} |
||
| 1923 | |||
| 1924 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1925 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1926 | begin |
||
| 1927 | if reg.ValueExists('ConfirmFileDelete') then |
||
| 1928 | begin |
||
| 1929 | if reg.ReadBool('ConfirmFileDelete') then |
||
| 1930 | result := gpEnabled |
||
| 1931 | else |
||
| 1932 | result := gpDisabled; |
||
| 1933 | end; |
||
| 1934 | reg.CloseKey; |
||
| 1935 | end; |
||
| 1936 | finally |
||
| 1937 | reg.Free; |
||
| 1938 | end; |
||
| 1939 | end; |
||
| 1940 | |||
| 1941 | class function TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize: integer; |
||
| 1942 | var |
||
| 1943 | reg: TRegistry; |
||
| 1944 | begin |
||
| 1945 | result := -1; |
||
| 1946 | reg := TRegistry.Create; |
||
| 1947 | try |
||
| 1948 | // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, |
||
| 1949 | // even if gpedit.msc shows "Not configured"! |
||
| 1950 | {$IFDEF GroupPolicyAcceptHKLMTrick} |
||
| 1951 | reg.RootKey := HKEY_LOCAL_MACHINE; |
||
| 1952 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1953 | begin |
||
| 1954 | if reg.ValueExists('RecycleBinSize') then |
||
| 1955 | begin |
||
| 1956 | result := reg.ReadInteger('RecycleBinSize'); |
||
| 1957 | Exit; |
||
| 1958 | end; |
||
| 1959 | reg.CloseKey; |
||
| 1960 | end; |
||
| 1961 | {$ENDIF} |
||
| 1962 | |||
| 1963 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 1964 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer') then |
||
| 1965 | begin |
||
| 1966 | if reg.ValueExists('RecycleBinSize') then |
||
| 1967 | begin |
||
| 1968 | result := reg.ReadInteger('RecycleBinSize'); |
||
| 1969 | end; |
||
| 1970 | reg.CloseKey; |
||
| 1971 | end; |
||
| 1972 | finally |
||
| 1973 | reg.Free; |
||
| 1974 | end; |
||
| 1975 | end; |
||
| 1976 | |||
| 1977 | class function TRecycleBinManager.RecyclerConfirmationDialogEnabled: boolean; |
||
| 1978 | var |
||
| 1979 | gp: GPOLICYBOOL; |
||
| 1980 | begin |
||
| 1981 | gp := RecyclerGroupPolicyConfirmFileDelete; |
||
| 1982 | if gp <> gpUndefined then |
||
| 1983 | begin |
||
| 1984 | result := gp = gpEnabled; |
||
| 1985 | end |
||
| 1986 | else |
||
| 1987 | begin |
||
| 1988 | result := RecyclerShellStateConfirmationDialogEnabled; |
||
| 1989 | end; |
||
| 1990 | end; |
||
| 1991 | |||
| 1992 | class function TRecycleBinManager.RecyclerShellStateConfirmationDialogEnabled: boolean; |
||
| 1993 | var |
||
| 1994 | lpss: SHELLSTATE; |
||
| 1995 | bNoConfirmRecycle: boolean; |
||
| 1996 | |||
| 1997 | PSHGetSettings: TSHGetSettings; |
||
| 1998 | RBHandle: THandle; |
||
| 1999 | |||
| 2000 | reg: TRegistry; |
||
| 2001 | rbuf: array[0..255] of byte; |
||
| 2002 | begin |
||
| 2003 | PSHGetSettings := nil; |
||
| 2004 | result := false; // Avoid warning message |
||
| 2005 | |||
| 2006 | RBHandle := LoadLibrary(shell32); |
||
| 2007 | try |
||
| 2008 | if RBHandle <> 0 then |
||
| 2009 | begin |
||
| 2010 | PSHGetSettings := GetProcAddress(RBHandle, C_SHGetSettings); |
||
| 2011 | if not Assigned(@PSHGetSettings) then |
||
| 2012 | begin |
||
| 2013 | FreeLibrary(RBHandle); |
||
| 2014 | RBHandle := 0; |
||
| 2015 | end; |
||
| 2016 | end; |
||
| 2017 | |||
| 2018 | if (RBHandle <> 0) and Assigned(PSHGetSettings) then |
||
| 2019 | begin |
||
| 2020 | ZeroMemory(@lpss, SizeOf(lpss)); |
||
| 2021 | PSHGetSettings(lpss, SSF_NOCONFIRMRECYCLE); |
||
| 2022 | bNoConfirmRecycle := (lpss.Flags1 and 4) = 4; // fNoConfirmRecycle |
||
| 2023 | |||
| 2024 | result := not bNoConfirmRecycle; |
||
| 2025 | end |
||
| 2026 | else |
||
| 2027 | begin |
||
| 2028 | reg := TRegistry.Create; |
||
| 2029 | try |
||
| 2030 | // API function call failed. Probably because Windows is too old. |
||
| 2031 | // Try to read out from registry. |
||
| 2032 | // The 3rd bit of the 5th byte of "ShellState" is the value |
||
| 2033 | // of "fNoConfirmRecycle". |
||
| 2034 | |||
| 2035 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 2036 | if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer') then |
||
| 2037 | begin |
||
| 2038 | ZeroMemory(@rbuf, SizeOf(rbuf)); |
||
| 2039 | reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); |
||
| 2040 | |||
| 2041 | // Lese 3tes Bit vom 5ten Byte |
||
| 2042 | bNoConfirmRecycle := ((rbuf[4] and 4) = 4); |
||
| 2043 | result := not bNoConfirmRecycle; |
||
| 2044 | |||
| 2045 | reg.CloseKey; |
||
| 2046 | end |
||
| 2047 | else |
||
| 2048 | begin |
||
| 2049 | raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSettings])]); |
||
| 2050 | end; |
||
| 2051 | finally |
||
| 2052 | reg.Free; |
||
| 2053 | end; |
||
| 2054 | end; |
||
| 2055 | finally |
||
| 2056 | if RBHandle <> 0 then FreeLibrary(RBHandle); |
||
| 2057 | end; |
||
| 2058 | end; |
||
| 2059 | |||
| 2060 | class procedure TRecycleBinManager.RecyclerConfirmationDialogSetEnabled(NewSetting: boolean); |
||
| 2061 | var |
||
| 2062 | lpss: SHELLSTATE; |
||
| 2063 | |||
| 2064 | PSHGetSetSettings: TSHGetSetSettings; |
||
| 2065 | RBHandle: THandle; |
||
| 2066 | |||
| 2067 | reg: TRegistry; |
||
| 2068 | rbuf: array[0..255] of byte; |
||
| 2069 | |||
| 2070 | dwResult: DWORD; |
||
| 2071 | begin |
||
| 2072 | PSHGetSetSettings := nil; |
||
| 2073 | |||
| 2074 | RBHandle := LoadLibrary(shell32); |
||
| 2075 | try |
||
| 2076 | if RBHandle <> 0 then |
||
| 2077 | begin |
||
| 2078 | PSHGetSetSettings := GetProcAddress(RBHandle, C_SHGetSetSettings); |
||
| 2079 | if not Assigned(@PSHGetSetSettings) then |
||
| 2080 | begin |
||
| 2081 | FreeLibrary(RBHandle); |
||
| 2082 | RBHandle := 0; |
||
| 2083 | end; |
||
| 2084 | end; |
||
| 2085 | |||
| 2086 | if (RBHandle <> 0) and Assigned(PSHGetSetSettings) then |
||
| 2087 | begin |
||
| 2088 | ZeroMemory(@lpss, SizeOf(lpss)); |
||
| 2089 | |||
| 2090 | PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, false); // Get |
||
| 2091 | |||
| 2092 | // Set 3rd bit equal to NewSetting |
||
| 2093 | if NewSetting then |
||
| 2094 | lpss.Flags1 := lpss.Flags1 or $00000004 |
||
| 2095 | else |
||
| 2096 | lpss.Flags1 := lpss.Flags1 and $FFFFFFFB; |
||
| 2097 | |||
| 2098 | PSHGetSetSettings(lpss, SSF_NOCONFIRMRECYCLE, true); // Set |
||
| 2099 | |||
| 2100 | SendMessageTimeout ( |
||
| 2101 | HWND_BROADCAST, WM_SETTINGCHANGE, |
||
| 2102 | 0, lParam (pChar ('ShellState')), |
||
| 2103 | SMTO_ABORTIFHUNG, 5000, dwResult |
||
| 2104 | ); |
||
| 2105 | end |
||
| 2106 | else |
||
| 2107 | begin |
||
| 2108 | reg := TRegistry.Create; |
||
| 2109 | try |
||
| 2110 | // API function call failed. Probably because Windows is too old. |
||
| 2111 | // Try to read out from registry. |
||
| 2112 | // The 3rd bit of the 5th byte of "ShellState" is the value |
||
| 2113 | // of "fNoConfirmRecycle". |
||
| 2114 | |||
| 2115 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 2116 | if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer', false) then |
||
| 2117 | begin |
||
| 2118 | ZeroMemory(@rbuf, SizeOf(rbuf)); |
||
| 2119 | |||
| 2120 | reg.ReadBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Get |
||
| 2121 | |||
| 2122 | // Set 3rd bit equal to NewSetting |
||
| 2123 | if NewSetting then |
||
| 2124 | rbuf[4] := rbuf[4] or $04 |
||
| 2125 | else |
||
| 2126 | rbuf[4] := rbuf[4] and $FB; |
||
| 2127 | |||
| 2128 | reg.WriteBinaryData('ShellState', rbuf, SizeOf(rbuf)); // Set |
||
| 2129 | |||
| 2130 | SendMessageTimeout ( |
||
| 2131 | HWND_BROADCAST, WM_SETTINGCHANGE, |
||
| 2132 | 0, lParam (pChar ('ShellState')), |
||
| 2133 | SMTO_ABORTIFHUNG, 5000, dwResult |
||
| 2134 | ); |
||
| 2135 | |||
| 2136 | reg.CloseKey; |
||
| 2137 | end |
||
| 2138 | else |
||
| 2139 | begin |
||
| 2140 | raise EAPICallError.CreateFmt(LNG_API_CALL_ERROR, [Format(LNG_NOT_CALLABLE, [C_SHGetSetSettings])]); |
||
| 2141 | end; |
||
| 2142 | finally |
||
| 2143 | reg.Free; |
||
| 2144 | end; |
||
| 2145 | end; |
||
| 2146 | finally |
||
| 2147 | if RBHandle <> 0 then FreeLibrary(RBHandle); |
||
| 2148 | end; |
||
| 2149 | end; |
||
| 2150 | |||
| 2151 | { TRbRecycleBinItem } |
||
| 2152 | |||
| 2153 | function TRbRecycleBinItem.GetSource: string; |
||
| 2154 | begin |
||
| 2155 | {$IFDEF UNICODE} |
||
| 2156 | result := SourceUnicode; |
||
| 2157 | {$ELSE} |
||
| 2158 | result := SourceAnsi; |
||
| 2159 | {$ENDIF} |
||
| 2160 | end; |
||
| 2161 | |||
| 2162 | end. |