newdisk.pas

源代码

unit NewDisk;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  New Disk form
}

interface

{$I VERSION.INC}

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  SetupForm, StdCtrls, ExtCtrls, NewStaticText, BitmapImage;

type
  TNewDiskForm = class(TSetupForm)
    DiskBitmapImage: TBitmapImage;
    SelectDiskLabel: TNewStaticText;
    PathLabel: TNewStaticText;
    PathEdit: TEdit;
    BrowseButton: TButton;
    OKButton: TButton;
    CancelButton: TButton;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BrowseButtonClick(Sender: TObject);
  private
    { Private declarations }
    Filename: string;
    function GetSanitizedPath: String;
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

function SelectDisk(const DiskNumber: Integer; const AFilename: String; var Path: String): Boolean;
function BrowseForFolder(const Prompt: String; var Directory: String; const ParentWnd: HWND; const NewFolderButton: Boolean): Boolean;
function NewGetOpenFileName(const Prompt: String; var FileName: String; const InitialDirectory, Filter, DefaultExtension: String; const ParentWnd: HWND): Boolean;

implementation

uses
  CommDlg, ShlObj, {$IFNDEF Delphi3orHigher} Ole2, {$ELSE} ActiveX, {$ENDIF}
  Msgs, MsgIDs, PathFunc, CmnFunc, CmnFunc2,
  Main, Wizard;

{$R *.DFM}

function SelectDisk(const DiskNumber: Integer; const AFilename: String;
  var Path: String): Boolean;
begin
  with TNewDiskForm.Create(Application) do
    try
      Filename := AFilename;
      SelectDiskLabel.Caption := FmtSetupMessage(msgSelectDiskLabel2, [IntToStr(DiskNumber)]);
      PathEdit.Text := Path;
      MessageBeep(0);
      Result := ShowModal = mrOK;
      if Result then
        Path := GetSanitizedPath;
    finally
      Free;
    end;
end;

