www.justiceforchandra.com Forum Index www.justiceforchandra.com
Justice for Chandra Levy and missing women
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

WEBVISITOR demo 5250 subfile program in ILE RPG /free
Goto page 1, 2  Next
 
Post new topic   Reply to topic    www.justiceforchandra.com Forum Index -> www.rdwrites.com forum (part of www.justiceforchandra.com)
View previous topic :: View next topic  
Author Message
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 5:23 pm    Post subject: WEBVISITOR demo 5250 subfile program in ILE RPG /free Reply with quote

WEBVISITOR / WEBBLOCKER is a program I recently wrote to help administer my site. It is written in RPG /free with subprocedures in a service program. The subfile is page by page style with windowed maintenance screens.

This could serve as an ILE shell program for any 5250 file maintenance program or application by replacing and extending the code in place. There are no copyright, license, or disclaimer statements as a requirement to carry along, etc.

Hopefully this is a useful template of a complex RPG ILE /free program to jump start programming in /free with service programs. Next up will be a CGIDEV2 web serving demo app. I'm hosting this on my Google Code project rdwrites:

http://code.google.com/p/rdwrites/

see http://code.google.com/p/rdwrites/downloads/list -
rdwrites 090715 WEBVISITOR 5250 subfile maintenance ascii source files zip

rd
_________________
ralph@ee.net
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 10:42 pm    Post subject: Reply with quote

WEBVISITOR.PF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITOR
     A*    ordered VISITOR
     A*****************************************************************
     A          R WEBVISITR                 TEXT('Website visitor record')
     A            WEBSITE       10A         TEXT('Website')
     A                                      COLHDG('Website')
     A            VISITOR        7  0       TEXT('Visitor')
     A                                      COLHDG('Visitor')
     A            IPSEG1         3  0       TEXT('IP segment 1')
     A                                      COLHDG('IP segment 1')
     A            IPSEG2         3  0       TEXT('IP segment 2')
     A                                      COLHDG('IP segment 2')
     A            IPSEG3         3  0       TEXT('IP segment 3')
     A                                      COLHDG('IP segment 3')
     A            IPSEG4         3  0       TEXT('IP segment 4')
     A                                      COLHDG('IP segment 4')
     A            HOST          32A         TEXT('Host name')
     A                                      COLHDG('Host name')
     A            CITY          32A         TEXT('City where located')
     A                                      COLHDG('City' 'where located')
     A            STATE          2A         TEXT('State where located')
     A                                      COLHDG('State' 'where located')
     A            TOPIC          6A         TEXT('Topic')
     A                                      COLHDG('Topic')
     A            USER          14A         TEXT('User')
     A                                      COLHDG('User')
     A            SEARCH        32A         TEXT('Search')
     A                                      COLHDG('Search')
     A*****************************************************************
     A          K WEBSITE
     A          K VISITOR



WEBVISITL1.LF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITL1
     A*    ordered IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBVISITOR)
     A          K WEBSITE
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBVISITL2.LF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITL2
     A*    ordered HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBVISITOR)
     A          K WEBSITE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBVISITL3.LF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITL3
     A*    ordered STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBVISITOR)
     A          K WEBSITE
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBVISITL4.LF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITL4
     A*    ordered CITY, STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBVISITOR)
     A          K WEBSITE
     A          K CITY
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBVISITL5.LF
Code:

     A*****************************************************************
     A*                      Website Visitors
     A*  File WEBVISITL5
     A*    ordered TOPIC, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBVISITOR)
     A          K WEBSITE
     A          K TOPIC
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 10:44 pm    Post subject: Reply with quote

WEBBLOCKER.PF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKER
     A*    ordered VISITOR
     A*****************************************************************
     A          R WEBVISITR                 TEXT('Website visitor record')
     A            WEBSITE       10A         TEXT('Website')
     A                                      COLHDG('Website')
     A            VISITOR        7  0       TEXT('Visitor')
     A                                      COLHDG('Visitor')
     A            IPSEG1         3  0       TEXT('IP segment 1')
     A                                      COLHDG('IP segment 1')
     A            IPSEG2         3  0       TEXT('IP segment 2')
     A                                      COLHDG('IP segment 2')
     A            IPSEG3         3  0       TEXT('IP segment 3')
     A                                      COLHDG('IP segment 3')
     A            IPSEG4         3  0       TEXT('IP segment 4')
     A                                      COLHDG('IP segment 4')
     A            HOST          32A         TEXT('Host name')
     A                                      COLHDG('Host name')
     A            CITY          32A         TEXT('City where located')
     A                                      COLHDG('City' 'where located')
     A            STATE          2A         TEXT('State where located')
     A                                      COLHDG('State' 'where located')
     A            TOPIC          6A         TEXT('Topic')
     A                                      COLHDG('Topic')
     A            USER          14A         TEXT('User')
     A                                      COLHDG('User')
     A            SEARCH        32A         TEXT('Search')
     A                                      COLHDG('Search')
     A*****************************************************************
     A          K WEBSITE
     A          K VISITOR



WEBBLOCKL1.LF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKL1
     A*    ordered IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBBLOCKER)
     A          K WEBSITE
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBBLOCKL2.LF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKL2
     A*    ordered HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBBLOCKER)
     A          K WEBSITE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBBLOCKL3.LF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKL3
     A*    ordered STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBBLOCKER)
     A          K WEBSITE
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBBLOCKL4.LF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKL4
     A*    ordered CITY, STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBBLOCKER)
     A          K WEBSITE
     A          K CITY
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBBLOCKL5.LF
Code:

     A*****************************************************************
     A*                      Website IP Blocker
     A*  File WEBBLOCKL5
     A*    ordered TOPIC, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBBLOCKER)
     A          K WEBSITE
     A          K TOPIC
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 10:59 pm    Post subject: Reply with quote

WEBIPRECRD.PF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRECRD
     A*    ordered VISITOR
     A*****************************************************************
     A          R WEBVISITR                 TEXT('Website visitor record')
     A            WEBSITE       10A         TEXT('Website')
     A                                      COLHDG('Website')
     A            VISITOR        7  0       TEXT('Visitor')
     A                                      COLHDG('Visitor')
     A            IPSEG1         3  0       TEXT('IP segment 1')
     A                                      COLHDG('IP segment 1')
     A            IPSEG2         3  0       TEXT('IP segment 2')
     A                                      COLHDG('IP segment 2')
     A            IPSEG3         3  0       TEXT('IP segment 3')
     A                                      COLHDG('IP segment 3')
     A            IPSEG4         3  0       TEXT('IP segment 4')
     A                                      COLHDG('IP segment 4')
     A            HOST          32A         TEXT('Host name')
     A                                      COLHDG('Host name')
     A            CITY          32A         TEXT('City where located')
     A                                      COLHDG('City' 'where located')
     A            STATE          2A         TEXT('State where located')
     A                                      COLHDG('State' 'where located')
     A            TOPIC          6A         TEXT('Topic')
     A                                      COLHDG('Topic')
     A            USER          14A         TEXT('User')
     A                                      COLHDG('User')
     A            SEARCH        32A         TEXT('Search')
     A                                      COLHDG('Search')
     A*****************************************************************
     A          K WEBSITE
     A          K VISITOR



WEBIPRCDL1.LF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRCDL1
     A*    ordered IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBIPRECRD)
     A          K WEBSITE
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBIPRCDL2.LF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRCDL2
     A*    ordered HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBIPRECRD)
     A          K WEBSITE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBIPRCDL3.LF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRCDL3
     A*    ordered STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBIPRECRD)
     A          K WEBSITE
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBIPRCDL4.LF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRCDL4
     A*    ordered CITY, STATE, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBIPRECRD)
     A          K WEBSITE
     A          K CITY
     A          K STATE
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4



WEBIPRCDL5.LF
Code:

     A*****************************************************************
     A*                      Website IP Records
     A*  File WEBIPRCDL5
     A*    ordered TOPIC, HOST, IPSEG1, IPSEG2, IPSEG3, IPSEG4
     A*****************************************************************
     A          R WEBVISITR                 PFILE(WEBIPRECRD)
     A          K WEBSITE
     A          K TOPIC
     A          K HOST
     A          K IPSEG1
     A          K IPSEG2
     A          K IPSEG3
     A          K IPSEG4
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 11:10 pm    Post subject: Reply with quote

