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
/
BEEHIVE
/
COMMS
/
PMODEM.ARC
/
OPEN.INC
< prev
next >
Wrap
Text File
|
1991-08-11
|
2KB
|
115 lines
{********** open.inc **********}
{ other utilites }
Procedure xmit(b: byte);
begin
modem_out(chr(b));
end;
Procedure Modem_Out_Line; {Line: data2 previously referenced}
{send a line to the modem}
var
i: byte;
begin
for i := 1 to length(line) do
ch_out(ord(line[i]));
ch_out(ord(CR));
end; {Modem_Out_Line}
function extractCount(mainstring: data2): integer;
{function to count substrings}
var
K,numbs: integer;
begin
K:= 0;
repeat
numbs:= pos('/',mainstring);
delete(mainstring,1,numbs);
K:= K+1
until numbs= 0;
extractCount:= K;
end;
function extract(mainstring: data2; N:integer): dataa;
{function to extract substrings delineated by '/'
from the form a/bcdef/g/hij...}
var
K,numbs: integer;
flag: boolean;
begin
flag:= false;
for K:= 1 to N do begin
numbs:= pos('/',mainstring);
if numbs>0 then begin
extract:= copy(mainstring,1,numbs-1);
delete(mainstring,1,numbs);
end
else if not flag then begin
extract:= mainstring;
flag:= true;
end
else extract:='';
end;
end; {extract}
procedure upper(var temp1:data);
{convert string to upper case}
var
local,local1: integer;
begin
local := length(temp1);
if local>0 then for local1 := 1 to local do
temp1[local1]:= (upCase(temp1[local1]));
end;{upper}
procedure time;
{beeps in 'wait' minutes}
label stop;
var
temp : byte;
counter: integer;
begin
write('--> timing...', CR);
counter:= 600 * wait;
for temp:= 1 to counter do begin
if keyPressed then begin
X:= chr(bdos(1));
goto stop;
end;
delay(100);
end;
STOP: write(^G);
end; {time}
function getTail: data2;
{get CP/M command tail of form '/xy'}
begin
getTail:= copy(ParamStr(1),2,10);
end; {getTail}
{*********** disk utilities **********}
function findfile(name: fname): boolean;
{look for file, return True if found, else false}
var
found:boolean;
f: file;
begin
assign(f,name);
{$I-} reset(f) {$I+};
found:= (IOresult= 0);
if found then close(f);
findfile:= found
end;{findfile}
procedure openFile(sourceName: fname);
begin
assign(sourceFile,sourceName);
if findfile(sourceName) then
reset(sourceFile)
else rewrite(sourceFile);
end; {openFile}