Test case : Tokens using Delphi 6

         
program tokens3;
{$APPTYPE CONSOLE}
uses
  classes, sysutils;

var
  t:tstringlist;   // a string container used to load the source

function counttokens(const src:string):integer; // the counting function

const
  cletters='_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  cnumbers='0123456789';

var
  oldat,
  at:integer;
  notoken:boolean;
  
  function isat(what:string):boolean;

  begin
    result:=AnsiUpperCase(copy(src,at,length(what)))=AnsiUpperCase(What);
    if result then at:=at+length(what); // more than 1 char
  end;

  function isin(what:string):boolean;

  begin
    result:=pos(src[at],what)>0; // test
    if result then inc(at);
  end;

  function objpoint:boolean;

  begin
    result:=(src[at]='.') and not (src[at+1] in ['0'..'9']);
    if result then inc(at);
  end;

  procedure getend(what:string);

  begin
    while not isat(what) do inc(at);
    notoken:=true;
  end;

begin
  result:=0;
  at:=1;
  while at<=Length(src) do // while we not reached the end of source
    begin
      oldat:=at;       // Start of next token = here
      notoken:=false;  // Default - what we will be reading is a token
      if isat(#39) then while not isat(#39) do inc(at)                                 // strings
      else if isat('//') then GetEnd(#13#10)                                           // linecomment
      else if isat('{') then GetEnd('}')                                               // blockcomment 1
      else if isat('(*') then GetEnd('*)')                                             // blockcomment 2
      else if (isat(':=') or isat('>=') or isat('<=') or isat('..') or isat('<>')) or  // long command
              ( (isin('[]()+*/-^@=<>;,:') or objpoint) )  then                         // short command
      else if isin('$#.'+cnumbers) then while isin('.'+cNumbers) do                    // numbers
      else if isin(cletters) then while isin(cLetters+cnumbers) do                     // identifiers
      else if isat(' ') or                                                             // spaces
              isat(#13#10) then notoken:=true;                                         // linebreaks
      if at=oldat then   // at didn't move -> we could not scan something
         writeln('Error '+inttostr(at)+' : "'+copy(src,at,20)+'"...');
      if not notoken then inc(result); // count a token
    end;
end;

begin
  t:=tstringlist.create;
  t.loadfromfile('tokens2.dpr');
  writeln(counttokens(t.text));
  freeandnil(t);
end.