Program MultiBoard_V1_Beta;
{**************************}
uses crt,dos;
Const
basex : byte = 1;
basey : byte = 1;
esc = #27;
Serie = $2E8;
Type
commentaire = string[55]; {Type nécessaires au record 'Mboard!' }
scom = string [30];
Mboard = Record
bbsname : scom;
comBBS1,comBBS2,comBBS3 : commentaire; { Commentaires au début }
Loc : scom;
sysopname : scom;
nbr_sys : byte; { Nombre de boards }
board_name: array[1..20] of scom;
errorl : array[1..20] of byte;
comb1 : array[1..20] of commentaire;
comb2 : array[1..20] of commentaire;
comb3 : array[1..20] of commentaire;
pass : array[1..20] of scom; {Mot de passe }
passagree : array[1..20] of boolean; {Oui ou non (pour le mot de passe)}
nbr_es : array[1..20] of byte; {Nombre d'essaies pour le mot }
end;
Var
Config : Mboard;
fichier : file of mboard;
fich : text;
{ Procédures de communication... }
{ Elles sont pas encore en Lib car version 1.0/Béta }
{ Enfin, il faudra... je pense qd même les mettre en }
{ Lors de la première compilation officielle de la béta }
{***************************************************************************}
Procedure GetChar(inchar : char);
(*******************************)
Begin
Inchar := chr(Port[serie]);
end;
Procedure SENDCHAR(outchar : char);
begin {* SendChar *}
port[Serie] := ord(outchar) { send character }
end; {* SendChar *}
Procedure SENDSTRING2(outstr : string;docr : boolean);
var
sloop : byte;
begin {* SendString *}
for sloop := 1 to length(outstr) do SendChar(outstr[sloop]);
if docr then
begin
SendChar(char($0D)); { send CR }
SendChar(char($0A)); { send LF }
end;
end; {* SendString *}
Procedure SENDSTRING(outstr : string;docr : boolean);
var
sloop : byte;
begin {* SendString *}
write(outstr);
for sloop := 1 to length(outstr) do SendChar(outstr[sloop]);
if docr then
begin
SendChar(char($0D)); { send CR }
SendChar(char($0A)); { send LF }
writeln;
end;
end; {* SendString *}
Procedure Sauteligne;
begin
SendChar(char($0D)); { send CR }
SendChar(char($0A)); { send LF }
writeln;
end;
Function INTSTR(val : longint;isize : byte) : string;
(****************************************************)
var
ist : string;
begin {* fIntStr *}
Str(val:isize,ist);
IntStr := ist
end; {* fIntStr *}
Procedure GOTOPORTXY(x,y : byte);
(********************************)
begin {* GotoPortXY *}
x := x + basex - 1;
y := y + basey - 1;
SendString2(esc+'['+IntStr(y,0)+';'+IntStr(x,0)+'H',false);
gotoxy(x,y);
end; {* GotoPortXY *}
Procedure clearscr;
(****************)
Begin
SendString2(esc+'[2J',false); { Efface l'écran de la remote }
clrscr;
end;
Procedure SETCOLOR(color : byte);
(*******************************)
var col : byte;
begin {* SetColor *}
SendString2(esc+'['+IntStr(color,0)+'m',false);
case color of
30 : col := 0;
31 : col := 4;
32 : col := 2;
33 : col := 14;
34 : col := 1;
35 : col := 5;
36 : col := 3;
37 : col := 15;
end;
textcolor(col);
end; {* SetColor *}
Procedure BACKCOLOR(color: byte);
(********************************)
var col : byte;
begin {* BackColor *}
if color in [30..37] then SendString2(esc+'['+IntStr(color+10,0)+'m',false);
case color of
30 : col := 0;
31 : col := 4;
32 : col := 2;
33 : col := 14;
34 : col := 1;
35 : col := 5;
36 : col := 3;
37 : col := 15;
end;
textbackground(col);
end; {* BackColor *}
{***************************************************************************}
{ Fin des procédures de communication }
{***************************************************************************}
Function str_time : string;
(**************************)
var item : string[20];
hour,minute,second,sec100,year,month,day,dayofweed : word;
h,m,s,y,mo,d : string[2];
begin
gettime(hour,minute,second,sec100);
getdate(year,month,day,dayofweed);
str(day:0,d);
if length(d) < 2 then d := '0' + d;
str(minute:0,m);
if length(m) < 2 then m := '0' + m;
str(month:0,mo);
if length(mo) < 2 then mo := '0' + mo;
str(second:0,s);
if length(s) < 2 then s := '0' + s;
str(hour:0,h);
if length(h) < 2 then h := '0' + h;
item := '> ' + d + '/' + mo + ' ' + h + ':' + m + ':' + s;
str_time := item;
end;
Procedure Erreur(error_message:string);
(*************************************)
begin
writeln(error_message);
Repeat until keypressed;
readkey;
end;
Procedure demande_creation;
(*************************)
begin
end;
Procedure VerifierIO; { Vérifie les erreurs d'E/S }
(*******************)
var
CodesES : integer;
ErreurES : boolean;
begin
CodesES := IOresult;
ErreurES := (CodesES <> 0);
if ErreurES then begin
case CodesES of
$02 : begin Erreur('File not found MBOARD.CFG');
demande_creation;end;
$03 : begin Erreur('File not found MBOARD.CFG');
demande_creation;end;
$04 : begin Erreur('File not open !');halt(1); end;
$10 : begin Erreur('Numeric format error');halt(1);end;
$20 : begin Erreur('Error');halt(1); end;
$21 : begin Erreur('Error');halt(1); end;
$22 : begin Erreur('Error');halt(1); end;
$90 : begin Erreur('Error');halt(1); end;
$91 : begin Erreur('Error');halt(1); end;
$99 : begin Erreur('Error');halt(1); end;
$F0 : begin Erreur('Error');halt(1); end;
$F1 : begin Erreur('Error');halt(1); end;
$F2 : begin Erreur('Error');halt(1); end;
$F3 : begin Erreur('Error');halt(1); end;
$FF : begin Erreur('Error');halt(1); end;
end;
end;
end;
procedure new_log; forward;
Procedure VerifierIO_log; { Vérifie les erreurs d'E/S }
(***********************)
var
CodesES : integer;
ErreurES : boolean;
begin
CodesES := IOresult;
ErreurES := (CodesES <> 0);
if ErreurES then begin
case CodesES of
$02 : new_log;
$03 : new_log;
$04 : begin Erreur('File not open !');halt(1); end;
$10 : begin Erreur('Numeric format error');halt(1);end;
$20 : begin Erreur('Error');halt(1); end;
$21 : begin Erreur('Error');halt(1); end;
$22 : begin Erreur('Error');halt(1); end;
$90 : begin Erreur('Error');halt(1); end;
$91 : begin Erreur('Error');halt(1); end;
$99 : begin Erreur('Error');halt(1); end;
$F0 : begin Erreur('Error');halt(1); end;
$F1 : begin Erreur('Error');halt(1); end;
$F2 : begin Erreur('Error');halt(1); end;
$F3 : begin Erreur('Error');halt(1); end;
$FF : begin Erreur('Error');halt(1); end;
end;
end;
end;
Procedure new_log; { Création du fichier.log }
(****************)
Begin
{$I-}
Assign(fich,'mboard.log');
Rewrite(fich);
verifierio;
writeln(fich,str_time + ' Multiboard 1.0/Béta [REG] log file created');
verifierio;
writeln(fich);
{$I+}
end;
Procedure charge_config; { Chargement du fichier MBOARD.CFG }
(**********************)
begin
{$I-}
Assign(fichier,'mboard.cfg');
reset(fichier);
verifierio;
read(fichier,config);
verifierio;
close(fichier);
verifierio;
{$I+}
end;
Procedure ecris_log(texte : string); { Chargement du fichier MBOARD.CFG }
(**********************************)
begin
{$I-}
Assign(fich,'mboard.log');
append(fich);
verifierio_log;
writeln(fich,texte);
close(fich);
verifierio;
{$I+}
end;
Procedure ecris_config; { Enregistrement de la configuration dans MBOARD.CFG }
(*********************)
Begin
{$I-}
Assign(fichier,'mboard.cfg');
Rewrite(fichier);
verifierio;
write(fichier,config);
verifierio;
close(fichier);
verifierio;
{$I+}
end;
Procedure Time_out;
(*****************)
begin
ecris_log(str_time + ' þ Incativity Timout þ Errorlevel: 1');
halt(1);
end;
Procedure Code(code:scom;nbr:byte;current:byte;nom:scom;var yerORno:boolean);
(***************************************************************************)
Begin { Affichage du cadre }
SetColor(33);
backcolor(34);
GotoPortXY(9,4);
sendstring('ÚŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽ¨',false);
GotoPortXY(9,5);
sendstring('³ ' + nom + ' þ Password Required ³',false);
Setcolor(37);
GotoPortXY(56,5);
sendstring(' #'+intstr(current,0)+'/'+intstr(nbr,0),false);
setcolor(33);
GotoPortXY(67,5);
sendstring('³',false);
GotoPortXY(9,6);
sendstring('³',false);
Setcolor(37);
Sendstring(' Enter The password: øøøøøøøøøøøøøøøøøøøøøøøøøøøøøø',false);
setcolor(33);
Sendstring(' ³',false);
GotoPortXY(9,7);
SendString('ÀŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽÙ',false);
GotoPortXY(32,6);
end;
Function CharWaiting : boolean;
(*****************************)
begin
delay(50);
CharWaiting := ((port[Serie + 5] and $01) = $01);
end;
Procedure affiche_menu;
(*********************)
Var comp : byte;
ligne : array[1..20] of byte;
lig : byte;
deplace : byte;
touche : char;
exit,yorn : boolean;
minute,minute2,second : word;
begin
exit := false;
deplace := 1;
ecris_log(str_time + ' User on line');
gettime(second,minute,second,second);
setcolor(30);backcolor(30);
clearscr;
setcolor(30);backcolor(36);
SendString('MultiBoard V1.0/Beta',false);
setcolor(31);
Sendstring(' REGISTERED To David Robert ',false);
setcolor(30);
Sendstring(' (C) 1995 David Robert',true);
sauteligne;
setcolor(33);backcolor(30);
SendString('Déplacez vous avec les touches ''a'' et ''q'' puis appuyez sur [ENTER]:',true);
sauteligne;
setcolor(30);Backcolor(37);
lig := 4;
For comp := 1 to config.nbr_sys do
begin
sendstring(config.board_name[comp],true);
inc(lig);
ligne[comp] := lig;
if config.comb1[comp] <> '' then
begin
setcolor(35);backcolor(30);
Sendstring(' ['+config.comb1[comp]+']',true);
inc(lig);
end;
if config.comb2[comp] <> '' then
begin
setcolor(35);backcolor(30);
Sendstring(' ['+config.comb2[comp]+']',true);
inc(lig);
end;
if config.comb3[comp] <> '' then
begin
setcolor(35);backcolor(30);
Sendstring(' ['+config.comb3[comp]+']',true);
inc(lig);
end;
setcolor(37);backcolor(30);
end;
sauteligne;
setcolor(30);backcolor(36);
sendstring(' logiciel en test, merci de me reporter toute anomalie que vous remarquerez ',false);
{ Fin de l'affichage }
Repeat
if CharWaiting then begin
GetChar(Touche);
if touche = esc then
if Charwaiting then begin
GetChar(Touche); if touche = '[' then if CharWaiting then begin
GetChar(Touche);
if touche = 'A' then begin
setcolor(37);backcolor(30);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
dec(deplace); if deplace = 0 then deplace := config.nbr_sys;
setcolor(30);Backcolor(37);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
end;
if touche = 'B' then begin
setcolor(37);backcolor(30);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
inc(deplace); if deplace = config.nbr_sys+1 then deplace := 1;
setcolor(30);Backcolor(37);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
end;
if touche = chr(13) then begin
ecris_log(str_time+' Escape at errorlevel: '+intstr(config.errorl[deplace],0)
+ ' => ' + config.board_name[deplace]);
{if config.passagree[deplace] then begin
code(config.pass[deplace],config.nbr_es[deplace],1,config.board_name[deplace],YorN);
readln;
end;}
setcolor(37);backcolor(30);
clearscr;
gotoportxy(1,1);
sendstring2('Loading board: [' + config.board_name[deplace] + '] please wait...',false);
writeln('Escape at errorlevel: ',config.errorl[deplace]);
exit := true;
halt(config.errorl[deplace]);
end;
end;
end;
end
else begin
if Keypressed then begin
touche := ReadKey;
if touche = chr(72) then begin
setcolor(37);backcolor(30);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
dec(deplace); if deplace = 0 then deplace := config.nbr_sys;
setcolor(30);Backcolor(37);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
end;
if touche = chr(80) then begin
setcolor(37);backcolor(30);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
inc(deplace); if deplace = config.nbr_sys+1 then deplace := 1;
setcolor(30);Backcolor(37);
gotoportxy(1,ligne[deplace]);
sendstring(config.board_name[deplace],false);
end;
if touche = chr(13) then begin
ecris_log(str_time + ' Escape at errorlevel: ' + intstr(config.errorl[deplace],0)
+ ' => ' + config.board_name[deplace]);
{if config.passagree[deplace] then begin
code(config.pass[deplace],config.nbr_es[deplace],1,config.board_name[deplace],YorN);
readln;
end;}
setcolor(37);backcolor(30);
clearscr;
gotoportxy(1,1);
sendstring2('Loading board: [' + config.board_name[deplace] + '] please wait...',false);
writeln('Escape at errorlevel: ',config.errorl[deplace]);
exit := true;
halt(config.errorl[deplace]);
end;
end;
end;
Until exit;
end;
Procedure affiche_presentation;
(*****************************)
Begin
ClrScr;
textcolor(14);
Writeln('MultiBoard 1.0/Beta — Registered to David Robert');
Textcolor(lightCyan);
Writeln('Copyright (C) 1995 David Robert. All Rights Reserved.');
writeln;
textcolor(7);
writeln('Usage: Multib <port>');
writeln;
writeln('<port> Witch serial port your modem is set on.');
end;
begin
Charge_config; { Charge le fichier de configuration mboard.cfg }
{ Pour le moment, pour le programme d'essaie, on va dire qu'il y a }
{ aucuns problème: fichier existe, io ok, enfin tout ce passe bien :-}
{ m'enfin ca commence a prendre forme :-))))))))))))))))))) }
{ Mais heu ! Il est jamais content ce David, ce programme sera }
{ bientot sur tous les bons BBS ! MAIS HEU !! }
affiche_menu; { Envoie la procédure de l'affichage menu }
end.
{ car := true;
gettime(second,minute2,second,second);
if minute2 - minute > 2 then time_out;
until car or keypressed;
if car then touche := chr(port[Serie]);
if keypressed then touche := readkey;
if car then begin}
syntax highlighted by Code2HTML, v. 0.9.1