freeotfefrmmain.pas

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

        miTmp.AutoHotkeys := maManual;  // Otherwise the hotkeys added
                                        // automatically can interfere with
                                        // examing the caption to get the drive
                                        // letter when clicked on
        miTmp.Caption := POPUP_DISMOUNT_INITIAL_TXT+mounted[i]+': '+strVolID;
        pmSystemTray.Items.Insert((i-1), miTmp);
      end;

      // Insert a divider into the system tray icon's popup menu after the
      // drives are listed
      if (length(mounted) > 0) then
        begin
        miTmp := TMenuItem.Create(nil);
        miTmp.Caption := '-';
        pmSystemTray.Items.Insert(length(mounted), miTmp);
        end;

    end;


  CountPortableDrivers := OTFEFreeOTFE.DriversInPortableMode();
  EnableDisableControls();

end;


// Tear down system tray icon popup menu menuitems previously added
procedure TfrmFreeOTFEMain.DestroySysTrayIconMenuitems();
var
  i: integer;
  miTmp: TMenuItem;
begin
  for i:=(pmSystemTray.Items.count-1) downto 0 do
    begin
    if (pmSystemTray.Items[i].Tag = TAG_SYSTRAYICON_POPUPMENUITEMS) then
      begin
      miTmp := pmSystemTray.Items[i];
      pmSystemTray.Items.Delete(i);
      miTmp.Free();
      end;
    end;
end;


procedure TfrmFreeOTFEMain.SystemTrayIconDismount(Sender: TObject);
var
  miDismount: TMenuItem;
  drive: char;
  strMenuCaption: string;
  strInitialCaption: string;
begin
  miDismount := TMenuItem(Sender);

  // We do this as Delphi 5 doesn't appear to honour the miTmp.AutoHotkeys
  // we set earlier?!
  strMenuCaption    := StripHotKey(miDismount.Caption);
  strInitialCaption := StripHotKey(POPUP_DISMOUNT_INITIAL_TXT);

  drive := strMenuCaption[Length(strInitialCaption)+1];

  DismountDrives(drive, FALSE);

  RefreshDrives();
end;


// Add an icon to represent the specified drive
// Returns: The icon's index in ilDriveIcons, or -1 on error
function TfrmFreeOTFEMain.AddIconForDrive(driveLetter: char): integer;
var
  iconIdx: integer;
  anIcon: TIcon;
  shfi: SHFileInfo;
  imgListHandle: THandle;
  iconHandle: HICON;
  tmpDrivePath: string;
