Как переписать все строки, начиная, с определенного символа в другой файл ? Опции

[Nemo]

Код

Uses
      CRT, Dos;
const
      FName1 = 'OutPut.txt';
      FName2 = 'Input.txt';
var
       F1, F2  : file;
       buf      : pointer;
       count  : longint;
       num    : longint;
begin
       WriteLn('Введите номер символа:');
       ReadLn(num);
       Assign(F1, FName);
       Assign(F2, FName);
       Reset(F1, 1);
       Reset(F2, 1);
       Seek(F1, num-1);
       count:=FileSize(F1)-Num+1;
       GetMem(buf, count);
       BlockRead(F1, buf^, count);
       BlockWrite(F2, buf^, count);
       FreeMem(buf, count);  
       Close(F1);
       Close(F2);
end.

PS:
Мог ощибиться - под рукой нет Паскаля.

[KRUTOY]

Лучше бы, конечно, решение, потому как мои подборки, кажись, нерациональны, да и разобрать их трудно !!:

Код

Program proga5;
uses crt;
var
F,G:text;
a,b,c:array [1..20] of string;
i,j,h,k,z:integer;
S:char;
begin
 clrscr;
 writeln('Введите файл: ');
 i:=1;
 while not (a[i-1]='nomore') and (i<=10) do
 begin
 readln(a[i]);
 inc(i)
 end;
 assign(F,'F');
 {$I-}
 rewrite(F);
 {$I+}
 if IOResult<>0 then
 writeln('” файл не существует: ');
    i:=1;
  while not (a[i]='nomore') and (i<=10) do
  begin
   writeln(F,a[i]);
   inc(i)
  end;
   close(F);
   writeln('введиет символ: ');
   readln(S);
   reset(F);
   i:=1;
   k:=1;
  while not EOF(F) and  (i<=10) do
    for i:=1 to (h-1) do
        begin
        for j:=1 to length(c[i]) do
        read(F,c[i][j]);
        if (c[i][j]=S) then
        begin
        b[k]:=copy(c[i],j,(length(c[i])-j));
        for k:=(k+1) to (h-1) do
        b[k]:=c[i+1];
        end;
        end;
close(F);
assign(G,'G');
rewrite(G);
k:=1;
while (k<=10) and (k<>(h-1)) do
begin
writeln(G,b[k]);
inc(k)
end;
close(G);
{clrscr;
reset(G);
{end;}
readkey
end.