+ demo for netware check-funcktion

rtl/netware/demos/Makefile

@@ -0,0 +1,25 @@
+# Makefile for freepascal nlm-test
+# Needs working nlmconv + i386-netware-ld
+# AD 8/2000
+
+PPC386OPT = -XX -O3 -Tnetware -Xs
+INCLUDES = 
+
+OBJS = check.on
+
+%.on:	%.pp
+	ppc386 $(PPC386OPT) $(INCLUDES) $*.pp
+
+all:	$(OBJS)
+
+# copy test.nlm to sys:test on 4.11 (fs-develop) and 5.1 (fs-ad) server
+install:	all
+	ncftpput -u linux -p linux fs-develop /sys/test *.nlm
+	ncftpput -u linux -p linux fs-ad /sys/test *.nlm
+
+clean:
+	rm -f *.on *.nlm *.ppn *.s *.bak *.o *.a
+
+dist:		clean
+
+distclean:	clean

rtl/netware/demos/check.pp

@@ -0,0 +1,54 @@
+{
+    $Id$
+    This file is part of Free Pascal for Netware.
+    Copyright (c) 1999-2002 by the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+    
+    Demonstrates the use of the check-function provided by the RTL
+ **********************************************************************}
+ 
+{$MODE OBJFPC}
+{$Description Demo CheckFunction for FreePascal Netware-RTL}
+{$Version 1.0.0}
+{$Copyright (c) 2002 the FreePascal development team}
+
+
+{ using crt automaticly calls _SetAutoScreenDestructionMode (TRUE);
+  so no "Press any key to close screeen" will be shown by netware }
+uses crt;
+
+var first : boolean = true;
+
+procedure checkfunction (var res : longint);
+begin
+  if first then
+  begin
+    ConsolePrintf (#13'It is unsafe to unload the nlm'#13#10);
+    res := 1;
+  end;
+  first := false;
+end;
+
+begin
+  WriteLn ('Press any key to unload nlm or unload via unload command');
+  WriteLn ('The first unload should show a message that it is unsafe');
+  WriteLn ('to unload the NLM, the second attempt should unload the');
+  WriteLn ('NLM without a message.');
+  System.NetwareCheckFunction := @checkfunction;
+  ReadKey;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-03-30 09:12:15  armin
+  + demo for netware check-funcktion
+
+ 
+}
+