home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / 10TLST.ZIP / QM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-15  |  16.7 KB  |  557 lines
  1. Unit QM; {QuickMount}
  2. Interface
  3. Uses DOS,CRT,TenTools;
  4.  
  5. Procedure QuickMount(ServID : S12);
  6.  
  7. Implementation
  8.  
  9. Procedure QuickMount(ServID : S12);
  10.  
  11. TYPE
  12.    ScreenPage = Array[1..4000] of Char;
  13.    ASCII = Set of Char;
  14.    DCharType= (UD,UR,UL,DR,DL,URL,DRL,URD,ULD,RL,URDL);
  15.    Charset = 'A'..'Z';
  16.    RDRTable = Array[1..200] of Char;
  17.    ColorSelections=(Normal,Inverse,Warning);
  18. CONST
  19.    DChar : Array[UD..URDL] of Char= ('│','└','┘','┌','┐','┴','┬','├','┤','─','┼');
  20.    LocalColor =Blue;
  21. VAR
  22.    ColorScreen : ScreenPage absolute $B800:$0000;
  23.    CurrentColors : ColorSelections;
  24.    ScreenSave,HelpSave : ScreenPage;
  25.    First,MainScreen,PreviousMounts,LoggedIn : Boolean;
  26.    DeviceList : DeviceArray;
  27.    UseList : Array[0..24] of set of Char;
  28.    MaxDevice,I,J : Integer;
  29.    GX1,GY1,GX2,GY2,GWidth,PX1,PY1,PMaxRow,PXOfs,Cursor,TCursor : Integer;
  30.    HoldY : Integer;
  31.    UseLetter,Inchar,CChar,GAR : Char;
  32.    RetCode : Word;
  33.    LocalTable : DriveArray;
  34.    LocalPrint : PrintArray;
  35.    CVAR : CharSet;
  36.    LChar : Char;
  37. Procedure ResetColors;
  38. Begin
  39.    Case CurrentColors of
  40.    Normal : Begin
  41.                TextColor(Yellow);
  42.                TextBackground(Cyan);
  43.             end;
  44.    Inverse : Begin
  45.                 TextColor(Red);
  46.                 TextBackground(White);
  47.              end;
  48.    Warning : Begin
  49.                 TextColor(White);
  50.                 TextBackground(Red);
  51.              end;
  52.    end;
  53. End;
  54.  
  55. Function Trim(InString : String) : String;
  56. Begin
  57.    While Pos(' ',InString)>0 do Delete(Instring,Pos(' ',InString),1);
  58.    While Pos(#0,Instring)>0 do Delete(Instring,Pos(#0,Instring),1);
  59.    Trim:=InString;
  60. End;
  61.  
  62. Procedure Beep;
  63. VAR
  64.    I,J : Integer;
  65. Begin
  66.    For J:=1 to 3 do for I:=5 to 10 do
  67.     begin
  68.        Sound(I*J*100);
  69.        Delay(3);
  70.        NoSound;
  71.     end;
  72.    For J:=3 downto 1 do for I:=10 downto 5 do
  73.     begin
  74.        Sound(I*J*100);
  75.        Delay(3);
  76.        NoSound;
  77.     end;
  78.    Sound(400);
  79.    Delay(50);
  80.    NoSound;
  81. End;
  82.  
  83.  
  84. Procedure Outline(X1,Y1,X2,Y2 : Integer;BridgePt : Integer);
  85. VAR
  86.    I : Integer;
  87. Begin
  88.    Window(1,1,80,25);
  89.    GotoXY(X1,Y1);
  90.    Write(DChar[DR]);
  91.    For I:=1 to X2-X1-1 do Write(DChar[RL]);
  92.    Write(DChar[DL]);
  93.    For I:= Y1+1 to Y2-1 do
  94.     begin
  95.        GotoXY(X1,I);
  96.        Write(DChar[UD]);
  97.        GotoXY(X2,I);
  98.        Write(DChar[UD]);
  99.     end;
  100.    GotoXY(X1,Y2);
  101.    Write(DChar[UR]);
  102.    For I:=1 to X2-X1-1 do Write(DChar[RL]);
  103.    Write(DChar[UL]);
  104.    Window(X1+1,Y1+1,X2-1,Y2-1);
  105.    ClrScr;
  106.    Window(1,1,80,25);
  107.    If BridgePt>0
  108.    then
  109.     begin
  110.        GotoXY(X1,Y1+BridgePt);
  111.        Write(DChar[URD]);
  112.        For I:=1 to X2-X1-1 do Write(DChar[RL]);
  113.        Write(DChar[ULD]);
  114.     End;
  115.    Window(X1+1,Y1+1,X2-1,Y2-1);
  116.    If MainScreen
  117.    then
  118.     begin
  119.        GX1:=X1+1;
  120.        GY1:=Y1+1;
  121.        GX2:=X2-1;
  122.        GY2:=Y2-1;
  123.        GWidth:=GX2-GX1+1;
  124.     end;
  125. End;
  126.  
  127. Procedure CenteredWindow(XSize,YSize : Integer);
  128. { Creates a Centered window box on the screen with the width XSize and the
  129.   height YSize. }
  130. VAR
  131.    X1,Y1 : Integer;
  132. Begin
  133.    X1:=(80-XSize)div 2;
  134.    Y1:=(25-YSize)div 2;
  135.    Outline(X1,Y1,X1+XSize,Y1+YSize,0);
  136. End;
  137.  
  138.  
  139. Procedure CenterWrite(S : String; Line : Integer);
  140. Begin
  141.    GotoXY((GWidth-Length(S))div 2+1,Line);
  142.    Write(S);
  143. End;
  144.  
  145. Procedure GetLogList(VAR LoginList : LogArray; VAR LogCount : Integer);
  146. VAR
  147.    I,J : Integer;
  148.    L : Word;
  149. Begin
  150.    If LogList(LoginList,I)=0
  151.    then LogCount:=I
  152.    else LogCount:=0;
  153. End;
  154.  
  155.  
  156. Procedure Devices(ServerName : S12;VAR DList : DeviceArray;VAR DeviceCount : Integer);
  157. VAR
  158.    SaveUser : S8;
  159.    SavePW : PW8;
  160.    LogList : LogArray;
  161.    I,D,E : Integer;
  162.    RetCode : Word;
  163.    MaxNodes : Integer;
  164. Begin
  165.    ServerName:=Upcase12(ServerName);
  166.    GetLogList(LogList,MaxNodes);
  167.    SaveUser:=ConfigTable^.CT_LName;
  168.    LoggedIn:=False;
  169.    I:=0;
  170.    If (MaxNodes>0) then
  171.     begin
  172.        while not (Loggedin or (I=MaxNodes)) do
  173.        begin
  174.           LoggedIN:=(LogList[I]=ServerName);
  175.           If not Loggedin then Inc(I);
  176.        end;
  177.     end
  178.    else LoggedIn:=False;
  179.    If Not Loggedin
  180.    then
  181.     begin
  182.        SetUsername('TESTING0');
  183.        RetCode:=Login(ServerName,'TESTPW');
  184.     end
  185.    else RetCode:=0;
  186.    If (RetCode=0)
  187.    then
  188.     begin
  189.        RetCode:=GetDevices(ServerName,DList,D);
  190.        DeviceCount:=D;
  191.        If not LoggedIN
  192.        then
  193.         begin
  194.            RetCode:=Logoff(Servername);
  195.            SetUserName(SaveUser);
  196.         end;
  197.     end
  198.    else Writeln('Can''t access ',Servername,' : ',RetCode);
  199. End;
  200.  
  201.  
  202. { The following "Pointer Procedures" will point at an item arranges in
  203.   rows by columns, indexed from 1 up by positive integer. }
  204.  
  205. Procedure SetPointer(X1,Y1,XOfs,MaxRow : Integer);
  206. Begin
  207.    PX1:=X1;
  208.    PY1:=Y1;
  209.    PMaxRow:=MaxRow;
  210.    PXOfs:=XOfs;
  211. End;
  212.  
  213. Procedure PointAt(Index : Integer);
  214. VAR
  215.  XPos,YPos : Integer;
  216. Begin
  217.    XPos:=(Index-1) div PMaxRow;
  218.    XPos:=PX1+(XPos * PXOfs);
  219.    YPos:=(Index-1)mod PMaxRow+1+PY1;
  220.    GotoXY(XPos,YPos);
  221. end;
  222.  
  223. Procedure DisplayList;
  224. VAR
  225.    I : Integer;
  226.    UseLetter : Char;
  227. Begin
  228.    For I:=1 to MaxDevice do
  229.     begin
  230.        PointAt(I);
  231.        TextColor(LocalColor);
  232.        If (Uselist[I-1]<>[])
  233.        then
  234.         begin
  235.            First:=True;
  236.            For UseLetter:='1' to 'Z' do if not (UseLetter in ['4'..'@'])
  237.            then
  238.             begin
  239.                If (UseLetter in UseList[I-1])
  240.                then
  241.                 begin
  242.                    If not First then Write(',');
  243.                    Write(UseLetter);
  244.                    First:=False;
  245.                 end;
  246.             end;
  247.            Write('=');
  248.         end;
  249.        ResetColors;
  250.        Write(DeviceList[I-1]);
  251.        ClrEol;
  252.     end;
  253. End;
  254.  
  255.  
  256. Procedure NVideo;
  257. Begin
  258.    CurrentColors:=Normal;
  259. End;
  260.  
  261. Procedure IVideo;
  262. Begin
  263.    CurrentColors:=Inverse;
  264. End;
  265.  
  266. Procedure WVideo;
  267. Begin
  268.    CurrentColors:=Warning;
  269. end;
  270.  
  271.  
  272. Procedure AlreadyAttached;
  273. VAR
  274.    TestID : S12;
  275. Begin
  276.    CenterWrite(Inchar+' is already attached!',1);
  277.    CenterWrite(Inchar+'='+LocalTable[Inchar].RPath+','+LocalTable[Inchar].ServerID,3);
  278.    CenterWrite('<─┘ to Change, [ESC] to abort',5);
  279.     Repeat
  280.        CChar:=Upcase(Readkey);
  281.        If (CChar=#0) then Gar:=Readkey;
  282.     Until (CChar in [#13,#27]);
  283.    If (CChar=#13)
  284.    then
  285.     begin  {Unmount/UnUse first}
  286.        If (Length(LocalTable[Inchar].RPath)>1)
  287.         then RetCode:=UnUse(Inchar)
  288.        else RetCode:=Unmount(Inchar);
  289.        TestID:=Trim(LocalTable[Inchar].ServerID);
  290.        If (TestID=ServID)
  291.        then
  292.         begin
  293.            J:=0;
  294.            While (Not(Inchar in UseList[J]) or (J=MaxDevice)) do Inc(J);
  295. {}           If (Inchar in UseList[J]) then UseList[J]:=Uselist[J]-[Inchar];
  296.         end;
  297.        LocalTable[Inchar].RPath:='';
  298.        LocalTable[Inchar].ServerID:='';
  299.        RetCode:=1;
  300.     end
  301.    else RetCode:=0;
  302. End;
  303.  
  304. Procedure DriveUnavailable;
  305. Begin
  306.    CenterWrite(Inchar+' is not available',1);
  307.    CenterWrite('in the local drive list.',3);
  308.    CenterWrite('Press any key to Continue',5);
  309.    CChar:=Upcase(Readkey);
  310.    If (CChar=#0) then Gar:=Readkey;
  311.    RetCode:=0;
  312. End;
  313.  
  314. Function Listed(DriveChar : Char): Boolean;
  315. Begin
  316.    Listed:=Trim(LocalTable[DriveChar].ServerID)<>'';
  317. End;
  318.  
  319.  
  320. Begin {QMount}
  321.    NVideo;
  322.    HoldY:=WhereY;
  323.    For I:=0 to 24 do UseList[I]:=[];
  324.    For I:=1 to Length(ServID) do ServID[I]:=Upcase(ServID[I]);
  325.    Devices(ServID,DeviceList,MaxDevice);
  326.    J:=26;
  327.    PreviousMounts:=((Mountlist(LocalTable,LocalPrint,J)=0)and (J>0));
  328.    If MaxDevice>0 then for I:=0 to MaxDevice-1 do
  329.     begin
  330.        DeviceList[I]:=Trim(DeviceList[I]);
  331.        if DeviceList[I][1]='_' then DeviceList[I]:=Copy(DeviceList[I],2,Length(DeviceList[I])-1);
  332.        If PreviousMounts
  333.        then
  334.         begin
  335.            CVAR:='A';
  336.            While not ((CVAR=Char(64+J)){or(CVAR in UseList[I])}) do
  337.             begin
  338.                Inc(CVAR);
  339.                If ((LocalTable[CVar].RPath=DeviceList[I])and(Trim(ServID)=Trim(LocalTable[CVAR].ServerID)))
  340.                then UseList[I]:=UseList[I]+[CVAR];
  341.             end;
  342.            If (COPY(DeviceList[I],1,3)='LPT')
  343.            then
  344.             begin
  345.                If (Trim(ServID)=Trim(LocalPrint[DeviceList[I][4]].ServerID))
  346.                then UseList[I]:=UseList[I]+[DeviceList[I][4]];
  347.                For LChar:='1' to '3' do
  348.                if ((LocalPrint[LChar].RPath=DeviceList[I])and(Trim(ServID)=Trim(LocalPrint[LChar].ServerID)))
  349.                then UseList[I]:=UseList[I]+[LChar];
  350.             end;
  351.         end;
  352.     end;
  353.    If not Loggedin
  354.    then
  355.     begin
  356.        Writeln('Not Logged to ',ServID);
  357.        For I:=1 to MaxDevice do
  358.         begin
  359.            Writeln(DeviceList[I-1]);
  360.         end;
  361.     end
  362.    else
  363.     begin
  364.        MainScreen:=True;
  365.        Move(ColorScreen,ScreenSave,4000);
  366.        TextColor(Yellow);
  367.        TextBackground(Cyan);
  368.        CenteredWindow(31,23);
  369.        MainScreen:=False;
  370.        CenterWrite(ServID,1);
  371.        CenterWrite('Devices ',2);
  372.        GotoXY(1,3);
  373.        For I:=1 to Gwidth do Write('─');
  374.        SetPointer(3,4,15,19);
  375.        DisplayList;
  376.        Cursor:=1;
  377.        Inchar:=#0;
  378.        Repeat
  379.           TCursor:=Cursor;
  380.           PointAt(Cursor);
  381.           IVideo;
  382.           ResetColors;
  383.           TextColor(LocalColor);
  384.           If (Uselist[Cursor-1]<>[])
  385.           then
  386.            begin
  387.               First:=True;
  388.               For UseLetter:='1' to 'Z' do if not (UseLetter in ['4'..'@'])
  389.               then
  390.                begin
  391.                   If (UseLetter in UseList[Cursor-1])
  392.                   then
  393.                    begin
  394.                       If not First then Write(',');
  395.                       Write(UseLetter);
  396.                       First:=False;
  397.                    end;
  398.                end;
  399.               Write('=');
  400.            end;
  401.           ResetColors;
  402.           Write(DeviceList[Cursor-1]);
  403.           Inchar:=Upcase(Readkey);
  404.           If Inchar=#0
  405.           then
  406.            begin
  407.               Inchar:=Readkey;
  408.               Case Inchar of
  409. {Up}          'H' : If TCursor>1 then Dec(TCursor) else TCursor:=MaxDevice;
  410. {Down}        'P' : If TCursor<MaxDevice then Inc(TCursor) else TCursor:=1;
  411. {Left}        'K' : If TCursor-PMaxRow>0 then Dec(TCursor,PMaxRow);
  412. {Right}       'M' : If TCursor+PMaxRow<=MaxDevice then Inc(TCursor,PMaxRow);
  413. {DELETE}      'S' : If Uselist[Cursor-1]<>[]
  414.                     then
  415.                      begin
  416.                         For UseLetter:='1' to 'Z' do if (UseLetter in UseList[Cursor-1])
  417.                         then
  418.                          begin
  419.                             If Not ((Copy(DeviceList[Cursor-1],1,3)='LPT')or(Length(DeviceList[Cursor-1])=1))
  420.                             then RetCode:=UnUse(UseLetter)
  421.                             else RetCode:=UnMount(UseLetter);
  422.                             If (UseLetter in ['A'..'Z'])
  423.                             then
  424.                              begin
  425.                                 LocalTable[UseLetter].ServerID:='';
  426.                                 LocalTable[UseLetter].RPath:='';
  427.                              end
  428.                             else
  429.                              begin
  430.                                 LocalPrint[UseLetter].ServerID:='';
  431.                                 LocalPrint[UseLetter].RPath:='';
  432.                              end;
  433.                             UseList[Cursor-1]:=UseList[Cursor-1]-[UseLetter];
  434.                          end;
  435.                         NVideo;
  436.                         ResetColors;
  437.                         DisplayList;
  438.                         RetCode:=0;
  439.                      end;
  440.               end;
  441.              Inchar:=#0;
  442.            end
  443.           else
  444.            begin
  445.               Case Inchar of
  446.               'A'..'Z' : Begin
  447.                             If Not ((Copy(DeviceList[Cursor-1],1,3)='LPT')or(Length(DeviceList[Cursor-1])=1))
  448.                             then
  449.                              Repeat
  450.                                 RetCode:=NetUse(ServID,Inchar,DeviceList[Cursor-1],'');
  451.                                 If (RetCode=0)
  452.                                 then
  453.                                  begin
  454.                                     UseList[Cursor-1]:=UseList[Cursor-1]+[Inchar];
  455.                                     LocalTable[Inchar].RPath:=DeviceList[Cursor-1];
  456.                                     LocalTable[Inchar].ServerID:=ServID;
  457.                                  end
  458.                                 else
  459.                                  begin
  460.                                     Beep;
  461.                                     Move(ColorScreen,HelpSave,4000);
  462.                                     TextBackground(Red);
  463.                                     TextColor(White);
  464.                                     CenteredWindow(31,7);
  465.                                     If (RetCode=85) then AlreadyAttached
  466.                                     else DriveUnavailable;
  467.                                     NVideo;
  468.                                     ResetColors;
  469.                                     Move(HelpSave,ColorScreen,4000);
  470.                                     Window(GX1,GY1,GX2,GY2);
  471.                                     DisplayList;
  472.                                     GotoXY(1,1);
  473.                                  end;
  474.                              Until (RetCode=0)
  475.                             else if (Length(DeviceList[Cursor-1])=1)
  476.                             then
  477.                              Repeat
  478.                                 If Listed(Inchar) then RetCode:=85
  479.                                 else RetCode:=Mount(ServID,Inchar,DeviceList[Cursor-1][1]);
  480.                                 If (RetCode=0)
  481.                                 then
  482.                                  begin
  483.                                     UseList[Cursor-1]:=UseList[Cursor-1]+[Inchar];
  484.                                     LocalTable[Inchar].RPath:=DeviceList[Cursor-1];
  485.                                     LocalTable[Inchar].ServerID:=ServID;
  486.                                  end
  487.                                 else
  488.                                  begin
  489.                                     Beep;
  490.                                     Move(ColorScreen,HelpSave,4000);
  491.                                     TextBackground(Red);
  492.                                     TextColor(White);
  493.                                     CenteredWindow(31,7);
  494.                                     If (RetCode=85) then AlreadyAttached
  495.                                     else DriveUnavailable;
  496.                                     NVideo;
  497.                                     ResetColors;
  498.                                     Move(HelpSave,ColorScreen,4000);
  499.                                     Window(GX1,GY1,GX2,GY2);
  500.                                     DisplayList;
  501.                                  end;
  502.                              Until (RetCode=0);
  503.                             If TCursor<MaxDevice then Inc(TCursor);
  504.                          End;
  505.               '1'..'3' : If (Copy(DeviceList[Cursor-1],1,3)='LPT')
  506.                          then
  507.                           begin
  508.                              RetCode:=Mount(ServID,Inchar,DeviceList[Cursor-1][4]);
  509.                              If (RetCode=0)
  510.                              then
  511.                               begin
  512.                                  UseList[Cursor-1]:=UseList[Cursor-1]+[Inchar];
  513.                                  LocalPrint[Inchar].RPath:=DeviceList[Cursor-1];
  514.                                  LocalPrint[Inchar].ServerID:=ServID;
  515.                               end
  516.                              else Beep;
  517.                             If TCursor<MaxDevice then Inc(TCursor);
  518.                           end;
  519.                 #27 : Begin
  520.                          sound(1000);
  521.                          Delay(15);
  522.                          Nosound;
  523.                       end;
  524.                else Beep;
  525.               end;
  526.            end;
  527.           PointAt(Cursor);
  528.           NVideo;
  529.           ResetColors;
  530.           TextColor(LocalColor);
  531.           If (Uselist[Cursor-1]<>[])
  532.           then
  533.            begin
  534.               First:=True;
  535.               For UseLetter:='1' to 'Z' do
  536.                begin
  537.                   If (UseLetter in UseList[Cursor-1])
  538.                   then
  539.                    begin
  540.                       If not First then Write(',');
  541.                       Write(UseLetter);
  542.                       First:=False;
  543.                    end;
  544.                end;
  545.               Write('=');
  546.            end;
  547.           ResetColors;
  548.           Write(DeviceList[Cursor-1]);
  549.           Cursor:=TCursor;
  550.        Until (Inchar=#27);
  551.        Move(ScreenSave,ColorScreen,4000);
  552.        Window(1,1,80,25);
  553.    end;
  554.   GotoXY(1,HoldY);
  555. End;
  556.  
  557. End.