WEBVISITPR.RPGLE
Code:

      *****************************************************************
      *               Web IP Records Prototype Definitions
      *
      *  Copy file WEBVISITPR
      *****************************************************************

      *****************************************************************
      * Prototyped call: addVisitor
      *****************************************************************
     d addVisitor      pr                  extpgm('WEBVISITRA')
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(SITE)
     d  prmVisitor                         like(RECID)

      *****************************************************************
      * Prototyped call: dspVisitor
      *****************************************************************
     d dspVisitor      pr                  extpgm('WEBVISITRB')
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(SITE)
     d  prmVisitor                         like(RECID)

      *****************************************************************
      * Prototyped call: updVisitor
      *****************************************************************
     d updVisitor      pr                  extpgm('WEBVISITRC')
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(SITE)
     d  prmVisitor                         like(RECID)

      *****************************************************************
      * Prototyped call: delVisitor
      *****************************************************************
     d delVisitor      pr                  extpgm('WEBVISITRD')
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(SITE)
     d  prmVisitor                         like(RECID)

      *****************************************************************
      * Prototyped call: chkVisitor
      *****************************************************************
     d chkVisitor      pr                  extpgm('WEBVISITRE')
     d  prmWarnid                          like(msgid)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(SITE)
     d  prmIPSEG1                          like(IPSEG)
     d  prmIPSEG2                          like(IPSEG)
     d  prmIPSEG3                          like(IPSEG)
     d  prmIPSEG4                          like(IPSEG)

      *****************************************************************
      * Prototyped call: clrmsgc
      *****************************************************************
     d clrmsgc         pr                  extpgm('CLRMSGC')

      *****************************************************************
      * Prototyped call: sndmsgidc
      *****************************************************************
     d sndmsgidc       pr                  extpgm('SNDMSGIDC')
     d  prmMsgfile                         like(pgmnam)
     d  prmMsgid                           like(msgid)

      *****************************************************************
      * Prototyped call: sndmsgdtac
      *****************************************************************
     d sndmsgdtac      pr                  extpgm('SNDMSGDTAC')
     d  prmMsgdta                          like(msgdta)

      *****************************************************************
      * Subprocedure: setPOSDSC
      *****************************************************************
     d setPOSDSC       pr                  like(POSDSC)
     d  prmView                            like(viewmode)

      *****************************************************************
      * Subprocedure: setIPSEG
      *****************************************************************
     d setIPSEG        pr
     d  prmIPSEG1                          like(IPSEG)
     d  prmIPSEG2                          like(IPSEG)
     d  prmIPSEG3                          like(IPSEG)
     d  prmIPSEG4                          like(IPSEG)
     d  prmIPCHR1                          like(IPCHR)
     d  prmIPCHR2                          like(IPCHR)
     d  prmIPCHR3                          like(IPCHR)
     d  prmIPCHR4                          like(IPCHR)

      *****************************************************************
      * Subprocedure: cvtIPSEG
      *****************************************************************
     d cvtIPSEG        pr
     d  prmIPSEG1                          like(IPSEG)
     d  prmIPSEG2                          like(IPSEG)
     d  prmIPSEG3                          like(IPSEG)
     d  prmIPSEG4                          like(IPSEG)
     d  prmIPCHR1                          like(IPCHR)
     d  prmIPCHR2                          like(IPCHR)
     d  prmIPCHR3                          like(IPCHR)
     d  prmIPCHR4                          like(IPCHR)

      *****************************************************************
      * Subprocedure: chkIPBlocked
      *****************************************************************
     d chkIPBlocked    pr              n
     d  prmSite                            like(SITE)
     d  prmIPSEG1                          like(IPSEG)
     d  prmIPSEG2                          like(IPSEG)
     d  prmIPSEG3                          like(IPSEG)
     d  prmIPSEG4                          like(IPSEG)

      *****************************************************************
      * Subprocedure: chkIPVisited
      *****************************************************************
     d chkIPVisited    pr              n
     d  prmSite                            like(SITE)
     d  prmIPSEG1                          like(IPSEG)
     d  prmIPSEG2                          like(IPSEG)
     d  prmIPSEG3                          like(IPSEG)
     d  prmIPSEG4                          like(IPSEG)

      *****************************************************************
      * Data Structure Declaration
      *****************************************************************
      * system program feedback area
     d systemds       sds
     d  pgmnam                       10
     d  pgmlib                81     90
     d  jobnam               244    253
     d  usrnam                       10
     d  jobnbr                        6  0

      *****************************************************************
      * Stand Alone Fields Declaration
      *****************************************************************
     d* Base types
     d boolean         s               n
     d char            s              1a
     d flag            s                   like(char)
     d returnCode      s              1s 0
     d viewmode        s              1  0
     d IPCHR           s              3a
     d POSDSC          s              7a
     d SITE            s             10a
     d IPSEG           s              3  0
     d IPZERO          s                   like(IPSEG) inz(0)
     d RECID           s              7  0

     d* Message file variables
     d pgmsgq          s                   like(pgmnam)
     d prmMsgfile      s                   like(pgmnam)
     d msgid           s              7a
     d msgdta          s             78a
     d prmMsgid        s                   like(msgid)
     d prmMsgdta       s                   like(msgdta)

     d* Return code values
     d   wrkSuccess    c                   const(0)
     d   wrkFailure    c                   const(1)
     d   wrkError      c                   const(-1)

     d* Subfile load values
     d   Position      c                   const(0)
     d   ReadForward   c                   const(1)
     d   ReadBack      c                   const(-1)

     d* Subfile view values
     d   VisitorRRN    c                   const(0)
     d   IPaddress     c                   const(1)
     d   HostIP        c                   const(2)
     d   StateHost     c                   const(3)
     d   CityState     c                   const(4)
     d   TopicHost     c                   const(5)

     d* Constants
     d IPlen           c                   const(%len(IPSEG))
     d IPdec           c                   const(%decpos(IPSEG))
     d green_ul        c                   const(X'24')
     d green_ul_ri     c                   const(X'25')
     d non_pr          c                   const(X'A7')
     d msgFile         c                   'RDWMSGF'
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 11:37 pm    Post subject: Reply with quote

