WebSVN – recyclebinunit – Diff – /trunk/Recycle Bin Unit v2/RecBinUnit2.pas

 ////////////////////////////////////////////////////////////////////////////////////
 // RECYCLE-BIN-UNIT V2 BY DANIEL MARSCHALL, VIATHINKSOFT                          //
 // E-MAIL: info@daniel-marschall.de                                               //
 // Web:    www.daniel-marschall.de & www.viathinksoft.de                          //
 ////////////////////////////////////////////////////////////////////////////////////
-// Revision: 03 JUL 2016                                                          //
+// Revision: 17 JUL 2016                                                          //
 // This unit is freeware, but please link to my website if you are using it!      //
 ////////////////////////////////////////////////////////////////////////////////////
 // Successfully tested with:                                                      //
 // Windows 95b (without IE4 Shell Extensions)                                     //
 // Windows 95b (with IE4 Shell Extensions)                                        //
 // - Remove "static"
 // - Remove "strict"
 // - Remove "$REGION"
 // TODO: ReadBuffer überall try-except
-// TODO: Win7 : Drive GUIDs
-// TODO: Win7 : Absolute vs. Relative size limitations
 // TODO: Always check EOF before reading anything?
 // TODO: Don't crash when timestamp is invalid. Do something else instead.
 // TODO: Is it possible to identify a Vista-file that is not named $Ixxxxxx.ext?
 // TODO: RecyclerGetInfofiles() check additionally for removable device?
 //       RecyclerIsValid() is false.
 //       - How does Windows 9x/NT manage the daylight saving time (if it does)?
 //       - How does Windows Vista+ react to a RECYCLER\ folder on a NTFS device?
 //       - How does Windows Vista+ react to a RECYCLED\ folder on a FAT device? ==> Win7: is ignored!
 //       - How does Windows XP react to RECYCLED\ folder on a FAT device?
 // TODO: Translate all comments from German to English
-// 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
+// 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
+// TODO: Add a lot of setters for system config stuff
 // If enabled, the deletion timestamps will not be converted by the WinAPI.
 {.$DEFINE FILETIME_DELPHI_CODE}
 // If a value is set in HKEY_LOCAL_MACHINE, it will be prefered, even if gpedit.msc shows "Not configured"!
 {$DEFINE GroupPolicyAcceptHKLMTrick}
 interface
 uses
-  Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages;
+  Windows, SysUtils, Classes, ContNrs, ShellAPI, Registry, Messages, Math;
 const
-  RECBINUNIT_VERSION = '2016-07-05';
+  RECBINUNIT_VERSION = '2016-07-17';
   RECYCLER_CLSID: TGUID = '{645FF040-5081-101B-9F08-00AA002F954E}';
-  NULL_GUID: TGUID      = '{00000000-0000-0000-0000-000000000000}';
+  NULL_GUID:      TGUID = '{00000000-0000-0000-0000-000000000000}';
 type
   // TODO: Wie sieht es aus mit Laufwerken, die nur als Mount-Point eingebunden sind?
   TRbDrive = class(TObject)
   strict private
     FDriveLetter: Char;
-    // will return NULL_GUID in case of an error or if it is not supported
+    function OldCapacityPercent(var res: integer): boolean; // in % (0-100)
+    function NewCapacityAbsolute(var res: integer): boolean; // in MB
-    function GetVolumeGUID: TGUID;
+    function DiskSize: integer; // in MB
-    function GetVolumeGUIDAvailable: boolean; protected
+    function DriveNumber: integer;
   strict protected
     function IsFAT: boolean;
     procedure CheckDriveExisting;
+    // will return NULL_GUID in case of an error or if it is not supported
+    function GetVolumeGUID: TGUID;
+    function GetVolumeGUIDAvailable: boolean;
+    // TODO: get drive serial
   public
     constructor Create(ADriveLetter: Char);
     // Wenn UserSID='', dann werden alle Recycler gefunden
     procedure ListRecycleBins(list: TObjectList{TRbRecycleBin}; UserSID: string='');
     function GetAPIInfo: TSHQueryRBInfo;
     function GetSize: int64;
     function GetNumItems: int64;
     function IsEmpty: boolean;
-    function GetMaxPercentUsage: integer;
+    function GetMaxPercentUsage: Extended; // 0..1
+    function GetMaxAbsoluteUsage: integer; // in MB
     function GetNukeOnDelete: boolean;
-    // These functions will check the global configuration and group policy, too.
-    function RecyclerGetPercentUsageAutoDeterminate: integer;
-    function RecyclerIsNukeOnDeleteAutoDeterminate: boolean;
   end;
   GPOLICYBOOL = (gpUndefined, gpEnabled, gpDisabled);
   TRecycleBinManager = class(TObject)
 procedure TRbDrive.CheckDriveExisting;
 begin
   // Does the drive exist?
   // see http://www.delphipraxis.net/post2933.html
