Turbo Toolbox/Turbo_Toolbox.iso/dtx9303/netz/tpnet/netlog.pas

Pascal/Delphi Source File | 1993-06-02 | 23.9 KB | 822 lines

{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
(*========================================================*)
(*                        NETLOG.PAS                      *)
(*            (C) 1993 G. Blumert & DMV-Verlag            *)
(*--------------------------------------------------------*)
(* Implementiert die Listen zur Verwaltung der geöffneten *)
(*                          Fenster                       *)
(* Compiler:                                              *)
(*   Turbo-Pascal ab 6.0 oder Turbo-Pascal für Windows    *)
(*========================================================*)

UNIT NetLog;

INTERFACE
{$IFDEF Windows}
USES
  MyWinDos,
  {$IFDEF Ver70}Objects, OWindows, OMemory,(* Oh-Borland *)
  {$ELSE}       WObjects, {$ENDIF}
  WinProcs, WinTypes, IPX, DPMI;
{$ELSE}
USES
  IPX, Objects, Views, Memory, Dos, App, MsgBox, Drivers;
{$ENDIF}

TYPE
  (* Eindeutige Identifikation eines Fensters *)
  pIPX_WindowID = ^tIPX_WindowID;
  tIPX_WindowID = RECORD
    IPX_ID: tIPX_ID;
    Socket: WORD;
{$IFDEF Windows}
    Win_ID: pWindowsObject;
{$ELSE}
    Win_ID: pView
{$ENDIF}
  END;

  (* Speichert alle Anwendungen, die sich für die gleiche *)
  (* Datei angemeldet haben.                              *)
  (* Enthält Einträge vom Typ pIPX_WindowID               *)
  pUserColl = ^tUserColl;
  tUserColl = OBJECT(tCollection)  (* besitzendes Fenster *)

{$IFDEF Windows}
    Parent: pWindowsObject;
{$ELSE}
    Parent: pView;
{$ENDIF}
    FileName: pString;              (* Name der LOG-Datei *)

   (* Erwartet die Socket-Nummer, an der nach Paketen für *)
   (* das Fenster gelauscht wird                          *)
    CONSTRUCTOR Init(aReceiveSocket: WORD);
    DESTRUCTOR Done; VIRTUAL;

    (* Gibt den von einer TIPX_WindowID belegten          *)
    (* Speicherplatz frei                                 *)
    PROCEDURE FreeItem(Item: POINTER); VIRTUAL;

    (* Liest die Adressen der bereits eingeloggten        *)
    (* Fenster ein                                        *)
    FUNCTION ReadLogFile(VAR f: FILE): BOOLEAN;

    (* Schickt die Daten an alle anderen Fenster ab       *)
    PROCEDURE SendCommand(Command: WORD;
                          aUserData: pUserData);

    (* Die folgenden beiden Funktionen nicht selber       *)
    (* aufrufen! - bzw. nur, wenn Sie genau wissen, was   *)
    (* Sie tun.                                           *)
    (* Wird von LogColl.LogIn aufgerufen                  *)
{$IFDEF Windows}
    FUNCTION LogIn(aParent: pWindowsObject;
                            aFileName: PathStr): BOOLEAN;
{$ELSE}
    FUNCTION LogIn(aParent: pView;
                   aFileName: PathStr): BOOLEAN;
{$ENDIF}

    (* Wird vom Destruktor aufgerufen                     *)
    FUNCTION LogOut: BOOLEAN;

    (* Sucht den zum empfangenen Paket gehörigen Absender *)
    (* aus der User-Liste heraus                          *)
    FUNCTION FindSender(aPacket: pIPX_Packet):pIPX_WindowID;

    (* Muß von jedem Fenster aufgerufen werden, das eine  *)
    (* LogIn-Message empfangen hat                        *)
    PROCEDURE AddUser(aPacket: pIPX_Packet);

    (* Muß von jedem Fenster aufgerufen werden, das eine  *)
    (* LogOut-Message erhalten hat                        *)
    PROCEDURE DeleteUser(aPacket: pIPX_Packet);
  END;

  (* Verwaltet alle LOG-Dateien, die die Anwendung nutzt  *)
  (* Enthält Einträge vom Typ PUserColl }                 *)
  pLogColl = ^tLogColl;
  tLogColl = OBJECT(tCollection)
    IsListening: BOOLEAN;
    Socket: WORD;(* Hi-Lo; Hier wird nach Daten gelauscht *)
    CONSTRUCTOR Init;
    DESTRUCTOR Done; VIRTUAL;

    (* Setzt IsListening auf TRUE und ruft                *)
    (* ListenForPacket auf                                *)
    PROCEDURE StartListening;

    (* Setzt IsListening auf FALSE und bricht             *)
    (* ListenForPacket per CancelEvent ab                 *)
    PROCEDURE StopListening;

    (* Meldet die Benutzung der Datei an.                 *)
{$IFDEF Windows}
    FUNCTION LogIn(LogFileName: PathStr; aParent:
                   pWindowsObject): pUserColl;
{$ELSE}
    FUNCTION LogIn(LogFileName: PathStr; aParent: pView):
                                                  pUserColl;
{$ENDIF}

    (* Meldet das Fenster wieder ab *)
{$IFDEF Windows}
    FUNCTION LogOut(aParent: pWindowsObject): BOOLEAN;
{$ELSE}
    FUNCTION LogOut(aParent: pView): BOOLEAN;
{$ENDIF}

    (* Gibt die User-Liste für das angegebene Fenster     *)
    (* zurück                                             *)
{$IFDEF Windows}
    FUNCTION GetUserColl(aParent: pWindowsObject):pUserColl;
  PRIVATE
    EventProc: POINTER;   (* Per MakeProcInstance         *)
                          (* festgelegte Prot.-Mode-Adr.  *)
    CallBackAdr: POINTER; (* Von DPMI erhaltener Call-    *)
                          (* Back für EventProc           *)
    DOSPtr: POINTER;      (* Real-Mode-Adresse des Event- *)
                          (* Handlers in WinNet           *)
{$ELSE}
    FUNCTION GetUserColl(aParent: pView): pUserColl;
{$ENDIF}
  END;


  (* Puffert die ankommenden Pakete. Enthält Einträge vom *)
  (* Typ pIPX_Packet.                                     *)
  (* Außerdem ist hier die Stelle, wo das Programm nach   *)
  (* ankommenden Paketen schaut und diese ggf. anfordert. *)
  (* Die Anwendung muß nach Bearbeitung des Pakets        *)
  (* unbedingt ClearPacket aufrufen, da erst dann das     *)
  (* nächste Paket »ausgegeben« wird, bzw. unter der      *)
  (* Speicherplatz erst dann wieder neu belegt wird.      *)

  pBuffColl = ^tBuffColl;
  tBuffColl = OBJECT(tCollection)

    (* Reserviert Platz für 100 Pakete, da die Routinen   *)
    (* der dynamischen Speicherverwaltung nicht reentrant *)
    (* sind.                                              *)
    CONSTRUCTOR Init;

    (* Nach Bearbeitung eines Pakets aufrufen! *)
    PROCEDURE ClearPacket(Packet: pIPX_Packet);

    (* Gibt den von einem tIPX_Packet belegten Speicher   *)
    (* frei                                               *)
    PROCEDURE FreeItem(Item: POINTER); VIRTUAL;

