telegard/conv17a9.pas

919 lines
22 KiB
ObjectPascal
Raw Permalink Normal View History

{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
2000-11-17 16:33:00 -08:00
{$M 50000,0,1024} { Declared here suffices for all Units as well! }
uses
crt,dos,
{rcg11172000 No semicolon?}
{myio,}
myio;
const
needconv = 'E';
standard_conversion = FALSE;
{$I rcc17a.pas}
{rcg11172000 hmm...don't have this file...}
{I rec17b.pas}
{$I brec17a2.pas}
{rcg11172000 ...but need this...}
{$I recc.pas}
var
a,b,lastss,mp,gp,sp:astr;
h,i,j,k,savx,savy:integer;
c:char;
aw:boolean; { author working }
back:boolean; { converting BACK TO PREVIOUS VERSION ! .. }
found:boolean;
dirinfo:searchrec;
ptsforisrequest,ptsfornotval:integer;
wind:windowrec;
didit:boolean;
needs:longint;
artable:astr;
{ systatf17a4:file of systatrec17a4;}
{ systat17a4:systatrec17a4;}
systatf1:file of systatrec1;
systat1:systatrec1;
systatf0:file of systatrec;
systat0:systatrec;
systatf:file of systatrec;
systat:systatrec;
modemrf17a7:file of modemrec17a7;
modemr17a7:modemrec17a7;
modemrf:file of modemrec;
modemr:modemrec;
fstringf:file of fstringrec;
fstring:fstringrec;
sf1:file of smalrec1;
sr1:smalrec1;
sf:file of smalrec;
sr:smalrec;
uf1:file of userrec1;
user1:userrec1; {**}
uf0:file of userrec;
user0:userrec;
uf:file of userrec;
user:userrec; {**}
bf1:file of boardrec1;
brd1:boardrec1;
{ bf17a5:file of boardrec17a5;}
{ brd17a5:boardrec17a5;}
bf:file of boardrec;
brd:boardrec;
mailfile1:file of mailrec1;
mail1:mailrec1; {**}
mailfile:file of mailrec;
mail:mailrec; {**}
ulf1:file of ulrec1;
ubrd1:ulrec1;
{ ulf17a2:file of ulrec17a2;}
{ ubrd17a2:ulrec17a2;}
ulf0:file of ulrec;
ubrd0:ulrec;
ulf:file of ulrec;
ubrd:ulrec;
ulff1:file of ulfrec1;
uld1:ulfrec1;
ulff:file of ulfrec;
uld:ulfrec;
{ slf1:file of slr1;
seclev1:array[0..255] of slr1;
slf:file of seclevrec;
seclev:seclevrec;}
gfilef1:file of gft1; {**}
gfile1:gft1; {**}
gfilef:file of tfilerec;{**}
gfile:tfilerec; {**}
smf1:file of smr1;
sm1:smr1;
smf:file of smr;
sm:smr;
ztf1:file of zlogt1; {**}
zt1:zlogt1; {**}
ztf:file of zlogrec; {**}
zt:zlogrec; {**}
vdf1:file of vdatar1; {**}
vd1:vdatar1; {**}
vdf:file of vdatar; {**}
vd:vdatar; {**}
macrf:file of macrorec;
macr:macrorec;
xp1:file of protrec1;
xpr1:protrec1;
xp0:file of protrec;
xpr0:protrec;
xp:file of protrec;
xpr:protrec;
mbasef1:file of messagerec1;
mbase1:messagerec1;
mbasef:file of messagerec;
mbase:messagerec;
ff:file;
{**} (* NOT defined globally in COMMON.PAS .... *)
function value(I:astr):integer;
var n,n1:integer;
begin
val(i,n,n1);
if n1<>0 then begin
i:=copy(i,1,n1-1);
val(i,n,n1)
end;
value:=n;
if i='' then value:=0;
end;
function cstrl(li:longint):astr;
var c:astr;
begin
str(li,c);
cstrl:=c;
end;
function cstr(i:integer):astr;
var c:astr;
begin
str(i,c);
cstr:=c;
end;
function tch(i:astr):astr;
begin
if length(i)>2 then i:=copy(i,length(i)-1,2) else
if length(i)=1 then i:='0'+i;
tch:=i;
end;
2001-03-02 14:07:42 -08:00
{rcg11272000 dunno if this is even used, but it won't fly under Linux.}
{ below is a working implementation.}
{
2000-11-17 16:33:00 -08:00
function time:astr;
var reg:registers;
h,m,s:string[4];
begin
reg.ax:=$2c00; intr($21,Dos.Registers(reg));
str(reg.cx shr 8,h); str(reg.cx mod 256,m); str(reg.dx shr 8,s);
time:=tch(h)+':'+tch(m)+':'+tch(s);
end;
2001-03-02 14:07:42 -08:00
}
2000-11-17 16:33:00 -08:00
2001-03-02 14:07:42 -08:00
function time:string;
var h,m,s:string[3];
hh,mm,ss,ss100:word;
begin
gettime(hh,mm,ss,ss100);
str(hh,h); str(mm,m); str(ss,s);
time:=tch(h)+':'+tch(m)+':'+tch(s);
end;
{rcg11272000 dunno if this is even used, but it won't fly under Linux.}
{ below is a working implementation, Y2K fixes included.}
{
2000-11-17 16:33:00 -08:00
function date:astr;
var reg:registers;
m,d,y:string[4];
begin
reg.ax:=$2a00; msdos(Dos.Registers(reg)); str(reg.cx,y); str(reg.dx mod 256,d);
str(reg.dx shr 8,m);
date:=tch(m)+'/'+tch(d)+'/'+tch(y);
end;
2001-03-02 14:07:42 -08:00
}
function date:string;
var
{rcg11272000 unused variable.}
{r:registers;}
{rcg11272000 Y2K-proofing.}
{y,m,d:string[3];}
m,d:string[3];
y:string[5];
yy,mm,dd,dow:word;
begin
getdate(yy,mm,dd,dow);
{rcg11272000 Y2K-proofing.}
{str(yy-1900,y); str(mm,m); str(dd,d);}
str(yy,y); str(mm,m); str(dd,d);
date:=tch(m)+'/'+tch(d)+'/'+y;
end;
2000-11-17 16:33:00 -08:00
function leapyear(yr:integer):boolean;
begin
leapyear:=(yr mod 4=0) and ((yr mod 100<>0) or (yr mod 400=0));
end;
function days(mo,yr:integer):integer;
var d:integer;
begin
d:=value(copy('312831303130313130313031',1+(mo-1)*2,2));
if (mo=2) and leapyear(yr) then d:=d+1;
days:=d;
end;
function daycount(mo,yr:integer):integer;
var m,t:integer;
begin
t:=0;
for m:=1 to (mo-1) do t:=t+days(m,yr);
daycount:=t;
end;
function daynum(dt:astr):integer;
var d,m,y,t,c:integer;
begin
t:=0;
m:=value(copy(dt,1,2));
d:=value(copy(dt,4,2));
2000-11-19 02:49:44 -08:00
{rcg11182000 hahahaha...a Y2K bug. :) }
2001-03-02 14:07:42 -08:00
{rcg11272000 Let's make sure the values coming in here are four }
{digits in the first place, which should save us some hacks elsewhere...}
{y:=value(copy(dt,7,2))+1900;}
{rcg11272000 my adds...}
if (length(dt) < 10) then rcgpanic('WHOA! TWO DIGIT YEAR IN DATE!');
y:=value(copy(dt,7,4));
{rcg11272000 end my adds...}
2000-11-19 02:49:44 -08:00
2000-11-17 16:33:00 -08:00
for c:=1985 to y-1 do
if leapyear(c) then t:=t+366 else t:=t+365;
t:=t+daycount(m,y)+(d-1);
daynum:=t;
if y<1985 then daynum:=0;
end;
function freek(d:integer):longint; (* See disk space *)
{var r:registers;}
begin
freek:=diskfree(d) div 1024;
{ r.ax:=$3600;
r.dx:=d;
msdos(dos.registers(r));
freek:=trunc(1.0*r.bx*r.ax*r.cx/1024.0);}
end;
procedure tc(i:integer);
begin
textcolor(i);
end;
procedure star(s:astr);
begin
tc(9); write('<27> ');
tc(11); writeln(s);
end;
function exdrv(s:astr):byte;
begin
{rcg11242000 point at root drive always. Ugh.}
{
2000-11-17 16:33:00 -08:00
s:=fexpand(s);
exdrv:=ord(s[1])-64;
}
exdrv:=3;
2000-11-17 16:33:00 -08:00
end;
procedure movefile(srcname,destpath:string);
var buffer:array[1..16384] of byte;
dfs,nrec:integer;
src,dest:file;
dd,dn,de:string;
procedure dodate;
var r:registers;
od,ot,ha:integer;
begin
srcname:=srcname+#0;
destpath:=destpath+#0;
with r do begin
ax:=$3d00; ds:=seg(srcname[1]); dx:=ofs(srcname[1]); msdos(dos.registers(r));
ha:=ax; bx:=ha; ax:=$5700; msdos(dos.registers(r));
od:=dx; ot:=cx; bx:=ha; ax:=$3e00; msdos(dos.registers(r));
ax:=$3d02; ds:=seg(destpath[1]); dx:=ofs(destpath[1]); msdos(dos.registers(r));
ha:=ax; bx:=ha; ax:=$5701; cx:=ot; dx:=od; msdos(dos.registers(r));
ax:=$3e00; bx:=ha; msdos(dos.registers(r));
end;
end;
begin
fsplit(srcname,dd,dn,de);
destpath:=destpath+dn+de;
assign(src,srcname);
{$I-} reset(src,1); {$I+}
if (ioresult<>0) then begin
writeln;
star('"'+srcname+'": File not found.'^G^G);
{ halt(1);}
end else begin
dfs:=freek(exdrv(destpath));
{rcg11172000 don't have LONGfilesize()...}
{if (trunc(longfilesize(src)/1024.0)+1>=dfs) then begin}
if (trunc(filesize(src)/1024.0)+1>=dfs) then begin
writeln;
star('"'+srcname+'": Disk full.');
halt(1);
end else begin
assign(dest,destpath); rewrite(dest,1);
repeat
blockread(src,buffer,16384,nrec);
blockwrite(dest,buffer,nrec);
until (nrec<16384);
close(dest);
close(src);
dodate;
erase(src);
end;
end;
end;
procedure smovefile(srcname,destpath:string);
begin
star('Moving "'+srcname+'" to "'+destpath+'"');
movefile(srcname,destpath);
end;
procedure ffile(fn:astr);
begin
findfirst(fn,anyfile,dirinfo);
found:=(doserror=0);
end;
procedure nfile;
var r:registers;
begin
findnext(dirinfo);
found:=(doserror=0);
end;
function allcaps(s:astr):astr; (* returns a COMPLETELY capitalized string *)
var i:integer;
begin
for i:=1 to length(s) do
s[i]:=upcase(s[i]);
allcaps:=s;
end;
procedure cursoron;
var reg:registers;
begin
with reg do begin
ch:=07; cl:=08; ah:=1;
intr($10,reg);
end;
end;
procedure cursoroff;
var reg:registers;
begin
with reg do begin
ch:=09; cl:=00; ah:=1;
intr($10,reg);
end;
end;
procedure prt(s:string);
begin
textcolor(9); write(s);
end;
procedure ttl(s:string);
begin
writeln;
textcolor(9); write('<27><>[');
textbackground(1); textcolor(15);
write(' '+s+' ');
textbackground(0); textcolor(9);
write(']');
repeat write('<27>') until wherex=80;
writeln;
end;
procedure ee(s:astr);
begin
clrscr;
writeln;
tc(4); writeln('ERROR:');
writeln;
tc(15); write(' '+s);
writeln;
writeln;
tc(9); write('Hit any key to exit : ');
repeat until keypressed;
c:=readkey;
removewindow(wind); gotoxy(savx,savy);
halt(1);
end;
procedure ss(s:astr);
begin
lastss:=allcaps(s);
star('Searching for "'+lastss+'"');
end;
procedure cantopen;
begin
ee('Unable to open "'+lastss+'"');
end;
function needc(c:char):boolean;
begin
if pos(c,needconv)<>0 then needc:=TRUE else needc:=FALSE;
end;
procedure fvers;
var i:integer;
begin
needs:=0;
writeln;
ss('status.dat');
assign(systatf1,'status.dat');
{$I-} reset(systatf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(systatf1,systat1); {$I+}
if (ioresult<>0) then begin
close(systatf1);
assign(systatf,'status.dat');
reset(systatf);
{$I-} read(systatf,systat); {$I+}
gp:=systat.gfilepath;
mp:=systat.menupath;
close(systatf);
end else begin
gp:=systat1.gfilepath;
mp:=systat1.menupath;
close(systatf1);
end;
inc(needs,sizeof(systatrec));
if needc('1') then begin
ss('names.lst');
assign(sf1,gp+'names.lst');
{$I-} reset(sf1); {$I+}
if (ioresult<>0) then begin
assign(systatf,'status.dat');
reset(systatf);
{$I-} read(systatf,systat); {$I+}
gp:=systat.gfilepath;
mp:=systat.menupath;
close(systatf);
assign(sf1,gp+'names.lst');
{$I-} reset(sf1); {$I+}
if (ioresult<>0) then cantopen;
end;
{$I-} read(sf1,sr1); {$I+}
inc(needs,sizeof(smalrec)*filesize(sf1));
close(sf1);
end;
if needc('2') then begin
ss('user.lst');
assign(uf1,gp+'user.lst');
{$I-} reset(uf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(uf1,user1); {$I+}
inc(needs,sizeof(userrec)*filesize(uf1));
close(uf1);
end;
if needc('3') then begin
ss('boards.dat');
assign(bf1,gp+'boards.dat');
{$I-} reset(bf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(bf1,brd1); {$I+}
inc(needs,sizeof(boardrec)*filesize(bf1));
close(bf1);
end;
if needc('4') then begin
ss('email.dat');
assign(mailfile1,gp+'email.dat');
{$I-} reset(mailfile1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(mailfile1,mail1); {$I+}
inc(needs,sizeof(mailrec)*filesize(mailfile1));
close(mailfile1);
end;
if needc('5') then begin
ss('gfiles.dat');
assign(gfilef1,gp+'gfiles.dat');
{$I-} reset(gfilef1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(gfilef1,gfile1); {$I+}
inc(needs,sizeof(tfilerec)*filesize(gfilef1));
close(gfilef1);
end;
if needc('6') then begin
ss('protocol.dat');
assign(xp1,gp+'protocol.dat');
{$I-} reset(xp1); {$I+}
if (ioresult<>0) then cantopen;
inc(needs,sizeof(protrec)*filesize(xp1));
close(xp1);
end;
if needc('7') then begin
ss('shortmsg.dat');
assign(smf1,gp+'shortmsg.dat');
{$I-} reset(smf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(smf1,sm1); {$I+}
inc(needs,sizeof(smalrec)*filesize(smf1));
close(smf1);
end;
if needc('8') then begin
ss('uploads.dat');
assign(ulf1,gp+'uploads.dat');
{$I-} reset(ulf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(ulf1,ubrd1); {$I+}
inc(needs,sizeof(ulrec)*filesize(ulf1));
close(ulf1);
end;
if needc('9') then begin
ss('voting.dat');
assign(vdf1,gp+'voting.dat');
{$I-} reset(vdf1); {$I+}
inc(needs,sizeof(vdatar)*filesize(vdf1));
if (ioresult=0) then close(vdf1);
end;
if needc('A') then begin
ss('zlog.dat');
assign(ztf1,gp+'zlog.dat');
{$I-} reset(ztf1); {$I+}
if (ioresult<>0) then cantopen;
{$I-} read(ztf1,zt1); {$I+}
inc(needs,sizeof(zlogrec)*filesize(ztf1));
close(ztf1);
end;
if needc('B') then begin
ss('*.dir');
ffile(gp+'*.dir');
while (found) do begin
assign(ulff1,fexpand(gp+dirinfo.name));
{$I-} reset(ulff1); {$I+}
inc(needs,sizeof(ulfrec)*filesize(ulff1));
close(ulff1);
nfile;
end;
end;
end;
function barconv(c:char):char;
var s:astr;
begin
if (pos(c,artable)<>0) then s:=copy('ABCDEFG',pos(c,artable),1) else s:='@';
barconv:=s[1];
end;
function arconv(c:char):char;
begin
if (c in ['A'..'G']) then
if (length(artable)>=ord(c)-64) and (artable[ord(c)-64] in ['@'..'Z']) then
arconv:=artable[ord(c)-64]
else arconv:='@'
else arconv:='@';
end;
function substall(src,old,new:astr):astr;
var p:integer;
begin
p:=1;
while (p>0) do begin
p:=pos(old,src);
if (p>0) then begin
insert(new,src,p+length(old));
delete(src,p,length(old));
end;
end;
substall:=src;
end;
procedure bconvert(xx:integer);
var i,j,k:integer;
s:astr;
b:boolean;
begin
end;
procedure fconvert(xx:integer);
const dcols:clrs=((15,7,7,15,15,15,112,7,143,7),(15,3,1,11,9,14,31,4,140,10));
var i,j,k:integer;
b:boolean;
s,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15:astr;
c:char;
mf,mf1:text;
sepmsgs,nocopy,bla,b1,b2:boolean;
f:file;
mary:array[0..200] of messagerec;
curdir:astr;
newpath:array[1..3] of astr;
fff:file;
menuline:array[1..13] of string[255];
uu:uflags1;
numread:word;
procedure make_paths;
var s:string;
i,j:integer;
begin
for i:=1 to 3 do begin
{rcg11242000 DOSism.}
{while copy(newpath[i],length(newpath[i]),1)='\' do}
while copy(newpath[i],length(newpath[i]),1)='/' do
2000-11-17 16:33:00 -08:00
newpath[i]:=copy(newpath[i],1,length(newpath[i])-1);
case i of 1:s:='AFILES'; 2:s:='TRAP'; 3:s:='TEMP'; end;
star(s+' path ("'+fexpand(newpath[i])+'")');
{$I-} mkdir(fexpand(newpath[i])); {$I+}
if (ioresult<>0) then begin
writeln;
star('Error creating directory "'+fexpand(newpath[i])+'"');
halt(1);
end;
if (i=3) then
for j:=1 to 3 do begin
{rcg11242000 dosism.}
(*{$I-} mkdir(fexpand(newpath[i]+'\'+cstr(j))); {$I+}*)
{$I-} mkdir(fexpand(newpath[i]+'/'+cstr(j))); {$I+}
2000-11-17 16:33:00 -08:00
if (ioresult<>0) then begin
writeln;
{rcg11242000 dosism.}
{star('Error creating directory "'+fexpand(newpath[i]+'\'+cstr(j))+'"');}
star('Error creating directory "'+fexpand(newpath[i]+'/'+cstr(j))+'"');
2000-11-17 16:33:00 -08:00
halt(1);
end;
end;
{rcg11242000 dosism.}
{newpath[i]:=newpath[i]+'\';}
newpath[i]:=newpath[i]+'/';
2000-11-17 16:33:00 -08:00
end;
end;
function sacs(b:byte):string;
begin
if (b>0) then sacs:='s'+cstr(b) else sacs:='';
end;
begin
case xx of
14:begin
ttl('Adding records to "MODEM.DAT"');
chdir(copy(gp,1,length(gp)-1));
ffile('modem.dat');
if (not found) then star('MODEM.DAT not found.')
else begin
assign(modemrf17a7,'modem.old'); rewrite(modemrf17a7);
close(modemrf17a7); erase(modemrf17a7);
assign(modemrf17a7,'modem.tcp'); rewrite(modemrf17a7);
close(modemrf17a7); erase(modemrf17a7);
assign(modemrf,'modem.tcp'); rewrite(modemrf);
assign(modemrf17a7,'modem.dat');
reset(modemrf17a7); read(modemrf17a7,modemr17a7);
with modemr17a7 do begin
modemr.waitbaud:=waitbaud;
modemr.comport:=comport;
modemr.init:=init;
modemr.answer:=answer;
modemr.hangup:=hangup;
modemr.offhook:=offhook;
modemr.nocallinittime:=nocallinittime;
modemr.arq9600rate:=arq9600rate;
modemr.noforcerate:=noforcerate;
modemr.nocarrier:=nocarrier;
modemr.nodialtone:=nodialtone;
modemr.busy:=busy;
for i:=1 to 2 do
for j:=0 to 4 do modemr.resultcode[i][j]:=resultcode[i][j];
modemr.ctschecking:=TRUE;
modemr.dsrchecking:=TRUE;
modemr.usexonxoff:=FALSE;
modemr.hardwired:=FALSE;
end;
write(modemrf,modemr);
close(modemrf);
rename(modemrf17a7,'modem.old');
rename(modemrf,'modem.dat');
star('Done.');
writeln;
end;
chdir(sp);
end;
end;
end;
procedure convert(xx:integer);
var s:astr;
i,j,k:integer;
c:char;
begin
case xx of
0 :c:='S';
1..9 :c:=chr(xx+48);
10..20:c:=chr(xx+55);
end;
if (needc(c)) then
if (back) then bconvert(xx) else fconvert(xx);
end;
begin
infield_out_fgrd:=15;
infield_out_bkgd:=1;
infield_inp_fgrd:=0;
infield_inp_bkgd:=7;
getdir(0,sp);
aw:=FALSE;
didit:=FALSE;
if paramcount>0 then if allcaps(paramstr(1))='C' then aw:=TRUE;
savx:=wherex; savy:=wherey;
setwindow(wind,1,1,80,25,7,0,0);
clrscr;
textbackground(1); textcolor(15); clreol;
write(' Telegard Conversion for '+ver1+' <10><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> '+ver);
textbackground(0);
window(1,2,80,25); clrscr;
tc(14);
writeln;
writeln('This program is provided to add/modify/create files used by Telegard to');
writeln('make it 100% functional under the '+ver+' environment. This file MUST');
writeln('be ran in the directory in which STATUS.DAT is found, and STATUS.DAT MUST');
writeln('be in '+ver1+' format!!! If STATUS.DAT is not in the current directory,');
writeln('or if you have already ran this program (STATUS.DAT has already been');
writeln('converted), this program will abort.');
writeln;
tc(9); write('Hit any key to continue (<ESC> to abort NOW) : ');
repeat until keypressed;
c:=readkey;
if (c=#27) then ee('ABORTED CONVERSION');
repeat
clrscr;
fvers;
if (not aw) then begin
writeln;
star('WARNING! This conversion program needs APPROXIMATELY');
star(cstrl(needs)+' bytes free on your main BBS drive!!!!!!!!');
writeln;
star('You currently have '+cstrl(freek(0)*1024)+' bytes left on the current drive.');
writeln;
star('If you DO NOT have enough space left, your drive will probably');
star('explode, and your house will burn to the ground. If you are');
star('skeptical of this, feel free to call Garfield, SysOp of Electric');
star('Eye ][ BBS (313/776-8928), who can tell you how bad HIS messed up');
star('when he converted from 1.6d3 --> 1.6e1 with only 500k!');
writeln;
if (not l_pynq('Proceed? ')) then ee('Aborted conversion');
end;
clrscr;
writeln;
if aw then begin
for i:=0 to 15 do begin
if (i>=1) and (i<=9) then c:=chr(i+48) else
if (i=0) then c:='S' else
if (i>=10) then c:=chr(i+55);
if (needc(c)) then begin
tc(9); write('['+cstr(i)+'] ');
if i<10 then write(' ');
tc(11);
case i of
0:write('(S)tatus.dat');
1:write('names.lst');
2:write('user.lst');
3:write('boards.dat');
4:write('email.dat');
5:write('gfiles.dat');
6:write('protocol.dat');
7:write('shortmsg.dat');
8:write('uploads.dat');
9:write('voting.dat');
10:write('zlog.dat');
11:write(gp+'*.dir');
12:write(gp+'*.brd');
13:write(mp+'*.mnu');
14:write('modem.dat');
15:write('string.dat');
end;
writeln;
end;
end;
writeln;
tc(14); write('Enter # to convert, (A)ll or (Q)uit :');
tc(9); readln(a); a:=allcaps(a);
j:=value(a);
end else
a:='A';
if (j=0) then
if (copy(a,1,1)='S') then j:=0 else j:=-1;
if (copy(a,1,1)<>'Q') or ((j>=0) and (j<=13)) then begin
writeln;
if aw then begin
tc(14); write('[1]Convert to '+ver+' - [2]Convert back to '+ver1+' : ');
tc(9); readln(b); b:=allcaps(b);
h:=value(b);
end else
h:=1;
if (h in [1,2]) then begin
clrscr; tc(15);
back:=FALSE;
if h=2 then back:=TRUE;
if back then begin
tc(31);
writeln('Convert '+ver+' <10><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> '+ver1);
end else
writeln('Convert '+ver1+' <10><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> '+ver);
writeln;
tc(4); write('WARNING: ');
tc(12);
if back then writeln('If files are not in version '+ver+' format,') else
writeln('If files are NOT in version '+ver1+' format,');
writeln('the data will be COMPLETELY LOST *FOREVER*!!');
writeln;
writeln;
tc(14); writeln('ARE YOU ABSOLUTELY SURE?');
writeln('(Enter "YES" in ALL CAPS, without quotes, if you are...)');
write(':');
readln(b);
if b='YES' then begin
clrscr;
if copy(a,1,1)<>'A' then convert(j)
else begin
for i:=0 to 20 do convert(i);
{ ttl('Moving new files into their directories');
smovefile('protocol.dat',systat.gfilepath);
smovefile('sysfunc.ans',systat.afilepath);}
end;
didit:=TRUE;
end;
end;
end;
if (not aw) then a:='Q';
until copy(a,1,1)='Q';
writeln;
star('Press any key...'); c:=readkey;
clrscr;
removewindow(wind);
if didit then begin
setwindow(wind,20,11,59,17,9,1,1);
clrscr; tc(15);
gotoxy(4,3);
write('Thank you for choosing Telegard!');
CursorOff; delay(1500); CursorOn;
removewindow(wind);
end;
gotoxy(savx,savy);
chdir(sp);
end.