setupldr.dpr

源代码

program SetupLdr;

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

  Setup Loader

  $jrsoftware: issrc/Projects/SetupLdr.dpr,v 1.23 2004/07/23 00:00:46 jr Exp $
}

uses
  XPTheme,
  Windows,
  Messages,
  SysUtils,
  Compress in 'Compress.pas',
  LZMA in 'LZMA.pas',
  SetupEnt in 'SetupEnt.pas',
  CmnFunc2 in 'CmnFunc2.pas',
  Msgs in 'Msgs.pas',
  MsgIDs in 'MsgIDs.pas',
  Struct in 'Struct.pas',
  InstFunc in 'InstFunc.pas',
  FileClass in 'FileClass.pas';

{$R *.RES}

procedure RaiseLastError(const Msg: TSetupMessageID);
var
  ErrorCode: DWORD;
begin
  ErrorCode := GetLastError;
  raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
    [SetupMessages[Msg], IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
end;

procedure ShowExceptionMsg;
begin
  if ExceptObject is EAbort then
    Exit;
  MessageBox(0, PChar(GetExceptMessage), Pointer(SetupMessages[msgErrorTitle]),
    MB_OK or MB_ICONSTOP);
    { ^ use a Pointer cast instead of a PChar cast so that it will use "nil"
      if SetupMessages[msgErrorTitle] is empty due to the messages not being
      loaded yet. MessageBox displays 'Error' as the caption if the lpCaption
      parameter is nil. }
end;

type
  PLanguageEntryArray = ^TLanguageEntryArray;
  TLanguageEntryArray = array[0..999999] of TSetupLanguageEntry;

var
  InitDisableStartupPrompt: Boolean = False;
  InitLang: String;
  ActiveLanguage: Integer = -1;
  SetupHeader: TSetupHeader;
  LanguageEntries: PLanguageEntryArray;
  LanguageEntryCount: Integer;
  SetupLdrExitCode: Integer = 0;
  SetupLdrWnd: HWND = 0;
  OrigWndProc: Pointer;
  RestartSystem: Boolean = False;

procedure ProcessCommandLine;
var
  I: Integer;
  Name: String;
begin
  for I := 1 to NewParamCount do begin
    Name := NewParamStr(I);
    if CompareText(Name, '/SP-') = 0 then
      InitDisableStartupPrompt := True
    else if CompareText(Copy(Name, 1, 6), '/Lang=') = 0 then
      InitLang := Copy(Name, 7, Maxint);
  end;
end;

procedure SetActiveLanguage(const I: Integer);
{ Activates the specified language }
begin
  if (I >= 0) and (I < LanguageEntryCount) and (I <> ActiveLanguage) then begin
    AssignSetupMessages(LanguageEntries[I].Data[1], Length(LanguageEntries[I].Data));
    ActiveLanguage := I;
  end;
end;

procedure ActivateDefaultLanguage;
{ Auto-detects the most appropriate language and activates it.
  Note: A like-named version of this function is also present in Main.pas. }
var
  I: Integer;
  UILang: LANGID;
begin
  if InitLang <> '' then begin
    { Use the language specified on the command line, if available }
    for I := 0 to LanguageEntryCount-1 do begin
      if CompareText(InitLang, LanguageEntries[I].Name) = 0 then begin
        SetActiveLanguage(I);
        Exit;
      end;
    end;
  end;

  case SetupHeader.LanguageDetectionMethod of
    ldUILanguage: UILang := GetUILanguage;
    ldLocale: UILang := GetUserDefaultLangID;
  else
    { ldNone }
    UILang := 0;
  end;
  if UILang <> 0 then begin
    { Look for a primary + sub language ID match }
    for I := 0 to LanguageEntryCount-1 do begin
      if LanguageEntries[I].LanguageID = UILang then begin
        SetActiveLanguage(I);
        Exit;
      end;
    end;
    { Look for just a primary language ID match }
    for I := 0 to LanguageEntryCount-1 do begin
      if (LanguageEntries[I].LanguageID and $3FF) = (UILang and $3FF) then begin
        SetActiveLanguage(I);
        Exit;
      end;
    end;
  end;

  { Otherwise, default to the first language }
  SetActiveLanguage(0);
end;

function SetupLdrWndProc(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT;
stdcall;
begin
  Result := 0;
  case Msg of
    WM_QUERYENDSESSION: begin
        { Return zero so that a shutdown attempt can't kill SetupLdr }
      end;
    WM_USER + 150: begin
        if WParam = 10000 then begin
          { Setup wants SetupLdr to restart the computer before it exits }
          RestartSystem := True;
          Result := 1;
        end
        else if WParam = 10001 then begin
          { Setup wants SetupLdr to change its active language }
          try
            SetActiveLanguage(LParam);
          except
            { just ignore any exceptions }
          end;
        end;
      end;
  else
    Result := CallWindowProc(OrigWndProc, Wnd, Msg, WParam, LParam);
  end;
end;

procedure ExecAndWait(const Filename, Parms: String; var ExitCode: Integer);
var
  CmdLine: String;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Msg: TMsg;
begin
  CmdLine := '"' + Filename + '" ' + Parms;

  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  if not CreateProcess(nil, PChar(CmdLine), nil, nil, False, 0, nil, nil,
     StartupInfo, ProcessInfo) then
    RaiseLastError(msgLdrCannotExecTemp);
  with ProcessInfo do begin
    { Don't need the thread handle, so close it now }
    CloseHandle(hThread);
    { Wait until the process returns. Uses MsgWaitForMultipleObjects
      because it has to check the message queue so the "feedback"
      cursor doesn't stay on. }
    repeat
      while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    until MsgWaitForMultipleObjects(1, hProcess, False, INFINITE,
      QS_ALLINPUT) <> WAIT_OBJECT_0+1;
    { Get the exit code }
    GetExitCodeProcess(hProcess, DWORD(ExitCode));
    { Then close the process handle }
    CloseHandle(hProcess);
  end;
end;

procedure SetupCorruptError;
begin
  if SetupMessages[msgSetupFileCorrupt] <> '' then
    raise Exception.Create(SetupMessages[msgSetupFileCorrupt])
  else
    { In case the messages haven't been loaded yet, use the constant }
    raise Exception.Create(SSetupFileCorrupt);
end;

procedure GenerateTempDir(var ADirectory: String);
var
  Dir: String;
  ErrorCode: DWORD;
begin
  while True do begin
    Dir := GenerateUniqueName(GetTempDir, '.tmp');
    if CreateDirectory(PChar(Dir), nil) then
      Break;
    ErrorCode := GetLastError;
    if ErrorCode <> ERROR_ALREADY_EXISTS then
      raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
        [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
         Win32ErrorString(ErrorCode)]));
  end;
  ADirectory := Dir;
end;

procedure RunImageLocally(const Module: HMODULE);
{ Force all of the specified module to be paged in to ensure subsequent
  accesses don't cause the disk image to be read.
  Based on code from http://www.microsoft.com/msj/0398/win320398.htm, with
  some fixes incorporated. }

  procedure Touch(var X: DWORD);
  { Note: Uses asm to ensure it isn't optimized away }
  asm