WEBVISITD.DSPF
Code:

     A*****************************************************************
     A*               WEBVISITOR File Maintenance
     A*  Display WEBVISITD
     A*****************************************************************
     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A*****************************************************************
     A          R SFLS1                     SFL
     A  95                                  SFLNXTCHG
     A            ATBS1SEL       1A  P
     A            S1SELECT       1A  B 10  3
     A                                      DSPATR(&ATBS1SEL)
     A            S1VISITOR R        H      REFFLD(WEBVISITR/VISITOR WEBVISITOR)
     A            S1IPSEG1       3A  O 10  6
     A            S1IPSEG2       3A  O 10 10
     A            S1IPSEG3       3A  O 10 14
     A            S1IPSEG4       3A  O 10 18
     A            S1HOST        29A  O 10 22
     A            S1CITY        16A  O 10 52
     A            S1STATE        2A  O 10 69
     A            S1TOPIC   R        O 10 72REFFLD(WEBVISITR/TOPIC  WEBVISITOR)
     A*
     A*****************************************************************
     A          R SFLC1                     SFLCTL(SFLS1)
     A                                      SFLSIZ(0012)
     A                                      SFLPAG(0012)
     A                                      CF03(03 'Exit')
     A                                      CF05(05 'Refresh')
     A                                      CF06(06 'Add')
     A                                      CF11(11 'View')
     A                                      CF12(12 'Return')
     A                                      ROLLDOWN(26 'ROLLDN/PAGEUP'  )
     A N94                                  ROLLUP(27 'ROLLUP/PAGEDOWN')
     A                                      OVERLAY
     A  91                                  SFLDSP
     A  92                                  SFLDSPCTL
     A  93                                  SFLCLR
     A  94                                  SFLEND(*MORE)
     A  96                                  CSRLOC(ROWPOS COLPOS)
     A*
     A            ROWPOS         3S 0H
     A            COLPOS         3S 0H
     A            SF1RRN         4S 0H
     A            PGMNAM        10A  O  1  2COLOR(BLU)
     A            C1FILE    R        O  1 35REFFLD(WEBVISITR/WEBSITE WEBVISITOR)
     A                                      COLOR(WHT)
     A                                  1 72DATE(*SYS *Y)
     A                                      EDTCDE(Y)
     A                                      COLOR(BLU)
     A                                  2  2USER
     A                                      COLOR(BLU)
     A            C1SITE    R        O  2 36REFFLD(WEBVISITR/WEBSITE WEBVISITOR)
     A                                      COLOR(WHT)
     A                                  2 72TIME
     A                                      COLOR(BLU)
     A                                  4  2'Position to'
     A            C1POSDSC       7A  O  4 14
     A  50        C1VISITOR R        B  4 22REFFLD(WEBVISITR/VISITOR WEBVISITOR)
     A  51        C1IPSEG1  R        B  4 22REFFLD(WEBVISITR/IPSEG1 WEBVISITOR)
     A  51        C1IPSEG2  R        B  4 27REFFLD(WEBVISITR/IPSEG2 WEBVISITOR)
     A  51        C1IPSEG3  R        B  4 32REFFLD(WEBVISITR/IPSEG3 WEBVISITOR)
     A  51        C1IPSEG4  R        B  4 37REFFLD(WEBVISITR/IPSEG4 WEBVISITOR)
     A  52        C1HOST    R        B  4 22REFFLD(WEBVISITR/HOST   WEBVISITOR)
     A                                      CHECK(LC)
     A  53        C1STATE   R        B  4 22REFFLD(WEBVISITR/STATE  WEBVISITOR)
     A            C1HOST3   R        H      REFFLD(WEBVISITR/HOST   WEBVISITOR)
     A  54        C1CITY    R        B  4 22REFFLD(WEBVISITR/CITY   WEBVISITOR)
     A                                      CHECK(LC)
     A            C1STATE4  R        H      REFFLD(WEBVISITR/STATE  WEBVISITOR)
     A            C1HOST4   R        H      REFFLD(WEBVISITR/HOST   WEBVISITOR)
     A  55        C1TOPIC   R        B  4 22REFFLD(WEBVISITR/TOPIC  WEBVISITOR)
     A                                      CHECK(LC)
     A            C1HOST5   R        H      REFFLD(WEBVISITR/HOST   WEBVISITOR)
     A*
     A                                  6  2'Type option, press Enter.'
     A                                      COLOR(BLU)
     A                                  7  5'2=Change'
     A                                      COLOR(BLU)
     A                                  7 16'4=Delete'
     A                                      COLOR(BLU)
     A                                  7 27'5=Display'
     A                                      COLOR(BLU)
     A*
     A                                  9  2'Opt'
     A                                      COLOR(WHT)
     A                                  9  6'IP1'
     A                                      COLOR(WHT)
     A                                  9 10'IP2'
     A                                      COLOR(WHT)
     A                                  9 14'IP3'
     A                                      COLOR(WHT)
     A                                  9 18'IP4'
     A                                      COLOR(WHT)
     A                                  9 22'Host'
     A                                      COLOR(WHT)
     A                                  9 52'City'
     A                                      COLOR(WHT)
     A                                  9 69'ST'
     A                                      COLOR(WHT)
     A                                  9 72'Topic'
     A                                      COLOR(WHT)
     A*
     A*****************************************************************
     A          R SFL1KEY
     A                                      OVERLAY
     A                                 23  2'F3=Exit'
     A                                      COLOR(BLU)
     A                                 23 12'F5=Refresh'
     A                                      COLOR(BLU)
     A                                 23 25'F6=Add'
     A                                      COLOR(BLU)
     A                                 23 34'F11=Change View'
     A                                      COLOR(BLU)
     A                                 23 52'F12=Return'
     A                                      COLOR(BLU)
     A*
     A*****************************************************************
     A          R SFLS2                     SFL
     A            S2SELECT       1A  B  4  4
     A            S2DESC         7A  O  4  7
     A                                      COLOR(WHT)
     A*
     A*****************************************************************
     A          R SFLC2                     SFLCTL(SFLS2)
     A                                      WINDOW(5 6 10 19)
     A                                      WDWBORDER((*COLOR YLW) (*DSPATR RI)-
     A                                       (*CHAR '        '))
     A                                      SFLSIZ(0006)
     A                                      SFLPAG(0006)
     A                                      CF03(03 'Exit')
     A                                      CF05(05 'Refresh')
     A                                      CF06(06 'Add')
     A                                      CF11(11 'View')
     A                                      CF12(12 'Return')
     A                                      ROLLDOWN(26 'ROLLDN/PAGEUP'  )
     A                                      ROLLUP(27 'ROLLUP/PAGEDOWN')
     A                                      OVERLAY
     A  91                                  SFLDSP
     A  92                                  SFLDSPCTL
     A  93                                  SFLCLR
     A            SF2RRN         4S 0H
     A                                  2  4'1=Select View'
     A                                      COLOR(BLU)
     A*****************************************************************
     A          R MSGSFL                    SFL SFLMSGRCD(24)
     A            MSGKEY                    SFLMSGKEY
     A            PGMSGQ                    SFLPGMQ
     A*
     A*****************************************************************
     A          R MSGCTL                    SFLCTL(MSGSFL)
     A                                      OVERLAY
     A                                      SFLSIZ(0010)
     A                                      SFLPAG(0001)
     A                                      SFLDSP
     A                                      SFLDSPCTL
     A                                      SFLINZ
     A N98                                  SFLEND
     A            PGMSGQ                    SFLPGMQ
     A*****************************************************************
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 11:38 pm    Post subject: Reply with quote

WEBVISITRP.RPGLE
Code:

      *****************************************************************
      *               Web IP Records File Maintenance
      *
      *  Program WEBVISITRP
      *****************************************************************
     h  dftactgrp(*no) actgrp('RDWRITES') bnddir('RDWRITES')
     h  debug option(*srcstmt:*nodebugio)

      *****************************************************************
      * File Specifications
      *****************************************************************
      * WEBIPRECRD override file
     fwebiprecrdif   e           k disk    rename(WEBVISITR: IPRECRD)
     fwebiprcdl1if   e           k disk    rename(WEBVISITR: IPRCDL1)
     fwebiprcdl2if   e           k disk    rename(WEBVISITR: IPRCDL2)
     fwebiprcdl3if   e           k disk    rename(WEBVISITR: IPRCDL3)
     fwebiprcdl4if   e           k disk    rename(WEBVISITR: IPRCDL4)
     fwebiprcdl5if   e           k disk    rename(WEBVISITR: IPRCDL5)
      * Display File
     fwebvisitd cf   e             workstn sfile(SFLS1:SF1RRN)
     f                                     infds(SFLC1DS)
     f                                     sfile(SFLS2:SF2RRN)

      *****************************************************************
      * *Entry Declaration
      *****************************************************************
     d WEBVISITRP      pr
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(WEBSITE)

     d WEBVISITRP      pi
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(WEBSITE)

      *****************************************************************
      * Prototype Definitions
      *****************************************************************
      /copy RDWSRC,WEBVISITPR

      *****************************************************************
      * Data Structure Declaration
      *****************************************************************
      * SFLC1 file information DS
     d SFLC1DS         ds           512     qualified
     d  rowcol               370    371b 0

      * function keys and indicators
     d @Indicator      s               *   inz(%addr(*IN))
     d Indicators      ds                  based(@Indicator)
     d  Exit                  03     03
     d  Refresh               05     05
     d  AddNew                06     06
     d  View                  11     11
     d  Cancel                12     12
     d  PageUp                26     26
     d  PageDown              27     27
     d  SflDsp                91     91
     d  SflDspCtl             92     92
     d  SflClr                93     93
     d  SflEnd                94     94
     d  SflNxtChg             95     95
     d  CsrLoc                96     96
     d  SflMsgEnd             98     98

      *****************************************************************
      * Stand Alone Fields Declaration
      *****************************************************************
     d* Mode variables
     d pageCtr         s                   like(SF1RRN) inz(0)
     d loopCtr         s                   like(SF1RRN)
     d loadmode        s                   like(viewmode)
     d reload          s                   like(boolean)
     d csrpos          s              5s 0

     d* Parm variables
     d prmErrorCode    s                   like(returnCode)
     d prmExit         s                   like(flag)
     d prmVisitor      s                   like(VISITOR)
     d prmView         s                   like(viewmode)

     d* Work variables
     d wrkErrflg       s                   like(flag)
     d wrkChgflg       s                   like(flag)
     d wrkTopflg       s                   like(flag)

     d* Save variables
     d savSf1RRN       s                   like(SF1RRN)
     d savVISITOR      s                   like(VISITOR)
     d savIPSEG1       s                   like(IPSEG1)
     d savIPSEG2       s                   like(IPSEG2)
     d savIPSEG3       s                   like(IPSEG3)
     d savIPSEG4       s                   like(IPSEG4)
     d savHOST         s                   like(HOST)
     d savCITY         s                   like(CITY)
     d savSTATE        s                   like(STATE)
     d savTOPIC        s                   like(TOPIC)

     d* Constants
     d sf1Size         c                   const(12)
     d sf2Size         c                   const(6)
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sat Aug 15, 2009 11:54 pm    Post subject: Reply with quote