{$IFNDEF Windows}
    (* TRUE, wenn Daten abgerufen werden können           *)
    FUNCTION PacketAvailable: BOOLEAN;

    (* Gibt das nächste Datenpaket zurück                 *)
    FUNCTION GetPacket: pIPX_Packet;

  PRIVATE
    PacketInUse            : BOOLEAN;
    (* --> TRUE, wenn Paket in Bearbeitung                *)
    FUNCTION FindUsedPacket: pIPX_Packet;
    (* Ermittelt das nächste empfangene Packet            *)
 {$ENDIF}
  END;

(* Überprüft zwei beliebige Datenfelder auf Gleichheit    *)
(* Sollte sich in jeder Utility-Bibliothek befinden       *)
FUNCTION IsEqual(VAR M1, M2; MSize: WORD): BOOLEAN;

CONST
  (* Puffert die ankommenden Pakete                       *)
  BuffColl: pBuffColl = NIL;


IMPLEMENTATION

CONST
  (* Hier legt IPX die ankommenden Daten ab               *)
  IPX_PacketBuffer: pIPX_Packet = NIL;

  (* Event-Control-Block für die Empfangs-Funktion        *)
  ECB: pECB = NIL;

  { Socket, an dem nach Paketen gelauscht wird }
  ReceiveSocket: WORD = 0;


