freeotfefrmmain.pas

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

unit FreeOTFEfrmMain;
// Description:
// By Sarah Dean
// Email: [e-mail]
// WWW:   http://www.FreeOTFE.org/
//
// -----------------------------------------------------------------------------
//


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Spin, StdCtrls, ComCtrls, ImgList, ExtCtrls, Grids, Menus, OTFE_U,
  OTFEFreeOTFE_U, Shredder, MouseRNGDialog_U, ActnList,
  FreeOTFESettings, SDUSystemTrayIcon, ToolWin, Buttons, XPMan;


type
  TPortableModeAction = (pmaStart, pmaStop, pmaToggle);

  TfrmFreeOTFEMain = class(TForm)
    ilDriveIcons: TImageList;
    lvDrives: TListView;
    pmDrives: TPopupMenu;
    miPopupDismount: TMenuItem;
    mmMain: TMainMenu;
    File1: TMenuItem;
    miFreeOTFEMountFile: TMenuItem;
    miDismountMain: TMenuItem;
    miExit: TMenuItem;
    N2: TMenuItem;
    miPopupProperties: TMenuItem;
    N3: TMenuItem;
    miFreeOTFENew: TMenuItem;
    View1: TMenuItem;
    miProperties: TMenuItem;
    N1: TMenuItem;
    miRefresh: TMenuItem;
    OpenDialog: TOpenDialog;
    Help1: TMenuItem;
    About1: TMenuItem;
    miDismountAllMain: TMenuItem;
    miPopupDismountAll: TMenuItem;
    N4: TMenuItem;
    miLinuxVolume: TMenuItem;
    miLinuxNew: TMenuItem;
    miLinuxMountFile: TMenuItem;
    OTFEFreeOTFE: TOTFEFreeOTFE;
    N5: TMenuItem;
    miFreeOTFEDrivers: TMenuItem;
    miLinuxDismount: TMenuItem;
    miTools: TMenuItem;
    miOverwriteFreeSpace: TMenuItem;
    miFormat: TMenuItem;
    N6: TMenuItem;
    miPopupFormat: TMenuItem;
    miPopupOverwriteFreeSpace: TMenuItem;
    MouseRNGDialog1: TMouseRNGDialog;
    N7: TMenuItem;
    miPortableModeDrivers: TMenuItem;
    N8: TMenuItem;
    miCDBBackup: TMenuItem;
    miCDBRestore: TMenuItem;
    miCreateKeyfile: TMenuItem;
    miChangePassword: TMenuItem;
    miCDBPlaintextDump: TMenuItem;
    miCDB: TMenuItem;
    miFreeOTFEMountPartition: TMenuItem;
    miLinuxMountPartition: TMenuItem;
    N9: TMenuItem;
    miLUKSDump: TMenuItem;
    ActionList1: TActionList;
    actFreeOTFENew: TAction;
    actFreeOTFEMountFile: TAction;
    actFreeOTFEMountPartition: TAction;
    actDismount: TAction;
    actDismountAll: TAction;
    actLinuxNew: TAction;
    actLinuxMountFile: TAction;
    actLinuxMountPartition: TAction;
    actProperties: TAction;
    pmSystemTray: TPopupMenu;
    actExit: TAction;
    open1: TMenuItem;
    open2: TMenuItem;
    mountfile1: TMenuItem;
    mountpartition1: TMenuItem;
    dismountall1: TMenuItem;
    N10: TMenuItem;
    miOptions: TMenuItem;
    actDisplayConsole: TAction;
    N11: TMenuItem;
    N12: TMenuItem;
    SDUSystemTrayIcon1: TSDUSystemTrayIcon;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ilToolbarIcons: TImageList;
    actTogglePortableMode: TAction;
    StatusBar1: TStatusBar;
    actFormat: TAction;
    actOverwriteFreeSpace: TAction;
    pbtbTogglePortableMode: TToolButton;
    XPManifest1: TXPManifest;
    actDrivers: TAction;
    actRefresh: TAction;
    procedure actDriversExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actRefreshExecute(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure lvDrivesResize(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure lvDrivesClick(Sender: TObject);
    procedure lvDrivesDblClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure miCDBBackupClick(Sender: TObject);
    procedure miCDBRestoreClick(Sender: TObject);
    procedure miCreateKeyfileClick(Sender: TObject);
    procedure miChangePasswordClick(Sender: TObject);
    procedure miCDBPlaintextDumpClick(Sender: TObject);
    procedure miLUKSDumpClick(Sender: TObject);
    procedure actFreeOTFENewExecute(Sender: TObject);
    procedure actFreeOTFEMountFileExecute(Sender: TObject);
    procedure actFreeOTFEMountPartitionExecute(Sender: TObject);
    procedure actDismountExecute(Sender: TObject);
    procedure actDismountAllExecute(Sender: TObject);
    procedure actLinuxNewExecute(Sender: TObject);
    procedure actLinuxMountFileExecute(Sender: TObject);
    procedure actLinuxMountPartitionExecute(Sender: TObject);
    procedure actPropertiesExecute(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure miOptionsClick(Sender: TObject);
    procedure actDisplayConsoleExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure actTogglePortableModeExecute(Sender: TObject);
    procedure lvDrivesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure actFormatExecute(Sender: TObject);
    procedure actOverwriteFreeSpaceExecute(Sender: TObject);
    procedure pbtbTogglePortableModeMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    // Flag to indicate that the login session is about to end
    EndSessionFlag: boolean;
    // Flag to indicate that the executable is about to exit
    ShuttingDownFlag: boolean;

    TempCypherDriver: string;
    TempCypherGUID: TGUID;
    TempCypherDetails: TFreeOTFECypher;
    TempCypherKey: string;
    TempCypherIV: int64;

    IconMounted: TIcon;
    IconUnmounted: TIcon;

    // We cache this information as it take a *relativly* long time to get it
    // from the OTFE component.
    CountPortableDrivers: integer;

  protected
    AllowUACEsclation: boolean;

    function  ActivateFreeOTFEComponent(suppressMsgs: boolean): boolean;
    procedure DeactivateFreeOTFEComponent();

    procedure InitializeDrivesDisplay();
    procedure RefreshDrives();
    function  AddIconForDrive(driveLetter: char): integer;

    procedure EnableDisableControls();
    function  GetDriveLetterFromLVItem(listItem: TListItem): char;

    procedure DumpDetailsToFile(LUKSDump: boolean);

    procedure ResizeWindow();

    // Set "mountAsSystem" to either:
    //   FREEOTFE
    //   LINUX
    //   PROMPT
    procedure MountFiles(mountAsSystem: TDragDropFileType; filenames: TStringList; readOnly: boolean);

    procedure DriveProperties();

    function  DismountSelected(): boolean;
    function  DismountAll(isEmergency: boolean = FALSE): boolean;
    function  DismountDrives(dismountDrives: string; isEmergency: boolean): boolean;
    procedure ReportDrivesNotDismounted(drivesRemaining: string; isEmergency: boolean);

    function  PortableModeSet(setTo: TPortableModeAction; suppressMsgs: boolean): boolean;
    function  _PortableModeStart(suppressMsgs: boolean): boolean;
    function  _PortableModeStop(suppressMsgs: boolean): boolean;
    function  _PortableModeToggle(suppressMsgs: boolean): boolean;

    // System tray icon related...
    procedure SystemTrayIconDismount(Sender: TObject);
    procedure DestroySysTrayIconMenuitems();

    // Hotkey related...
    procedure SetupHotKeys();
    procedure EnableHotkey(hotKey: TShortCut; hotKeyIdent: integer);
    procedure DisableHotkey(hotKeyIdent: integer);

    // Vista fix
    procedure WMSyscommand(var Message: TWmSysCommand); message WM_SYSCOMMAND;
    procedure AddUACShieldIcons();

    procedure UACEscalateForDriverInstallation();
    procedure UACEscalateForPortableMode(portableAction: TPortableModeAction; suppressMsgs: boolean);
    procedure UACEscalate(cmdLineParams: string; suppressMsgs: boolean);

  public
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
    procedure WMDeviceChange(var Msg : TMessage); message WM_DEVICECHANGE;
    procedure WMQueryEndSession(var msg: TWMQueryEndSession); message WM_QUERYENDSESSION;
    procedure WMEndSession(var msg: TWMEndSession); message WM_ENDSESSION;

    procedure GenerateOverwriteData(Sender: TObject; passNumber: integer; bytesRequired: cardinal; var outputBlock: TShredBlock);

    procedure InitApp();

    function MessageHook(var msg: TMessage): boolean;

    // Handle any command line options; returns TRUE if command line options
    // were passed through
    function HandleCommandLineOpts(var exitCode: integer): boolean;

    // Vista fix
    procedure CreateParams(var Params: TCreateParams); override;

  end;

var
  frmFreeOTFEMain: TfrmFreeOTFEMain;
  GLOBAL_VAR_WM_FREEOTFE_RESTORE: cardinal;
  GLOBAL_VAR_WM_FREEOTFE_REFRESH: cardinal;

implementation

{$R *.DFM}
{$R FreeOTFESystemTrayIcons.dcr}

uses
  ShellApi,  // Required for SHGetFileInfo
  Commctrl,  // Required for ImageList_GetIcon
  ComObj,  // Required for StringToGUID
  Math,  // Required for min
  SDUGeneral,
  SDUDialogs,
  About_U,
  FreeOTFEfrmVolProperties,
  FreeOTFEfrmSelectOverwriteMethod,
  FreeOTFEfrmCDBDump,
  FreeOTFEfrmCDBBackupRestore,
  FreeOTFEfrmOptions,
  OTFEConsts_U,
  SDUFileIterator_U;

const
  TEXT_NEED_ADMIN =
           'You need administrator privileges in order to carry out this operation.';


  // Format disk related functions ripped from the Unofficial Delphi FAQ (UDF)
  SHFMT_ID_DEFAULT        = $FFFF;
  // Formating options
  SHFMT_OPT_QUICKFORMAT   = $0000;
  SHFMT_OPT_FULL          = $0001;
  SHFMT_OPT_SYSONLY       = $0002;
  // Error codes
  SHFMT_ERROR             = $FFFFFFFF;
  SHFMT_CANCEL            = $FFFFFFFE;
  SHFMT_NOFORMAT          = $FFFFFFFD;

  R_ICON_MOUNTED   = 'MOUNTED';
  R_ICON_UNMOUNTED = 'UNMOUNTED';

  POPUP_DISMOUNT_INITIAL_TXT = 'Dismount ';

  TAG_SYSTRAYICON_POPUPMENUITEMS = 5000;

  HOTKEY_TEXT_NONE = '(None)';
  HOTKEY_IDENT_DISMOUNT      = 1;
  HOTKEY_IDENT_DISMOUNTEMERG = 2;

  // Command line switch indicator
  // Note: Only used when creating command lines; parsing them is more flexable
  CMDLINE_SWITCH_IND = '/';

  // Command line parameters...
  CMDLINE_NOUACESCALATE = 'noUACescalate';
  CMDLINE_DRIVERINSTALL = 'driverinstall';
  CMDLINE_PORTABLE      = 'portable';
  CMDLINE_START         = 'start';
  CMDLINE_ON            = 'on';
  CMDLINE_STOP          = 'stop';
  CMDLINE_OFF           = 'off';
  CMDLINE_TOGGLE        = 'toggle';
  CMDLINE_MOUNT         = 'mount';
  CMDLINE_FREEOTFE      = 'freeotfe';
  CMDLINE_LINUX         = 'linux';
  CMDLINE_VOLUME        = 'volume';
  CMDLINE_READONLY      = 'readonly';
  CMDLINE_DISMOUNT      = 'dismount';
  CMDLINE_FORCE         = 'force';
  CMDLINE_ALL           = 'all';
  CMDLINE_SUPPRESS      = 'suppress';

  // Command line return values...
  CMDLINE_SUCCESS                            =   0;
  CMDLINE_EXIT_INVALID_CMDLINE               = 100;
  CMDLINE_EXIT_UNABLE_TO_CONNECT             = 101;
  CMDLINE_EXIT_UNABLE_TO_MOUNT               = 102;
  CMDLINE_EXIT_UNABLE_TO_DISMOUNT            = 103;
  CMDLINE_EXIT_UNABLE_TO_START_PORTABLE_MODE = 104;
  CMDLINE_EXIT_UNABLE_TO_STOP_PORTABLE_MODE  = 105;


// External function in shell32.dll
function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt;
            stdcall; external 'shell32.dll' name 'SHFormatDrive'


// This procedure is called after OnCreate, and immediatly before the
// Application.Run() is called
procedure TfrmFreeOTFEMain.InitApp();
var
  goForStartPortable: boolean;
begin
  // Hook Windows messages first; if we're running under Vista and the user UAC
  // escalates to start portable mode (below), we don't want to miss any
  // refresh messages the escalated process may send us!
  Application.HookMainWindow(MessageHook);

  InitializeDrivesDisplay();
  // We call EnableDisableControls(...) at this point, to display the
  // toolbar/statusbar as needed
  EnableDisableControls();

  if not(ActivateFreeOTFEComponent(TRUE)) then
    begin
    goForStartPortable := Settings.OptAutoStartPortable;
    if not(goForStartPortable) then
      begin
      goForStartPortable := (SDUMessageDlg(
               'The main FreeOTFE driver does not appear to be installed/running on this computer'+SDUCRLF+
               SDUCRLF+
               'Would you like to start FreeOTFE in portable mode?',
               mtConfirmation,
               [mbYes, mbNo],
               0
              ) = mrYes);
      end;

    if goForStartPortable then
      begin
      PortableModeSet(pmaStart, FALSE);
      end
    else
      begin
      SDUMessageDlg(
             'Please see the "installation" section of the accompanying documentation'+SDUCRLF+
             'for instructions on how to install the FreeOTFE drivers.',
             mtInformation,
             [mbOK],
             0
            );
      end;

    end;

  RefreshDrives();
  EnableDisableControls();
  SetupHotKeys();

end;

procedure TfrmFreeOTFEMain.RefreshDrives();
var
  ListItem: TListItem;
  driveIconNum: integer;
  i: integer;
  volumeInfo: TOTFEFreeOTFEVolumeInfo;
  mounted: string;
  miTmp: TMenuItem;
  strVolID: string;
begin
  // Flush any caches in case a separate instance of FreeOTFE running from the
  // commandline, with escalated UAC changed the drivers installed/running
  OTFEFreeOTFE.CachesFlush();

  // Cleardown all...

  // ...Main FreeOTFE window list...
  lvDrives.Items.Clear();
  ilDriveIcons.Clear();

  // ...System tray icon drives list...
  DestroySysTrayIconMenuitems();

  // In case the drivers have been stopped/started recently, we bounce the
  // FreeOTFE component up and down (silently!)
  DeactivateFreeOTFEComponent();
  ActivateFreeOTFEComponent(TRUE);

  /// ...and repopulate
  if OTFEFreeOTFE.Active then
    begin
    mounted := OTFEFreeOTFE.DrivesMounted();

    for i:=1 to length(mounted) do
      begin
      // ...Main FreeOTFE window list...
      if OTFEFreeOTFE.GetVolumeInfo(mounted[i], volumeInfo) then
        begin
        ListItem := lvDrives.Items.Add;
        ListItem.Caption := '     '+mounted[i]+':';
        ListItem.SubItems.Add(volumeInfo.Filename);
        driveIconNum := AddIconForDrive(mounted[i]);
        if (driveIconNum>=0) then
          begin
          ListItem.ImageIndex := driveIconNum;
          end;
        end
      else
        begin
        // Strange... The drive probably got dismounted between getting the
        // list of mounted drives, and querying them for more information...
        end;


        // The volume ID/label
        strVolID := SDUVolumeID(mounted[i]);
        if strVolID<>'' then
          begin
          strVolID := '['+strVolID+']';
          end;

        // ...System tray icon popup menu...
        miTmp := TMenuItem.Create(nil);
        miTmp.Tag := TAG_SYSTRAYICON_POPUPMENUITEMS;  // We tag our menuitems
                                                      // in order that we can
                                                      // know which ones to
                                                      // remove later
        miTmp.OnClick := SystemTrayIconDismount;