Code:


      *****************************************************************
      * Mainline
      *****************************************************************
      /free
        // initial subfile load
         viewmode = IPaddress;
         exsr initLoadPos;
         reload = *on;

         dow Exit = *off;
           if reload = *on;
             CsrLoc = *off;
             exsr loadSfl;
             reload = *off;
           endif;
           write MSGCTL;
           write SFL1KEY;
           exfmt SFLC1;
           exsr clrMsg;
           exsr setSFLC1csr;
           CsrLoc = *off;

           select;
            // F3 Exit pressed
             when Exit = *on;
               leave;

            // F12 Cancel pressed
             when Cancel = *on;
               leave;
           endsl;

          // check if an option entered
           wrkChgflg = *off;
           wrkTopflg = *off;
           if SflDsp = *on;
             dou %eof;
               wrkErrflg = *off;
               readc SFLS1;
               if %eof;
                 leave;
               endif;

               CsrLoc = *on;
               select;
                // update IP address record
                 when S1SELECT = '2';
                   exsr optUpdIP;

                // delete IP address record
                 when S1SELECT = '4';
                   exsr optDelIP;

                // display IP address record
                 when S1SELECT = '5';
                   exsr optDspIP;

                // ignore blanks
                 when S1SELECT = *blanks;

                 other;
                   wrkErrflg = *on;
                   prmMsgfile = msgFile;
                   prmMsgid = 'RDW0012';
                  // 'Invalid option.'
                   exsr sndmsgid;
               endsl;

               select;
                 when wrkErrflg = *off;
                   S1SELECT = *blanks;
                   atbS1SEL = green_ul;
                   SflNxtChg = *off;

                 other;
                  // subfile selection criteria not met
                  // return with highlighted subfile change option
                   atbS1SEL = green_ul_ri;
                   SflNxtChg = *on;
                   wrkChgflg = *on;
               endsl;
               update SFLS1;
             enddo;
           endif;

           if wrkChgflg = *on;
             iter;
           endif;

           select;
            // check if PageDown key is pressed
             when PageDown = *on
               and SflEnd = *off;
               loadmode = ReadForward;
               reload = *on;

            // check if PageUp key is pressed
             when PageUp = *on
               and SflDsp = *on;
               loadmode = ReadBack;
               exsr setTopPos;
               reload = *on;

            // F5 Refresh pressed
             when Refresh = *on;
               loadmode = Position;
               exsr setTopPos;
               reload = *on;

            // F6 Add pressed
             when AddNew = *on;
               exsr optAddIP;

            // F11 Change View pressed
             when View = *on;
               exsr optView;

            // check if reposition is entered
             other;
               exsr chkReposition;
               if reload = *off
                 and wrkTopflg = *on;
                 loadmode = Position;
                 exsr setTopPos;
                 reload = *on;
               endif;
           endsl;
         enddo;

        // Exit program
         exsr exitProgram;
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 4:42 pm    Post subject: Reply with quote

Code:

       //**************************************************************
       //  Subroutine: optAddIP
       //**************************************************************
         begsr optAddIp;

           callp addVisitor(prmErrorCode
                           :prmExit
                           :prmFile
                           :prmSite
                           :prmVisitor);
           select;
             when prmExit = *on;
               exsr exitProgram;

             when prmErrorCode = wrkSuccess;
               exsr setAddPos;
               reload = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0004';
              // 'Record added.'
               exsr sndmsgid;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: setAddPos
       //    in:       viewmode set to selected view
       //**************************************************************
         begsr setAddPos;

           loadmode = Position;

           chain (prmSite: prmVISITOR) WEBIPRECRD;
           if not %found(WEBIPRECRD);
             leavesr;
           endif;

           select;
             when viewmode = VisitorRRN;
               C1VISITOR = VISITOR;

             when viewmode = IPaddress;
               C1IPSEG1 = IPSEG1;
               C1IPSEG2 = IPSEG2;
               C1IPSEG3 = IPSEG3;
               C1IPSEG4 = IPSEG4;

             when viewmode = HostIP;
               C1HOST = HOST;
               C1IPSEG1 = IPSEG1;
               C1IPSEG2 = IPSEG2;
               C1IPSEG3 = IPSEG3;
               C1IPSEG4 = IPSEG4;

             when viewmode = StateHost;
               C1STATE = STATE;
               C1HOST3 = HOST;
               C1IPSEG1 = IPSEG1;
               C1IPSEG2 = IPSEG2;
               C1IPSEG3 = IPSEG3;
               C1IPSEG4 = IPSEG4;

             when viewmode = CityState;
               C1CITY = CITY;
               C1STATE4 = STATE;
               C1HOST4 = HOST;
               C1IPSEG1 = IPSEG1;
               C1IPSEG2 = IPSEG2;
               C1IPSEG3 = IPSEG3;
               C1IPSEG4 = IPSEG4;

             when viewmode = TopicHost;
               C1TOPIC = TOPIC;
               C1HOST5 = HOST;
               C1IPSEG1 = IPSEG1;
               C1IPSEG2 = IPSEG2;
               C1IPSEG3 = IPSEG3;
               C1IPSEG4 = IPSEG4;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: optUpdIP
       //**************************************************************
         begsr optUpdIp;

           prmVisitor = S1VISITOR;
           callp updVisitor(prmErrorCode
                           :prmExit
                           :prmFile
                           :prmSite
                           :prmVisitor);
           select;
             when Exit = *on;
               exsr exitProgram;

             when prmErrorCode = wrkSuccess;
               wrkTopflg = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0005';
              // 'Record updated.'
               exsr sndmsgid;

             when prmErrorCode = wrkError;
               wrkErrflg = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0009';
              // 'Selection not completed.'
               exsr sndmsgid;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: optDelIP
       //**************************************************************
         begsr optDelIp;

           prmVisitor = S1VISITOR;
           callp delVisitor(prmErrorCode
                           :prmExit
                           :prmFile
                           :prmSite
                           :prmVisitor);
           select;
             when Exit = *on;
               exsr exitProgram;

             when prmErrorCode = wrkSuccess;
               wrkTopflg = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0006';
              // 'Record deleted.'
               exsr sndmsgid;

             when prmErrorCode = wrkError;
               wrkErrflg = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0009';
              // 'Selection not completed.'
               exsr sndmsgid;
           endsl;

         endsr;
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 5:42 pm    Post subject: Reply with quote

