home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol255 / size.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-03-22  |  2.3 KB  |  117 lines
  1. program size;
  2. (*--------------------------------------*)
  3. (*                    *)
  4. (*    Get Program Size        *)
  5. (*      Public Domain Soft  JUG-CP/M  *)
  6. (*        83-1-3    by K.Maeda    *)
  7. (*        84-10-16  revised    *)
  8. (*--------------------------------------*)
  9.  
  10. type
  11.   head  =  record
  12.         group_type :  byte;
  13.         group_leng :  integer;
  14.         base_value :  integer;
  15.         group_min  :  integer;
  16.         group_max  :  integer
  17.        end;
  18.  
  19.   buffer = array[0..127] of byte;
  20.  
  21.   pstrg  = ^string;
  22.  
  23. var
  24.   sec_data : buffer;
  25.   leng_seg : integer;
  26.   parm_pt  : pstrg;
  27.   f_name   : string;
  28.   f_get    : file;
  29.   result   : integer;
  30.   sec_pt   : ^head;
  31.   rep_flg  : boolean;
  32.  
  33. external function @cmd : pstrg;
  34.  
  35. procedure get_fn;
  36. begin
  37.   writeln;
  38.   write('File Name  (if End, CR-only) : ');
  39.   readln(f_name)
  40. end;
  41.  
  42. procedure hex(x:byte);
  43. var
  44.   mh,ml : integer;
  45.   ch,cl : char;
  46. begin
  47.   mh:=x div 16;  ml:=x mod 16;
  48.   if mh > 9 then ch:=chr(mh+55) else ch:=chr(mh+48);
  49.   if ml > 9 then cl:=chr(ml+55) else cl:=chr(ml+48);
  50.   write(ch,cl)
  51. end;
  52.  
  53.  
  54. procedure size_print;
  55. var
  56.   group_message : string;
  57.   itype , i     : integer;
  58. begin
  59.   writeln;
  60.   writeln;
  61.   writeln('+++++  Header Record of File  -  ',f_name,'  +++++');
  62.  
  63.   blockread(f_get,sec_data,result,128,0);
  64.   i:=0;
  65.   sec_pt:=addr(sec_data[i]);
  66.   itype:=sec_pt^.group_type;
  67.  
  68.   while itype > 0 do begin
  69.     case itype of
  70.       1 : group_message:='Code Segment';
  71.       2 : group_message:='Data Segment';
  72.       3 : group_message:='Extra Segment';
  73.       4 : group_message:='Stack Segment';
  74.       else group_message:=concat('Others #',chr(itype+48));
  75.     end;
  76.  
  77.     leng_seg:=(sec_pt^.group_min + 32)  div  64;
  78.  
  79.     writeln;
  80.     writeln(group_message);
  81.     write('   base address : ');
  82.     hex(hi(sec_pt^.base_value)); hex(lo(sec_pt^.base_value));
  83.     writeln;
  84.     writeln('   min size (KB): ',leng_seg:4);
  85.     i:=i+9;  if i>127 then exit;
  86.     sec_pt:=addr(sec_data[i]);
  87.     itype:=sec_pt^.group_type;
  88.   end; { while }
  89. end;
  90.  
  91.  
  92.  
  93. (*----- Main Procedure -----*)
  94.  
  95. begin
  96.   parm_pt  := @cmd;            { get command parameter }
  97.   f_name   := parm_pt^;
  98.  
  99.   if (f_name='') or (f_name=' ')
  100.    then begin
  101.     rep_flg := false;
  102.     get_fn;
  103.     if length(f_name) = 0        then exit;
  104.    end
  105.   else rep_flg := true;
  106.  
  107.   repeat
  108.     assign(f_get,f_name);
  109.     reset( f_get );
  110.     if ioresult <> 255 then size_print
  111.                else writeln('Cannot Open.');
  112.     close( f_get,result );
  113.  
  114.     if not rep_flg then get_fn;
  115.   until (length(f_name) = 0) or rep_flg
  116. end.
  117.