-  if not GetLogicalDrives and (1 shl DriveLetterToDriveNumber(FDriveLetter)) <> 0 then
+  if not GetLogicalDrives and (1 shl DriveNumber) <> 0 then
   begin
     raise EInvalidDrive.CreateFmt(LNG_DRIVE_NOT_EXISTING, [UpperCase(FDriveLetter)+':']);
   end;
 end;
   FDriveLetter := ADriveLetter;
   CheckDriveExisting;
 end;
+function TRbDrive.DiskSize: integer;
+begin
+  result := SysUtils.DiskSize(DriveNumber+1 {0 is current, 1 is A}) div (1024*1024);
+end;
+function TRbDrive.DriveNumber: integer;
+begin
+  result := DriveLetterToDriveNumber(FDriveLetter);
+end;
 function TRbDrive.GetAPIInfo: TSHQueryRBInfo;
 var
   PSHQueryRecycleBin: TSHQueryRecycleBin;
   RBHandle: THandle;
   res: HRESULT;
   finally
     if RBHandle <> 0 then FreeLibrary(RBHandle);
   end;
 end;
-function TRbDrive.GetMaxPercentUsage: integer;
+function TRbDrive.GetMaxPercentUsage: Extended;
+var
+  abs: integer; // in MB
+  rel: integer; // in % (0-100)
+  gpSetting: integer;
+const
+  DEFAULT_PERCENT = 10; // Windows 95 default
+begin
+  gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
+  if gpSetting <> -1 then
+    result := gpSetting / 100
+  else if TRecycleBinManager.UsesGlobalSettings then
+    result := TRecycleBinManager.GetGlobalMaxPercentUsage / 100
+  else if OldCapacityPercent(rel) then
+  begin
+    result := rel / 100;
+  end
+  else if NewCapacityAbsolute(abs) then
+  begin
+    result := abs / DiskSize;
+  end
+  else
+  begin
+    result := DEFAULT_PERCENT / 100;
+  end;
+end;
+function TRbDrive.GetMaxAbsoluteUsage: integer;
+var
+  abs: integer; // in MB
+  rel: integer; // in % (0-100)
+  gpSetting: integer;
+const
+  DEFAULT_PERCENT = 10; // Windows 95 default
+begin
+  gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
+  if gpSetting <> -1 then
+    result := Ceil(gpSetting/100 * DiskSize)
+  else if TRecycleBinManager.UsesGlobalSettings then
+    result := Ceil(TRecycleBinManager.GetGlobalMaxPercentUsage/100 * DiskSize)
+  else if NewCapacityAbsolute(abs) then
+  begin
+    result := abs;
+  end
+  else if OldCapacityPercent(rel) then
+  begin
+    result := Ceil(rel/100 * DiskSize);
+  end
+  else
+  begin
+    result := Ceil(DEFAULT_PERCENT/100 * DiskSize);
+  end;
+end;
+function TRbDrive.OldCapacityPercent(var res: integer): boolean;
 var
   reg: TRegistry;
   purgeInfo: TRbWin95PurgeInfo;
-const
-  RES_DEFAULT = 10; // Windows 95 - Standardwert
 begin
+  if Win32MajorVersion >= 6 then
+  begin
+    // Only available till Windows XP
+    result := false;
+    exit;
+  end;
-  result := RES_DEFAULT;
+  result := false;
   reg := TRegistry.Create;
   try
     reg.RootKey := HKEY_LOCAL_MACHINE;
       begin
         if reg.ValueExists('Percent') then
         begin
           // Windows 2000 - Informationen liegen aufgeschlüsselt in der Registry
-          result := reg.ReadInteger('Percent');
+          res := reg.ReadInteger('Percent');
+          result := true;
         end;
       end
       else
       begin
         if reg.ValueExists('PurgeInfo') then
         begin
           // Windows 95 - Kodierte Informationen liegen in PurgeInfo
           reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
-          result := purgeInfo.percentDrive[FDriveLetter];
+          res := purgeInfo.percentDrive[FDriveLetter];
+          result := true;
         end;
       end;
       reg.CloseKey;
     end;
   finally
     reg.Free;
   end;
 end;
-function TRbDrive.RecyclerGetPercentUsageAutoDeterminate: integer;
+function TRbDrive.NewCapacityAbsolute(var res: integer): boolean;
 var
-  gpSetting: integer;
+  reg: TRegistry;
 begin
