RealICQClient/Includes/MyBean/Tools/包依赖分析工具/fMain.pas

unit fMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Buttons,
  Dialogs, StdCtrls, ExtCtrls, CnSMRBplUtils;

type
  TfrmMain = class(TForm)
    dlgOpen: TOpenDialog;
    gpAnalyse: TPanel;
    Panel2: TPanel;
    pnlRequiredPackages: TPanel;
    Label2: TLabel;
    mmoRequirePackages: TMemo;
    pnlExeFiles: TPanel;
    Label3: TLabel;
    lstFiles: TListBox;
    pnlButton: TPanel;
    btnOpenFiles: TBitBtn;
    btnAnalyse: TBitBtn;
    btnClearFiles: TBitBtn;
    btnCopyUnits: TBitBtn;
    Label1: TLabel;
    mmoUnits: TMemo;
    lblPath: TLabel;
    edtTOPath: TEdit;
    lblCopyTo: TLabel;
    edtDEPath: TEdit;
    mmoDevUnits: TMemo;
    mmoLog: TMemo;
    procedure btnCopyUnitsClick(Sender: TObject);
    procedure btnClearFilesClick(Sender: TObject);
    procedure lstFilesKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure lstFilesClick(Sender: TObject);
    procedure btnAnalyseClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnOpenFilesClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FAnalyseResults: TPackageInfosList;
    FUIUpdating: Boolean;
    FPerformUIUpdating: Boolean;
    FAnalysing: Boolean;

    function GetSelectedFile: string;
    function IndexOfAnalyseResult(const s: string): Integer;

    procedure AddFiles(ss: TStrings);
    procedure AnalyseAFile(const FileName: string; AllowException: Boolean = False);
    procedure AnalyseAllFiles(var Errors: string);
    procedure Analysing(b: Boolean);
    procedure UpdateAnalyseResultView(PPI: PPackageInfos); overload;
    procedure UpdateAnalyseResultView(ssUnits, ssRequirePackages: TStrings); overload;
    procedure UpdateAnalyseResultView; overload;
    procedure UpdateControlsState;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses StrUtils, CnBaseUtils;

{$R *.dfm}

const
  CRLF = #13#10;
var
  // ÐèÒª±¾µØ»¯µÄ×Ö·û´®
  SCnAnalyzedResultsSaved: string = 'Analyzed Results Saved Successed to File %s.';
  SCnDuplicatedNameFound: string = 'Can NOT Save analyzed result: Duplicated File Names Found:'#13#10#13#10'%s';
  SCnSomeAnalyzedFailed: string = 'All Files Analyzed, but Some Files Analyzed Failed:'#13#10;


function StringProcessProc(const s: string): string;
begin
  Result := ExtractFileName(s);
end;

procedure TfrmMain.AddFiles(ss: TStrings);
var
  i: Integer;
  tmpSs: TStringList;
begin
  tmpSs := TStringList.Create;
  try
    tmpSs.Assign(lstFiles.Items);
    tmpSs.Sorted := True;
    for i := 0 to ss.Count - 1 do
    begin
      if FileExists(ss[i]) then
      begin
        tmpSs.Add(ss[i]);
      end;
    end;
    lstFiles.Items.Assign(tmpSs);
  finally
    tmpSs.Free;
  end;
end;

procedure TfrmMain.AnalyseAFile(const FileName: string; AllowException: Boolean = False);
begin
  try
    FAnalyseResults.AddFile(FileName);
  except
    if AllowException then
    begin
      raise;
    end;
  end;
end;

procedure TfrmMain.AnalyseAllFiles(var Errors: string);
var
  i: Integer;
begin
  FAnalyseResults.BeginUpdate;
  try
    FAnalyseResults.Clear;
    for i := 0 to lstFiles.Items.Count - 1 do
    begin
      try
        AnalyseAFile(lstFiles.Items[i], True);
      except
        on E: Exception do
        begin
          Errors := Errors + E.Message + #13#10;
        end;
      end;
    end;
  finally
    FAnalyseResults.EndUpdate;
  end;
end;

procedure TfrmMain.Analysing(b: Boolean);
begin
  FAnalysing := b;
  UpdateControlsState;
end;

procedure TfrmMain.btnAnalyseClick(Sender: TObject);
var
  Errors: string;
  I, J: Integer;
  S: string;
