source: cprs/branches/ScanSourceForConstants/SearchMissingU.pas@ 581

unit SearchMissingU;

interface

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

  type
    TSearchConstsForm = class(TForm)
    Memo: TMemo;
      OKBtn: TBitBtn;
      SearchBtn: TBitBtn;
     OpenDialog1: TOpenDialog;
    AbortBtn: TBitBtn;
    cbReportChanges: TCheckBox;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure SearchBtnClick(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure OKBtnClick(Sender: TObject);
    procedure AbortBtnClick(Sender: TObject);
    private
      { Private declarations }
      ConstNames : TStringList;
      AbortScan : boolean;
      procedure LoadConsts;
      procedure ScanAll;
      procedure ScanTree(RootDir : string);
      function Scan1File(FilePathName : string) : integer;
      function Report1File(FilePathName : string) : integer;
      function CheckOneConst(oneConst : string) : boolean;
    public
      { Public declarations }
      function Exists(s : string) : boolean;
    end;

  var
    SearchConstsForm: TSearchConstsForm;

implementation

  {$R *.dfm}

  uses ShowConstsU, SrcScannerU, StrUtils;

  procedure TSearchConstsForm.ScanAll;
  var
    RootDir : string;
  begin
    if OpenDialog1.Execute then begin
      RootDir := ExtractFilePath(OpenDialog1.FileName);
      ScanTree(RootDir);
      Memo.Lines.Add('Done.');
    end;
  end;

  procedure TSearchConstsForm.ScanTree(RootDir : string);
  var
    SrchRec : TSearchRec;
    NumErrorFiles : integer;
    NoAsk : boolean;
    NumProbs : integer;
  begin
    NumErrorFiles := 0;
    AbortScan := false; NoAsk := false;
    if FindFirst(RootDir+'*.*', faDirectory, SrchRec)=0 then begin
      repeat
        Application.ProcessMessages;
        if SrchRec.Attr = faDirectory then begin
          if (SrchRec.Name<>'.') and ((SrchRec.Name<>'..')) then begin
            ScanTree(RootDir+SrchRec.Name+'\');
          end;
        end else begin
          if ExtractFileExt(SrchRec.Name)= '.pas' then begin
            if cbReportChanges.Checked = true then begin
              NumProbs := Report1File(RootDir+SrchRec.Name);
            end else begin
              NumProbs := Scan1File(RootDir+SrchRec.Name);
            end;
            if NumProbs > 0 then begin
              NumErrorFiles := NumErrorFiles + 1;
              if (NumErrorFiles > 4) and (NoAsk=false) then begin
                case MessageDlg('5 files with errors found.  Continue?', mtError, mbYesNoCancel,0) of
                  mrYes  : NoAsk := true;
                  mrNo   : AbortScan := true;
                  mrCancel : {do nothing, ask again}
                end; {case}
              end;
            end;
          end;
        end;
      until (FindNext(SrchRec)<>0) or AbortScan;
    end;
    FindClose(SrchRec);
  end;

  function TSearchConstsForm.Scan1File(FilePathName : string) : integer;
  //returns number of problems.
  var
    Lines : TStringList;
    i,p : integer;
    oneLine : string;
    oneConst : string;
    found : integer;
  begin
    Lines := TStringList.Create;
    found := 0;
    Lines.LoadFromFile(FilePathName);
    Memo.Lines.Add('Scanning: '+FilePathName);
    for i := 0 to Lines.Count-1 do begin
      oneLine := Lines.Strings[i];
      while Pos('DKLangConstW',oneLine)>0 do begin
        p := Pos('DKLangConstW',oneLine)+13;
        oneLine := MidStr(oneLine,p+1,999);
        p := Pos('''',oneLine);
        oneConst := MidStr(oneLine,1,p-1);
        if CheckOneConst(oneConst) = false then found := found + 1;
        oneLine := MidStr(oneLine,p+1,999);
      end;
    end;
    //if found > 0 then edit file??
    Lines.Free;
    Result := found;
  end;

  function TSearchConstsForm.Report1File(FilePathName : string) : integer;
  //returns number of problems.
  var
    Lines : TStringList;
    i,p : integer;
    oneLine : string;
    oneConst : string;
    found : integer;
  begin
    Lines := TStringList.Create;
    found := 0;
    Lines.LoadFromFile(FilePathName);
    Memo.Lines.Add(' --------------------------------------------------------------- ');
    Memo.Lines.Add(' ');
    Memo.Lines.Add('                    File: '+FilePathName);
    Memo.Lines.Add('Line#');
    for i := 0 to Lines.Count-1 do begin
      oneLine := Lines.Strings[i];
      if Pos('//kt',oneLine)>0 then begin
        Memo.Lines.Add(IntToStr(i)+': '+oneLine)
      end;
    end;
    Lines.Free;
    Result := found;
  end;

  function TSearchConstsForm.CheckOneConst(oneConst : string) : boolean;
  //return TRUE if OK, FALSE if had to be added.
  begin
    Result := true;
    if not Exists(oneConst) then begin
      if Memo.Lines.IndexOf(oneConst) < 0 then begin
        Memo.Lines.Add(oneConst);
        Result := false;
      end;
    end;
  end;

  function TSearchConstsForm.Exists(s : string) : boolean;
  begin
    Result := ConstNames.IndexOf(s) > -1;
  end;

  procedure TSearchConstsForm.LoadConsts;
  var i : integer;
      s : string;
  begin
    ConstNames.Clear;
    for i := 0 to ConstantsOutputForm.ConstantsMemo.Lines.Count-1 do begin
      s := ConstantsOutputForm.ConstantsMemo.Lines.Strings[i];
      s := piece(s,'=',1);
      ConstNames.Add(s);
    end;
  end;

  procedure TSearchConstsForm.FormCreate(Sender: TObject);
  begin
    ConstNames := TStringList.Create;
  end;

  procedure TSearchConstsForm.FormDestroy(Sender: TObject);
  begin
    ConstNames.Free;
  end;

procedure TSearchConstsForm.SearchBtnClick(Sender: TObject);
var
  fName: string;

begin
  OKBtn.Enabled := false;
  AbortBtn.Enabled := true;
  SearchBtn.Enabled := false;
  Memo.Lines.Clear;
  ScanAll();
  OKBtn.Enabled := true;
  AbortBtn.Enabled := false;
  SearchBtn.Enabled := true;
  if cbReportChanges.Checked = true then begin
    if MessageDlg('Save Report?',mtConfirmation,mbOKCancel,0) = mrOK then begin
      if OpenDialog1.Execute then begin
        fName := OpenDialog1.FileName;
        Memo.Lines.SaveToFile(fName);
      end;
    end;
  end;
end;

procedure TSearchConstsForm.FormShow(Sender: TObject);
begin
  LoadConsts;
end;

procedure TSearchConstsForm.OKBtnClick(Sender: TObject);
begin
  Hide;
end;

procedure TSearchConstsForm.AbortBtnClick(Sender: TObject);
begin
  AbortScan := true;
end;

end.