Code:

       //**************************************************************
       //  Subroutine: optDspIP
       //**************************************************************
         begsr optDspIp;

           prmVisitor = S1VISITOR;
           callp dspVisitor(prmErrorCode
                           :prmExit
                           :prmFile
                           :prmSite
                           :prmVisitor);
           select;
             when Exit = *on;
               exsr exitProgram;

             when prmErrorCode = wrkSuccess;
              // record displayed

             when prmErrorCode = wrkError;
               wrkErrflg = *on;
               prmMsgfile = msgFile;
               prmMsgid = 'RDW0009';
              // 'Selection not completed.'
               exsr sndmsgid;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: optView
       //**************************************************************
         begsr optView;

           exsr loadSfl2;
           exfmt SFLC2;

           dou %eof;
             readc SFLS2;
             if %eof;
               leave;
             endif;

             if S2SELECT <> *blanks;
               viewmode = SF2RRN-1;
               loadmode = Position;
               exsr setTopPos;
               exsr initViewMode;
               C1POSDSC = setPOSDSC(viewmode);
               reload = *on;
               leave;
             endif;
           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: initLoadPos
       //    in:       viewmode set to selected view
       //**************************************************************
         begsr initLoadPos;

           loadmode = Position;
           C1POSDSC = setPOSDSC(viewmode);

           select;
             when viewmode = VisitorRRN;
               C1VISITOR = *loval;
               savVISITOR  = *zeros;

             when viewmode = IPaddress;
               C1IPSEG1 = *loval;
               C1IPSEG2 = *loval;
               C1IPSEG3 = *loval;
               C1IPSEG4 = *loval;
               savIPSEG1 = *zeros;
               savIPSEG2 = *zeros;
               savIPSEG3 = *zeros;
               savIPSEG4 = *zeros;

             when viewmode = HostIP;
               C1HOST   = *loval;
               C1IPSEG1 = *loval;
               C1IPSEG2 = *loval;
               C1IPSEG3 = *loval;
               C1IPSEG4 = *loval;
               savHOST  = *blanks;
               savIPSEG1 = *zeros;
               savIPSEG2 = *zeros;
               savIPSEG3 = *zeros;
               savIPSEG4 = *zeros;

             when viewmode = StateHost;
               C1STATE  = *loval;
               C1HOST3  = *loval;
               C1IPSEG1 = *loval;
               C1IPSEG2 = *loval;
               C1IPSEG3 = *loval;
               C1IPSEG4 = *loval;
               savSTATE = *blanks;
               savHOST  = *blanks;
               savIPSEG1 = *zeros;
               savIPSEG2 = *zeros;
               savIPSEG3 = *zeros;
               savIPSEG4 = *zeros;

             when viewmode = CityState;
               C1CITY   = *loval;
               C1STATE4 = *loval;
               C1HOST4  = *loval;
               C1IPSEG1 = *loval;
               C1IPSEG2 = *loval;
               C1IPSEG3 = *loval;
               C1IPSEG4 = *loval;
               savCITY  = *blanks;
               savSTATE = *blanks;
               savHOST  = *blanks;
               savIPSEG1 = *zeros;
               savIPSEG2 = *zeros;
               savIPSEG3 = *zeros;
               savIPSEG4 = *zeros;

             when viewmode = TopicHost;
               C1TOPIC  = *loval;
               C1HOST5  = *loval;
               C1IPSEG1 = *loval;
               C1IPSEG2 = *loval;
               C1IPSEG3 = *loval;
               C1IPSEG4 = *loval;
               savTOPIC = *zeros;
               savHOST  = *blanks;
               savIPSEG1 = *zeros;
               savIPSEG2 = *zeros;
               savIPSEG3 = *zeros;
               savIPSEG4 = *zeros;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: loadSfl
       //**************************************************************
         begsr loadSfl;

           exsr initSfl;
           SF1RRN = savSF1RRN;
           pageCtr = *zeros;

           exsr loadViewMode;

           SflClr = *off;
           SflDspCtl = *on;

          // Display message if no record found
           if SF1RRN = *zeros;
             SF1RRN = 1;
             atbS1SEL = non_pr;
             write SFLS1;
             prmMsgfile = msgFile;
             prmMsgid = 'RDW0002';
            // 'No records to display.'
             exsr sndmsgid;
           endif;

         endsr;

       //**************************************************************
       //  Subroutine: initSfl
       //**************************************************************
         begsr initSfl;

           exsr clrSfl;
           select;
             when loadmode = Position;
               exsr initViewMode;

             when loadmode = ReadForward;
               exsr rollSfl;

             when loadmode = ReadBack;
               exsr backSfl;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: clrSfl
       //**************************************************************
         begsr clrSfl;

           SflClr = *on;
           SflDsp = *off;
           SflDspCtl = *off;
           SflEnd = *off;
           SflNxtChg = *off;

           SF1RRN = *zeros;
           savSF1RRN = SF1RRN;

           write SFLC1;

           SflDsp = *on;
           SflDspCtl = *on;
           SflClr = *off;

           C1FILE   = prmFile;
           C1SITE   = prmSite;

           S1SELECT = *blanks;
           atbS1SEL = green_ul;
           S1VISITOR = *zeros;
           S1IPSEG1 = *zeros;
           S1IPSEG2 = *zeros;
           S1IPSEG3 = *zeros;
           S1IPSEG4 = *zeros;
           S1HOST   = *blanks;
           S1CITY   = *blanks;
           S1STATE  = *blanks;
           S1TOPIC  = *blanks;

         endsr;
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 5:50 pm    Post subject: Reply with quote

Code:


       //**************************************************************
       //  Subroutine: initViewMode
       //    in:       viewmode set to selected view
       //              position to variables set
       //**************************************************************
         begsr initViewMode;

           *in50 = *off;
           *in51 = *off;
           *in52 = *off;
           *in53 = *off;
           *in54 = *off;
           *in55 = *off;

           select;
             when viewmode = VisitorRRN;
               setll (prmSite: C1VISITOR) WEBIPRECRD;
               *in50 = *on;

             when viewmode = IPaddress;
               setll (prmSite
                     :C1IPSEG1
                     :C1IPSEG2
                     :C1IPSEG3
                     :C1IPSEG4)
                     WEBIPRCDL1;
               *in51 = *on;

             when viewmode = HostIP;
               setll (prmSite
                     :C1HOST
                     :C1IPSEG1
                     :C1IPSEG2
                     :C1IPSEG3
                     :C1IPSEG4)
                     WEBIPRCDL2;
               *in52 = *on;

             when viewmode = StateHost;
               setll (prmSite
                     :C1STATE
                     :C1HOST3
                     :C1IPSEG1
                     :C1IPSEG2
                     :C1IPSEG3
                     :C1IPSEG4)
                     WEBIPRCDL3;
               *in53 = *on;

             when viewmode = CityState;
               setll (prmSite
                     :C1CITY
                     :C1STATE4
                     :C1HOST4
                     :C1IPSEG1
                     :C1IPSEG2
                     :C1IPSEG3
                     :C1IPSEG4)
                     WEBIPRCDL4;
               *in54 = *on;

             when viewmode = TopicHost;
               setll (prmSite
                     :C1TOPIC
                     :C1HOST5
                     :C1IPSEG1
                     :C1IPSEG2
                     :C1IPSEG3
                     :C1IPSEG4)
                     WEBIPRCDL5;
               *in55 = *on;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: rollSfl
       //**************************************************************
         begsr rollSfl;

           select;
             when viewmode = VisitorRRN;
               setgt (prmSite: savVISITOR) WEBIPRECRD;

             when viewmode = IPaddress;
               setgt (prmSite
                     :savIPSEG1
                     :savIPSEG2
                     :savIPSEG3
                     :savIPSEG4)
                     WEBIPRCDL1;

             when viewmode = HostIP;
               setgt (prmSite
                     :savHOST
                     :savIPSEG1
                     :savIPSEG2
                     :savIPSEG3
                     :savIPSEG4)
                     WEBIPRCDL2;

             when viewmode = StateHost;
               setgt (prmSite
                     :savSTATE
                     :savHOST
                     :savIPSEG1
                     :savIPSEG2
                     :savIPSEG3
                     :savIPSEG4)
                     WEBIPRCDL3;

             when viewmode = CityState;
               setgt (prmSite
                     :savCITY
                     :savSTATE
                     :savHOST
                     :savIPSEG1
                     :savIPSEG2
                     :savIPSEG3
                     :savIPSEG4)
                     WEBIPRCDL4;

             when viewmode = TopicHost;
               setgt (prmSite
                     :savTOPIC
                     :savHOST
                     :savIPSEG1
                     :savIPSEG2
                     :savIPSEG3
                     :savIPSEG4)
                     WEBIPRCDL5;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: backSfl
       //**************************************************************
         begsr backSfl;

           exsr initViewMode;

           select;
             when viewmode = VisitorRRN;
               exsr backVisitorRRN;

             when viewmode = IPaddress;
               exsr backIPaddress;

             when viewmode = HostIP;
               exsr backHostIP;

             when viewmode = StateHost;
               exsr backStateHost;

             when viewmode = CityState;
               exsr backCityState;

             when viewmode = TopicHost;
               exsr backTopicHost;
           endsl;

           exsr initViewMode;

         endsr;

       //**************************************************************
       //  Subroutine: loadViewMode
       //**************************************************************
         begsr loadViewMode;

           select;
             when viewmode = VisitorRRN;
               exsr loadVisitorRRN;

             when viewmode = IPaddress;
               exsr loadIPaddress;

             when viewmode = HostIP;
               exsr loadHostIP;

             when viewmode = StateHost;
               exsr loadStateHost;

             when viewmode = CityState;
               exsr loadCityState;

             when viewmode = TopicHost;
               exsr loadTopicHost;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: loadVisitorRRN
       //**************************************************************
         begsr loadVisitorRRN;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRECRD)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRECRD;
             if %eof(WEBIPRECRD);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savVISITOR = VISITOR;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRECRD;
                 if %eof(WEBIPRECRD);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1VISITOR = *zeros;

         endsr;
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 6:02 pm    Post subject: Reply with quote

