Как найти слово в тексте паскаль

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Var f:text;
    s,s1,s2:string;
    b:boolean;
    i:byte;
Begin
    Assign(f,'c:in.txt');Reset(f);
    write('Введите слово: ');readln(s2);
    s1:='';b:=false;
    While not Eof(f) do
     Begin
      readln(f,s);
      writeln(s);
      s:=s+' ';
      For i:=1 to Length(s) do
       if not (s[i] in [' ','.','-',':',';','!','?']) then s1:=s1+s[i]
        else 
         Begin
          if s2=s1 then b:=true;
          s1:='';
         End;
     End;
    if b then writeln('В файле есть такое слово')
     else writeln('Нету такого словав файле');
    readln;
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

var f:text;s,st:string;
    n:integer;
begin
  assign(f,'textfile.txt');
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    writeln(s);
  end;
  writeln('введите искомое слово');
  readln(st);
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    n:=pos(st,s);
    if n>0 then begin
      writeln('есть такое слово в тексте');
      break;
    end;
  end;
  if n=0 then writeln('нет такого слова в тексте');
  close(f);
  readln
end.

1

 n:=pos(st,s);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

var f:text;s,st:string;
    n:integer;
begin
  assign(f,'1.txt');
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    writeln(s);
  end;
  writeln('введите искомое слово');
  readln(st);
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    n:=pos(st,s);
    if (n>0) and (s[n-1]=' ') and (s[n+length(st)+1]=' ') then
    begin
    writeln('есть такое слово в тексте');
    break;
    end
    else writeln('слово отсутствует');
    end;
    if n=0 then writeln('нет такого слова в тексте');
  close(f);
  readln
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

uses crt;
const pr=[' ','.',',',':',';','-','!','?'];
var f: text;
    s,sl: string;
    b: boolean;
    i: byte;
begin
assign(f,'D:in.txt');
reset(f);
write('Слово: '); readln(sl);
b:=false;
while not eof(f) do
      begin
      readln(f,s); writeln(s);
      s:=' '+s+' ';
      if not b then
         begin
         for i:=1 to length(s) do
             if (copy(s,i,length(sl))=sl) and (s[i-1] in pr)
             and (s[i+length(sl)] in pr) then b:=true;
         end;
      end;
close(f);
if b then writeln('Слово есть в файле') else writeln('Слова нет в файле');
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
Var f:text;
    s,s1,s2:string;
    b:boolean;
    i:byte;
Begin
    Assign(f,'c:in.txt');Rewrite(f);
    Repeat
     write('Vvedite stroku texta(okonchanie vvoda,vvod pustoi stroki): ');readln(s);
     if s<>''then writeln(f,s);
    Until s='';
    Close(f);
    write('Vvedite slovo: ');readln(s2);
    Assign(f,'c:in.txt');Reset(f);
    s1:='';b:=false;
    While not Eof(f) do
     Begin
      readln(f,s);
      writeln(s);
      s:=s+' ';
      For i:=1 to Length(s) do
       if not (s[i] in [' ','.','-',':',';','!','?']) then s1:=s1+s[i]
        else 
         Begin
          if s2=s1 then b:=true;
          s1:='';
         End;
     End;
    if b then writeln('V faile est" takoe slovo')
     else writeln('V faile net takogo slova');
    Close(f);
    readln;
end.

1

writeln('Vvedite stroku texta(okonchanie vvoda,vvod pustoi stroki): ');readln(s);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

program Project1;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this };
 
type
 
  { TMyApplication }
 
  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;
 
{ TMyApplication }
 
procedure TMyApplication.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;
 
  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;
 
  { add your program here }
 
  // stop program loop
  Terminate;
end;
 
constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;
 
destructor TMyApplication.Destroy;
begin
  inherited Destroy;
end;
 
procedure TMyApplication.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;
 
var
  Application: TMyApplication;
 
{$R *.res}
Var f:text;
    s,s1,s2:string;
    b:boolean;
    i:byte;
begin
  Application:=TMyApplication.Create(nil);
  Application.Title:='My Application';
  Application.Run;
  Application.Free;
 Assign(f,'c:in.txt');Rewrite(f);
    Repeat
     writeln('Vvedite stroku texta(okonchanie vvoda,vvod pustoi stroki): ');readln(s);
     if s<>''then writeln(f,s);
    Until s='';
    Close(f);
    write('Vvedite slovo: ');readln(s2);
    Assign(f,'c:in.txt');Reset(f);
    s1:='';b:=false;
    While not Eof(f) do
     Begin
      readln(f,s);
      writeln(s);
      s:=s+' ';
      For i:=1 to Length(s) do
       if not (s[i] in [' ','.','-',':',';','!','?']) then s1:=s1+s[i]
        else
         Begin
          if s2=s1 then b:=true;
          s1:='';
         End;
     End;
    if b then writeln('V faile est" takoe slovo')
     else writeln('V faile net takogo slova');
    Close(f);
    readln;
end.