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