freeotfefrmmain.pas

文件驱动加密,功能强大,可产生加密分区,支持AES,MD2,MD4,MD5MD2, MD4, MD5, RIPEMD-128, RIPEMD-160, SHA-1, SHA-224, SHA-256,

procedure TfrmFreeOTFEMain.DriveProperties();
var
  propertiesDlg: TfrmFreeOTFEVolProperties;
  i: integer;
begin
  for i:=0 to (lvDrives.items.count-1) do
    begin
    if lvDrives.Items[i].Selected then
      begin
      propertiesDlg:= TfrmFreeOTFEVolProperties.Create(self);
      try
        propertiesDlg.DriveLetter := GetDriveLetterFromLVItem(lvDrives.Items[i]);
        propertiesDlg.OTFEFreeOTFE := OTFEFreeOTFE;
        propertiesDlg.ShowModal();
      finally
        propertiesDlg.Free();
      end;

      end;
    end;

end;


// If "isEmergency" is TRUE, the user will *not* be informed of any drives
// which couldn't be dismounted 
function TfrmFreeOTFEMain.DismountAll(isEmergency: boolean = FALSE): boolean;
var
  drivesRemaining: string;
  allOK: boolean;
begin
  allOK := TRUE;

  OTFEFreeOTFE.DismountAll(isEmergency);

  // If it wasn't an emergency dismount, and drives are still mounted, report.
  drivesRemaining := OTFEFreeOTFE.DrivesMounted();
  if (drivesRemaining<>'') then
    begin
    if not(isEmergency) then
      begin
      allOK := FALSE;
      RefreshDrives();
      ReportDrivesNotDismounted(drivesRemaining, FALSE);
      end
    else
      begin
      // Just give it another go... Best we can do.
      OTFEFreeOTFE.DismountAll(isEmergency);
      end;
    end;

  RefreshDrives();

  Result := allOK;
end;


function TfrmFreeOTFEMain.DismountSelected(): boolean;
var
  i: integer;
  drivesRemaining: string;
  toDismount: string;
  allOK: boolean;
begin
  drivesRemaining := '';

  // First we build up a list of drives to dismount, then we dismount them.
  // This is done since we can't just run through the lvDrives looking for
  // selected items, as they're getting removed while we walk though the list!

  for i:=0 to (lvDrives.items.count-1) do
    begin
    if lvDrives.Items[i].Selected then
      begin
      toDismount := toDismount + GetDriveLetterFromLVItem(lvDrives.Items[i]);
      end;
    end;

  allOK := DismountDrives(toDismount, FALSE);

  RefreshDrives();

  Result := allOK;
end;


// Dismount the drives specified
// This procedure *will* report drives which couldn't be mounted - regardless
// of "isEmergency"
function TfrmFreeOTFEMain.DismountDrives(dismountDrives: string; isEmergency: boolean): boolean;
var
  i: integer;
  tmpDrv: char;
  drivesRemaining: string;
  allOK: boolean;
begin
  allOK := TRUE;
  drivesRemaining := '';

  for i:=1 to length(dismountDrives) do
    begin
    tmpDrv := dismountDrives[i];
    if not(OTFEFreeOTFE.Dismount(tmpDrv, isEmergency)) then
      begin
      drivesRemaining := drivesRemaining + tmpDrv;
      allOK := FALSE;
      end;

    end;

  if (drivesRemaining<>'') then
    begin
    RefreshDrives();
    ReportDrivesNotDismounted(drivesRemaining, isEmergency);
    end;

  RefreshDrives();

  Result := allOK;
end;


// Warn the user that some drives remain mounted, and if the dismount attempted
// wasn't an emergency dismount, then prompt the user if they want to attempt
// an emergency dismount
procedure TfrmFreeOTFEMain.ReportDrivesNotDismounted(drivesRemaining: string; isEmergency: boolean);
var
  msg: string;
  i: integer;
  plural_thisthese: string;
  plural_drivedrives: string;
