home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / powrdoor / powrsys.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-09-26  |  18.0 KB  |  535 lines
  1. {$N-,V-,B-,S-,R-,D-}
  2.  
  3. (*----------------------------------------------------------------------*)
  4. (* Program: PowrSYS - SysOp Menu for PowerBBS by Russell Frey           *)
  5. (*                                                                      *)
  6. (* Date: September 26, 1991                                             *)
  7. (*                                                                      *)
  8. (* Source code to the PowerBBS SysOp's Menu in PowerDOOR format.        *)
  9. (* Update this program, and you can replace the standard PowrSys.EXE    *)
  10. (*                                                                      *)
  11. (* You are free to modify and distribute under the Shareware or         *)
  12. (* public domain format, but you MAY NOT distribute any program         *)
  13. (* any other way.  Refer to PowrDoor.DOC for more information.          *)
  14. (*----------------------------------------------------------------------*)
  15. (* There are many modifications that can be done to improve this source *)
  16. (* code.  So have fun modifying and learning PowrDOOR!                  *)
  17. (*----------------------------------------------------------------------*)
  18. (* If you have modifications to this file, that you would like to       *)
  19. (* distribute, please upload it to the support bbs.                     *)
  20. (*----------------------------------------------------------------------*)
  21.  
  22. Program PowerBBS_SysOp_Menu_Door;
  23.  
  24. uses windos,winprocs,strings,powrwin,powrdoor;
  25.  
  26. type
  27.    char2 = array [1..2] of char;
  28.  
  29.    powr_caller_rec = record
  30.       message:        array[1..75] of char;
  31.       crlf:           char2;
  32.    end;
  33.  
  34. var
  35.    UserTemp: PowrUser;
  36.    powr_caller:    powr_caller_rec;
  37.  
  38.    K,N,KK,MM : Integer;
  39.    L : String;
  40.  
  41.    i:   integer;
  42.    ofd:        text;
  43.    Pass : Boolean;
  44.    Temp42 : String;
  45.    R : Integer;
  46.  
  47.    Temps5: String;
  48.  
  49. (* -------------------------------------------------------------------- *)
  50. Function Show_Boolean(TrueFalse : Boolean) : String;
  51.  
  52. Begin
  53.  if Truefalse then Show_Boolean := 'Yes'
  54.               else Show_Boolean := 'No ';
  55. End;
  56.  
  57. (* -------------------------------------------------------------------- *)
  58. Procedure DisplayUpdate(Start1:   String;
  59.                          Info1:    String;
  60.                          Answer1:  String;
  61.                          Start2:   String;
  62.                          Info2:    String;
  63.                          Answer2:  String);
  64. Var
  65.  Tempstring1: String;
  66.  
  67. Begin
  68.  write_com(SENDWHITE);
  69.  write_com(' '+Start1+' ');
  70.  write_com(SENDCYAN);
  71.  write_com(Info1);
  72.  write_com(': ');
  73.  Tempstring1 := Answer1;
  74.  delete_after_spaces(Tempstring1);
  75.  write_com(SENDGREEN+Tempstring1);
  76.  writeln_com_spaces(36-(Length(Info1)+Length(Tempstring1)));
  77.  write_com(SENDWHITE+Start2+' ');
  78.  write_com(SENDCYAN);
  79.  write_com(Info2);
  80.  write_com(': ');
  81.  Tempstring1 := Answer2;
  82.  delete_after_spaces(Tempstring1);
  83.  write_com(SENDGREEN+Tempstring1);
  84.  writelncom;
  85. End;
  86.  
  87. (* -------------------------------------------------------------------- *)
  88. Procedure Get_Input(MaxStr : Integer;
  89.                     Question : String);
  90.  
  91. Begin
  92.  Repeat
  93.   writelncom;
  94.   Pass := True;
  95.   R := Length(Question) - 1;
  96.   writeln_com_border(R,Maxstr);
  97.   write_com(SENDGREEN+Question);
  98.   ask_user(Temp42,MaxStr);
  99.   upper_string(temp42);
  100.   delete_after_spaces(Temp42);
  101.   if Length(Temp42) < 1 then Pass := False;
  102.   if Pass = False then Begin
  103.                          writelncom;
  104.                          writeln_com(SENDYELLOW +'Invalid Response! Try Again. ');
  105.                        End;
  106.  Until (Pass = True) Or (drop_carrier);
  107.  writelncom;
  108. End;
  109.  
  110. (* -------------------------------------------------------------------- *)
  111. Procedure New_Birthday;
  112.  
  113. Var
  114.   Birth_Date: String;
  115.  
  116. Begin
  117.   writelncom;
  118.   write_com(SENDYELLOW+' Enter the date you were born ['+SENDWHITE+'MM-DD-YY'+
  119.        SENDYELLOW+']: ');
  120.   Get_Date(Birth_Date,False,'');
  121.   put_chars_into(UserTemp.Birthday,Birth_Date,Sizeof(UserTemp.Birthday));
  122. End;
  123.  
  124. (* -------------------------------------------------------------------- *)
  125. procedure mode_toggle;
  126.  
  127. Var
  128.   Temp724 : String;
  129.  
  130. begin
  131.   writelncom;
  132.   write_com(SENDYELLOW+'Monitor type: ['+SENDWHITE+'C'+SENDYELLOW+']olor, ['+SENDWHITE+
  133.        'M'+SENDYELLOW+']onochrome, or ['+SENDWHITE+'N'+SENDYELLOW+']one');
  134.   if GetInput(True,Temp724,1) then Exit;
  135.   if Temp724 = 'C' then
  136.                          UserTemp.Monitor_Type := 'C'
  137.  
  138. else if Temp724 = 'M' then
  139.                          UserTemp.Monitor_Type := 'M'
  140.                       else
  141.                          UserTemp.Monitor_Type := 'N';
  142. End;
  143.  
  144. (* -------------------------------------------------------------------- *)
  145. Procedure New_Password;
  146.  
  147. Var temp999 : STRING;
  148. Begin
  149.  Repeat
  150.   writelncom;
  151.   Get_Input(10,' Password (One word please!): ');
  152.   temp999 := Temp42;
  153.   Get_Input(10,'  Re-enter password to check: ');
  154.   if temp999 <> Temp42 then Begin
  155.                              writelncom;
  156.                              writeln_com(SENDYELLOW+' Password do not match ! ');
  157.                             End;
  158.  Until drop_carrier Or (temp999 = Temp42);
  159.   put_chars_into(UserTemp.Password,Temp42,sizeof(UserTemp.Password));
  160. End;
  161.  
  162. (* -------------------------------------------------------------------- *)
  163. Procedure New_VoicePhone;
  164.  
  165. Begin
  166.   writelncom;
  167.   write_com(SENDYELLOW+'Enter your HOME Phone # [XXX-XXX-XXXX]: ');
  168.   Get_A_Input('(###) ###-####',Temp42,False,'');
  169.   put_chars_into(UserTemp.Phone_Number,Temp42,sizeof(UserTemp.Phone_Number));
  170. End;
  171.  
  172. (* -------------------------------------------------------------------- *)
  173. Procedure New_City;
  174.  
  175. Begin
  176.   writelncom;
  177.   Get_Input(20,' City and State calling From? ');
  178.   put_chars_into(UserTemp.Location,temp42,sizeof(UserTemp.Location));
  179. End;
  180.  
  181. (* -------------------------------------------------------------------- *)
  182. Procedure New_Computer;
  183.  
  184. Begin
  185.   writelncom;
  186.   Get_Input(15,'    What is your Computer type? ');
  187.   put_chars_into(UserTemp.Computer,Temp42,sizeof(UserTemp.Computer));
  188. End;
  189.  
  190. (* -------------------------------------------------------------------- *)
  191. Procedure Set_Page;
  192.  
  193. Var
  194.   Temp25: String;
  195.   Halt: Boolean;
  196.  
  197. Begin
  198.   Halt := False;
  199.   temp25 := '';
  200.   writelncom;
  201.   write_com(SENDYELLOW+'Enter '+SENDWHITE+'PAGE Length'+SENDYELLOW+' ['+SENDWHITE+
  202.        'ENTER'+SENDYELLOW+'='+int_to_asc(UserTemp.Screen_lines)+']: ');
  203.   ask_user(TEMP25,2);
  204.   upper_string(TEMP25);
  205.   if temp25 = '' then Halt := True;
  206.   if Halt = False then UserTemp.Screen_lines := asc_to_int(TEMP25);
  207.   writelncom;
  208. End;
  209.  
  210.  
  211. (* -------------------------------------------------------------------- *)
  212. Procedure Sysop_SB;
  213.  
  214. Var
  215.   User_File: file_handle;
  216.   Num_users: LongInt;
  217.   Tempi6,Tempi7: Integer;
  218.  
  219. Begin
  220.    User_File := Open_File(UserFile_Path,2);
  221.    num_users := (seek_file(User_File,0,2) div sizeof(UserTemp))-1;
  222.    seek_file(user_file,0,0);
  223.    tempi6 := -1;
  224.    repeat
  225.       inc(tempi6);
  226.       Tempi7 := read_file(User_File,UserTemp,Sizeof(UserTemp));
  227.       writeln_com(SENDWHITE+rjust(int_to_asc(Tempi6+1),4)+'. '+SENDGREEN+UserTemp.Last_Call+
  228.               ' '+SENDYELLOW+UserTemp.Name+' '+SENDRED+UserTemp.Location+' '+SENDCYAN+
  229.               UserTemp.Last_Time+SENDWHITE+' '+rjust(UserTemp.Last_Time,3)+' Min');
  230.    until (tempi6 >= num_users) or (user_abort) or (drop_carrier);
  231.    close_file(User_File);
  232.    get_a_return;
  233. End;
  234.  
  235. (* -------------------------------------------------------------------- *)
  236. procedure display_activitylog(todisplay: string);
  237. var
  238.  Caller_FH:  file_handle;
  239.  tempi6, tempi7: longint;
  240.  temps1: string;
  241.  
  242. begin
  243.    Caller_FH := Open_File(todisplay,2);
  244.    tempi6 := seek_file(Caller_FH,0,2);
  245.    tempi6 := (tempi6 div sizeof(powr_caller))-1;
  246.    close_file(caller_FH);
  247.    caller_FH := Open_File(todisplay,2);
  248.    repeat
  249.      seek_file(caller_FH,tempi6*sizeof(powr_caller),0);
  250.      Tempi7 := read_file(Caller_FH,powr_caller,Sizeof(powr_caller));
  251.      temps1 := powr_caller.Message;
  252.      delete_after_spaces(temps1);
  253.      writeln_com(temps1);
  254.      dec(tempi6);
  255.    until (user_abort) or (drop_carrier) or (tempi6 < 1);
  256.    close_file(Caller_FH);
  257.    get_a_return;
  258. end;
  259.  
  260. (* -------------------------------------------------------------------- *)
  261. Procedure View_Caller;
  262. Var
  263.  temps1,tempactlog:   string;
  264.  
  265.  Begin
  266.    tempactlog := copy(CallerLog,1,length(CallerLog)-1);
  267.    writeln_com_node_status;
  268.    writelncom;
  269.    write_com('Enter Node # to view Actlog');
  270.    if getinput(false,temps1,2) then exit;
  271.    tempactlog := tempactlog + temps1;
  272.    if Not file_exists(tempactlog) then exit;
  273.    display_activitylog(tempactlog);
  274. End;
  275.  
  276. (* -------------------------------------------------------------------- *)
  277. Procedure Update_Conferences;
  278.  
  279. Var
  280.   Tempi10: Integer;
  281.   Temps11: String;
  282.  
  283. Begin
  284.   writelncom;
  285.    writeln_com(' Enter * for forums to give access, or [Enter] for no change.');
  286.    writeln_com('        0.........1.........2.........3.........4.........');
  287.    writeln_com_spaces(8);
  288.    For Tempi10 := 0 to 49 do
  289.     if bit_from_byte(UserTemp.Forum_Data[tempi10].Options,1) then
  290.       write_com('*')
  291.     else
  292.       write_com(' ');
  293.    writelncom;
  294.      write_com('Access= ');
  295.      ask_user(Temps11,50);
  296.      delete_after_spaces(Temps11);
  297.      if Temps11 <> '' then
  298.       Begin
  299.       For Tempi10 := 0 To 49 Do
  300.        set_bit_byte(UserTemp.Forum_Data[Tempi10].Options,1,False);
  301.       For Tempi10 := 1 to Length(Temps11) Do
  302.        set_bit_byte(UserTemp.Forum_Data[tempi10-1].Options,1,Copy(Temps11,Tempi10,1) = '*');
  303.       End;
  304.    writelncom;
  305.    writeln_com('        5.........6.........7.........8.........9.........');
  306.    writeln_com_spaces(8);
  307.    For Tempi10 := 50 to 99 do
  308.     if bit_from_byte(UserTemp.Forum_Data[tempi10].Options,1) then
  309.      write_com('*')
  310.     else
  311.      write_com(' ');
  312.    writelncom;
  313.      write_com('Access= ');
  314.      ask_user(Temps11,50);
  315.      delete_after_spaces(Temps11);
  316.      if Temps11 <> '' then
  317.      Begin
  318.       For tempi10 := 50 to 99 do
  319.        set_bit_byte(UserTemp.Forum_Data[Tempi10].Options,1,False);
  320.       For Tempi10 := 1 to Length(Temps11) Do
  321.        set_bit_byte(UserTemp.Forum_Data[tempi10+49].Options,1,Copy(Temps11,Tempi10,1) = '*');
  322.      End;
  323. End;
  324.  
  325. (* -------------------------------------------------------------------- *)
  326. Procedure User_Database_Update;
  327.  
  328. Var Hotkeym: Char;
  329.     Temp020 : String;
  330.     User_File: file_handle;
  331.     Num_Users: LongInt;
  332.     User_Num,Junki: Integer;
  333.     Temps6,temps7,Temps8,Temps15,Temps26: String;
  334.     Tempi8,Tempi9: Integer;
  335.     Tempi10: Integer;
  336.     PL,PP: Integer;
  337.     PA:    Real;
  338.     tempc25: char25;
  339.     tempw: word;
  340.  
  341. Begin
  342.  User_Num := 0;
  343.  Repeat
  344.   User_File := open_file(UserFile_Path,2);
  345.   num_users := (seek_file(user_file,0,2) div sizeof(UserTemp))-1;
  346.   ClearScreen;
  347.   if User_Num > Num_Users then User_Num := Num_Users - 1;
  348.   seek_file(user_file,user_num*sizeof(UserTemp),0);
  349.   Junki := read_file(User_File,UserTemp,Sizeof(UserTemp));
  350.   close_file(User_File);
  351.     writeln_com(SENDYELLOW+'Record # '+SENDWHITE+int_to_asc(User_num + 1)+SENDYELLOW+' of '+SENDWHITE+int_to_asc(Num_Users+1));
  352.     writelncom;
  353.     DisplayUpdate(' 1.','  User''s name',UserTemp.Name,' 2.','Dead & Locked Out',
  354.                     Show_Boolean(bit_from_byte(UserTemp.options,4)));
  355.     DisplayUpdate(' 3.',' Calling From',UserTemp.Location,' 4.',' Last Called',
  356.                    UserTemp.Last_Call+' '+UserTemp.Last_Time);
  357.     DisplayUpdate(' 5.','     Password','<Not Shown>',' 6.','  Sec. Level',
  358.                    int_to_asc(UserTemp.access));
  359.     DisplayUpdate(' 7.','     Birthday',UserTemp.Birthday,' 8.',' # Downloads',
  360.                    int_to_asc(UserTemp.Downloads)+'   '+double_to_kilobyte(UserTemp.Download_Bytes)+' k');
  361.     DisplayUpdate(' 9.','   Home Phone',UserTemp.Phone_Number,'10.','   # Uploads',
  362.                    int_to_asc(UserTemp.Uploads)+'   '+double_to_kilobyte(UserTemp.uploads_bytes)+' k');
  363.     DisplayUpdate('11.','       Expert',Show_Boolean(bit_from_byte(UserTemp.options,1)),
  364.                    '12.','     # Calls',int_to_asc(UserTemp.Calls));
  365.     DisplayUpdate('13.','     Computer',UserTemp.Computer,'14.',' # Msgs Left',
  366.                    int_to_asc(UserTemp.Messages_Left));
  367.     DisplayUpdate('15.','     Protocol',UserTemp.Xproto,'   ','','');
  368.     DisplayUpdate('16.','Screen Length',int_to_asc(UserTemp.Screen_lines),'   ','','');
  369.     DisplayUpdate('17.',' Monitor Type',UserTemp.Monitor_Type,'   ','','');
  370.     DisplayUpdate('18.','Expiring Date/Level',UserTemp.Expiration_Date+' '+int_to_asc(UserTemp.Expiration_Access),
  371.                    '   ','','');
  372.     writelncom;
  373.     writeln_com('        0.........1.........2.........3.........4.........5');
  374.       write_com('20.     ');
  375.     For Tempi10 := 0 to 50 Do
  376.      if bit_from_byte(UserTemp.Forum_Data[Tempi10].Options,1) then
  377.       write_com(chr(Tempi10 mod 10+ord('0')))
  378.      else
  379.       write_com(' ');
  380.     writelncom;
  381.     writeln_com_spaces(9);
  382.     For Tempi10 := 51 to 99 Do
  383.      if bit_from_byte(UserTemp.Forum_Data[Tempi10].Options,1) then
  384.       write_com(chr(Tempi10 mod 10+ord('0')))
  385.      else
  386.       write_com(' ');
  387.     writelncom;
  388.     writeln_com(infotext('Time Left: |MINLEFT|'));
  389.     writelncom;
  390.     write_com(SENDYELLOW+'[F]ind, [J]ump, [Q]uit, [1..20], [ENTER=Next]: ');
  391.     ask_user(Temps6,20);
  392.     upper_string(Temps6);
  393.     delete_after_spaces(Temps6);
  394.     Temp020 := Temps6;
  395.     writelncom;
  396.     if drop_carrier then exit;
  397.     case asc_to_int(Temps6) of
  398.      1: Begin
  399.            writelncom;
  400.            Get_Input(25,' New User Name? ');
  401.            put_chars_into(UserTemp.Name,Temp42,Sizeof(UserTemp.Name));
  402.           End;
  403.      2: set_bit_byte(UserTemp.options,4, Not bit_from_byte(UserTemp.options,4));
  404.      3: New_City;
  405.      4: Begin
  406.            Temps5 := UserTemp.Last_Call;
  407.            write_com(SENDYELLOW+'Enter Last Called ['+SENDWHITE+'DATE'+'], ['+SENDWHITE+'ENTER'+
  408.                 SENDYELLOW+'='+UserTemp.Last_Call+') (MM-DD-YY): ');
  409.            Get_A_Input('##-##-##',Temps5,True,Temps5);
  410.            put_chars_into(UserTemp.Last_Call,Temps5,Sizeof(UserTemp.Last_Call));
  411.            Temps5 := UserTemp.Last_Time;
  412.            write_com(SENDYELLOW+'Enter Last Called ['+SENDWHITE+'TIME'+'], ['+SENDWHITE+'ENTER'+
  413.                 SENDYELLOW+'='+Temps5+') (XX:XX): ');
  414.            Get_A_Input('##:##',Temps5,True,Temps5);
  415.            put_chars_into(UserTemp.Last_Time,Temps5,Sizeof(UserTemp.Last_Time));
  416.           End;
  417.      5: New_Password;
  418.      6: Begin
  419.            writelncom;
  420.            Get_Input(3,' New Security Level? ');
  421.            UserTemp.access := asc_to_int(Temp42);
  422.          End;
  423.      7: New_Birthday;
  424.      8: Begin
  425.            Get_Input(4,'   Total Number Of Downloads: ');
  426.            UserTemp.Downloads := asc_to_int(Temp42);
  427.            Get_Input(4,' Total Number Of K Downloads: ');
  428.            val(temp42,Pa,tempw);
  429.            PA := PA * 1024;
  430.            real_to_double(PA,UserTemp.Download_Bytes);
  431.           End;
  432.      9: New_VoicePhone;
  433.     10: Begin
  434.            Get_Input(4,'   Total Number Of Uploads: ');
  435.            UserTemp.Uploads := asc_to_int(Temp42);
  436.            Get_Input(4,' Total Number Of K Uploads: ');
  437.            val(temp42,Pa,tempw);
  438.            PA := PA * 1024;
  439.            real_to_double(PA,UserTemp.uploads_bytes);
  440.           End;
  441.     11: set_bit_byte(UserTemp.options,1, Not bit_from_byte(UserTemp.options,1));
  442.     12: Begin
  443.            writelncom;
  444.            Get_Input(3,' New Number Of Calls? ');
  445.            UserTemp.Calls := asc_to_int(Temp42);
  446.           End;
  447.     13: New_Computer;
  448.     14: Begin
  449.            Get_Input(4,' Total Number Of Messages Left: ');
  450.            UserTemp.Messages_Left := asc_to_int(Temp42);
  451.           End;
  452.     15: Begin
  453.            writelncom;
  454.            Get_Input(1,' New Default Protocol? ');
  455.            put_chars_into(UserTemp.Xproto,Temp42,Sizeof(UserTemp.Xproto));
  456.           End;
  457.     16: Set_Page;
  458.     17: Mode_Toggle;
  459.     18: Begin
  460.          writelncom;
  461.          write_com(' Enter Expiration Date: ');
  462.          Temp42 := UserTemp.Expiration_Date;
  463.          Get_Date(Temp42,True,Temp42);
  464.          put_chars_into(UserTemp.Expiration_Date,Temp42,Sizeof(UserTemp.Expiration_Date));
  465.          write_com('Enter Expiration Level: ');
  466.          ask_user(Temp42,3);
  467.          delete_after_spaces(Temp42);
  468.          if Temp42 <> '' then UserTemp.Expiration_Access := asc_to_int(Temp42);
  469.         End;
  470.     20: Update_Conferences;
  471.     End;
  472.    User_File := open_file(UserFile_Path,2);
  473.    seek_file(user_file,user_num*sizeof(UserTemp),0);
  474.    write_file(User_File,UserTemp,Sizeof(UserTemp));
  475.    close_file(User_File);
  476.    if Temps6 = 'J' then Begin
  477.     writelncom;
  478.     write_com(SENDYELLOW+'Jump: ('+SENDWHITE+'1..'+int_to_asc(Num_Users+1)+SENDYELLOW+')? ');
  479.     ask_user(Temps7,5);
  480.     delete_after_spaces(Temps7);
  481.     Tempi8 := asc_to_int(Temps7);
  482.     if (Tempi8 < 1) Or (Tempi8 > Num_Users+1) then Temps6 := 'Q';
  483.     User_Num := Tempi8 - 1;
  484.    End;
  485.    if Temps6 = 'F' then Begin
  486.     writelncom;
  487.     write_com(SENDYELLOW+'Enter Users '+SENDWHITE+'FULL NAME'+SENDYELLOW+': ');
  488.     ask_user(Temps7,25);
  489.     delete_after_spaces(Temps7);
  490.     upper_string(Temps7);
  491.     put_chars_into(tempc25,temps7,sizeof(tempc25));
  492.     Tempi8 := search_userrec_for(UserTemp,tempc25);
  493.     if tempi8 > 0 then user_num := tempi8 - 1;
  494.    End;
  495.    if Temps6 = '' then Begin
  496.      inc(user_num);
  497.      if User_Num > Num_Users then Temps6 := 'Q';
  498.      End;
  499.  Until (drop_carrier) Or (Temps6 = 'Q');
  500. End;
  501.  
  502. (* -------------------------------------------------------------------- *)
  503. procedure sysop_main_menu;
  504. var
  505.  menucommand: string;
  506.  
  507. const
  508.    None = '~';
  509. begin
  510.  repeat
  511.    writelncom;
  512.    type_file('\Powrbbs\Screen\SysOp');
  513.    writelncom;
  514.    write_com(SENDYELLOW+'SysOps Door Demo Command? ');
  515.    Repeat
  516.     Get_Hotkey(MenuCommand[1]);
  517.    Until drop_carrier or (MenuCommand[1] <> chr(13));
  518.    writeln_com(MenuCommand[1]);
  519.    if drop_carrier then exit;
  520.  
  521.    case menucommand[1] of
  522.          'A':  View_Caller;
  523.          'L':  Sysop_Sb;
  524.          'Q':  Exit;
  525.          'U':  User_Database_Update;
  526.       end;
  527.   until drop_carrier;
  528. end;
  529.  
  530. begin
  531.  begin_live_program('PowerSys - System_Door - (c) 1991 by Russell Frey');
  532.  Sysop_Main_Menu;
  533.  end_live_program;
  534. End.
  535.