{ INSTAL.PAS                                Copyright (c) Ivan Rebo }
{ Instalacka pre hru utek.                                          }
{ https://github.com/IRebo/utek/tree/master/old-199x-version        }
{                                                                   }
{ Author: Ivan Rebo                                                 }
{ Datum: 20.01.1995                           http://www.trsek.com  }
 
{$I-}
{$G+,N-,E-}
program instalacia;
uses crt,dos,xla;
 
type
	TCharArray = array[0..0] of char;
 
var
	f : file;
	S : SearchRec;
	n : NameStr;
	d,d1 : DirStr;
	e : ExtStr;
	tmp : boolean;
	nlines, nfiles, i : integer;
	totratio, size,	compsize, origsize : longint;
	mode : word;
	buf:array [1..60000] of byte;
    zal1,zal2,b:byte;
    filename : string;
    kl,disk:char;
    diskces,cesta,temp:string;
    a:integer;
    DirInfo: SearchRec;
 
label cest;
 
function xexists( filename : string ) : boolean;
var
	f : file;
	tmp : boolean;
begin
	assign( f, filename );
	reset( f );
	tmp := ioresult=0;
	if tmp then close(f);
	xexists := tmp;
end;
 
procedure xstrupcase( var s : string ); assembler;
asm
	les di, s
	mov cx, 0
	mov cl, es:[di]
	inc di
	or  cl, cl
	jz @@Done
 
@@ChangeChar:
	mov al, es:[di]
	cmp al, 'a'
	jl @@Next
	cmp al, 'z'
	jg @@Next
	sub al, 32
	mov es:[di], al
@@Next:
	inc di
	loop @@ChangeChar
@@Done:
end;
 
procedure ReadFile( var data; s : word; var actual : longint ); far;
var
	amountread : word;
begin
	blockread( f, data, s, amountread );
	actual := amountread;
end;
 
procedure WriteFile( var data; blocksize : word ); far;
begin
	blockwrite( f, data, blocksize );
end;
 
procedure hc;
begin
   asm mov ah,1;mov ch,$20;int $10;end;
end;
procedure sc;
begin
   asm mov ah,1;mov ch,3;mov cl,4;int $10;end;
end;
procedure vc;
begin
   asm mov ah,1;mov ch,0;mov cl,4;int $10;end;
end;
 
procedure getdrive;
label iov;
begin
 textcolor(15);textbackground(1);
 gotoxy(15,10);
 write('Zadaj disk pre hru Utek : ');
 textbackground(7);iov:textbackground(1);
 gotoxy(2,8);
 write('                                                                  ');
 textbackground(7);gotoxy(41,10);
 write(' ');
 gotoxy(41,10);write(disk);
 kl:=readkey;
 if ord(kl)=0 then
 begin kl:=readkey;goto iov;end;
 if kl=#27 then begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 if kl<>#13 then
 begin
  if upcase(kl) in ['A'..'Z'] then disk:=kl;
  goto iov;
 end else begin
  if disk=#0 then begin goto iov;end;
  if upcase(disk)='A' then begin goto iov;end;
  if upcase(disk)='B' then begin goto iov;end;
  chdir(disk+':\');
  if ioresult<>0 then begin gotoxy(25,8);write('Takyto disk neexistuje !');
  kl:=readkey;if ord(kl)=0 then begin kl:=readkey;end;goto iov;end;
  if diskfree(ord(upcase(disk))-ord('A')+1)<4000000 then begin gotoxy(21,8);
  write('Malo volneho miesta na disku ! Potrebne : 4 Mb.');
  kl:=readkey;if ord(kl)=0 then begin kl:=readkey;end;goto iov;end;
 end;
end;
 
procedure getcesta;
label iov;
begin
 textcolor(15);textbackground(1);
 gotoxy(15,10);
 write('Zadaj cestu pre hru Utek : ');
 textbackground(7);iov:textbackground(1);
 gotoxy(2,8);
 write('                                                                  ');
 textbackground(7);gotoxy(41,10);
 write('                          ');
 gotoxy(41,10);write(cesta);
 sc;kl:=readkey;hc;
 if ord(kl)=0 then
 begin kl:=readkey;goto iov;end;
 if kl=#27 then begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 if kl<>#13 then
 begin
  if kl=#8 then delete(cesta,length(cesta),1);
  if length(cesta)>24 then
  begin gotoxy(30,8);goto iov;end;
  if upcase(kl) in ['A'..'Z'] then cesta:=cesta+kl;
  if (kl=':')or(kl='\') then cesta:=cesta+kl;
  if upcase(kl) in ['0'..'9'] then cesta:=cesta+kl;
  goto iov;
 end;
 if length(cesta)=0 then begin
   gotoxy(25,8);write('Zla cesta !');kl:=readkey;if ord(kl)=0 then
   begin kl:=readkey;end;goto iov;
  end;
 a:=1;temp:='';
 repeat
  if cesta[a]='\' then begin
   chdir(temp);if ioresult<>0 then begin mkdir(temp);chdir(temp);end;
   if ioresult<>0 then begin
   gotoxy(25,8);write('Zla cesta !');kl:=readkey;
   if ord(kl)=0 then
   begin kl:=readkey;end;goto iov;
  end;
  temp:='';end else
  temp:=temp+cesta[a];
  inc(a);
 until a=length(cesta);temp:=temp+cesta[a];
 chdir(temp);if ioresult<>0 then begin mkdir(temp);chdir(temp);end;
end;
 
procedure getreg;
label iov;
var meno:string;
begin
 meno:='';
 textcolor(15);textbackground(1);
 gotoxy(10,10);
 write('Zadaj svoje meno a priezvisko :');
 textbackground(7);
 iov:textbackground(1);
 gotoxy(2,8);
 write('                                                                  ');
 textbackground(7);gotoxy(41,10);
 write('                          ');
 gotoxy(41,10);write(meno);
 sc;kl:=readkey;hc;
 if ord(kl)=0 then
 begin kl:=readkey;goto iov;end;
 if kl<>#13 then
 begin
  if kl=#8 then delete(meno,length(meno),1);
  if length(meno)>20 then
  begin gotoxy(30,8);goto iov;end;
  if upcase(kl) in ['A'..'Z'] then meno:=meno+kl;
  if upcase(kl)=' ' then meno:=meno+kl;
  goto iov;
 end;
 if (length(meno)=0)or(meno[1]=' ') then begin
   gotoxy(25,8);write('Zle meno !');kl:=readkey;if ord(kl)=0 then
   begin kl:=readkey;end;goto iov;end;
 chdir(disk+':\'+cesta);
 for a:=length(meno) to 20 do meno:=meno+' ';
 for a:=1 to 20 do
 meno[a]:=chr(ord(meno[a])+a*3+50);
 assign(f,'utek.exe');
 reset(f,1);
 seek(f,30);
 for a:=30 to 50 do
  begin b:=ord(meno[a-29]);blockwrite(f,b,1);end;
 b:=$50;blockwrite(f,b,1);
 b:=$40;blockwrite(f,b,1);
 for a:=53 to 81 do
  begin b:=mem[$f000:$78+(a-53)]+120;blockwrite(f,b,1);end;
 close(f);
 chdir(diskces);
end;
 
procedure depack(p2,adr:string);
var p3:string;
    f1:file;
    size,sizes:longint;
begin
 assign(f,p2+'.HOE');
 reset(f,1);
 assign(f1,adr+'\'+p2+'.hoe');
 rewrite(f1,1);
 size:=filesize(f);
 repeat
  if size>60000 then
  begin
   size:=size-60000;
   sizes:=60000;
  end
  else sizes:=size;
  blockread(f,buf,sizes);
  blockwrite(f1,buf,sizes);
 until size=sizes;
 close(f);close(f1);
 if ioresult<>0 then
 begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 totratio:=0;
 XLAOutProc:=WriteFile;
 xLAInProc:=ReadFile;
 xstrupcase( p2 );
 FSplit( p2, d, n, e );
 if e = '' then e := '.hoe';
 p2 := adr+'\'+d+n+e;
 p3 := '*.*';
 xstrupcase( p3 );
 if not XOpenArchive(p2) then
 begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 tmp := XLAFindFirst( p3, filename );
 while tmp do
 begin
	assign(f,adr+'\'+filename);
	rewrite(f,1);
	if not XLAGet(filename) then
	begin
     textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
     writeln('Instalacia predcasne ukoncena !!!');
     sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
	end;
	close( f );
	tmp := XLAFindNext( filename );
 end;
 XCloseArchive;
 assign(f1,p2);
 reset(f1,1);
 erase(f1);
end;
 
procedure testor;
begin
 b:=ord(upcase(diskces[1]))-ord('A');
 asm
  mov al,b
  mov dx,0
  mov cx,1
  lea bx,buf
  int 25h
  pop dx
  jc @chyba
  mov b,0
  jmp @end
  @chyba:
  mov b,1
  @end:
 end;
 if b=1 then
 begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 zal1:=buf[10];
 zal2:=buf[11];
 if (zal1<>ord(','))or(zal2<>ord('O')) then
 begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
end;
 
begin
 textcolor(15);textbackground(0);
 clrscr;
 hc;
 textcolor(15);textbackground(1);
 write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍť');
 for a:=1 to 22 do begin write('ş                                                                              ş'); end;
 write('ČÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍź');
 getdir(0,diskces);
 getdrive;
 cest:
 getcesta;
 testor;
 textcolor(15);textbackground(1);
 gotoxy(15,10);
 write('                                                                 ');
 mkdir('data');
 mkdir('data2');
 mkdir('data3');
 mkdir('code');
 mkdir('music');
 mkdir('ende');
 mkdir('uvod');
 if ioresult<>0 then ;chdir(diskces);
 textcolor(15);textbackground(7);
 gotoxy(30,8);
 write('Cakaj prosim ... - 00%');
 depack('data1',disk+':\'+cesta+'\data');
 gotoxy(30,8);
 write('Cakaj prosim ... - 25%');
 depack('data2',disk+':\'+cesta+'\data2');
 gotoxy(30,8);
 write('Cakaj prosim ... - 45%');
 depack('data3',disk+':\'+cesta+'\data3');
 gotoxy(30,8);
 write('Cakaj prosim ... - 50%');
 depack('base',disk+':\'+cesta);
 gotoxy(30,8);
 write('Cakaj prosim ... - 55%');
 depack('uvod',disk+':\'+cesta+'\uvod');
 gotoxy(30,8);
 write('Cakaj prosim ... - 60%');
 depack('ende',disk+':\'+cesta+'\ende');
 gotoxy(30,8);
 write('Cakaj prosim ... - 70%');
 depack('code',disk+':\'+cesta+'\code');
 gotoxy(30,8);
 write('Cakaj prosim ... - 75%');
 gotoxy(29,10);
 write('Vloz prosim 2. disketu !');
 repeat
 kl:=readkey;if kl=#0 then kl:=readkey;
 assign(f,'music.hoe');
 reset(f,1);close(f);
 until ioresult=0;
 testor;
 textcolor(15);textbackground(1);
 gotoxy(29,10);
 write('                        ');
 depack('music',disk+':\'+cesta+'\music');
 textcolor(15);textbackground(7);
 gotoxy(30,8);
 write('Cakaj prosim ... - 100%');
 if (zal1<>ord(','))or(zal2<>ord('O')) then
 begin
  textcolor(7);textbackground(0);sc;clrscr;textcolor(lightred);
  writeln('Instalacia predcasne ukoncena !!!');
  sound(2000);delay(100);nosound;textcolor(7);chdir(diskces);halt(1);
 end;
 getreg;
 gotoxy(23,15);
 write('Instalacia kompletna - Potlac klavesu.');
 kl:=readkey;
 if ord(kl)=0 then
 begin kl:=readkey;end;
 textcolor(7);
 textbackground(0);
 sc;clrscr;writeln('Instalacia kompletna !');chdir(diskces);
end.