[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]

    {

     Ken Johnson's Novell unit.
     kjohnso3@chat.carleton.ca
     Some of this stuff may/maynot work. If something doesn't,
     email me.

    }

    Unit kjnet;
    interface
    Var
      error : byte;
    Const
      week : array[0..6] of string = ('Sunday','Monday','Tuesday','Wednesday'
                                     ,'Thursday','Friday','Saturday');
      personal     = $05;{used for GETMESSAGE}
      broadcast    = $01;
      receiveall         = $00;{used for SETBROADCASTMODE}
      NoUsermessage      = $01;
      StoreServerMessage = $02;
      StoreAllMessages   = $03;

    type
    diskrec=record
      clockticks:longint;
      objectid:longint;
      diskspace:longint;
      enforced:Byte;
    end;

      diskspacerec = record
        len : word;
        clockticks : longint;
        id : longint;
        diskleft : longint;
        restrict : byte;
      end;
      BinderyRec = Record
        ID : longint;
        objtype : word;
        Name : String;
        objectFlag : byte;
        securitylevel : byte;
        propertyflags : byte;
      end;

     NoReturn = record{when the function call}
        Len : Word;    {returns nothing.}
      End;
       Userrec = record
        Name      : string;
        objtype   : word;
        id        : longint;
        logindate : string;
        logintime : string;
        weekday   : string;
        Connection: Byte;
      end;
    procedure delnulls(var s : string);
    procedure Callint(Ahreg : byte;Var bufferin,bufferout;
                      Var error : Byte);
    procedure getdisk(id:longint;var disk : diskrec);

    Procedure GetBinderyAccess(var sec : byte;var id : longint);
    Function  upcaseStr(s : string) : String;
    procedure logout;
    function  connectnum : byte;
    procedure setbroadcastmode(mode : byte);
    function  Getbroadcastmode : byte;
    Procedure SendBroadCastMessage(Con : Byte;Message : String);
    Function  GetMessage(Func : Byte) : String;
    Procedure SendPersonalMessage(Con : Byte;Message : String);
    procedure broadcastToConsole(message : string);
    function  idnumber : longint;
    procedure Getconnectioninfo(Con : byte;Var U : userrec);
    function  Connect2ID(Con : byte) : longint;
    {procedure getdiskspaceleft(id : longint;var bufferout : diskspacerec);}
    procedure ClearConnection(c : byte);
    procedure getopenfiles(c : word;var files : array of string;var numf : byte);
    procedure scanbindery(objID : Longint;obj : word;name1 : string;
                          var Bin : binderyrec;var error:byte);
    function name2id(name : string) : longint;

    Function  ConsoleOperator : Boolean;
    function fullname(Name : string) : string;
    procedure callFint(con : word;var bufferin,bufferout;
                      var e : word);

    implementation

    Function fullname(Name : string) : string;
    Type
      request = record
        len : word;
        sub : byte;
        objtype : word;
        data : array[1..65] of byte;
      end;
      reply = record
        len : word;
        value : array[1..128] of Byte;
        s : byte;
        f : byte;
      end;
    var
      reaL:STRING;
      prop:string;
      bufferin : request;
      bufferout : reply;
      x,i : byte;
      Begin
        fillchar(Bufferin,sizeof(BUfferin),0);
        Fillchar(BufferOut,Sizeof(Bufferout),0);
        Bufferout.Len := Sizeof(BufferOut)-2;
        prop := 'IDENTIFICATION';
        with bufferin do
          begin
            Sub := $3d;
            objtype := 256;{I guess tis could be different.}
            i := 1;
            bufferin.data[i] := Length(Name);
            for x := 1 to length(name) do
              begin
                Inc(I);
                bufferin.daTa[i] := ord(name[x]);
              end;
            inc(i);
            bufferin.data[i] := 01;
            inc(i);
            bufferin.data[i] := length(Prop);
            for x := 1 to length(Prop) do
              begin
                Inc(i);
                bufferin.data[i] := ord(prop[x]);
              end;
          end;
        bufferin.len := 3+I;
       callint($e3,Bufferin,bufferout,error);
       i := 1;
       While Not(Chr(Bufferout.value[i]) = '') and not (I = 128)do
         begin
           real[i] := Chr(Bufferout.Value[i]);
           Inc(I);
         end;
         real[0] := chr(I);
         delnulls(real);
         fullname:=real;
      End;

    {--------------------------------------------------------------------------}
    procedure getpriv(Var bufferin,bufferout;Var e : Byte);Assembler;
      asm
        push ds
        mov ah,$e3
        lds si,bufferin
        les di,bufferout
        int $21
        mov [byte ptr e],al
        pop ds
      end;
    {----------------------------------------------------------------------}
    function name2id(name : string) : longint;
    type
      request=record
        len:word;
        sub:byte;
        obtype:word;
        name:array[1..49] of char;
      end;
      reply = record
        len:word;
        id:longint;
        objtype:word;
        name : array[1..48] of char;
      end;
    var
     bufferin:request;
     bufferout:reply;
     x:byte;
      begin
        bufferin.len := 3+Length(name)+1;
        bufferin.sub:=$35;
        bufferin.obtype:=(256);
        for x := 0 to length(name) do
          begin
            bufferin.name[x+1] := name[x];
          end;

       fillchar(bufferout,sizeof(bufferout),0);
       bufferout.len:=$36;
       callint($e3,bufferin,bufferout,error);
       name2id := (bufferout.id);
      end;
    {--------------------------------------------------------------------------}
    Function ConsoleOperator : Boolean;
    type
      request = record
        len : Word;
        Sub : Byte;
      end;
    var
      bufferin : request;
      bufferout : noreturn;
      begin
        Bufferin.len := 1;
        bufferin.Sub := $c8;
        getpriv(bufferin,bufferout,error);
        if error = $c6 Then consoleoperator := False
        else consoleoperator := true;
      end;
    {--------------------------------------------------------------------------}
    procedure getdisk(id:longint;var disk : diskrec);
    type
      request = record
        len:word;
        sub:byte;
        id1:Longint;
      end;
      reply = record
        len:word;
        a:array[1..3]of longint;
        enforced:byte;
      end;
    var
      bufferin:request;
      bufferout:reply;
      u:userrec;
      begin

        bufferin.len:=5;
        bufferin.sub:=$e6;
        bufferin.id1:=(id);
        fillchar(Bufferout,sizeof(bufferout),0);
        bufferout.len:=sizeof(bufferout)-2;
        callint($e3,bufferin,bufferout,error);

        with bufferout do
          begin
            disk.clockticks := SWAP(a[1]);
            disk.objectid:=SWAP(a[2]);
            disk.diskspace:=swap(a[3]);
            disk.enforced:=enforced;
          end;
      end;

    {--------------------------------------------------------------------------}
    procedure scanbindery(objID : Longint;obj : word;name1 : string;
                          var Bin : binderyrec;var error : byte);
    type
      request = record
        len : word;
        sub : byte;
        id  : longint;
        ot  : word;
        namelen : byte;
        namedata : array[1..47] of char;
      end;
      reply = record
        len : word;
        id  : longint;
        ot  : word;
       name : array[1..48] of char;
       flag : byte;
       lev  : byte;
       prop : byte;
      end;
    var{this works man}
      bufferin : request;
      bufferout : reply;
      x,i : byte;
      name:string;
      begin
        name:=name1;
        upcaseStr(name);
        fillchar(Bufferin,sizeof(Bufferin),0);
        with bufferin do
          begin
            sub := $37;
            id := objid;
            ot := obj;
            i := 0;
            namelen := length(name);
            for x := 1 to length(Name) do
              begin
                inc(i);
                namedata[i] := name[x];
              end;
            len := length(Name)+8;
          end;
        bufferout.len := sizeof(Bufferout)-2;
       callint($e3,bufferin,bufferout,error);
       With BUfferout do
         begin
           bin.id := id;
           bin.objtype := ot;
           for i := 1 to 48 do
             bin.name[i] := bufferout.name[i];
           bin.name[0] := chr(i);
           bin.objectflag := flag;
           bin.securitylevel := lev;
           bin.propertyflags := prop;
         end;
      end;
    {------------------------------------------------------------------------}
    procedure callFint(con : word;var bufferin,bufferout;
                      var e : word);assembler;
      asm
        push ds
        mov ax,$f217
        mov cx,con
        lds si,bufferin
        les di,bufferout
        int $21
        mov [word ptr e],ax
        pop ds
      end;
    {------------------------------------------------------------------------}
    procedure sortthese(num : word;B : array of byte;var files : array of string);
    var
      W,x,i : integer;
      len : byte;
      oldi : integer;
      begin
        i := 16;
        x := -1;
          repeat
             INC(x);
             files[x][0] := chr(B[i]);{length}
             len := b[i];
             inc(i);
             OldI := i;
             for w := 1 to len do
               begin
                 files[x][w] := chr(b[i]);
                 inc(i);
                 if oldI > i+16 Then Break;
               end;
             inc(I,16);

          until x = num;

      end;
    {------------------------------------------------------------------------}
    procedure getopenfiles(c : word;var files : array of string;var numf : byte);
    type
      request = record
        len : word;
        sub : byte;
        con : word;
        lastrec : word;
      end;
      reply = record
        nextrecord : word;
        numberofrecords : word;
        RawReplyData : array[1..508] of Byte;
      end;
    var
      bufferin  : request;
      bufferout : reply;
      i,x,l : word;
      error : word;
      begin
        fillchar(files,sizeof(Files),0);
        for i := 11 to 13 do
           begin
             fillchar(Bufferin,sizeof(Bufferin),0);
             fillchar(Bufferout,sizeof(Bufferout),0);
             with bufferin do
               begin
                 len := $5;
                 sub := $eb;
                 con := c;
                 lastrec := $00;
               end;
             callFint(bufferin.con,bufferin,bufferout,error);
             if (Bufferout.numberofrecords > 0) Then
                begin
                  numf := bufferout.numberofrecords;
                  sortthese(bufferout.numberofrecords,bufferout.rawreplydata,files);
                  exit;
                end;
       end;
       end;

    {------------------------------------------------------------------------}
    procedure ClearConnection(c : byte);
    type
      request = record
        len : word;
        sub : byte;
        con : byte;
      end;
    var
      bufferin : request;
      bufferout : noreturn;
      begin
        bufferin.len := 2;
        bufferin.sub := $d2;
        bufferin.con := c;
        callint($e3,bufferin,bufferout,error);
      end;
    {------------------------------------------------------------------------}
    function  Connect2ID(Con : byte) : longint;
    var
      u : userrec;
      begin
        getconnectioninfo(con,u);
        connect2id := u.id;
      end;
    {------------------------------------------------------------------------}
    procedure getdiskspaceleft(id : longint;var bufferout : diskspacerec);
    type
      request = record
        len : word;
        sub : byte;
        oid : longint;
      end;                {works. page 367}
    var
      bufferin : request;
      begin
        with bufferin do
          begin
            len := 5;
            sub := $e6;
            oid := id;
          end;
      fillchar(Bufferout,sizeof(Bufferout),0);
      bufferout.len := sizeof(Bufferout)-2;
      callint($e3,bufferin,bufferout,error);
      end;
    {------------------------------------------------------------------------}
    procedure delnulls(var s : string);
    var
      x : byte;
      temp : string;
      begin
        for x := 1 to length(S) do
          begin
            if s[x] = #0 Then
              Begin
                s[0] := chr(X-1);
                exit;
              End;
          end;
      end;
    {------------------------------------------------------------------------}
    procedure Callint(Ahreg : byte;Var bufferin,bufferout;
                      Var error : Byte);assembler;
    asm
      xor ax,ax

      push ds
      mov ah,ahreg
      lds si,bufferin
      les di,bufferout
      int 21h
      pop ds
      mov [byte ptr error],al
    end;
    {------------------------------------------------------------------------}
    Procedure GetBinderyAccess(var sec : byte;var id : longint);
    Type
      request = record
        len : word;
        sub : byte;
      end;
     reply = record
       len : word;
       level : byte;
       oid : longint;
     end;
    var
      bufferin : request;
      bufferout : reply;
      Begin
        bufferin.len := 1;{page 328. works}
        bufferin.sub := $46;
        fillchar(Bufferout,sizeof(bufferout),0);
        bufferout.len := 5;
        callint($e3,bufferin,bufferout,error);
        sec := bufferout.level;
        id := bufferout.oid;
      End;
    {------------------------------------------------------------------------}
    Function upcaseStr(s : string) : String;
    var x : byte;
      begin
        for x := 1 to Length(s) do
        S[x] := Upcase(S[x]);
        upcaseStr := s;
      end;
    {------------------------------------------------------------------------}
    procedure logout;assembler;
      asm
        mov ah,$d7
        int 21h
        mov [byte ptr error],al
      end;
    {------------------------------------------------------------------------}
    function connectnum : byte;assembler;
      asm
        mov ah,$dc
        int 21h{connectnum stored in al. should return}
      end;
    {------------------------------------------------------------------------}
    procedure setbroadcastmode(mode : byte);assembler;
      asm
        mov ah,$de
        mov dl,mode{page 374}
        int 21h
      end;
    {------------------------------------------------------------------------}
    function Getbroadcastmode : byte;assembler;
      asm
        mov ah,$de
        mov dl,$04           {page 374}
        int 21h{broadcastmode stored in al}
      end;
    {------------------------------------------------------------------------}
    Procedure SendBroadCastMessage(Con : Byte;Message : String);
    Type
      Request = Record
        Len : Word;
        sub : byte;
        Stuff : array[1..157] of byte;
      End;
      reply = record
        len : word;
        num : byte;
        list : array[1..100] of byte;
      end;
    Var
      Bufferin : request;
      bufferout : reply;
      i,x : byte;
      Begin
        fillchar(Bufferin,Sizeof(Bufferin),0);
        fillchar(BufferOut,Sizeof(BufferOut),0);
        With Bufferin do
          begin
            len := Length(message)+4;
            Sub := $00;                          {works. page 374}
            I := 1;
            Stuff[i] := 1;{connect num}
            Inc(I);
            Stuff[i] := Con;
            Inc(I);
            Stuff[i] := Length(Message);
            Inc(I);
            for x := 1 to Length(Message) do
              Begin
                stuff[i] := ord(Message[x]);
                inc(I);
              end;
          end;
        callInt($e1,Bufferin,Bufferout,Error);
      End;
    {------------------------------------------------------------------------}
    Function GetMessage(Func : Byte) : String;
    Type
      Request = Record
        Len : Word;
        Sub : Byte;
      End;
      Reply = Record
        Len  : Word;
        messlen : Byte;
        mess : array[1..126] of byte;
      End;
    Var                      {page 376 & 375}
      Bufferin : request;
      BufferOut : Reply;
      duh,x : byte;
      Begin
        getmessage := '';
        fillchar(Bufferin,Sizeof(Bufferin),0);
        Fillchar(Bufferout,Sizeof(Bufferout),0);
        Bufferin.Len := 1;
        Bufferin.Sub := Func;{a personal message or a broadcast message}
        bufferout.Len := 128;
        CallInt($e1,Bufferin,BufferOut,Error);

        duh := bufferout.messlen;
        getmessage[0] := chr(duh);
        for x := 1to duh do
            Getmessage[x] := chr(bufferout.mess[x]);
      End;
    {------------------------------------------------------------------------}
    Procedure SendPersonalMessage(Con : Byte;Message : String);
    Type
      request = Record
        Len : Word;
        Sub : Byte;
        Data : array[1..228] Of Byte;
      End;                        {likely works. page 375-376}
      Reply = Record
        Len : word;
        Num : Byte;
        Results : Array[1..100] of byte;
      End;
    Var
      Bufferin : request;
      Bufferout : reply;
      x,i : byte;
      Begin
        fillchar(Bufferin,Sizeof(Bufferin),0);
        Fillchar(Bufferout,Sizeof(Bufferout),0);
        Bufferin.sub := $04;
        i := 1;
        bufferin.data[i] := 1;{num of connections}
        Inc(i);
        Bufferin.Data[i] := Con;{which connection number?}
        inc(I);
        Bufferin.data[i] := length(message);{length of message}
        Inc(i);
        For X := 1 to Length(Message) do{actual message}
          Begin
            bufferin.data[i] := ord(message[x]);
            inc(i);
          End;
        Bufferin.Len := 4+Length(message);
        callint($e1,bufferin,bufferout,error);{call the int}
      End;
    {------------------------------------------------------------------------}
    procedure broadcastToConsole(message : string);
    Type
      request = record
        len : word;
        sub : byte;
        Messlen : byte;
        mess : array[1..$3c] of byte;
      end;
    var
      bufferin  : request;
      bufferout : noreturn;
      x : byte;
      Begin
        fillchar(Bufferin,Sizeof(Bufferin),0);
        Fillchar(Bufferout,Sizeof(Bufferout),0);
        bufferin.len := 2+length(message);
        bufferin.sub := $09;
        Bufferin.messlen := Length(Message);
        for x := 1 to Length(Message) do
        Bufferin.Mess[x] := ord(message[x]);
        callint($e1,bufferin,bufferout,error);
      End;
    {------------------------------------------------------------------------}
    function idnumber : longint;
    var
      id : longint;
      l : byte;
      begin
        getbinderyaccess(L,id);{just uses this routine}
        idnumber := id;
      end;
    {------------------------------------------------------------------------}
    procedure Getconnectioninfo(Con : byte;Var U : userrec);
    type
      request = record
        len : word;                              {this routine}
        sub : byte;                              {will get all}
        connect : byte;                          {info about a}
      end;                                       {connection..}
      reply = record
        len : word;
        id : longint;
        ot :word;
        stuff : array[1..48] of byte;
        log  : array[0..6] of byte;
      end;
    var
      bufferin : request;
      bufferout : reply;
      x,i : byte;
      t1,t2 : string;
      year : string;
      date : string;
      begin
        bufferin.len := 2;
        bufferin.sub := $16;
        bufferin.connect := con;
        fillchar(Bufferout,sizeof(Bufferout),0);
        bufferout.len := sizeof(Bufferout)-2;
        callint($e3,bufferin,bufferout,error);
        u.objtype := bufferout.ot;
        u.id := bufferout.id;
        t1 := '';
        t1[0] := chr(48);
        i := 1;
        for x := 1 to 48 do
          begin
            t1[x] := chr(bufferout.stuff[i]);
            inc(i);
          end;
       t2 := '';
       t2[0] := chr(7);
       i := 48;
       u.name := t1;
       t1 := '';
       with bufferout do
         begin
           str(log[1],t1);{month}
           date := t1+'\';
           str(log[2],t1);
           date := date+t1+'\'; {day}
           str(log[0],t1); {year}
           date := date+t1;
           u.logindate := date;
           str(log[3],t1);{hour}
           date := t1+':';
           str(log[4],t1);
           date := date+T1+':';{min}
           str(log[5],t1);{sec}
           date := date+t1;
           u.logintime := t1;
           u.weekday := Week[log[6]];
         end;
      delnulls(u.name);
      u.connection := con;
      end;
    {------------------------------------------------------------------------}
    Begin
    End.

[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]