function BrowseCallback(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
    SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
  Result := 0;
end;

function BrowseForFolder(const Prompt: String; var Directory: String; const ParentWnd: HWND; const NewFolderButton: Boolean): Boolean;
const
  BIF_UAHINT = $100;
  BIF_NONEWFOLDERBUTTON = $200;
  BIF_NEWDIALOGSTYLE = $0040;
var
  InitialDir: String;
  Malloc: IMalloc;
  BrowseInfo: TBrowseInfo;
  DisplayName, Path: array[0..MAX_PATH-1] of Char;
  ActiveWindow: HWND;
  WindowList: Pointer;
  IDList: PItemIDList;
begin
  Result := False;
  InitialDir := RemoveBackslashUnlessRoot(Directory);  { Win95 doesn't allow trailing backslash }
  if FAILED(SHGetMalloc(Malloc)) then
    Malloc := nil;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  with BrowseInfo do begin
    hwndOwner := ParentWnd;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar(Prompt);
    ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE or BIF_UAHINT;
    if not NewFolderButton then
      ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON;
    if InitialDir <> '' then begin
      lpfn := BrowseCallback;
      Pointer(lParam) := PChar(InitialDir);
    end;
  end;
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  CoInitialize(nil);
  try
    IDList := SHBrowseForFolder(BrowseInfo);
  finally
    CoUninitialize();
    EnableTaskWindows(WindowList);
    { SetActiveWindow(Application.Handle) is needed or else the focus doesn't
      properly return to ActiveWindow }
    SetActiveWindow(Application.Handle);
    SetActiveWindow(ActiveWindow);
  end;
  try
    if (IDList = nil) or not SHGetPathFromIDList(IDList, Path) then
      Exit;
    Directory := Path;
  finally
    if Assigned(Malloc) then
      Malloc.Free(IDList);
  end;
  Result := True;
end;

function NewGetOpenFileName(const Prompt: String; var FileName: String; const InitialDirectory, Filter, DefaultExtension: String; const ParentWnd: HWND): Boolean;

  function AllocFilterStr(const S: string): string;
  var
    P: PChar;
  begin
    Result := '';
    if S <> '' then
    begin
      Result := S + #0;  // double null terminators
      P := PathStrScan(PChar(Result), '|');
      while P <> nil do
      begin
        P^ := #0;
        Inc(P);
        P := PathStrScan(P, '|');
      end;
    end;
  end;

var
  ofn: TOpenFileName;
  lpstrFile: array[0..MAX_PATH-1] of Char;
  TempFilter: String;
  ActiveWindow: HWND;
  WindowList: Pointer;
  FPUControlWord: Word;
begin
  StrPLCopy(lpstrFile, FileName, SizeOf(lpstrFile)-1);

  FillChar(ofn, SizeOf(ofn), 0);
  ofn.lStructSize := SizeOf(ofn);
  ofn.hwndOwner := ParentWnd;
  TempFilter := AllocFilterStr(Filter);
  ofn.lpstrFilter := PChar(TempFilter);
  ofn.lpstrFile := lpstrFile;
  ofn.nMaxFile := SizeOf(lpstrFile);
  ofn.lpstrInitialDir := PChar(InitialDirectory);
  ofn.lpstrTitle := PChar(Prompt);
  ofn.Flags := OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
  ofn.lpstrDefExt := Pointer(DefaultExtension);

  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  try
    asm
      // Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
      FNSTCW  FPUControlWord
    end;
    try
      if GetOpenFileName(ofn) then begin
        FileName := lpstrFile;
        Result := True;
      end else
        Result := False;
    finally
      asm
        FNCLEX
        FLDCW FPUControlWord
      end;
    end;
  finally
    EnableTaskWindows(WindowList);
    { SetActiveWindow(Application.Handle) is needed or else the focus doesn't
      properly return to ActiveWindow }
    SetActiveWindow(Application.Handle);
    SetActiveWindow(ActiveWindow);
  end;
end;

{ TNewDiskForm }

constructor TNewDiskForm.Create(AOwner: TComponent);
begin
  inherited;

  InitializeFont;
  CenterInsideControl(WizardForm, False);

  Caption := SetupMessages[msgChangeDiskTitle];
  PathLabel.Caption := SetupMessages[msgPathLabel];
  BrowseButton.Caption := SetupMessages[msgButtonBrowse];
  OKButton.Caption := SetupMessages[msgButtonOK];
  CancelButton.Caption := SetupMessages[msgButtonCancel];

  DiskBitmapImage.Bitmap.Handle := LoadBitmap(HInstance, 'DISKIMAGE');  {don't localize};
  DiskBitmapImage.ReplaceColor := clBlue;
  DiskBitmapImage.ReplaceWithColor := Color;
end;

function TNewDiskForm.GetSanitizedPath: String;
begin
  Result := PathExpand(RemoveBackslashUnlessRoot(Trim(PathEdit.Text)));
end;

procedure TNewDiskForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Path: String;
begin
  case ModalResult of
    mrOK: begin
        Path := GetSanitizedPath;
        if (Path = '') or not NewFileExists(AddBackslash(Path) + Filename) then begin
          CanClose := False;
          MsgBox(FmtSetupMessage(msgFileNotInDir2, [Filename, Path]),
            '', mbError, MB_OK);
        end;
      end;
    mrCancel: CanClose := ExitSetupMsgBox;
  end;
end;

procedure TNewDiskForm.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
  { Leave Message.Result at 0; deny shutdown attempts. This is to prevent
    nested calls to FormCloseQuery. (The default VCL handler for
    WM_QUERYENDSESSION calls CloseQuery.) }
end;

procedure TNewDiskForm.BrowseButtonClick(Sender: TObject);
var
  Dir: String;
begin
  Dir := GetSanitizedPath;
  if BrowseForFolder(SetupMessages[msgSelectDirectoryLabel], Dir, Handle, False) then
    PathEdit.Text := Dir;
end;

var
  WM_QueryCancelAutoPlay: UINT;

procedure TNewDiskForm.WndProc(var Message: TMessage);
begin
  { When we receive a 'QueryCancelAutoPlay' message as a result of a new CD
    being inserted, return 1 to prevent it from being 'autoplayed'.
    Note: According to the docs, this message is only sent on Shell version
    4.70 and later. }
  if Message.Msg = WM_QueryCancelAutoPlay then
    Message.Result := 1
  else
    inherited;
end;

initialization
  WM_QueryCancelAutoPlay := RegisterWindowMessage('QueryCancelAutoPlay');
end.