|
midrange.com
CRTCGIKEY using CGIDEV2
_____
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
*****************************************************************
Fcgikeypf uF a E K DISK usropn
*****************************************************************
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables1
d UpperAlpha s 1 DIM(26) CTDATA PERRCD(26)
d LowerAlpha s 1 DIM(26) CTDATA PERRCD(26)
d Digits s 1 DIM(10) CTDATA PERRCD(10)
d UpperAlphaElem s 10u 0
d LowerAlphaElem s 10u 0
d DigitsElem s 10u 0
d DateNowd s d DATFMT(*ISO)
d #DateNow s 8 0
d @DateNow s 8
d TimeNowd s t TIMFMT(*ISO)
d #TimeNow s 8 0
d @TimeNow s 8
d @DateTimeStr s 16
d RandomLen s 10u 0
d FldPos s 2 0 inz(1)
d x s 10u 0
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
c *entry Plist
c Parm @USER 10
c Parm RndKey
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- Main Line
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
c open cgikeypf
c @USER chain cgikeypf
c if %found
c exsr CrtKey
c move #DateNow KeyDate
c movel #TimeNow KeyTime
c update cgikeyr
c else
c exsr CrtKey
c move #DateNow KeyDate
c movel #TimeNow KeyTime
C MOVEL @User Usrid
c write cgikeyr
c endif
c exsr endit
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- Create Key
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C CrtKey begsr
c clear RNDKEY
*****Place Current Date and Time into key******
c TIME DateNowd
c movel DateNowd #DateNow
c move #DateNow @DateNow
c TIME TimeNowd
c movel TimeNowd #TimeNow
c move #TimeNow @TimeNow
*****Start with a random length between 24 and 64******
c eval RandomLen = Random(24:64)
*****while FldPos is less than random length****
c dow FldPos <= RandomLen
*****pick from a random array****
c eval x = Random(1:3)
*--------------------------
c if x = 1
*****Pick a random element from array****
c eval UpperAlphaElem = Random(1:26)
c eval %subst(RNDKEY:FldPos:1)=
c UpperAlpha(UpperAlphaElem)
c eval FldPos = FldPos + 1
c endif
*--------------------------
c if x = 2
*****Pick a random element from array****
c eval LowerAlphaElem = Random(1:26)
c eval %subst(RNDKEY:FldPos:1)=
c LowerAlpha(LowerAlphaElem)
c eval FldPos = FldPos + 1
c endif
*--------------------------
c if x = 3
*****Pick a random element from array****
c eval DigitsElem = Random(1:10)
c eval %subst(RNDKEY:FldPos:1)=
c Digits(DigitsElem)
c eval FldPos = FldPos + 1
c endif
c enddo
c endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- END PROGRAM
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C endit begsr
C eval *inlr=*on
C return
c endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
**
ABCDEFGHIJKLMNOPQRSTUVWXYZ
**
abcdefghijklmnopqrstuvwxyz
**
0123456789
_____
CHECKCGIKEY
/copy lntcgisrc/ilesrc,hspecs
/copy lntcgisrc/ilesrc,hspecsbnd
*****************************************************************
Fcgikeypf uF a E K DISK usropn
*****************************************************************
/copy lntcgisrc/ilesrc,prototypeb
/copy lntcgisrc/ilesrc,usec
/copy lntcgisrc/ilesrc,variables3
*****************************************************************
d DateNowD s d DATFMT(*ISO)
d #DateNow s 8 0
d TimeNowT s t TIMFMT(*ISO)
d #TimeNow s 6 0
d ##TimeNow s 6 0
D Lib s 10 inz('*LIBL')
D Fn s 10 inz('HTMLSRC')
D Mbr s 10 inz('CHKCGIH')
DPSSDS DS
D WSID 244 253
D USERID 254 263
D JOBNUM 264 273
D LOGWS 244 253
D LOGUSR 254 263
D LOGJB# 264 273
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- Main Line
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
c *entry Plist
c Parm @USER 10
c Parm @RndKey 64
*****CGI TIME OUT VALUE in MINUTES*****
c *dtaara define CgiKeyTime 3 0
C IN *DTAARA
******Check user's key******
c if @User <> ' '
c open cgikeypf
c @User chain cgikeypf
c if %found and RndKey = @RndKey
c exsr CheckKey
c else
c clear @RndKey
c exsr NotAllowed
c endif
c endif
c exsr endit
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- Calculate CGI Key time out
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C CheckKey begsr
*****Current Date and Time******
c TIME DateNowD
c movel DateNowD #DateNow
c TIME TimeNowT
c movel TimeNowT #TimeNow
******Subtract Timeout from current time.
c SUBDUR CgiKeyTime:*MNTimeNowT
c movel TimeNowT ##TimeNow
******If time limit for key has expired...delete record
C/EXEC SQL
C+ DELETE FROM CGIKEYPF
C+ WHERE USRID = :@User and
C+ ((KEYDATE <> :#DateNow) or (KEYTIME < :##TimeNow))
C/END-EXEC
*****Update Date and Time for key******
c @user chain cgikeypf
c if %found and RndKey = @RndKey
C/EXEC SQL
C+ update CGIKEYPF
C+ set KEYTIME = :#TimeNow, KEYDATE = :#DateNow
C+ WHERE USRID = :@User
C/END-EXEC
c endif
c exsr endit
c endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- NOT ALLOWED HTML
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
c NotAllowed begsr
c exsr RtvEnvVar
/copy lntcgisrc/ilesrc,prolog3
c callp wrtsection('TOP')
c callp wrtsection('*fini')
c endsr
*=====================================================================******
* Retrieve environment variables
*=====================================================================******
C RtvEnvVar begsr
C callp gethtml(fn:lib:mbr)
* Use getenvp to get this server's protocol and name
C eval S_Protocol =getenv('SERVER_PROTOCOL':
C qusec)
C eval S_Name =getenv('SERVER_NAME':
C qusec)
C eval USERID =getenv('REMOTE_USER':qusec)
*
C endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C*--- END PROGRAM
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
C endit begsr
C eval *inlr=*on
c close cgikeypf
C return
c endsr
_____
Jeffrey Flaker
Senior Programmer/Analyst
Linens 'N Things
6 Brighton Rd
Clifton, NJ 07015
Phone: 973-249-4384
Fax: 973-249-4901
http://www.lnt.com
-----Original Message-----
From: Shannon O'Donnell [ mailto:sodonnell@xxxxxxxxxxxxxxx]
Sent: Friday, August 01, 2003 10:02 AM
To: Web Enabling the AS400 / iSeries
Subject: Re: [WEB400] Hiding HTML Source
Hi Jeff,
That's an interesting idea! Do you have a code sample to help explain how
to do it?
Thanks!
Shannon O'Donnell
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
