Program CSTLPost;
(***************)

{ Poste un fichier texte sous forme d'un message dans la base hudson }
{ Freeware by Castle BBS Coorporation }

uses crt,dos;

Type
  MsgToIdxRecord = String[35];
  FlagType = Array[1..4] of Byte;
  Lastreadrecord = Array[1..200] of integer;

Netnode = Record
          Zone,
          Net,
          Node   : Word;
       end;

NetAdress =  record
            Zone,
            Net,
            Node,
            Point     : Word;
     end;

InfoRecord = Record
           LowMsg:       integer;
           HighMsg:      integer;         (* MSGINFO.BBS *)
           TotalActive:  integer;
           ActiveMsgs:   Array[1..200] of Integer;
     End;

IdxRecord = Record
        Msgnum:   Integer;                 (* MSGIDX.BBS *)
        Board:    Byte;
     end;

HdrRecord = Record
        MsgNum,                             (* MSGHDR.BBS *)
        ReplyTo,
        SeeAlsoNum,
        TimesRead:       Integer;   { Not used}
        StartRec:        Word; { Je pense que c'est ce que je cherchais non ? }
        NumRecs,               {Tient ! ca aussi ! }
        DestNet,
        DestNode,
        OrigNet,
        OrigNode:       Integer;
        Destzone,
        Origzone:       Byte;
        Cost:           Integer;
        MsgAttr,
        Netattr,
        Board:          Byte;
        PostTime:       String[5];
        PostDate:       String[8];
        WhoTo,
        WhoFrom:        MsgToIdxRecord;
        Subj:           String[72];
    End;

Type texte = string[255];

Var hdr : Hdrrecord;
    txt,tampon : texte;
    txt2 : msgtoidxrecord;
    info : inforecord;
    idx : idxrecord;
    fich_txt : file of texte;
    txt_record : array[0..200] of texte; { Nombre de séries de 255 caractères}
    fichier : file of hdrrecord;
    fich_info : file of inforecord;
    fich_idx : file of idxrecord;     {variables ... Pfouuuu....}
    fich : file of msgtoidxrecord;
    answer : file of char;
    compteur,I,J : integer;
    total_a : integer;
    caractere : char;
    f_name : string[30];
    from,too : string[35];
    Subj : string[72];
    Attr : byte;
    Path : string[30];
    board : byte;
    item : string[80];
    option : char;
    node : string[5];
    erreur : integer;
    DestNet,
    DestNode,
    OrigNet,
    OrigNode,
    Destzone,
    Origzone : integer;
    unsent,priv,local,received : boolean;


Function time : string;
(*********************)
var item : string[30];
    hour,minute,second,sec100 : word;
    h,m : string[2];
begin
  gettime(hour,minute,second,sec100);
  str(minute:0,m);
  if length(m) < 2 then m := '0' + m;
  str(hour:0,h);
  if length(h) < 2 then h := '0' + h;
  item := h + ':' + m;
  time := item;
end;

Function date : string;
(*********************)
var item : string[30];
    var Year, Month, Day, DayOfWeek: Word;
    d,m : string[2];
    y : string[4];
begin
  getdate(Year,month,day,dayofweek);
  str(month:0,m);
  if length(m) < 2 then m := '0' + m;
  str(day:0,d);
  if length(d) < 2 then d := '0' + d;
  str(year,y);
  y[2] := Y[4];
  y[1] := y[3];
  y[0] := chr(2);
  item := m + '-' + d + '-' + y;
  date := item;
end;


begin

 { Détection des arguments }

 if paramcount = 0 then begin
     Writeln('CastlePost Version 1.0b FREEWARE By David Robert');
     Writeln('(C)1995 Castle BBS Corp. - All Rights Reserved');
     Writeln('CSTLPOST <Options>');
     Writeln;
     Writeln('Options:');
     Writeln('========');
     Writeln('/R<Fichier texte>                        - Fichier texte a poster');
     Writeln('/O<Adresse d''origine>                    - Adresse d''origine du message');
     Writeln('/D<Adresse de destination>               - Adresse de destination');
     Writeln('/F<Nom d''expediteur>                     - Nom de l''expéditeur espacé par ''_''');
     Writeln('/T<Nom du destinataire>                  - Nom du destinateur espacé par ''_''');
     Writeln('/S<Sujet>                                - Sujet espacé par ''_''');
     Writeln('/M<U|L|R|P>                              - Attibuts');
     Writeln('/P<Path Hudson>                          - Le répertoire de la base HUDSON');
     Writeln('/B<Board>                                - Numéro de Board de la conférence');
     Writeln;
     Writeln('Attributs de message');
     Writeln('====================');
     Writeln('U : Unsent');
     Writeln('L : Local');
     Writeln('R : Received');
     Writeln('P : Private');
Halt;
end;

    Writeln('CSTLPOST 1.0b Poste le message...');

For I := 1 to Paramcount do      {Décodage de la ligne de commande }
 begin
  item := paramstr(I);
  if item[1] = '/' then begin
   option := item[2];
   case upcase(option) of
     'R' : begin
             f_name := '';
             For J := 3 to length(item) do
             begin
             f_name := f_name + item[J];      { Fichier Texte }
             end;
            end;

     'O' : begin
             J := 3;
             node := '';
            Repeat
             node := node + Item[J];           { Adresse d'origine }
             inc(J);
            until Item[J] = ':';
             val(node,origzone,erreur);
             inc(J);
             node := '';
            Repeat
             node := node + Item[J];
             inc(J);
            until Item[J] = '/';
             val(node,orignet,erreur);
             inc(J);
             node := '';
            Repeat
             node := node + Item[J];
             inc(J);
            until J = length(item)+1;
             val(node,orignode,erreur);
           end;

     'D' : begin
             J := 3;
             node := '';
            Repeat
             node := node + Item[J];           { Adresse d'origine }
             inc(J);
            until Item[J] = ':';
             val(node,destzone,erreur);
             inc(J);
             node := '';
            Repeat
             node := node + Item[J];
             inc(J);
            until Item[J] = '/';
             val(node,destnet,erreur);
             inc(J);
             node := '';
            Repeat
             node := node + Item[J];
             inc(J);
            until J = length(item)+1;
             val(node,destnode,erreur);
           end;

     'F' : Begin
              From := '';
              For J := 3 to length(item) do
              begin
               if item[J] = '_' then item[J] := ' ';
               from := from + item[J];
              end;
            end;

     'T' : Begin
              too := '';
              For J := 3 to length(item) do
              begin
               if item[J] = '_' then item[J] := ' ';
               too := too + item[J];
              end;
           end;

     'S' : Begin
              subj := '';
              For J := 3 to length(item) do
              begin
               if item[J] = '_' then item[J] := ' ';
               subj := subj + item[J];
              end;
           end;

     'M' : Begin
             For J := 3 to length(item) do
             begin
               case item[J] of
                 'P' : Priv := true;
                 'L' : local := true;
                 'U' : unsent := true;
                 'R' : received := true;
               end;
              attr := ord(priv)*8+ord(received)*16+ord(unsent)*32+ord(local)*64;
             end;
           end;

     'P' : begin
             For J := 3 to length(item) do
             begin
             path := path + item[J];
             end;
            end;

     'B' : begin
            node := '';
            For J := 3 to length(item) do
             begin
             node := node + item[J];
             end;
             val(node,board,erreur);
            end;
         end;
     end;
   end;

   { Ouverture du fichier Texte }

 Assign(answer,f_name);
 {$I-} reset(answer); {$I+}
 if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: ',f_name);
   halt;
  end;

   { Conversion du format .TXT au format MSGTXT }
   { C'est ca qui prend du temps... }
   { A voir pour une version plus rapide...}

 I := 0;
 J := 30;

 tampon := #1+'PID: CSTLPOST 1.0b FREEWARE'+#13+#10;

 For compteur := 0 to filesize(answer)-1 do
   begin
     inc(J);
     seek(answer,compteur);
     read(answer,caractere);
     tampon[J] := caractere;
     if J = 255 then
     begin
       tampon[0] := chr(255);
       txt_record[I] := tampon;
       J := 0;
       inc(I);
     end;
   end;
   if J > 0 then
    begin
      tampon[0] :=chr(J);
      txt_record[I] := tampon;
    end;
  close(answer);
  total_a := I+1;


  { MISE A JOUR DU FICHIER MSGINFO.BBS }

  Assign(fich_info,path + 'msginfo.bbs');  {msginfo.bbs}
{$I-}  reset(fich_info); {$I+}
if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: MSGINFO.BBS');
   halt;
  end;

  read(fich_info,info);
  seek(fich_info,0);
  info.highmsg := info.highmsg + 1;
  info.totalactive := info.totalactive + 1;
  info.activemsgs[board] := info.activemsgs[board] + 1;
  write(fich_info,info);
  close(fich_info);

 { MISE A JOUR DU FICHIER MSGHDR.BBS }

  Assign(fichier,path + 'msghdr.bbs');   {msghdr.bbs}
{$I-}  reset(fichier); {I+}
if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: MSGHDR.BBS');
   halt;
  end;

  seek(fichier,filesize(fichier)-1);
  read(fichier,hdr);
  seek(fichier,filesize(fichier));
  hdr.MsgNum := info.highmsg;
  hdr.ReplyTo := 0;
  hdr.SeeAlsoNum := 0;
  hdr.TimesRead := 0;   { Not used}
  hdr.StartRec := hdr.startrec + hdr.Numrecs;
  hdr.NumRecs := Total_a;
  hdr.DestNet := destnet;
  hdr.DestNode := destnode;
  hdr.OrigNet := orignet;
  hdr.OrigNode := orignode;
  hdr.Destzone := destzone;
  hdr.Origzone := origzone;
  hdr.Cost := 0;
  hdr.MsgAttr := attr;
  hdr.Netattr := 0;
  hdr.Board := board;
  hdr.PostTime := time;
  hdr.PostDate := date;
  hdr.WhoTo := too;
  hdr.WhoFrom := from;
  hdr.Subj := subj;
  Write(fichier,hdr);
  close(fichier);

  { MISE A JOUR DU FICHIER MSGIDX.BBS }

  Assign(fich_idx,path + 'msgidx.bbs'); {msgidx.bbs}
 {I-}  reset(fich_idx); {I+}
 if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: MSGIDX.BBS');
   halt;
  end;

  seek(fich_idx,filesize(fich_idx));
  idx.msgnum := hdr.msgnum;
  idx.board := hdr.board;
  write(fich_idx,idx);
  close(fich_idx);

  { MISE A JOUR DU FICHIER MSGTXT.BBS }

  Assign(fich_txt,path +'msgtxt.bbs');  {msgtxt.bbs}
{$I-}  reset(fich_txt); {I+}
if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: MSGTXT.BBS');
   halt;
  end;

  seek(fich_txt,filesize(fich_txt));
    For I := 0 to total_a-1 do
  begin
    txt := txt_record[I];
    write(fich_txt,txt);
  end;
  close(fich_txt);

  { MISE A JOUR DU FICHIER MSGTOIDX.BBS }

  Assign(fich,path + 'msgtoidx.bbs');   {msgtoidx.bbs}
 {$I-} reset(fich); {$I+}
 if ioresult <> 0 then
  begin
   Writeln('Impossible d''ouvrir le fichier: MSGTOIDX.BBS');
   halt;
  end;

  seek(fich,filesize(fich));
  txt2 := too;
  write(fich,txt2);
  close(fich);

end.

syntax highlighted by Code2HTML, v. 0.9.1