program stringy;
{Program ilustruje porovnavani dvou retezcu podle abecedy,
nezajima se pritom o velikost pismen}
type tvysledek=-1..1; {mensi, rovno, vetsi}

function min(a,b:longint):longint;
begin
 if a<b then min:=a else min:=b;
end;

function srovnej(s1,s2:Openstring):tvysledek;
var i:Word;
begin
 for i:=1 to min(length(s1),length(s2)) do
  if UpCase(s1[i])<UpCase(s2[i]) then begin srovnej:=-1; exit; end
   else
    if UpCase(s1[i])>UpCase(s2[i]) then begin srovnej:=1; exit; end;

 if length(s1)<length(s2) then begin srovnej:=-1; exit; end
  else if length(s1)>length(s2) then begin srovnej:=1; exit; end
       else srovnej:=0;
end;

begin
 writeln(srovnej('ahoj','AHOJ'));
 writeln(srovnej('kocka','pes'));
 readln;
end.

*********************************************************************************************


program stringy;
{Tentyz program jde s pouzitim standardni knihovny napsat o mnoho rychleji
a prehledneji}
uses strings;
begin
 writeln(strIcomp('ahoj','AHOJ'));
 readln;
end.

**********************************************************************************************************

program razenistringu;
{Setridime pole stringu... pouzivam quicksort, at si ten algoritmus zapamatujeme}
const maxdelka=50; {max delka pole}
type Tpole=array[1..maxdelka] of string;
     Tsrovnavaci=function(s1,s2:string):Integer;

function min(a,b:longint):longint;
begin
 if a<b then min:=a else min:=b;
end;

procedure prohod(var s1,s2:string);
var s3:string;
begin
 s3:=s1;
 s1:=s2;
 s2:=s3;
end;

function srovnej(s1,s2:Openstring):integer;far;
var i:Word;
begin
 for i:=1 to min(length(s1),length(s2)) do
  if UpCase(s1[i])>UpCase(s2[i]) then begin srovnej:=-1; exit; end
   else
    if UpCase(s1[i])<UpCase(s2[i]) then begin srovnej:=1; exit; end;

 if length(s1)>length(s2) then begin srovnej:=-1; exit; end
  else if length(s1)<length(s2) then begin srovnej:=1; exit; end
       else srovnej:=0;
end;


procedure QuickSort(var Pole:Tpole;odkud,kam:integer;porovnej:Tsrovnavaci);
var piv:string;{pivot}
    i,j:1..maxdelka;
begin
 if odkud>=kam then Exit;{uz neni co radit, jedno- a meneprvkove pole je serazene vzdy}
 piv:=pole[odkud];{vyber pivota}
 j:=odkud;{pozice, kam az sahaji prvky mensi nebo rovne pivotovi}
 i:=odkud;{pozice srovnavaneho prvku}

 for i:=odkud to kam do
 if porovnej(piv,pole[i])<0 then
  begin
   j:=j+1;
   prohod(pole[i],pole[j]);{prvek mensi nez pivot prohodime s prvnim
                           prvkem vetsim a jako dalsi vyssi prvek
                           oznacime prvek nasledujici}
  end;
 prohod(pole[odkud],pole[j]);{pivota soupneme doprostred}
 QuickSort(pole,odkud,j-1,porovnej); {a setridime levou}
 QuickSort(pole,j+1,kam,porovnej);   {a pravou cast pole}
end;

var fin:text;
    i:integer;
    delka:integer;
    pole:tpole;
begin
 assign(fin,'funkce.pas');
 reset(fin);
 i:=0;
 while (not Eof(fin)) and (i<maxdelka) do
  begin
   i:=i+1;
   readln(fin,pole[i]);
  end;
 delka:=i;
 quicksort(pole,1,delka,srovnej);
 for i:=1 to delka do
  writeln(pole[i]);
 readln;
end.

*****************************************************************************
{$X+} {Potrebujeme rozsirenou syntaxi, nebot pouzivame strings je lepsi ji nastavit
      v hlavicce, nebot pak pujde nas program prelozit nezavisle
      na nastaveni kompilatoru}
program rotation;
uses strings;

function vypis(a:Pchar):word;
{Jako vzdy vraci pocet vypsanych znaku}
var i:word;
begin
 i:=0;
 while a[i]<>#0 do
  begin
   write(a[i]);
   i:=i+1;
  end;
 vypis:=i;{vrati pocet vypsanych znaku}
end;

function rotate(a:Pchar;n:word):Pchar;
var b:Pchar;
    t:word;