-  gpSetting := TRecycleBinManager.RecyclerGroupPolicyRecycleBinSize;
-  if gpSetting <> -1 then
+  if Win32MajorVersion < 6 then
-    result := gpSetting
+  begin
-  else if TRecycleBinManager.UsesGlobalSettings then
+    // Only available since Windows Vista
-    result := TRecycleBinManager.GetGlobalMaxPercentUsage
+    result := false;
-  else
+    exit;
-    result := GetMaxPercentUsage;
-end;
+  end;
+  result := false;
+  reg := TRegistry.Create;
+  try
+    reg.RootKey := HKEY_CURRENT_USER;
-function TRbDrive.RecyclerIsNukeOnDeleteAutoDeterminate: boolean;
+    if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
-begin
+    begin
+      // Windows Vista and upwards
-  if TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
+      if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
-    result := true
+      begin
-  else if TRecycleBinManager.UsesGlobalSettings then
+        res := reg.ReadInteger('MaxCapacity'); // in MB
-    result := TRecycleBinManager.GetGlobalNukeOnDelete
+        result := true;
+      end;
+      reg.CloseKey;
-  else
+    end;
+  finally
-    result := GetNukeOnDelete;
+    reg.Free;
+  end;
 end;
 function TRbDrive.GetNukeOnDelete: boolean;
 var
   reg: TRegistry;
   purgeInfo: TRbWin95PurgeInfo;
 const
-  RES_DEFAULT = false; // Windows 95 - Standardwert
+  RES_DEFAULT = false; // Windows 95 default
+begin
+  if TRecycleBinManager.RecyclerGroupPolicyNoRecycleFiles = gpEnabled then
+    result := true
+  else if TRecycleBinManager.UsesGlobalSettings then
+    result := TRecycleBinManager.GetGlobalNukeOnDelete
+  else
-begin
+  begin
-  result := RES_DEFAULT;
+    result := RES_DEFAULT;
-  reg := TRegistry.Create;
+    reg := TRegistry.Create;
-  try
+    try
+      reg.RootKey := HKEY_CURRENT_USER;
+      if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\BitBucket\Volume') then
+      begin
+        // Windows Vista and upwards
+        if reg.OpenKeyReadOnly(GUIDToString(VolumeGUID)) then
+        begin
+          result := reg.ReadBool('NukeOnDelete');
+        end;
+        reg.CloseKey;
+      end
+      else
+      begin
-    reg.RootKey := HKEY_LOCAL_MACHINE;
+        reg.RootKey := HKEY_LOCAL_MACHINE;
-    // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
+        // Im Auslieferungszustand von Windows 95 ist dieser Schlüssel nicht vorhanden.
-    // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
+        // Er wird bei der ersten Änderung der Papierkorb-Einstellungen erstellt.
-    if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
+        if reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\BitBucket') then
-        begin
+            begin
-          // Windows 95 - Kodierte Informationen liegen in PurgeInfo
+              // Windows 95 - Kodierte Informationen liegen in PurgeInfo
-          reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
+              reg.ReadBinaryData('PurgeInfo', purgeInfo, SizeOf(purgeInfo));
-          result := ((purgeInfo.NukeOnDeleteBits shr DriveLetterToDriveNumber(FDriveLetter)) and 1) = 1;
+              result := ((purgeInfo.NukeOnDeleteBits shr DriveNumber) and 1) = 1;
-        end;
+            end;
-      end;
+          end;
-      reg.CloseKey;
+          reg.CloseKey;
-    end;
+        end;
+      end;
-  finally
+    finally
-    reg.Free;
+      reg.Free;
-  end;
+    end;
-end;
+  end;
+end;
 function TRbDrive.GetNumItems: int64;
 begin
   result := GetAPIInfo.i64NumItems;
 end;
   reg: TRegistry;
   purgeInfo: TRbWin95PurgeInfo;
 const
   RES_DEFAULT = 10; // Windows 95 - Standardwert
 begin
+  if Win32MajorVersion >= 6 then
+  begin
+    // Only available till Windows XP
+    result := -1;
+    exit;
+  end;
   result := RES_DEFAULT;
   reg := TRegistry.Create;
   try
     reg.RootKey := HKEY_LOCAL_MACHINE;
   reg: TRegistry;
   purgeInfo: TRbWin95PurgeInfo;
 const
   RES_DEFAULT = false; // Windows 95 - Standardwert
 begin
+  if Win32MajorVersion >= 6 then
+  begin
+    // Only available till Windows XP
+    result := false;
+    exit;
+  end;
   result := RES_DEFAULT;
   reg := TRegistry.Create;
   try
     reg.RootKey := HKEY_LOCAL_MACHINE;
   reg: TRegistry;
   purgeInfo: TRbWin95PurgeInfo;
 const
   RES_DEFAULT = true; // Windows 95 - Standardwert
 begin
+  if Win32MajorVersion >= 6 then
+  begin
+    // Only available till Windows XP
+    result := false;
+    exit;
+  end;
   result := RES_DEFAULT;
   reg := TRegistry.Create;
   try
     reg.RootKey := HKEY_LOCAL_MACHINE;

Subversion Repositories recyclebinunit

recyclebinunit/trunk/Recycle Bin Unit v2/RecBinUnit2.pas – Rev 77 → 78