{ 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.