home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / INTRFC62.ZIP / UTIL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-06-13  |  2.2 KB  |  112 lines
  1. unit util;
  2.  
  3. interface
  4.   uses dos;
  5.  
  6.   var
  7.     last_file_size : longint;
  8.  
  9.   function minw(w1,w2:word):word;
  10.  
  11.   function normalize(p:pointer):pointer;
  12.  
  13.   function add_offset(p:pointer; add:word):pointer;
  14.  
  15.   function upper(var s:string):string;
  16.  
  17.   function ptr_diff(p1,p2:pointer):longint;
  18.  
  19.   procedure read_file(filename: string;var buffer:pointer;
  20.                      offset:longint; size:word);
  21.   { Attempts to read a file into buffer; returns nil if there was a problem }
  22.  
  23.   function roundup(n,r:word):word;
  24.  
  25. implementation
  26.  
  27. function minw(w1,w2:word):word;
  28. begin
  29.   if w1<w2 then
  30.     minw := w1
  31.   else
  32.     minw := w2;
  33. end;
  34.  
  35. function normalize(p:pointer):pointer;
  36. var
  37.   s,o : word;
  38. begin
  39.   s := seg(p^);
  40.   o := ofs(p^);
  41.   if o > $f then
  42.   begin
  43.     s := s + o shr 4;
  44.     o := o and $f;
  45.   end;
  46.   normalize := ptr(s,o);
  47. end;
  48.  
  49. function add_offset(p:pointer; add:word):pointer;
  50. begin
  51.   p := normalize(p);
  52.   add_offset := ptr(seg(p^),ofs(p^)+add);
  53. end;
  54.  
  55. function upper(var s:string):string;
  56. var
  57.   i:integer;
  58.   result : string;
  59. begin
  60.   result[0] := s[0];
  61.   for i:=1 to length(s) do
  62.     result[i] := upcase(s[i]);
  63.   upper := result;
  64. end;
  65.  
  66. function ptr_diff(p1,p2:pointer):longint;
  67. begin
  68.   ptr_diff := 16*(longint(seg(p1^))-longint(seg(p2^))) + ofs(p1^) - ofs(p2^);
  69. end;
  70.  
  71. procedure read_file(filename: string;var buffer:pointer;
  72.                    offset:longint; size:word);
  73. { Attempts to read a file into buffer; returns nil if there was a problem }
  74. var
  75.   f:file;
  76.   try_size : longint;
  77. begin
  78.   assign(f,filename);
  79.   buffer := nil;
  80.   {$i-} reset(f,1); {$i+}
  81.   if ioresult <> 0 then
  82.     exit;
  83.   last_file_size := filesize(f);
  84.   try_size := last_file_size-offset;
  85.   if try_size < size then
  86.     size := try_size;
  87.   try_size := size;
  88.   if size > 65521 then
  89.   begin
  90.     writeln('File size too large.  File not read.');
  91.     exit;
  92.   end;
  93.   if maxavail < size then
  94.   begin
  95.     writeln('Out of memory.  File ',filename,' not read.');
  96.     exit;
  97.   end;
  98.   getmem(buffer,size);
  99.   seek(f,offset);
  100.   blockread(f,buffer^,try_size,size);
  101.   close(f);
  102. end;
  103.  
  104. function roundup(n,r:word):word;
  105. begin
  106.   roundup := r*((n+r-1) div r);
  107. end;
  108.  
  109. end.
  110.  
  111.  
  112.