begin
  iconIdx := -1;
  
  // Create a suitable icon to represent the drive
  tmpDrivePath := driveLetter+':\';
  imgListHandle := SHGetFileInfo(
                                 PChar(tmpDrivePath),
                                 0,
                                 shfi,
                                 sizeof(shfi),
                                 SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
//                                 SHGFI_DISPLAYNAME

  if imgListHandle<>0 then
    begin
    iconHandle := ImageList_GetIcon(imgListHandle, shfi.iIcon, ILD_NORMAL);
    if (iconHandle<>0) then
      begin
      anIcon:= TIcon.Create();
      try
        anIcon.ReleaseHandle();

        anIcon.handle := iconHandle;

        if (ilDriveIcons.Width<anIcon.Width) then
          begin
          ilDriveIcons.Width := anIcon.Width;
          end;
        if (ilDriveIcons.Height<anIcon.Height) then
          begin
          ilDriveIcons.Height := anIcon.Height;
          end;

        iconIdx := ilDriveIcons.addicon(anIcon);

        anIcon.ReleaseHandle();
        DestroyIcon(iconHandle);
      finally
        anIcon.Free();
      end;

      end;
    end;


  Result := iconIdx;

end;

procedure TfrmFreeOTFEMain.InitializeDrivesDisplay();
var
  tmpColumn: TListColumn;
begin
  // Listview setup...
  lvDrives.SmallImages := ilDriveIcons;
  lvDrives.RowSelect:= TRUE;
  lvDrives.MultiSelect:= TRUE;
  lvDrives.showcolumnheaders := TRUE;
  lvDrives.ReadOnly := TRUE;
  lvDrives.ViewStyle := vsReport;
//    lvDrives.ViewStyle := vsIcon;
//    lvDrives.ViewStyle := vsList;
  lvDrives.IconOptions.Arrangement := iaTop;


  // Listview columns...
  tmpColumn := lvDrives.Columns.Add;
  tmpColumn.Caption := 'Drive';
  tmpColumn.width := 100;

//    tmpColumn.minwidth := lvDrives.width;
  tmpColumn := lvDrives.Columns.Add;
  tmpColumn.Caption := 'Volume';
  tmpColumn.width := lvDrives.clientwidth - lvDrives.columns[0].width - ilDriveIcons.width;


// xxx - shouldn't this work?     NewColumn.autosize := TRUE;
// xxx - shouldn't this work?     NewColumn.minwidth := lvDrives.clientwidth - lvDrives.columns[0].width - ilDriveIcons.width;


// xxx - use destroyimage or whatever it was to cleardown the **imagelist**

end;


// Add an icon to represent the specified drive
// Returns: The icon's index in ilDriveIcons, or -1 on error
procedure TfrmFreeOTFEMain.AddUACShieldIcons();
const
  UAC_IDI_SHIELD = 32518;
var
  iconIdx: integer;
  anIcon: TIcon;
  iconHandle: HICON;
begin
  // Create a suitable icon to represent the drive
  iconHandle := LoadImage(
                          0,
                          PChar(UAC_IDI_SHIELD),
                          IMAGE_ICON,
                          ilToolbarIcons.Width,
                          ilToolbarIcons.Height,
                          (LR_CREATEDIBSECTION or LR_SHARED)
                         );
  if (iconHandle <> 0) then
    begin
    anIcon:= TIcon.Create();
    try
      anIcon.ReleaseHandle();

      anIcon.handle := iconHandle;
      {
      if (ilToolbarIcons.Width < anIcon.Width) then
        begin
        ilToolbarIcons.Width := anIcon.Width;
        end;
      if (ilToolbarIcons.Height < anIcon.Height) then
        begin
        ilToolbarIcons.Height := anIcon.Height;
        end;
       }
      iconIdx := ilToolbarIcons.AddIcon(anIcon);

      anIcon.ReleaseHandle();
      DestroyIcon(iconHandle);
    finally
      anIcon.Free();
    end;

    // Set icons on menuitems
    if (iconIdx >= 0) then
      begin
      miFreeOTFEDrivers.ImageIndex := iconIdx;
      miPortableModeDrivers.ImageIndex := iconIdx;
      actFormat.ImageIndex := iconIdx;
      end;

    end;

end;


procedure TfrmFreeOTFEMain.FormCreate(Sender: TObject);
begin
{$IFDEF FREEOTFE_DEBUG}
  OTFEFreeOTFE.DebugShowMessage := FALSE;  // xxx - disable showmessages(...) of debug if built with debug on
{$ENDIF}

  // Vista fix
  if SDUOSVistaOrLater() then
    begin
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(
                  Application.Handle,
                  GWL_EXSTYLE,
                  (
                   GetWindowLong(Application.Handle, GWL_EXSTYLE) and not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW
                  )
                 );
    ShowWindow(Application.Handle, SW_SHOW);

    // Mark as appropriate with UAC "shield" icons
    AddUACShieldIcons();
    end;

  // Prevent endless loops of UAC escalation...
  AllowUACEsclation := FALSE;

  EndSessionFlag := FALSE;
  ShuttingDownFlag := FALSE;

  self.Caption := Application.Title;
  SDUSystemTrayIcon1.Tip := Application.Title;

  IconMounted:= TIcon.Create();
  IconMounted.Handle := LoadImage(hInstance, PChar(R_ICON_MOUNTED), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);
  IconUnmounted:= TIcon.Create();
  IconUnmounted.Handle := LoadImage(hInstance, PChar(R_ICON_UNMOUNTED), IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);

  // We set these to invisible so that if they're disabled by the user
  // settings, it doens't flicker on them off
  ToolBar1.Visible := FALSE;
  Statusbar1.Visible := FALSE;

  // Give the user a clue
  ToolBar1.ShowHint := TRUE;

  ToolBar1.Indent := 5;

  CountPortableDrivers := -1;

  StatusBar1.SimplePanel := TRUE;

end;

procedure TfrmFreeOTFEMain.actRefreshExecute(Sender: TObject);
begin
  RefreshDrives();

end;

procedure TfrmFreeOTFEMain.About1Click(Sender: TObject);
var
  aboutDlg: TAbout_F;
begin
  aboutDlg:= TAbout_F.Create(self);
  try
    aboutDlg.OTFEFreeOTFE := OTFEFreeOTFE;
    aboutDlg.ShowModal();
  finally
    aboutDlg.Free();
  end;

end;

procedure TfrmFreeOTFEMain.lvDrivesResize(Sender: TObject);
begin
  ResizeWindow();

end;


procedure TfrmFreeOTFEMain.FormResize(Sender: TObject);
begin
  ResizeWindow();

end;


// Resize the columns in the drives list so the 2nd column fills out...
procedure TfrmFreeOTFEMain.ResizeWindow();
var
  tmpColumn: TListColumn;
begin
  if lvDrives.columns.count>1 then
    begin
    tmpColumn := lvDrives.columns[1];
    tmpColumn.width := lvDrives.clientwidth - lvDrives.columns[0].width - ilDriveIcons.width;
    end;

end;


procedure TfrmFreeOTFEMain.MountFiles(mountAsSystem: TDragDropFileType; filenames: TStringList; readOnly: boolean);
var
  i: integer;
  mountedAs: string;
  msg: string;
  errMsg: string;
  mountedOK: boolean;
begin
  if (mountAsSystem = ftFreeOTFE) then
    begin
    mountedOK:= OTFEFreeOTFE.MountFreeOTFE(filenames, mountedAs, readOnly);
    end
  else if (mountAsSystem = ftLinux) then
    begin
    mountedOK:= OTFEFreeOTFE.MountLinux(filenames, mountedAs, readOnly);
    end
  else
    begin
    mountedOK:= OTFEFreeOTFE.Mount(filenames, mountedAs, readOnly);
    end;

  if not(mountedOK) then
    begin
    if (OTFEFreeOTFE.LastErrorCode <> OTFE_ERR_USER_CANCEL) then
      begin
      errMsg := 'Unable to mount volume; please ensure that you entered the '+SDUCRLF+
                'correct details (password, etc)'+SDUCRLF+
                SDUCRLF+
                'If you are using a keyfile, please ensure that you check/uncheck the'+SDUCRLF+
                '"Data from offset includes CDB" option, as appropriate for your'+SDUCRLF+
                'volume.';
      if (OTFEFreeOTFE.LastErrorCode = OTFE_ERR_NO_FREE_DEVICES) then
        begin
        errMsg := 'Your volume could not be mounted at this time as there are'+SDUCRLF+
                  'no suitable FreeOTFE devices free.'+SDUCRLF+
                  SDUCRLF+
                  'Please dismount one or more volumes, and try again.';
        end;

      SDUMessageDlg(errMsg, mtError, [mbOK], 0);
      end;

    end
  else
    begin
    if (length(mountedAs)=1) then
      begin
      msg := 'Your FreeOTFE volume has been mounted as drive: ';
      end
    else
      begin
      msg := 'Your FreeOTFE volumes have been mounted as drives: ';
      end;

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

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

    RefreshDrives();
    SDUMessageDlg(msg, mtInformation, [mbOK], 0);
    end;

end;


// Handle files being dropped onto the form from (for example) Windows Explorer.
// Files dropped onto the form should be treated as though the user is trying
// to mount them as volume files
procedure TfrmFreeOTFEMain.WMDropFiles(var Msg: TWMDropFiles);
var
  buffer: array[0..MAX_PATH] of Char;
  numFiles: longint;
  i: integer;
  filesToMount: TStringList;
begin
  try
    // Bring our window to the foreground
    SetForeGroundWindow(self.handle);

    // Handle the dropped files
    numFiles := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
    filesToMount := TStringList.Create();
    try
      for i:=0 to (numFiles-1) do
        begin
        DragQueryFile(msg.Drop,
                      i,
                      @buffer,
                      sizeof(buffer));
        filesToMount.Add(buffer);
        end;

      MountFiles(Settings.OptDragDropFileType, filesToMount, FALSE);

      Msg.Result := 0;
    finally
      filesToMount.Free();
    end;
  finally
    DragFinish(Msg.Drop);
  end;

end;


procedure TfrmFreeOTFEMain.WMDeviceChange(var Msg : TMessage);
begin
  RefreshDrives();

end;


// Function required for close to system tray icon
procedure TfrmFreeOTFEMain.WMQueryEndSession(var msg: TWMQueryEndSession);
begin
  // Default to allowing shutdown
  msg.Result := 1;
  EndSessionFlag := (msg.Result = 1);
  inherited;
  EndSessionFlag := (msg.Result = 1);
  
end;


// Function required for close to system tray icon
procedure TfrmFreeOTFEMain.WMEndSession(var msg: TWMEndSession);
begin
  EndSessionFlag := msg.EndSession;

end;