ucomponentinstaller.pas

装DevExpress控件时很麻烦,总提示某某控件得先装才行。于是做了这个工具。稍改改就可以用于自己的控件安装了。

// IDE = IDE version to compile with
// Install = True if the package is DesignTime only, otherwise False.
// Log = Log strings
// IncludesL = list of includes folder paths, e.g. 'C:\MyCompos\AnotherCompo\Source'
// TempDir = Temp dir where the package dcu will be copied, e.g. 'C:\Windows\Temp\MyCompos'
var
  CommandLine, WorkDir, BPLDir, DOSOutput, DCCConfig: string;
  L: TStringList;
  I: Integer;
  S, R, Aux1, Aux2: string; // Auxiliary strings
begin
  Result := False;
  if IDE = ideNone then Exit;
  if not FileExists(PackageFilename) then begin
    if Assigned(Log) then
      SpWriteLog(Log, SLogInvalidPath, PackageFilename);
    Exit;
  end
  else begin
    // [IDE Bug]: dcc32.exe won't execute if -Q option is not used
    // But it works fine without -Q if ShellExecute is used:
    // ShellExecute(Application.Handle, 'open', DCC, ExtractFileName(PackageFilename), ExtractFilePath(PackageFilename), SW_SHOWNORMAL);
    // There must be something wrong with SpExecuteDosCommand
    CommandLine := DCC + ' -Q  ' + ExtractFileName(PackageFilename);
    WorkDir := ExtractFilePath(PackageFilename);

    L := TStringList.Create;
    try
      // Add the SourceSearchPath directory to the registry
      //SpIDEAddToSearchPath(SourceSearchPath, IDE);

      // Expand SearchPath, replace $(Delphi) and $(BDS) with real directories
      // and enclose the paths with " " to transform it to a valid
      // comma delimited string for the -U switch.
      L.Text := SourceSearchPath +';'+ SpIDEExpandMacros(SpIDESearchPath(IDE), IDE);
      L.Text := StringReplace(L.Text, ';', #13#10, [rfReplaceAll, rfIgnoreCase]);
      for I := 0 to L.Count - 1 do
        L[I] := '"' + L[I] + '"';
      S := StringReplace(L.Text, #13#10, ';', [rfReplaceAll, rfIgnoreCase]);
      if S[Length(S)] = ';' then
        Delete(S, Length(S), 1);

      // Save the DCC32.CFG file on the Package directory
      DCCConfig := IncludeTrailingPathDelimiter(WorkDir) + 'DCC32.CFG';
      SpIDETypeToString(IDE, Aux1, Aux2, R);
      L.Clear;
      // SearchPath
      L.Add('-U' + S);
      // Resource directories, add the source folder as the default *.dcr search folder
      L.Add('-R"' + SourceSearchPath + '"');
      // BPL Output
      SpReadRegValue('SOFTWARE\Borland\' + R + '\Library', 'Package DPL Output', S);
      S := SpIDEExpandMacros(S, IDE);
      L.Add('-LE"' + S + '"');
CommandLine := CommandLine + ' -LE"' + S + '"';
      BPLDir := IncludeTrailingPathDelimiter(S);
      // BPI Output for the compiled packages, required for C++Builder 2006 and above
      if IDE >= ideDelphi2006 then
      begin
        L.Add('-NB"' + S + '"');
CommandLine := CommandLine + ' -NB"' + S + '"';
      end;
      // DCP Output
      SpReadRegValue('SOFTWARE\Borland\' + R + '\Library', 'Package DCP Output', S);
      S := SpIDEExpandMacros(S, IDE);
      L.Add('-LN"' + S + '"');
CommandLine := CommandLine + ' -LN"' + S + '"';
      // Includes, dcc32.exe accepts Includes as a semicolon separated string
      // enclosed by double quotes, e.g. "C:\dir1;C:\dir2;C:\dir3"
      S := '';
      for I := 0 to IncludesL.Count - 1 do
        S := S + ';' + IncludesL[I];
      if S <> '' then begin
        Delete(S, 1, 1);
        S := '"' + S + '"';
        L.Add('-I' + S);
      end;
      // DCU Output for the compiled packages
      if TempDir <> '' then
        L.Add('-N"' + TempDir + '"');
      // Add -JL compiler switch to make Hpp files required for C++Builder 2006 and above
      // This switch is undocumented:
      // http://groups.google.com/group/borland.public.cppbuilder.ide/browse_thread/thread/456bece4c5665459/0c4c61ecec179ca8
      if IDE >= ideDelphi2006 then
        L.Add('-JL');

      L.SaveToFile(DCCConfig);
    finally
      L.Free;
    end;

    // Compile
    SpWriteLog(Log, SLogCompiling, PackageFilename);
    try
      Result := SpExecuteDosCommand(CommandLine, WorkDir, DOSOutput);
      if Assigned(Log) then
        Log.Text := Log.Text + DosOutput + #13#10;
//      if Result then
      begin
        //Add the SourceSearchPath directory to the registry
        SpIDEAddToSearchPath(SourceSearchPath, IDE);
        //Register
        Result := SpRegisterPackage(PackageFilename, BPLDir, IDE, Log);
      end;
    finally
      DeleteFile(DCCConfig);
    end;
  end;

  if not Result and Assigned(Log) then
    SpWriteLog(Log, SLogErrorCompiling, PackageFilename, '');
end;

function SpRegisterPackage(PackageFilename, BPLDir: string; IDE: TSpIDEType; Log: TStrings): Boolean;
var
  RunTime, DesignTime: Boolean;
  BPLFilename, Description, RegKey: string;
  Aux1, Aux2, R: string;
begin
  Result := False;
  if IDE = ideNone then Exit;

  BPLDir := IncludeTrailingPathDelimiter(BPLDir);
  SpGetPackageOptions(PackageFilename, BPLDir, RunTime, DesignTime, BPLFilename, Description);

  SpIDETypeToString(IDE, Aux1, Aux2, R);
  RegKey := 'SOFTWARE\Borland\' + R + '\Known Packages';

  if RunTime then begin
    SpDeleteRegValue(RegKey, BPLFilename);
    Result := True
  end
  else begin
    if FileExists(BPLFilename) then begin
      if SpWriteRegValue(RegKey, BPLFilename, Description) then begin
        SpWriteLog(Log, SLogInstalling, PackageFilename);
        Result := True;
      end;
    end;
  end;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpComponentPackage }

constructor TSpComponentPackage.Create;
begin
  inherited;
end;

destructor TSpComponentPackage.Destroy;
begin
  inherited;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpComponentPackageList }

function TSpComponentPackageList.GetItems(Index: Integer): TSpComponentPackage;
begin
  Result := TSpComponentPackage(inherited Items[Index]);
end;

procedure TSpComponentPackageList.SetItems(Index: Integer; const Value: TSpComponentPackage);
begin
  inherited Items[Index] := Value;
end;

procedure TSpComponentPackageList.LoadFromIni(Filename: string);
var
  L: TStringList;
  Entry: TSpComponentPackage;
  I, Aux: integer;
  S: string;
begin
  Clear;
  L := TStringList.Create;
  try
    L.LoadFromFile(Filename);
    for I := 0 to L.Count - 1 do
    begin
          S := Trim(L[i]);
          if Pos('=',s)=1 then
          begin
            FMinimumIDE := SpStringToIDEType(Copy(s,2,255));
            Continue;
          end;
          if Pos('-',s)=1 then
          begin
            Continue;
          end;
          if (s='') then
            Continue;
          //
          Entry := TSpComponentPackage.Create;
          if Pos(';',L[i])>0 then
          begin
            S := Copy(L[i],1,Pos(';',L[i])-1);
            Entry.SearchPath := Copy(L[i],Pos(';',L[i])+1,255);
          end;
          Entry.Name := ExtractFileName(S);
          Entry.Destination := ExtractFilePath(S);

          Add(Entry);
    end;
  finally
    L.Free;
  end;
end;

function TSpComponentPackageList.CompileAll(BaseFolder: string; IDE: TSpIDEType; Log: TStrings): Integer;
var
  IdeName, DCC, TempDir: string;
  I, J, N, P: integer;
  Item: TSpComponentPackage;
  CompileL, IncludesL, SL: TStringList;
  Aux1, Aux2: string; // Auxiliary strings
begin
  Result := 0;
  if IDE = ideNone then begin
    Result := 0;
    Exit;
  end
  else
    if not SpIDEInstalled(IDE) then begin
      SpIDETypeToString(IDE, IdeName, Aux1, Aux2);
      SpWriteLog(Log, SLogInvalidIDE, IdeName);
      Exit;
    end;

  // Create TempDir
  //SpGetWinDirs(Aux1, Aux2, TempDir);
  //TempDir := IncludeTrailingPathDelimiter(TempDir) + 'SpMultiInstall';
  //CreateDir(TempDir);

  DCC := SpIDEDCC32Path(IDE);
  CompileL := TStringList.Create;
  IncludesL := TStringList.Create;
  CompileL.Clear;
  IncludesL.Clear;
  try
    for I := 0 to Count - 1 do begin
      Item := Items[I];

      if Pos(':',Item.SearchPath)=0 then
        Item.SearchPath := Item.Destination + Item.SearchPath;

      if IncludesL.IndexOf(Item.SearchPath)=-1 then
        IncludesL.Add(Item.SearchPath);

      if Item.Installable = sitInstallable then
        CompileL.AddObject(Item.Destination + Item.Name, Item);
    end;

    SL := TStringList.Create;
    i:=0;
    while i<CompileL.Count do
    begin
      P := -1;
      SpReadIncludePackages(CompileL[i],SL);
      for j:=0 to CompileL.Count-1 do
      begin
        if SL.IndexOf(LowerCase(ChangeFileExt(ExtractFileName(CompileL[j]),'')))>-1 then
        begin
          if P<j then P := j;
        end;
      end;
      if P>i then
      begin
        CompileL.Exchange(i,P);
      end else
        Inc(i);
    end;
    SL.Free;

    // Compile and Install
    for J := 0 to CompileL.Count - 1 do
    begin
      Item := TSpComponentPackage(CompileL.Objects[j]);
      SpWriteLog(Log, SLogStartCompile, Item.Name);
      if not SpCompilePackage(Item.Destination + Item.Name, DCC, Item.SearchPath, IDE, IncludesL, Log, BaseFolder{TempDir}) then
      begin
        SpWriteLog(Log, SLogCompileError, Item.Name);
//        Exit;
      end else
      begin
        Inc(Result);
      end;
      Application.ProcessMessages;
    end;

  finally
    CompileL.Free;
    IncludesL.Free;
    //SpFileOperation(TempDir, '', FO_DELETE);
  end;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpExecuteList }

function TSpExecuteList.GetItems(Index: Integer): TSpExecuteEntry;
begin
  Result := TSpExecuteEntry(inherited Items[Index]);
end;

procedure TSpExecuteList.SetItems(Index: Integer; const Value: TSpExecuteEntry);
begin
  inherited Items[Index] := Value;
end;

procedure TSpExecuteList.LoadFromIni(Filename, Section: string);
var
  L, V: TStringList;
  ExecuteEntry: TSpExecuteEntry;
  Action: TSpActionType;
  I: integer;
begin
  L := TStringList.Create;
  V := TStringList.Create;
  try
    Clear;
    SpIniLoadStringList(L, Filename, Section, rvExecuteIniPrefix);
    for I := 0 to L.Count - 1 do
      if SpParseEntryValue(L[I], V, 3) then begin
        Action := SpStringToActionType(V[0]);
        if Action <> satNone then begin
          ExecuteEntry := TSpExecuteEntry.Create;
          ExecuteEntry.Action := Action;
          ExecuteEntry.Origin := V[1];
          ExecuteEntry.Destination := V[2];
          Add(ExecuteEntry);
        end;
      end;
  finally
    L.Free;
    V.Free;
  end;
end;

function TSpExecuteList.ExecuteAll(BaseFolder: string; Log: TStrings): Boolean;
var
  I: Integer;
  Item: TSpExecuteEntry;
  S, DosOutput: string;
begin
  Result := False;

  // Check if the files exist
  for I := 0 to Count - 1 do begin
    Item := Items[I];
    Item.Origin := StringReplace(Item.Origin, rvBaseFolder, ExcludeTrailingPathDelimiter(BaseFolder), [rfReplaceAll, rfIgnoreCase]);
    Item.Destination := StringReplace(Item.Destination, rvBaseFolder, ExcludeTrailingPathDelimiter(BaseFolder), [rfReplaceAll, rfIgnoreCase]);
    if not FileExists(Item.Origin) then begin
      SpWriteLog(Log, SLogInvalidPath, Item.Origin);
      Exit;
    end;
  end;

  // Execute
  for I := 0 to Count - 1 do begin
    Item := Items[I];
    case Item.Action of
      satCopy, satCopyRun:
        if SpFileOperation(Item.Origin, Item.Destination, FO_COPY) then begin
          SpWriteLog(Log, SLogCopying, Item.Origin, Item.Destination);
          if Item.Action = satCopyRun then begin
            // Run it if it's a a valid file
            S := ExtractFileName(Item.Origin);
            if S <> '' then begin
              S := IncludeTrailingPathDelimiter(Item.Destination) + S;
              SpWriteLog(Log, SLogExecuting, S);
              if SpExecuteDosCommand(S, Item.Destination, DosOutput) then
                Log.Text := Log.Text + DosOutput + #13#10
              else begin
                SpWriteLog(Log, SLogErrorExecuting, Item.Origin, '');
                Exit;
              end;
            end;
          end;
        end
        else begin
          SpWriteLog(Log, SLogErrorCopying, Item.Origin, Item.Destination);
          Exit;
        end;
    end;
  end;

  Result := True;
end;

//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpMultiInstaller }

constructor TSpMultiInstaller.Create(IniFilename: string);
begin
  FComponentPackages := TSpComponentPackageList.Create;
  FComponentPackages.LoadFromIni(IniFilename);
end;

destructor TSpMultiInstaller.Destroy;
begin
  FComponentPackages.Free;
  inherited;
end;

function TSpMultiInstaller.Install(BaseFolder: string; IDE: TSpIDEType; Log: TStrings): Boolean;
var
  i,x: integer;
  N, Secs: Single;
begin
  Result := False;

  x:=0;
  for i:=0 to ComponentPackages.Count-1 do
    if ComponentPackages.Items[i].Installable = sitInstallable then
      Inc(x);

  FInstalling := True;
  try
    Log.Clear;
    N := GetTickCount;
        i := ComponentPackages.CompileAll(BaseFolder, IDE, Log);
        if i>0 then begin
          Secs := (GetTickCount - N) / 1000;
          SpWriteLog(Log, SLogEnd, '');
          Log.Add(Format(SLogFinished+ ' ('+inttostr(i)+'/'+inttostr(x)+' Packages)', [Secs]));
          Result := True;
        end else
          SpWriteLog(Log, 'Abort :(', '');
  finally
    FInstalling := False;
  end;
end;

end.