uses crt,dos;

{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}

{$M 50000,0,90000} { Declared here suffices for all Units as well! }

{$I rec16e1.pas}

var systatf:file of systatrec;

systat:systatrec;

bf:file of boardrec;

brd:boardrec;

sp:string;

i:integer;

c:char;

abort:boolean;

procedure tc(i:integer);

begin

textcolor(i);

end;

procedure star(s:astr);

begin

tc(9); write('þ ');

tc(11); writeln(s);

end;

procedure ttl(s:string);

begin

writeln;

textcolor(9); write('ÄÄ[');

textbackground(1); textcolor(15);

write(' '+s+' ');

textbackground(0); textcolor(9);

write(']');

repeat write('Ä') until wherex=80;

writeln;

end;

function cstr(i:integer):astr;

var c:astr;

begin

str(i,c);

cstr:=c;

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;

function exdrv(s:astr):byte;

begin

s:=fexpand(s);

exdrv:=ord(s[1])-64;

end;

procedure movefile(srcname,destpath:string);

var buffer:array[1..16384] of byte;

dfs,nrec:integer;

src,dest:file;

dd:dirstr;

dn:namestr;

de:extstr;

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 moveprivmail(npath:astr);

var j,k:integer;

s,s1,odir:astr;

mailfile:file of mailrec;

mr:mailrec;

f:file;

lastm,thism:messages; {* keep track of mass-mail duplicates *}

begin

while copy(npath,length(npath),1)='\' do

npath:=copy(npath,1,length(npath)-1);

getdir(0,odir);

{$I-} chdir(npath); {$I+}

if ioresult=0 then begin

chdir(odir);

star('Using existing subdirectory ("'+npath+'")');

end else begin

star('Creating new subdirectory ("'+npath+'")');

{$I-} mkdir(npath); {$I+}

end;

if (ioresult=0) then begin

assign(mailfile,systat.gfilepath+'email.dat');

{$I-} reset(mailfile); {$I+}

if (ioresult=0) then begin

k:=0;

writeln;

for j:=filesize(mailfile)-1 downto 0 do begin {* will sort messages in

* the order of

* newest-->oldest *}

seek(mailfile,j); read(mailfile,mr);

with mr.msg do begin

s:=ltr+cstr(number)+'.'+cstr(ext);

s1:=systat.pmsgpath+s;

thism:=mr.msg;

gotoxy(wherex,wherey-1); clreol;

inc(k);

star('Message file #'+cstr(k)+' of '+

cstr(filesize(mailfile))+': '+npath+'\'+s);

if ((thism.ltr<>lastm.ltr) or

(thism.number<>lastm.number) or

(thism.ext<>lastm.ext)) then begin

assign(f,s1);

{$I-} reset(f); {$I+}

if ioresult=0 then begin

close(f);

movefile(s1,npath+'\');

lastm:=thism;

end else star('File does not exist: '+s1);

lastm:=thism;

end;

end;

end;

close(mailfile);

end else star('Unable to open file: '+systat.gfilepath+'EMAIL.DAT');

end else star('Unable to create subdirectory: '+npath);

end;

procedure movemsgbase(brd:boardrec; npath:astr; i:integer);

var j,k:integer;

s,s1,odir:astr;

f:file;

mary:array[0..200] of messagerec;

begin

while copy(npath,length(npath),1)='\' do

npath:=copy(npath,1,length(npath)-1);

with brd do begin

getdir(0,odir);

{$I-} chdir(npath); {$I+}

if ioresult=0 then begin

chdir(odir);

star('Using existing subdirectory ("'+npath+'")');

end else begin

star('Creating new subdirectory ("'+npath+'")');

{$I-} mkdir(npath); {$I+}

end;

if ioresult=0 then begin

assign(f,systat.gfilepath+brd.filename+'.BRD');

{$I-} reset(f,sizeof(messagerec)); {$I+}

if ioresult=0 then begin

writeln;

blockread(f,mary[0],1);

blockread(f,mary[1],mary[0].message.number);

close(f);

k:=0;

for j:=mary[0].message.number downto 1 do {* will sort messages in

* the order of

* newest-->oldest *}

with mary[j].message do begin

s:=ltr+cstr(number)+'.'+cstr(ext);

s1:=systat.pmsgpath+s;

assign(f,s1);

{$I-} reset(f); {$I+}

if ioresult=0 then begin

close(f);

gotoxy(wherex,wherey-1); clreol;

inc(k);

star('Message file #'+cstr(k)+' of '+

cstr(mary[0].message.number)+': '+npath+'\'+s);

movefile(s1,npath+'\');

end else star('File does not exist: '+s1);

end;

end else star('Unable to open file: '+systat.gfilepath+brd.filename+'.BRD');

end else star('Unable to create subdirectory: '+npath);

end;

end;

begin

getdir(0,sp);

assign(systatf,'status.dat');

reset(systatf); read(systatf,systat); close(systatf);

star('Each message base in Telegard can now occupy its own, seperate directory');

star('path on your drive. Seperating the messages into seperate directorys');

star('will speed up seek-time for messages considerably.');

writeln;

star('This program can do all the work of seperating all the messages');

star('in each base into their own directories.');

writeln;

star('Message directories will be created off of your current Telegard MSGS\');

star('directory according to the *.BRD FILENAMEs of each message base.');

writeln;

star('Example:');

star('"'+systat.pmsgpath+'EMAIL\" for private mail');

star('"'+systat.pmsgpath+'GENERAL\" for message base #1');

star(' (if msg base #1 filename is "GENERAL")');

star('"'+systat.pmsgpath+'MISC\" for message base #2');

star(' (if msg base #2 filename is "MISC")');

star('And so on.');

writeln;

write('Continue and do this? [Yes] : ');

repeat c:=upcase(readkey) until c in ['Y','N',^M];

abort:=(c='N');

writeln(c);

if (abort) then halt;

writeln;

writeln;

ttl('Moving public message bases into seperate directory paths');

assign(bf,systat.gfilepath+'boards.dat');

reset(bf);

for i:=0 to filesize(bf)-1 do begin

seek(bf,i); read(bf,brd);

brd.msgpath:=brd.msgpath+brd.filename+'\';

seek(bf,i); write(bf,brd);

star('Moving messages in '+brd.filename+'.BRD ('+brd.name+') to "'+brd.msgpath+'"');

movemsgbase(brd,brd.msgpath,i+1);

end;

close(bf);

chdir(sp);

ttl('Moving private mail into "'+systat.pmsgpath+'EMAIL\"');

moveprivmail(systat.pmsgpath+'EMAIL\');

systat.pmsgpath:=systat.pmsgpath+'EMAIL\';

rewrite(systatf); write(systatf,systat); close(systatf);

end.