home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
bbs_mail
/
faketo4d.arj
/
FAKETO4D.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-05
|
3KB
|
116 lines
{$V-}
program FakeTo4D;
uses dos,crt,totmisc,totstr,heapunt2;
const VER ='FakeTo4D v1.0';
var
Net,Node,PointNet,
i: integer;
DirInfo: SearchRec;
Outbound,
srch,
num,
temp1,temp2,
temp3: string;
delfile: file;
infile,outfile: text;
file_list: HeapObj;
{==========================================================================}
{ This Procedure Gives MySelf some well derserved credit @ the DOS prompt. }
{==========================================================================}
procedure Display_Logo;
begin {** Procedure Display_Logo **}
textcolor(7); textbackground(0);
Writeln(VER+' by Ron Pritchett of 1:376/74.0');
Writeln('Copyright (c) 1991 Realm Software, Distribute Freely, No Modifications');
Writeln;
end; {** Procedure Display_Logo **}
begin
writeln;
Display_logo;
assign(infile,'FakeTo4D.ctl');
reset(infile);
readln(infile,net);
readln(infile,node);
readln(infile,pointnet);
readln(infile,outbound);
writeln('Net/Node: ',net,'/',node);
writeln('PointNet: ',pointnet);
writeln('Outbound: ',outbound);
i:=pointnet;
srch:=outbound+'\'+IntToHexStr(i)+'*.?lo';
FindFirst(srch,archive,DirInfo);
while DosError = 0 do
begin
num:=copy(DirInfo.name,5,4);
temp1:=Outbound+'\'+PadRight(IntToHexStr(net),4,'0');
temp1:=temp1+PadRight(IntToHexStr(node),4,'0')+'.PNT\0000';
temp1:=temp1+num+'.'+copy(DirInfo.name,10,3);
if not exist(temp1) then
begin
i:=HexStrToLong(copy(dirinfo.name,5,4));
write('Moving mail for ',pointnet,'/',i);
writeln(' to ',net,'/',node,'.',i);
temp3:=outbound+'\'+dirinfo.name;
assign(delfile,temp3);
rename(delfile,temp1);
end
else
begin
i:=HexStrToLong(copy(dirinfo.name,5,4));
write('Merging mail for ',pointnet,'/',i);
writeln(' & ',net,'/',node,'.',i);
assign(infile,temp1);
reset(infile);
file_list.init;
while not eof(infile) do
begin
readln(infile,temp3);
temp3:=strip('B',#10,temp3);
file_list.insert(temp3);
end;
close(infile);
erase(infile);
temp2:=outbound+'\'+Dirinfo.name;
assign(infile,temp2);
reset(infile);
while not eof(infile) do
begin
readln(infile,temp3);
temp3:=strip('B',#10,temp3);
if not file_list.search(temp3) then
file_list.insert(temp3);
end;
close(infile);
erase(infile);
assign(outfile,temp1);
rewrite(outfile);
while not file_list.empty do
begin
temp2:=file_list.getmin;
writeln(outfile,temp2);
end;
close(outfile);
end;
FindNext(DirInfo);
end;
end.