Code:

       //**************************************************************
       //  Subroutine: loadIPaddress
       //**************************************************************
         begsr loadIPaddress;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRCDL1)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRCDL1;
             if %eof(WEBIPRCDL1);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savIPSEG1 = IPSEG1;
             savIPSEG2 = IPSEG2;
             savIPSEG3 = IPSEG3;
             savIPSEG4 = IPSEG4;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRCDL1;
                 if %eof(WEBIPRCDL1);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1IPSEG1 = *zeros;
           C1IPSEG2 = *zeros;
           C1IPSEG3 = *zeros;
           C1IPSEG4 = *zeros;

         endsr;

       //**************************************************************
       //  Subroutine: loadHostIP
       //**************************************************************
         begsr loadHostIP;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRCDL2)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRCDL2;
             if %eof(WEBIPRCDL2);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savHOST   = HOST;
             savIPSEG1 = IPSEG1;
             savIPSEG2 = IPSEG2;
             savIPSEG3 = IPSEG3;
             savIPSEG4 = IPSEG4;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRCDL2;
                 if %eof(WEBIPRCDL2);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1HOST   = *blanks;
           C1IPSEG1 = *zeros;
           C1IPSEG2 = *zeros;
           C1IPSEG3 = *zeros;
           C1IPSEG4 = *zeros;

         endsr;

       //**************************************************************
       //  Subroutine: loadStateHost
       //**************************************************************
         begsr loadStateHost;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRCDL3)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRCDL3;
             if %eof(WEBIPRCDL3);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savSTATE  = STATE;
             savHOST   = HOST;
             savIPSEG1 = IPSEG1;
             savIPSEG2 = IPSEG2;
             savIPSEG3 = IPSEG3;
             savIPSEG4 = IPSEG4;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRCDL3;
                 if %eof(WEBIPRCDL3);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1STATE  = *blanks;
           C1HOST3  = *blanks;
           C1IPSEG1 = *zeros;
           C1IPSEG2 = *zeros;
           C1IPSEG3 = *zeros;
           C1IPSEG4 = *zeros;

         endsr;

       //**************************************************************
       //  Subroutine: loadCityState
       //**************************************************************
         begsr loadCityState;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRCDL4)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRCDL4;
             if %eof(WEBIPRCDL4);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savCITY   = CITY;
             savSTATE  = STATE;
             savHOST   = HOST;
             savIPSEG1 = IPSEG1;
             savIPSEG2 = IPSEG2;
             savIPSEG3 = IPSEG3;
             savIPSEG4 = IPSEG4;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRCDL4;
                 if %eof(WEBIPRCDL4);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1CITY   = *blanks;
           C1STATE4 = *blanks;
           C1HOST4  = *blanks;
           C1IPSEG1 = *zeros;
           C1IPSEG2 = *zeros;
           C1IPSEG3 = *zeros;
           C1IPSEG4 = *zeros;

         endsr;

       //**************************************************************
       //  Subroutine: loadTopicHost
       //**************************************************************
         begsr loadTopicHost;

           if pageCtr >= sf1Size;
             leavesr;
           endif;

           dou %eof(WEBIPRCDL5)
             or pageCtr = sf1Size;

             reade (prmSite) WEBIPRCDL5;
             if %eof(WEBIPRCDL5);
               leave;
             endif;

             exsr setSFL1;

           enddo;

           if pageCtr > *zeros;
             savTOPIC  = TOPIC;
             savHOST   = HOST;
             savIPSEG1 = IPSEG1;
             savIPSEG2 = IPSEG2;
             savIPSEG3 = IPSEG3;
             savIPSEG4 = IPSEG4;

            // Check if EOF, end SFL
             select;
               when pageCtr < sf1Size;
                 SflEnd = *on;

               other;
                 reade (prmSite) WEBIPRCDL5;
                 if %eof(WEBIPRCDL5);
                   SflEnd = *on;
                 endif;
             endsl;
           else;
             SflEnd = *on;
           endif;

           C1TOPIC  = *blanks;
           C1HOST5  = *blanks;
           C1IPSEG1 = *zeros;
           C1IPSEG2 = *zeros;
           C1IPSEG3 = *zeros;
           C1IPSEG4 = *zeros;

         endsr;

       //**************************************************************
       //  Subroutine: setSFL1
       //**************************************************************
         begsr setSFL1;

           SF1RRN += 1;

           S1VISITOR = VISITOR;

           callp setIPSEG(IPSEG1
                         :IPSEG2
                         :IPSEG3
                         :IPSEG4
                         :S1IPSEG1
                         :S1IPSEG2
                         :S1IPSEG3
                         :S1IPSEG4);

           S1HOST   = HOST;
           S1CITY   = CITY;
           S1STATE  = STATE;
           S1TOPIC  = TOPIC;

           SflDspCtl = *on;
           SflNxtChg = *off;
           write SFLS1;
           pageCtr += 1;

         endsr;

Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 6:10 pm    Post subject: Reply with quote

