Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ задача про строки и файл с записями

Автор: Zeon 18.05.2004 12:17

Не могу с ними разобраться!!! sad.gif

Автор: Zeon 18.05.2004 12:19

1, Текст задан строкой, напечатать в алфавитном порядке все гласные буквы, которые входят в последнее слово.
и еще одна

2, В файле *.* содержатся записи, имеющие следующую структуру:
group :integer;
memo: string;
Запишите в бинарный файл все записи с полем memo, не содержащим цифры.

Автор: BlackShadow 18.05.2004 15:37

1). Русская версия smile.gif

Код

Const
 Delimeters:Set Of Char = [' ',',',';','.','!','?'];
 Letters:Array[1..20] Of Char = ('А','Е','Ё','И','О','У','Ы','Э','Ю','Я','а','е','ё','и','о','у','ы','э','ю','я');
 s = 'Вот такой вот текст мы взяли для проверки';
Var
 i,j,k:Integer;
Begin
 i:=Length(s);
 While i>0 Do
   If s[i] In Delimiters Then
     Break
   Else
     Dec(i);
 For j:=1 To 10 Do
   For k:=i+1 To Length(s) Do
     If (s[k] = Letters[j]) Or (s[k] = Letters[j + 10]) Then
       Write(s[k]);
 WriteLn
End.

2). Кроссязычная версия smile.gif
Код

Var
 f1,f2:Text;
 Group:Integer;
 Memo:String;
 i:Integer;
 b:Boolean;
Begin
 Assign(f1,'In.txt');
 Reset(f1);
 Assign(f2,'Out.Txt');
 ReWrite(f2);
 While Not Eof(f1) Do
 Begin
   ReadLn(f1,Group);
   ReadLn(f2,Memo);
   b:=False;
   For i:=1 To Length(Memo) Do
     If Memo[i] In ['0'..'9'] Then
     Begin
       b:=True;
       Break
     End;
   If Not b Then
   Begin
     WriteLn(f2,Group);
     WriteLn(f2,Memo)
   End
 End;
 Close(f1);
 Close(f2)
End.

Автор: APAL 18.05.2004 15:43

BlackShadow

А где же описание записей???

... = record .... end.

А то файл получается не с записями, а просто текстовый.
А выходной файл и вовсе не бинарный - насколько я понял он должен быть:

Код
f2 : File;

Автор: BlackShadow 18.05.2004 15:49

А какая разница???????????????????????????????????
Результа-то один и тот же...

Автор: APAL 18.05.2004 16:00

Задачу, скорее всего, задал какой-то препод. И решение не соответствует условиям.

Автор: BlackShadow 18.05.2004 16:13

Ну, доставучий какой...

Код

Type
 TData=Record
   Group:Integer;
   Memo:String[255]
 End;

Var
 f1:File Of TData;
 f2:File;
 d:TData;
 i:Integer;
 b:Boolean;

Begin
 Assign(f1,'In.In');
 Reset(f1);
 Assign(f2,'Out.Out');
 ReWrite(f2,1);
 While Not Eof(f1) Do
 Begin
   Read(f1,d);
   b:=False;
   For i:=1 To Length(d.Memo) Do
     If d.Memo[i] In ['0'..'9'] Then
     Begin
       b:=True;
       Break
     End;
   If Not b Then
     BlockWrite(f2,d,sizeOf(d)
 End;
 Close(f1);
 Close(f2)
End.


Вот только для дебага и демонстрации придётся входной файл создать:
Код

Type
 TData=Record
   Group:Integer;
   Memo:String[255]
 End;

Var
 f1:File Of TData;
 d:TData;
 i,n,k,j,l:Integer;

Begin
 Randomize;
 Assign(f1,'In.In');
 ReWrite(f1);
 n:=Random(100);
 For i:= 1 To n Do
 Begin
   d.Group:=Random(32767);
   d.Memo:='';
   k:=Random(256);
   For j:=1 To k Do
     d.Memo:=d.Memo+Char(Random(128-32)+32);
   Write(f1,d)
 End;
 Close(f1)
End.

Вот так, вроде...

Автор: Zeon 18.05.2004 19:26

Спасибо всем за внимание ! smile.gif

Автор: BlackShadow 18.05.2004 19:51

Да, не на чем :p2: :P

Автор: Zeon 23.05.2004 11:44

Первая задачка че-т не пашет...

Автор: BlackShadow 23.05.2004 16:07

Ну малёк обшыбсю:

Код

Const
Delimeters:Set Of Char = [' ',',',';','.','!','?'];
Letters:Array[1..20] Of Char = ('А','Е','Ё','И','О','У','Ы','Э','Ю','Я','а','е','ё','и','о','г','л','н','о','п');
s:String = 'Вок такой вот текст мы взяли для проверки';
Var
i,j,k:Integer;
Begin
i:=Length(s);
While i>0 Do
  If s[i] In Delimeters Then
    Break
  Else
    Dec(i);
For j:=1 To 10 Do
  For k:=i+1 To Length(s) Do
    If (s[k] = Letters[j]) Or (s[k] = Letters[j + 10]) Then
      Write(s[k]);
WriteLn
End.