{$IFDEF Windows}
  Packet_Sel: LongInt = 0;  (* Von GlobalDOSAlloc ...     *)
  ECB_Sel   : LongInt = 0;  (* zurückgegebene Werte       *)
{$ENDIF}

(* Gibt TRUE zurück, wenn eine andere Anwendung der       *)
(* Empfänger des Pakets ist                               *)
FUNCTION IsDifferentNode(Packet: pIPX_Packet): BOOLEAN;
BEGIN
  WITH Packet^ DO IsDifferentNode :=
    (NOT IsEqual(Dest,MyIPX_ID,SizeOf(tIPX_ID))) OR
    (ReceiveSocket <> Dest_Socket)
END;

(* Überprüft zwei beliebige Datenfelder auf Gleichheit    *)
FUNCTION IsEqual(VAR M1, M2; MSize: WORD): BOOLEAN;
                                                  ASSEMBLER;
ASM
  CLD
  PUSH    DS                             (* DS sichern    *)
  LES     DI, M1                         (* ES:DI = M1    *)
  LDS     SI, M2                         (* DS:SI = M2    *)
  MOV     CX, MSize                      (* Länge         *)
  XOR     AX, AX
  TEST    CX, 1                          (* Länge gerade? *)
  JZ      @SeekWord
  CMPSB                                  (* Nein          *)
  JNZ     @Ab                            (* Ungleich?     *)
@SeekWord:
  SHR     CX, 1                          (* /2            *)
  JCXZ    @AbTrue                        (* schon fertig? *)
  REPE    CMPSW
  JNZ     @Ab                            (* Ungleich?     *)
@AbTrue:
  Inc     AL                             (* Nein - AL = 1 *)
@Ab:
  POP     DS
END;

(*--------------------------------------------------------*)
(* Es folgt der Eventhandler, der bei Eintreffen eines    *)
(* Paketes angesprungen wird. Dieser muß als FAR          *)
(* definiert sein.                                        *)
(* Die Stack-Prüfung darf nicht eingeschaltet sein, da    *)
(* nicht der Turbo-Pascal-Stapel benutzt wird, was die    *)
(* Stack-Prüfroutine meist merkt.                         *)
(* Die Register brauchen nicht gesichert werden,  aber    *)
(* das Datensegment muß richtig gesetzt sein              *)

{$IFOPT S+}
  {$S-}
  {$DEFINE CheckStack}
{$ENDIF}

{$IFDEF Windows}

PROCEDURE DoEvent; FAR;
VAR
  p       : pIPX_Packet;
  UserColl: pUserColl;

  (* Gibt TRUE zurück, wenn das Paket »leer« ist          *)
  FUNCTION IsEmpty(Item: pIPX_Packet): BOOLEAN; FAR;
  BEGIN
    IsEmpty := Item^.Data.Command = 0;
  END;