begin
  plural_thisthese := 'this';
  plural_drivedrives := 'drive';
  if (length(drivesRemaining)>0) then
    begin
    plural_thisthese := 'these';
    plural_drivedrives := 'drives';
    end;

  msg := 'Unable to dismount '+plural_drivedrives+': ';
  for i:=1 to length(drivesRemaining) do
    begin
    if (i<>1) then
      begin
      msg := msg + ', ';
      end;

    msg := msg + drivesRemaining[i] + ':';
    end;


  // If the dismount attempted was a non-emergency dismount; prompt user if
  // they want to attempt an emergency dismount
  if not(isEmergency) then
    begin
    msg := msg+SDUCRLF+
           SDUCRLF+
           'Do you wish to force a dismount on '+plural_thisthese+' '+plural_drivedrives+'?';

    if (SDUMessageDlg(msg, mtConfirmation, [mbYes,mbNo], 0) = mrYes)then
      begin
      if (SDUMessageDlg(
                     'Warning: Emergency dismounts are not recommended'+SDUCRLF+
                     SDUCRLF+
                     'Are you sure you wish to proceed?',
                     mtWarning,
                     [mbYes,mbNo],
                     0
                    ) = mrYes) then
        begin
        DismountDrives(drivesRemaining, TRUE);
        end;

      end;
    end
  else
    begin
    // Dismount reporting on *was* an emergency dismount; just report remaining
    // drives still mounted
    SDUMessageDlg(msg, mtInformation, [mbOK], 0);
    end;

end;



procedure TfrmFreeOTFEMain.lvDrivesClick(Sender: TObject);
begin
  EnableDisableControls();

end;

procedure TfrmFreeOTFEMain.EnableDisableControls();
var
  drivesSelected: boolean;
  drivesMounted: boolean;
  drvLetter: char;
  freeSpace: int64;
  totalSpace: int64;
  statusText: string;
  i: integer;
begin
  // The FreeOTFE object may not be active...
  actFreeOTFENew.Enabled            := OTFEFreeOTFE.Active;
  actFreeOTFEMountFile.Enabled      := OTFEFreeOTFE.Active;
  actFreeOTFEMountPartition.Enabled := (OTFEFreeOTFE.Active and OTFEFreeOTFE.CanMountDevice());
  // Linux menuitem completely disabled if not active...
  miLinuxVolume.Enabled             := OTFEFreeOTFE.Active;
  actLinuxNew.Enabled               := miLinuxVolume.Enabled;
  actLinuxMountFile.Enabled         := miLinuxVolume.Enabled;
  actLinuxMountPartition.Enabled    := (miLinuxVolume.Enabled and OTFEFreeOTFE.CanMountDevice());

  miChangePassword.Enabled := OTFEFreeOTFE.Active;
  miCreateKeyfile.Enabled  := OTFEFreeOTFE.Active;
  miCDB.Enabled            := OTFEFreeOTFE.Active;


  // Flags used later
  drivesSelected := (lvDrives.selcount > 0);
  drivesMounted  := (lvDrives.Items.count > 0);


  // Actions & menuitems to be enabled/disabled, depending on whether a drive
  // is selected
  actDismount.enabled   := drivesSelected;
  actProperties.enabled := drivesSelected;

  miFormat.enabled                  := drivesSelected;
  miPopupFormat.enabled             := drivesSelected;
  miOverwriteFreeSpace.enabled      := drivesSelected;  // Note: Implies FreeOTFE drivers are running
  miPopupOverwriteFreeSpace.enabled := drivesSelected;  // Note: Implies FreeOTFE drivers are running


  // Action item to be enabled/disabled, as long as one or more drives are
  // mounted
  actDismountAll.enabled  := drivesMounted;


  // Driver handling...
  actTogglePortableMode.Checked := (CountPortableDrivers > 0);
  actTogglePortableMode.Enabled := (
                                    OTFEFreeOTFE.CanUserManageDrivers() or
                                    // If we're on Vista, always allow the
                                    // toggle portable mode option; the
                                    // user can escalate UAC if needed
                                    SDUOSVistaOrLater()
                                   );
  // If the portable mode control is enabled, but we don't know how many
  // drivers there are in portable mode, presumably we're running under
  // Vista without admin access - in which case this control just toggles the
  // portable mode status - and DOESN'T turn it on/off
  if (
      actTogglePortableMode.Enabled and
      (CountPortableDrivers < 0)
     ) then
    begin
    actTogglePortableMode.Caption := 'Toggle portable mode drivers';
    end
  else
    begin
    actTogglePortableMode.Caption := 'Use portable mode drivers';

    // Ensure NO ICON FOR PORTABLE MODE DRIVERS if the user is admin; it shows
    // a checkbox instead, depending on whether the drivers are running or not
    miPortableModeDrivers.ImageIndex := -1;
    end;



  // Misc display related...
  SDUSystemTrayIcon1.Active         := Settings.OptSystemTrayIconDisplay;
  SDUSystemTrayIcon1.MinimizeToIcon := Settings.OptSystemTrayIconMinTo;
  if drivesMounted then
    begin
    SDUSystemTrayIcon1.Icon := IconMounted;
    end
  else
    begin
    SDUSystemTrayIcon1.Icon := IconUnmounted;
    end;

  ToolBar1.Visible := Settings.OptDisplayToolbar;
  StatusBar1.Visible := Settings.OptDisplayStatusbar;

  // Update status bar text, if visible
  if StatusBar1.Visible then
    begin
    statusText := '';
    if (lvDrives.SelCount = 0) then
      begin
      if (lvDrives.Items.Count = 1) then
        begin
        statusText := inttostr(lvDrives.Items.Count)+' drive mounted.';
        end
      else
        begin
        statusText := inttostr(lvDrives.Items.Count)+' drives mounted.';
        end;

      end
    else if (lvDrives.SelCount > 0) then
      begin
      if (lvDrives.SelCount = 1) then
        begin
        for i:=0 to (lvDrives.items.count-1) do
          begin
          if lvDrives.Items[i].Selected then
            begin
            drvLetter := GetDriveLetterFromLVItem(lvDrives.Items[i]);
            freeSpace := DiskFree(Ord(drvLetter) - 64);
            totalSpace := DiskSize(Ord(drvLetter) - 64);

            if (
                (freeSpace > -1) and
                (totalSpace > -1)
               ) then
              begin
              statusText := '';
              statusText := statusText +
                            drvLetter+':';
              statusText := statusText +
                            ' Free Space: '+SDUFormatUnits(
                                                       freeSpace,
                                                       UNITS_BYTES_DENOMINATINON,
                                                       UNITS_BYTES_MULTIPLIER,
                                                       1
                                                      );
              statusText := statusText +
                            ' Total Size: '+SDUFormatUnits(
                                                       totalSpace,
                                                       UNITS_BYTES_DENOMINATINON,
                                                       UNITS_BYTES_MULTIPLIER,
                                                       1
                                                      );
              end;
            end;

            break;
          end;
        end;

      if (statusText = '') then
        begin
        statusText := inttostr(lvDrives.SelCount)+' drives selected.';
        end;

      end;

    StatusBar1.SimpleText := statusText;
    end;

