Main

BAR$MAIN (RPGLE)



  X * REFERRER$ BEGSR BAR$MAIN 62  
  X * REFERRERSPAM$ BEGSR BAR$MAIN 12  
  X * REFERRERSPAM$2 BEGSR BAR$MAIN 7  
  X * LOGNAVS BEGSR BAR$MAIN 22  
  X * PFADSR BEGSR BAR$MAIN 65  
  X * PFADSR2 BEGSR BAR$MAIN 65  
  X * PFADELEMENT BEGSR BAR$MAIN 34  
  X * PFADEXTERN BEGSR BAR$MAIN 51  
  X * SPRACHESR BEGSR BAR$MAIN 48  
  X * DAUERINF BEGSR BAR$MAIN 13  
  X * *PSSR BEGSR BAR$MAIN 31  
  X  
  X * SPKEYSPR KLIST BAR$MAIN 3  
  X * SPKEYMAN KLIST BAR$MAIN 3  
  X * LIKEYSPR KLIST BAR$MAIN 3  
  X * LIKEYMAN KLIST BAR$MAIN 3  
  X * TEKEY1SPR KLIST BAR$MAIN 3  
  X * TEKEY1MAN KLIST BAR$MAIN 3  
  X  
  X * SEITEMITSR EXSR BAR$SEITE    
  X * AGENTSPAM$ EXSR BAR$AGENT    
  X * AGENTSPAM$123 EXSR BAR$AGENT    
  X * DATEN EXSR BAR$DATEN    
  X * SESSION EXSR BAR$SID    
  X * AGENTINF EXSR BAR$AGENT    
  X * SEITE EXSR BAR$SEITE    
  X * SECURITY EXSR BAR$SEC    
  X * NEUEDT EXSR BAR$NEUED    
  X * SENDEN EXSR BAR$SEND    
  X * ANFRAGE EXSR BAR$NEUED    
  X * NATYPNAV EXSR BAR$NAV    
  X * NATYPNAV EXSR BAR$NAV    
  X * NATYPNAV EXSR BAR$NAV    
  X * NATYPNAV EXSR BAR$NAV    
  X * SEITENAVSR EXSR BAR$SEITE    
  X * ANFRAGE EXSR BAR$NEUED    
  X  