BEGIN
  p := BuffColl^.FirstThat(@IsEmpty);
  IF p <> NIL THEN BEGIN              (* Noch Platz frei? *)
    p^ := IPX_PacketBuffer^;
    WITH p^.Data DO
      PostMessage(DestWin^.hWindow, Command, 0, LongInt(p))
  END;     (* Hier könnte man jetzt mit ELSE weitermachen *)
           (* und eine Fehlerbehandlung einbauen.         *)
           (* Außerdem könnte man prüfen, ob das Fenster  *)
           (* überhaupt noch existiert, und anderenfalls  *)
           (* gleich ClearPacket aufrufen, damit der      *)
           (* Speicherplatz wieder freigegeben wird.      *)

  (* Auf das nächste Paket warten                         *)
  ListenForPacket(Ptr(HiWord(ECB_Sel), 0));
END;

PROCEDURE IPX_Event; FAR; ASSEMBLER;
ASM
  PUSH  ES
  PUSH  DI
  MOV   AX, [SI]                         (* IP vom Stapel *)
  MOV   ES:[DI+2AH], AX
  MOV   AX, [SI+2]                       (* CS vom Stapel *)
  MOV   ES:[DI+2CH], AX
  MOV   AX, Seg @Data
  MOV   DS, AX
  CALL  DoEvent
  POP   DI
  POP   ES
  IRET
END;

{$ELSE}

PROCEDURE IPX_Event; FAR;
VAR
  p       : pIPX_Packet;
  UserColl: pUserColl;

  FUNCTION IsEmpty(Item: pIPX_Packet): BOOLEAN; FAR;
  BEGIN
    IsEmpty := Item^.Data.Command = 0;
  END;

BEGIN
  ASM
    MOV    AX, Seg @Data
    MOV    DS, AX
  END;
  p := BuffColl^.FirstThat(@IsEmpty);
  IF p <> NIL THEN p^ := IPX_PacketBuffer^;
  ListenForPacket(ECB);
END;
{$ENDIF}

{$IFDEF CheckStack}
(* Falls Stackprüfung vorher aktiv, wieder einschalten    *)
  {$S+}
  {$UNDEF CheckStack}
{$ENDIF}
(*--------------------------------------------------------*)

CONSTRUCTOR tBuffColl.Init;
VAR
  i: INTEGER;
  p: pIPX_Packet;
BEGIN
  tCollection.Init(100, 0);
  FOR i := 0 TO 99 DO BEGIN
    p := MemAlloc(SizeOf(tIPX_Packet));
    IF p <> NIL THEN BEGIN
      FillChar(p^, SizeOf(tIPX_Packet), 0);
      Insert(p)
    END
  END
END;

(* Achtung: Es kann passieren, daß hier Packets ankommen, *)
(* die gar nicht in der Collection enthalten sind!        *)
(* Ist zwar nicht die feine englische Art, spart aber     *)
(* etwas Code.                                            *)
PROCEDURE tBuffColl.ClearPacket(Packet: pIPX_Packet);
BEGIN
  Packet^.Data.Command := 0;
{$IFNDEF Windows}
  IF IndexOf(Packet) <> -1 THEN PacketInUse := FALSE
{$ENDIF}
END;

PROCEDURE tBuffColl.FreeItem(Item: POINTER);
BEGIN
  FreeMem(Item, SizeOf(tIPX_Packet));
END;

{$IFNDEF Windows}

(* TRUE, wenn ein Paket empfangen wurde                   *)
FUNCTION tBuffColl.PacketAvailable: BOOLEAN;
BEGIN
  PacketAvailable := (NOT PacketInUse)
                     AND (FindUsedPacket <> NIL)
END;

(* Gibt das erste benutzte Paket oder NIL zurück          *)
FUNCTION tBuffColl.FindUsedPacket: pIPX_Packet;
  FUNCTION NotEmpty(Item: pIPX_Packet): BOOLEAN; FAR;
  BEGIN
    NotEmpty := Item^.Data.Command <> 0;
  END;
BEGIN
  FindUsedPacket := FirstThat(@NotEmpty);
END;

FUNCTION tBuffColl.GetPacket: pIPX_Packet;
BEGIN
  GetPacket := FindUsedPacket;
  PacketInUse := TRUE;
END;

{$ENDIF}

