telegard/t2t.pas

1345 lines
40 KiB
ObjectPascal
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
{$M 50000,0,1000} { Declared here suffices for all Units as well! }
uses
crt,dos,
myio, common;
{$I tagr24d.pas}
{$I rec18a.pas}
var
a,b,lastss,mp,gp,sp:astr;
h,i,j,k,savx,savy:integer;
c:char;
aw:boolean; { author working }
backtotag:boolean; { CONVERTING TO TELEGARD .. }
found:boolean;
dirinfo:searchrec;
ptsforisrequest,ptsfornotval:integer;
wind:windowrec;
didit:boolean;
tag_uf:file of tag_userrec;
tag_ulf:file of tag_ulrec;
tag_ulff:file of tag_ulfrec;
tag_bff:file of tag_messagerec;
tag_sf:file of tag_smalrec;
tag_bf:file of tag_boardrec;
tag_vf:file of tag_vdatar;
tag_u1:tag_userrec;
tag_ub:tag_ulrec;
tag_ulffr:tag_ulfrec;
tag_bffr:tag_messagerec;
tag_sr:tag_smalrec;
tag_bb:tag_boardrec;
tag_vv:tag_vdatar;
uf:file of userrec;
ulf:file of ulrec;
ulff:file of ulfrec;
bff:file of messagerec;
sf:file of smalrec;
bf:file of boardrec;
vf:file of vdatar;
u1:userrec;
ub:ulrec;
ulffr:ulfrec;
bffr:messagerec;
sr:smalrec;
bb:boardrec;
vv:vdatar;
tagpath,tgpath,tmsgpath:astr;
artable:astr;
tag_systatf:file of tag_systatrec;
tag_systat:tag_systatrec;
systatf:file of systatrec;
systat:systatrec;
macrf:file of macrorec;
macr:macrorec;
ff:file;
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 cstr(i:integer):astr;
var c:astr;
begin
str(i,c);
cstr:=c;
end;
procedure alignpathname(var s:astr);
begin
{rcg11242000 DOSisms.}
{
if copy(s,length(s),1)<>'\' then s:=s+'\';
while (copy(s,length(s)-1,2)='\\') and (length(s)>2) do
}
if copy(s,length(s),1)<>'/' then s:=s+'/';
while (copy(s,length(s)-1,2)='//') and (length(s)>2) do
s:=copy(s,1,length(s)-1);
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;
{rcg11272000 dunno if this is even used, but it won't fly under Linux.}
{ below is a working implementation.}
{
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;
}
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.}
{
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;
}
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;
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));
{rcg11182000 hahahaha...a Y2K bug. :) }
{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...}
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.}
{
s:=fexpand(s);
exdrv:=ord(s[1])-64;
}
exdrv:=3;
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));
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;
var ther:array[1..10] of boolean;
procedure nott(i:integer; s:astr);
begin
if (not backtotag) then begin
star(s);
ther[i]:=FALSE;
end;
end;
procedure findnotther;
var i,n:integer;
begin
n:=0;
for i:=1 to 10 do
if not ther[i] then inc(n);
if n<>0 then begin
star('File(s) not found. Abort conversion? [Yes] : ');
repeat c:=upcase(readkey) until c in ['Y','N',^M];
if c<>'N' then ee('File(s) not found -- Aborted.');
end;
end;
procedure fvers;
var i:integer;
begin
clrscr;
star('Checking files');
for i:=1 to 10 do ther[i]:=TRUE;
assign(tag_uf,tagpath+'user.lst');
{$I-} reset(tag_uf); {$I+}
if (ioresult<>0) then nott(1,'"'+tagpath+'user.lst": file not found.');
assign(tag_sf,tagpath+'names.lst');
{$I-} reset(tag_sf); {$I+}
if (ioresult<>0) then nott(2,'"'+tagpath+'names.lst": file not found.');
assign(tag_ulf,tagpath+'fboards.dat');
{$I-} reset(tag_ulf); {$I+}
if (ioresult<>0) then nott(3,'"'+tagpath+'fboards.dat": file not found.');
assign(tag_bf,tagpath+'boards.dat');
{$I-} reset(tag_bf); {$I+}
if (ioresult<>0) then nott(4,'"'+tagpath+'boards.dat": file not found.');
assign(tag_vf,tagpath+'voting.dat');
{$I-} reset(tag_vf); {$I+}
if (ioresult<>0) then nott(5,'"'+tagpath+'voting.dat": file not found.');
findnotther;
end;
{rcg11172000 had to change this to get it compiling under Free Pascal...}
{function substall(src,old,new:astr):astr;}
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;
function c2(i:integer):astr;
var s:astr;
begin
str(i,s);
if length(s)>2 then s:=copy(s,length(s)-1,2)
else if length(s)=1 then s:='0'+s;
c2:=s;
end;
function spdate(y,m,d:integer):integer;
begin
spdate:=((y-1920)*512)+(m*32)+d;
end;
function sptime(h,m,s:integer):integer;
begin
sptime:=(h*2048)+(m*32)+(s div 2);
end;
function getspdate(i:integer):astr;
var x,y,m,d:longint;
begin
x:=i; if x<0 then x:=x+65536;
y:=x div 512; x:=x-512*y;
m:=x div 32; x:=x-32*m;
d:=x;
getspdate:=c2(m)+'/'+c2(d)+'/'+c2(y);
end;
function getsptime(i:integer):astr;
var x,h,m,s:longint;
begin
x:=i; if x<0 then x:=x+65536;
h:=x div 2048; x:=x-2048*h;
m:=x div 32; x:=x-32*m;
s:=x div 2;
getsptime:=c2(h)+':'+c2(m)+':'+c2(s);
end;
procedure bconvert(xx:integer);
var ttt:uflags;
s:astr;
siz,siz1:longint;
i,j,k:integer;
b:boolean;
procedure donothing;
begin end;
begin
case xx of
1:begin
ttl('Converting "NAMES.LST" to TAG format');
assign(sf,tgpath+'names.lst');
reset(sf);
rewrite(tag_sf);
for i:=0 to filesize(sf)-1 do begin
seek(sf,i); read(sf,sr);
star(' (record #'+cstr(i)+' of '+cstr(filesize(sf))+')'); gotoxy(1,wherey-1);
with sr do begin
tag_sr.name:=name;
tag_sr.number:=number;
end;
seek(tag_sf,i); write(tag_sf,tag_sr);
end;
close(sf);
writeln;
end;
2:begin
ttl('Converting "USER.LST" to TAG format');
assign(uf,tgpath+'user.lst');
reset(uf);
rewrite(tag_uf);
for i:=0 to filesize(uf)-1 do begin
seek(uf,i); read(uf,u1);
star(' (record #'+cstr(i)+' of '+cstr(filesize(uf)-1)+')'); gotoxy(1,wherey-1);
with u1 do begin
tag_u1.uname:=name;
tag_u1.rname:=realname;
tag_u1.addr:=street;
tag_u1.comtype:=computer;
tag_u1.citystate:=citystate;
tag_u1.snote:=note;
tag_u1.lastdate:=spdate(value(copy(laston,7,2)),
value(copy(laston,1,2)),
value(copy(laston,4,2)));
tag_u1.lasttime:=spdate(0,0,0);
tag_u1.pw:=pw;
tag_u1.phone:=ph;
tag_u1.zcode:=zipcode;
with tag_u1.qscan[1] do begin
ltr:='A';
number:=-32767;
end;
for j:=2 to tag_maxboards do tag_u1.qscan[j]:=tag_u1.qscan[1];
for j:=1 to 20 do tag_u1.vote[j]:=vote[j];
for j:=1 to 15 do tag_u1.callspr[j]:=255;
tag_u1.ttimeon:=ttimeon;
tag_u1.ulk:=0.0; tag_u1.dlk:=0.0;
if (uk>0) and (uk<2147483647) then tag_u1.ulk:=round(uk);
if (dk>0) and (dk<2147483647) then tag_u1.dlk:=round(dk);
tag_u1.usernum:=i;
if (lockedout) then tag_u1.usernum:=i-1;
if (deleted) then tag_u1.usernum:=0;
tag_u1.privpost:=emailsent;
tag_u1.pubpost:=msgpost;
tag_u1.feedback:=feedback;
tag_u1.numcalls:=loggedon;
tag_u1.numul:=uploads;
tag_u1.numdl:=downloads;
tag_u1.fmail:=forusr;
tag_u1.hbaud:=1200;
tag_u1.timetoday:=0;
tag_u1.credit:=0;
tag_u1.debit:=0;
tag_u1.points:=filepoints;
tag_u1.timebank:=timebank;
tag_u1.bday:=spdate(value(copy(bday,7,2)),
value(copy(bday,1,2)),
value(copy(bday,4,2)));
tag_u1.strtmenu:=1;
tag_u1.sl:=sl;
tag_u1.dsl:=dsl;
if (novice in ac) then tag_u1.hlvl:=3 else tag_u1.hlvl:=1;
tag_u1.colms:=linelen;
tag_u1.lines:=pagelen;
tag_u1.callstoday:=ontoday;
tag_u1.illegal:=illegal;
tag_u1.waiting:=waiting;
tag_u1.lmsgbase:=lastmsg;
tag_u1.ldlbase:=lastfil;
tag_u1.cls:=ord(^L);
tag_u1.nulls:=0;
for c:='A' to 'Z' do
if (c in ar) then tag_u1.ar:=tag_u1.ar+[c];
tag_u1.flags:=[];
for ttt:=rlogon to fnodeletion do
if ttt in ac then
case ttt of
rlogon :tag_u1.flags:=tag_u1.flags+[txonecall];
rchat :tag_u1.flags:=tag_u1.flags+[txrchat];
rvalidate :tag_u1.flags:=tag_u1.flags+[txpubnotval];
rbackspace :;
ramsg :tag_u1.flags:=tag_u1.flags+[txrautomsg];
rpostan :tag_u1.flags:=tag_u1.flags+[txranon];
rpost :tag_u1.flags:=tag_u1.flags+[txrpubmsg];
remail :tag_u1.flags:=tag_u1.flags+[txrprivmsg];
rvoting :tag_u1.flags:=tag_u1.flags+[txrvoting];
rmsg :tag_u1.flags:=tag_u1.flags+[txautoprivdel];
spcsr :;
onekey :tag_u1.flags:=tag_u1.flags+[txonekey];
pause :tag_u1.flags:=tag_u1.flags+[txpause];
ansi :tag_u1.flags:=tag_u1.flags+[txansi];
color :tag_u1.flags:=tag_u1.flags+[txcolor];
alert :tag_u1.flags:=tag_u1.flags+[txalert];
smw :;
nomail :tag_u1.flags:=tag_u1.flags+[txmboxclosed];
fnodlratio :tag_u1.flags:=tag_u1.flags+[txnodllimit];
fnopostratio:tag_u1.flags:=tag_u1.flags+[txnopostcall];
fnofilepts :tag_u1.flags:=tag_u1.flags+[txnofilepts];
fnodeletion :tag_u1.flags:=tag_u1.flags+[txprotdel];
end;
if (sex='M') then tag_u1.flags:=tag_u1.flags+[txusermale];
tag_u1.flags:=tag_u1.flags+[txclschar];
for j:=1 to 4 do tag_u1.msgsysop[j]:=255;
tag_u1.dlscan:=[]; tag_u1.msgscan:=[];
for j:=0 to tag_maxuboards do tag_u1.dlscan:=tag_u1.dlscan+[j];
for j:=0 to tag_maxboards do tag_u1.msgscan:=tag_u1.msgscan+[j];
for b:=FALSE to TRUE do
for j:=0 to 9 do
tag_u1.colors[b][j]:=cols[b][j];
end;
seek(tag_uf,i); write(tag_uf,tag_u1);
end;
close(uf);
writeln;
end;
3:begin
ttl('Converting "BOARDS.DAT" to TAG format');
assign(bf,tgpath+'boards.dat');
reset(bf);
rewrite(tag_bf);
for i:=0 to filesize(bf)-1 do begin
seek(bf,i); read(bf,bb);
star(' (record #'+cstr(i)+' of '+cstr(filesize(bf)-1)+')'); gotoxy(1,wherey-1);
with bb do begin
tag_bb.name:=name;
tag_bb.filename:=filename;
tag_bb.sl:=0;
if (maxmsgs>200) then tag_bb.maxmsgs:=200 else tag_bb.maxmsgs:=maxmsgs;
tag_bb.pw:=password;
if (anonymous=yes) then tag_bb.anonymous:=yesanon
else if (anonymous=forced) then tag_bb.anonymous:=forcedanon
else tag_bb.anonymous:=noanon;
tag_bb.ar:='@';
tag_bb.noansi:=FALSE;
tag_bb.postsl:=0;
end;
seek(tag_bf,i); write(tag_bf,tag_bb);
with bb do
assign(bff,tgpath+filename+'.BRD');
{$I-} reset(bff); {$I+}
if (ioresult=0) then begin
seek(bff,0); read(bff,bffr);
siz:=bffr.message.number;
if (siz>filesize(bff)-1) then siz:=filesize(bff)-1;
assign(tag_bff,tagpath+tag_bb.filename+'.BRD');
clreol;
star(' (record #'+cstr(i)+' of '+cstr(filesize(bf)-1)+
') -- "'+bb.filename+'.BRD"');
rewrite(tag_bff); write(tag_bff,tag_bffr);
if (siz>200) then siz1:=siz-199 else siz1:=1;
for j:=siz1 to siz do begin
seek(bff,j); read(bff,bffr);
star(' (record #'+cstr(j)+' of '+cstr(siz)+')');
gotoxy(1,wherey-1);
with bffr do begin
tag_bffr.title:=title;
if (validated in messagestat) then
tag_bffr.messagestat:=tag_validated
else
if (unvalidated in messagestat) then
tag_bffr.messagestat:=tag_unvalidated
else
if (deleted in messagestat) then
tag_bffr.messagestat:=tag_deleted;
tag_bffr.message.ltr:=message.ltr;
tag_bffr.message.number:=message.number;
tag_bffr.message.ext:=message.ext;
tag_bffr.owner:=owner;
tag_bffr.date:=bffr.date;
tag_bffr.mage:=255;
end;
{seek(tag_bff,j);} write(tag_bff,tag_bffr);
end;
clreol; gotoxy(1,wherey-1);
close(bff);
close(tag_bff);
end;
end;
close(bf);
writeln;
end;
8:begin
ttl('Converting "UPLOADS.DAT" to TAG format ("FBOARDS.DAT")');
assign(ulf,tgpath+'uploads.dat');
reset(ulf);
rewrite(tag_ulf);
for i:=0 to filesize(ulf)-1 do begin
seek(ulf,i); read(ulf,ub);
star(' (record #'+cstr(i)+' of '+cstr(filesize(ulf)-1)+')');
gotoxy(1,wherey-1);
with ub do begin
tag_ub.name:=name;
tag_ub.filename:=filename;
tag_ub.dlpath:=dlpath;
tag_ub.ulpath:=ulpath;
tag_ub.password:=password;
tag_ub.dsl:=0;
tag_ub.namedsl:=255;
tag_ub.ar:='@';
tag_ub.noratio:=(fbnoratio in fbstat);
end;
seek(tag_ulf,i); write(tag_ulf,tag_ub);
{rcg11182000 lowercased this ".DIR" string...}
with ub do
assign(ulff,tgpath+filename+'.dir');
{$I-} reset(ulff); {$I+}
if (ioresult=0) then begin
seek(ulff,0); read(ulff,ulffr);
siz:=ulffr.blocks;
if (siz>filesize(ulff)-1) then siz:=filesize(ulff)-1;
{rcg11182000 lowercased this ".DIR" string...}
assign(tag_ulff,tag_ub.dlpath+tag_ub.filename+'.dir');
clreol;
star(' (record #'+cstr(i)+' of '+cstr(filesize(ulf)-1)+
') -- "'+ub.filename+'.dir"');
rewrite(tag_ulff); write(tag_ulff,tag_ulffr);
for j:=1 to siz do begin
seek(ulff,j); read(ulff,ulffr);
star(' (record #'+cstr(j)+' of '+cstr(siz)+')');
gotoxy(1,wherey-1);
with ulffr do begin
tag_ulffr.filename:=filename;
tag_ulffr.description:=description;
tag_ulffr.nacc:=nacc;
tag_ulffr.ft:=ft;
tag_ulffr.blocks:=blocks;
tag_ulffr.owner:=stowner;
tag_ulffr.date:=date;
tag_ulffr.daten:=daten;
tag_ulffr.unval:=(notval in filestat);
tag_ulffr.filepoints:=filepoints;
end;
seek(tag_ulff,j); write(tag_ulff,tag_ulffr);
end;
clreol; gotoxy(1,wherey-1);
close(ulff);
close(tag_ulff);
end;
end;
close(ulf);
writeln;
end;
9:begin
ttl('Converting "VOTING.DAT" to TAG format.');
assign(vf,tgpath+'voting.dat');
reset(vf);
rewrite(tag_vf);
for i:=0 to filesize(vf)-1 do begin
seek(vf,i); read(vf,vv);
star(' (record #'+cstr(i+1)+' of '+cstr(filesize(vf))+')');
gotoxy(1,wherey-1);
with vv do begin
tag_vv.question:=question;
tag_vv.numa:=numa;
for j:=0 to 9 do begin
tag_vv.answ[j].ans:=answ[j].ans;
tag_vv.answ[j].numres:=answ[j].numres;
end;
end;
seek(tag_vf,i); write(tag_vf,tag_vv);
end;
close(vf);
writeln;
end;
end;
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:astr;
c:char;
mf,mf1:text;
sepmsgs,nocopy:boolean;
f:file;
mary:array[0..200] of messagerec;
curdir:astr;
newpath:array[1..3] of astr;
ttt:tag_flagrec;
tt:tag_acrq;
siz:longint;
begin
case xx of
1:begin
ttl('Converting "NAMES.LST" to Telegard format');
assign(sf,tgpath+'names.lst');
rewrite(sf);
for i:=0 to filesize(tag_sf)-1 do begin
seek(tag_sf,i); read(tag_sf,tag_sr);
star(' (record #'+cstr(i+1)+' of '+cstr(filesize(tag_sf))+')'); gotoxy(1,wherey-1);
with tag_sr do begin
sr.name:=name;
sr.number:=number;
end;
seek(sf,i); write(sf,sr);
end;
close(sf);
writeln;
end;
2:begin
ttl('Converting "USER.LST" to Telegard format');
assign(uf,tgpath+'user.lst');
rewrite(uf);
for i:=0 to filesize(tag_uf)-1 do begin
seek(tag_uf,i); read(tag_uf,tag_u1);
star(' (record #'+cstr(i)+' of '+cstr(filesize(tag_uf)-1)+')'); gotoxy(1,wherey-1);
with tag_u1 do begin
u1.name:=uname;
u1.realname:=rname;
u1.pw:=pw;
u1.ph:=phone;
u1.bday:=getspdate(bday);
u1.firston:=getspdate(lastdate);
u1.laston:=getspdate(lastdate);
u1.street:=addr;
u1.citystate:=citystate;
u1.zipcode:=zcode;
u1.computer:=comtype;
u1.occupation:='';
u1.wherebbs:='';
u1.note:=snote;
u1.lockedout:=(usernum<>i);
u1.deleted:=(usernum=0);
u1.lockedfile:='LOCKOUT';
u1.ac:=[];
u1.sex:='F';
for ttt:=txautoprivdel to txclschar do
if (ttt in flags) then
case ttt of
txautoprivdel:u1.ac:=u1.ac+[rmsg];
txnopostcall :u1.ac:=u1.ac+[fnopostratio];
txrautomsg :u1.ac:=u1.ac+[ramsg];
txranon :u1.ac:=u1.ac+[rpostan];
txrchat :u1.ac:=u1.ac+[rchat];
txnodllimit :u1.ac:=u1.ac+[fnodlratio];
txrpubmsg :u1.ac:=u1.ac+[rpost];
txrprivmsg :u1.ac:=u1.ac+[remail];
txrvoting :u1.ac:=u1.ac+[rvoting];
txonecall :u1.ac:=u1.ac+[rlogon];
txpubnotval :u1.ac:=u1.ac+[rvalidate];
txprotdel :u1.ac:=u1.ac+[fnodeletion];
txnofilepts :u1.ac:=u1.ac+[fnofilepts];
txpause :u1.ac:=u1.ac+[pause];
txansi :u1.ac:=u1.ac+[ansi];
txcolor :u1.ac:=u1.ac+[color];
txonekey :u1.ac:=u1.ac+[onekey];
txalert :u1.ac:=u1.ac+[alert];
txusermale :u1.sex:='M';
txmboxclosed :u1.ac:=u1.ac+[nomail];
end;
if (hlvl>2) then u1.ac:=u1.ac+[novice];
u1.ar:=[];
for c:='A' to 'Z' do
if (c in ar) then u1.ar:=u1.ar+[c];
with u1.qscan[1] do begin
ltr:='A';
number:=-32767;
ext:=1;
end;
for j:=2 to maxboards do u1.qscan[j]:=u1.qscan[1];
for j:=1 to maxboards do u1.qscn[j]:=TRUE;
u1.dlnscn:=[];
for j:=0 to maxuboards do u1.dlnscn:=u1.dlnscn+[j];
for j:=1 to 20 do u1.vote[j]:=vote[j];
u1.ttimeon:=trunc(ttimeon);
if (ulk>0) and (ulk<2147483647) then u1.uk:=round(ulk) else u1.uk:=0;
if (dlk>0) and (dlk<2147483647) then u1.dk:=round(dlk) else u1.dk:=0;
u1.uploads:=numul;
u1.downloads:=numdl;
u1.loggedon:=numcalls;
u1.tltoday:=120;
u1.msgpost:=pubpost;
u1.emailsent:=privpost;
u1.feedback:=feedback;
u1.forusr:=fmail;
u1.filepoints:=points;
u1.waiting:=waiting;
u1.linelen:=colms;
u1.pagelen:=lines;
u1.ontoday:=callstoday;
u1.illegal:=illegal;
u1.sl:=sl;
u1.dsl:=dsl;
for b:=FALSE to TRUE do
for j:=0 to 9 do u1.cols[b][j]:=colors[b][j];
u1.lastmsg:=lmsgbase;
u1.lastfil:=ldlbase;
u1.credit:=trunc(credit);
u1.timebank:=timebank;
for j:=1 to 5 do u1.boardsysop[j]:=255;
u1.trapactivity:=FALSE;
u1.trapseperate:=FALSE;
u1.timebankadd:=0;
u1.mpointer:=-1;
u1.chatauto:=FALSE;
u1.chatseperate:=FALSE;
u1.userstartmenu:='';
u1.slogseperate:=FALSE;
u1.clsmsg:=0;
for j:=1 to 57 do u1.res[j]:=0;
end;
seek(uf,i); write(uf,u1);
end;
close(uf);
writeln;
end;
3:begin
ttl('Converting "BOARDS.DAT" to Telegard format');
assign(bf,tgpath+'boards.dat');
rewrite(bf);
for i:=0 to filesize(tag_bf)-1 do begin
seek(tag_bf,i); read(tag_bf,tag_bb);
star(' (record #'+cstr(i)+' of '+cstr(filesize(tag_bf)-1)+')'); gotoxy(1,wherey-1);
with tag_bb do begin
bb.name:=name;
bb.filename:=filename;
bb.msgpath:=systat.pmsgpath;
bb.acs:='';
if (sl>0) then bb.acs:=bb.acs+'s'+cstr(sl);
if (ar in ['A'..'Z']) then bb.acs:=bb.acs+'f'+ar;
bb.postacs:='';
if (postsl>0) then bb.postacs:=bb.postacs+'s'+cstr(postsl);
bb.mciacs:='%';
bb.maxmsgs:=maxmsgs;
if (anonymous=noanon) then bb.anonymous:=no
else
if (anonymous=yesanon) then bb.anonymous:=yes
else
if (anonymous=forcedanon) then bb.anonymous:=forced;
bb.password:=pw;
bb.mbstat:=[];
bb.permindx:=i;
bb.mbdepth:=0;
end;
seek(bf,i); write(bf,bb);
with tag_bb do
assign(tag_bff,tagpath+filename+'.BRD');
{$I-} reset(tag_bff); {$I+}
if (ioresult=0) then begin
siz:=filesize(tag_bff)-1;
assign(bff,tgpath+tag_bb.filename+'.BRD');
star(' (record #'+cstr(i)+' of '+cstr(filesize(tag_bf)-1)+
') -- "'+tag_bb.filename+'.dir"'); gotoxy(1,wherey-1);
writeln;
rewrite(bff);
bffr.message.number:=siz;
seek(bff,0); write(bff,bffr);
for j:=1 to siz do begin
seek(tag_bff,j); read(tag_bff,tag_bffr);
star(' (record #'+cstr(j)+' of '+cstr(siz)+')');
gotoxy(1,wherey-1);
with tag_bffr do begin
bffr.title:=title;
bffr.messagestat:=[];
if (messagestat=tag_validated) then
bffr.messagestat:=bffr.messagestat+[validated]
else
if (messagestat=tag_unvalidated) then
bffr.messagestat:=bffr.messagestat+[unvalidated]
else
if (messagestat=tag_deleted) then
bffr.messagestat:=bffr.messagestat+[deleted];
bffr.message.ltr:=message.ltr;
bffr.message.number:=message.number;
bffr.message.ext:=message.ext;
bffr.owner:=owner;
bffr.date:=tag_bffr.date;
bffr.nacc:=0;
end;
seek(bff,j); write(bff,bffr);
end;
clreol; gotoxy(1,wherey-1);
close(bff);
close(tag_bff);
end;
end;
close(bf);
writeln;
end;
8:begin
ttl('Converting "FBOARDS.DAT" to Telegard format ("UPLOADS.DAT")');
assign(ulf,tgpath+'uploads.dat');
rewrite(ulf);
for i:=0 to filesize(tag_ulf)-1 do begin
seek(tag_ulf,i); read(tag_ulf,tag_ub);
star(' (record #'+cstr(i)+' of '+cstr(filesize(tag_ulf)-1)+')'); gotoxy(1,wherey-1);
with tag_ub do begin
ub.name:=name;
ub.filename:=filename;
ub.dlpath:=dlpath;
ub.ulpath:=ulpath;
ub.maxfiles:=2000;
ub.password:=password;
ub.arctype:=1;
ub.cmttype:=1;
ub.fbdepth:=0;
ub.fbstat:=[];
if (noratio) then ub.fbstat:=ub.fbstat+[fbnoratio];
ub.acs:='';
if (dsl>0) then ub.acs:=ub.acs+'d'+cstr(dsl);
if (ar in ['A'..'Z']) then ub.acs:=ub.acs+'f'+ar;
ub.ulacs:='';
ub.nameacs:='';
if (namedsl>0) then ub.acs:=ub.acs+'d'+cstr(namedsl);
ub.permindx:=i;
for j:=1 to 6 do ub.res[j]:=0;
end;
seek(ulf,i); write(ulf,ub);
{rcg11182000 lowercased this ".DIR" string...}
with tag_ub do
assign(tag_ulff,dlpath+filename+'.dir');
{$I-} reset(tag_ulff); {$I+}
if (ioresult=0) then begin
siz:=filesize(tag_ulff)-1;
{rcg11182000 lowercased this ".DIR" string...}
assign(ulff,tgpath+tag_ub.filename+'.dir');
star(' (record #'+cstr(i)+' of '+cstr(filesize(tag_ulf)-1)+
') -- "'+tag_ub.filename+'.dir"'); gotoxy(1,wherey-1);
writeln;
rewrite(ulff);
ulffr.blocks:=siz;
seek(ulff,0); write(ulff,ulffr);
for j:=1 to siz do begin
seek(tag_ulff,j); read(tag_ulff,tag_ulffr);
star(' (record #'+cstr(j)+' of '+cstr(siz)+')');
gotoxy(1,wherey-1);
with tag_ulffr do begin
ulffr.filename:=filename;
ulffr.description:=description;
ulffr.filepoints:=filepoints;
ulffr.nacc:=nacc;
ulffr.ft:=ft;
ulffr.blocks:=blocks;
ulffr.owner:=1;
ulffr.stowner:=owner;
ulffr.date:=date;
ulffr.daten:=daten;
ulffr.vpointer:=-1;
ulffr.filestat:=[];
if (unval) then ulffr.filestat:=ulffr.filestat+[notval];
end;
seek(ulff,j); write(ulff,ulffr);
end;
clreol; gotoxy(1,wherey-1);
close(ulff);
close(tag_ulff);
end;
end;
close(ulf);
writeln;
end;
9:begin
ttl('Converting "VOTING.DAT" to Telegard format.');
assign(vf,tgpath+'voting.dat');
rewrite(vf);
for i:=0 to filesize(tag_vf)-1 do begin
seek(tag_vf,i); read(tag_vf,tag_vv);
star(' (record #'+cstr(i+1)+' of '+cstr(filesize(tag_vf))+')');
gotoxy(1,wherey-1);
with tag_vv do begin
vv.question:=question;
vv.numa:=numa;
for j:=0 to 9 do begin
vv.answ[j].ans:=answ[j].ans;
vv.answ[j].numres:=answ[j].numres;
end;
end;
seek(vf,i); write(vf,vv);
end;
close(vf);
writeln;
end;
end;
end;
procedure convert(xx:integer);
var i,j,k:integer;
s:astr;
begin
if (backtotag) 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(' Conversion for TAG '+tag_ver+' <11><><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD> Telegard '+s_ver);
textbackground(0);
window(1,2,80,25); clrscr;
tc(14);
writeln;
writeln('This program is provided to convert data files used by');
writeln('TAG '+tag_ver+' to the proper formats used by Telegard '+s_ver+'.');
writeln('It may ALSO be used to convert from Telegard format to TAG.');
writeln;
writeln(' TAG '+tag_ver+' Telegard '+s_ver);
writeln(' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
writeln(' USER .LST <11><>-<2D><> USER .LST');
writeln(' NAMES .LST <11><>-<2D><> NAMES .LST');
writeln(' FBOARDS .DAT <11><>-<2D><> UPLOADS .DAT');
writeln(' ????????.DIR <11><>-<2D><> ????????.DIR');
writeln(' * EMAIL .DAT <11><>-<2D><> EMAIL .DAT');
writeln(' * SHORTMSG.DAT <11><>-<2D><> SHORTMSG.DAT');
writeln(' BOARDS .DAT <11><>-<2D><> BOARDS .DAT');
writeln(' ????????.BRD <11><>-<2D><> ????????.BRD');
writeln(' VOTING .DAT <11><>-<2D><> VOTING .DAT');
writeln(' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
writeln(' * means files require NO conversion and are');
writeln(' already in the correct Telegard '+s_ver+' format.');
writeln;
textcolor(14); write('Hit <CR> to continue, any other key to abort now : ');
repeat until keypressed;
c:=readkey;
if (c<>^M) then ee('ABORTED CONVERSION');
repeat
clrscr;
writeln;
textcolor(14);
writeln('Will you be converting ...');
writeln;
writeln('1. From TAG to Telegard format');
writeln('2. From Telegard to TAG format');
writeln('Q. Abort');
writeln;
textcolor(9); write('Select : ');
repeat c:=upcase(readkey) until (c in ['1','2','Q']);
if (c='Q') then ee('ABORTED CONVERSION');
backtotag:=(c='2');
writeln(c);
writeln;
writeln;
if (not backtotag) then begin
writeln;
textcolor(15); writeln('Enter your TAG GFILES pathname.');
textcolor(14);
writeln('USER.LST, NAMES.LST, FBOARDS.DAT, BOARDS.DAT, and other');
writeln('such files are here, and will be used to create the Telegard');
writeln('equivalents in your Telegard paths.');
writeln;
textcolor(9); write('TAG Path: '); infield(tagpath,40);
if (tagpath='') then ee('ABORTED');
alignpathname(tagpath); clreol; writeln(tagpath);
writeln;
writeln;
textcolor(15); writeln('Enter your Telegard MAIN BBS pathname.');
textcolor(14);
writeln('The data file STATUS.DAT should exist in this directory.');
writeln('The GFILES path will be located by searching STATUS.DAT.');
writeln('This step is involved to ensure you have a version of Telegard');
writeln('ALREADY set up; it is an essential part of the conversion.');
writeln;
textcolor(9); write('Telegard Path: '); infield(tgpath,40);
if (tgpath='') then ee('ABORTED');
alignpathname(tgpath); clreol; writeln(tgpath);
end else begin
writeln;
textcolor(15); writeln('Enter your Telegard MAIN BBS pathname.');
textcolor(14);
writeln('The Telegard file STATUS.DAT should exist in this directory.');
writeln('Other files will be located by searching STATUS.DAT.');
writeln;
textcolor(9); write('Telegard Path: '); infield(tgpath,40);
if (tgpath='') then ee('ABORTED');
alignpathname(tgpath); clreol; writeln(tgpath);
writeln;
writeln;
textcolor(15); writeln('Enter your TAG GFILES pathname.');
textcolor(14);
writeln('The converted TAG data files will be created in this directory.');
writeln('If they already exist, they will be overwritten.');
writeln;
textcolor(9); write('TAG Path: '); infield(tagpath,40);
if (tagpath='') then ee('ABORTED');
alignpathname(tagpath); clreol; writeln(tagpath);
end;
clrscr;
writeln;
textcolor(9); write('Converting: ');
textcolor(14);
if (backtotag) then writeln('TO TAG FORMAT')
else writeln('TO TELEGARD FORMAT');
textcolor(9); write('TAG Path: '); textcolor(15); writeln(tagpath);
textcolor(9); write('Telegard Path: '); textcolor(15); writeln(tgpath);
writeln;
writeln;
until l_pynq('Is this OK? ');
if (not backtotag) then begin
writeln;
textcolor(14);
writeln('Now you need to enter your Telegard MSGS directory, where you');
writeln('will later be putting all of your message files in.');
writeln;
{rcg11242000 DOSism.}
{writeln('This is probably "'+tgpath+'MSGS\" ...');}
writeln('This is probably "'+tgpath+'MSGS/" ...');
writeln;
textcolor(9); write('Telegard MSGS Path: '); infield(tmsgpath,40);
if (tmsgpath='') then ee('ABORTED');
alignpathname(tmsgpath); clreol; writeln(tmsgpath);
end;
assign(systatf,tgpath+'status.dat'); reset(systatf); read(systatf,systat);
systat.pmsgpath:=tmsgpath;
rewrite(systatf); write(systatf,systat); close(systatf);
tgpath:=systat.gfilepath;
repeat
clrscr;
fvers;
clrscr;
writeln;
(*
if aw then begin
for i:=0 to 13 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);
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('*.dir');
{ 12:write('*.brd');}
{ 13:write(mp+'*.mnu');}
end;
writeln;
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';
*)
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
clrscr; tc(15);
if (backtotag) then
writeln('Convert Telegard '+s_ver+' <10><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TAG '+tag_ver)
else
writeln('Convert TAG '+tag_ver+' <10><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Telegard '+s_ver);
writeln;
tc(4); write('WARNING: ');
tc(12);
if (backtotag) then
writeln('If Telegard data files are not in version '+s_ver+' format,')
else
writeln('If TAG data files are NOT in version '+tag_ver+' 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;
for i:=0 to 13 do convert(i);
didit:=TRUE;
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);
if (not backtotag) then write('Thank you for choosing Telegard!')
else write('Well, thanks for TRYING Telegard!');
CursorOff; delay(1500); CursorOn;
removewindow(wind);
end;
gotoxy(savx,savy);
chdir(sp);
end.