C          
C *COPYRIGHT JÜRGEN REULE 2010-2023
C          
C          
C *     --------------------------------------
C *     Beginn-Zeitpunkt ermitteln
C *     --------------------------------------
C       CLEAR   DATE            
C       TIME   DATETIME            
C       CALLP(E) HTTPDATEX ( DATE:DATETIME:1)
C          
C *     --------------------------------------
C *     Abweichung zu UTC ermitteln
C *     --------------------------------------
C       CLEAR   HOURS            
C       CLEAR   MINUTES            
C       CLEAR   SECONDS            
C       CALLP(E) UTCOFFSETS ( HOURS:MINUTES:SECONDS:FEEDBACK)
C       EVAL UTCOFFSET     =             SECONDS
C          
C *     --------------------------------------
C *     Variablen initialisieren
C *     --------------------------------------
C       CLEAR   SID            
C       CLEAR   SIDQUERY            
C       CLEAR   SIDCOOKIE            
C          
C       CLEAR   DEBUG            
C       CLEAR   DEBUGQUERY            
C       CLEAR   DEBUGCOOKIE            
C          
C       CLEAR   SPRACHE            
C       CLEAR   SPRACHEQUERY            
C       CLEAR   SPRACHECOOKIE            
C          
C       CLEAR   SUCHE            
C       CLEAR   SCHMAL            
C       CLEAR   BENUTZER            
C       CLEAR   KENNWORT            
C          
C       CLEAR   COOKIE            
C       CLEAR   COOKIE2            
C       CLEAR   COOKIE3            
C       CLEAR   CONTEXT            
C          
C *     --------------------------------------
C *     Variablen initialisieren
C *     --------------------------------------
C       CLEAR   FORMTYPE            
C       CLEAR   DATATYPE            
C       CLEAR   DATAPTR            
C       CLEAR   DATALEN            
C       CLEAR   FILETYPE            
C       CLEAR   FILEPTR            
C       CLEAR   FILELEN            
C          
C *     --------------------------------------
C *     Datenstrukturen initialisieren
C *     --------------------------------------
C       CLEAR   LINKDS            
C       CLEAR   TEXTDS            
C       CLEAR   NAVIDS            
C       CLEAR   MIMEDS            
C       CLEAR   LABELDS            
C       CLEAR   SMILYDS            
C       CLEAR   RUBRIKDS            
C       CLEAR   OBJEKTDS            
C       CLEAR   ARTIKELDS            
C       CLEAR   ANFRAGEDS            
C       CLEAR   MANDANTDS            
C       CLEAR   ANTWORTDS            
C       CLEAR   MITGLIEDDS            
C       CLEAR   BENUTZERDS            
C       CLEAR   FORMDATADS            
C          
C *     --------------------------------------
C *     Debug-Modus / Schmal-Modus
C *     --------------------------------------
C       MOVEL(P) '0' DEBUG0            
C       MOVEL(P) '0' SCHMAL0            
C          
C *     --------------------------------------
C *     Variablen vorbelegen
C *     --------------------------------------
C     *ZERO ADD *LOVAL DAUER            
C     *ZERO ADD STATUS200 STATUS            
C       MOVEL(P) INDEXFOLLOW ROBOTS            
C     RANGES# CAT(P) NONE# :1 RANGE            
C     *ZERO ADD LOCABSLEN LOCLEN            
C     *ZERO ADD 1 LOCPOS            
C       CLEAR   LOCABS            
C       CLEAR   LOCATION            
C       CLEAR   MODIFIED            
C       CLEAR   LENGTH            
C       CLEAR   SIZE6            
C       CLEAR   QUERY            
C          
C *     --------------------------------------
C *     Cache-Zeiten einstellen
C *     --------------------------------------
C     CACHE# CAT(P) CACHEMIN# :1 CACHE            
C          
C       CAT PRAGMA# :0 CACHE            
C       CAT NOCACHE# :1 CACHE            
C          
C       CAT EXPIRES# :0 CACHE            
C       CAT DATE :1 CACHE            
C       CAT '§' :0 CACHE            
C          
C *     --------------------------------------
C *     Zeitpunkt ermitteln
C *     --------------------------------------
C     DATETIME SUBDUR NOZEITYEAR:*Y DATETIME7            
C          
C *     --------------------------------------
C *     Variablen initialisieren
C *     --------------------------------------
C       CLEAR   DNT            
C       CLEAR   HTTP            
C       CLEAR   HOST            
C       CLEAR   PFAD            
C       CLEAR   PFAD2            
C       CLEAR   AGENT            
C       CLEAR   SECURE            
C       CLEAR   SCHEME            
C       CLEAR   METHOD            
C       CLEAR   SCRIPT            
C       CLEAR   SCRIPT2            
C       CLEAR   REFERRER            
C          
C *     --------------------------------------
C *     Schema ermitteln http/https
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         REQUESTSCHEME:
C         REQUESTSCHEMELN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SCHEME     = %SUBST(ENVRCV:1:ENVLEN)
C     'https' COMP SCHEME       — — 23  
C       ELSE                
C *     --------------------------------------
C *     Schema ermitteln http/https
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         HTTPS:
C         HTTPSLEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SECURE     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Schema ermitteln http/https
C *     --------------------------------------
C     'ON' COMP SECURE       — — 23  
C       EVAL SECURE     = ''
C   23   EVAL SCHEME     = 'https'
C   N23   EVAL SCHEME     = 'http'
C       ENDIF                
C *     --------------------------------------
C *     Methode ermitteln GET/POST/...
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         REQUESTMETHOD:
C         REQUESTMETHODLN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL METHOD     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Methode ermitteln GET/POST/...
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         HTTPMETHOVER:
C         HTTPMETHOVERLEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL METHOD     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Hostname ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         HTTPHOST:
C         HTTPHOSTLEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL HOST       = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Pfadname ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         SCRIPTNAME:
C         SCRIPTNAMELEN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SCRIPT     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Pfadname ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         DOCUMENTURI:
C         DOCUMENTURILEN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SCRIPT     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Pfadname ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         PATHINFO:
C         PATHINFOLEN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SCRIPT     = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Pfadname ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         REDIRECTURL:
C         REDIRECTURLLEN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL SCRIPT2    = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Agent ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         HTTPUSERAGENT:
C         HTTPUSERAGENTLN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL AGENT      = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Referrer ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         REFERER:
C         REFERERLEN:QUSEC)
C          
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':' ')
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL REFERRER   = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Do Not Track ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         HTTPDNT:
C         HTTPDNTLEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL DNT        = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     IFS-Verzeichnis ermitteln
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         DOCUMENTROOT:
C         DOCUMENTROOTLEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       EVAL PFADIFS    = %SUBST(ENVRCV:1:ENVLEN)
C       ENDIF                
C *     --------------------------------------
C *     Adressen ermitteln
C *     --------------------------------------
C       EVAL HTTP       =  SCHEME +'://'+ HOST +'/'
C          
C *     --------------------------------------
C *     Pfad ermitteln
C *     --------------------------------------
C     *BLANKS IFNE SCRIPT              
C       EVAL PFAD       = %REPLACE('':SCRIPT:1:1)
C       ENDIF                
C *     --------------------------------------
C *     Pfad ermitteln
C *     --------------------------------------
C     *BLANKS IFNE SCRIPT2              
C       EVAL PFAD2      = %REPLACE('':SCRIPT2:1:1)
C       ENDIF                
C *     --------------------------------------
C *     Mandant einlesen
C *     --------------------------------------
C       OPEN MANDANTL2       — 77 —  
C     PFADIFS CHAIN MANDANTL2       77 77 —  
C          
C *     --------------------------------------
C *     Webmaster ermitteln
C *     --------------------------------------
C       MOVEL(P) *HIVAL WEBMASTER            
C       MOVEL(P) WEBMASTER$ ELEMENTNAV            
C       EXSR SEITEMITSR              
C   N77 *ZERO ADD MIMIT WEBMASTER            
C          
C *     --------------------------------------
C *     Spezielle Navigationen ermitteln
C *     --------------------------------------
C       EXSR LOGNAVS              
C          
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C       EXSR PFADSR              
C       EXSR PFADSR2              
C          
C *     --------------------------------------
C *     Verweise auf externe Seiten
C *     --------------------------------------
C       EXSR PFADELEMENT              
C       EXSR PFADEXTERN              
C          
C *     --------------------------------------
C *     Werbung aus Agent löschen
C *     --------------------------------------
C       EXSR AGENTSPAM$              
C       EXSR AGENTSPAM$123              
C          
C *     --------------------------------------
C *     Werbung/Session aus Referrer löschen
C *     --------------------------------------
C       EXSR REFERRER$              
C       EXSR REFERRERSPAM$              
C       EXSR REFERRERSPAM$2              
C          
C *     --------------------------------------
C *     Werte ermitteln und Benutzer anmelden
C *     --------------------------------------
C       EXSR DATEN              
C       EXSR SESSION              
C          
C *     --------------------------------------
C *     Debug-Modus setzen
C *     --------------------------------------
C     DEBUG0 IFEQ DEBUG              
C       CLEAR   DEBUG            
C       ENDIF                
C *     --------------------------------------
C *     Schmal-Modus setzen
C *     --------------------------------------
C     SCHMAL0 IFEQ SCHMAL              
C       CLEAR   SCHMAL            
C       ENDIF                
C *     --------------------------------------
C *     Sprache setzen
C *     --------------------------------------
C       EXSR SPRACHESR              
C          
C *     --------------------------------------
C *     Agent
C *     --------------------------------------
C       EXSR AGENTINF              
C          
C *     --------------------------------------
C *     Seite / Sicherheit
C *     --------------------------------------
C       EXSR SEITE              
C       EXSR SECURITY              
C          
C *     --------------------------------------
C *     Anlegen / Ändern / Senden
C *     --------------------------------------
C       EXSR NEUEDT              
C       EXSR SENDEN              
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C       EXSR ANFRAGE              
C          
C *     --------------------------------------
C *     Kennworte aus Variablen entfernen
C *     --------------------------------------
C       CLEAR   KENNWORT            
C       CLEAR   KENNWORT1            
C       CLEAR   KENNWORT2            
C       CLEAR   KENNWORT3            
C          
C *     --------------------------------------
C *     Speicherbereich freigeben
C *     --------------------------------------
C       DEALLOC   DATAPTR     — 77 —  
C          
C       SETON         — LR —  
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     REFERRER$ BEGSR                
C *     --------------------------------------
C *     Session aus Referrer löschen
C *     --------------------------------------
C     SIDNAME SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = SIDNAME + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = SIDNAME + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C *     --------------------------------------
C *     Benutzer aus Referrer löschen
C *     --------------------------------------
C     BENUTZERNAME SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = BENUTZERNAME + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = BENUTZERNAME + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C *     --------------------------------------
C *     Kennwort aus Referrer löschen
C *     --------------------------------------
C     KENNWORTNAME SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C *     --------------------------------------
C *     Kennwort aus Referrer löschen
C *     --------------------------------------
C     KENNWORTNAME1 SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME1 + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME1 + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C *     --------------------------------------
C *     Kennwort aus Referrer löschen
C *     --------------------------------------
C     KENNWORTNAME2 SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME2 + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME2 + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C *     --------------------------------------
C *     Kennwort aus Referrer löschen
C *     --------------------------------------
C     KENNWORTNAME3 SCAN REFERRER POS     — 77 78  
C     *IN78 IFEQ *ON              
C     '&' SCAN REFERRER:POS POS2     — 77 78  
C   N78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME3 + VAL$
C   78   EVAL %SUBST(REFERRER:POS) = KENNWORTNAME3 + VAL$ +
C       %SUBST(REFERRER:POS2)
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     REFERRERSPAM$ BEGSR                
C *     --------------------------------------
C *     Werbung in Referrer
C *     --------------------------------------
C     *BLANKS IFNE REFERRER              
C     '/franzi/' IFEQ SCRIPT              
C     '/pikachu/' OREQ SCRIPT              
C     '/siberia401/' OREQ SCRIPT              
C       MOVEL(P) *ALL'*' SPAM$            
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     REFERRERSPAM$2 BEGSR                
C *     --------------------------------------
C *     Werbung in Referrer
C *     --------------------------------------
C     '.speechbox.' SCAN REFERRER       — 77 78  
C   78   MOVEL(P) SPAM$BOX SPAM$            
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     LOGNAVS BEGSR                
C *     --------------------------------------
C *     Spezielle Navigationen ermitteln
C *     --------------------------------------
C       MOVEL(P) TYPIDX NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) NANAV INDEXNAV            
C          
C       MOVEL(P) TYPOBJS NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) NANAV OBJEKTNAV            
C          
C       MOVEL(P) TYPSMILYS NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) NANAV SMILYNAV            
C          
C       MOVEL(P) TYPFRD NATYP            
C       EXSR NATYPNAV              
C       CAT ' target="' :0 TARGETFRD            
C       CAT NANAV :0 TARGETFRD            
C       CAT '"' :0 TARGETFRD            
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     PFADSR BEGSR                
C     ' ' CHECKR PFAD LEN            
C       CLEAR   PFADX            
C       CLEAR   PFADXX            
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     *ZERO IFEQ LEN              
C     UPPER:LOWER XLATE(P) HTML PFADXX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     ' ' SCAN PFAD POS     — 77 32  
C   32 POS COMP LEN       — 32 32  
C     1 SUBST(P) PFAD:LEN CHAR            
C     CHAR DOWNE '.'              
C     CHAR ANDNE '/'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD:LEN CHAR            
C       ENDDO                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     CHAR IFEQ '.'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD:LEN CHAR            
C       ADD 1 LEN            
C     CHAR IFNE '/'              
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C       SUBST(P) PFAD:LEN PFADX            
C       SUBST(P) PFAD:LEN PFADS            
C     PFADS IFNE PFADX              
C       CLEAR   PFADX            
C       CLEAR   PFADXX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     LOWER:UPPER XLATE(P) PFADX PFADX            
C     UPPER:LOWER XLATE(P) PFADX PFADXX            
C     PFADXX IFEQ PFADX              
C       CLEAR   PFADX            
C       CLEAR   PFADXX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C       SUBST(P) PFAD:LEN PFADX            
C       SUB 1 LEN            
C     LEN IFGE 1              
C     LEN SUBST(P) PFAD PFAD            
C       ELSE                
C       CLEAR   PFAD            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     PFADSR2 BEGSR                
C     ' ' CHECKR PFAD2 LEN            
C       CLEAR   PFAD2X            
C       CLEAR   PFAD2XX            
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     *ZERO IFEQ LEN              
C     UPPER:LOWER XLATE(P) HTML PFAD2XX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     ' ' SCAN PFAD2 POS     — 77 32  
C   32 POS COMP LEN       — 32 32  
C     1 SUBST(P) PFAD2:LEN CHAR            
C     CHAR DOWNE '.'              
C     CHAR ANDNE '/'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD2:LEN CHAR            
C       ENDDO                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     CHAR IFEQ '.'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD2:LEN CHAR            
C       ADD 1 LEN            
C     CHAR IFNE '/'              
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C       SUBST(P) PFAD2:LEN PFAD2X            
C       SUBST(P) PFAD2:LEN PFADS            
C     PFADS IFNE PFAD2X              
C       CLEAR   PFADX            
C       CLEAR   PFADXX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C     LOWER:UPPER XLATE(P) PFAD2X PFAD2X            
C     UPPER:LOWER XLATE(P) PFAD2X PFAD2XX            
C     PFAD2XX IFEQ PFAD2X              
C       CLEAR   PFAD2X            
C       CLEAR   PFAD2XX            
C       ELSE                
C *     --------------------------------------
C *     Pfad und Endung ermitteln
C *     --------------------------------------
C       SUBST(P) PFAD2:LEN PFAD2X            
C       SUB 1 LEN            
C     LEN IFGE 1              
C     LEN SUBST(P) PFAD2 PFAD2            
C       ELSE                
C       CLEAR   PFAD2            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     PFADELEMENT BEGSR                
C     ' ' CHECKR PFAD LEN            
C       CLEAR   ELEMENT            
C *     --------------------------------------
C *     Letzte Navigation im Pfad ermitteln
C *     --------------------------------------
C     *ZERO IFEQ LEN              
C       CLEAR   ELEMENT            
C       ELSE                
C *     --------------------------------------
C *     Letzte Navigation im Pfad ermitteln
C *     --------------------------------------
C     1 SUBST(P) PFAD:LEN CHAR            
C     CHAR DOWNE '/'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD:LEN CHAR            
C       ENDDO                
C     CHAR IFEQ '/'              
C       ADD 1 LEN            
C       ENDIF                
C       SUBST(P) PFAD:LEN ELEMENT            
C       ENDIF                
C *     --------------------------------------
C *     Letzte Navigation im Pfad ermitteln
C *     --------------------------------------
C     *BLANKS IFEQ ELEMENT              
C       MOVEL(P) INDEXNAV ELEMENT            
C       ENDIF                
C *     --------------------------------------
C *     Länge des Pfads ohne letzte Navigation
C *     --------------------------------------
C     LEN SUB 2 PFADLEN3            
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     PFADEXTERN BEGSR                
C       MOVEL(P) ELEMENT ELEMENTNAV            
C *     --------------------------------------
C *     Verweise auf externe Seiten
C *     --------------------------------------
C       EXSR SEITENAVSR              
C     *IN77 IFEQ *OFF              
C     NATYP ANDEQ TYPEXTERN              
C          
C *     --------------------------------------
C *     Externe Adresse für Weiterleiten
C *     --------------------------------------
C       CALLP(E) GETENV ( ENVRCV:
C         ENVRCVLEN:ENVLEN:
C         REQUESTURI:
C         REQUESTURILEN:QUSEC)
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C       SUBST(P) ENVRCV CHAR            
C          
C     '/' IFNE CHAR              
C *     --------------------------------------
C *     Daten in EBCDIC umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( ASCII:0:
C         ENVRCV:ENVLEN:
C         EBCDIC:0:0:ENVLEN:
C         ENVRCV:RCVLEN:
C         DUMMY:FB)
C       ENDIF                
C *     --------------------------------------
C *     Formulardaten umsetzen
C *     --------------------------------------
C       CALLP(E) UTF8X ( ENVRCV:
C         ENVRCVLEN:ENVLEN:'<':'%')
C          
C *     --------------------------------------
C *     Externe Adresse für Weiterleiten
C *     --------------------------------------
C     ENVLEN IFGE 1              
C     ENVLEN ANDLE ENVRCVLEN              
C     ENVLEN SUBST(P) ENVRCV WWW            
C     '?' SCAN WWW POS     — 77 78  
C   78   ADD 1 POS            
C   78   SUBST(P) WWW:POS WWW            
C   N78   CLEAR   WWW            
C       SETON         — 31 —  
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     SPRACHESR BEGSR                
C       CLEAR   SPRACHEDS            
C       CLEAR   LINKDS            
C       CLEAR   TEXTDS            
C *     --------------------------------------
C *     Sprache setzen
C *     --------------------------------------
C     *BLANKS IFEQ SPRACHE              
C       MOVEL(P) MASPR SPRACHE            
C       ENDIF                
C *     --------------------------------------
C *     Sprache setzen
C *     --------------------------------------
C       MOVEL(P) SPRACHE SPSPR            
C          
C *     --------------------------------------
C *     Sprachtexte/Verweise/Texte einlesen
C *     --------------------------------------
C       OPEN SPRACHEP       — 77 —  
C     SPKEYSPR CHAIN SPRACHEP       77 77 —  
C   77 SPKEYMAN CHAIN SPRACHEP       77 77 —  
C          
C       OPEN LINKP       — 77 —  
C     LIKEYSPR CHAIN LINKP       77 77 —  
C   77 LIKEYMAN CHAIN LINKP       77 77 —  
C          
C       OPEN TEXTL1       — 77 —  
C     TEKEY1SPR CHAIN TEXTL1       77 77 —  
C   77 TEKEY1MAN CHAIN TEXTL1       77 77 —  
C          
C *     --------------------------------------
C *     Sprache übernehmen
C *     --------------------------------------
C       MOVEL(P) SPSPR LANGUAGE            
C          
C *     --------------------------------------
C *     Sprache übernehmen
C *     --------------------------------------
C     *BLANKS IFEQ SPNEUMIT2              
C       EVAL SPNEUMIT2  =  MAILKENNWORT
C       ENDIF                
C     *BLANKS IFEQ SPNEUPWD2              
C       EVAL SPNEUPWD2  =  MAILKENNWORT
C       ENDIF                
C     *BLANKS IFEQ SPCHGPWD2              
C       EVAL SPCHGPWD2  =  MAILKENNWORT
C       ENDIF                
C       ENDSR                
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     SPKEYSPR KLIST                
C       KFLD   MAMAN            
C       KFLD   SPSPR            
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     SPKEYMAN KLIST                
C       KFLD   MAMAN            
C       KFLD   MASPR            
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     LIKEYSPR KLIST                
C       KFLD   MAMAN            
C       KFLD   SPSPR            
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     LIKEYMAN KLIST                
C       KFLD   MAMAN            
C       KFLD   MASPR            
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     TEKEY1SPR KLIST                
C       KFLD   MAMAN            
C       KFLD   SPSPR            
C          
  X * SPRACHESR CHAIN BAR$MAIN    
  X  