CONSTRUCTOR tUserColl.Init(aReceiveSocket: WORD);
BEGIN
  tCollection.Init(10,5);
  ReceiveSocket := aReceiveSocket;
  Parent        := NIL;
  FileName      := NIL;
END;

DESTRUCTOR tUserColl.Done;
BEGIN
  IF FileName <> NIL THEN BEGIN
    LogOut;
    DisposeStr(FileName);
  END;
  tCollection.Done;
END;

PROCEDURE tUserColl.FreeItem(Item: POINTER);
BEGIN
  FreeMem(Item,SizeOf(tIPX_WindowID))
END;

FUNCTION tUserColl.ReadLogFile(VAR f: FILE): BOOLEAN;
VAR
  IDPtr: pIPX_WindowID;
BEGIN
  ReadLogFile := FALSE;
  WHILE NOT EoF(f) DO BEGIN
    IDPtr := MemAlloc(SizeOf(tIPX_WindowID));
    IF IDPtr = NIL THEN BEGIN
{$IFNDEF Windows}
      Application^.OutOfMemory;
                  (* Hat Borland bei TPW leider vergessen *)
{$ENDIF}
      Exit
    END;
    BlockRead(f,IDPtr^, SizeOf(tIPX_WindowID));
    Insert(IDPtr)
  END;
  ReadLogFile := TRUE
END;

{$IFDEF Windows}
FUNCTION tUserColl.LogIn(aParent: pWindowsObject;
                         aFileName: PathStr): BOOLEAN;
{$ELSE}
FUNCTION tUserColl.LogIn(aParent: pView;
                         aFileName: PathStr): BOOLEAN;
{$ENDIF}
VAR
  f: FILE;

BEGIN
  LogIn := FALSE;
  Parent := aParent;
  Assign(f, aFileName);
  IF FSearch(aFileName, '') <> '' THEN BEGIN
                                   (* Logdatei vorhanden? *)
    Reset(f,1);
    IF NOT ReadLogFile(f) THEN Exit;
  END ELSE Rewrite(f, 1);

  (* Eigene Adresse eintragen *)
  BlockWrite(f, MyIPX_ID, SizeOf(MyIPX_ID));
  BlockWrite(f, ReceiveSocket, SizeOf(ReceiveSocket));
  BlockWrite(f, aParent, SizeOf(aParent));
  Close(f);
  LogIn := TRUE;
  FileName := NewStr(aFileName);
  SendCommand(wm_LoggedIn, NIL)
END;

FUNCTION tUserColl.LogOut: BOOLEAN;
VAR
  f    : FILE;
  fSize: LongInt;

  PROCEDURE DoWrite(Item: pIPX_WindowID); FAR;
  BEGIN
    BlockWrite(f, Item^, SizeOf(Item^));
  END;

BEGIN                             (* von tUserColl.LogOut *)
  Assign(f,FileName^);
  Rewrite(f, 1);
  ForEach(@DoWrite);
  fSize := FileSize(f);
  Close(f);
  IF fSize = 0 THEN Erase(f)
               ELSE SendCommand(wm_LoggedOut, NIL)
END;

{$IFDEF Windows}
PROCEDURE tUserColl.SendCommand(Command: WORD;
                                aUserData: pUserData);
VAR
  AnECB     : pECB;
  Packet    : pIPX_Packet;
  DosECB,
  DosPacket : LongInt;

  PROCEDURE DoSend(Item: pIPX_WindowID); FAR;
  BEGIN
    FillChar(AnECB^, SizeOf(TECB), 0);
    WITH AnECB^, Item^ DO BEGIN
      Imm_Adr := IPX_ID.NodeAdr;
      Frag_Count := 1;
      Frag_Adr := Ptr(HiWord(DosPacket), 0);
      Frag_Size := SizeOf(tIPX_Packet);
    END;
    FillChar(Packet^, SizeOf(Packet^), 0);
    WITH Packet^, Item^ DO BEGIN
      Dest := IPX_ID;
      Dest_Socket       := Item^.Socket;
      Data.SourceWin    := Parent;
      Data.DestWin      := Win_ID;
      Data.SourceSocket := ReceiveSocket;
      Data.Command      := Command;
      IF aUserData <> NIL THEN Data.UserData := aUserData^
    END;
    (* Nachrichten an andere Anwendungen über das Netz    *)
    (* schicken                                           *)
    IF IsDifferentNode(Packet) THEN
      SendPacketWithoutSocket(Ptr(HiWord(DosECB), 0), AnECB)
    ELSE BEGIN
      Packet^.Source := MyIPX_ID;
      WITH Packet^.Data DO
        SendMessage(DestWin^.hWindow, Command, 0,
                    LongInt(Packet))
    END
  END;