begin
  Analysing(True);
  try
    Errors := '';
    AnalyseAllFiles(Errors);
    if Errors <> '' then
    begin
      raise Exception.Create(SCnSomeAnalyzedFailed + Errors);
    end;
  finally
    Analysing(False);
  end;

  for I := 0 to FAnalyseResults.Count - 1 do
  begin
    for J := 0 to FAnalyseResults.PackageInfos[I].Units.Count - 1 do
    begin
      S := FAnalyseResults.PackageInfos[I].Units.Strings[J];
      if ((LeftStr(S, 2) = 'cx') or (LeftStr(S, 2) = 'dx'))
        and (mmoDevUnits.Lines.IndexOf(S) = -1) then
        mmoDevUnits.Lines.Add(S);
    end;
  end;
end;

procedure TfrmMain.btnClearFilesClick(Sender: TObject);
begin
  FAnalyseResults.Clear;
  lstFiles.Clear;
  mmoDevUnits.Clear;
  UpdateControlsState;
end;

procedure TfrmMain.btnCopyUnitsClick(Sender: TObject);
var
  I: Integer;
  sF, sT: string;
begin
  if not DirectoryExists(edtTOPath.Text) then
    ForceDirectories(edtTOPath.Text);
  for I := 0 to mmoDevUnits.Lines.Count - 1 do
  begin
    sF := edtDEPath.Text + mmoDevUnits.Lines.Strings[I];
    sT := edtTOPath.Text + mmoDevUnits.Lines.Strings[I];
    //if FileExists(sF + '.dfm') then
    //  CopyFile(PChar(sF + '.dfm'),PChar(sT + '.dfm'), True);
    if FileExists(sF + '.dcu') then
      CopyFile(PChar(sF + '.dcu'), PChar(sT + '.dcu'), True)
    else
      mmoLog.Lines.Add(SF);
  end;
end;

procedure TfrmMain.btnOpenFilesClick(Sender: TObject);
begin
  if dlgOpen.Execute then
  begin
    AddFiles(dlgOpen.Files);
    UpdateControlsState;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FAnalyseResults := TPackageInfosList.Create;
  FAnalyseResults.Sorted := True;
  FAnalyseResults.StringProcessProc := StringProcessProc;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FAnalyseResults.Free;
end;

function TfrmMain.GetSelectedFile: string;
begin
  Result := '';
  if lstFiles.ItemIndex >= 0 then
  begin
    Result := lstFiles.Items[lstFiles.ItemIndex];
  end;
end;

function TfrmMain.IndexOfAnalyseResult(const s: string): Integer;
begin
  Result := -1;
  if s = '' then
  begin
    Exit;
  end;

  Result := FAnalyseResults.IndexOf(s);
end;

procedure TfrmMain.lstFilesClick(Sender: TObject);
begin
  UpdateControlsState;
end;

procedure TfrmMain.lstFilesKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if FPerformUIUpdating then
  begin
    UpdateControlsState;
  end;
end;

procedure TfrmMain.UpdateAnalyseResultView;
begin
  UpdateAnalyseResultView(FAnalyseResults.PackageInfos[IndexOfAnalyseResult(GetSelectedFile)]);
end;

procedure TfrmMain.UpdateAnalyseResultView(ssUnits, ssRequirePackages: TStrings);
begin
  if Assigned(ssUnits) then
    mmoUnits.Lines.Assign(ssUnits);
  if Assigned(ssRequirePackages) then
  begin
    mmoRequirePackages.Lines.Text :=AnsiString(ssRequirePackages.Text);
    //mmoRequirePackages.Lines.Assign(ssRequirePackages);
  end;
end;

procedure TfrmMain.UpdateAnalyseResultView(PPI: PPackageInfos);
begin
  if PPI = nil then
  begin
    UpdateAnalyseResultView(nil, nil);
  end
  else
  begin
    UpdateAnalyseResultView(PPI.Units, PPI.RequiredPackages);
  end;
end;

procedure TfrmMain.UpdateControlsState;
var
  bEnabled: Boolean;
begin
  if FUIUpdating then
  begin
    Exit;
  end;

  FUIUpdating := True;
  try
    bEnabled := not FAnalysing;

    btnOpenFiles.Enabled := bEnabled;
    btnAnalyse.Enabled := bEnabled and (lstFiles.Items.Count > 0);
    btnClearFiles.Enabled := btnAnalyse.Enabled;
    lstFiles.Enabled := bEnabled;
  finally
    UpdateAnalyseResultView;
    FUIUpdating := False;
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
  I: Integer;
begin
  for i := 0 to ControlCount - 1 do
  begin
    if Controls[i] is TButton then
    begin
      with TButton(Controls[i]) do
      begin
        Caption := StringReplace(Caption, ' ', #13#10, [rfReplaceAll]);
      end;
    end;
  end;
  UpdateControlsState;
end;

end.