All pastes #393308 Raw Edit

Something

public text v1 · immutable
·published 2007-03-13 13:20 UTC
rendered paste body
//Robertas Jurkaitis, 8 grupe, 1 uzduotis, 7 variantas
//Nuskaito intext.txt, surikiuoja abeceles tvarka tuos zodzius, kurie turi dvibalsius, isveda i outtext.txt
program uzd1;
const abc='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
      bals='aeiouAEIOU';
      type mas=array[1..1000] of string;

//NUSKAITOM

procedure procedure(var arr:mas; var wordnr:integer);
var ch:char;
    nr:integer;
    word:string;
    intext:text;

begin
    assign(intext, 'intext.txt');
    reset(intext);
    begin
        word:=''; wordnr:=0;
        while not Eof(intext) do
        begin
            read(intext, ch);
            nr:=pos(ch, abc);
            if nr>0 then
            begin
                word:=word+ch;
            end
            else
            begin
                if pos(ch, abc)=0 then
                if word<>'' then
                begin
                    wordnr:=wordnr+1;
                    arr[wordnr]:=word;
                end;
                word:='';
            end;
        end;
        if word<>'' then
        begin
            wordnr:=wordnr+1;
            arr[wordnr]:=word;
            word:='';
        end;
        close(intext);
    end
end;

//SURIKIUOJAM

procedure sortz(var arr:mas; wordnr:integer);
var n, j:integer;
    temp:string;

begin
    for n:=1 to wordnr do
    begin
        for j:=n+1 to wordnr do
        begin
            if arr[n]>arr[j] then
            begin
                temp:=arr[n];
                arr[n]:=arr[j];
                arr[j]:=temp;
            end;
        end;
    end;
end;

//PATIKRINAM IR SPAUSDINAM

procedure checkprint(var arr:mas; wordnr:integer);
var outtext:text;
    n, m, z:integer;
    charas:char;

begin
    assign(outtext, 'outtext.txt');
    rewrite(outtext);
    z:=0;
    for n:=1 to wordnr do
    begin
        for m:=1 to length(arr[wordnr]) do
        begin
            charas:=arr[wordnr][m];
            z:=pos(charas, bals);
            if z>0 then
            begin
                charas:=arr[wordnr][m+1];
                z:=pos(charas, bals);
                if z>0 then
                writeln(outtext, arr[wordnr]);
            end;
                
            if (z>0)and(m=length(arr[wordnr])) then
            z:=0;
        end;
    end;
    close(outtext);
end;


var wordnr:integer;
    arr:mas;
    a, b:integer;
    txt:text;

begin
    readz(arr, wordnr);
    writeln('Nuskaitem');
    //sortz(arr, wordnr);
    writeln('Surikiavom');
    //checkprint(arr, wordnr);
    writeln('Baigta');
    readln();
    assign(txt, 'tekstas.txt');
    rewrite(txt);
    for a:=1 to wordnr do
    begin
       writeln(txt, arr[wordnr]);
    end;
    close(txt);
end.