CD Actual 13/CDA13.ISO/cdactual/demobin/share/program/Pascal/10TLST.ZIP/QLOG.PAS

Pascal/Delphi Source File | 1990-10-16 | 20.1 KB | 694 lines

{$M 32768,0,65536}
Program QLOG;
Uses CRT,TenTools,DOS,QM;

TYPE
   ScreenPage = Array[1..4000] of Char;
   ASCII = Set of Char;
   DCharType= (UD,UR,UL,DR,DL,URL,DRL,URD,ULD,RL,URDL);
   Charset = '1'..'Z';
   RDRTable = Array[1..200] of Char;
CONST
   DChar : Array[UD..URDL] of Char= ('│','└','┘','┌','┐','┴','┬','├','┤','─','┼');

VAR
   LogTable : DriveArray;
   PTable : PrintArray;
   LoginList : LogArray;
   QJ : Integer;
   L,U : Word;
   C : Charset;
   SR : SearchRec;
   SA : Word;
   RDR : ^RDRTAble;
   ColorScreen : Screenpage absolute $B800:$0000;
   Node : S12;
   UserName : S8;
   PW : S8;
   ScreenSave : ScreenPage;
   Test,LLRet : Word;
   Ret,QI,HoldY,LL : Integer;
   Inchar,GAR : Char;

Procedure Beep;
VAR
   I,J : Integer;
Begin
   For J:=1 to 3 do for I:=5 to 10 do
    begin
       Sound(I*J*100);
       Delay(3);
       NoSound;
    end;
   For J:=3 downto 1 do for I:=10 downto 5 do
    begin
       Sound(I*J*100);
       Delay(3);
       NoSound;
    end;
   Sound(400);
   Delay(50);
   NoSound;
End;

Procedure Showmounts;
TYPE
  SStr = String[5];
VAR
  I,J,K : Integer;
  C : Charset;
  AvailList : Array[1..30] of SStr;
Begin
   ClrScr;
   TextColor(LightGray);
   I:=14;
   J:=1;
   K:=0;
   If ((Mountlist(LogTable,PTable,I)=0)and (I>0))
   then
    begin
       for C:='A' to Char(I+64) do
        begin
           If J<9 then GotoXY(1,J) else GotoXY(40,J-8);
           If LogTable[C].ServerID<>'            '
           then
            begin
               Write(C,'=',LogTable[C].RPath,',',LogTable[C].ServerID);
               Inc(J);
            end
           else
            begin
               Inc(K);
               AvailList[K]:=C;
            end;
        end;
       for C:='1' to '3' do
        begin
           If J<9 then GotoXY(1,J) else GotoXY(40,J-8);
           If PTable[C].ServerID<>'            '
           then
            begin
               Write('LPT',C,':=','LPT',PTable[C].RPath,',',PTable[C].ServerID);
               Inc(J);
            end
           else
            begin
               Inc(K);
               AvailList[K]:='LPT'+C+':';
            end;
        end;
    end;
   I:=MountsAvail;
   GotoXY(1,9);
   Writeln('');
   Writeln('Total Mounts Available: ',I);
   GotoXY(1,14);
   Write('Mounts Available:  ');
   If K=0 then Write('none')
   else for I:=1 to K do
    begin
       Write(AvailList[I]);
       If not (I=K) then Write(',');
    end;
End;


Procedure QuickSSSelect(VAR SStation : S12);
VAR
   I,CS,PCS : Integer;
   SSList : NABuffer;
   MaxSS,MaxRows : Integer;
   NetRet : Word;
   QNode,TempNode : S12;
   Sorted : Boolean;
   Inchar,ExChar : Char;

   procedure Beep;
    VAR
       I : Integer;
       GAR : Char;
   begin
      Randomize;
      For I:=1 to 300 do
       begin
          Sound(10*Random(1000)+100);
          Delay(1);
       end;
      Nosound;
     While keypressed do GAR:=Readkey;
   end;

   procedure ErrorOut(Err : word);
   begin
      Write('Error #',Err,' from NODES procedure');
      Halt;
   end;

   Function Loggedin(NodeID : S12) : Boolean;
   VAR
     p : Integer;
   begin
      p:=0;
      While ((p<LL)and not(NodeID=LoginList[p])) do Inc(p);
      Loggedin := Not(p=LL);
   end;

   procedure Illustrate(QIndex : Integer);
   begin
      GotoXY(((QIndex-1) div MaxRows)*13+1,(QIndex-1) mod MaxRows+2);
      If (CS=QIndex) then TextBackground(Red) else TextBackground(Black);
      If (SSList[QIndex]=QNode)
      then
       begin
          TextColor(Yellow);
          Write(SSList[QIndex]);
          If Loggedin(SSList[QIndex]) then TextColor(White) else TextColor(LightMagenta);
          GotoXY(((QIndex-1) div MaxRows)*13+1,(QIndex-1) mod MaxRows+2);
          Write(SSList[QIndex][1]);
       end
      else
       begin
          TextColor(LightGreen);
          Write(SSList[QIndex]);
          If Loggedin(SSList[QIndex]) then TextColor(White) else TextColor(LightMagenta);
          GotoXY(((QIndex-1) div MaxRows)*13+1,(QIndex-1) mod MaxRows+2);
          Write(SSList[QIndex][1]);
       end;
      TextBackground(Black);
   end;


