Delphi Code Counter

This Delphi program counts the no. of lines of code in all source files of the user-selected Delphi project file(s).

 

unit CountMain;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  IniFiles, StdCtrls;

 

type

  TZCountForm = class(TForm)

    SelBtn: TButton;

    XLb_Count: TLabel;

    CountBtn: TButton;

    OpenDialog: TOpenDialog;

    XLb_ProjName: TLabel;

    procedure SelBtnClick(Sender: TObject);

    procedure CountBtnClick(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    { Private declarations }

    IniFullFileName: string;

    DprFullFileName: string;

    DprFilePath: string;

    DprFileList: TStringList;

    PasFileList: TStringList;

    DprFiles: TStrings;

    KeyFullFileName: string;

    KeywordList: TStringList;

    procedure SetBtnsAndLabels;

    function  GetDprCount(DprFullFileName: string): LongInt;

    function  GetLineCount(FullFileName: string): LongInt;

    function  IsWhiteSpace(Buf: string): Boolean;

  public

    { Public declarations }

  end;

 

var

  ZCountForm: TZCountForm;

 

implementation

 

{$R *.DFM}

 

const

  DefSect = 'Settings';

 

procedure TZCountForm.FormCreate(Sender: TObject);

begin

  DprFileList := TStringList.Create;

  PasFileList := TStringList.Create;

  KeywordList := TStringList.Create;

end;

 

procedure TZCountForm.FormDestroy(Sender: TObject);

begin

  DprFileList.Free;

  PasFileList.Free;

  KeywordList.Free;

end;

 

procedure TZCountForm.FormActivate(Sender: TObject);

var

  I: LongInt;

  IniFile: TIniFile;

  ZCountPath: string;

begin

  XLb_Count.Caption := '';

  ZCountPath := ExtractFilePath(Application.ExeName);

  KeyFullFileName := ZCountPath + 'Keywords.txt';

  KeywordList.LoadFromFile(KeyFullFileName);

  for I := KeywordList.Count - 1 downto 0 do

  begin

    KeywordList[I] := Trim(LowerCase(KeywordList[I]));

    if KeywordList[I] = '' then

      KeywordList.Delete(I);

  end;

  IniFullFileName := ZCountPath +

    'ZCount.ini';

  IniFile := TIniFile.Create(IniFullFileName);

  try

    DprFiles := nil;

    DprFullFileName := IniFile.ReadString(DefSect,

      'Path', '');

    SetBtnsAndLabels;

  finally

    IniFile.Free;

  end;

end;

 

procedure TZCountForm.SetBtnsAndLabels;

begin

  CountBtn.Enabled := FileExists(DprFullFileName);

  XLb_Count.Caption := '';

  XLb_ProjName.Caption := DprFullFileName;

  DprFilePath := ExtractFilePath(DprFullFileName);

end;

 

procedure TZCountForm.SelBtnClick(Sender: TObject);

var

  IniFile: TIniFile;

begin

  OpenDialog.InitialDir := ExtractFilePath(DprFullFileName);

  if not OpenDialog.Execute then

    Exit;

  DprFullFileName := OpenDialog.FileName;

  DprFiles := OpenDialog.Files;

  IniFile := TIniFile.Create(IniFullFileName);

  try

    IniFile.WriteString(DefSect, 'Path', DprFullFileName);

    SetBtnsAndLabels;

  finally

    IniFile.Free;

  end;

end;

 

procedure TZCountForm.CountBtnClick(Sender: TObject);

var

  LineCount: LongInt;

  I: LongInt;

  FullFileName: string;

begin

  LineCount := 0;

  Screen.Cursor := crHourGlass;

  try

    if DprFiles = nil then

    begin

      LineCount := GetDprCount(DprFullFileName);

      XLb_Count.Caption := IntToStr(LineCount);

      Update;

    end

    else begin

      for I := 0 to DprFiles.Count - 1 do

      begin

        FullFileName := DprFiles[I];

        LineCount := LineCount + GetDprCount(FullFileName);

        XLb_Count.Caption := IntToStr(LineCount);

        Update;

      end;

    end;

  finally

    Screen.Cursor := crDefault;

  end;

end;

 

function TZCountForm.GetDprCount(DprFullFileName: string): LongInt;

var

  LineCount: LongInt;

  I, J: LongInt;

  Buf: string;

  FileName: string;

  FullFileName: string;

  QuoteStr: string;

begin

  LineCount := 0;

  QuoteStr := '''';

  DprFileList.LoadFromFile(DprFullFileName);

  for I := 0 to DprFileList.Count - 1 do

  begin

    Buf := DprFileList[I];

    J := Pos(QuoteStr, Buf);

    if J <= 0 then

      Continue;

    FileName := Copy(Buf, J + 1, Length(Buf));

    FileName := Copy(FileName, 1, Pos(QuoteStr, FileName) - 1);

    FileName := Trim(FileName);

    FullFileName := DprFilePath + FileName;

    LineCount := LineCount + GetLineCount(FullFileName);

  end;

  Result := LineCount;

end;

 

function TZCountForm.GetLineCount(FullFileName: string): LongInt;

var

  I: LongInt;

  Buf: string;

  StartLn, EndLn: LongInt;

  TopWSpaceCount: LongInt;

  WSpaceCount: LongInt;

begin

  Result := 0;

  if not FileExists(FullFileName) then

    Exit;

  PasFileList.LoadFromFile(FullFileName);

  TopWSpaceCount := 0;

  WSpaceCount := 0;

  StartLn := 1;

  EndLn := PasFileList.Count;

  for I := 0 to PasFileList.Count - 1 do

  begin

    Buf := Trim(LowerCase(PasFileList[I]));

    if Buf = 'implementation' then

      StartLn := I + 1

    else if Buf = 'end.' then

    begin

      EndLn := I - 1;

      Break;

    end

    else if not IsWhiteSpace(Buf) then

    else if StartLn > 1 then

      Inc(WSpaceCount)

    else

      Inc(TopWSpaceCount)

  end;

  if WSpaceCount <= 0 then

    WSpaceCount := TopWSpaceCount;

  Result := EndLn - StartLn - WSpaceCount + 1;

end;

 

function TZCountForm.IsWhiteSpace(Buf: string): Boolean;

var

  I: LongInt;

  Ch: Char;

  WordStr: string;

begin

  Result := False;

  Buf := Buf + ' ';

  WordStr := '';

  for I := 1 to Length(Buf) do

  begin

    Ch := Buf[I];

    if Ch in ['a'..'z'] then

    begin

      WordStr := WordStr + Ch;

    end

    else if WordStr <> '' then

    begin

      Result := KeywordList.IndexOf(WordStr) >= 0;

      if not Result then

        Exit;

      Result := False;

      WordStr := '';

    end

    else if not (Ch in [' ', ';']) then

      Exit

    else begin

      WordStr := '';

    end;

  end;

  Result := True;

end;

 

end.