C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/NWTP04/XCONN/LOGOUT.PAS

Pascal/Delphi Source File | 1993-12-29 | 5KB | 210 lines

{$X+,V-,B-}
Program Logout;

{ This program is an adaption of a multi-worm version,
  written by a Dutch programmer (sorry, I don't have a name..)}

{ This adaption / NwTP 0.4 API. (c) 1994, R.Spronk }

uses crt,dos,graph,nwConn;
{ demo of a program that logs out the user, and fills the screen with
  a worm, functionally equal to the worm of the netware console monitor. }

const
  MaxTailLen      = 30;
  MaxDeviations   = 15;
  MaxSymbols      = 5;
  TailSegments    : array[1..MaxSymbols] of byte
                  = (32,176,177,178,219);

type
  BorderColl = (left,right,upside,downside);

var
  gd,gm           : integer;

  color           : boolean;
  wormrecord      : record
                    x_head,y_head : integer;
                    ChosenDir     : integer;
                    PreferredDir  : integer;
                    LengthFactor  : integer;
                    TailLen       : integer;
                    x,y           : array[1..MaxTailLen] of integer;
                    end;


procedure Initialization;
var CurrSegment : integer;
begin
randomize;

with wormrecord
 do begin
    LengthFactor:=random(5)+3;
    TailLen:=MaxSymbols*LengthFactor;
    if TailLen>MaxTailLen then TailLen:=MaxTailLen;
    x_head:=40;
    y_head:=12;
    PreferredDir:=random(8);
    for CurrSegment:=1 to MaxTailLen
     do begin
        x[CurrSegment]:=0;
        y[CurrSegment]:=0;
        end;
    end;
end;

procedure ChooseDir;
{ This procedure determines the future direction of the worm. }
VAR NbrOfDev : integer;
begin
NbrOfDev:=0;
with wormrecord
 do begin
    repeat
      repeat
        inc (NbrOfDev);
        ChosenDir:=random(8);
      until  (NbrOfDev>=MaxDeviations)
             or (ChosenDir=PreferredDir);
    until abs(PreferredDir-ChosenDir)<>4;
    PreferredDir:=ChosenDir;
    end;
end;

procedure DrawWorm;
var CurrSegment : integer;
    SegmentSym : integer;
begin
with wormrecord
 do begin
    if color then textcolor (7);
    for CurrSegment:=1 to TailLen
     do begin
        SegmentSym:=(CurrSegment-1) div LengthFactor+1;
        if (x[CurrSegment]<>0)
         then begin
              gotoxy (x[CurrSegment],y[CurrSegment]);
              write (chr(TailSegments[SegmentSym]),
                     chr(TailSegments[SegmentSym]));
              end;
        if (CurrSegment<TailLen)
         then begin
              x[CurrSegment]:=x[CurrSegment+1];
              y[CurrSegment]:=y[CurrSegment+1];
              end;
        end;
    gotoxy (x[TailLen],y[TailLen]);
    x[TailLen]:=x_head;
    y[TailLen]:=y_head;
    end;
if color then textcolor (7);
end;

procedure ReverseDir (ScreenBorder:BorderColl);
{ Bounce directions on screenborders }
begin
with wormrecord
 do case ScreenBorder of
    left  : case PreferredDir of
              3 : PreferredDir:=1;
              4 : PreferredDir:=0;
              5 : PreferredDir:=7;
             end;
    right : case PreferredDir of
              1 : PreferredDir:=3;
              0 : PreferredDir:=4;
              7 : PreferredDir:=5;
             end;
    upside  : case PreferredDir of
              1 : PreferredDir:=7;
              2 : PreferredDir:=6;
              3 : PreferredDir:=5;
            end;
    downside  : case PreferredDir of
              5 : PreferredDir:=3;
              6 : PreferredDir:=2;
              7 : PreferredDir:=1;
            end;
  end;
end;


procedure DeterminePos;
begin
with wormrecord
 do begin
    if (ChosenDir in [1..3])
     then dec (y_head);
    if (ChosenDir in [5..7])
     then inc (y_head);
    if (ChosenDir in [3..5])
     then dec (x_head);
    if (ChosenDir<2) or (ChosenDir=7)
     then inc (x_head);
    if (ChosenDir=0)
     then inc (x_head);
    if (ChosenDir=4)
     then dec (x_head);

    if (x_head<1)
     then begin
          x_head:=2-x_head;
          ReverseDir (left);
          end;
    if (x_head>77)
     then begin
          x_head:=77-(x_head-77);
          ReverseDir (right);
          end;
    if (y_head<1)
     then begin
          y_head:=2-y_head;
          ReverseDir (upside);
          end;
    if (y_head>24)
     then begin
          y_head:=24-(y_head-24);
          ReverseDir (downside);
          end;
    end; {with}
end;


procedure logoutservers;
{ Logs you out form all servers by logging out and detaching on
  a server by server basis. Normally you are not detached when
  logging off. It gives your connection back to the server. }
Var connId:byte;
    servName:string;
begin
for connId:=1 to 8
 do begin
    IF GetFileServerName(ConnId,servName)
     then begin
          IF LogoutFromFileServer(ConnId)
             and DetachFromFileServer(connId)
           then writeln('You are now detached from fileserver ',servName);
          end
    end;
delay(2500);
end;


begin
  color:=false;
  detectgraph (gd,gm);
  color:=(gd<>7);
  logoutservers;
  clrscr;
  Initialization;
  repeat
   ChooseDir  ;
   DeterminePos;
   DrawWorm   ;
  delay (150);
  until keypressed;
  clrscr;
end.