end;


function TfrmFreeOTFEMain.GetDriveLetterFromLVItem(listItem: TListItem): char;
var
  tmpDrv: string;
begin
  // Trim the padding whitespace off the drive letter + colon
  tmpDrv := listItem.Caption;
  tmpDrv := TrimLeft(tmpDrv);

  // The first letter of the item's caption is the drive letter
  Result := tmpDrv[1];

end;

procedure TfrmFreeOTFEMain.lvDrivesDblClick(Sender: TObject);
var
  driveLetter: string;
  explorerCommandLine: string;
begin
  if (lvDrives.selcount > 0) then
    begin
    driveLetter := GetDriveLetterFromLVItem(lvDrives.selected);

    if (driveLetter<>'') then
      begin
      explorerCommandLine := 'explorer '+driveLetter+':\';

      if (WinExec(PChar(explorerCommandLine), SW_RESTORE))<31 then
        begin
        SDUMessageDlg('Error running Explorer', mtError, [], 0);
        end;

      end;
    end;

end;

procedure TfrmFreeOTFEMain.actDriversExecute(Sender: TObject);
var
  UACEscalateAttempted: boolean;
begin
  UACEscalateAttempted := FALSE;

  DeactivateFreeOTFEComponent();
  try
    try
      // This is surrounded by a try...finally as it may throw an exception if
      // the user doesn't have sufficient privs to do this
      OTFEFreeOTFE.ShowDriverControlDlg();

      // Send out a message to any other running instances of FreeOTFE to
      // refresh; the drivers may have changed.
      // Note that if we had to UAC escalate (see exception below), the UAC
      // escalated process will send out this windows message
      SDUPostMessageExistingApp(GLOBAL_VAR_WM_FREEOTFE_REFRESH, 0, 0);
    except
      on EFreeOTFENeedAdminPrivs do
        begin
        UACEscalateForDriverInstallation();
        UACEscalateAttempted := TRUE;
        end;
    end;

  finally
    // Note: We supress any messages that may be the result of failing to
    //       activate the OTFEFreeOTFE componentactivating the if we had to
    //       UAC escalate.
    //       In that situation, the UAC escalated process will sent out a
    //       refresh message when it's done. 
    ActivateFreeOTFEComponent(UACEscalateAttempted);

    EnableDisableControls();
  end;

end;


function TfrmFreeOTFEMain.ActivateFreeOTFEComponent(suppressMsgs: boolean): boolean;
var
  obsoleteDriver: boolean;
begin
  obsoleteDriver:= FALSE;
  try
    OTFEFreeOTFE.Active := TRUE;
  except
    on EFreeOTFEObsoleteDriver do
      begin
      obsoleteDriver := TRUE;
      end;

  else
    // We should only get to here if the FreeOTFE driver isn't both
    // installed & started

  end;


  if (