Program Config_multiboard;
(************************)
{ Ce programme permettra de configurer le logiciel MultiBoard 1.0b }
{ Il agiera sur un fichier record en pascal jusqu'a 20 systèmes. }
uses crt,dos;
{$I image.pas}
{$I fenetre.pas }
{$I normal.pas } { Dessins de toute l'interface utilisateur }
{$I sysdata.pas } { Merci TheDraw :-}
{$I cachedat.pas }
{$I Boarddat.pas }
{$I effacebo.pas }
{$I efface.pas }
{$I cache.pas } { Cache le menu de l'editeur de board }
Type
Une_Selection = (Top,System_Data,Board_Manager,info,dosshell,quit,end_sel);
commentaire = string[55];
scom = string [30];
Mboard = Record
bbsname : scom;
comBBS1,comBBS2,comBBS3 : commentaire;
Loc : scom;
sysopname : scom;
nbr_sys : byte;
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;
passagree : array[1..20] of boolean;
nbr_es : array[1..20] of byte;
end;
var
Selection,Last_sel : Une_Selection;
Touche : char;
good_bye : boolean;
config : mboard;
fichier : file of mboard;
Procedure Curs_off; assembler;
ASM
MOV AH,01
MOV CX,1812H
INT 10H
end;
Procedure Curs_on; assembler;
ASM
MOV AH,01
MOV CX,0607H
INT 10H
end;
procedure print(x,y:byte;stt:string); {affiche les caractères direct video }
(************************************)
var q:byte;
begin
for q:= 1 to length(stt) do mem[$b800:(x+y*80+q-1)*2]:=ord(stt[q]);
end;
procedure print2(x,y:byte;stt:string); { affiche attribus direct video }
(************************************)
var q:byte;
begin
for q:= 1 to length(stt) do mem[$b800:(x+1+y*80+q-2)*2+1]:=ord(stt[q]);
end;
Procedure affiche_menu_principal;
(*******************************)
Type ScreenType = array[0..3999] of byte;
var screen : ScreenType absolute $B800:0000;
begin
move(imagedata,screen,4000);
end;
Procedure Erreur(error_message:string);
begin
writeln(error_message);
Repeat until keypressed;
readkey;
end;
Procedure init_config;
(********************)
Var I : byte;
begin
config.bbsname := '';
config.comBBS1 := '';
config.comBBS2 := '';
config.comBBS3 := '';
config.Loc := '';
config.sysopname := '';
config.nbr_sys := 0;
For I := 1 to 20 do
begin
config.board_name[I] := '';
config.errorl[I] := 100+I;
config.comb1[I] := '';
config.comb2[I] := '';
config.comb3[I] := '';
config.pass[I] := '';
config.passagree[I] := false;
config.nbr_es[I] := 3;
end;
end;
Procedure ecris_config; forward;
Procedure demande_creation;
begin
Writeln('Press space key to create one');
repeat
repeat until keypressed;
touche := readkey;
until touche = chr(32);
init_config;
ecris_config;
writeln('Fichier MBOARD.CFG créé !');
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 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_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 shell; { sort momentanément sous dos }
(**************)
Begin
SwapVectors;
Exec(GetEnv('COMSPEC'),'');
SwapVectors;
End;
Procedure affiche_information;
(****************************)
type ScreenType = array [0..3999] of Byte;
var Screen : ScreenType absolute $B800:0000;
X,Offset : Integer;
begin
Offset := 170;
for X := 0 to fenetre_DEPTH-1 do
Move (fenetre[1+X*fenetre_WIDTH*2],
Screen[X*160+Offset],fenetre_WIDTH*2);
repeat until keypressed;
Offset := 170;
for X := 0 to normal_DEPTH-1 do
Move (normal[1+X*normal_WIDTH*2],
Screen[X*160+Offset],normal_WIDTH*2);
readkey;
end;
Function INTSTR(val : longint;isize : byte) : string;
(***************************************************)
var
ist : string;
begin {* fIntStr *}
Str(val:isize,ist);
IntStr := ist
end; {* fIntStr *}
Function intval(s:scom) : byte;
(*****************************)
var variable : byte;
code : integer;
begin
val(S,variable,code);
intval := variable;
end;
Procedure yes_no(item : boolean;x,y:word;var new_val:boolean);
(************************************************************)
Begin
Case item of
True: begin
new_val := false;
print(x,y,'No ');
end;
False: begin
new_val := true;
print(x,y,'Yes');
end;
end;
end;
Procedure asksmall(item: scom;x,y,lengt:word;var new_val : byte);
(***************************************************************)
var
xdep,ydep : integer;
quit,save : boolean;
n_val : string[3];
begin
curs_on;
new_val := intval(item);
n_val := intstr(new_val,0);
gotoxy(x+lengt+1,y+1);
xdep := x+lengt+1;
ydep := y+1;
print(x,y,'øøø');
print2(x,y,#33#33#33);
print(x,y,item);
save := false;
quit := false;
repeat
repeat until keypressed;
touche := readkey;
case touche of
chr(8) : begin if xdep > 21 then begin xdep := xdep - 1;
print(xdep-1,ydep-1,'ø');
gotoxy(xdep,ydep);delete(n_val,length(n_val),1);
end; end;
chr(13) : begin quit := true; save := true; end;
chr(27) : quit :=true;
else begin
if xdep < 24 then begin
print(xdep-1,ydep-1,touche);
xdep := xdep+1;
gotoxy(xdep,ydep); n_val := n_val + touche end;
end;
end;
until quit;
curs_off;
If not save then new_val := intval(item) else new_val := intval(n_val);
print(x,y,' ');
print2(x,y,#3#3#3);
print(x,y,n_val); touche := ' ';
end;
Procedure ask(item: scom;x,y,lengt:word;var new_val : scom);
(**********************************************************)
var
xdep,ydep : integer;
quit,save : boolean;
begin
curs_on;
new_val := item;
gotoxy(x+lengt+1,y+1);
xdep := x+lengt+1;
ydep := y+1;
print(x,y,'øøøøøøøøøøøøøøøøøøøøøøøøøøøøøø');
print2(x,y,#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33 +
#33#33#33#33#33#33#33#33#33);
print(x,y,item);
save := false;
quit := false;
repeat
repeat until keypressed;
touche := readkey;
case touche of
chr(8) : begin if xdep > 21 then begin xdep := xdep - 1;
print(xdep-1,ydep-1,'ø');
gotoxy(xdep,ydep);delete(new_val,length(new_val),1);
end; end;
chr(13) : begin quit := true; save := true; end;
chr(27) : quit :=true;
else begin
if xdep < 51 then begin
print(xdep-1,ydep-1,touche);
xdep := xdep+1;
gotoxy(xdep,ydep); new_val := new_val + touche end;
end;
end;
until quit;
curs_off;
If not save then new_val := item;
print(x,y,' ');
print2(x,y,#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3);
print(x,y,new_val); touche := ' ';
end;
Procedure askbig(item: commentaire;x,y,lengt:word;Var new_val : commentaire);
(***************************************************************************)
var
xdep,ydep : integer;
quit,save : boolean;
begin
curs_on;
new_val := item;
gotoxy(x+lengt+1,y+1);
xdep := x+lengt+1;
ydep := y+1;
print(x,y,'øøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøø');
print2(x,y,#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33 +
#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33#33 +
#33#33#33#33#33#33#33#33#33);
print(x,y,item);
quit := false;
save := false;
repeat
repeat until keypressed;
touche := readkey;
case touche of
chr(8) : begin if xdep > 21 then begin xdep := xdep - 1;
print(xdep-1,ydep-1,'ø');
gotoxy(xdep,ydep);
delete(new_val,length(new_val),1);
end; end;
chr(13) : begin quit := true; save := true; end;
chr(27) : quit :=true;
else begin
if xdep < 76 then begin
print(xdep-1,ydep-1,touche);
xdep := xdep+1;
gotoxy(xdep,ydep);new_val := new_val + touche end;
end;
end;
until quit;
curs_off;
If not save then new_val := item;
print(x,y,' ');
print2(x,y,#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3 +
#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3#3);
print(x,y,new_val); touche := ' ';
end;
Procedure configuration_du_systeme;
(*********************************)
type ScreenType = array [0..3999] of Byte;
sys_Selection = (top,bbs_name,com_1,com_2,com_3,loc,sysop_name,end_sel);
var Screen : ScreenType absolute $B800:0000;
X,Offset : Integer;
selec,last_sel_sys : sys_selection;
begin
Offset := 1450; {Replace ??? with offset to display block}
for X := 0 to sysdATA_DEPTH-1 do
Move (sysData[1+X*sysDATA_WIDTH*2],
Screen[X*160+Offset],sysDATA_WIDTH*2);
print(20,11,config.bbsname);
print(20,12,config.combbs1);
print(20,13,config.combbs2);
print(20,14,config.combbs3);
print(20,15,config.loc);
print(20,16,config.sysopname);
selec := bbs_name;
print(0,24,'Name of your BBS or your system... ');
(* Fin de l'affichage du menu contextuel *)
repeat
repeat
until keypressed;
touche := readkey;
if touche = chr(80) then begin last_sel_sys := Selec;
Selec := Succ(Selec); end;
if touche = chr(72) then begin Last_sel_sys := Selec;
Selec := Pred(Selec); end;
if selec = end_sel then selec := bbs_name;
if selec = top then selec := sysop_name;
if touche = chr(13) then
begin
Case Selec of
BBS_name : begin ask(config.bbsname,20,11,length(config.bbsname),config.bbsname); end;
com_1 : begin askbig(config.comBBS1,20,12,length(config.combbs1),config.combbs1);end;
com_2 : begin askbig(config.comBBS2,20,13,length(config.combbs2),config.combbs2);end;
com_3 : begin askbig(config.comBBS3,20,14,length(config.combbs3),config.combbs3);end;
loc : begin ask(config.loc,20,15,length(config.loc),config.loc);end;
sysop_name: begin ask(config.sysopname,20,16,length(config.sysopname),config.sysopname);end;
end;
end;
Case Selec of
BBS_name : begin print2(7,11,'qqqqqqqqqq');
print(0,24,'Name of your BBS or your system... ');end;
Com_1 : begin print2(7,12,'qqqqqqqqqq');
print(0,24,'Comment line one. ');end;
Com_2 : begin print2(7,13,'qqqqqqqqqq');
print(0,24,'Second comment line. ');end;
Com_3 : begin print2(7,14,'qqqqqqqqqq');
print(0,24,'Third comment line. ');end;
Loc : begin print2(7,15,'qqqqqqqqqq');
print(0,24,'Location of your system. ');end;
sysop_name : begin print2(7,16,'qqqqqqqqqq');
print(0,24,'Name of the Sysop. ');end;
end;
Case last_sel_sys of
BBS_Name : print2(7,11,#7#7#7#7#7#7#7#7#7#7);
com_1 : print2(7,12,#7#7#7#7#7#7#7#7#7#7);
com_2 : print2(7,13,#7#7#7#7#7#7#7#7#7#7);
com_3 : print2(7,14,#7#7#7#7#7#7#7#7#7#7);
loc : print2(7,15,#7#7#7#7#7#7#7#7#7#7);
sysop_name : print2(7,16,#7#7#7#7#7#7#7#7#7#7);
end;
until touche = chr(27);
offset := 1450;
for X := 0 to cacheDATA_DEPTH-1 do
Move (cacheData[1+X*cacheDATA_WIDTH*2],
Screen[X*160+Offset],cacheDATA_WIDTH*2);
end;
Procedure cache_editb;
(*********************)
type ScreenType = array [0..3999] of Byte;
var Screen : ScreenType absolute $B800:0000;
X,Offset : Integer;
begin
Offset := 1774;
for X := 0 to cache_DEPTH-1 do
Move (cache[1+X*cache_WIDTH*2],
Screen[X*160+Offset],cache_WIDTH*2);
end;
Procedure efface_board;
(*********************)
type ScreenType = array [0..3999] of Byte;
var Screen : ScreenType absolute $B800:0000;
X,Offset : Integer;
begin
Offset := 1800;
for X := 0 to efface_DEPTH-1 do
Move (efface[1+X*efface_WIDTH*2],
Screen[X*160+Offset],efface_WIDTH*2);
end;
Procedure edit_board(num: byte;new : boolean);
(********************************************)
type
sys_Selection = (top,board_name,com_1,com_2,com_3,priv,password,retries,errorlevel,end_sel);
var
selec,last_sel_sys : sys_selection;
com2 : string[2];
com : string[20];
begin
str(config.nbr_sys,com);
str(num,com2);
com := ' Editing ';
if new then print(6,9,' New Entry ') else print(6,9,com);
print2(6,9,#30#30#30#30#30#30#30#30#30#30#30);
print2(7,11,'qqqqqqqqqqqq');
selec := board_name;
print(0,24,'Name of the boad ');
if new then efface_board;
print(20,11,config.board_name[num]);
print(20,12,config.comb1[num]);
print(20,13,config.comb2[num]);
print(20,14,config.comb3[num]);
if config.passagree[num] then print(20,15,'Yes')
else print(20,15,'No');
print(20,16,config.pass[num]);
str(config.nbr_es[num],com);
print(20,17,com);
str(config.errorl[num],com);
print(20,18,com);
repeat
repeat
until keypressed;
touche := readkey;
if touche = chr(80) then begin last_sel_sys := Selec;
Selec := Succ(Selec); end;
if touche = chr(72) then begin Last_sel_sys := Selec;
Selec := Pred(Selec); end;
if selec = end_sel then selec := board_name;
if selec = top then selec := errorlevel;
if touche = chr(13) then begin
Case Selec of
board_name : begin ask(config.board_name[num],20,11,length(config.board_name[num]),config.board_name[num]);
end;
com_1 : begin askbig(config.comB1[num],20,12,length(config.comb1[num]),config.comb1[num]);
end;
com_2 : begin askbig(config.comB2[num],20,13,length(config.comb2[num]),config.comb2[num]);
end;
com_3 : begin askbig(config.comb3[num],20,14,length(config.comb3[num]),config.comb3[num]);
end;
priv : begin yes_no(config.passagree[num],20,15,config.passagree[num]); end;
password: begin ask(config.pass[num],20,16,length(config.pass[num]),config.pass[num]);
end;
retries : begin
asksmall(intstr(config.nbr_es[num],0),20,17,length(intstr(config.nbr_es[num],0)),config.nbr_es[num]);
end;
errorlevel: begin
asksmall(intstr(config.errorl[num],0),20,18,length(intstr(config.errorl[num],0)),config.errorl[num]);
{Pfouuuuu... Ca a été galère a convertir toutes ces conneries de Val et Str }
end;
end;
end;
Case Selec of
board_name : begin print2(7,11,'qqqqqqqqqqqq');
print(0,24,'Name of the boad ');end;
Com_1 : begin print2(7,12,'qqqqqqqqqqqq');
print(0,24,'Comment line one. ');end;
Com_2 : begin print2(7,13,'qqqqqqqqqqqq');
print(0,24,'Second comment line. ');end;
Com_3 : begin print2(7,14,'qqqqqqqqqqqq');
print(0,24,'Third comment line. ');end;
Priv : begin print2(7,15,'qqqqqqqqqqqq');
print(0,24,'Yes if you want a password to be requierd.');end;
password : begin print2(7,16,'qqqqqqqqqqqq');
print(0,24,'Password (usefull only if Private ''Yes'' ');end;
retries : begin print2(7,17,'qqqqqqqqqqqq');
print(0,24,'Number of password retries. ');end;
Errorlevel : begin print2(7,18,'qqqqqqqqqqqq');
print(0,24,'Exit errorlevel number. ');end;
end;
Case last_sel_sys of
Board_Name : print2(7,11,#7#7#7#7#7#7#7#7#7#7#7#7);
com_1 : print2(7,12,#7#7#7#7#7#7#7#7#7#7#7#7);
com_2 : print2(7,13,#7#7#7#7#7#7#7#7#7#7#7#7);
com_3 : print2(7,14,#7#7#7#7#7#7#7#7#7#7#7#7);
priv : print2(7,15,#7#7#7#7#7#7#7#7#7#7#7#7);
password : print2(7,16,#7#7#7#7#7#7#7#7#7#7#7#7);
retries : print2(7,17,#7#7#7#7#7#7#7#7#7#7#7#7);
Errorlevel : print2(7,18,#7#7#7#7#7#7#7#7#7#7#7#7);
end;
until touche = chr(27);
touche := ' ';
if new then inc(config.nbr_sys);
cache_editb;
end;
Procedure configuration_des_boards;
(*********************************)
type screentype = array [0..3999] of Byte;
var Screen : ScreenType absolute $B800:0000;
X,Offset : Integer;
com : string[15];
com2 : string[2];
com3 : string[15];
current,I : byte;
begin
Current := 1; { Numéro de départ pour la fenetre de configuration }
Offset := 1450;
for X := 0 to boarddATA_DEPTH-1 do { Dessin de la fenetre }
Move (boardData[1+X*boardDATA_WIDTH*2],
Screen[X*160+Offset],boardDATA_WIDTH*2);
repeat
begin
If config.nbr_sys = 0 then
begin
print(0,24,'No boards configurated, press ''INS'' to create one.');
if touche = chr(82) then edit_board(1,True);
Offset := 1450;
for X := 0 to boarddATA_DEPTH-1 do { Dessin de la fenetre }
Move (boardData[1+X*boardDATA_WIDTH*2],
Screen[X*160+Offset],boardDATA_WIDTH*2);
end;
if config.nbr_sys > 0 then
begin
str(config.nbr_sys,com);
str(current,com2);
com3 := #30#30#30#30#30#30#30#30#30#30;
com := ' View ' + com2 + '/' + com;
if length(com) < 11 then com := com + ' ' else com3 := com3 + #30;
print(6,9,com);
print2(6,9,com3);
print(20,11,config.board_name[current]);
print(20,12,config.comb1[current]);
print(20,13,config.comb2[current]);
print(20,14,config.comb3[current]);
if config.passagree[current] then print(20,15,'Yes')
else print(20,15,'No');
print(20,16,config.pass[current]);
str(config.nbr_es[current],com);
print(20,17,com);
str(config.errorl[current],com);
print(20,18,com);
end;
end;
Repeat until keypressed;
touche := Readkey;
case touche of
chr(77) : if config.nbr_sys > 0 then begin inc(current); efface_board; end;
chr(75) : if config.nbr_sys > 0 then begin dec(current); efface_board; end;
chr(82) : if config.nbr_sys < 20 then edit_board(config.nbr_sys+1,true);
chr(83) : if config.nbr_sys > 0 then begin { On efface le current et on renomme les autres }
for I := current to config.nbr_sys do
begin
config.board_name[I] := config.board_name[I+1];
config.errorl[I] := config.errorl[I+1];
config.comb1[I] := config.comb1[I+1];
config.comb2[I] := config.comb2[I+1];
config.comb3[I] := config.comb3[I+1];
config.pass[I] := config.pass[I+1];
config.passagree[I] := config.passagree[I+1];
config.nbr_es[I] := config.nbr_es[I+1];
end;
dec(config.nbr_sys);
end;
chr(13) : if config.nbr_sys > 0 then edit_board(current,false);
end;
if current > config.nbr_sys then current := 1;
if current < 1 then current := config.nbr_sys;
until touche = chr(27); {Fin par la touche [ESC] }
Offset := 1450;
for X := 0 to effaceboard_DEPTH-1 do
Move (effaceboard[1+X*effaceboard_WIDTH*2], { Effacement de la fenetre }
Screen[X*160+Offset],effaceboard_WIDTH*2);
end;
{ Programme Principal }
(*********************)
Begin
curs_off;
affiche_menu_principal; { Je crois que c'est clair :-}
Selection := System_data;
charge_config; { Charge le fichier de configuration MBOARD.CFG }
repeat
repeat
until keypressed;
touche := readkey;
if touche = chr(80) then begin last_sel := Selection;
Selection := Succ(Selection); end;
if touche = chr(72) then begin Last_sel := Selection;
Selection := Pred(Selection); end;
if selection = end_sel then selection := system_data;
if selection = top then selection := quit;
if touche = chr(13) then begin
Case Selection of
System_data : begin configuration_du_systeme end;
Board_manager : begin configuration_des_boards end;
Info : begin affiche_information end;
Dosshell : begin shell end;
Quit : good_bye := true;
end;
end;
Case Selection of
System_data : begin print2(33,10,'qqqqqqqqqqqqq');
print(0,24,'Miscellaneous system information ');end;
Board_manager : begin print2(33,11,'qqqqqqqqqqqqq');
print(0,24,'All boards configuration: ErrorLevel, etc.');end;
Info : begin print2(33,12,'qqqqqqqqqqqqq');
print(0,24,'Information about this software... ');end;
Dosshell : begin print2(33,13,'qqqqqqqqqqqqq');
print(0,24,'Shell to DOS... ');end;
Quit : begin print2(33,14,'qqqqqqqqqqqqq');
print(0,24,'Exit Multiboard V1.0 ');end;
end;
Case last_sel of
System_data : print2(33,10,#7#7#7#7#7#7#7#7#7#7#7#7#7);
Board_manager : print2(33,11,#7#7#7#7#7#7#7#7#7#7#7#7#7);
Info : print2(33,12,#7#7#7#7#7#7#7#7#7#7#7#7#7);
Dosshell : print2(33,13,#7#7#7#7#7#7#7#7#7#7#7#7#7);
Quit : print2(33,14,#7#7#7#7#7#7#7#7#7#7#7#7#7);
end;
until good_bye;
ecris_config; {Sauvegarde de la configuration}
Clrscr;
end.
syntax highlighted by Code2HTML, v. 0.9.1