unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ImgList;
type
TForm1 = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
Memo2: TMemo;
SaveDialog1: TSaveDialog;
ImageList1: TImageList;
Label1: TLabel;
Label2: TLabel;
N6: TMenuItem;
procedure Button1Click(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure Memo2Change(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N6Click(Sender: TObject);
private
procedure ShowResult;
procedure Work;
public
end;
var
Form1: TForm1;
var f: textFile;
k: array [1..84] of integer;
s,sl,nm,lb: string;
i,j: byte;
c: char;
implementation
uses Unit2;
const ks: array [1..84] of string=('program','uses','const','var','label','type','begin','end',
'and','or','not','div','mod','if','then','else','case','of', 'byte','integer','real','char','string','array','record','file','set', 'for','to','do','downto','goto','in','nil','repeat','until','while', 'function','procedure','as','asm','class','constructor','destructor', 'dispinterface','except','exports','finalization','finally','implementation', 'inherited','initialization','inline','interface','is','library','object','out', 'packed','property','raise','resourcestring','shl','shr','threadvar','try',
'unit','with','xor','public','private','protected', 'published','copy','pos','delete','length','setlength','now','read','write',
'override','overwrite','virtual');
r: set of char=[' ',':',';',','];
function CutName (str: string; q: byte): string;
var sss: string;
begin
sss:='';
while (q>=1) and (str[q] in ['a'..'z','0'..'9']) do
begin
sss:=str[q]+sss;
dec(q);
end;
CutName:=sss;
end;
function CutNameF (str: string; q: byte): string;
var sss: string;
begin
sss:='';
while (q<=length(str)) and (str[q] in ['a'..'z','0'..'9']) do
begin
sss:=sss+str[q];
inc(q);
end;
CutNameF:=sss;
end;
{$R *.dfm}
procedure TForm1.ShowResult;
var
i,j:integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Ключевые слова:');
j:=0;
for i:=1 to 84 do
if k[i]<>0 then
begin
inc(j);
Memo1.Lines.Add(ks[i]+'- '+IntToStr(k[i]));
end;
Memo1.Lines.Add('Перечень простых переменных: '+nm);
Memo1.Lines.Add('Перечень меток в алфавитном порядке: '+lb);
end;
procedure TForm1.Work;
begin
AssignFile(f, OpenDialog1.Filename);
reset(f); nm:=''; sl:=''; lb:=''; j:=0;
while not (eof(f)) do
begin
readln(f,s);
s:=' '+s+' ';
if pos('label',s)<>0 then
begin
sl:=copy(s,pos('label',s)+5,pos(';',s)-pos('label',s)+5);
for c:='a' to 'z' do
for j:=2 to length(s) do
if (sl[j]=c) and (sl[j-1] in r)then lb:=lb+CutNameF (sl,j)+' ';
sl:='';
end;
for i:=2 to length(s) do
if copy(s,i,2)=':=' then nm:=nm+CutName (s,i-1)+', ';
for i:=1 to length(s) do
if not (s[i] in r) then sl:=sl+s[i] else
if length(sl)>0 then
begin
for j:=1 to 84 do
if sl=ks[j] then inc(k[j]);
sl:='';
end;
end;
CloseFile(f);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Work;
ShowResult;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
Memo1.ScrollBars:=ssVertical;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
AboutBox.Showmodal;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
Work;
ShowResult;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
Edit1.Text:=ChangeFileExt(ExtractFileName(OpenDialog1.Filename),'');
end;
procedure TForm1.Memo2Change(Sender: TObject);
begin
Memo2.ScrollBars:=ssVertical;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
Memo2.Lines.SaveToFile(OpenDialog1.FileName);
end;
procedure TForm1.N6Click(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
end;
end.
17.05.2016, 10:45
Программа обработки pas файлов
Линейный вид
