unit vnm_cpi;

{****************************************************************************}
{Unit VNM_CPI - it is a addon unit for graphics library VenomGFX.            }
{It brings a loader for fonts in CPI format in several subformats            }
{(MS-DOS, DR-DOS, NT, CPX packed used in FreeDOS)                            }
{****************************************************************************}

{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
interface

function CPI_container_extraction(var s,kam:string):longint;
Function CPI_Vrat_Komplexni_Retezec_s_velikostmi(const s:string;var p:pchar):longint;

type TCPI_container_extraction_report = procedure(var s:string);
var CPI_container_extraction_report:TCPI_container_extraction_report;

implementation
uses Objects,GrpFile,VenomMng,VnmFnHlp,VNM_FV,UPXdecod;

const
    MAX_CPI_ZAZN = 5000;



//Structures in the CPI file format
type
PCPI_header = ^TCPI_header;
TCPI_header = packed record
{0}  id:byte;
{1}  id7:array[0..6] of char;
{8}  reserved:array[0..7] of byte;
{16} pnum:word;
{18} ptyp:byte;
{19} fih_offset:longint;
{23}
end;



{FontInfoHeader = num_codepages = word}
PCodePageEntryHeader = ^TCodePageEntryHeader;
TCodePageEntryHeader = packed record
{0}  cpeh_size:word;
{2}  next_cpeh_offset:longint;
{6}  device_type:word;
{8}  device_name:array[0..7] of char;
{16} codepage:word;
{18} reserved:array[0..5] of char;
{24} cpih_offset:longint;
{28}
end;


PCodePageInfoHeader = ^TCodePageInfoHeader;
TCodePageInfoHeader = packed record
{0} version:word;
{2} num_fonts:word;
{4} size:word;
{6}
end;


PPrinterFontHeader = ^TPrinterFontHeader;
TPrinterFontHeader = packed record
printer_type:word;
escape_length:word;
end;


PScreenFontHeader = ^TScreenFontHeader;
TScreenFontHeader = packed record
{0} height:byte;
{1} width:byte;
{2} yaspect:byte;
{3} xaspect:byte;
{4} num_chars:word;
{6}
end;



type

     TCPIZaznamElm = packed record
        pozf:longint;   {offset v souboru}
        odkaz:pointer;  {odkaz do pameti na PObecnyFont/PFontFV(inicialne bude NIL)}
        vels:longint;
        vel:longint;
        cp:longint;
        pozfdr:longint; {specifikum pro fonty z DRDOSu}
        end;

     PCPIZaznamRec = ^TCPIZaznamRec;
     TCPIZaznamRec = packed array[1..MAX_CPI_ZAZN] of TCPIZaznamElm;

     PFontCPI = ^TFontCPI;
     TFontCPI = object
     {mapa:PfonMapa;}
     {main_CPI_header:TCPI_header;}

     zaznamu:longint;
     zaznam:PCPIZaznamRec;



     default_cp:longint;
     drdos:boolean;
     upx:boolean;
     rez:string[24];   {nazev bez cesty}
     zdroj:string;     {nazev s cestou nebo bez cesty}
     Constructor Init;
     Function PocetSad:byte;
     Function Analyza_CPI(var grp:TStream):byte;
     Function Prvni_Vyskyt_codepage(codepage:longint):longint;
     Function Vrat_Retezec_s_velikostmi(codepage:longint):string;
     Function Vrat_Retezec_s_codepages:string;
     Function Nejblizsi_k_oznaceni(hodnota,codepage:longint):longint;
     Function Index_podle_oznaceni(i,codepage:longint):byte;
     Function Load_DRDOS_subformat(os:PStream;var s:string;index,vel:longint):PObecnyFont;
     Destructor Done;virtual;
     end;


Function String_Up(s:string):string;
var a:byte;
begin
for a:=1 to Length(s) do s[a]:=UpCase(s[a]);
String_Up:=s;
end;


Function MyStr(i:longint):string;
var s:string;
begin
Str(i,s);
MyStr:=s;
end;


Constructor TFontCPI.Init;
var i:byte;
begin
rez:='';
zdroj:='';
default_cp:=0;
zaznamu:=0;
drdos:=false;
upx:=false;
zaznam:=nil;
{
for i:=1 to MAX_CPI_ZAZN do
    begin
    zaznam[i].pozf:=0;
    zaznam[i].pozfdr:=0;
    zaznam[i].odkaz:=nil;
    zaznam[i].vels:=0;
    zaznam[i].vel:=0;
    zaznam[i].cp:=0;
    end;
}
end;


Function TFontCPI.Vrat_Retezec_s_velikostmi(codepage:longint):string;
var a:longint;
    s,t:string;
begin
if zaznamu=0 then Exit('');
if codepage=0 then codepage:=default_cp;
s:='';
for a:=1 to zaznamu do
    if zaznam^[a].cp = codepage then
       begin
       Str(zaznam^[a].vel,t);
       s:=s+t+',';
       end;
if s<>'' then dec(byte(s[0]));
Vrat_Retezec_s_velikostmi:=s;
end;


Function TFontCPI.Vrat_Retezec_s_codepages:string;
var a,b:byte;
    s,t:string;
    i,k:longint;
    u:array[1..100] of longint;
    uzmame:boolean;

begin
if zaznamu=0 then Exit('');
for a:=1 to 100 do u[a]:=0;
s:='';
k:=0;
for a:=1 to zaznamu do
    begin
    i:=zaznam^[a].cp;
    uzmame:=false;
    b:=1;
    while b<=k do
       begin
       if u[b]=i then begin uzmame:=true;Break;end;
       inc(b);
       end;
    if uzmame=false then
       begin
       inc(k);
       u[k]:=i;
       Str(i,t);
       s:=s+t+',';
       end;
    end;
dec(byte(s[0]));
Vrat_Retezec_s_codepages:=s;
end;



Function TFontCPI.Analyza_CPI(var grp:TStream):byte;
{GRP musi byt jiz otevreny Stream nastaveny na Seek(0)}
var buf,buf_f:pchar;
    ne,ne2:^longint;
    wo,wo2:^word;
    cpih:PCPI_header;
    cpgh:PCodePageInfoHeader;
    drblok:pchar;
    drnum:byte;
    fih:PCodePageEntryHeader;
    sfh:PScreenFontHeader;
    a,b,i,bv,f,ff,kt,drkt,cpio:longint;
    nt:longint;
    dr:boolean;
    num_codepages:longint;
    debug:longint;
    podtyp:byte;
    tiskarna,zaznamok:boolean;
    st7:string[7];
    lokzaznamu:longint;         {lokalni ulozeni zaznamu...}
    lokzaznam:PCPIZaznamRec;    {...na konci zkopiruju do radneho bufferu}

begin

if zdroj='' then Exit(1);
{nejsme napojeni na zdrojovy soubor?}

bv:=grp.GetSize;
if bv<300 then Exit(3);
{soubor je podezrele maly?}


GetMem(buf,bv);
grp.Read(buf^,bv);

dr:=false;
drblok:=nil;
cpih:=pointer(buf);
if cpih^.id=127 then dr:=true else
  if cpih^.id<>255 then begin FreeMem(buf);Exit(4);end;
if (cpih^.pnum<>1) or (cpih^.ptyp<>1) then begin FreeMem(buf);Exit(5);end;
st7[0]:=#7;
Move(cpih^.id7,st7[1],7);

if st7='FONT   ' then podtyp:=1 else
if st7='FONT.NT' then podtyp:=2 else
if st7='DRFONT ' then podtyp:=3 else podtyp:=0;

if podtyp=0 then begin FreeMem(buf);Exit(6);end;
if podtyp=2 then nt:=1 else nt:=0;

if dr=true then if podtyp<>3 then begin FreeMem(buf);Exit(6);end
                             else begin
                             drdos:=true;
                             drblok:=@buf[23];
                             drnum:=byte(drblok[0]);
                             end;
if dr=false then if podtyp=3 then begin FreeMem(buf);Exit(6);end;

wo2:=@buf[cpih^.fih_offset];
num_codepages:=wo2^;         {pocet definovanych kodovych stranek}
{Tady pozor - muze tu byt zrada, nektere patologicke soubory sem davaji...}
{...nesmyslne velke cislo. Pozdeji to budeme muset kontrolovat}

if num_codepages=0 then begin FreeMem(buf);Exit(7);end;

{Ted uz muzu zhruba odhadnout kolik budu maximalne potrebovat zaznamu}
lokzaznamu:=0;
GetMem(lokzaznam,SizeOf(TCPIZaznamElm)*num_codepages*10);


i:=cpih^.fih_offset+2;
fih:=@buf[i];

{writeln('Analyza bezi!');
writeln(fih^.device_type);
writeln(fih^.codepage);
writeln(fih^.cpih_offset);}


default_cp:=fih^.codepage;    {prvni definovana znakova sada bude tou defaultni}
{writeln('-',default_cp,'-');}
{writeln(num_codepages);readln;}


for a:=1 to num_codepages do
    begin
    fih:=@buf[i];
    tiskarna:=fih^.device_type=2;
    if tiskarna=false then
       if (fih^.device_name='4201    ') or
          (fih^.device_name='4208    ') or
          (fih^.device_name='5202    ') or
          (fih^.device_name='1050    ') then tiskarna:=true;

    cpio:=fih^.cpih_offset;

    if (cpio>bv-24) or (cpio<0) then Break;

    {writeln('CPIO: ',cpio,' CPIO+i: ',i*nt+cpio);readln;}

    cpgh:=@buf[i*nt+cpio];



    if tiskarna=false then
       begin
       kt:=i*nt+fih^.cpih_offset+6;
       drkt:=kt+cpgh^.num_fonts*6;     {offset na tabulku FontIndex}

       {writeln('CPGH: ',cpgh^.num_fonts);}
       {readln;}


       for b:=1 to cpgh^.num_fonts do
           begin
           {writeln('A : ',a,' num_codepages: ',num_codepages);
           writeln('B : ',b,'  CPGH: ',cpgh^.num_fonts,'  KT: ',kt,'  BV: ',bv);
           readln;}

           sfh:=@buf[kt];
           if (sfh^.width=8) and (sfh^.num_chars=256) then
              begin
              zaznamok:=true;
              inc(lokzaznamu);

              {writeln('zatim OK');
              readln;}

              lokzaznam^[lokzaznamu].odkaz:=nil;
              lokzaznam^[lokzaznamu].vel:=sfh^.height;
              lokzaznam^[lokzaznamu].cp:=fih^.codepage;
              end else begin zaznamok:=false;{writeln('POZOR');}end;
           if drdos=false
              then begin
              if zaznamok=true then lokzaznam^[lokzaznamu].pozf:=kt+6;
              inc(kt,6+sfh^.height*sfh^.width*sfh^.num_chars div 8);
              {writeln(zaznam[zaznamu].cp,' : ',zaznam[zaznamu].vel,' - ',zaznam[zaznamu].pozf);}
              end
              else begin
              ne:=@drblok[1+drnum+(b-1)*4];
              if zaznamok=true then
                 begin
                 lokzaznam^[lokzaznamu].pozf:=drkt;
                 lokzaznam^[lokzaznamu].pozfdr:=ne^;
                 {writeln('cp: ',zaznam[zaznamu].cp,'vel: ',zaznam[zaznamu].vel,' ',drkt,' : ',ne^);}
                 end;
              inc(kt,6);
              end;
           end;
       end;
    i:=i*nt+fih^.next_cpeh_offset; {ukazatel na blok pro dalsi kodovou stranku}
    if (i>bv-24) or (i<0) then Break;
    {writeln('I: ',i);
    writeln(num_codepages);
    readln;}
    end;

zaznamu:=lokzaznamu;
GetMem(zaznam,SizeOf(TCPIZaznamElm)*zaznamu);
Move(lokzaznam^,zaznam^,SizeOf(TCPIZaznamElm)*zaznamu);


FreeMem(lokzaznam);
FreeMem(buf);

{writeln('konec analyzy');
readln;}

if zaznamu=0 then Analyza_CPI:=8 else Analyza_CPI:=0;
end;


Function TFontCPI.Prvni_Vyskyt_codepage(codepage:longint):longint;
var a:longint;
begin
for a:=1 to zaznamu do
    if zaznam^[a].cp=codepage then Exit(a);
Prvni_Vyskyt_codepage:=0;
end;


Function TFontCPI.Nejblizsi_k_oznaceni(hodnota,codepage:longint):longint;
{vrati index zaznamu s veliosti, ktera je nejblize k pozadovane}
var a,b,d,i:longint;
begin
if zaznamu=0 then Exit(0);
if zaznamu=1 then Exit(1);

a:=Prvni_Vyskyt_codepage(codepage);
if a=0 then codepage:=0;
if codepage=0 then codepage:=default_cp;
i:=maxlongint div 2;
b:=0;
for a:=1 to zaznamu do
    if zaznam^[a].cp=codepage then
       begin
       if zaznam^[a].vel=hodnota
          then Exit(a);
       d:=abs(hodnota-zaznam^[a].vel);
       if d<i then b:=a;
       end;
Nejblizsi_k_oznaceni:=b;
end;


Function TFontCPI.Index_podle_oznaceni(i,codepage:longint):byte;
var a:longint;
begin
a:=Prvni_Vyskyt_codepage(codepage);
if a=0 then codepage:=0;
if codepage=0 then codepage:=default_cp;
for a:=1 to zaznamu do
    if zaznam^[a].cp=codepage then
       if zaznam^[a].vel=i then Exit(a);
Index_podle_oznaceni:=0;
end;


Function TFontCPI.PocetSad:byte;
begin
PocetSad:=zaznamu;
end;


Function Dekomprimuj_UPX_data_do_streamu(s:string;var ms:TMemoryStream):longint;
{vraci velikost dekomprimovanych dat. Pokud je nevalidni, tak vrati 0}
var grp:TGRPStream;
     vb,ub:longint;
     buf:pointer;
begin
buf:=nil;
grp.Init(s,grpOpenRead);
if grp.status<>grpOK then begin Grp.Done;Exit(0);end;
vb:=grp.GetSize;

GetMem(buf,$FFFF);
grp.Read(buf^,vb);
Grp.Done;

if Check_UPX(buf)=-1 then begin FreeMem(buf);Exit(0);end;

ub:=Decode_UPX(buf,vb);

ms.Init(1,ub);
ms.Write(buf^,ub);
ms.Seek(0);
FreeMem(buf);
Dekomprimuj_UPX_data_do_streamu:=ub;
end;


Function TFontCPI.Load_DRDOS_subformat(os:PStream;var s:string;index,vel:longint):PObecnyFont;
{OS uz musi byt otevreny a Seek musi byt na 0}
var grp:TGRPStream;
    ms:PMemoryStream;
    vv,vf:longint;
    a,c,d:longint;
    wo:^word;
    woo:word;
    drd:pchar;

begin


{grp.Init(s,grpOpenRead);
if grp.status<>grpOK then begin Grp.Done;Exit(nil);end;

vv:=vel*256;
ms.Init(1,vv);

vf:=grp.GetSize;
GetMem(drd,vf);
grp.Read(drd^,vf);
grp.Done;}

vv:=vel*256;

ms:=New(PMemoryStream,Init(1,vv));
vf:=os^.GetSize;
GetMem(drd,vf);
os^.Read(drd^,vf);

d:=0;
for a:=0 to 255 do
    begin
    wo:=@drd[zaznam^[index].pozf+a*2];
    woo:=wo^;
    c:=vel*woo+zaznam^[index].pozfdr;
    ms^.Write(drd[c],vel);
    end;

{ms.Seek(0);}
Load_DRDOS_subformat:=Load_FV_font_from_stream(ms,s,vel);
FreeMem(drd);
Dispose(ms,Done);
end;


Destructor TFontCPI.Done;
begin
{dummy}
end;


Function Load_font_z_CPI(s2:string;pozf,velf:longint):pointer;
{Nacte do PObecnyFont/PFontFNT}
begin

end;


Function CPI_font_setstyle(fnt:pointer;podfunkce,param1,param2:longint):pointer;
var hf,nhf:PObecnyFont;
    pw:PFontCPI;
    pf:PFontFV;
    s2:string;
    ms:TMemoryStream;
    gs:TGRPstream;
    os:PStream;
    ub,l,okindex,okvelikost,okpozf,okvels:longint;


begin

if podfunkce=2 then
   if (param1 and prop_fn)<>0
      then VNMFN_PROP_MODE:=true
      else VNMFN_PROP_MODE:=false;

if podfunkce<>1 then Exit(nil);

{Podfunkce 1:  PARAM1 zde znaci velikost}

hf:=fnt;
pw:=hf^.odkaz_na_kontejner;
if pw=nil then Exit(nil);

s2:=pw^.zdroj;
okindex:=pw^.Nejblizsi_k_oznaceni({param1,param2}byte(param1),param1 shr 16);
okvelikost:=pw^.zaznam^[okindex].vel;
okpozf:=pw^.zaznam^[okindex].pozf;
okvels:=pw^.zaznam^[okindex].vels;

if pw^.upx=true then
   begin
   ub:=Dekomprimuj_UPX_data_do_streamu(s2,ms);
   if ub>0 then os:=@ms else os:=nil;
   end
   else begin
   gs.Init(s2,grpOpenRead);
   if gs.status<>grpOK then begin gs.Done;os:=nil;end else os:=@gs;
   end;

if os=nil then Exit(nil);

if pw^.drdos=true
   then nhf:=pw^.Load_DRDOS_subformat(os,s2,okindex,okvelikost)
   else {nhf:=Load_FV_font_from_container(s2,okpozf,okvelikost);}
        nhf:=Load_FV_font_from_stream_se_spec_pozici(os,s2,okpozf,okvelikost);

if pw^.upx=true
   then ms.Done
   else gs.Done;


{if pw^.drdos=true
   then nhf:=pw^.Load_DRDOS_subformat(s2,okindex,okvelikost)
   else nhf:=Load_FV_font_from_container(s2,okpozf,okvelikost);}

{jsou vyplnene FDATA=... a TYPZDROJE=2}

nhf^.typzdroje:=3;     {opravime, protoze jsem z bitmapoveho kontejneru}
nhf^.typ_kontejneru_detail:=3; {CPI}
nhf^.odkaz_na_kontejner:=pw;   {vazba na zastresujici strukturu FON}
pf:=PFontFV(nhf^.fdata);
pw^.zaznam^[okindex].odkaz:=nhf;
pf^.rukojet:=nhf;
pf^.kodova_stranka:=pw^.zaznam^[okindex].cp;
CPI_font_setstyle:=nhf;
end;


Function Load_CPI_font_internal(s:string;var o_strm:TStream;size:longint;zda_upx:boolean):pointer;
var a,e:byte;
    grp:TGrpStream;
    s2:string;
    temphf:PObecnyFont;
    pw:PFontCPI;
    p:pointer;

begin
for a:=1 to Length(s) do s[a]:=UpCase(s[a]);
s2:=DoplnJmenoFontu(s);

{Zde vime, ze CPI soubor existuje}
pw:=New(PFontCPI,Init);    {inicializace "skorapky"}
pw^.zdroj:=s2;
pw^.rez:=NazevBezCesty(s);
pw^.upx:=zda_upx;
e:=pw^.Analyza_CPI(o_strm);  {mimo jine vyplni promennou <zaznamu>}

if e<>0 then  {Analyza_CPI zjistila nejakou chybu?}
   begin
   Dispose(pw,Done);
   Exit(nil);
   end;

temphf:=New(PObecnyFont,Init);          {inicializuji pahyl fontu...}
temphf^.odkaz_na_kontejner:=pw;         {...ktery napojim na nasi skorapku}
{nicmene, neobtezuju se s napojovanim na zadne PFontFNT}


p:=CPI_font_setstyle(temphf,1,byte(size),(size shr 16));
{pomoci pahylu se propojime s Mapou a nahrajeme pozadovanou velikost}
Dispose(temphf,Done);                   {a tento pahyl nyni smazu}
Load_CPI_font_internal:=p;
end;



Function Load_CPI_font(s:string;size:longint):pointer;
var a:byte;
    grp:TGrpStream;
    s2:string;

begin
for a:=1 to Length(s) do s[a]:=UpCase(s[a]);
s2:=DoplnJmenoFontu(s);

grp.Init(s2,grpOpenRead);
if grp.status<>grpOK then begin Grp.Done;Exit(nil);end;

Load_CPI_font:=Load_CPI_font_internal(s,grp,size,false);
grp.Done;
end;


Function Load_CPX_font(s:string;size:longint):pointer;
var a:byte;
    ms:TMemoryStream;
    s2:string;
    newhf:PObecnyFont;
    pw:PFontCPI;
    ub:longint;

begin
for a:=1 to Length(s) do s[a]:=UpCase(s[a]);
s2:=DoplnJmenoFontu(s);

ub:=Dekomprimuj_UPX_data_do_streamu(s2,ms);

newhf:=Load_CPI_font_internal(s,ms,size,true);
pw:=PFontCPI(newhf^.fdata);
ms.Done;
Load_CPX_font:=newhf;
end;



Function CPI_Font_PrepChar(fnt:pointer;znak:word):pointer;
var hf:PObecnyFont;
begin
hf:=fnt;
CPI_Font_PrepChar:=hf^.fdata^.PrepChar(znak);
end;



Procedure CPI_font_OutText(kam:pointer;x,y:longint;s:string;fnt:pointer;color:word);
var hf:PObecnyFont;
    pf:PFontFV;

begin
if fnt<>nil then
   begin
   hf:=fnt;
   pf:=PFontFV(hf^.fdata);
   VnmFnHlp_OutText(kam,x,y,s,pf,color);
   end;
end;



Function CPI_Font_GetInfo(fnt:pointer;param1,param2:longint):longint;
var hf,hf2:PObecnyFont;
    pw:PFontCPI;
    i,j:longint;
    s:string;

begin
hf:=fnt;

if param1=101 then   {funkce Dej nejblizsi velikost k Param2}
   begin
   pw:=hf^.odkaz_na_kontejner;
   i:=pw^.Nejblizsi_k_oznaceni(byte(param2),param2 shr 16);
   j:=(pw^.zaznam^[i].cp shl 16)+pw^.zaznam^[i].vel;
   Exit(j);
   end;

if param1=102 then   {funkce Dej odkaz na font s oznacenim Param2}
   begin
   pw:=hf^.odkaz_na_kontejner;
   i:=pw^.Index_podle_oznaceni(byte(param2),param2 shr 16);
   hf2:=pw^.zaznam^[i].odkaz;
   Exit(longint(hf2));
   end;

if param1=3 then     {vygeneruj retezec, ktery obsahuje vsechny dostupne}
   begin             {velikosti fontu}
   pw:=hf^.odkaz_na_kontejner;
   s:=pw^.Vrat_retezec_s_velikostmi(0);
   Move(s,pointer(param2)^,Length(s)+1);
   Exit(-1);
   end;

if param1=4 then     {vygeneruj retezec, ktery obsahuje vsechny dostupne}
   begin             {kodove stranky fontu}
   pw:=hf^.odkaz_na_kontejner;
   s:=pw^.Vrat_Retezec_s_codepages;
   Move(s,pointer(param2)^,Length(s)+1);
   Exit(-1);
   end;

i:=hf^.GetInfo(param1,param2);
CPI_Font_GetInfo:=i;
end;




Function CPI_Font_delete(fnt:pointer;mode:byte):boolean;
var hf:PObecnyFont;
    pf:PFontCPI;
begin
hf:=fnt;
if mode=0
   then Dispose(hf,Done)    {Smaze i hf^.FData  (typu PFontFV), ale nikoliv kontejner}
   else begin {mode 1}
   pf:=hf^.odkaz_na_kontejner;
   FreeMem(pf^.zaznam);
   pf^.zaznam:=nil;
   Dispose(pf,Done);        {smaze mapu...}
   hf^.odkaz_na_kontejner:=nil;
   Dispose(hf,Done);        {...i vlastni data}
   end;
CPI_Font_delete:=true;
end;



Function CPI_container_extraction(var s,kam:string):longint;
var h:PObecnyFont;
    pw:PFontCPI;
     i,j,ub:longint;
     b:pointer;
    gs:TGRPstream;
    bf:TBufStream;


    ms:TMemoryStream;
    os:PStream;


    s3:string;
    ss:string;

begin

h:=Load_CPI_font(s,16);      {zkusime nahrat jako CPI}
if h=nil then
   begin
   h:=Load_CPX_font(s,16);   {a kdyz to nevyjde tak jako CPX}
   if h=nil then Exit(1);
   end;

pw:=h^.odkaz_na_kontejner;

if pw^.upx=true then
   begin
   ub:=Dekomprimuj_UPX_data_do_streamu(s,ms);
   if ub>0 then os:=@ms else os:=nil;
   end
   else begin
   gs.Init(s,grpOpenRead);
   if gs.status<>grpOK then begin gs.Done;os:=nil;end else os:=@gs;
   end;

if os<>nil then
   begin
   s3:=Copy(pw^.rez,1,3);
   for i:=1 to pw^.zaznamu do
       begin
       j:=256*pw^.zaznam^[i].vel;
       GetMem(b,j);
       os^.Seek(pw^.zaznam^[i].pozf);

       os^.Read(b^,j);
       {os^.ReadStream(b^,j);}

       ss:=MyStr(pw^.zaznam^[i].cp)+'-'+MyStr(pw^.zaznam^[i].vel)+'.FV';
       if CPI_container_extraction_report<>nil
          then CPI_container_extraction_report(ss);

       bf.Init(kam+ss,stCreate,j);
       bf.Write(b^,j);
       bf.Done;

       FreeMem(b);
       end;
   end;

if pw^.upx=true
   then ms.Done
   else gs.Done;

(*
gr.Init(s,grpOpenRead);
s3:=Copy(pw^.rez,1,3);
for i:=1 to pw^.zaznamu do
    begin
    j:=256*pw^.zaznam[i].vel;
    GetMem(b,j);
    gr.Seek(pw^.zaznam[i].pozf);
    gr.ReadStream(b^,j);

    ss:=MyStr(pw^.zaznam[i].cp)+'-'+MyStr(pw^.zaznam[i].vel)+'.FV';
    if CPI_container_extraction_report<>nil
       then CPI_container_extraction_report(ss);

    bf.Init(kam+ss,stCreate,j);
    bf.Write(b^,j);
    bf.Done;

    FreeMem(b);
    end;
gr.Done;
*)

CPI_Font_delete(h,1);
CPI_container_extraction:=0;
end;


Function CPI_Vrat_Komplexni_Retezec_s_velikostmi(const s:string;var p:pchar):longint;
{P musi byt prealokovany buffer}
{Vysledkem funkce je delka vysledneho PCharu <P>}
var h:PObecnyFont;
    pw:PFontCPI;
    i,j,k:longint;
    u:string;

begin
h:=Load_CPI_font(s,16);
if h=nil then h:=Load_CPX_font(s,16);

if h=nil then
   begin
   p[0]:=#0;
   Exit(0);
   end;
pw:=h^.odkaz_na_kontejner;
k:=0;
for i:=1 to pw^.zaznamu do
    begin
    u:=MyStr(pw^.zaznam^[i].cp)+':'+MyStr(pw^.zaznam^[i].vel)+',';
    j:=Length(u);
    Move(u[1],p[k],j);
    inc(k,j);
    end;
p[k-1]:=#0;
CPI_Font_delete(h,1);
CPI_Vrat_Komplexni_Retezec_s_velikostmi:=k-1;
end;


Procedure Register_CPI_Loader;
begin
RegisterFontEngine('CPI',
                   @Load_CPI_font,
                   @CPI_Font_PrepChar,
                   @CPI_Font_OutText,
                   @CPI_Font_setstyle,
                   @CPI_Font_GetInfo,
                   @CPI_Font_delete);

end;


Procedure Register_CPX_Loader;
begin
RegisterFontEngine('CPX',
                   @Load_CPX_font,
                   @CPI_Font_PrepChar,
                   @CPI_Font_OutText,
                   @CPI_Font_setstyle,
                   @CPI_Font_GetInfo,
                   @CPI_Font_delete);

end;




begin
CPI_container_extraction_report:=nil;
Register_CPI_Loader;
Register_CPX_Loader;
end.
