home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / STRINGZ.INC < prev    next >
Encoding:
Text File  |  1993-03-08  |  3.3 KB  |  120 lines
  1.   procedure __xtmovmem;
  2.   type
  3.     localdesctable = record
  4.       seglimit   : word;
  5.       loword     : word;
  6.       hibyte     : byte;
  7.       dataaccess : byte;
  8.       reserved   : word
  9.     end;
  10.  
  11.     globaldesctable = record
  12.       dummy      : localdesctable;
  13.       local      : localdesctable;
  14.       source     : localdesctable;
  15.       target     : localdesctable;
  16.       bioscs     : localdesctable;
  17.       stack      : localdesctable
  18.     end;
  19.  
  20.   var
  21.     gdt     : globaldesctable;
  22.     dosads  : _xads;
  23.     reg     : registers;
  24.     tempseg : word;
  25.     tempofs : word;
  26.     temp    : longint;
  27.  
  28.   begin
  29.     if false then begin errorcode := 4; exit end;
  30.     fillchar(gdt, sizeof(gdt), #0);
  31.     tempseg := _vectoraddr(memptr)._seg;
  32.     tempofs := _vectoraddr(memptr)._ofs;
  33.     temp    := (16 * longint(tempseg)) + longint(tempofs);
  34.     with dosads do begin
  35.       _hibyte := byte((temp div 65536) and $ff);
  36.       _loword := word((temp - (65536 * longint(_hibyte))) and $ffff)
  37.     end;
  38.  
  39.     with gdt do begin
  40.       if (toext) then begin
  41.         source.hibyte := dosads._hibyte;
  42.         source.loword := dosads._loword;
  43.         target.hibyte := extads._hibyte;
  44.         target.loword := extads._loword
  45.       end else begin
  46.         source.hibyte := extads._hibyte;
  47.         source.loword := extads._loword;
  48.         target.hibyte := dosads._hibyte;
  49.         target.loword := dosads._loword
  50.       end;
  51.       source.seglimit   := nowords shl 2;
  52.       target.seglimit   := nowords shl 2;
  53.       source.dataaccess := $93;
  54.       target.dataaccess := $93
  55.     end;
  56.     with reg do begin
  57.       ax := $8700;
  58.       cx := nowords;
  59.       es := seg(gdt);
  60.       si := ofs(gdt);
  61.       intr($15, reg);
  62.       if ((flags and fcarry) <> 0) then errorcode := ah else errorcode := 0
  63.     end
  64.   end;
  65.  
  66.   procedure __xtmovmem(
  67.     memptr: pointer; extads: _xads; nowords: word;
  68.     toext: boolean; var errorcode: word
  69.   );
  70.   function  __rem_str(s:string; target:string):string;
  71.   function  __nxtwrd(var s : string):string;
  72.   function  __strtok(var s : string; delimiters:string):string;
  73.   function __rem_str(s:string; target:string):string;
  74.   var
  75.     slen  :      byte absolute s;
  76.     tlen  : byte absolute target;
  77.     p     :              integer;
  78.  
  79.   begin
  80.     p := pos(target,s);
  81.     __rem_str := s;
  82.     if (p <> 0) then begin delete(s,p,tlen); __rem_str := s; end;
  83.   end; {end function substr}
  84.  
  85.  
  86.   function __nxtwrd(var s : string):string;
  87.   var p : byte;
  88.   begin
  89.     __nxtwrd := '';
  90.     s := __cvtstr(s, _rem_lead_white_str + _rem_trail_white_str);
  91.     if length(s)=0 then exit;
  92.     p := pos(' ',s);
  93.     if p > 0 then begin __nxtwrd := copy(s,1,p-1); delete(s,1,p) end else begin
  94.       __nxtwrd := s; s:= '';
  95.     end;
  96.   end;
  97.  
  98.  
  99.   function __strtok(var s : string; delimiters:string):string;
  100.   var
  101.     p,b   :        byte;
  102.     vkeys : set of char;
  103.  
  104.   begin
  105.     __strtok := '';
  106.     s := __cvtstr(s, _rem_lead_white_str + _rem_trail_white_str);
  107.     if length(s)=0 then exit;
  108.     vkeys := [];
  109.     for p := 1 to length(delimiters) do vkeys := vkeys + [delimiters[p]];
  110.     if s[1] in vkeys then delete(s,1,1);
  111.     for p := 1 to length(s) do begin
  112.       if s[p] in vkeys then begin
  113.         __strtok := copy(s,1,p-1); delete(s,1,p); exit;
  114.       end;
  115.     end;
  116.     __strtok := s;
  117.     s        := '';
  118.   end;
  119.  
  120.