Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

What goes where? ... Clarified.

Status
Not open for further replies.

ArevProgrammer

Programmer
Apr 7, 2001
38
0
0
US
Hi,

Thanks to all who have responded. I will share with you the following source code, which is the MAIN.PRG. Here it is...
M.cur_versio = 1.00
SET BELL OFF
SET CENTURY ON
SET CONFIRM ON
SET CURRENCY TO ''
SET DATE TO AMERICAN
SET DELETED ON
SET ESCAPE OFF
SET EXACT ON
SET EXCLUSIVE OFF
SET KEYCOMP TO DOS
SET MACKEY TO
SET RESOURCE OFF
SET SAFETY ON
SET STATUS OFF
SET STATUS BAR OFF
SET TALK OFF
SET TEXTMERGE OFF
SET TYPEAHEAD TO 64
SET MULTILOCKS ON
CLEA
SET SYSMENU OFF
SET COLOR OF SCHEME 1 TO W+/B, W+/B, W+/B, GR+/B, R+/B, W+/W, W+/BG, W/N, N/BG, R+/B, N+/N
= SYS(2008, 'I', 1)
= SYS(2008, 'O', 0)
IF NETWORK() .AND. ('2.'$OS() .OR. '3.0'$OS())
WAIT WINDOW 'Multiuser requires DOS 3.1 or higher. You are using '+OS()
QUIT
ENDI
SET PROCEDURE TO procs.prg
IF .NOT. FILE(SYS(2004)+'config.fp')
M.fh_tmp = FCREATE(SYS(2004)+'config.fp')
IF (M.fh_tmp<0)
WAIT WINDOW 'Error creating file '+SYS(2004)+'CONFIG.FP.'
ELSE
= FPUTS(M.fh_tmp, 'CODEPAGE = 437')
= FPUTS(M.fh_tmp, ;
';NOTE: do NOT use less than 2048K as min KB memory')
= FPUTS(M.fh_tmp, ;
';MEMLIMIT = <% of memory to use>,<min KB memory>,<max KB memory>' ;
)
= FPUTS(M.fh_tmp, 'MEMLIMIT = 100,2048,2048')
= FPUTS(M.fh_tmp, 'MVCOUNT = 3600')
= FPUTS(M.fh_tmp, 'TITLE = RS-2000')
= FPUTS(M.fh_tmp, 'SET REPROCESS TO 50')
= FPUTS(M.fh_tmp, 'SET SEPARATOR TO')
= FPUTS(M.fh_tmp, 'SET MARK TO')
= FPUTS(M.fh_tmp, 'SET AUTOSAVE ON')
= FCLOSE(M.fh_tmp)
ENDI
RELE M.fh_tmp
WAIT WINDOW 'Upgrade completed. '+ ;
'RS-2000 must be exited and restarted.'
ON SHUTDOWN
QUIT
ENDI
CLEA MACROS
PUBL M.g_user_id, M.g_outdev, M.g_esc_loc, M.g_defout, M.g_ptr_desc, ;
M.g_maxuser, M.g_syspath, M.g_datpath, M.g_rptpath
M.g_maxuser = 1
M.g_defout = 1
M.g_user_id = SPACE(8)
M.g_syspath = SYS(5)+SYS(2003)
IF FILE('DATA_LOC.WF')
M.fhandle = FOPEN('DATA_LOC.WF')
SET DEFAULT TO (FGETS(M.fhandle))
= FCLOSE(M.fhandle)
RELE M.fhandle
ENDI
M.use_ok = .T.
IF M.use_ok .AND. file_use('','info','S')
WAIT NOWAIT ''
ELSE
M.use_ok = .F.
ENDI
IF M.use_ok .AND. file_use('','user','S')
SET ORDER TO 'user_id'
ELSE
M.use_ok = .F.
ENDI
IF .NOT. M.use_ok
WAIT WINDOW 'The necessary files could not be opened. Aborting..'
RETU
ENDI
RELE M.use_ok
SELE 'user'
DO log100.spr >>> See Code for this below.
ON SHUTDOWN DO shutdown
ON KEY LABEL ALT+X DO shutdown
SCAT MEMVAR
M.g_user_id = user.user_id
IF .NOT. FILE('register.dbf')
WAIT WINDOW 'Necessary files are missing.'
ELSE
M.use_ok = .T.
ON ERROR m.use_ok = .F.
SELE 225
USE SHARED register ALIAS register
ON ERROR
IF .NOT. M.use_ok
WAIT WINDOW 'Necessary files are missing.'
CLOS ALL
RELE ALL
ON SHUTDOWN
QUIT
ELSE
M.cs_cnt = 1
UNLO ALL
ON ERROR m.cs_cnt = m.cs_cnt + 1
SCAN
IF M.use_ok
REPL register.cs WITH SYS(2007, M.g_user_id+STR(RECNO()))
IF RLOCK()
M.use_ok = .F.
ENDI
ELSE
REPL register.cs WITH SYS(2007, STR(((RAND(-1)+1)* ;
65536)+RECNO()))
IF (register.cs=SYS(2007, M.g_user_id+STR(RECNO())))
WAIT WINDOW 'User ID '+ALLTRIM(M.g_user_id)+ ;
' is already logged in on another station.'
CLOS ALL
RELE ALL
ON SHUTDOWN
QUIT
ENDI
ENDI
IF (M.cs_cnt>M.g_maxuser)
WAIT WINDOW 'Too many users logged in. Try again later.'
CLOS ALL
RELE ALL
ON SHUTDOWN
QUIT
ENDI
ENDS
ON ERROR
IF M.use_ok
INSE INTO register (cs) VALUE (SYS(2007, M.g_user_id+ ;
STR(RECCOUNT()+1)))
= RLOCK()
ENDI
RELE M.cs_cnt
ENDI
RELE M.use_ok
ENDI
SELE user
IF user.show_sts
SET STATUS BAR ON
SET CLOCK STATUS
ELSE
SET STATUS BAR OFF
SET CLOCK OFF
ENDI
IF .NOT. FILE(ALLTRIM(user.resource)+'.DBF')
WAIT WINDOW 'User resource file is missing.'
ON SHUTDOWN
QUIT
ELSE
M.cur_area = SELECT()
M.use_ok = .T.
ON ERROR m.use_ok = .F.
SELE 0
USE (ALLTRIM(user.resource))
IF M.use_ok
LOCA FOR ((type='DATA') .AND. (id='DIARYDATA') .AND. (name= ;
DTOS(DATE())))
IF FOUND()
WAIT WINDOW 'Please check your calendar for appointments.'
ENDI
USE
SELE (M.cur_area)
SET RESOURCE TO (ALLTRIM(user.resource)+'.DBF')
ELSE
WAIT WINDOW 'User ID '+ALLTRIM(M.g_user_id)+' is already logged in.'
ON SHUTDOWN
QUIT
ENDI
ON ERROR
SELE (M.cur_area)
ENDI
ON KEY LABEL F4 KEYBOARD &quot;{CTRL+TAB}&quot;
ON KEY LABEL F6 ACTIVATE WINDOW CALENDAR
ON KEY LABEL F7 ACTIVATE WINDOW CALCULATOR
ON KEY LABEL Alt+F12 ACTIVATE WINDOW PUZZLE
M.cs_temp = 0
DO WHILE .NOT. RLOCK('info')
ENDD
REST FROM MEMO info.cs ADDITIVE
M.cs_test = STR((MOD((M.cs2-INT(RAND(M.cs1)*65536)+65536), 65536)), 5)
UNLO IN info
FOR M.miss_cnt = 1 TO 50
IF (M.cs_test=SYS(2007, STR(M.miss_cnt)))
M.cs_temp = M.miss_cnt
ENDI
ENDF
IF ((M.cs_temp>5) .AND. ((MOD(M.cs_temp, 5))<>0)) .OR. ((M.cs_temp<5) ;
.AND. .NOT. INLIST(M.cs_temp, 1, 3, 4))
WAIT WINDOW 'Fatal error. Product tampering suspected. Call Maximus IT'
ENDI
M.cs1 = INT(RAND(VAL(SYS(2007, M.g_user_id)))*65536)
M.cs2 = MOD((VAL(SYS(2007, STR(M.cs_temp)))+INT(RAND(M.cs1)*65536)), 65536)
DO WHILE .NOT. RLOCK('info')
ENDD
SAVE TO MEMO info.cs ALL LIKE cs?
M.g_maxuser = M.cs_temp
RELE M.cs_temp, M.cs_test, M.cs1, M.cs2
DO WHILE .NOT. RLOCK('user')
WAIT WINDOW NOWAIT TRIM(g_user_id)+ ;
' user record currently locked by another user. Waiting...'
ENDD
REPL user.log_dt WITH DATE()
REPL user.log_time WITH TIME()
UNLO IN 'user'
IF DISKSPACE()<2
WAIT WINDOW 'WARNING: Available diskspace is below 2 megs.'
ENDI
IF (info.lst_upd_dt<>DATE()) .OR. (info.lst_sts_dt<DATE())
DO WHILE .NOT. RLOCK('info')
WAIT WINDOW NOWAIT 'Waiting to lock INFO file'
ENDD
ENDI
IF (info.lst_sts_dt<DATE())
REPL info.lst_sts_dt WITH DATE()
ENDI
IF (info.lst_upd_dt<>DATE())
REPL info.lst_upd_dt WITH DATE()
ENDI
UNLO IN info
IF USED('info')
SELE info
USE
ENDI
IF USED('user')
SELE user
USE
ENDI
CLEA
SET SYSMENU AUTOMATIC
rd_exit = .F.
READ VALID rd_exit
*