BEGIN
  DosECB    := GlobalDosAlloc(SizeOf(TECB));
  DosPacket := GlobalDosAlloc(SizeOf(tIPX_Packet));
  AnECB     := Ptr(LoWord(DosECB), 0);
  Packet    := Ptr(LoWord(DosPacket), 0);
  ForEach(@DoSend);
  GlobalDosFree(LoWord(DosECB));
  GlobalDosFree(LoWord(DosPacket))
END;

{$ELSE}

PROCEDURE tUserColl.SendCommand(Command: WORD;
                                aUserData: pUserData);
VAR
  AnECB : TECB;
  Packet: tIPX_Packet;

  PROCEDURE DoSend(Item: pIPX_WindowID); FAR;
  BEGIN
    FillChar(AnECB,SizeOf(TECB), 0);
    WITH AnECB, Item^ DO BEGIN
      Imm_Adr    := IPX_ID.NodeAdr;
      Frag_Count := 1;
      Frag_Adr   := @Packet;
      Frag_Size  := SizeOf(tIPX_Packet);
    END;
    FillChar(Packet, SizeOf(Packet), 0);
    WITH Packet, Item^ DO BEGIN
      Dest              := IPX_ID;
      Dest_Socket       := Item^.Socket;
      Data.SourceWin    := Parent;
      Data.DestWin      := Win_ID;
      Data.SourceSocket := ReceiveSocket;
      Data.Command      := Command;
      IF aUserData <> NIL THEN Data.UserData := aUserData^
    END;
    (* Nachrichten an andere Anwendungen über das Netz    *)
    (* schicken                                           *)
    IF IsDifferentNode(@Packet) THEN
      SendPacketWithoutSocket(@AnECB)
    ELSE BEGIN
      Packet.Source := MyIPX_ID;
      WITH Packet.Data DO
        Message(DestWin, evBroadcast, Command, @Packet)
    END
  END;

BEGIN ForEach(@DoSend) END;
{$ENDIF}

FUNCTION tUserColl.FindSender(aPacket: pIPX_Packet):
                                              pIPX_WindowID;

  FUNCTION DoFind(Item: pIPX_WindowID): BOOLEAN; FAR;
  BEGIN
    WITH aPacket^, Item^ DO DoFind :=
      (Win_ID = Data.SourceWin) AND
      IsEqual(IPX_ID, Source, SizeOf(Source)) AND
      (Socket = Data.SourceSocket)
  END;

BEGIN
  FindSender := FirstThat(@DoFind);
END;

PROCEDURE tUserColl.AddUser(aPacket: pIPX_Packet);
VAR
  WinID: pIPX_WindowID;
BEGIN
  WinID := MemAlloc(SizeOf(tIPX_WindowID));
  IF WinID <> NIL THEN WITH WinID^, aPacket^ DO BEGIN
    Win_ID := Data.SourceWin;
    IPX_ID := Source;
    Socket := Data.SourceSocket;
    Insert(WinID);
  END
{$IFNDEF Windows}
   ELSE Application^.OutOfMemory
{$ENDIF}
END;

PROCEDURE tUserColl.DeleteUser(aPacket: pIPX_Packet);
VAR
  WinID: pIPX_WindowID;