begin
   CS:=0;
   MaxSS:=140;
   NetRet:=Nodes(SSList,MaxSS,True);       {List of Superstations}
   If (NetRet<>0) then ErrorOut(NetRet);
   QNode:=NodeName;
   TextBackground(Black);
   ClrScr;
   {Sort SSList}
   Repeat
      Sorted:=True;
      For I:=1 to MaxSS-1 do
       if SSlist[I]>SSlist[I+1] then
        begin
           TempNode:=SSlist[I];
           SSlist[I]:=SSList[I+1];
           SSlist[I+1]:=TempNode;
           Sorted:=False;
        end;
   Until Sorted;
   MaxRows:=MaxSS div 6;
   If (MaxSS mod 6)>0 then Inc(MaxRows);
   HoldY:=MaxRows+3;
   LLRet:=LogList(LoginList,LL);
   If not (LLRet=0) then LL:=0;
   For I:=1 to MaxSS do
    begin
       If (SSList[I]=SStation) then CS:=I;
       Illustrate(I);
    end;
  Window(1,12,80,25);
  Showmounts;
  Window(1,1,80,25);
  GotoXY(1,MaxRows+3);
  TextColor(LightRed);
  Write(MaxSS,' Superstations on the Network...');
  Repeat
     Illustrate(CS);
     PCS:=CS;
     Inchar:=Upcase(Readkey);
     If (Inchar=#0)
     then
      begin
         Exchar:=Readkey;
          Case Exchar of
{Up}       'H' : If CS>1 then Dec(CS) else Beep;
{Down}     'P' : If CS<MaxSS then Inc(CS) else Beep;
{Left}     'K' : If (CS-MaxRows)>0 then Dec(CS,MaxRows) else Beep;
{Right}    'M' : If (CS+MaxRows)<=MaxSS then Inc(CS,MaxRows) else Beep;
{Home}     'G' : CS:=1;
{End}      'O' : CS:=MaxSS;
{Delete}   'S' : Begin
                    LLRet:=Logoff(SSList[CS]);
                    LLRet:=LogList(LoginList,LL);
                 end;
           else Beep;
          end;
      end
     else if (Inchar=#13)
     then SSTation:=SSList[CS]
     else if (Inchar=#27)
     then SStation:=''
     else Beep;
     Illustrate(PCS);
  Until (Inchar in [#13,#27]);
End;




{$V-}
Procedure CellEdit (VAR Cell : String;
               LocX,LocY,Len : Integer;
               InCursor : Integer;
               CursorMode : Char;
               CCase : Char;
           VAR PrvCell : String;
           VAR RetCode : Integer);
{ CellEdit(Cell,X,Y,Length,InCursor,['I','O','S'],['U','M','L','C','N'],PrvCell,Ret) }
{Procedure to edit a line (up to 80 characters) beginning at location (LocX,
LocY) and lasting for Len characters (maximum) using standard editing
sequences: Position with arrows, [Del] deletes current character, [<-] deletes
previous character, [Esc] clears cell, ^R returns cell entry, [<-'] accepts
entry and exits CELLEDIT, [Ins] toggles between OVERWRITE and INSERT modes;
on entry, <I>nsert or <O>verwrite (or 'S' for Spreadsheet mode, replacing if
anything is entered) is selected in Cursormode with a character
or <F>ill,which opens in Overwrite mode and exits with a retcode of 0 when
the last character in the cell has been filled. CCase indicates <U>ppercase,
<M>ixed, <L>etters, <C>apital Letters, or <N>umbers.
InCursor is the position of the cursor on entry, with 0 meaning to position
one character to the right of the last character in the line.
     Cell and PrvCell are type LINE (string[80]) the entry (Cell) which is
already on the screen, and an optional previous entry which could be returned
with ^R. ^C and TAB will also exit but with a different retcode for each.
RetCodes:
         0 - Good Edit
         1 - ^C exit
         2 - TAB exit
         4 - Escape Key
         else Function or arrow key was used,
         ordinate of keycode (after #0 is
         returned.
HELP is called within celledit if an F1 key is pressed. Celledit is the
returned to. (added specifically for CVIEW implementation)

}
VAR
  Insert : Boolean;
  CaseOK : Boolean;
  Kunit : Char;
  OldCell,TmpCell : String;
  CursorPos : Integer;
          I,J : Integer;
  Regs : Registers;
Function Chop(Cell : String) : Integer;
{This function returns the length of a line of characters not counting trailing
spaces}
VAR
   I : Integer;
Begin
   Chop:=0;
   For I:=1 to Length(Cell) do
   if (Cell[I]<>' ') then Chop:=I;
End;

Procedure CursorChange(BIG : Boolean);
Begin
   With Regs do
   begin
      AX:=$0100;
      If BIG then CX:=$0007 else CX:=$0607;
      Intr($10,Regs);
   end;
End;

Procedure ClearCell (LocX,LocY,Len : Integer);
{   This procedure clears the current cell as described by the left edge
   (LocX,LocY), and the Len (Length); also leaves cursor at left edge. }
 Begin
    GotoXY(LocX,LocY);
    Write(Copy('                                                                                ',1,Len));
    GotoXY(LocX,LocY);
 end;

Begin {Celledit}
   OldCell:=PrvCell;
   If OldCell='' then OldCell:=Cell;
   If (CursorMode ='I') then Insert:=True else Insert:=False;
   CursorChange(Insert);
   GotoXY(LocX,LocY); {Puts cursor at beginning of current entry}
   Write(Cell);
   If Length(Cell)<Len then for I:=1 to Len-Length(Cell) do Write(' ');
   If InCursor>0
   then
    begin
       GotoXY(LocX+InCursor-1,LocY);
       CursorPos:=InCursor-1;
    end
   else CursorPos:=Length(Cell);
   Repeat
      Repeat
         CaseOK:=True;
         KUnit:=ReadKey;
         If CCase='U' then KUnit:=Upcase(KUnit)
         else if CCase='N'
         then
          begin
             If not (KUnit in [#0,#8,#9,#13,#18,#27,#32,#45,#46,#48..#57,#83])
             then
              begin
                 CaseOK:=False;
                 Beep;
              end;
          end;
      Until CaseOK;
      If ((CursorMode='S') and not(KUnit in [#0,#9,#13,#27]))
      then
       begin
          Cell:='';
          ClearCell(LocX,LocY,Len);
          CursorMode:='O';
       end
      else CursorMode:='O';
      Case KUnit of
          #0 : If keypressed
                then
                 begin
                    KUnit:=ReadKey;
                    Case KUnit of
{home key}          #71 : CursorPos := 0;
{Left key}          #75 : CursorPos := CursorPos -1;
{Control-Left}      #115: CursorPos := CursorPos -8;
{Right key}         #77 : CursorPos := CursorPos +1;
{Control-Right}     #116: CursorPos := CursorPos +8;
{End key}           #79 : CursorPos := Chop(Cell);
{INS key}           #82 : If Insert
                          then
                           begin
                              Insert:=False;
                              CursorChange(False);
                           end
                          else
                           begin
                              Insert:=True;
                              CursorChange(True);
                           end;
{Del key}           #83 : begin
                             Cell := Copy(
                             Concat(Copy(Cell,1,CursorPos),
                             Copy(Cell,CursorPos+2,80),'                    '),1,Len);
                             GotoXY(LocX,LocY);
                             Write(Cell);
                          end;
(*{Help Key}          #59 : begin
                             Help;
                          end;
*)                    else
                     begin
                        RetCode:=Ord(KUnit);
                        KUnit:=#13;
                     end;
                     end; {Case}
                     If CursorPos<0
                     then
                      begin
                         RetCode:=75;
                         KUnit:=#13;
                      end;
                     If CursorPos>(Len-1)
                     then
                      begin
                         RetCode:=77;
                         KUnit:=#13;
                      end;
                     GotoXY(LocX+CursorPos,LocY);
                 end;
           #27 : begin
                    RetCode:=4;
                    KUnit:=#13;
                    Cell:=OldCell;
                 end;
{Case KUnit}#8 : begin
                   If CursorPos>0
                   then
                    begin
                       Cell := Copy(
                       Concat(Copy(Cell,1,CursorPos-1),
                       Copy(Cell,CursorPos+1,(Len-CursorPos)),'                    '),1,Len);
                       GotoXY(LocX,LocY);
                       Write(Cell);
                       CursorPos := CursorPos -1;
                       GotoXY(LocX+CursorPos,LocY);
                    end
                   else Beep;
                end;
 {TAB}     #9 : begin
                   RetCode:=2;
                   KUnit:=#13;
                end;
    #32..#126 : begin
                   If CursorPos<Len
                   then
                    begin
                       If Insert
                       then
                        begin
                           Cell := Copy(
                           Concat(Copy(Concat(Cell,'                    ')
                           ,1,CursorPos),KUnit,
                           Copy(Cell,CursorPos+1,80),'                    ')
                           ,1,Len);
                           Write(Copy(Cell,CursorPos+1,Length(Cell)-CursorPos));
                        end
                       else
                        begin
                           If CursorPos>0 then Cell := Copy(
                             Concat(Copy(Concat(Cell,'                    ')
                             ,1,CursorPos),KUnit,
                             Copy(Cell,CursorPos+2,80),'                    '),1,Len)
                           else Cell:=KUnit+Copy(Concat(Cell,'                   ')
                             ,2,Len-1);
                           Write(Cell[CursorPos+1]);
                        end;
                       CursorPos := CursorPos +1;
                       GotoXY(LocX+CursorPos,LocY);
                       If Cursormode='F' then if CursorPos=len then KUnit:=#13;
                    end
                   else Beep;
                end;
         #18  : begin
                   TmpCell := Cell;
                   Cell := OldCell;
                   OldCell := TmpCell;
                   ClearCell(LocX,LocY,Len);
                   Write(Cell);
                   If InCursor>0
                   then
                    begin
                       GotoXY(LocX+InCursor-1,LocY);
                       CursorPos:=InCursor-1;
                    end
                   else CursorPos:=Length(Cell);
                   GotoXY(LocX+CursorPos,LocY);
                end;
        #13   : RetCode:=0;
           ^C : Begin
                   RetCode:=1;
                   KUnit:=#13;
                end;
           #1 : for I:= 1 to 3 do
                    begin
                       For J:=10 to 20 do
                        begin
                           Sound(J*200);
                           Delay(5);
                        end;
                       For J:=20 downto 10 do
                        begin
                           Sound(J*200);
                           Delay(5);
                        end;
                       Nosound;
                    end;
          else Beep;
      end; {case}
   Until KUnit = #13;
   ClearCell(LocX,LocY,Len);
   GotoXY(LocX,LocY);
   Write(Cell);
   CursorChange(False);
end;


Procedure Outline(X1,Y1,X2,Y2 : Integer;BridgePt : Integer);
VAR
   I : Integer;
Begin
   Window(1,1,80,25);
   GotoXY(X1,Y1);
   Write(DChar[DR]);
   For I:=1 to X2-X1-1 do Write(DChar[RL]);
   Write(DChar[DL]);
   For I:= Y1+1 to Y2-1 do
    begin
       GotoXY(X1,I);
       Write(DChar[UD]);
       GotoXY(X2,I);
       Write(DChar[UD]);
    end;
   GotoXY(X1,Y2);
   Write(DChar[UR]);
   For I:=1 to X2-X1-1 do Write(DChar[RL]);
   Write(DChar[UL]);
   Window(X1+1,Y1+1,X2-1,Y2-1);
   ClrScr;
   Window(1,1,80,25);
   If BridgePt>0
   then
    begin
       GotoXY(X1,Y1+BridgePt);
       Write(DChar[URD]);
       For I:=1 to X2-X1-1 do Write(DChar[RL]);
       Write(DChar[ULD]);
    End;
   Window(X1+1,Y1+1,X2-1,Y2-1);
End;

Procedure CenteredWindow(XSize,YSize : Integer);
{ Creates a Centered window box on the screen with the width XSize and the
  height YSize. }
VAR
   X1,Y1 : Integer;
Begin
   X1:=(80-XSize)div 2;
   Y1:=(25-YSize)div 2;
   Outline(X1,Y1,X1+XSize,Y1+YSize,0);
End;

Procedure Unlog;
VAR I : Integer;
Begin
   I:=13;
   If ((Mountlist(LogTable,PTable,I)=0)and (I>0))
   then for C:='C' to Char(I+64) do if ((LogTable[C].ServerID<>'            ')and(LogTable[C].ServerID<>'Local       '))
   then
    begin
       GotoXY(1,4);
       Write('Unmounting ',C,'=',LogTable[C].RPath,',',LogTable[C].ServerID,'...');
       U:=Unmount(C);
       GotoXY(1,4);
       Write('Logging off ',LogTable[C].ServerID,'!');
       L:=Logoff(LogTable[C].ServerID);
    end;
   If ((LogList(LoginList,I)=0) and (I>0))
   then
    for QJ:=0 to I-1 do
    begin
       GotoXY(1,4);
       Write('Logging off ',LoginList[QJ]);
       L:=Logoff(LoginList[QJ]);
    end;
   GotoXY(1,4);
   ClrEol;
End;


Begin
   Test:=1;
   HoldY:=WhereY;
   If ParamCount=0
   then
    begin
       Node:='            ';
       For QJ:=1 to 12 do Node[QJ]:=ConfigTable^.CT_NID[QJ];
       QuickSSSelect(Node);
    end
   else Node:=ParamStr(1);
   While (Node<>'') do
    begin
       For QI:=1 to Length(Node) do Node[QI]:=Upcase(Node[QI]);
       While Length(Node)<12 do Node:=Node+' ';
       UserName:=ConfigTable^.CT_LName;
       Test:=1;
       If ((LogList(LoginList,QI)=0) and (QI>0))
       then
        for QJ:=0 to QI-1 do
        begin
           If (LoginList[QJ]=Node)
           then
            begin
               GotoXY(1,HoldY);
               Writeln(UserName,' already logged into ',Node);
               Write('(N)ew Username, (C)ontinue');
               Repeat
                  Inchar:=Upcase(Readkey);
                  If Inchar=#0 then Gar:=Readkey;
               Until (Inchar in ['N','C']);
               If Inchar='C' then Test:=0;
            end;
        end;
       If Test<>0
       then
        begin
           Move(ColorScreen,ScreenSave,4000);
           TextColor(Yellow);
           TextBackground(Cyan);
           CenteredWindow(36,5);
           GotoXY(1,1);
           Write('Logging ',UserName,' into ',Node);
           GotoXY(1,3);
           PW:='';
           Write('Password: ');
           Ret:=80;
            Repeat
               Case Ret of
               80 : CellEdit(PW,11,3,8,1,'S','U',PW,Ret);
               72 : begin
                       CellEdit(UserName,9,1,8,1,'S','U',UserName,Ret);
                       If not (Username=ConfigTable^.CT_LName)
                       then
                        begin
                           For QI:=1 to 8 do ConfigTable^.CT_LName[QI]:=UserName[QI];
                           Unlog;
                        end;
                       If not (Ret=4) then Ret:=80;
                   end;
               4 : begin
                      PW:='';
                      Ret:=0;
                   end;
              else
               begin
                  Beep;
                  Ret:=80;
               end;
             end;
           Until Ret=0;
           If PW<>''
           then
            begin
               TextBackground(Black);
               ClrScr;
               GotoXY(1,3);
               TextColor(White+Blink);
               Write('   Logging into ',Node);
               Test:=Login(Node,PW);
            end
           else Test:=$FFFF;
           Move(ScreenSave,ColorScreen,4000);
           TextBackground(Black);
           TextColor(lightGray);
           Window(1,1,80,25);
           GotoXY(1,HoldY);
        end;
        Case Test of
        0 : Begin
               GotoXY(1,HoldY);
               Writeln('Logged into ',Node);
               QuickMount(Node);
            End;
        $FFFF : Writeln('Login Aborted');
         else Writeln('Login failed: ',Test);
        end;
       If (ParamCount>0) then Node:='' else QuickSSSelect(Node);
    end;
   Window(1,1,80,25);
   For QJ:=1 to HoldY-1 do
    begin
       GotoXY(1,25);
       Writeln('');
    end;
   GotoXY(1,25-HoldY+1);
End.