home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / PMODEM.ARK / OPEN.INC < prev    next >
Text File  |  1987-02-22  |  2KB  |  115 lines
  1. {********** open.inc **********}
  2.         { other utilites }
  3.  
  4. Procedure xmit(b: byte);
  5. begin
  6.   modem_out(chr(b));
  7. end;
  8.  
  9. Procedure Modem_Out_Line; {Line: data2 previously referenced}
  10. {send a line to the modem}
  11. var
  12.   i: byte;
  13. begin
  14.   for i := 1 to length(line) do
  15.     ch_out(ord(line[i]));
  16.     ch_out(ord(CR));
  17. end; {Modem_Out_Line}
  18.  
  19. function extractCount(mainstring: data2): integer;
  20. {function to count substrings}
  21. var
  22.   K,numbs: integer;
  23. begin
  24.   K:= 0;
  25.   repeat
  26.     numbs:= pos('/',mainstring);
  27.     delete(mainstring,1,numbs);
  28.     K:= K+1
  29.   until numbs= 0;
  30.   extractCount:= K;
  31. end;
  32.  
  33. function extract(mainstring: data2; N:integer): dataa;
  34. {function to extract substrings delineated by '/'
  35. from the form a/bcdef/g/hij...}
  36. var
  37.   K,numbs: integer;
  38.   flag: boolean;
  39. begin
  40.   flag:= false;
  41.   for K:= 1 to N do begin
  42.     numbs:= pos('/',mainstring);
  43.     if numbs>0 then begin
  44.       extract:= copy(mainstring,1,numbs-1);
  45.       delete(mainstring,1,numbs);
  46.     end
  47.     else if not flag then begin
  48.       extract:= mainstring;
  49.       flag:= true;
  50.     end
  51.     else extract:='';
  52.   end;
  53. end; {extract}
  54.  
  55. procedure upper(var temp1:data);
  56. {convert string to upper case}
  57. var
  58.    local,local1: integer;
  59. begin
  60.    local := length(temp1);
  61.    if local>0 then for local1 := 1 to local do
  62.      temp1[local1]:= (upCase(temp1[local1]));
  63. end;{upper}
  64.  
  65. procedure time;
  66. {beeps in 'wait' minutes}
  67. label stop;
  68. var
  69.   temp : byte;
  70.   counter: integer;
  71. begin
  72.   write('--> timing...', CR);
  73.   counter:= 600 * wait;
  74.   for temp:= 1 to counter do begin
  75.     if keyPressed then begin
  76.       X:= chr(bdos(1));
  77.       goto stop;
  78.     end;
  79.   delay(100);
  80.   end;
  81. STOP: write(^G);
  82. end; {time}
  83.  
  84. function getTail: data2;
  85. {get CP/M command tail of form '/xy'}
  86. begin
  87.    getTail:= copy(ParamStr(1),2,10);
  88. end; {getTail}
  89.  
  90. {*********** disk utilities **********}
  91.  
  92. function findfile(name: fname): boolean;
  93. {look for file, return True if found, else false}
  94. var
  95.    found:boolean;
  96.    f: file;
  97. begin
  98.    assign(f,name);
  99.    {$I-} reset(f) {$I+};
  100.    found:= (IOresult= 0);
  101.    if found then close(f);
  102.    findfile:= found
  103. end;{findfile}
  104.  
  105. procedure openFile(sourceName: fname);
  106. begin
  107.   assign(sourceFile,sourceName);
  108.   if findfile(sourceName) then
  109.   reset(sourceFile)
  110.   else rewrite(sourceFile);
  111. end; {openFile}
  112.  
  113.  
  114.  
  115.