Всем доброе утро!
Возникла следующая залача. Требуется найти в текстовом файле количество вхождений подстроки в строку по шаблону.
Например подстроки AB и ab.

 
var fname : string;
    f1 : text;
  
procedure outputfile(var f1 : text);
var s : string;

begin
     reset(f1);
     repeat
     readln(f1, s);
     writeln(s);
     until eof(f1);
end;

function search(var f1 : text; s1 : string; s2 : string) : integer;
var x : integer;
    s : string;
begin
     x := 0;
     reset(f1);
     while not eof(f1) do
     begin
     read(f1, s);
     for i := 0 to length(s) do
         if ((s[i] = s1) and (s[i + 1] = s2)) then inc(x);
     end;
     search := x;
     close(f1);
end;

begin
clrscr;

writeln('What file do you want open?');
readln(fname);
assign(f1, fname);
outputfile(f1);
writeln('The amount ofcombination of words AB is equal', search(f1, 'A', 'B'));
writeln('The amount of combination of words ab is equal', search(f1), 'a', 'b');
readkey;
end.

Не томи. В чем вопрос-то?..

В том то и вопрос что эта програмулина не делает того что надо. Просьюа подкорректировать код.

Тема разрулена мною лично. Всем спс за внимание!

Так ты б уже выложил результат, вдруг пригодится кому-то

Та воть пожалуста

 
program lab9;

uses crt;


var fname : string;
    f1 : text;
    ans : char;
    s, str : string;
    x, i, n : integer;
procedure outputfile(var f1 : text);
var s : string;

begin
     reset(f1);
     repeat
     readln(f1, s);
     writeln(s);
     until eof(f1);
end;

function search(var f1 : text; s1 : string; s2 : string) : integer;
var x : integer;
    s : string;
begin
     x := 0;
     reset(f1);
     while not eof(f1) do
     begin
     readln(f1, s);
     for i := 0 to length(s) do
         if ((s[i] = s1) and (s[i + 1] = s2)) then inc(x);
     end;
     search := x;
     close(f1);
end;


begin
clrscr;
writeln('What file do you want open?');
readln(fname);
assign(f1, fname);
outputfile(f1);
writeln('The amount of combination of words AB is equal ', search(f1, 'A', 'B'));
writeln('The amount of combination of words ab is equal ', search(f1, 'a', 'b'));
readkey;
end.

Вот и всё.