home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / wpfoot / testfoot.mod < prev   
Text File  |  1995-04-14  |  4KB  |  169 lines
  1. MODULE TESTFOOT;
  2.  
  3. (*************************************************************************
  4.    TESTFOOT     Workplace Shell class registration for 'Foot'
  5.  
  6.    Copyright (c) 1995 by Juergen Neuhoff
  7.  
  8.    Description: This module performs the registration of a sample
  9.    workplace class 'Foot'. The class must be implemented in a module
  10.    'FOOT.DLL'.
  11. **************************************************************************)
  12.  
  13.  
  14.  
  15. (*$XL+*)
  16. (*$XF+*)
  17. (*$LINK   NAME TESTFOOT WINDOWCOMPAT   STACKSIZE 8096 *)
  18.  
  19. IMPORT SYSTEM;
  20. IMPORT WINWORKPLACE;
  21. IMPORT DOSPROCESS;
  22. IMPORT OS2DEF;
  23. IMPORT SOM;
  24. IMPORT DOSFILEMGR;
  25. IMPORT Conversions;
  26. IMPORT Strings;
  27.  
  28.  
  29. (****
  30.  
  31. PROCEDURE SOMError
  32. (
  33.   Code       : SOM.INT;
  34.   FileName   : ARRAY OF CHAR;
  35.   LineNumber : SOM.INT
  36. );
  37. VAR
  38.   rc           : OS2DEF.APIRET;
  39.   hLog         : DOSFILEMGR.HFILE;
  40.   ActionTaken  : LONGCARD;
  41.   BytesWritten : LONGCARD;
  42.   LineStr      : ARRAY [0..12] OF CHAR;
  43.   LogLocation  : LONGCARD;
  44. BEGIN
  45.   rc := DOSFILEMGR.DosOpen
  46.   ( "TESTFOOT.LOG",
  47.     hLog,
  48.     ActionTaken,
  49.     0,
  50.     DOSFILEMGR.FILE_NORMAL,
  51.     DOSFILEMGR.OPEN_ACTION_CREATE_IF_NEW +
  52.     DOSFILEMGR.OPEN_ACTION_OPEN_IF_EXISTS,
  53.     DOSFILEMGR.OPEN_SHARE_DENYNONE +
  54.     DOSFILEMGR.OPEN_ACCESS_READWRITE,
  55.     NIL
  56.   );
  57.   IF rc = 0 THEN
  58.     rc := DOSFILEMGR.DosSetFilePtr
  59.     ( hLog,
  60.       0,
  61.       DOSFILEMGR.FILE_END,
  62.       LogLocation
  63.     );
  64.     IF rc = 0 THEN
  65.       rc := DOSFILEMGR.DosWrite
  66.       ( hLog,
  67.         "File : ",
  68.         7,
  69.         BytesWritten
  70.       );
  71.       IF rc = 0 THEN
  72.         rc := DOSFILEMGR.DosWrite
  73.         ( hLog,
  74.           FileName,
  75.           Strings.Size( FileName ),
  76.           BytesWritten
  77.         );
  78.         IF rc = 0 THEN
  79.           rc := DOSFILEMGR.DosWrite
  80.           ( hLog,
  81.             "  Line : ",
  82.             9,
  83.             BytesWritten
  84.           );
  85.           IF rc = 0 THEN
  86.             Conversions.LongIntToStr( LineNumber, LineStr );
  87.             rc := DOSFILEMGR.DosWrite
  88.             ( hLog,
  89.               LineStr,
  90.               Strings.Length( LineStr ),
  91.               BytesWritten
  92.             );
  93.           END;
  94.         END;
  95.       END;
  96.     END;
  97.   END;
  98.   DOSFILEMGR.DosClose( hLog );
  99.   IF rc <> 0 THEN
  100.     DOSPROCESS.DosBeep( 1500, 500 );
  101.   END;
  102. END SOMError;
  103.  
  104. ****)
  105.  
  106.  
  107.  
  108. VAR
  109.   hobj             : WINWORKPLACE.HOBJECT;
  110.   done             : BOOLEAN;
  111.   rc               : OS2DEF.APIRET;
  112.   somFindClsInFile : SOM.somMethodPtr;
  113.   FootPath         : ARRAY [0..OS2DEF.CCHMAXPATHCOMP-1] OF CHAR;
  114.  
  115. BEGIN
  116. (****
  117.   (* for debugging only ... *)
  118.   SOM.SOMClassMgrObject := SOM.somEnvironmentNew();
  119.   somFindClsInFile := SOM.somClassResolve
  120.   ( SOM.SOMClassMgrClassData.classObject,
  121.     SOM.SOMClassMgrClassData.somFindClsInFile
  122.   );
  123.   SOM.SOMError := SOMError;
  124.   SOM.SOM_TraceLevel   := 2;
  125.   SOM.SOM_WarnLevel    := 1;
  126.   SOM.SOM_AssertLevel  := 2;
  127. ****)
  128.  
  129.   (* class registration *)
  130.   rc := DOSFILEMGR.DosQueryPathInfo
  131.   ( "FOOT.DLL", DOSFILEMGR.FIL_QUERYFULLNAME, FootPath, SIZE( FootPath ) );
  132.   IF rc = 0 THEN
  133.     done := WINWORKPLACE.WinRegisterObjectClass( "Foot", FootPath );
  134.   ELSE
  135.     done := FALSE;
  136.   END;
  137.   IF NOT done THEN
  138.     rc := DOSPROCESS.DosBeep( 500, 500 );
  139.   END;
  140.  
  141. (****
  142.   (* object creation *)
  143.   IF done THEN
  144.     hobj := WINWORKPLACE.WinCreateObject
  145.     (
  146.       "Foot",
  147.       "MyFoot",
  148.       "",
  149.       "C:\",
  150.       WINWORKPLACE.CO_REPLACEIFEXISTS
  151.     );
  152.     IF hobj <> 0 THEN
  153.       RETURN;
  154.     END;
  155.   END;
  156.   rc := DOSPROCESS.DosBeep( 2000, 1500 );
  157. ****)
  158.  
  159. (****
  160.   (* class deregistration *)
  161.   done := WINWORKPLACE.WinDeregisterObjectClass( "Foot" );
  162.   IF NOT done THEN
  163.     rc := DOSPROCESS.DosBeep( 500, 1500 );
  164.   END;
  165.   RETURN;
  166. ****)
  167.  
  168. END TESTFOOT.
  169.