Code:

       //**************************************************************
       //  Subroutine: chkReposition
       //    in:       viewmode set to selected view
       //              position to variables optionally set
       //**************************************************************
         begsr chkReposition;

           select;
             when viewmode = VisitorRRN;
               if C1VISITOR > *zeros;
                 loadmode = Position;
                 reload = *on;
               endif;

             when viewmode = IPaddress;
               if C1IPSEG1 > *zeros;
                 loadmode = Position;
                 reload = *on;
               endif;

             when viewmode = HostIP;
               if C1HOST > *blanks;
                 loadmode = Position;
                 reload = *on;
               endif;

             when viewmode = StateHost;
               if C1STATE > *blanks;
                 loadmode = Position;
                 reload = *on;
               endif;

             when viewmode = CityState;
               if C1CITY > *blanks;
                 loadmode = Position;
                 reload = *on;
               endif;

             when viewmode = TopicHost;
               if C1TOPIC > *blanks;
                 loadmode = Position;
                 reload = *on;
               endif;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: setTopPos
       //    in:       viewmode set to selected view
       //**************************************************************
         begsr setTopPos;

           SF1RRN = 1;
           chain SF1RRN SFLS1;

           select;
             when viewmode = VisitorRRN;
               C1VISITOR = S1VISITOR;

             when viewmode = IPaddress;
               exsr setC1IPSEG;

             when viewmode = HostIP;
               C1HOST = S1HOST;
               exsr setC1IPSEG;

             when viewmode = StateHost;
               C1STATE = S1STATE;
               C1HOST3 = S1HOST;
               exsr setC1IPSEG;

             when viewmode = CityState;
               C1CITY = S1CITY;
               C1STATE4 = S1STATE;
               C1HOST4 = S1HOST;
               exsr setC1IPSEG;

             when viewmode = TopicHost;
               C1TOPIC = S1TOPIC;
               C1HOST5 = S1HOST;
               exsr setC1IPSEG;
           endsl;

         endsr;

       //**************************************************************
       //  Subroutine: setC1IPSEG
       //    Convert character display of IP address to numeric IP
       //**************************************************************
         begsr setC1IPSEG;

           callp cvtIPSEG(C1IPSEG1
                         :C1IPSEG2
                         :C1IPSEG3
                         :C1IPSEG4
                         :S1IPSEG1
                         :S1IPSEG2
                         :S1IPSEG3
                         :S1IPSEG4);

         endsr;

       //**************************************************************
       //  Subroutine: backVisitorRRN
       //**************************************************************
         begsr backVisitorRRN;

           loopCtr = *zeros;

           dou %eof(WEBIPRECRD)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRECRD;
             if %eof(WEBIPRECRD)
               or %error;
               leave;
             endif;

             C1VISITOR = VISITOR;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: backIPaddress
       //**************************************************************
         begsr backIPaddress;

           loopCtr = *zeros;

           dou %eof(WEBIPRCDL1)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRCDL1;
             if %eof(WEBIPRCDL1)
               or %error;
               leave;
             endif;

             C1IPSEG1 = IPSEG1;
             C1IPSEG2 = IPSEG2;
             C1IPSEG3 = IPSEG3;
             C1IPSEG4 = IPSEG4;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: backHostIP
       //**************************************************************
         begsr backHostIP;

           loopCtr = *zeros;

           dou %eof(WEBIPRCDL2)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRCDL2;
             if %eof(WEBIPRCDL2)
               or %error;
               leave;
             endif;

             C1HOST = HOST;
             C1IPSEG1 = IPSEG1;
             C1IPSEG2 = IPSEG2;
             C1IPSEG3 = IPSEG3;
             C1IPSEG4 = IPSEG4;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: backStateHost
       //**************************************************************
         begsr backStateHost;

           loopCtr = *zeros;

           dou %eof(WEBIPRCDL3)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRCDL3;
             if %eof(WEBIPRCDL3)
               or %error;
               leave;
             endif;

             C1STATE = STATE;
             C1HOST3 = HOST;
             C1IPSEG1 = IPSEG1;
             C1IPSEG2 = IPSEG2;
             C1IPSEG3 = IPSEG3;
             C1IPSEG4 = IPSEG4;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: backCityState
       //**************************************************************
         begsr backCityState;

           loopCtr = *zeros;

           dou %eof(WEBIPRCDL4)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRCDL4;
             if %eof(WEBIPRCDL4)
               or %error;
               leave;
             endif;

             C1CITY = CITY;
             C1STATE4 = STATE;
             C1HOST4 = HOST;
             C1IPSEG1 = IPSEG1;
             C1IPSEG2 = IPSEG2;
             C1IPSEG3 = IPSEG3;
             C1IPSEG4 = IPSEG4;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: backTopicHost
       //**************************************************************
         begsr backTopicHost;

           loopCtr = *zeros;

           dou %eof(WEBIPRCDL5)
             or loopCtr = sf1Size;

             readpe(e) (prmSite) WEBIPRCDL5;
             if %eof(WEBIPRCDL5)
               or %error;
               leave;
             endif;

             C1TOPIC = TOPIC;
             C1HOST5 = HOST;
             C1IPSEG1 = IPSEG1;
             C1IPSEG2 = IPSEG2;
             C1IPSEG3 = IPSEG3;
             C1IPSEG4 = IPSEG4;
             loopCtr += 1;

           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: setSFLC1csr
       //**************************************************************
         begsr setSFLC1csr;

           csrpos = SFLC1DS.rowcol;
           ROWPOS = %div(csrpos: 256);
           COLPOS = %rem(csrpos: 256);

         endsr;

       //**************************************************************
       //  Subroutine: loadSfl2
       //**************************************************************
         begsr loadSfl2;

           exsr clrSfl2;

           dou SF2RRN = sf2Size;
             prmView = SF2RRN;
             S2DESC = setPOSDSC(prmView);
             SflDspCtl = *on;
             SF2RRN += 1;
             write SFLS2;
           enddo;

         endsr;

       //**************************************************************
       //  Subroutine: clrSfl2
       //**************************************************************
         begsr clrSfl2;

           SflClr = *on;
           SflDsp = *off;
           SflDspCtl = *off;

           SF2RRN = *zeros;

           write SFLC2;

           SflDsp = *on;
           SflDspCtl = *on;
           SflClr = *off;

           S2SELECT = *blanks;
           S2DESC   = *blanks;

         endsr;

       //**************************************************************
       //  Subroutine: clrMsg
       //**************************************************************
         begsr clrMsg;

           SflMsgEnd = *on;
           write MSGCTL;
           SflMsgEnd = *off;
           clrmsgc();

         endsr;

       //**************************************************************
       //  Subroutine: sndMsgid
       //    parms:    prmMsgfile  message file
       //              prmMsgid    message id to send
       //**************************************************************
         begsr sndMsgid;

           sndmsgidc(prmMsgfile: prmMsgid);

         endsr;

       //**************************************************************
       //  Subroutine: sndMsg
       //    parms:    prmMsgdta   message to send
       //**************************************************************
         begsr sndMsg;

           sndmsgdtac(prmMsgdta);

         endsr;

       //**************************************************************
       //  Subroutine: exitProgram
       //**************************************************************
         begsr exitProgram;

           *inlr = *on;
           return;

         endsr;

       //**************************************************************
       //  Subroutine: *inzsr
       //**************************************************************
         begsr *inzsr;

           pgmsgq = pgmnam;

         endsr;

      /end-free
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 6:18 pm    Post subject: Reply with quote

WEBVISITDA.DSPF
Code:

     A*****************************************************************
     A*               WEBVISITOR File Maintenance Add
     A*  Display WEBVISITDA
     A*****************************************************************
     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A*****************************************************************
     A          R SCN06
     A                                      WINDOW(01 02 21 74)
     A                                      WDWBORDER((*COLOR TRQ) (*DSPATR RI)-
     A                                       (*CHAR '        '))
     A                                      CF03(03 'Exit')
     A                                      CF10(10 'Save')
     A                                      CF12(12 'Return')
     A                                      OVERLAY
     A            PGMNAM        10A  O  1  2COLOR(BLU)
     A            S6FILE    R        O  1 33REFFLD(WEBVISITR/WEBSITE WEBVISITOR)
     A                                      COLOR(WHT)
     A                                  1 44'Add'
     A                                      COLOR(WHT)
     A                                  1 66DATE(*SYS *Y)
     A                                      EDTCDE(Y)
     A                                      COLOR(BLU)
     A                                  2  2USER
     A                                      COLOR(BLU)
     A            S6SITE    R        O  2 36REFFLD(WEBVISITR/WEBSITE WEBVISITOR)
     A                                      COLOR(WHT)
     A                                  2 66TIME
     A                                      COLOR(BLU)
     A*
     A                                  5  2'IP address ID. .'
     A                                      COLOR(WHT)
     A                                  5 19'*New'
     A                                  6  2'IP address , . .'
     A                                      COLOR(WHT)
     A            ATBIPSEG1      1A  P
     A            S6IPSEG1  R        B  6 19REFFLD(WEBVISITR/IPSEG1 WEBVISITOR)
     A                                      DSPATR(&ATBIPSEG1)
     A            S6IPSEG2  R        B  6 24REFFLD(WEBVISITR/IPSEG2 WEBVISITOR)
     A            S6IPSEG3  R        B  6 29REFFLD(WEBVISITR/IPSEG3 WEBVISITOR)
     A            S6IPSEG4  R        B  6 34REFFLD(WEBVISITR/IPSEG4 WEBVISITOR)
     A                                  7  2'Host . . . , . .'
     A                                      COLOR(WHT)
     A            S6HOST    R        B  7 19REFFLD(WEBVISITR/HOST   WEBVISITOR)
     A                                      CHECK(LC)
     A                                  8  2'City . . . , . .'
     A                                      COLOR(WHT)
     A            S6CITY    R        B  8 19REFFLD(WEBVISITR/CITY   WEBVISITOR)
     A                                      CHECK(LC)
     A                                  9  2'State. . . , . .'
     A                                      COLOR(WHT)
     A            S6STATE   R        B  9 19REFFLD(WEBVISITR/STATE  WEBVISITOR)
     A                                 10  2'Topic. . . , . .'
     A                                      COLOR(WHT)
     A            S6TOPIC   R        B 10 19REFFLD(WEBVISITR/TOPIC  WEBVISITOR)
     A                                      CHECK(LC)
     A                                 12  2'User . . . , . .'
     A                                      COLOR(WHT)
     A            S6USER    R        B 12 19REFFLD(WEBVISITR/USER   WEBVISITOR)
     A                                      CHECK(LC)
     A                                 13  2'Search . . , . .'
     A                                      COLOR(WHT)
     A            S6SEARCH  R        B 13 19REFFLD(WEBVISITR/SEARCH WEBVISITOR)
     A                                      CHECK(LC)
     A*
     A                                 19  2'F3=Exit'
     A                                      COLOR(BLU)
     A                                 19 12'F10=Save'
     A                                      COLOR(BLU)
     A                                 19 23'F12=Return'
     A                                      COLOR(BLU)
     A*
     A*****************************************************************
     A          R MSGSFL                    SFL SFLMSGRCD(20)
     A            MSGKEY                    SFLMSGKEY
     A            PGMSGQ                    SFLPGMQ
     A*
     A*****************************************************************
     A          R MSGCTL                    SFLCTL(MSGSFL)
     A                                      WINDOW(SCN06)
     A                                      OVERLAY
     A                                      SFLSIZ(0010)
     A                                      SFLPAG(0001)
     A                                      SFLDSP
     A                                      SFLDSPCTL
     A                                      SFLINZ
     A N98                                  SFLEND
     A            PGMSGQ                    SFLPGMQ