C     TEKEY1MAN KLIST                
C       KFLD   MAMAN            
C       KFLD   MASPR            
C          
  X * ANFRAGE EXSR BAR$NEUED    
  X * SENDHTML EXSR BAR$SEND    
  X  
C     DAUERINF BEGSR                
C *     --------------------------------------
C *     Zeit für Seitenaufbau ermitteln
C *     --------------------------------------
C     *ZERO ADD *HIVAL NUM            
C     *ZERO ADD *HIVAL DAUER            
C       TIME   DATETIME2            
C     DATETIME2 SUBDUR DATETIME NUM:*MS     — 77 —  
C   N77   DIV(H) 1000 NUM            
C     DAUER IFGT NUM              
C     *ZERO ADD NUM DAUER            
C       ENDIF                
C       ENDSR                
C          
C     *PSSR BEGSR                
C     *BLANKS IFEQ PSSR              
C       MOVEL(P) 'X' PSSR            
C *     --------------------------------------
C *     Fehler melden
C *     --------------------------------------
C       MOVEL(P) SCRIPT MSG            
C     '*PSSR' DSPLY '*REQUESTER'              
C     MSG DSPLY '*REQUESTER'              
C     DATETIME DSPLY '*REQUESTER'              
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C       EXSR ANFRAGE              
C          
C *     --------------------------------------
C *     Kennworte aus Variablen entfernen
C *     --------------------------------------
C       CLEAR   KENNWORT            
C       CLEAR   KENNWORT1            
C       CLEAR   KENNWORT2            
C       CLEAR   KENNWORT3            
C          
C *     --------------------------------------
C *     Speicherbereich freigeben
C *     --------------------------------------
C       DEALLOC   DATAPTR     — 77 —  
C          
C       ENDIF                
C       ENDSR '*CANCL'              
C          
C /COPY SOURCE,BAR$AGENT
C /COPY SOURCE,BAR$ART
C /COPY SOURCE,BAR$BLASE
C /COPY SOURCE,BAR$DATEN
C /COPY SOURCE,BAR$EXIST
C /COPY SOURCE,BAR$FORM
C /COPY SOURCE,BAR$FRAME
C /COPY SOURCE,BAR$LABEL
C /COPY SOURCE,BAR$LISTE
C /COPY SOURCE,BAR$LINK
C /COPY SOURCE,BAR$NAV
C /COPY SOURCE,BAR$NEUED
C /COPY SOURCE,BAR$NUM
C /COPY SOURCE,BAR$PWD
C /COPY SOURCE,BAR$ROBOTS
C /COPY SOURCE,BAR$SCRIPT
C /COPY SOURCE,BAR$SEC
C /COPY SOURCE,BAR$SEITE
C /COPY SOURCE,BAR$SEND
C /COPY SOURCE,BAR$SID
C /COPY SOURCE,BAR$SRC
C /COPY SOURCE,BAR$STOUT
C /COPY SOURCE,BAR$TABLE
C /COPY SOURCE,BAR$TEXT
C /COPY SOURCE,BAR$ZEILE
C /COPY SOURCE,BAR$ZUSATZ

729 ms | Kontakt | Information | Aibo-Bar © 2005-2024