Here is the associated LOG100.SPR...

PRIV M.currarea, M.talkstat, M.compstat
IF SET('TALK')='ON'
SET TALK OFF
M.talkstat = 'ON'
ELSE
M.talkstat = 'OFF'
ENDI
M.compstat = SET('COMPATIBLE')
SET COMPATIBLE TO FOXPLUS
IF .NOT. WEXIST('log100') .OR. UPPER(WTITLE('LOG100'))=='LOG100.PJX' ;
.OR. UPPER(WTITLE('LOG100'))=='LOG100.SCX' .OR. ;
UPPER(WTITLE('LOG100'))=='LOG100.MNX' .OR. UPPER(WTITLE('LOG100'))== ;
'LOG100.PRG' .OR. UPPER(WTITLE('LOG100'))=='LOG100.FRX' .OR. ;
UPPER(WTITLE('LOG100'))=='LOG100.QPR'
DEFI WINDOW log100 FROM INT((SROWS()-10)/2), INT((SCOLS()-45)/2) TO ;
INT((SROWS()-10)/2)+9, INT((SCOLS()-45)/2)+44 NOFLOAT NOCLOSE ;
SHADOW TITLE ' RS-2000 (tm) ' NOMINIMIZE COLOR SCHEME 1
ENDI
PRIV M.miss_cnt, M.cs_test
M.use_ok = .T.
GOTO TOP IN 'user'
g_maxuser = 0
M.usercnt = 0
DO WHILE .NOT. RLOCK('info')
ENDD
REST FROM MEMO info.cs ADDITIVE
UNLO IN info
M.cs_test = STR((MOD((M.cs2-INT(RAND(M.cs1)*65536)+65536), 65536)), 5)
FOR M.miss_cnt = 1 TO 50
IF (M.cs_test=SYS(2007, STR(M.miss_cnt)))
g_maxuser = M.miss_cnt
ENDI
ENDF
IF (g_maxuser=0) .OR. ((g_maxuser>5) .AND. ((MOD(g_maxuser, 5))<>0)) ;
.OR. ((g_maxuser<5) .AND. .NOT. INLIST(g_maxuser, 1, 3, 4))
WAIT WINDOW 'Fatal error. Product tampering suspected.'
CLOS ALL
RELE ALL
ON SHUTDOWN
QUIT
ENDI
SELE 'user'
SCAN
SELE 0
M.use_ok = .T.
ON ERROR m.usercnt = m.usercnt + 1
USE EXCLUSIVE (user.resource)
ON ERROR
IF USED()
USE
ENDI
IF M.usercnt>=g_maxuser
WAIT WINDOW 'Maximum number of users exceeded. Try again later.'
ON SHUTDOWN
QUIT
ENDI
SELE 'user'
ENDS
RELE M.use_ok
M.miss_cnt = 0
M.g_user_id = SPACE(LEN(user.user_id))
M.input_pass = SPACE(LEN(user.password)/3)
IF WVISIBLE('log100')
ACTI WINDOW SAME log100
ELSE
ACTI WINDOW NOSHOW log100
ENDI
@ 4, 3 SAY 'User id :' SIZE 1, 9, 0
@ 4, 13 GET M.g_user_id DEFAULT ' ' SIZE 1, 8 PICTURE '@!' VALID ;
_0pz0wud8p() WHEN _0pz0wud8a()
@ 6, 3 SAY 'Password:' SIZE 1, 9, 0
@ 6, 13 GET M.input_pass DEFAULT ' ' SIZE 1, 24 VALID _0pz0wudaf() WHEN ;
_0pz0wuda1()
IF .NOT. WVISIBLE('log100')
ACTI WINDOW log100
ENDI
READ CYCLE
RELE WINDOW log100
IF M.talkstat='ON'
SET TALK ON
ENDI
IF M.compstat='ON'
SET COMPATIBLE TO DB4
ENDI
IF (M.usercnt>=M.g_maxuser)
ON SHUTDOWN
QUIT
ENDI
*
FUNC getpass
PARA apass
cpass = ''
apass = PADR(apass, 24)
FOR M.cnt = 1 TO 24 STEP 3
cpass = cpass+CHR(VAL(SUBSTR(apass, M.cnt, 3)))
ENDF
RETU cpass
*
PROC trimuser
M.g_user_id = PADR(SUBSTR(TRIM(M.g_user_id), 1, ;
MAX((LEN(TRIM(M.g_user_id))-1), 0)), LEN(M.g_user_id))
IF .NOT. EMPTY(M.g_user_id)
KEYB '{END}'
ENDI
RETU
*
PROC trimpass
M.input_pass = PADR(SUBSTR(TRIM(M.input_pass), 1, ;
MAX((LEN(TRIM(M.input_pass))-1), 0)), LEN(user.password)/3)
IF .NOT. EMPTY(M.input_pass)
KEYB '{END}'
ENDI
RETU
*
FUNC _0pz0wud8a
ON KEY LABEL BACKSPACE DO trimuser
ON KEY LABEL ESCAPE DO trimuser
RETU .T.
*
FUNC _0pz0wud8p
ON KEY LABEL BACKSPACE
ON KEY LABEL ESCAPE
IF SEEK(g_user_id, 'user')
IF FILE((TRIM(user.resource)+'.DBF'))
M.cur_area = SELECT()
M.use_ok = .T.
ON ERROR m.use_ok = .F.
SELE 0
USE (user.resource)
ON ERROR
IF M.use_ok
USE
SELE user
SCAT MEMVAR
M.miss_cnt = 0
ELSE
WAIT WINDOW 'User ID '+ALLTRIM(M.g_user_id)+ ;
' is already logged in.'
M.miss_cnt = M.miss_cnt+1
IF M.miss_cnt=3
ON SHUTDOWN
QUIT
ENDI
M.g_user_id = SPACE(8)
SHOW GET M.g_user_id
WAIT WINDOW NOWAIT 'Invalid USER ID - 1'
_CUROBJ = OBJNUM(M.g_user_id)
ENDI
SELE (M.cur_area)
ELSE
WAIT WINDOW &quot;User's resource file missing.&quot;
ON SHUTDOWN
QUIT
ENDI
ELSE
? CHR(7)
M.miss_cnt = M.miss_cnt+1
IF M.miss_cnt=3
ON SHUTDOWN
QUIT
ENDI
M.g_user_id = SPACE(8)
SHOW GET M.g_user_id
WAIT WINDOW NOWAIT 'Invalid USER ID - 2'
_CUROBJ = OBJNUM(M.g_user_id)
ENDI
RETU .T.
*
FUNC _0pz0wuda1
ON KEY LABEL BACKSPACE DO trimpass
ON KEY LABEL ESCAPE DO trimpass
RETU .T.
*
FUNC _0pz0wudaf
ON KEY LABEL BACKSPACE
ON KEY LABEL ESCAPE
IF (M.input_pass=TRIM(UPPER(getpass(user.password))))
RELE WINDOW log100
M.miss_cnt = 0
ELSE
? CHR(7)
M.miss_cnt = M.miss_cnt+1
IF M.miss_cnt=3
ON SHUTDOWN
QUIT
ENDI
WAIT WINDOW NOWAIT 'Invalid PASSWORD.'
M.input_pass = SPACE(LEN(user.password)/3)
_CUROBJ = OBJNUM(M.input_pass)
ENDI
RETU .T.
*

I am trying to figure out where in VFP to put the code for the snippets found in this .spr file that would closely match an event or event(s) in VFP. It may be kind of hard to understand, but for all practical purposes it checks the user id, password and user count among other things.

I just want to know what in a VFP window (form) became or took the place of the Setup snippet, Proc snippet and that kind of stuff.

Sorry to be so blind.


Thanks Much!!!


Scott Rome was not built in a day. Be patient!
 
Setup snippet was replaced with a data environment for setting up the data. Or the Load event of the form.

the load event of the form happens after the data enviroment and before any forms objects become initilized.
after the objects are initilized then the forms init event happens.

other events you need to look at are:
unload
destroy
queryunload

you have lots more choices now. it is a matter to read up on each to find out which one should be used for what suits your needs. Attitude is Everything
 
This maybe one of those times to take &quot;practical purposes&quot; description and simply create a new form - most of this code is unnesessary in VFP.

The easiest part of conversion is rewriting!

Rick

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top