Back to top
View user's profile Send private message Send e-mail Visit poster's website
rd



Joined: 13 Sep 2002
Posts: 9234
Location: Jacksonville, FL

PostPosted: Sun Aug 16, 2009 9:43 pm    Post subject: Reply with quote

WEBVISITRA.RPGLE
Code:

      *****************************************************************
      *               Web IP Records File Maintenance Add
      *
      *  Program WEBVISITRA
      *****************************************************************
     h  dftactgrp(*no) actgrp('RDWRITES') bnddir('RDWRITES')
     h  debug option(*srcstmt:*nodebugio)

      *****************************************************************
      * File Specifications
      *****************************************************************
      * WEBIPRECRD override file
     fwebiprecrdif a e           k disk    rename(WEBVISITR: IPRECRD)
      * Display File
     fwebvisitdacf   e             workstn

      *****************************************************************
      *Entry Declaration
      *****************************************************************
     d WEBVISITRA      pr
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(WEBSITE)
     d  prmVisitor                         like(VISITOR)

     d WEBVISITRA      pi
     d  prmErrorCode                       like(returnCode)
     d  prmExit                            like(flag)
     d  prmFile                            like(pgmnam)
     d  prmSite                            like(WEBSITE)
     d  prmVisitor                         like(VISITOR)

      *****************************************************************
      * Prototype Definitions
      *****************************************************************
      /copy RDWSRC,WEBVISITPR

      *****************************************************************
      * Data Structure Declaration
      *****************************************************************
      * function keys and indicators
     d @Indicator      s               *   inz(%addr(*IN))
     d Indicators      ds                  based(@Indicator)
     d  Exit                  03     03
     d  Save                  10     10
     d  Cancel                12     12
     d  SflMsgEnd             98     98

      *****************************************************************
      * Stand Alone Fields Declaration
      *****************************************************************
     d* Work variables
     d wrkVISITOR      s                   like(VISITOR)
     d wrkCfmflg       s                   like(flag)


      *****************************************************************
      * Mainline
      *****************************************************************
      /free
         write SCN06;
         exsr clrMsg;
         exsr setSCN06;

         dou Exit = *on or Cancel = *on;
           write MSGCTL;
           exfmt SCN06;
           exsr clrMsg;

           select;

            // F3 Exit pressed
             when Exit = *on;
               prmExit = Exit;
               leave;

            // F12 Return pressed
             when Cancel = *on;
               leave;

            // F10 Save pressed
             when Save = *on;
               exsr valSCN06;
               if wrkCfmflg = 'N';
                 iter;
               endif;
               exsr wrtSCN06;
               leave;

            // Enter pressed
             other;
               exsr valSCN06;
               if wrkCfmflg = 'Y';
                 prmMsgfile = msgFile;
                 prmMsgid = 'RDW0008';
                // 'Press F10 to save.'
                 exsr sndmsgid;
               endif;
           endsl;
         enddo;

        // Exit program
         exsr exitProgram;

       //**************************************************************
       //  Subroutine: setSCN06
       //**************************************************************
         begsr setSCN06;

           S6FILE   = prmFile;
           S6SITE   = prmSite;

           ATBIPSEG1 = green_ul;
           S6IPSEG1 = *zeros;
           S6IPSEG2 = *zeros;
           S6IPSEG3 = *zeros;
           S6IPSEG4 = *zeros;
           S6HOST   = *blanks;
           S6CITY   = *blanks;
           S6STATE  = *blanks;
           S6TOPIC  = *blanks;
           S6USER   = *blanks;
           S6SEARCH = *blanks;

         endsr;

       //**************************************************************
       //  Subroutine: valSCN06
       //**************************************************************
         begsr valSCN06;

           wrkCfmflg = 'N';
           ATBIPSEG1 = green_ul;

           if S6IPSEG1 = *zeros;
             ATBIPSEG1 = green_ul_ri;
             prmMsgfile = msgFile;
             prmMsgid = 'RDW0003';
            // 'Required field.'
             exsr sndmsgid;
             leavesr;
           endif;

           prmMsgid = *blanks;
           callp chkVisitor(prmMsgid
                           :prmFile
                           :prmSite
                           :S6IPSEG1
                           :S6IPSEG2
                           :S6IPSEG3
                           :S6IPSEG4);

           if prmMsgid <> *blanks;
             prmMsgfile = msgFile;
            // rules warning message
             exsr sndmsgid;
             leavesr;
           endif;

           wrkCfmflg = 'Y';

         endsr;

       //**************************************************************
       //  Subroutine: wrtSCN06
       //**************************************************************
         begsr wrtSCN06;

           setgt (prmSite: *hival) WEBIPRECRD;
           readpe (prmSite) WEBIPRECRD;
           if not %eof(WEBIPRECRD);
             wrkVISITOR = VISITOR;
           else;
             wrkVISITOR = *zeros;
           endif;
           monitor;
             wrkVISITOR += 1;
             on-error;
               exsr OverflowErr;
               leavesr;
             endmon;

           WEBSITE = prmSite;
           VISITOR = wrkVISITOR;
           IPSEG1  = S6IPSEG1;
           IPSEG2  = S6IPSEG2;
           IPSEG3  = S6IPSEG3;
           IPSEG4  = S6IPSEG4;
           HOST    = S6HOST;
           CITY    = S6CITY;
           STATE   = S6STATE;
           TOPIC   = S6TOPIC;
           USER    = S6USER;
           SEARCH  = S6SEARCH;

           write(e) IPRECRD;
           if %error;
             exsr IOSysErr;
             leavesr;
           endif;
           prmVISITOR = wrkVISITOR;
           prmErrorCode = wrkSuccess;

         endsr;

       //**************************************************************
       //  Subroutine: clrMsg
       //**************************************************************
         begsr clrMsg;

           SflMsgEnd = *on;
           write MSGCTL;
           SflMsgEnd = *off;
           clrmsgc();

         endsr;

       //**************************************************************
       //  Subroutine: sndMsgid
       //    parms:    prmMsgfile  message file
       //              prmMsgid    message id to send
       //**************************************************************
         begsr sndMsgid;

           sndmsgidc(prmMsgfile: prmMsgid);

         endsr;

       //**************************************************************
         begsr IOSysErr;

           prmErrorCode = wrkError;
           prmMsgfile = msgFile;
           prmMsgid = 'RDW0010';
          // 'Record I/O failure.'
           exsr sndmsgid;

         endsr;

       //**************************************************************
       //  Subroutine: OverflowErr
       //**************************************************************
         begsr OverflowErr;

           prmErrorCode = wrkError;
           prmMsgfile = msgFile;
           prmMsgid = 'RDW0011';
          // 'Numeric overflow. Operation failed.'
           exsr sndmsgid;

         endsr;

       //**************************************************************
       //  Subroutine: exitProgram
       //**************************************************************
         begsr exitProgram;

           *inlr = *on;
           return;

         endsr;

       //**************************************************************
       //  Subroutine: *inzsr
       //**************************************************************
         begsr *inzsr;

          // default return code
           prmErrorCode = wrkFailure;
           prmExit = *blanks;

           pgmsgq = pgmnam;

         endsr;

      /end-free
Back to top
View user's profile Send private message Send e-mail Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    www.justiceforchandra.com Forum Index -> www.rdwrites.com forum (part of www.justiceforchandra.com) All times are GMT - 4 Hours
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group