unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, jpeg, ExtCtrls, JvWizard, JvWizardRouteMapSteps, JvExControls, Packages, JvComponent, VirtualTrees, JvTabBar, JvPageList, ImgList, JvAppInst, XPMan, StdCtrls, Mask, JvExMask, JvToolEdit, CheckLst, ComCtrls, JvExComCtrls, JvProgressBar, Logging, Menus; const WM_STARTINSTALL = WM_USER + 1; type TFormMain = class(TForm) JvWizard: TJvWizard; JvWizardComponents: TJvWizardInteriorPage; JvWizardRouteMapSteps: TJvWizardRouteMapSteps; JvWizardPageChooseDirectories: TJvWizardInteriorPage; JvTabBar: TJvTabBar; JvPageList: TJvPageList; PageDesigntime: TJvStandardPage; VTreeComps: TVirtualStringTree; PageRuntime: TJvStandardPage; VTreeRun: TVirtualStringTree; ImageListPackages: TImageList; VTreeDesign: TVirtualStringTree; PanelDesignSplit: TPanel; VTreeUnits: TVirtualStringTree; PanelRunSplit: TPanel; PageComponents: TJvStandardPage; JvAppInstances: TJvAppInstances; JvModernTabBarPainter1: TJvModernTabBarPainter; VTreePalette: TVirtualStringTree; EditBPLDirectory: TJvDirectoryEdit; EditInstallDir: TJvDirectoryEdit; Label1: TLabel; Label2: TLabel; XPManifest1: TXPManifest; Label3: TLabel; JvWizardPageInstall: TJvWizardInteriorPage; Image: TImage; LblVersion: TLabel; ProgressBar: TJvProgressBar; LblStatus: TLabel; PopupMenu: TPopupMenu; MenuInstallAll: TMenuItem; MenuInstallNone: TMenuItem; procedure FormCreate(Sender: TObject); procedure VTreeDesignInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure VTreeDesignFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VTreeDesignGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure VTreeDesignGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure VTreeDesignChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VTreeDesignChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VTreeCompsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure VTreeCompsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure VTreeCompsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure VTreeRunChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VTreeUnitsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure VTreeUnitsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure VTreeUnitsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure VTreeUnitsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure VTreeUnitsMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); procedure VTreeCompsMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); procedure VTreeUnitsBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); procedure VTreeUnitsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure VTreePaletteInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure VTreePaletteGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure VTreePaletteGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure VTreePaletteMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); procedure VTreePaletteInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure VTreePaletteChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure JvWizardCancelButtonClick(Sender: TObject); procedure JvWizardActivePageChanged(Sender: TObject); procedure JvWizardPageInstallEnterPage(Sender: TObject; const FromPage: TJvWizardCustomPage); procedure JvWizardPageInstallCancelButtonClick(Sender: TObject; var Stop: Boolean); procedure JvWizardPageInstallFinishButtonClick(Sender: TObject; var Stop: Boolean); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure MenuInstallNoneClick(Sender: TObject); private { Private-Deklarationen } FUpdateCheckBoxesLock: Boolean; FAborted: Boolean; FInstalling: Boolean; procedure UpdateCheckBoxes; procedure UpdatePackageSelection; procedure UpdatePaletteSelection; procedure CopyOneFile(const SourceFilename, DestFilename: string); procedure WMStartInstall(var Msg: TMessage); message WM_STARTINSTALL; procedure RegisterToIDE(Log: TLog); procedure MakeDirectories(Log: TLog; const Dir: string); public { Public-Deklarationen } end; var FormMain: TFormMain; implementation uses JvGnugettext, DataModuleMain, Configuration, Utils, DelphiData; {$R *.dfm} type TDataKind = (dkPackage, dkComponent); PDataP = ^TDataP; TDataP = record Package: IPackage; end; PDataC = ^TDataC; TDataC = record Comp: IComponentItem; end; PDataU = ^TDataU; TDataU = record UnitItem: IUnit; end; PDataPC = ^TDataPC; TDataPC = record Palette: string; Comp: IComponentItem; end; procedure TFormMain.UpdateCheckBoxes; begin if FUpdateCheckBoxesLock then Exit; FUpdateCheckBoxesLock := True; try UpdatePackageSelection; UpdatePaletteSelection; finally FUpdateCheckBoxesLock := False; end; end; procedure TFormMain.UpdatePackageSelection; var Node: PVirtualNode; begin Node := VTreeRun.GetFirst; while Node <> nil do begin if PDataP(VTreeRun.GetNodeData(Node)).Package.Checked then VTreeRun.CheckState[Node] := csCheckedNormal else VTreeRun.CheckState[Node] := csUncheckedNormal; Node := VTreeRun.GetNextSibling(Node); end; Node := VTreeDesign.GetFirst; while Node <> nil do begin if PDataP(VTreeDesign.GetNodeData(Node)).Package.Checked then VTreeDesign.CheckState[Node] := csCheckedNormal else VTreeDesign.CheckState[Node] := csUncheckedNormal; Node := VTreeDesign.GetNextSibling(Node); end; end; procedure TFormMain.UpdatePaletteSelection; var Node, Child: PVirtualNode; Data: PDataPC; begin Node := VTreePalette.GetFirst; while Node <> nil do begin Child := VTreePalette.GetFirstChild(Node); while Child <> nil do begin Data := PDataPC(VTreePalette.GetNodeData(Child)); if Data.Comp.Checked then VTreePalette.CheckState[Child] := csCheckedNormal else VTreePalette.CheckState[Child] := csUncheckedNormal; Child := VTreePalette.GetNextSibling(Child); end; Node := VTreePalette.GetNextSibling(Node); end; end; procedure TFormMain.FormCreate(Sender: TObject); var i, k: Integer; Pals: TStringList; Filename: string; begin JvPageList.ActivePageIndex := 0; if FileExists('Config\' + Config.WizardPicture) then JvWizardRouteMapSteps.Image.Picture.LoadFromFile('Config\' + Config.WizardPicture); Filename := Config.WelcomePicture; if (Filename <> '') and (Filename[1] = '*') then begin Image.Proportional := True; Image.Stretch := True; Delete(Filename, 1, 1); end; if FileExists('Config\' + Filename) then Image.Picture.LoadFromFile('Config\' + Filename); EditInstallDir.Text := ResolveDirectory(Config.DefaultInstallDir); EditBPLDirectory.Text := ResolveDirectory(Config.DefaultBPLDir); if Config.Title <> '' then Caption := Config.Title; LblVersion.Caption := Config.Target.DisplayName; VTreeDesign.NodeDataSize := SizeOf(TDataP); VTreeRun.NodeDataSize := SizeOf(TDataP); VTreeDesign.RootNodeCount := 0; VTreeRun.RootNodeCount := 0; for i := 0 to PackageList.PackageCount - 1 do begin if PackageList.Packages[i].IsRunOnly then PDataP(VTreeRun.GetNodeData(VTreeRun.AddChild(nil))).Package := PackageList.Packages[i] else PDataP(VTreeDesign.GetNodeData(VTreeDesign.AddChild(nil))).Package := PackageList.Packages[i]; for k := 0 to Config.Target.KnownPackages.Count - 1 do if SameText(ChangeFileExt(Config.Target.KnownPackages[k].Name, ''), PackageList.Packages[i].Name) then PackageList.Packages[i].Checked := True; end; VTreeComps.NodeDataSize := SizeOf(TDataC); VTreeUnits.NodeDataSize := SizeOf(TDataU); VTreePalette.RootNodeCount := 0; VTreePalette.NodeDataSize := SizeOf(TDataPC); Pals := TStringList.Create; try Pals.Sorted := True; for i := 0 to PackageList.ComponentCount - 1 do begin if Pals.IndexOf(PackageList.Components[i].Palette) < 0 then begin Pals.Add(PackageList.Components[i].Palette); PDataPC(VTreePalette.GetNodeData(VTreePalette.AddChild(nil))).Palette := PackageList.Components[i].Palette; end; end; finally Pals.Free; end; if VTreePalette.RootNodeCount = 0 then begin JvTabBar.Tabs[0].Visible := False; JvPageList.ActivePageIndex := 1; end; if VTreeDesign.RootNodeCount = 0 then begin JvTabBar.Tabs[1].Visible := False; JvPageList.ActivePageIndex := 2; end; UpdateCheckBoxes; end; procedure TFormMain.VTreeDesignInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); begin Sender.CheckType[Node] := ctCheckBox; if PDataP(Sender.GetNodeData(Node)).Package.Checked then Sender.CheckState[Node] := csCheckedNormal else Sender.CheckState[Node] := csUncheckedNormal; end; procedure TFormMain.VTreeDesignFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); begin PDataP(Sender.GetNodeData(Node)).Package := nil; end; procedure TFormMain.VTreeDesignGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); begin if PDataP(Sender.GetNodeData(Node)).Package.Description = '' then CellText := PDataP(Sender.GetNodeData(Node)).Package.Name else CellText := PDataP(Sender.GetNodeData(Node)).Package.Description; end; procedure TFormMain.VTreeDesignGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin if PDataP(Sender.GetNodeData(Node)).Package.IsRunOnly then ImageIndex := 2 else ImageIndex := 0; end; procedure TFormMain.VTreeDesignChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); var Package: IPackage; begin if FUpdateCheckBoxesLock then Exit; Package := PDataP(Sender.GetNodeData(Node)).Package; Package.Checked := Node.CheckState = csCheckedNormal; UpdateCheckBoxes; end; procedure TFormMain.VTreeDesignChange(Sender: TBaseVirtualTree; Node: PVirtualNode); begin VTreeComps.Clear; if Node <> nil then VTreeComps.RootNodeCount := PDataP(Sender.GetNodeData(Node)).Package.ComponentCount; end; procedure TFormMain.VTreeCompsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var Data: PDataC; begin Data := Sender.GetNodeData(Node); Data.Comp := PDataP(VTreeDesign.GetNodeData(VTreeDesign.GetFirstSelected)).Package.Components[Node.Index]; end; procedure TFormMain.VTreeCompsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); var Data: PDataC; begin CellText := ''; Data := Sender.GetNodeData(Node); if Column = 0 then CellText := Data.Comp.ComponentClass else if Column = 1 then CellText := Data.Comp.Palette; end; procedure TFormMain.VTreeCompsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin if Column = 0 then ImageIndex := PDataC(Sender.GetNodeData(Node)).Comp.ImageIndex; end; procedure TFormMain.VTreeRunChange(Sender: TBaseVirtualTree; Node: PVirtualNode); begin VTreeUnits.Clear; if Node <> nil then VTreeUnits.RootNodeCount := PDataP(Sender.GetNodeData(Node)).Package.UnitCount; end; procedure TFormMain.VTreeUnitsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var Data: PDataU; begin if ParentNode = nil then begin Data := Sender.GetNodeData(Node); Data.UnitItem := PDataP(VTreeRun.GetNodeData(VTreeRun.GetFirstSelected)).Package.Units[Node.Index]; if Data.UnitItem.ComponentCount > 0 then InitialStates := InitialStates + [ivsHasChildren, ivsExpanded]; end else begin Data := Sender.GetNodeData(ParentNode); PDataC(Sender.GetNodeData(Node)).Comp := Data.UnitItem.Components[Node.Index]; end; end; procedure TFormMain.VTreeUnitsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); begin CellText := ''; if Sender.NodeParent[Node] = nil then CellText := PDataU(Sender.GetNodeData(Node)).UnitItem.Name else CellText := PDataC(Sender.GetNodeData(Node)).Comp.ComponentClass; end; procedure TFormMain.VTreeUnitsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin if Sender.NodeParent[Node] <> nil then ImageIndex := PDataC(Sender.GetNodeData(Node)).Comp.ImageIndex; end; procedure TFormMain.VTreeUnitsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); begin ChildCount := PDataU(Sender.GetNodeData(Node)).UnitItem.ComponentCount; end; procedure TFormMain.VTreeUnitsMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); begin if Sender.NodeParent[Node] <> nil then NodeHeight := DMMain.ImageListComponents.Height + 2; end; procedure TFormMain.VTreeCompsMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); begin NodeHeight := DMMain.ImageListComponents.Height + 2; end; procedure TFormMain.VTreeUnitsBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); begin if Sender.NodeParent[Node] <> nil then begin TargetCanvas.Brush.Color := $fff5f5; TargetCanvas.FillRect(CellRect); end; end; procedure TFormMain.VTreeUnitsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); begin if Sender.NodeParent[Node] = nil then TargetCanvas.Font.Style := [fsBold]; end; procedure TFormMain.VTreePaletteInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var Data, ParentData: PDataPC; i: Integer; Index: Integer; begin Data := Sender.GetNodeData(Node); if ParentNode = nil then begin InitialStates := InitialStates + [ivsHasChildren]; Sender.CheckType[Node] := ctTriStateCheckBox; end else begin ParentData := Sender.GetNodeData(ParentNode); Index := Node.Index; for i := 0 to PackageList.ComponentCount - 1 do if CompareText(PackageList.Components[i].Palette, ParentData.Palette) = 0 then begin if Index = 0 then begin Data.Comp := PackageList.Components[i]; Break; end; Dec(Index); end; Sender.CheckType[Node] := ctCheckBox; if Data.Comp.Checked then Sender.CheckState[Node] := csCheckedNormal else; Sender.CheckState[Node] := csUncheckedNormal; end; end; procedure TFormMain.VTreePaletteGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); var Data: PDataPC; begin CellText := ''; Data := Sender.GetNodeData(Node); if Data.Comp = nil then begin if Column = 0 then CellText := Data.Palette; end else begin if Column = 0 then CellText := Data.Comp.ComponentClass else if Column = 1 then CellText := Data.Comp.UnitName else if Column = 2 then CellText := Data.Comp.Package.Name; end; end; procedure TFormMain.VTreePaletteGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); var Data: PDataPC; begin Data := Sender.GetNodeData(Node); if Data.Comp <> nil then begin if Column = 0 then ImageIndex := Data.Comp.ImageIndex; end; end; procedure TFormMain.VTreePaletteMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); var Data: PDataPC; begin Data := Sender.GetNodeData(Node); if Data.Comp <> nil then NodeHeight := DMMain.ImageListComponents.Height + 2; end; procedure TFormMain.VTreePaletteInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); var Data: PDataPC; i: Integer; begin Data := Sender.GetNodeData(Node); if Data.Comp = nil then begin for i := 0 to PackageList.ComponentCount - 1 do if CompareText(PackageList.Components[i].Palette, Data.Palette) = 0 then Inc(ChildCount); end; end; procedure TFormMain.VTreePaletteChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); var Data: PDataPC; i: Integer; begin if FUpdateCheckBoxesLock then Exit; Data := Sender.GetNodeData(Node); if Data.Comp <> nil then Data.Comp.Checked := Node.CheckState = csCheckedNormal else begin if not Sender.ChildrenInitialized[Node] then begin for i := 0 to PackageList.ComponentCount - 1 do if CompareText(PackageList.Components[i].Palette, Data.Palette) = 0 then PackageList.Components[i].Checked := Node.CheckState = csCheckedNormal; end; end; UpdateCheckBoxes; end; procedure TFormMain.JvWizardCancelButtonClick(Sender: TObject); begin Close; end; procedure TFormMain.JvWizardActivePageChanged(Sender: TObject); begin if JvWizard.ActivePageIndex = 1 then begin JvWizard.ButtonNext.Caption := _('&Install'); end else begin JvWizard.ButtonNext.Caption := _('&Next >'); end; end; procedure TFormMain.JvWizardPageInstallCancelButtonClick(Sender: TObject; var Stop: Boolean); begin Stop := True; FAborted := True; end; procedure TFormMain.CopyOneFile(const SourceFilename, DestFilename: string); var InFile, OutFile: TFileStream; CreationTime, LastWriteTime, LastAccessTime: TFileTime; Buf: array[0..128 * 1024] of Byte; StreamSize, Readn: Integer; begin InFile := TFileStream.Create(SourceFileName, fmOpenRead or fmShareDenyWrite); try OutFile := TFileStream.Create(DestFileName, fmCreate or fmShareExclusive); try StreamSize := InFile.Size; while StreamSize > 0 do begin Readn := StreamSize; if Readn > Length(Buf) then Readn := Length(Buf); InFile.Read(Buf[0], Readn); OutFile.Write(Buf[0], Readn); Dec(StreamSize, Readn); if FAborted then Break; end; GetFileTime(InFile.Handle, @CreationTime, @LastAccessTime, @LastWriteTime); SetFileTime(OutFile.Handle, @CreationTime, @LastAccessTime, @LastWriteTime); finally OutFile.Free; end; finally InFile.Free; end; SetFileAttributes(PChar(DestFileName), GetFileAttributes(PChar(SourceFileName))); end; procedure TFormMain.JvWizardPageInstallEnterPage(Sender: TObject; const FromPage: TJvWizardCustomPage); begin FInstalling := True; PostMessage(Handle, WM_STARTINSTALL, 0, 0); end; procedure TFormMain.JvWizardPageInstallFinishButtonClick(Sender: TObject; var Stop: Boolean); begin Close; end; procedure TFormMain.MakeDirectories(Log: TLog; const Dir: string); begin if (Dir <> '') and (Length(Dir) > 3) and not DirectoryExists(Dir) then begin MakeDirectories(Log, ExtractFileDir(Dir)); CreateDir(Dir); Log.DirAdd(Dir); end; end; function IsFileNewerThan(const Filename, CompareToFile: string): Boolean; var sr1, sr2: TSearchRec; begin Result := True; if (FindFirst(Filename, faAnyFile and not faDirectory, sr1) = 0) and (FindFirst(CompareToFile, faAnyFile and not faDirectory, sr2) = 0) then Result := (sr1.Time > sr2.Time) or (sr1.Size <> sr2.Size); end; procedure TFormMain.WMStartInstall(var Msg: TMessage); var Files, Packages: TStringList; i: Integer; Size, CopiedSize: Int64; Percentage, NewPercentage: Integer; DestFilename, Filename: string; DataDir: string; PackagesDir: string; Log: TLog; begin LblStatus.Caption := 'Collecting files...'; Application.ProcessMessages; try Config.InstallDir := ExcludeTrailingPathDelimiter(EditInstallDir.Text); Config.BplDir := ExcludeTrailingPathDelimiter(EditBPLDirectory.Text); Log := TLog.Create; FAborted := False; try // start Installation Files := TStringList.Create; Packages := TStringList.Create; try DataDir := ExtractFilePath(ParamStr(0)) + 'Data'; PackagesDir := ExtractFilePath(ParamStr(0)) + 'Packages'; FindFiles(DataDir, '*.*', True, Files, []); FindFiles(PackagesDir, '*.*', False, Packages, []); Size := 0; for i := 0 to Files.Count - 1 do Inc(Size, Integer(Files.Objects[i])); for i := 0 to Packages.Count - 1 do Inc(Size, Integer(Packages.Objects[i])); ProgressBar.Max := 100; ProgressBar.Position := 0; Percentage := 0; CopiedSize := 0; for i := 0 to Files.Count - 1 do begin DestFilename := Config.InstallDir + Copy(Files[i], Length(DataDir) + 1, MaxInt); MakeDirectories(Log, ExtractFileDir(DestFilename)); if not FileExists(DestFileName) or IsFileNewerThan(Files[i], DestFilename) then begin LblStatus.Caption := Format(_('Copying file: %s'), [Copy(Files[i], Length(DataDir) + 1 + 1, MaxInt)]); LblStatus.Update; CopyOneFile(Files[i], DestFilename); Log.FileAdd(DestFilename); end; { progress } Inc(CopiedSize, Integer(Files.Objects[i])); NewPercentage := CopiedSize * 100 div Size; if NewPercentage <> Percentage then begin Percentage := NewPercentage; ProgressBar.Position := Percentage; Application.ProcessMessages; end; if FAborted then Break; end; MakeDirectories(Log, Config.BplDir); for i := 0 to Packages.Count - 1 do begin DestFilename := Config.BplDir + Copy(Packages[i], Length(PackagesDir) + 1, MaxInt); if FileAge(Packages[i]) > FileAge(DestFilename) then begin LblStatus.Caption := Format(_('Copying file: %s'), [Copy(Packages[i], Length(PackagesDir) + 1 + 1, MaxInt)]); LblStatus.Update; CopyOneFile(Packages[i], DestFilename); Log.FileAdd(DestFilename); end; { progress } Inc(CopiedSize, Integer(Packages.Objects[i])); NewPercentage := CopiedSize * 100 div Size; if NewPercentage <> Percentage then begin Percentage := NewPercentage; ProgressBar.Position := Percentage; Application.ProcessMessages; end; if FAborted then Break; end; finally Packages.Free; Files.Free; end; LblStatus.Caption := 'Registering packages...'; Application.ProcessMessages; RegisterToIDE(Log); finally try LblStatus.Caption := 'Generating uninstall information...'; Application.ProcessMessages; Filename := ExtractFilePath(ParamStr(0)) + 'Config\DelphiPkgUninstall.bin'; DestFilename := Config.InstallDir + PathDelim + 'DelphiPkgUninstall.exe'; if FileExists(Filename) then CopyOneFile(Filename, DestFilename); try Log.SaveToFile(Config.InstallDir + PathDelim + 'install.log'); finally Log.Free; end; finally LblStatus.Caption := 'Finished.'; Application.ProcessMessages; FInstalling := False; JvWizardPageInstall.VisibleButtons := [bkFinish]; end; end; except LblStatus.Caption := 'Failed.'; JvWizardPageInstall.VisibleButtons := [bkFinish]; Application.HandleException(Self); end; end; procedure TFormMain.RegisterToIDE(Log: TLog); var Dir, Action, Kind: string; i: Integer; List: TStrings; Filename: string; begin for i := 0 to Config.LibraryPaths.Count - 1 do begin Dir := Config.LibraryPaths[i]; if Trim(Dir) = '' then Continue; Action := Copy(Dir, 1, Pos('=', Dir) - 1); Delete(Dir, 1, Length(Action) + 1); Kind := Copy(Dir, 1, Pos(',', Dir) - 1); Delete(Dir, 1, Length(Kind) + 1); Dir := ResolveDirectory(Dir); if SameText(Kind, 'Search') then List := Config.Target.SearchPaths else if SameText(Kind, 'Browse') then List := Config.Target.BrowsingPaths else if SameText(Kind, 'Debug') then List := Config.Target.DebugDcuPaths else raise Exception.CreateFmt('Invalid config.ini file: Unknown LibraryPath kind "%s"', [Kind]); Dir := Config.Target.InsertDirMacros(Dir); if (List.IndexOf(Dir) < 0) and (List.IndexOf(Config.Target.ExpandDirMacros(Dir)) < 0) then List.Add(Dir); Log.PathListAdd(Kind, Dir); end; for i := 0 to PackageList.PackageCount - 1 do begin if not PackageList.Packages[i].IsRunOnly then begin if (Config.Target.DisabledPackages.IndexOfFilename(Config.Target.ExpandDirMacros(Filename)) >= 0) then Config.Target.DisabledPackages.Remove(Config.Target.ExpandDirMacros(Filename)); if (Config.Target.DisabledPackages.IndexOfFilename(Filename) >= 0) then Config.Target.DisabledPackages.Remove(Filename); Filename := Config.Target.InsertDirMacros(Config.BplDir + PathDelim + PackageList.Packages[i].Name + '.bpl'); if PackageList.Packages[i].Checked then begin if (Config.Target.KnownPackages.IndexOfFilename(Config.Target.ExpandDirMacros(Filename)) < 0) and (Config.Target.KnownPackages.IndexOfFilename(Filename) < 0) then begin Config.Target.KnownPackages.Add(Filename, PackageList.Packages[i].Description); Log.PackageAdd(Filename); end; end else begin if (Config.Target.KnownPackages.IndexOfFilename(Config.Target.ExpandDirMacros(Filename)) >= 0) then Config.Target.KnownPackages.Remove(Config.Target.ExpandDirMacros(Filename)); if (Config.Target.KnownPackages.IndexOfFilename(Filename) >= 0) then Config.Target.KnownPackages.Remove(Filename); end; end; end; Config.Target.SavePaths; Config.Target.SavePackagesLists; end; procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := not FInstalling; end; procedure TFormMain.MenuInstallNoneClick(Sender: TObject); var i: Integer; begin for i := 0 to PackageList.PackageCount - 1 do PackageList.Packages[i].Checked := Sender = MenuInstallAll; UpdateCheckBoxes; end; end.