main.pas

源代码

begin
  DebugNotifyIntermediate(deCodeLine, Position);
end;

procedure CodeRunnerOnException(const Exception: String; const Position: LongInt);
begin
  if Debugging then
    DebugNotifyException(Exception, deCodeLine, Position);
end;

procedure SetActiveLanguage(const I: Integer);
{ Activates the specified language }
var
  LangEntry: PSetupLanguageEntry;
  J: Integer;
begin
  if ActiveLanguage = I then
    Exit;

  LangEntry := Entries[seLanguage][I];

  AssignSetupMessages(LangEntry.Data[1], Length(LangEntry.Data));

  ActiveLanguage := I;
  Finalize(LangOptions);  { prevent leak on D2 }
  LangOptions := LangEntry^;

  if LangEntry.LicenseText <> '' then
    ActiveLicenseText := LangEntry.LicenseText
  else
    ActiveLicenseText := SetupHeader.LicenseText;

  if LangEntry.InfoBeforeText <> '' then
    ActiveInfoBeforeText := LangEntry.InfoBeforeText
  else
    ActiveInfoBeforeText := SetupHeader.InfoBeforeText;

  if LangEntry.InfoAfterText <> '' then
    ActiveInfoAfterText := LangEntry.InfoAfterText
  else
    ActiveInfoAfterText := SetupHeader.InfoAfterText;

  SetMessageBoxCaption(mbInformation, PChar(SetupMessages[msgInformationTitle]));
  SetMessageBoxCaption(mbConfirmation, PChar(SetupMessages[msgConfirmTitle]));
  SetMessageBoxCaption(mbError, PChar(SetupMessages[msgErrorTitle]));
  SetMessageBoxCaption(mbCriticalError, PChar(SetupMessages[msgErrorTitle]));
  Application.Title := SetupMessages[msgSetupAppTitle];

  for J := 0 to Entries[seType].Count-1 do begin
    with PSetupTypeEntry(Entries[seType][J])^ do begin
      case Typ of
        ttDefaultFull: Description := SetupMessages[msgFullInstallation];
        ttDefaultCompact: Description := SetupMessages[msgCompactInstallation];
        ttDefaultCustom: Description := SetupMessages[msgCustomInstallation];
      end;
    end;
  end;

  { Tell SetupLdr to change its language too. (It's possible for SetupLdr to
    display messages after Setup terminates, e.g. if it fails to restart the
    computer.) }
  if SetupLdrMode then
    SendNotifyMessage(SetupLdrWnd, WM_USER + 150, 10001, I);
end;

procedure ActivateDefaultLanguage;
{ Auto-detects the most appropriate language and activates it.
  Also initializes the ShowLanguageDialog variable.
  Note: A like-named version of this function is also present in SetupLdr.dpr. }
var
  I: Integer;
  UILang: LANGID;
begin
  ShowLanguageDialog := (SetupHeader.ShowLanguageDialog = slYes);

  if InitLang <> '' then begin
    { Use the language specified on the command line, if available }
    for I := 0 to Entries[seLanguage].Count-1 do begin
      if CompareText(InitLang, PSetupLanguageEntry(Entries[seLanguage][I]).Name) = 0 then begin
        SetActiveLanguage(I);
        ShowLanguageDialog := False;
        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 Entries[seLanguage].Count-1 do begin
      if PSetupLanguageEntry(Entries[seLanguage][I]).LanguageID = UILang then begin
        SetActiveLanguage(I);
        Exit;
      end;
    end;
    { Look for just a primary language ID match }
    for I := 0 to Entries[seLanguage].Count-1 do begin
      if (PSetupLanguageEntry(Entries[seLanguage][I]).LanguageID and $3FF) = (UILang and $3FF) then begin
        SetActiveLanguage(I);
        Exit;
      end;
    end;
  end;

  { Otherwise, default to the first language }
  SetActiveLanguage(0);
  if SetupHeader.ShowLanguageDialog = slAuto then
    ShowLanguageDialog := True;
end;

procedure SetTaskbarButtonVisibility(const AVisible: Boolean);
var
  ExStyle: Longint;
