home *** CD-ROM | disk | FTP | other *** search
/ hobbes.nmsu.edu / 2008-06-02_hobbes.nmsu.edu.zip / dos / Usb4pas.zip / DUTILS.PAS next >
Pascal/Delphi Source File  |  1998-10-02  |  15KB  |  722 lines
  1. { DUTILS - Turbo Pascal UTILITIES                      }
  2. { (c) 1994 by Dieter Pawelczak                         }
  3.  
  4. {$R-}
  5. {$D+}
  6. {$S-}
  7. unit DUTILS;
  8. interface
  9. uses DOS,crt;
  10. const { Month names and number of days - used to display the date }
  11.   MonthStr: array[1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun','Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  12.   DayStr: Array[0..6] of String[3] = ('Su.','Mo.','Tu.','We.','Th.','Fr.','Sa.');
  13.   MonatStr: array[1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'Mai', 'Jun','Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez');
  14.   TagStr: Array[0..6] of String[3] = ('So.','Mo.','Di.','Mi.','Do.','Fr.','Sa.');
  15.   MonthLen: Array[1..12] of Byte=(31,28,31,30,31,30,31,31,30,31,30,31);
  16.  
  17. var
  18.   Path: PathStr;
  19.   scrtyp:Word;
  20.  
  21.  
  22. (*    File - Procedures                             *)
  23.  
  24. procedure copyfile(Source,Dest:String);
  25. function Filelength(pth:string):LongInt;
  26. procedure IsExt(VAR Filename:String;Ext:String);
  27. FUNCTION GetExefilesize(Exename:String): LONGINT;
  28. function getprgdir(prg:string):String;(* read directory of prg file      *)
  29. function fileexist(fn:String):Boolean;
  30.  
  31. (*    CRT routines                                  *)
  32.  
  33. procedure cursoroff;
  34. procedure cursoron;
  35.  
  36. procedure color(ccl,cch:Byte);        (* color (Fore -,background)       *)
  37. function Bigletters(bl:String):String;(* German upcase                   *)
  38.  
  39.  
  40. Procedure Twin(x1,y1,x2,y2:Byte);
  41. Procedure Twin2(x1,y1,x2,y2:Byte);  (* Double          *)
  42. Procedure Twin1(x1,y1,x2,y2:Byte);  (* Single          *)
  43. Procedure Cwin2(x1,y1,x2,y2,attr:Byte);  (* Double with colour attributes     *)
  44. Procedure Cwin1(x1,y1,x2,y2,attr:Byte);  (* single                            *)
  45. Procedure tback;                    (* draw background                        *)
  46. procedure shad(xx,yy:WORD);
  47. procedure print(x1,y1:word;t:string);(* print with no attributes *)
  48. procedure cprint(x1,y1:word;t:string;attr:byte);(* print with attributes *)
  49.  
  50. (* Number Conversions                               *)
  51.  
  52. procedure twodecout(xx:real);
  53. procedure hexout(xx:word);          (* print hex number                   *)
  54. function bins16(xx:word):String;
  55. function bins8(xx:byte):String;
  56. function bins(xx:longint):String;
  57.  function hexs(xx:longint):String;
  58. function hexs8(xx:byte):String;
  59. function hexs16(xx:word):String;
  60. function twodecs(xx:real):String;   (* convert real to string             *)
  61. function decs(xx:longint;format:Byte):String;(* convert integer to String *)
  62. function hextodec(s:string):longint;(* convert Hex to Longint             *)
  63.  
  64. (* Date and Time                                    *)
  65.  
  66. function getweekday(d,m,y:word):integer; (* d-day m-month y-year          *)
  67. function date(typ:boolean):String;  (* convert date to string             *)
  68. procedure stime;                      (* show time                       *)
  69. function time:String;               (* get time               HH.MM.SS    *)
  70. function timeexact:String;          (* get time               HH.MM.SS.hh *)
  71.  
  72. (* Keyboard  *)
  73.  
  74. function shiftpressed:Boolean;
  75. function strpressed:Boolean;
  76. function Altpressed:Boolean;
  77. function altgrpressed:Boolean;
  78.  
  79.  
  80.  
  81.  
  82. implementation
  83.  
  84.  
  85. function shiftpressed:Boolean;
  86. var std:byte;
  87. begin
  88. asm
  89.   mov ah,2;
  90.   int 16h
  91.   mov std,al
  92.   end;
  93. shiftpressed:=(std and 1=1)or(std and 2=2);
  94. end;
  95.  
  96. function strpressed:Boolean;
  97. var std:byte;
  98. begin
  99. asm
  100.   mov ah,2;
  101.   int 16h
  102.   mov std,al
  103.   end;
  104. strpressed:=(std and 4=4);
  105. end;
  106.  
  107. function Altpressed:Boolean;
  108. var std:byte;
  109. begin
  110. asm
  111.   mov ah,2;
  112.   int 16h
  113.   mov std,al
  114.   end;
  115. Altpressed:=(std and 8=8);
  116. end;
  117.  
  118. function altgrpressed:Boolean;
  119. var std:byte;
  120. begin
  121. asm
  122.   mov ah,12h;
  123.   int 16h
  124.   mov std,ah
  125.   end;
  126. altgrpressed:=(std and 8=8);
  127. end;
  128.  
  129.  
  130.  
  131.  
  132.  
  133. function getweekday(d,m,y:word):integer;
  134. var h1,s:longint;
  135.     ii:Byte;
  136.     iss:boolean;
  137.  
  138. begin
  139. iss:=false;
  140. if y mod 4=0 then iss:=true;
  141. if y mod 100=0 then if (y mod 400<>0) then iss:=false;
  142. s:=0;if y>1 then s:=(y-1) div 4-(y div 100)+(y div 400);
  143. h1:=y+s;
  144. if m>1 then for ii:=1 to m-1 do h1:=h1+longint(Monthlen[ii]);
  145. if m>2 then if iss then h1:=h1+1;
  146. h1:=h1+d;
  147. getweekday:=h1 mod 7;
  148. end;
  149.  
  150. function date(Typ:Boolean):String;
  151. VAR yy,mm,dd,dw:WORD;
  152.     TG:String;
  153. begin
  154. getdate(yy,mm,dd,dw);
  155. if not typ then tg:=TagStr[dw] else tg:=daystr[dw];
  156. date:=tg+', '+decs(dd,2)+'.'+decs(mm,2)+'.'+decs(yy,4);
  157. end;
  158.  
  159. function time:String;
  160. VAR hh,mm,ss,dw:WORD;
  161.     TG,TI:String;
  162. begin
  163. gettime(hh,mm,ss,dw);
  164. ti:=decs(mm,2);if ti[1]=' ' then ti[1]:='0';
  165. tg:=decs(hh,2)+'.'+ti;
  166. ti:=decs(ss,2);if ti[1]=' ' then ti[1]:='0';
  167. tg:=tg+'.'+ti;time:=tg;
  168. end;
  169.  
  170. function timeexact:String;
  171. VAR hh,mm,ss,dw:WORD;
  172.     TG,TI:String;
  173. begin
  174. gettime(hh,mm,ss,dw);
  175. ti:=decs(mm,2);if ti[1]=' ' then ti[1]:='0';
  176. tg:=decs(hh,2)+'.'+ti;
  177. ti:=decs(ss,2);if ti[1]=' ' then ti[1]:='0';
  178. tg:=tg+'.'+ti;
  179. ti:=decs(dw,2);if ti[1]=' ' then ti[1]:='0';
  180. tg:=tg+'.'+ti;timeexact:=tg;
  181. end;
  182.  
  183. {$I-}
  184. function fileexist(fn:String):Boolean;
  185. var ff:text;
  186.    i:integer;
  187. begin
  188. i:=ioresult;
  189. Assign(ff,fn);reset(ff);
  190. if ioresult=0 then
  191.   begin close(ff); fileexist:=true end else fileexist:=false;
  192.  
  193.  
  194. end;
  195.  
  196. function single(s:char):longint;
  197. var i:longint;
  198. begin
  199. if ord(s)>58 then i:=ord(s)-55 else i:=ord(s)-48;
  200. single:=i;
  201. end;
  202.  
  203. function hextodec(s:string):longint;
  204. var i:longint;
  205. begin
  206. s:=bigletters(s);
  207. if pos('$',s)=1 then s:=copy(s,2,length(s)-1);
  208. while s[length(s)]=' ' do s:=copy(s,1,length(s)-1);
  209. i:=0;
  210. while length(s)<>0
  211. do
  212. begin
  213. if length(s)=5 then i:=i+65536*single(s[1]);
  214. if length(s)=4 then i:=i+4096*single(s[1]);
  215. if length(s)=3 then i:=i+256*single(s[1]);
  216. if length(s)=2 then i:=i+16*single(s[1]);
  217. if length(s)=1 then i:=i+single(s[1]);
  218. s:=copy(s,2,length(s)-1);
  219. end;
  220. hextodec:=i;
  221. end;
  222.  
  223. procedure cprint(x1,y1:word;t:string;attr:byte);
  224. var h2,h3:WORD;
  225. begin
  226. t:=t+#0;
  227. h2:=ofs(t)+1;
  228. h3:=seg(t);
  229.       asm
  230.       push ds
  231.       push es
  232.       push si
  233.       push di
  234.       mov ax,h3
  235.       mov es,ax
  236.       mov ax,y1
  237.       dec ax
  238.       mov dx,$00A0
  239.       mul dx
  240.       mov bx,ax
  241.       mov ax,x1
  242.       dec ax
  243.       shl ax,1
  244.       add ax,bx
  245.       mov di,ax
  246.       mov si,h2
  247.       mov ax,ScrTyp;
  248.       mov ds,ax;
  249.       mov bh,attr
  250. @002:
  251.       mov bl,es:[si]
  252.       cmp bl,0
  253.       je @003
  254.       moV ds:[di],bx
  255.       inc di
  256.       inc di
  257.       inc si
  258.       jmp @002
  259. @003:
  260.       pop di
  261.       pop si
  262.       pop es
  263.       pop ds
  264.       end;
  265. end;
  266. procedure print(x1,y1:word;t:string);
  267. var h2,h3:WORD;
  268. begin
  269. t:=t+#0;
  270. h2:=ofs(t)+1;
  271. h3:=seg(t);
  272.       asm
  273.       push ds
  274.       push es
  275.       push si
  276.       push di
  277.       mov ax,h3
  278.       mov es,ax
  279.       mov ax,y1
  280.       dec ax
  281.       mov dx,$00A0
  282.       mul dx
  283.       mov bx,ax
  284.       mov ax,x1
  285.       dec ax
  286.       shl ax,1
  287.       add ax,bx
  288.       mov di,ax
  289.       mov si,h2
  290.       mov ax,ScrTyp;
  291.       mov ds,ax;
  292. @002:
  293.       mov bl,es:[si]
  294.       cmp bl,0
  295.       je @003
  296.       moV ds:[di],bl
  297.       inc di
  298.       inc di
  299.       inc si
  300.       jmp @002
  301. @003:
  302.       pop di
  303.       pop si
  304.       pop es
  305.       pop ds
  306.       end;
  307. end;
  308.  
  309. procedure color(ccl,cch:Byte);
  310. begin
  311. textcolor(ccl);TextBackground(cch);
  312. end;
  313.  
  314. function NumStr(N, D: Integer): String;
  315. begin
  316.   NumStr[0] := Chr(D);
  317.   while D > 0 do
  318.   begin
  319.     NumStr[D] := Chr(N mod 10 + Ord('0'));
  320.     N := N div 10;
  321.     Dec(D);
  322.   end;
  323. end;
  324.  
  325. function getprgdir(prg:string):String;
  326. var nam:Namestr;
  327.     ext:Extstr;
  328.     pth:pathstr;
  329.     umg:dirstr;
  330.     s:string;
  331. begin
  332.   s:=FSEARCH(prg,'*.*');
  333.   if s='' then s:=FSearch(prg,getenv('PATH'));
  334.   pth:=s;
  335.   Fsplit(pth,umg,nam,ext);
  336.   getprgdir:=umg;
  337. end;
  338.  
  339. procedure IsExt(VAR Filename:String;Ext:String);
  340. begin
  341. if pos('.',Filename)=0 then Filename:=Filename+Ext;
  342. end;
  343.  
  344. function Filelength(pth:string):LongInt;
  345. var i:longint;
  346.     fi:file;
  347. begin
  348. {$I-}
  349. assign(fi,pth);reset(fi,1);i:=0;
  350. IF IOResult=0 then i:=FileSize(fi);
  351. {$I+}
  352. close(fi);
  353. Filelength:=i;
  354. end;
  355.  
  356.  
  357.  
  358. procedure stime;
  359. var
  360. hour,min,sec,sec100:word;
  361. z:string[3];
  362. zeit:string[10];
  363.  
  364. begin
  365.   gettime(hour,min,sec,sec100);
  366.         zeit:='';
  367.         str(hour,z);if hour<10 then z:='0'+z;
  368.         zeit:=z+':';
  369.         str(min,z);if min<10 then z:='0'+z;
  370.         zeit:=zeit+z+':';
  371.         str(sec,z);if sec<10 then z:='0'+z;
  372.         zeit:='<'+zeit+z+'>';
  373.         print(70,25,zeit);
  374. end;
  375. function Bigletters(bl:String):String;
  376. var i:Byte;
  377. begin
  378. for i:=1 to length(bl) do
  379. begin
  380. if (bl[i]>='a') and (bl[i]<='z') then bl[i]:=CHR(ord(bl[i])-32);
  381. if bl[i]='ä' then bl[i]:='Ä';
  382. if bl[i]='ö' then bl[i]:='Ö';
  383. if bl[i]='ü' then bl[i]:='Ü';
  384. end;
  385. Bigletters:=bl;
  386. end;
  387.  
  388.  
  389.  
  390.  
  391.  
  392. Procedure Shad(xx,yy:Word);
  393. BEGIN
  394. if xx<>80 then
  395. asm
  396.   mov ax,ScrTyp;
  397.   mov es,ax
  398.   mov ax,yy
  399.   mov dx,160
  400.   mul dx
  401.   mov bx,ax
  402.   mov ax,xx
  403.   mov dx,2
  404.   mul dx
  405.   add ax,bx
  406.   mov di,ax
  407.   mov al,es:[di]
  408.   cmp al,$B2
  409.   jne @002
  410.   mov al,$B0
  411.   mov es:[di],al
  412. @002:
  413.   end;
  414. end;
  415.  
  416. Procedure Twin(x1,y1,x2,y2:Byte);
  417. var b,c,d:String[80];
  418.     i:Byte;
  419. begin
  420.   b:='';c:='';d:='';if y2>25 then y2:=25;if x2>80 then x2:=80;
  421.   for i:=x1 to x2-2 do
  422.     begin
  423.       b:=b+chr(32);d:=d+'═';
  424.     end;
  425. c:='╔'+d+'╗';gotoxy(x1,y1);write(c);
  426.   b:='║'+b+'║';
  427.   for i:=y1 to y2-2 do
  428.     begin
  429.       gotoxy(x1,i+1);write(b);
  430.     end;
  431. c:='╚'+d+'╝';gotoxy(x1,y2);write(c);
  432.   end;
  433. Procedure Twin2(x1,y1,x2,y2:Byte);
  434. var b,c,d:String[80];
  435.     i:Byte;
  436. begin
  437.   b:='';c:='';d:='';if y2>25 then y2:=25;if x2>80 then x2:=80;
  438.   for i:=x1 to x2-2 do
  439.     begin
  440.       b:=b+chr(32);d:=d+'═';
  441.     end;
  442. c:='╔'+d+'╗';gotoxy(x1,y1);write(c);shad(x2,y1);
  443.   b:='║'+b+'║';
  444.   for i:=y1 to y2-2 do
  445.     begin
  446.       gotoxy(x1,i+1);write(b);shad(x2,i+1);
  447.     end;
  448. c:='╚'+d+'╝';gotoxy(x1,y2);write(c);
  449. for i:=x1+1 to x2 do shad(i,y2);
  450.   end;
  451. Procedure Twin1(x1,y1,x2,y2:Byte);
  452. var b,c,d:String[80];
  453.     i:Byte;
  454. begin
  455.   b:='';c:='';d:='';if y2>25 then y2:=25;
  456.   if x2>80 then x2:=80;
  457.   for i:=x1 to x2-2 do
  458.     begin
  459.       b:=b+chr(32);d:=d+'─';
  460.     end;
  461. c:='┌'+d+'┐';shad(x2,y1-1);shad(x2,y1);
  462. gotoxy(x1,y1);write(c);
  463.   b:='│'+b+'│';
  464.   for i:=y1 to y2-2 do
  465.     begin
  466.       gotoxy(x1,i+1);write(b);shad(x2,i+1);
  467.     end;
  468.   c:='└'+d+'┘';
  469.   gotoxy(x1,y2);write(c);
  470.   for i:=x1+1 to x2 do shad(i,y2);
  471. end;
  472. Procedure Cwin2(x1,y1,x2,y2,attr:Byte);
  473. var b,c,d:String[80];
  474.     i:Byte;
  475. begin
  476.   b:='';c:='';d:='';if y2>24 then y2:=24;if x2>80 then x2:=80;
  477.   for i:=x1 to x2-2 do
  478.     begin
  479.       b:=b+chr(32);d:=d+'═';
  480.     end;
  481. c:='╔'+d+'╗';cprint(x1,y1,c,attr);shad(x2,y1);
  482.   b:='║'+b+'║';
  483.   for i:=y1 to y2-2 do
  484.     begin
  485.       cprint(x1,i+1,b,attr);shad(x2,i+1);
  486.     end;
  487. c:='╚'+d+'╝';cprint(x1,y2,c,attr);
  488. for i:=x1+1 to x2 do shad(i,y2);
  489.   end;
  490. Procedure Cwin1(x1,y1,x2,y2,attr:Byte);
  491. var b,c,d:String[80];
  492.     i:Byte;
  493. begin
  494.   b:='';c:='';d:='';if y2>24 then y2:=24;
  495.   if x2>80 then x2:=80;
  496.   for i:=x1 to x2-2 do
  497.     begin
  498.       b:=b+chr(32);d:=d+'─';
  499.     end;
  500. c:='┌'+d+'┐';shad(x2,y1-1);shad(x2,y1);
  501. cprint(x1,y1,c,attr);
  502.   b:='│'+b+'│';
  503.   for i:=y1 to y2-2 do
  504.     begin
  505.       cprint(x1,i+1,b,attr);shad(x2,i+1);
  506.     end;
  507.   c:='└'+d+'┘';
  508.   cprint(x1,y2,c,attr);
  509.   for i:=x1+1 to x2 do shad(i,y2);
  510. end;
  511.  
  512. Procedure TBack;
  513. begin
  514. asm
  515.   mov ax,ScrTyp;
  516.   mov es,ax
  517.   mov di,160
  518.   mov al,$B2
  519. @001:
  520.   mov es:[di],al
  521.   inc di
  522.   inc di
  523.   cmp di,3840
  524.   jb @001
  525. end;
  526. end;
  527. function twodecs(xx:real):String;
  528. var h1,h2,h3:longint;
  529. s,ss:String[8];
  530. begin
  531. xx:=xx*100;
  532. h1:=trunc(xx);
  533. h2:=h1 div 100;
  534. h3:=h1 mod 100;
  535. if h3<0 then h3:=-h3;
  536. str(h2,ss);
  537. str(h3,s);if h3<10 then s:='0'+s;
  538. twodecs:=ss+'.'+s;
  539. end;
  540.  
  541. procedure twodecout(xx:real);
  542. begin
  543. write(twodecs(xx));
  544. end;
  545. procedure hexout(xx:word);
  546. begin
  547. write(hexs(xx));
  548. end;
  549. function decs(xx:longint;format:Byte):String;
  550. var s:string[10];
  551. begin
  552. str(xx,s);
  553. while length(s)<format do s:=' '+s;
  554. decs:=s;
  555. end;
  556.  
  557. function hexs(xx:longint):String;
  558. var ss:String[8];
  559.     h1,h2:Byte;
  560. begin
  561. ss:='';
  562.   h1:=32;
  563.   repeat
  564.     dec(h1,4);
  565.     h2:=(xx shr h1) and $f;
  566.     if h2>9 then h2:=h2+7;
  567.     h2:=h2+48;
  568.     ss:=ss+chr(h2);
  569.   until h1=0;
  570. hexs:=ss;
  571. end;
  572.  
  573. function hexs16(xx:word):String;
  574. var ss:String[8];
  575.     h1,h2:Byte;
  576. begin
  577. ss:='';
  578.   h1:=16;
  579.   repeat
  580.     dec(h1,4);
  581.     h2:=(xx shr h1) and $f;
  582.     if h2>9 then h2:=h2+7;
  583.     h2:=h2+48;
  584.     ss:=ss+chr(h2);
  585.   until h1=0;
  586. hexs16:=ss;
  587. end;
  588.  
  589. function hexs8(xx:byte):String;
  590. var ss:String[8];
  591.     h1,h2:Byte;
  592. begin
  593. ss:='';
  594.   h1:=8;
  595.   repeat
  596.     dec(h1,4);
  597.     h2:=(xx shr h1) and $f;
  598.     if h2>9 then h2:=h2+7;
  599.     h2:=h2+48;
  600.     ss:=ss+chr(h2);
  601.   until h1=0;
  602. hexs8:=ss;
  603. end;
  604.  
  605.  
  606. function bins(xx:longint):String;
  607. var ss:String[32];
  608.     h1,h2:Byte;
  609. begin
  610. ss:='';
  611.   h1:=32;
  612.   repeat
  613.     dec(h1);
  614.     h2:=(xx shr h1) and $1;
  615.     h2:=h2+48;
  616.     ss:=ss+chr(h2);
  617.   until h1=0;
  618. bins:=ss;
  619. end;
  620.  
  621. function bins16(xx:word):String;
  622. var ss:String[32];
  623.     h1,h2:Byte;
  624. begin
  625. ss:='';
  626.   h1:=16;
  627.   repeat
  628.     dec(h1);
  629.     h2:=(xx shr h1) and $1;
  630.     h2:=h2+48;
  631.     ss:=ss+chr(h2);
  632.   until h1=0;
  633. bins16:=ss;
  634. end;
  635.  
  636. function bins8(xx:byte):String;
  637. var ss:String[32];
  638.     h1,h2:Byte;
  639. begin
  640. ss:='';
  641.   h1:=8;
  642.   repeat
  643.     dec(h1);
  644.     h2:=(xx shr h1) and $1;
  645.     h2:=h2+48;
  646.     ss:=ss+chr(h2);
  647.   until h1=0;
  648. bins8:=ss;
  649. end;
  650.  
  651. procedure copyfile(Source,Dest:String);
  652. var FROMF, TOF:FILE;
  653. Numread,Numwrite:WORD;
  654. BUF:array[0..3071] of CHAR;
  655. var ds,ss:String;
  656. begin
  657. ds:=Dest;ss:=source;
  658. if (ds='')  then ds:=copy(ss,1,pos('.',ss))+'bak';
  659. assign(FRomF,Source);Reset(FROMF,1);
  660. assign(TOF,Ds);Rewrite(ToF,1);
  661. writeLn('Copy file(s):'+Source+' to:'+dest);
  662. repeat
  663.   Blockread(FromF,Buf,SizeOf(Buf),Numread);
  664.   Blockwrite(TOF,Buf,Numread,Numwrite);
  665. until (Numread=0) or (Numwrite<>Numread) or (Numread<>SizeOF(BUF));
  666. Close(Fromf);
  667. Close(Tof);
  668. end;
  669.  
  670. FUNCTION GetExefilesize(Exename:String): LONGINT;
  671. VAR
  672.   ExeFile: FILE OF BYTE;
  673.   IDByte : ARRAY[1..2] OF BYTE;
  674.   g      : ARRAY[1..4] OF BYTE;
  675.   g1,g2,g3,g4:longint;
  676.   Ioerror:integer;
  677. BEGIN
  678.   Assign(ExeFile, ExeName);
  679.   Reset(ExeFile);
  680.   IOError := IOResult;
  681.   IF IOError <> 0 THEN exit;
  682.   Read(ExeFile, IDByte[1]);
  683.   Read(ExeFile, IDByte[2]);
  684.   IF (Chr(IDByte[1]) = 'M') AND (Chr(IDByte[2]) = 'Z') THEN
  685.                      BEGIN                            (* EXE *)
  686.     Read(ExeFile, g[1]);g1:=g[1];
  687.     Read(ExeFile, g[2]);g2:=g[2];
  688.     Read(ExeFile, g[3]);g3:=g[3];
  689.     Read(ExeFile, g[4]);g4:=g[4];
  690.     Close(ExeFile);
  691.     IF (g[1] = 0) AND (g[2] = 0) THEN
  692.       Getexefilesize :=
  693.           g4 * 256 + g3
  694.     ELSE
  695.       Getexefilesize :=
  696.         (g4 * 256 + g3 - 1) * 512 + (g2 * 256 +
  697.           g1);
  698.   END
  699.   ELSE
  700.   Getexefilesize := 0;
  701. END;
  702.  
  703. procedure cursoroff; assembler;
  704.  asm
  705.    mov AH,01h
  706.    mov CH,32
  707.    mov CL,1
  708.    int 10h
  709.  end;
  710.  
  711. procedure cursoron; assembler;
  712.  asm
  713.    mov AH,01h
  714.    mov CH,0
  715.    mov CL,1
  716.    int 10h
  717.  end;
  718.  
  719. begin
  720. ScrTyp:=$B800;Randomize;
  721. if Byte(Ptr($40,$49)^)=7 then ScrTyp:=$b000;
  722. end.