begin
 t:=strlen(a);
 if n>t then n:=n mod t; {Retezec se protoci nekolikrat}
                         {Abychom mohli provest dalsi kod, museli jsme zajistit,ze n<t}
 GetMem(b,t);            {Bacha, alokujeme pamet, musime ji nekde uvolnit}
 StrCopy(b,a+n);         {a+n je zapis povoleny pouze v rozsirene syntaxi
                         rika: vem ukazatel na a a soupni ho o n znaku
                         doprava - tedy na zacatek naseho vysledneho
                         retezce}
 StrLCopy(StrEnd(b),a,n);{Dokopirujeme zbyle znaky}
 rotate:=b;
end;

var b:Pchar;
begin
 b:=rotate('dinosauri jeste nevymreli',260);
 vypis(b);
 freemem(b,StrLen(b)); {Jako vzdy nezapomeneme pamet uvolnit,
                       to je take duvod, proc nelze primo psat
                       vypis(rotate('dinosauri ... ',21))}
 readln;
end.

*****************************************************************************

{$X+} {Opet stringy -- tudiz zapneme rozsirenou syntaxi}
program prevod;
{Prevede pole stringu na jediny dlouhatansky Pchar}
{Jelikoz u Pcharu musim zajistit potrebnou delku,
nevystacime si s new a dispose (dokonce ani s StrNew a StrDispose)
a musime vyuzit funkce GetMem a FreeMem}
uses strings;
const maxdelka=200;
      increment:word=200;
var a,b:Pchar;
    stringy:array[1..maxdelka] of string;
    s:string;
    fin:text;
    delka,i:word;
    delkaa:word;
    maxdelkaa:word;

function inflate(var a:Pchar;var puvmaxdelka:word;increment:word):Pchar;
var b:Pchar;
    i:word;
begin
 getmem(b,puvmaxdelka+increment);
 for i:=0 to puvmaxdelka do
  b[i]:=a[i]; {Prekopirujeme puvodni string}
 FreeMem(a,puvmaxdelka); {Uvolnime zabranou pamet}
 puvmaxdelka:=puvmaxdelka+increment;
 a:=b;
 inflate:=b;
end;