BEGIN
  WinID := FindSender(aPacket);
  IF WinID <> NIL THEN Free(WinID) ELSE BEGIN
{$IFDEF Windows}
    MessageBox(GetFocus,
               'Ungⁿltige LogOut-Message empfangen!',
               'Fehler!',
               mb_OK OR mb_IconExclamation);
{$ELSE}
    MessageBox(^C'Ungültige Logout-Message empfangen!', NIL,
                                     mfError OR mfOkButton);
{$ENDIF}
    BuffColl^.ClearPacket(aPacket)
  END
END;

CONSTRUCTOR tLogColl.Init;
LABEL NoMem;                (* Da staunt der Purist . . . *)
VAR
  osResult: BYTE;
  DOSAdr  : POINTER;
BEGIN
  tCollection.Init(10, 5);
  IsListening := FALSE;

{$IFDEF Windows}
  EventProc := MakeProcInstance(@IPX_Event, hInstance);
                                         (* Event-Handler *)
  CallBackAdr := GetCallBack(EventProc);
                                      (* Adresse für DPMI *)
  DOSAdr := InitIPX(CallBackAdr);
  IF DOSAdr = NIL THEN BEGIN
    MessageBox(GetFocus, 'WinNet nicht installiert!',
                         NIL, mb_OK OR mb_IconHand);

{$ELSE}
  IF NOT InitIPX THEN BEGIN
    MessageBox('IPX nicht geladen!', NIL,
               mfError OR mfOkButton);
{$ENDIF}
    Fail;
  END;
  Socket := 0;
  OpenSocket(Socket, osResult, os_AutoClose);
  IF osResult <> osm_SocketOk THEN BEGIN
    IF osResult = osm_SocketAlreadyOpen
{$IFDEF Windows}
     THEN MessageBox(GetFocus,
                     'Socket bereits ge÷ffnet!',
                     'Fehler',
                     mb_OK OR mb_IconExclamation)
     ELSE MessageBox(GetFocus,
                     'Keine freien Sockets mehr!', 'Fehler',
                     mb_OK OR mb_IconExclamation);
{$ELSE}
     THEN MessageBox('Socket bereits geöffnet!', NIL,
                     mfError OR mfOkButton)
     ELSE MessageBox('Keine freien Sockets mehr!', NIL,
                     mfError OR mfOkButton);
{$ENDIF}
    Fail;
  END;
{$IFDEF Windows}
  Packet_Sel := GlobalDosAlloc(SizeOf(tIPX_Packet));
  IF Packet_Sel <> 0 THEN
    IPX_PacketBuffer := Ptr(LoWord(Packet_Sel), 0);
{$ELSE}
  IPX_PacketBuffer := MemAlloc(SizeOf(tIPX_Packet));
{$ENDIF}
  IF IPX_PacketBuffer = NIL THEN BEGIN