begin
  { The taskbar button is hidden by setting the WS_EX_TOOLWINDOW style on the
    application window. We can't simply hide the window because on D3+ the VCL
    would just show it again in TApplication.UpdateVisible when the first form
    is shown. }
  if (GetWindowLong(Application.Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) <> AVisible then begin
    SetWindowPos(Application.Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or
      SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    ExStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
    if AVisible then
      ExStyle := ExStyle and not WS_EX_TOOLWINDOW
    else
      ExStyle := ExStyle or WS_EX_TOOLWINDOW;
    SetWindowLong(Application.Handle, GWL_EXSTYLE, ExStyle);
    if AVisible then
      { Show and activate when becoming visible }
      ShowWindow(Application.Handle, SW_SHOW)
    else
      SetWindowPos(Application.Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or
        SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  end;
end;

procedure InitializeCommonVars;
{ Initializes variables shared between Setup and Uninstall }
begin
  IsAdmin := IsAdminLoggedOn;
  IsPowerUser := IsAdmin or IsPowerUserLoggedOn;
  Randomize;
end;

procedure InitializeSetup;
{ Initializes various vars used by the setup. This is called in the project
  source. }

  function VerToStr(Ver: Cardinal; ServicePack: Word): String;
  var
    Digits: Integer;
  begin
    with TSetupVersionDataVersion(Ver) do begin
      Digits := 2;
      if Minor mod 10 = 0 then begin
        Dec(Digits);
        Minor := Minor div 10;
      end;
      FmtStr(Result, '%d.%.*d', [Major, Digits, Minor]);
      if Build <> 0 then
        Result := Result + Format('.%d', [Build]);
      if ServicePack <> 0 then begin
        Result := Result + ' Service Pack ' + IntToStr(Hi(ServicePack));
        if Lo(ServicePack) <> 0 then
          Result := Result + Format('.%d', [Lo(ServicePack)]);
      end;
    end;
  end;

  procedure AbortInit(const Msg: TSetupMessageID);
  begin
    MsgBox(SetupMessages[Msg], '', mbCriticalError, MB_OK);
    Abort;
  end;

  procedure AbortInitFmt1(const Msg: TSetupMessageID; const Arg1: String);
  begin
    MsgBox(FmtSetupMessage(Msg, [Arg1]), '', mbCriticalError, MB_OK);
    Abort;
  end;

  procedure AbortInitVerError(const Msg: TSetupMessageID; const Platform: String;
    const Ver: Cardinal; const ServicePack: Word);
  begin
    MsgBox(FmtSetupMessage(Msg, [Platform, VerToStr(Ver, ServicePack)]), '',
      mbCriticalError, MB_OK);
    Abort;
  end;

  procedure ReadFileIntoStream(const Stream: TStream;
    const R: TCompressedBlockReader);
  type
    PBuffer = ^TBuffer;
    TBuffer = array[0..8191] of Byte;
  var
    Buf: PBuffer;
    BytesLeft, Bytes: Longint;
  begin
    New(Buf);
    try
      R.Read(BytesLeft, SizeOf(BytesLeft));
      while BytesLeft > 0 do begin
        Bytes := BytesLeft;
        if Bytes > SizeOf(Buf^) then Bytes := SizeOf(Buf^);
        R.Read(Buf^, Bytes);
        Stream.WriteBuffer(Buf^, Bytes);
        Dec(BytesLeft, Bytes);
      end;
    finally
      Dispose(Buf);
    end;
  end;

  procedure ReadWizardImage(var WizardImage: TBitmap; const R: TCompressedBlockReader);
  var
    MemStream: TMemoryStream;
  begin
    MemStream := TMemoryStream.Create;
    try
      ReadFileIntoStream(MemStream, R);
      MemStream.Seek(0, soFromBeginning);
      WizardImage := TBitmap.Create;
      WizardImage.LoadFromStream(MemStream);
    finally
      MemStream.Free;
    end;
  end;

  procedure LoadDecompressorDLL;
  var
    Filename: String;
  begin
    Filename := AddBackslash(TempInstallDir) + '_isdecmp.dll';
    SaveStreamToTempFile(DecompressorDLL, Filename);
    FreeAndNil(DecompressorDLL);
    DecompressorDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
    if DecompressorDLLHandle = 0 then
      InternalError(Format('Failed to load DLL "%s"', [Filename]));
    case SetupHeader.CompressMethod of
      cmZip:
        if not ZlibInitDecompressFunctions(DecompressorDLLHandle) then
          InternalError('ZlibInitDecompressFunctions failed');
      cmBzip:
        if not BZInitDecompressFunctions(DecompressorDLLHandle) then
          InternalError('BZInitDecompressFunctions failed');
    end;
  end;

  procedure LoadDecryptDLL;
  var
    Filename: String;
  begin
    Filename := AddBackslash(TempInstallDir) + '_iscrypt.dll';
    SaveStreamToTempFile(DecryptDLL, Filename);
    FreeAndNil(DecryptDLL);
    DecryptDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
    if DecryptDLLHandle = 0 then
      InternalError(Format('Failed to load DLL "%s"', [Filename]));
    if not ArcFourInitFunctions(DecryptDLLHandle) then
      InternalError('ISCryptInitFunctions failed');
  end;

var
  PCount: Integer;

  SetupFilename: String;
  SetupFile: TFile;
  TestID: TSetupID;
  Reader: TCompressedBlockReader;

  I: Integer;

  Name: String;

  OldErrorMode: UINT;

  procedure ReadEntriesWithoutVersion(const EntryType: TEntryType;
    const Count: Integer; const Size: Integer);
  var
    I: Integer;
    P: Pointer;
  begin
    Entries[EntryType].Capacity := Count;
    for I := 0 to Count-1 do begin
      P := AllocMem(Size);
      SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType]);
      Entries[EntryType].Add(P);
    end;
  end;

  procedure ReadEntries(const EntryType: TEntryType; const Count: Integer;
    const Size: Integer; const MinVersionOfs, OnlyBelowVersionOfs: Integer);
  var
    I: Integer;
    P: Pointer;
  begin
    if Debugging then begin
      OriginalEntryIndexes[EntryType] := TList.Create;
      OriginalEntryIndexes[EntryType].Capacity := Count;
    end;
    Entries[EntryType].Capacity := Count;
    for I := 0 to Count-1 do begin
      P := AllocMem(Size);
      SECompressedBlockRead(Reader, P^, Size, EntryStrings[EntryType]);
      if InstallOnThisVersion(TSetupVersionData((@PByteArray(P)[MinVersionOfs])^),
         TSetupVersionData((@PByteArray(P)[OnlyBelowVersionOfs])^)) = irInstall then begin
        Entries[EntryType].Add(P);
        if Debugging then
          OriginalEntryIndexes[EntryType].Add(Pointer(I));
      end
      else
        SEFreeRec(P, EntryStrings[EntryType]);
    end;
  end;

  function HandleInitPassword(const NeedPassword: Boolean): Boolean;
  { Handles InitPassword and returns the updated value of NeedPassword }
  { Also see Wizard.CheckPassword }
  var
    S: String;
    PasswordOk: Boolean;
  begin
    Result := NeedPassword;

    if NeedPassword and (InitPassword <> '') then begin
      PasswordOk := False;
      S := InitPassword;
      if shPassword in SetupHeader.Options then
        PasswordOk := TestPassword(S);
      if not PasswordOk and (CodeRunner <> nil) then
        PasswordOk := CodeRunner.RunBooleanFunction('CheckPassword', [S], False, PasswordOk);

      if PasswordOk then begin
        Result := False;
        if shEncryptionUsed in SetupHeader.Options then
          FileExtractor.CryptKey := S;
      end;
    end;
  end;

  procedure SetupInstallMode;
  begin
    if InitSilent then
      InstallMode := imSilent
    else if InitVerySilent then
      InstallMode := imVerySilent;

    if InstallMode <> imNormal then begin
      if InstallMode = imVerySilent then begin
        Application.ShowMainForm := False;
        SetTaskbarButtonVisibility(False);
      end;
      SetupHeader.Options := SetupHeader.Options - [shWindowVisible];
    end;
  end;

  function RecurseExternalGetSizeOfFiles(const SearchBaseDir, SearchSubDir,
    SearchWildcard: String; const SourceIsWildcard: Boolean;
    const RecurseSubDirs: Boolean): Integer64;
  var
    Se