
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;

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);
assign(f,fn+'.MB');
{$i-} reset(F); {$i+}
if ioresult<>0 then begin
                    rewrite(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);
                    end;
if filesize(f) >= i-1 then begin
                           seek(f,i-1);
                           read(f,mb);
                           lb:=true;
                           end;
close(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
assign(f,fn+'.MB');
{$i-} reset(F); {$i+}
if ioresult<>0 then rewrite(f);
seek(f,filesize(F));
write(f,mb);
close(F);
end;

Procedure Delete_base(fn:string;i:byte);
var f  : file of messagebaserec;
    mb  : messagebaserec;
  begin
    assign(f,fn+'.MB');
    {$i-} reset(F); {$i+}
    if ioresult<>0  then begin
                         rewrite(f);
                         close(F);
                         end;
    if i>filesize(f) then begin
                          close(f);
                          exit;
                          end;
    if filesize(f) =0 then begin
                           close(F);
                           exit;
                           end;
    if filesize(f)=1 then begin
                          truncate(f);
                          end else
                         begin
                            REPEAT
                            SEEK(f,i+1);
                            READ(f,mb);
                            SEEK(f,i);
                            WRITE(f,mb);
                            INC(i);
                            UNTIL i=FILESIZE(f)-1;
                            truncate(f);
                         end;
    close(f);
   end;

procedure list_base(fn:string);
var f:file of messagebaserec;
    mb:messagebaserec;
begin
    assign(f,fn+'.MB');
    {$i-} reset(F); {$i+}
    if ioresult<>0  then exit;
    if filesize(f)=0 then exit;
    fillchar(mb,sizeof(mb),#0);
    repeat
    read(f,mb);
    until eof(f);
    close(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
assign(f,fn+'.MB');
{$i-} reset(F); {$i+}
if ioresult<>0 then rewrite(f);
fillchar(temp,sizeof(temp),#0);

ii:=filesize(f);
dec(i);
if i > filesize(F) then begin
                        seek(f,filesize(f));
                        write(f,mb);
                        close(f);
                        exit;
                        end;
seek(f,i);
for xx:=ii-1 downto i do begin
                         seek(f,xx);
                         read(f,temp);
                         seek(f,xx+1);
                         write(f,temp);
                         end;
seek(f,i);
write(f,mb);
close(F);
end;