uses dos,crt,filehandle;
procedure assign;
begin
end;
procedure close;
begin
end;
procedure reset;
begin
end;
procedure rewrite;
begin
end;
procedure seek;
begin
end;
type
   MessageBaseRec = Record
                     Description : String[40];
                     DataFile    : String[8];
                     QWKID       : String[10];
                     BaseType    : array[1..7] of boolean;
                     Sponsor     : String[30];
                     PostAccess  : String[80]; {i.e. "a17$513"}
                     ReadAccess  : String[80];
                     ListAccess  : String[80];
                     Password    : String[30]; {i.e. "SMEEGLEDIPO"}
                     MaxMessages : 1..1000;
                     UseNet      : Boolean;
                     EchoMailDir : String[80]; {i.e. "C:\NETS\BLACK\ANSI"}
                     NetAddress  : Byte;       {i.e. "23:200/17 }
                     OriginLine  : Byte;       {i.e. "Stolen Archives .."}
                     EchoTag     : String[80]; {i.e. "BLK_ANSI"}
                     NetID       : String[20]; {i.e. "BlackNet"}
                     Kill_Kludge : Boolean;
                     Kill_Seenby : Boolean;
                     Kill_TearLn : Boolean;
                    End;
  type

  MessageRec = Record
                Author   : String[30];
                Status   : Byte; { Bit 1 - Private } { Bit 2 - Anonymous }
                Position : LongInt;
                Numlines : integer;
                ToField  : String[30];
                UserNote : String[50];
                DateTime : string[8];
                Subject  : string[30];
               End;

               type msgbod  = record
                       text : string[80];
                    end;

               type msgbuff = array[1..101] of msgbod;

function load_base(fn:string;var mb:messagebaserec;i:byte):boolean;
var f   : file;{ of messagebaserec;}
    lb  : boolean;
begin
lb:=false;
fillchar(mb,sizeof(mb),#0);

if nassign(f,fn+'.MB')=false then begin
                    nreset(f);
                    fillchar(mb,sizeof(mb),#0);
                    mb.Description  :='New Message Base';
                    mb.DataFile     :='NEWBASE';
                    mb.QWKID        :='1';
                    mb.BaseType[1]  :=true;
                    mb.BaseType[2]  :=true;
                    mb.BaseType[3]  :=true;
                    mb.BaseType[4]  :=true;
                    mb.BaseType[5]  :=true;
                    mb.BaseType[6]  :=true;
                    mb.BaseType[7]  :=false;
                    mb.Sponsor      :='Sudden Death';
                    mb. PostAccess  :='';
                    mb. ReadAccess  :='';
                    mb. ListAccess  :='';
                    mb. Password    :='';
                    mb. MaxMessages :=100;
                    mb. UseNet      :=false;
                    mb. EchoMailDir :='';
                    mb. NetAddress  :=1;
                    mb. OriginLine  :=1;
                    mb. EchoTag     :='Lucid';
                    mb. NetID       :='';
                    mb. Kill_Kludge :=false;
                    mb. Kill_Seenby :=false;
                    mb. Kill_TearLn :=false;
{                   write(f,mb);}
                    nwrite(f,mb,sizeof(mb));
                    end;
if filesize(f) >= i-1 then begin
                           nseek(f,i-1);
                           nread(f,mb,sizeof(mb));
                           lb:=true;
                           end;
nclose(f);
if lb=false then fillchar(mb,sizeof(mb),#0);
load_base:=lb;
end;

procedure add_base(fn:string;mb:messagebaserec);
var f  : file;{ of messagebaserec;}

begin
nassign(f,fn+'.MB');
nseek(f,filesize(F));
nwrite(f,mb,sizeof(mb));
nclose(F);
end;

Procedure Delete_base(fn:string;i:byte);
var f  : file;{ of messagebaserec;}
    mb  : messagebaserec;
  begin

    if nassign(f,fn+'.MB')=false then
                                begin
                                nclose(F);
                                exit;
                                end;
    if i>filesize(f) then begin
                          nclose(f);
                          exit;
                          end;
    if filesize(f) =0 then begin
                           nclose(F);
                           exit;
                           end;
    if filesize(f)=1 then begin
                          truncate(f);
                          end else
                         begin
                            REPEAT
                            nSEEK(f,i+1);
                            nREAD(f,mb,sizeof(mb));
                            nSEEK(f,i);
                            nWRITE(f,mb,sizeof(mb));
                            INC(i);
                            UNTIL i=FILESIZE(f)-1;
                            truncate(f);
                         end;
    nclose(f);
   end;

procedure list_base(fn:string);
var f:file;{ of messagebaserec;}
    mb:messagebaserec;
begin
    nassign(f,fn+'.MB');
    if io<>0  then exit;
    if filesize(f)=0 then exit;
    fillchar(mb,sizeof(mb),#0);
    repeat
    nread(f,mb,sizeof(mb));
    until eof(f);
    nclose(f);
end;

procedure insert_base(fn:string;i:byte;mb:messagebaserec);
var f   : file;{ of messagebaserec;}
    temp: messagebaserec;
    fx  : byte;
    ii  : byte;
    xx  : byte;
begin
nassign(f,fn+'.MB');
fillchar(temp,sizeof(temp),#0);

ii:=filesize(f);
dec(i);
if i > filesize(F) then begin
                        nseek(f,filesize(f));
                        nwrite(f,mb,sizeof(mb));
                        nclose(f);
                        exit;
                        end;
nseek(f,i);
for xx:=ii-1 downto i do begin
                         nseek(f,xx);
                         nread(f,temp,sizeof(temp));
                         nseek(f,xx+1);
                         nwrite(f,temp,sizeof(temp));
                         end;
nseek(f,i);
nwrite(f,mb,sizeof(mb));
nclose(F);
end;

procedure post_msg(fn:String;idx:messagerec;mb:msgbuff);
var idxf : file;{ of messagerec; { message index }
    msgf : file;{ of msgbod;  { message body file }
    ctr  : integer;
    str  : string[80];
begin
nassign(idxf,fn+'.NDX');
nassign(msgf,fn+'.BOD');

nseek(idxf,filesize(idxf));
idx.position:=filesize(msgf);

write(idxf,idx);
close(idxf);
seek(msgf,filesize(msgf));
ctr:=0;
repeat
inc(ctr);
write(msgf,mb[ctr]);
until ctr=idx.numlines;
close(msgf);
end;

procedure read_msg(fn:string; i:longint);
type str80=string[80];
var idxf : file of messagerec; { message index }
    msgf : file {of str80};     { message body file }
    idx  : messagerec;
    lc   : integer;
    liner: str80;
begin
assign(idxf,fn+'.NDX');
{$i-} reset(idxf); {$i+}
if ioresult<>0 then rewrite(idxf);

if i = 0 then begin
                   close(idxf);
                   exit;
                   end;

if filesize(idxf) =0 then begin
                         close(idxf);
                         exit;
                         end;

if i > filesize(idxf) then begin
                             close(idxf);
                             exit;
                             end;
seek(idxf,i-1);
read(idxf,idx);

assign(msgf,fn+'.BOD');
{$i-} reset(msgf,1); {$i+}

if ioresult<>0 then begin;
                    rewrite(msgf,1);
                    close(msgf);
                    exit;
                    end;
seek(msgf,idx.position);
writeln('message from ',idx.author);
writeln('message to   ',idx.tofield);
writeln('position     ',idx.position);
for lc:=1 to idx.numlines do begin
                             fillchar(liner,sizeof(liner),#0);
                             blockread(msgf,liner,sizeof(liner));
                             write(lc);
                             writeln(liner);
                             end;
close(msgf);
close(idxf);
writeln('---- > ');
readkey;
end;

procedure local_upload_msg(fn:string; ndx:messagerec; ul:string);
var idxf : file of messagerec; { message index }
    msgf : file of msgbod;     { message body file }
    ulf  : text;
    maxl : integer;
    line : msgbod;
    ctr  : integer;
begin
assign(idxf,fn+'.NDX');
{$i-} reset(idxf); {$i+}
if ioresult<>0 then rewrite(idxf);

assign(ulf,ul);
{$i-} reset(ulf); {$i+}
if ioresult<>0 then begin
                    close(idxf);
                    exit;
                    end;

assign(msgf,fn+'.BOD');
{$i-} reset(msgf); {$i+}
if ioresult<>0 then rewrite(msgf);

seek(msgf,filesize(msgf));

ctr:=0;
ndx.position:=filesize(msgf);

repeat
fillchar(line,80,#0);
readln(ulf,line.text);
textattr:=7;
write(msgf,line);
inc(ctr);
until eof(ulf);

ndx.numlines:=ctr;
seek(idxf,filesize(idxf));
write(idxf,ndx);
close(idxf);
close(ulf);
close(msgf);
end;


var ndx:messagerec;
    mb :msgbuff;
    f  :file;
begin
fillchar(ndx,sizeof(ndx),#0);
ndx.author:='Sudden Death';
ndx.status:=1;
ndx.position:=0;
ndx.numlines:=0;
ndx.tofield:='Judge Dredd';
ndx.Usernote:='Duh';
ndx.datetime:='03/20/80';
ndx.subject:='New Message Shit';
ndx.numlines:=3;
fillchar(mb,sizeof(mb),#0);
MB[1].TEXT:='d';
MB[2].TEXT:='e';
mb[3].text:='f';
{post_msg(fn:String;idx:messagerec;mb:msgbuff);}
{POST_MSG('AREA1',NDX,MB);
{read_msg('AREA1',1);}
read_msg('AREA1',1);{
read_msg('AREA1',3);}
readkey;

end.