function vypis(a:Pchar):word;
{Vypise Pchar a vrati pocet vypsanych znaku}
var i:word;
begin
 i:=0; {V pascalu nejde inicializovat konstanty procedur jinak nez takto}
 while (a[i]<>#0) do
  begin
   write(a[i]);
   i:=i+1;
  end;
 vypis:=i;
end;

begin
 write('Jmeno souboru: ');
 readln(s);
 assign(fin,s);
 {$I-}       {Vypneme kontrolu, takze pokud se nam nepovede
             soubor otevrit, program nespadne
             a cislo chyby se ulozi do IOResult}
 Reset(fin);
 {$I+}       {Kontrolu zapneme co nejdrive}
 if IOResult<>0 then
  begin
   Write('Nepodarilo se zadany soubor otevrit pro cteni');
   Readln;
   Halt;
  end;

 delka:=0;
 while (not Eof(fin)) and (delka<maxdelka) do
  begin
   delka:=delka+1;
   Readln(fin,stringy[delka]);
  end;

 delkaa:=0;
 maxdelkaa:=0;
 getmem(b,300);
 for i:=1 to delka do
  begin
   if maxdelkaa<delkaa+length(stringy[i])+2 then {V pameti mame alokovano malo mista}
    a:=inflate(a,maxdelkaa,increment); {Tak ho zvetsim}
   StrCat(a,(StrPCopy(b,stringy[i]))); {pripojim na konec stringu a}
   StrCat(a,#10#13#0); {za nej pripojim znaky nove radky, pojistim nula na konci}
   delkaa:=delkaa+length(stringy[i])+2; {a zvetsim aktualni delku a}
  end;
 FreeMem(b,256);  {Uvolnime pomocnou promennou}

 vypis(a);
 FreeMem(a,maxdelkaa);
 readln;
end.

********************************************************************************************************

{$X+}
program prevod;
{Ulozi soubor do PCharu, vyuziva pritom objektu}
uses strings;
const increment:word=200;
type  pdata=^tdata;
      tdata=object
                s:Pchar;
                sz:word;
                avaible:word;
                constructor Init;
                procedure inflate(increment:integer); {Zvetsi alokovane misto}
                function vypis:word;                  {Vypise data a vrati kolik znaku vypsal}
                function put(os:Openstring):longint; {Vlozi radku s do Pcharu}
                destructor Done;virtual; {Za destruktor vzdy piseme slovo virtual
                                         predejdeme tak mnoha problemum}
          end;

constructor tdata.init;
begin
 s:=nil;
 sz:=0;
 avaible:=0;
end;

procedure tdata.inflate(increment:integer);
var b:Pchar;
    i:word;
begin
 getmem(b,avaible+increment);
 if sz=0 then
  for i:=0 to avaible+increment do b[i]:=#0
 else
 for i:=0 to sz do
  b[i]:=s[i];
  b[sz+1]:=#0; {Radeji tam vrazime jeste jednu ukoncovaci nulu}
 FreeMem(s,avaible); {Uvolnime zabranou pamet}
 Inc(avaible,increment);
 s:=b;
end;

function tdata.vypis:word;
var i:word;
begin
 i:=0;
 while (s[i]<>#0) do
  begin
   write(s[i]);
   i:=i+1;
  end;
 vypis:=i;
end;

function tdata.put(os:Openstring):Longint;
var b:array[0..300] of char; {To je take Pchar a tohle je rychlejsi
                             nez ho pri kazdem volani alokovat dynamicky}
begin
 if avaible<sz+Length(os)+2 then {V pameti mame alokovano malo mista}
      inflate(increment); {Tak ho zvetsim}
   StrCat(s,(StrPCopy(b,os))); {pripojim na konec stringu a}
   StrCat(s,#10#13#0); {za nej pripojim znaky nove radky, pojistim nulou na konci}
   inc(sz,length(os)+2);
   put:=sz;
end;

destructor tdata.done;
begin
 FreeMem(s,avaible);
 avaible:=0;
 sz:=0;
end;

{--------------------------end of PDATA------------------------}

var a:pdata;
    s:string;
    fin:text;
    i:word;

begin
 write('Jmeno souboru: ');
 readln(s);
 assign(fin,s);
 {$I-}       {Vypneme kontrolu, takze pokud se nam nepovede
             soubor otevrit, program nespadne
             a cislo chyby se ulozi do IOResult}
 Reset(fin);
 {$I+}       {Kontrolu zapneme co nejdrive}
 if IOResult<>0 then
  begin
   Write('Nepodarilo se zadany soubor otevrit pro cteni');
   Readln;
   Halt;
  end;

 a:=new(pdata,init);
 while not Eof(fin) do
  begin
   Readln(fin,s);
   a^.put(s); {vlozim s do a}
  end;
 a^.vypis;
 dispose(a,done);

 readln;
end.

******************************************************************************

{$X+}
program nahrazeni;
{Nahradi v souboru jmeno vsechny vyskyty a stringem s
a vysledek ulozi do souboru sjmeno.
Jelikoz Pascal vyuziva jen malou cast pameti, zvladne tento program
zpracovat soubor o maximalni delce cca. 20 000 znaku.
(Jinak bychom si museli jeste hrat s pristupem na disk a to by teprve
byla sranda.)}
uses strings;

const increment:word=200;
type  pdata=^tdata;
      tdata=object
                private {Soukroma data a metody. Mel by o nich
                        vedet pouze objekt sam.}
                        s:Pchar;
                        sz:word;
                        avaible:word;
                        procedure inflate(increment:integer); {Zvetsi alokovane misto}

                public
                      constructor Init;
                      function vypis:word;                  {Vypise data a vrati kolik znaku vypsal}
                      function put(var Os:Openstring):Longint; {Vlozi radku s do Pcharu}
                      destructor Done;virtual; {Za destruktor vzdy piseme slovo virtual
                                                    predejdeme tak mnoha problemum}
          end;

constructor tdata.init;
begin
 s:=nil;
 sz:=0;
 avaible:=0;
end;

procedure tdata.inflate(increment:integer);
var b:Pchar;
    i:longint;
begin
 getmem(b,avaible+increment);
 if sz=0 then
  for i:=0 to avaible+increment do b[i]:=#0
  else
  for i:=0 to sz do
   b[i]:=s[i];
  b[sz+1]:=#0; {Radeji tam vrazime jeste jednu ukoncovaci nulu}
 FreeMem(s,avaible); {Uvolnime zabranou pamet}
 Inc(avaible,increment);
 s:=b;
end;

function tdata.vypis:word;
var i:word;
begin
 i:=0;
 while (s[i]<>#0) do
  begin
   write(s[i]);
   i:=i+1;
  end;
 vypis:=i;
end;

function tdata.put(var Os:Openstring):Longint;
var b:array[0..300] of char; {To je take Pchar a tohle je rychlejsi
                             nez ho pri kazdem volani alokovat dynamicky}
begin
 if avaible<sz+Length(os)+2 then {V pameti mame alokovano malo mista}
      inflate(increment); {Tak ho zvetsim}
   StrCat(s,(StrPCopy(b,os))); {pripojim na konec stringu a}
   StrCat(s,#10#13#0); {za nej pripojim znaky nove radky, pojistim nulou na konci}
   inc(sz,length(os)+2);
   put:=sz;
end;

destructor tdata.done;
begin
 FreeMem(s,avaible);
 avaible:=0;
 sz:=0;
end;

{-------------------------------end of pdata--------------------------------------------------------}

type    pfdata=^tfdata;
        tfdata=object(tdata) {Potrebujeme novy objekt s podobnymi vlastnosti,
                           tak ho vytvorime jako potomka jiz existujiciho
                           objektu}
                public
                      function getfile(var fin:text):longint; {Nahraje soubor do PCharu, vrati pocet nactenych radek}
                      function putfile(var fout:text):longint;{Ulozi PChar do souboru, vrati pocet ulozenych znaku}

                      function replace(var a,b:OpenString):longint; {Nahradi v retezci podretezce A podretezcem B,
                                                                    vrati pocet zmen}
                      destructor Done;virtual; {Jelikoz je destruktor virtualni,
                                               musi mit kazdy potomek svuj vlastni
                                               destruktor.}
             end;

function tfdata.getfile(var fin:text):longint; {Zkopiruje soubor do Pcharu
                                               a vrati pocet zkopirovanych
                                               radek.}
var os:string;
    t:longint;
begin
 t:=0;
 while not Eof(fin) do
  begin
   Readln(fin,os); {na stringu je blbe, ze se nacte jen prvnich 255 znaku
                   z dane radky. Lepsi by bylo nacitat po jednotlivych charech
                   ci pomoci bitoveho cteni ve vetsich blocich.}
   put(os); {vlozim s do a}
   Inc(t);
  end;
getfile:=t;
end;

function tfdata.putfile(var fout:text):longint; {Ulozi Pchar do souboru}
var i:word;
begin
 i:=0;
 while s[i]<>#0 do
  begin
   Write(fout,s[i]);
   i:=i+1;
  end;
putfile:=i;
end;

function tfdata.replace(var a,b:OpenString):longint;
var s1,s2:array[0..255] of char;
    a1,b1,c1,p:Pchar;
    da,db,dc,dd:Longint;
    t,i:longint;
begin
 a1:=StrPCopy(s1,a);
 b1:=StrPCopy(s2,b);
 da:=StrLen(a1);
 db:=StrLen(b1);
 dd:=StrLen(s);
 dc:=db-da;

 t:=0;
 i:=0;

 p:=StrPos(s+t,a1);
 while p<>nil do
  begin
   getmem(c1,dd+dc);
   if p<>s then StrLCopy(c1,s,p-s);
   t:=p-s+db;
   StrCopy(StrEnd(c1),b1);
   StrCopy(StrEnd(c1),p+da);
   FreeMem(s,sz);
   sz:=dd+dc;
   avaible:=sz;
   s:=c1;
   inc(i);
   p:=StrPos(s+t,a1);
  end;

 replace:=i;
end;

destructor tfdata.Done;
begin
 inherited Done; {Jelikoz se destruktor potomka a predka nelisi,
                 zavolame puvodni destruktor predka, to znamena
                 to slovicko inherited.}
end;
{---------------------------------end of tfdata------------------------------}


var A,B:string;
    P:pfdata;
    fin,fout:text;
    fname:string;

begin
 {--------------------------INICIALIZACE-------------------------------------}
 write('Jmeno souboru:');
 Readln(fname);
 Assign(fin,fname);
 Assign(fout,'s'+fname);
 {$I-}
  Reset(fin);
  Rewrite(fout); {Predtim bychom meli zkontrolovat, zda tento soubor
                 nahodou neexistuje, abychom ho nahodou neprepsali.}
 {$I+}
 if IOResult<>0 then
    begin
         Writeln('Soubory se nepodarilo otevrit');
         Readln;
         Halt;
    end;
 p:=new(pfdata,Init);
 {----------------------------VLASTNI TELO PROGRAMU--------------------------}
 p^.getfile(fin);
 write('Zadejte retezec k nahrazeni:');
 readln(A);
 write('Zadejte cim nahrazovat:');
 readln(B);
 p^.replace(A,B);
 p^.putfile(fout);
 {---------------------------NEZBYTNY UKLID----------------------------------}
 dispose(p,done);
 Close(fout);
 Close(fin);
end.