× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@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 thread ...

Follow-Ups:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.