home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / netz / tpnet / ipxtestd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-02  |  11.3 KB  |  352 lines
  1. (*========================================================*)
  2. (*                       IPXTESTD.PAS                     *)
  3. (*            (C) 1993 G. Blumert & DMV-Verlag            *)
  4. (*--------------------------------------------------------*)
  5. (* Compiler:                                              *)
  6. (*   Turbo-Pascal 6.0                                     *)
  7. (* Demo-Anwendung zur Demonstration einer Netzwerkan-     *)
  8. (* wendung.                                               *)
  9. (* Programm in ein Netzwerkverzeichnis kopieren und von   *)
  10. (* verschiedenen Arbeitsstationen aus aufrufen            *)
  11. (* Achtung: Das Programm läuft unter Windows nur exklusiv *)
  12. (* als Vollbild!                                          *)
  13. (* Setzt das Vorhandensein eines Novell-Netzwerks voraus! *)
  14. (*========================================================*)
  15.  
  16. PROGRAM IPXTest;
  17. {$X+}
  18. USES
  19.   App, Dos, IPX, NetLog, Objects, Views, Drivers, Memory,
  20.   MsgBox, Menus;
  21.  
  22. TYPE
  23.   pIPXApp = ^tIPXApp;
  24.   tIPXApp = OBJECT(tApplication)
  25.     LogColl : pLogColl;             (* Liste der Fenster, *)
  26.                                     (* die IPX nutzen     *)
  27.     CONSTRUCTOR Init;
  28.     DESTRUCTOR Done; VIRTUAL;
  29.  
  30.     (* TRUE, wenn Programm unter Windows läuft            *)
  31.     FUNCTION  RunsUnderWindows: BOOLEAN;
  32.     PROCEDURE InitMenuBar; VIRTUAL;
  33.     PROCEDURE GetEvent(VAR Event: tEvent); VIRTUAL;
  34.     PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
  35.  
  36.     (* Öffnet ein neues Fenster für die angegebene        *)
  37.     (* Dateinummer                                        *)
  38.     PROCEDURE InsertWindow(aFileNum: LongInt);
  39.  
  40. PRIVATE
  41.     (* Hier steht die nächste zu vergebende Fensternummer *)
  42.     WinNum  : INTEGER;
  43.  
  44.   END;
  45.  
  46.   pIPXWin = ^tIPXWin;                     (* Demo-Fenster *)
  47.   tIPXWin = OBJECT(tWindow)
  48.     UserColl: PUserColl;
  49.     WinNum : LongInt;       (* Vereinfacht die Sache für  *)
  50.                             (* FormatStr bzw. MsgBox      *)
  51.     FileNum: LongInt;       (* LongInt auch wegen der     *)
  52.                             (* FormatStr-Routine          *)
  53.     IsValid: BOOLEAN;
  54.     CONSTRUCTOR Init(aNumber: INTEGER; aFileNum: LongInt);
  55.     FUNCTION Valid(Command: WORD): BOOLEAN; VIRTUAL;
  56.     PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
  57.   END;
  58.  
  59. CONST
  60.   cm_NewFile1       = 1001; (* Fenster für Datei 1 öffnen *)
  61.   cm_NewFile2       = 1002; (* Fenster für Datei 2 öffnen *)
  62.   cm_NewFile3       = 1003; (* Fenster für Datei 3 öffnen *)
  63.   cm_SendCommand    = 1004;
  64.  
  65. CONSTRUCTOR tIPXWin.Init(aNumber: INTEGER;
  66.                          aFileNum: LongInt);
  67. VAR
  68.   r    : tRect;
  69.   fName: PathStr;
  70. BEGIN
  71.   fName := ParamStr(0);
  72.   WHILE fName[Length(fName)] <> '\' DO Dec(fName[0]);
  73.   fName := fName + 'IPXTEST.LG' + CHAR(aFileNum + Ord('0'));
  74.   DeskTop^.GetExtent(r);
  75.   tWindow.Init(r, fName, aNumber);
  76.   FileNum := aFileNum;
  77.   WinNum  := aNumber;
  78.   Options := Options OR ofTileable;
  79.   (* Wenn das einloggen nicht klappt, Fenster ungültig    *)
  80.   (* machen                                               *)
  81.   UserColl := pIPXApp(Application)^.LogColl^.LogIn(fName,
  82.                                                      @Self);
  83.   IsValid := UserColl <> NIL
  84. END;
  85.  
  86. (* Beim Initialisieren wird geprüft, ob das Einloggen     *)
  87. (* erfolgreich war. Das Schließen wird nur nach           *)
  88. (* erfolgreichem Ausloggen gestattet - was zwar fatal     *)
  89. (* ist, wenn der Server abgeschmiert ist, aber dann sind  *)
  90. (* die Daten ja sowieso beim Teufel . . .                 *)
  91. FUNCTION tIPXWin.Valid(Command: WORD): BOOLEAN;
  92. BEGIN
  93.   Valid := TRUE;
  94.   IF Command = cmValid THEN Valid := IsValid ELSE
  95.   IF Command = cmClose THEN
  96.    IF NOT pIPXApp(Application)^.LogColl^.LogOut(@Self) THEN
  97.    BEGIN
  98.     MessageBox(^c'Fenster %d:'#13'Datei %d konnte nicht ' +
  99.                  'ausloggen!',
  100.                @WinNum,
  101.                mfInformation OR mfOkButton);
  102.     Valid := FALSE;
  103.   END
  104. END;
  105.  
  106. PROCEDURE tIPXWin.HandleEvent(VAR Event: tEvent);
  107. VAR
  108.   WinID: pIPX_WindowID;
  109.  
  110.   FUNCTION IsIPXCommand(aCommand: WORD): BOOLEAN;
  111.   BEGIN
  112.     IsIPXCommand := (aCommand = wm_CommandReceived) OR
  113.                     (aCommand = wm_LoggedIn) OR
  114.                     (aCommand = wm_LoggedOut)
  115.    END;
  116.  
  117. BEGIN
  118.   tWindow.HandleEvent(Event);
  119.  
  120.   IF (Event.What = evCommand) AND
  121.      (Event.Command = cm_SendCommand) THEN BEGIN
  122.     UserColl^.SendCommand(wm_CommandReceived,NIL);
  123.     ClearEvent(Event)
  124.  
  125.   END ELSE IF (Event.What = evBroadcast) AND
  126.              IsIPXCommand(Event.Command) AND
  127.           (pIPX_Packet(Event.InfoPtr)^.Data.DestWin = @Self)
  128.   THEN BEGIN
  129.     CASE Event.Command OF
  130.       wm_CommandReceived:
  131.         MessageBox(^c'Fenster %d:'#13'Datei %d' +
  132.                      ' wurde bearbeitet!', @WinNum,
  133.                      mfInformation OR mfOkButton);
  134.       wm_LoggedIn:
  135.         BEGIN
  136.           UserColl^.AddUser(Event.InfoPtr);
  137.           MessageBox('Fenster %d:'#13+
  138.                      'Datei %d hat einen weiteren Nutzer',
  139.                      @WinNum, mfInformation OR mfOkButton);
  140.         END;
  141.       wm_LoggedOut:
  142.         BEGIN
  143.         UserColl^.DeleteUser(Event.InfoPtr);
  144.         MessageBox(^c'Fenster %d:'#13^c +
  145.                    'Datei %d hat einen Nutzer weniger',
  146.                    @WinNum, mfInformation OR mfOkButton);
  147.       END
  148.  
  149.     ELSE Exit END;
  150.  
  151.     BuffColl^.ClearPacket(Event.InfoPtr);(* !! Wichtig !! *)
  152.     ClearEvent(Event);    (* Unbedingt diese Reihenfolge! *)
  153.   END;
  154. END;
  155.  
  156. CONSTRUCTOR tIPXApp.Init;
  157. VAR
  158.   r: tRect;
  159.   i: INTEGER;
  160.  
  161.   (* Leert den Tastaturpuffer und wartet dann auf eine    *)
  162.   (* Taste                                                *)
  163.   FUNCTION GetKey: CHAR; ASSEMBLER;
  164.   ASM
  165.   @Nochmal:
  166.     MOV  AH, 1      (* Funkt. $01 - Prüfe Tastaturpuffer  *)
  167.     INT  16H        (* Tastatur-Interrupt                 *)
  168.     JZ   @leer      (* Zeichen vorhanden?                 *)
  169.     MOV  AH, 0      (* Dann Funkt. $$00 aufrufen -        *)
  170.                     (* Zeichen lesen                      *)
  171.     INT  16H        (* Tastatur-Interrupt                 *)
  172.     JMP  @Nochmal   (* Noch mehr Zeichen im Puffer ?      *)
  173.   @leer:
  174.     MOV  AH, 0
  175.     INT  16H      (* Rückgabe: AH ScanCode, AL Tastencode *)
  176.   END;
  177.  
  178. BEGIN
  179.   IF NOT InitIPX THEN BEGIN              (* !! Wichtig !! *)
  180.     PrintStr('IPX nicht geladen!'#13#10);
  181.     Halt(1)
  182.   END;
  183.   IF RunsUnderWindows THEN BEGIN    (* !! Auch wichtig !! *)
  184.     PrintStr('Programm muß exklusiv als Vollbild laufen!'  +
  185.              #13#10);
  186.     PrintStr('Wenn nicht, dann ist gleich der Griff zum '  +
  187.              'Reset-Schalter fällig!'#13#10+
  188.              'Abbruch mit <Esc>, mit jeder Taste Programm' +
  189.              ' starten . . .');
  190.     IF GetKey = #27 THEN Halt(2);
  191.     ASM
  192.       MOV AX, 1681H             (* Begin critical section *)
  193.       INT 2FH                   (* Verhinder Taskwechsel  *)
  194.     END;
  195.   END;
  196.   tApplication.Init;
  197.   WinNum := 1;          (* 1. zu vergebende Fensternummer *)
  198.   LogColl := New(PLogColl,Init);
  199.   IF LogColl = NIL THEN Fail;     (* Speicher reservieren *)
  200.   DeskTop^.GetExtent(r);
  201.   FOR i := 1 TO 3 DO InsertWindow(i); (* Fenster einfügen *)
  202.   DeskTop^.Tile(r);
  203. END;
  204.  
  205. DESTRUCTOR tIPXApp.Done;
  206. BEGIN
  207.   IF LogColl <> NIL THEN Dispose(LogColl,Done);
  208.   IF RunsUnderWindows THEN ASM
  209.     MOV AX, 1682H;                (* End critical section *)
  210.     INT 2FH
  211.   END;
  212.   tApplication.Done
  213. END;
  214.  
  215. (* Windows setzt bei der Initialisierung die              *)
  216. (* Umgebungsvariable WINDIR. Allerdings, immer in Klein-  *)
  217. (* buchstaben.                                            *)
  218. (* Die Funktion GetEnv hingegen wandelt den übergebenen   *)
  219. (* Variablennamen in Großbuchstaben um - und findet dann  *)
  220. (* das klein geschriebene windir nicht.                   *)
  221. (* Daher muß man jeden Eintrag "zu Fuß" prüfen            *)
  222. FUNCTION tIPXApp.RunsUnderWindows: BOOLEAN;
  223. VAR
  224.   j: INTEGER;
  225.  
  226. {$IFDEF Ver70}
  227.   FUNCTION ToUpper(CONST s: STRING): STRING;
  228. {$ELSE}
  229.   FUNCTION ToUpper(s: STRING): STRING;
  230. {$ENDIF}
  231.   VAR
  232.     i: BYTE;
  233.   BEGIN
  234.     FOR i := 1 TO Length(s) DO s[i] := UpCase(s[i]);
  235.     ToUpper := s
  236.   END;
  237.  
  238. BEGIN
  239.   RunsUnderWindows := FALSE;
  240.   FOR j := 1 TO EnvCount DO
  241.     IF Pos('WINDIR=', ToUpper(EnvStr(j))) = 1 THEN
  242.       RunsUnderWindows := TRUE
  243. END;
  244.  
  245.  
  246. PROCEDURE tIPXApp.InitMenuBar;
  247. VAR
  248.   r: tRect;
  249. BEGIN
  250.   DeskTop^.GetExtent(r);
  251.   r.B.Y := Succ(r.A.Y);
  252.   MenuBar := New(pMenuBar, Init(r, NewMenu(
  253.     NewSubMenu('~D~atei', hcNoContext, NewMenu(
  254.       NewItem('Datei ~1~', '', kbNoKey,cm_NewFile1, 0,
  255.       NewItem('Datei ~2~', '', kbNoKey,cm_NewFile2, 0,
  256.       NewItem('Datei ~3~', '', kbNoKey,cm_NewFile3, 0,
  257.       NewLine(
  258.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, 0,
  259.     NIL)))))),
  260.     NewSubMenu('~N~etzwerk', hcNoContext, NewMenu(
  261.       NewItem('~N~achricht abschicken', 'F2', kbF2,
  262.               cm_SendCommand, hcNoContext,
  263.     NIL)),
  264.     NewSubMenu('~F~enster', hcNoContext, NewMenu(
  265.       NewItem('~B~ewegen', 'STRG+F5', kbCtrlF5, cmResize, 0,
  266.       NewItem('~Z~oom', 'F5', kbF5,cmZoom, hcNoContext,
  267.       NewItem('~T~ile', '', kbNoKey, cmTile, hcNoContext,
  268.       NewItem('~C~ascade', '', kbNoKey, cmCascade, 0,
  269.       NewItem('~V~origes', 'STRG+F6', kbCtrlF6, cmPrev, 0,
  270.       NewItem('~N~ächstes', 'F6', kbF6, cmNext, hcNoContext,
  271.       NewItem('~S~chließen', 'ALT+F3', kbAltF3, cmClose, 0,
  272.     NIL)))))))),
  273.   NIL))))))
  274. END;
  275.  
  276. (* Wenn ein Paket angekommen ist, dieses weiterreichen,   *)
  277. (* sonst normale Event-Behandlung                         *)
  278. PROCEDURE tIPXApp.GetEvent(VAR Event: tEvent);
  279. BEGIN
  280.   WITH BuffColl^ DO
  281.     IF (NOT PacketAvailable) THEN
  282.       tApplication.GetEvent(Event)
  283.   ELSE BEGIN
  284.     WITH Event DO BEGIN
  285.       InfoPtr := GetPacket;
  286.       What := evBroadcast;
  287.       Event.Command :=
  288.                    pIPX_Packet(Event.InfoPtr)^.Data.Command;
  289.     END;
  290.   END;
  291. END;
  292.  
  293. PROCEDURE tIPXApp.HandleEvent(VAR Event: tEvent);
  294. VAR
  295.   WinID    : pIPX_WindowID;
  296.   UserColl : PUserColl;
  297.   TheParent: pView;
  298.   r        : tRect;
  299.  
  300.   PROCEDURE CloseAll(Item: pView); FAR;
  301.   BEGIN
  302.     Message(Item,evCommand,cmClose,NIL)
  303.   END;
  304.  
  305. BEGIN
  306.  
  307. (* Es ist wichtig, daß die Fenster alle einzeln           *)
  308. (* ordentlich geschlossen  werden. Anderenfalls bleiben   *)
  309. (* eventuell LOG-Dateien zurück!                          *)
  310.  
  311.   IF (Event.Command = cmQuit) THEN
  312.     DeskTop^.ForEach(@CloseAll);
  313.  
  314. (* Hier kann man jetzt, wenn es beim Schließen der        *)
  315. (* Fenster zu einem Fehler kommt, ClearEvent aufrufen, um *)
  316. (* das Programm doch nicht zu beenden                     *)
  317.  
  318.   tApplication.HandleEvent(Event);
  319.   IF Event.What = evCommand THEN BEGIN
  320.     CASE Event.Command OF
  321.       cmTile: BEGIN
  322.         DeskTop^.GetExtent(r);
  323.         DeskTop^.Tile(r)
  324.       END;
  325.       cmCascade: BEGIN
  326.         DeskTop^.GetExtent(r);
  327.         DeskTop^.Cascade(r)
  328.       END;
  329.       cm_NewFile1: InsertWindow(1);
  330.       cm_NewFile2: InsertWindow(2);
  331.       cm_NewFile3: InsertWindow(3);
  332.     ELSE Exit END;
  333.     ClearEvent(Event)
  334.   END
  335. END;
  336.  
  337. PROCEDURE tIPXApp.InsertWindow(aFileNum: LongInt);
  338. BEGIN
  339.   DeskTop^.Insert(ValidView(New(pIPXWin, Init(WinNum,
  340.                                                aFileNum))));
  341.   Inc(WinNum)
  342. END;
  343.  
  344. VAR TestApp: tIPXApp;
  345. BEGIN
  346.   IF TestApp.Init THEN TestApp.Run;
  347.   TestApp.Done;
  348. END.
  349.  
  350. (*========================================================*)
  351. (*                    Ende von IPXTESTD.PAS               *)
  352.