home *** CD-ROM | disk | FTP | other *** search
- Comment
- ========================================
-
- METER.INC
- (c) Copyright 1990-1991 Computer Tyme * All rights reserved
-
- This software metering module counts how many users are using an
- application and limits it to a fixed number of users. Thus, you can
- save money on other software by limiting the number of people who can
- run an application to the number of copies you own.
-
- This can also be used to limit an application to 1 user where the
- application only works on a network if for one user at a time.
-
- To use this module, add the line INCLUDE 'METER.INC' to your menu.
- Then under the OnKey you want to meter:
-
- OnKey 'W'
- if Limit('WP',6) then Return ;limit to 6 users
- WP
-
- In the above example, a Word Perfect choice is limited to 6 users. Thus
- you may have 20 users total but only 6 can run Word Perfect at the same
- time.
-
- The way it works is, MarxMenu creates a semaphore when it runs an
- application and stores the semaphore name in an environment variable
- named METER. When the user returns to the menu the semaphore is
- cleared. If the user turns off their computer in the middle of an
- application, netware will clear the semaphore within 15 minutes.
-
- This file could be modified to create a report file to trace usage of
- programs and when programs overflow. In the spirit of "keep it simple"
- I have not included these features.
-
- ========================================
- EndComment
-
- MeterInit
-
- Procedure MeterInit
- var SemaName
- SemaName = ReadEnv('METER')
- if SemaName > '' then NovCloseSemaphore('XM-' + SemaName)
- SetEnv('METER=')
- EndProc
-
-
- Procedure Limit (Name,Count)
- if NovSemaphoreUsers('XM-' + Name) >= Count
- TooManyUsers(Name)
- Return True
- endif
- NovOpenSemaphore('XM-' + Name,0) ; 'XM-' is for XMETER compatibility
- SetEnv('METER=' + Name)
- Return False
- EndProc
-
-
- Procedure TooManyUsers(Name)
- var Ch
- BoxHeader = ' * Press any Key * '
- DrawBox 11 21 length(Name) + 30 3
- UseArrows Off
- Cursor Off
- TextColor MenuHeaderFG MenuBG
- Write Char(7) ' All copies of ' Name ' are in Use!'
- Ch = ReadKey
- EraseTopWindow
- EndProc