NoMem:
    {$IFNDEF Windows} Application^.OutOfMemory; {$ENDIF}
    Fail;
  END;
  FillChar(IPX_PacketBuffer^,SizeOf(tIPX_Packet),0);
{$IFDEF Windows}
  ECB_Sel := GlobalDosAlloc(SizeOf(TECB));
  IF ECB_Sel <> 0 THEN ECB := Ptr(LoWord(ECB_Sel),0);
{$ELSE}
  ECB := MemAlloc(SizeOf(TECB));
{$ENDIF}
  IF ECB = NIL THEN GOTO NoMem;
                 (* GOTO is'n prima Befehl - ... manchmal *)
  FillChar(ECB^,SizeOf(TECB),0);
  WITH ECB^ DO BEGIN                     (* ECB ausfüllen *)
{$IFDEF Windows}
    ESR_Adr := DOSAdr;
{$ELSE}
    ESR_Adr := @IPX_Event;               (* Event-Handler *)
{$ENDIF}
    FillChar(Imm_Adr, SizeOf(Imm_Adr), $FF);
                            (* Empfangen von allen Knoten *)
    Frag_Count := 1;        (* Nur 1 Datenpaket           *)
{$IFDEF Windows}
    Frag_Adr := Ptr(HiWord(Packet_Sel), 0);
{$ELSE}
    Frag_Adr := IPX_PacketBuffer;
{$ENDIF}
    Frag_Size := SizeOf(tIPX_Packet)
  END;
  ECB^.Socket := Socket;        (* Zum Zwischenspeichern: *)
  BuffColl := New(pBuffColl, Init);
END;

(*-------------------  Aufräumen  ------------------------*)
DESTRUCTOR tLogColl.Done;
BEGIN
  FreeAll;
  IF Socket <> 0 THEN BEGIN
    (* Eigentlich überflüssig, doch zur Sicherheit . . .: *)
    StopListening;
    CloseSocket(Socket);
{$IFDEF Windows}
    FreeCallBack(CallBackAdr);
    FreeProcInstance(EventProc);
  END;
  IF Packet_Sel <> 0 THEN GlobalDosFree(LoWord(Packet_Sel));
  IF ECB_Sel <> 0 THEN GlobalDosFree(LoWord(ECB_Sel));
{$ELSE}
  END;
  IF IPX_PacketBuffer <> NIL THEN
    FreeMem(IPX_PacketBuffer, SizeOf(tIPX_Packet));
  IF ECB <> NIL THEN FreeMem(ECB, SizeOf(TECB));
{$ENDIF}
  IF BuffColl <> NIL THEN Dispose(BuffColl, Done)
END;

(* Ermittelt die zum Fenster gehörige User-Liste          *)
{$IFDEF Windows}
FUNCTION tLogColl.GetUserColl(aParent: pWindowsObject):
                                                  pUserColl;
{$ELSE}
FUNCTION tLogColl.GetUserColl(aParent: pView): pUserColl;
{$ENDIF}

  FUNCTION FindParent(Item: pUserColl): BOOLEAN; FAR;
  BEGIN
    FindParent := aParent = Item^.Parent;
  END;

BEGIN
  GetUserColl := FirstThat(@FindParent);
END;

PROCEDURE tLogColl.StartListening;
BEGIN
  IF NOT IsListening THEN BEGIN
                            (* Wird etwa schon gelauscht? *)
{$IFDEF Windows}
    ListenForPacket(Ptr(HiWord(ECB_Sel),0));
{$ELSE}
    ListenForPacket(ECB);
{$ENDIF}
    IsListening := TRUE
  END
END;

PROCEDURE tLogColl.StopListening;
BEGIN
  IF IsListening THEN BEGIN
                        (* Wird überhaupt noch gelauscht? *)
    IsListening := FALSE;
{$IFDEF Windows}
    CancelEvent(Ptr(HiWord(ECB_Sel),0));
{$ELSE}
    CancelEvent(ECB);
{$ENDIF}
  END
END;

{$IFDEF Windows}
FUNCTION tLogColl.LogIn(LogFileName: PathStr;
                        aParent: pWindowsObject): pUserColl;
{$ELSE}
FUNCTION tLogColl.LogIn(LogFileName: PathStr;
                        aParent: pView): pUserColl;
{$ENDIF}
VAR UserColl: pUserColl;
BEGIN
  LogIn := NIL;
  UserColl := New(pUserColl,Init(Socket));
  IF UserColl^.LogIn(aParent, LogFileName) THEN BEGIN
    Insert(UserColl);
    StartListening;
    LogIn := UserColl
  END
END;

{$IFDEF Windows}
FUNCTION tLogColl.LogOut(aParent: pWindowsObject): BOOLEAN;
{$ELSE}
FUNCTION tLogColl.LogOut(aParent: pView): BOOLEAN;
{$ENDIF}
VAR UserColl: pUserColl;
BEGIN
  LogOut := FALSE;
  UserColl := GetUserColl(aParent);
  IF UserColl <> NIL THEN BEGIN
    Free(UserColl);
    IF Count = 0 THEN StopListening; (* Letzter Lauscher? *)
    LogOut := TRUE
  END;
END;

END.

(*========================================================*)
(*                     Ende von NETLOG.PAS                *)