Anlegen / Ändern

BAR$NEUED (RPGLE)



  X * NEUEDT BEGSR BAR$NEUED 142  
  X * DBDATEN BEGSR BAR$NEUED 82  
  X * DBFRX BEGSR BAR$NEUED 15  
  X * DBFRT BEGSR BAR$NEUED 26  
  X * DBEDTMIT BEGSR BAR$NEUED 131  
  X * DBEDTRUB BEGSR BAR$NEUED 87  
  X * DBEDTSMILY BEGSR BAR$NEUED 76  
  X * DBEDTIDX BEGSR BAR$NEUED 88  
  X * DBEDTNAV BEGSR BAR$NEUED 62  
  X * DBEDTARTPN BEGSR BAR$NEUED 116  
  X * DBEDTAW BEGSR BAR$NEUED 64  
  X * DBNEUMIT BEGSR BAR$NEUED 168  
  X * DBNEURUB BEGSR BAR$NEUED 115  
  X * DBNEUSMILY BEGSR BAR$NEUED 82  
  X * DBNEUARTPN BEGSR BAR$NEUED 110  
  X * DBNEUAW BEGSR BAR$NEUED 108  
  X * DBNEUAWPN BEGSR BAR$NEUED 22  
  X * DBNEUAG BEGSR BAR$NEUED 61  
  X * DBNEUFILE BEGSR BAR$NEUED 53  
  X * DBNEUPWD BEGSR BAR$NEUED 65  
  X * DBCHGPWD BEGSR BAR$NEUED 63  
  X * DBCHGMAIL BEGSR BAR$NEUED 62  
  X * DBDLTARTPN BEGSR BAR$NEUED 12  
  X * DBDLTAW BEGSR BAR$NEUED 12  
  X * DBRCLARTPN BEGSR BAR$NEUED 12  
  X * DBRCLAW BEGSR BAR$NEUED 12  
  X * DBGELPN BEGSR BAR$NEUED 14  
  X * DBGELART BEGSR BAR$NEUED 14  
  X * DBRMVAW BEGSR BAR$NEUED 14  
  X * DBLOGIN BEGSR BAR$NEUED 8  
  X * DBLOGIN3 BEGSR BAR$NEUED 5  
  X * DBLOGOUT BEGSR BAR$NEUED 7  
  X * REDIRECTALL BEGSR BAR$NEUED 29  
  X * REDIRECTRUB2 BEGSR BAR$NEUED 7  
  X * REDIRECTRUB2S BEGSR BAR$NEUED 9  
  X * REDIRECTSMILY2 BEGSR BAR$NEUED 17  
  X * REDIRECTARTPN BEGSR BAR$NEUED 14  
  X * REDIRECTARTPNX BEGSR BAR$NEUED 19  
  X * REDIRECTARTPN2 BEGSR BAR$NEUED 24  
  X * REDIRECTAW BEGSR BAR$NEUED 15  
  X * REDIRECTAWX BEGSR BAR$NEUED 20  
  X * REDIRECTAW2 BEGSR BAR$NEUED 19  
  X * REDIRECTAG2 BEGSR BAR$NEUED 14  
  X * GELESEN BEGSR BAR$NEUED 34  
  X * GELESENPF BEGSR BAR$NEUED 11  
  X * GELESENAKT BEGSR BAR$NEUED 11  
  X * RESETMITPF BEGSR BAR$NEUED 15  
  X * RESETMITAKT BEGSR BAR$NEUED 15  
  X * IFS$WRITEFILE BEGSR BAR$NEUED 66  
  X * IFS$WRITERUB BEGSR BAR$NEUED 46  
  X * IFS$WRITENAV BEGSR BAR$NEUED 46  
  X * IFS$WRITESMILY BEGSR BAR$NEUED 52  
  X * IFS$WRITEARTPN BEGSR BAR$NEUED 57  
  X * ANFRAGE BEGSR BAR$NEUED 199  
  X * ANFRAGEOBJEKT BEGSR BAR$NEUED 42  
  X * ANFRAGEAG BEGSR BAR$NEUED 16  
  X * NEUPN BEGSR BAR$NEUED 10  
  X * SENDMAIL BEGSR BAR$NEUED 7  
  X * SENDMAILX BEGSR BAR$NEUED 7  
  X * SENDMAILV BEGSR BAR$NEUED 6  
  X * SENDMAIL2 BEGSR BAR$NEUED 48  
  X * WEITER BEGSR BAR$NEUED 82  
  X * WEITER2 BEGSR BAR$NEUED 62  
  X * WEITER3 BEGSR BAR$NEUED 18  
  X * OBJEKTNAME BEGSR BAR$NEUED 23  
  X  
  X * RUKEY KLIST BAR$NEUED 3  
  X * SMKEY KLIST BAR$NEUED 3  
  X * TEKEY KLIST BAR$NEUED 3  
  X * TEKEYMAN KLIST BAR$NEUED 3  
  X * NAKEYWW KLIST BAR$NEUED 3  
  X * MIKEY1MAX KLIST BAR$NEUED 2  
  X * RUKEY1MAX KLIST BAR$NEUED 2  
  X * ARKEY1MAX KLIST BAR$NEUED 3  
  X * AWKEY1MAX KLIST BAR$NEUED 4  
  X * MIKEY1ARMIT KLIST BAR$NEUED 3  
  X * MIKEY1ARPN KLIST BAR$NEUED 3  
  X * AGKEY1MAX KLIST BAR$NEUED 2  
  X * MIKEYN3 KLIST BAR$NEUED 3  
  X * GEKEY KLIST BAR$NEUED 5  
  X * IFS$WRITEPARM PLIST BAR$NEUED 8  
  X * MIKEY1ART3 KLIST BAR$NEUED 3  
  X * ANFRAGEPARM PLIST BAR$NEUED 3  
  X * QSNDPARM PLIST BAR$NEUED 5  
  X * AGKEY2 KLIST BAR$NEUED 3  
  X * SENDMAILPARM PLIST BAR$NEUED 8  
  X * SENDMAILXPARM PLIST BAR$NEUED 8  
  X * BEKEY KLIST BAR$NEUED 3  
  X * MIKEY KLIST BAR$NEUED 3  
  X * ARKEY KLIST BAR$NEUED 4  
  X * AWKEY KLIST BAR$NEUED 5  
  X  
  X * KENNWORTNEU EXSR BAR$PWD    
  X * KENNWORTNEU EXSR BAR$PWD    
  X * KENNWORTBEN EXSR BAR$PWD    
  X * KENNWORTMIT EXSR BAR$PWD    
  X * KENNWORTBEN EXSR BAR$PWD    
  X * SESSIONENDE EXSR BAR$SID    
  X * NATYPNAV EXSR BAR$NAV    
  X * NATYPNAV EXSR BAR$NAV    
  X * NUMSTR EXSR BAR$NUM    
  X * NATYPNAV EXSR BAR$NAV    
  X * NUMSTR EXSR BAR$NUM    
  X * NATYPNAV EXSR BAR$NAV    
  X * NUMSTR EXSR BAR$NUM    
  X * LINKADDNEU EXSR BAR$LINK    
  X * DAUERINF EXSR BAR$MAIN    
  X * NATYPNAV EXSR BAR$NAV    
  X * NATYPNAV EXSR BAR$NAV    
  X * MYTITELXQUERY EXSR BAR$TEXT    
  X * MYTITELXUTF8 EXSR BAR$TEXT    
  X * MYTITELXQUERY EXSR BAR$TEXT    
  X * MYTITELXUTF8 EXSR BAR$TEXT    
  X * ELEMENTMINSR EXSR BAR$SEITE    
  X  
C          
C *COPYRIGHT JÜRGEN REULE 2010-2023
C          
  X * *MAIN* EXSR BAR$MAIN    
  X  
C     NEUEDT BEGSR                
C     *IN31 IFEQ *OFF              
C       EXSR DBDATEN              
C *     --------------------------------------
C *     Anlegen / Ändern
C *     --------------------------------------
C     *ZERO ADD LOCABSLEN LOCLEN            
C     *ZERO ADD 1 LOCPOS            
C       CLEAR   LOCABS            
C       CLEAR   REDIRECT            
C       CLEAR   REDIRECT#            
C *     --------------------------------------
C *     Anlegen / Ändern
C *     --------------------------------------
C          
C       SELECT    
C     METHOD WHENEQ PUT              
C     METHOD OREQ DELETE              
C          
C     *OFF IFNE *OFF              
C *     --------------------------------------
C *     Anlegen / Ändern
C *     --------------------------------------
C     WWTYP CASEQ TYPPN DBEDTARTPN            
C     WWTYP CASEQ TYPART DBEDTARTPN            
C     WWTYP CASEQ TYPMIT DBEDTMIT            
C     WWTYP CASEQ TYPRUB DBEDTRUB            
C     WWTYP CASEQ TYPSMILY DBEDTSMILY            
C     WWTYP CASEQ TYPAW DBEDTAW            
C          
C     WWTYP CASEQ TYPPF DBEDTNAV            
C     WWTYP CASEQ TYPAKT DBEDTNAV            
C     WWTYP CASEQ TYPBAR DBEDTNAV            
C     WWTYP CASEQ TYPMMM DBEDTNAV            
C     WWTYP CASEQ TYPGAL DBEDTNAV            
C     WWTYP CASEQ TYPNAV DBEDTNAV            
C     WWTYP CASEQ TYPIDX DBEDTIDX            
C          
C     WWTYP CASEQ TYPEDTPN DBEDTARTPN            
C     WWTYP CASEQ TYPEDTPN2 DBEDTARTPN            
C     WWTYP CASEQ TYPEDTART DBEDTARTPN            
C     WWTYP CASEQ TYPEDTART2 DBEDTARTPN            
C     WWTYP CASEQ TYPEDTMIT DBEDTMIT            
C     WWTYP CASEQ TYPEDTRUB DBEDTRUB            
C     WWTYP CASEQ TYPEDTSMILY DBEDTSMILY            
C     WWTYP CASEQ TYPEDTAW DBEDTAW            
C          
C     WWTYP CASEQ TYPEDTNAV DBEDTNAV            
C     WWTYP CASEQ TYPEDTIDX DBEDTIDX            
C       ENDCS                
C       ENDIF                
C *     --------------------------------------
C *     Nicht weiterleiten
C *     --------------------------------------
C       CLEAR   REDIRECT            
C       CLEAR   REDIRECT#            
C          
C     METHOD WHENEQ GET              
C     METHOD OREQ POST              
C *     --------------------------------------
C *     Anlegen / Ändern
C *     --------------------------------------
C     *OFF IFNE *OFF              
C     WWTYP CASEQ TYPPN DBNEUAW            
C     WWTYP CASEQ TYPART DBNEUAW            
C     WWTYP CASEQ TYPBAR DBNEUAW            
C     WWTYP CASEQ TYPMMM DBNEUMIT            
C     WWTYP CASEQ TYPGAL DBNEURUB            
C     WWTYP CASEQ TYPMIT DBNEUARTPN            
C     WWTYP CASEQ TYPRUB DBNEUARTPN            
C     WWTYP CASEQ TYPICNS DBNEUFILE            
C     WWTYP CASEQ TYPOBJS DBNEUFILE            
C     WWTYP CASEQ TYPFILES DBNEUFILE            
C     WWTYP CASEQ TYPSAVES DBNEUFILE            
C     WWTYP CASEQ TYPBLASEN DBNEUFILE            
C     WWTYP CASEQ TYPKNOWNS DBNEUFILE            
C     WWTYP CASEQ TYPSMILYS DBNEUSMILY            
C       ENDCS                
C       ENDIF                
C          
C     WWTYP CASEQ TYPNEUPN DBNEUARTPN            
C     WWTYP CASEQ TYPNEUPN2 DBNEUARTPN            
C     WWTYP CASEQ TYPNEUART DBNEUARTPN            
C     WWTYP CASEQ TYPNEUART2 DBNEUARTPN            
C     WWTYP CASEQ TYPNEUMIT DBNEUMIT            
C     WWTYP CASEQ TYPNEURUB DBNEURUB            
C     WWTYP CASEQ TYPNEUSMILY DBNEUSMILY            
C     WWTYP CASEQ TYPNEUAW DBNEUAW            
C          
C     WWTYP CASEQ TYPEDTPN DBEDTARTPN            
C     WWTYP CASEQ TYPEDTPN2 DBEDTARTPN            
C     WWTYP CASEQ TYPEDTART DBEDTARTPN            
C     WWTYP CASEQ TYPEDTART2 DBEDTARTPN            
C     WWTYP CASEQ TYPEDTMIT DBEDTMIT            
C     WWTYP CASEQ TYPEDTRUB DBEDTRUB            
C     WWTYP CASEQ TYPEDTSMILY DBEDTSMILY            
C     WWTYP CASEQ TYPEDTAW DBEDTAW            
C          
C     WWTYP CASEQ TYPDLTPN DBDLTARTPN            
C     WWTYP CASEQ TYPDLTART DBDLTARTPN            
C     WWTYP CASEQ TYPDLTAW DBDLTAW            
C          
C     WWTYP CASEQ TYPRCLPN DBRCLARTPN            
C     WWTYP CASEQ TYPRCLART DBRCLARTPN            
C     WWTYP CASEQ TYPRCLAW DBRCLAW            
C          
C     WWTYP CASEQ TYPGELPN DBGELPN            
C     WWTYP CASEQ TYPGELART DBGELART            
C          
C     WWTYP CASEQ TYPNEUFILE DBNEUFILE            
C     WWTYP CASEQ TYPNEUFILE2 DBNEUFILE            
C          
C     WWTYP CASEQ TYPEDTNAV DBEDTNAV            
C     WWTYP CASEQ TYPEDTIDX DBEDTIDX            
C          
C     WWTYP CASEQ TYPLOGIN DBLOGIN            
C     WWTYP CASEQ TYPLOGIN2 DBLOGIN            
C     WWTYP CASEQ TYPLOGIN3 DBLOGIN3            
C     WWTYP CASEQ TYPLOGOUT DBLOGOUT            
C          
C     WWTYP CASEQ TYPNEUPWD DBNEUPWD            
C     WWTYP CASEQ TYPCHGPWD DBCHGPWD            
C     WWTYP CASEQ TYPCHGMAIL DBCHGMAIL            
C          
C     WWTYP CASEQ TYPFRA DBFRX            
C     WWTYP CASEQ TYPFRR DBFRX            
C     WWTYP CASEQ TYPFRD DBFRX            
C     WWTYP CASEQ TYPFRE DBFRX            
C     WWTYP CASEQ TYPFRI DBFRX            
C     WWTYP CASEQ TYPFRN DBFRX            
C     WWTYP CASEQ TYPFRW DBFRX            
C     WWTYP CASEQ TYPFRS DBFRX            
C     WWTYP CASEQ TYPFRP DBFRX            
C     WWTYP CASEQ TYPFRT DBFRX            
C       ENDCS                
C       ENDSL                
C       ENDIF                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       EXSR WEITER              
C       ENDSR                
C          
  X * NEUEDT EXSR BAR$NEUED    
  X  
C     DBDATEN BEGSR                
C *     --------------------------------------
C *     Nur für Mitglieder
C *     --------------------------------------
C     '0':' ' XLATE NFM NFM            
C     NONFM IFNE NFM              
C       MOVEL(P) 'X' NFM            
C       ENDIF                
C *     --------------------------------------
C *     Chat
C *     --------------------------------------
C     '0':' ' XLATE CHAT CHAT            
C     NOCHAT IFNE CHAT              
C       MOVEL(P) 'X' CHAT            
C       ENDIF                
C *     --------------------------------------
C *     Serie
C *     --------------------------------------
C     '0':' ' XLATE SERIE SERIE            
C     NOSERIE IFNE SERIE              
C       MOVEL(P) 'X' SERIE            
C       ENDIF                
C *     --------------------------------------
C *     Ton
C *     --------------------------------------
C     '0':' ' XLATE SOUND SOUND            
C     *BLANKS IFNE SOUND              
C       MOVEL(P) 'X' SOUND            
C       ENDIF                
C *     --------------------------------------
C *     Smilys
C *     --------------------------------------
C     '0':' ' XLATE SMILYS SMILYS            
C     *BLANKS IFNE SMILYS              
C       MOVEL(P) 'X' SMILYS            
C       ENDIF                
C *     --------------------------------------
C *     Sterne
C *     --------------------------------------
C     '0':' ' XLATE STERNE STERNE            
C     *BLANKS IFNE STERNE              
C       MOVEL(P) 'X' STERNE            
C       ENDIF                
C *     --------------------------------------
C *     Funkeln
C *     --------------------------------------
C     '0':' ' XLATE SPARKLE SPARKLE            
C     *BLANKS IFNE SPARKLE              
C       MOVEL(P) 'X' SPARKLE            
C       ENDIF                
C *     --------------------------------------
C *     Zeigen
C *     --------------------------------------
C     '0':' ' XLATE ZEIGEN ZEIGEN            
C     *BLANKS IFNE ZEIGEN              
C       MOVEL(P) 'X' ZEIGEN            
C       ENDIF                
C *     --------------------------------------
C *     Anlage entfernen
C *     --------------------------------------
C     '0':' ' XLATE REMOVE REMOVE            
C     *BLANKS IFNE REMOVE              
C       MOVEL(P) 'X' REMOVE            
C       ENDIF                
C *     --------------------------------------
C *     Anlage entfernen
C *     --------------------------------------
C     *BLANKS IFNE REMOVE              
C       MOVEL(P) '-' FILEX            
C       CLEAR   FILEPTR            
C       CLEAR   FILELEN            
C       ENDIF                
C *     --------------------------------------
C *     Anlage entfernen
C *     --------------------------------------
C     METHOD IFEQ DELETE              
C     *BLANKS ANDEQ FILEX              
C       MOVEL(P) '-' FILEX            
C       CLEAR   FILEPTR            
C       CLEAR   FILELEN            
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBFRX BEGSR                
C *     --------------------------------------
C *     Chat
C *     --------------------------------------
C       EXSR DBFRT              
C       EXSR DBNEUAW              
C          
C     *BLANKS IFNE REDIRECT              
C *     --------------------------------------
C *     Auf aktuelle Seite weiterleiten
C *     --------------------------------------
C       MOVEL(P) ELEMENT REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDIF                
C       ENDSR                
C          
  X * DBFRX EXSR BAR$NEUED    
  X  
C     DBFRT BEGSR                
C *     --------------------------------------
C *     Ton ein/aus
C *     --------------------------------------
C     *BLANKS IFNE SUBMIT1              
C     *BLANKS ORNE SUBMIT2              
C          
C *     --------------------------------------
C *     Ton ein/aus
C *     --------------------------------------
C     *BLANKS IFNE SUBMIT1              
C       MOVEL(P) 'X' SOUND            
C       ELSE                
C       CLEAR   SOUND            
C       ENDIF                
C *     --------------------------------------
C *     Benutzer aktualisieren
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C       MOVEL(P) SOUND BESOUND            
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTMIT BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Mitglied ändern
C *     --------------------------------------
C     *BLANKS WHENNE MW              
C     *BLANKS ORNE WEB              
C     *BLANKS ORNE BERUF              
C     *BLANKS ORNE HOBBY              
C     *BLANKS ORNE HERKUNFT              
C     *BLANKS ORNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE SOUND              
C     *BLANKS ORNE SMILY1              
C     *BLANKS ORNE SMILYS              
C     *BLANKS ORNE STERNE              
C     *BLANKS ORNE SPARKLE              
C     *BLANKS ORNE COLOR              
C     *BLANKS ORNE GEB              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Mitglied ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVE MITGLIEDDS MITGLIEDSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     LOWER:UPPER XLATE(P) MW MIMW            
C       MOVEL(P) WEB MIWEB            
C       MOVEL(P) BERUF MIBERUF            
C       MOVEL(P) HOBBY MIHOBBY            
C       MOVEL(P) HERKUNFT MIHERKUNFT            
C       MOVEL(P) TITEL MITITEL            
C       MOVEL(P) TITEL2 MITITEL2            
C       MOVEL(P) SOUND MISOUND            
C       MOVEL(P) SMILY1 MISMILY1            
C       MOVEL(P) SMILYS MISMILYS            
C       MOVEL(P) STERNE MISTERNE            
C       MOVEL(P) SPARKLE MISPARKLE            
C          
C *     --------------------------------------
C *     Farbe im Chat
C *     --------------------------------------
C     UPPER:LOWER XLATE COLOR MICOLOR            
C     1 SUBST MICOLOR CHAR            
C     '#' IFNE CHAR              
C     '#' CAT MICOLOR MICOLOR            
C       ENDIF                
C     HEXCHARS CHECK MICOLOR:2       77  
C   77   CLEAR   MICOLOR            
C          
C *     --------------------------------------
C *     Geburtstag
C *     --------------------------------------
C       CLEAR   MIGEB            
C     *EUR TEST(D)   GEB     77  
C     *IN77 IFEQ *OFF              
C     *EUR MOVE GEB MIGEB            
C       ELSE                
C       MOVEL(P) GEB GEB8            
C     GEB8 IFEQ GEB              
C     *DMY. TEST(D)   GEB8     77  
C     *IN77 IFEQ *OFF              
C     *DMY. MOVE GEB8 MIGEB            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       UPDATE MITGLIEDF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Auf Mitglied weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVE MITGLIEDSAVE MITGLIEDDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Mitglied weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C     LOWER:UPPER XLATE(P) MIMW MW            
C       MOVEL(P) MIWEB WEB            
C       MOVEL(P) MIBERUF BERUF            
C       MOVEL(P) MIHOBBY HOBBY            
C       MOVEL(P) MIHERKUNFT HERKUNFT            
C       MOVEL(P) MITITEL TITEL            
C       MOVEL(P) MITITEL2 TITEL2            
C       MOVEL(P) MISOUND SOUND            
C       MOVEL(P) MISMILY1 SMILY1            
C       MOVEL(P) MISMILYS SMILYS            
C       MOVEL(P) MISTERNE STERNE            
C       MOVEL(P) MISPARKLE SPARKLE            
C          
C *     --------------------------------------
C *     Farbe im Chat
C *     --------------------------------------
C     UPPER:LOWER XLATE MICOLOR COLOR            
C          
C *     --------------------------------------
C *     Geburtstag
C *     --------------------------------------
C     *LOVAL COMP MIGEB       77 77  
C   77 *EUR MOVE MIGEB GEB            
C   N77   CLEAR   GEB            
C       ENDSL                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTRUB BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Rubrik ändern
C *     --------------------------------------
C     *BLANKS WHENNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE FILEX              
C     *BLANKS ORNE SERIE              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Rubrik ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Rubrik aktualisieren
C *     --------------------------------------
C       OPEN RUBRIKP       77  
C     RUKEY CHAIN RUBRIKF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVEL(P) RUNAV MYNAV            
C       MOVEL(P) RUFILEX MYFILEX            
C       MOVE RUBRIKDS RUBRIKSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE SERIE              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C       MOVEL(P) TITEL RUTITEL            
C       MOVEL(P) TITEL2 RUTITEL2            
C     METHOD IFNE DELETE              
C     *BLANKS ORNE SERIE              
C       MOVEL(P) SERIE RUSERIE            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE FILEX              
C       MOVEL(P) FILEX RUFILEX            
C       ENDIF                
C *     --------------------------------------
C *     Rubrik aktualisieren
C *     --------------------------------------
C       UPDATE RUBRIKF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITERUB              
C          
C *     --------------------------------------
C *     Auf Rubrik weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVE RUBRIKSAVE RUBRIKDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Rubrik weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C       MOVEL(P) RUTITEL TITEL            
C       MOVEL(P) RUTITEL2 TITEL2            
C       MOVEL(P) RUSERIE SERIE            
C       ENDSL                
C       ENDSR                
C          
  X * DBEDTRUB CHAIN BAR$NEUED    
  X  
C     RUKEY KLIST                
C       KFLD   MAMAN            
C       KFLD   RURUB            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTSMILY BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Smily ändern
C *     --------------------------------------
C     *BLANKS WHENNE REMOVE              
C     *BLANKS ORNE FILEX              
C     *BLANKS ORNE TITEL              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Smily ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Smily aktualisieren
C *     --------------------------------------
C       OPEN SMILYP       77  
C     SMKEY CHAIN SMILYF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVEL(P) SMNAV MYNAV            
C       MOVEL(P) SMFILEX MYFILEX            
C       MOVE SMILYDS SMILYSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE REMOVE              
C     *BLANKS ORNE TITEL              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C       MOVEL(P) TITEL SMTITEL            
C       ENDIF                
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE FILEX              
C       MOVEL(P) FILEX SMFILEX            
C       ENDIF                
C *     --------------------------------------
C *     Smily aktualisieren
C *     --------------------------------------
C       UPDATE SMILYF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITESMILY              
C          
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVE SMILYSAVE SMILYDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C       MOVEL(P) SMTITEL TITEL            
C       ENDSL                
C       ENDSR                
C          
  X * DBEDTSMILY CHAIN BAR$NEUED    
  X  
C     SMKEY KLIST                
C       KFLD   MAMAN            
C       KFLD   SMTITEL            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTIDX BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Portal ändern
C *     --------------------------------------
C     *BLANKS WHENNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE HINWEIS              
C     *BLANKS ORNE KALENDER              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE FILEX              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Portal ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Portal aktualisieren
C *     --------------------------------------
C       OPEN TEXTP       77  
C     TEKEY CHAIN TEXTF       77 77  
C   77 TEKEYMAN CHAIN TEXTF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVE TEXTDS TEXTSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE HINWEIS              
C     *BLANKS ORNE KALENDER              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C       MOVEL(P) TITEL TETITEL            
C       MOVEL(P) TITEL2 TETITEL2            
C       MOVEL(P) HINWEIS TEHINWEIS            
C     METHOD IFNE DELETE              
C     *BLANKS ORNE KALENDER              
C       EVAL   TEKALENDER = %TRIM(KALENDER)
C       ENDIF                
C       EVAL   TETEXT     = %TRIM(TEXT)
C       ENDIF                
C *     --------------------------------------
C *     Portal aktualisieren
C *     --------------------------------------
C       UPDATE TEXTF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Navigation aktualisieren
C *     --------------------------------------
C       EXSR DBEDTNAV              
C          
C *     --------------------------------------
C *     Auf Portal weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVE TEXTSAVE TEXTDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Portal weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C       MOVEL(P) TETITEL TITEL            
C       MOVEL(P) TETITEL2 TITEL2            
C       MOVEL(P) TEHINWEIS HINWEIS            
C       EVAL   KALENDER = %TRIM(TEKALENDER)
C       EVAL   TEXT     = %TRIM(TETEXT)
C       ENDSL                
C       ENDSR                
C          
  X * DBEDTIDX CHAIN BAR$NEUED    
  X  
C     TEKEY KLIST                
C       KFLD   MAMAN            
C       KFLD   SPRACHE            
C          
  X * DBEDTIDX CHAIN BAR$NEUED    
  X  
C     TEKEYMAN KLIST                
C       KFLD   MAMAN            
C       KFLD   MASPR            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * DBEDTIDX EXSR BAR$NEUED    
  X  
C     DBEDTNAV BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Navigation ändern
C *     --------------------------------------
C     *BLANKS WHENNE REMOVE              
C     *BLANKS ORNE FILEX              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Navigation ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C       MOVEL(P) NAVIDS NAVISAVE2            
C *     --------------------------------------
C *     Navigation aktualisieren
C *     --------------------------------------
C       OPEN NAVIP       77  
C     NAKEYWW CHAIN NAVIF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVEL(P) NANAV MYNAV            
C       MOVEL(P) NAFILEX MYFILEX            
C       MOVEL(P) NAVIDS NAVISAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE FILEX              
C       MOVEL(P) FILEX NAFILEX            
C       ENDIF                
C *     --------------------------------------
C *     Navigation aktualisieren
C *     --------------------------------------
C       UPDATE NAVIF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITENAV              
C          
C *     --------------------------------------
C *     Auf Navigation weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVEL(P) NAVISAVE NAVIDS            
C       ENDIF                
C       ENDIF                
C       MOVEL(P) NAVISAVE2 NAVIDS            
C       ENDIF                
C *     --------------------------------------
C *     Auf Navigation weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C       ENDSL                
C       ENDSR                
C          
  X * DBEDTNAV CHAIN BAR$NEUED    
  X  
C     NAKEYWW KLIST                
C       KFLD   MAMAN            
C       KFLD   WWTYPEDT            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTARTPN BEGSR                
C     *BLANKS IFEQ ARFILEX              
C       MOVEL(P) ARFILEX FILEX            
C       ENDIF                
C *     --------------------------------------
C *     Artikel/Nachricht ändern
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Artikel/Nachricht ändern
C *     --------------------------------------
C     *BLANKS WHENNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE KAMERA              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE FILEX              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     NONFM ORNE NFM              
C     NOCHAT ORNE CHAT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Artikel/Nachricht ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Artikel/Nachricht aktualisieren
C *     --------------------------------------
C       OPEN ARTIKELP       77  
C     ARKEY CHAIN ARTIKELF       77 77  
C     *IN77 IFEQ *OFF              
C          
C     *ZERO ADD ARART MYART            
C       MOVEL(P) ARFILEX MYFILEX            
C       MOVE ARTIKELDS ARTIKELSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE TITEL              
C     *BLANKS ORNE TITEL2              
C     *BLANKS ORNE KAMERA              
C     *BLANKS ORNE REMOVE              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     NONFM ORNE NFM              
C     NOCHAT ORNE CHAT              
C     METHOD OREQ DELETE              
C     XLATE1:XLATE2 XLATE(P) TITEL ARTITEL            
C     XLATE1:XLATE2 XLATE(P) TITEL2 ARTITEL2            
C     METHOD IFNE DELETE              
C     NONFM ORNE NFM              
C       MOVEL(P) NFM ARNFM            
C       ENDIF                
C     METHOD IFNE DELETE              
C     NOCHAT ORNE CHAT              
C       MOVEL(P) CHAT ARCHAT            
C       ENDIF                
C       MOVEL(P) PTZ ARPTZ            
C       MOVEL(P) FLIP ARFLIP            
C       MOVE DATETIME ARDATCHG            
C       EVAL   ARTEXT   = %TRIM(TEXT)
C     XLATE1:XLATE2 XLATE(P) ARTEXT ARTEXT            
C       EVAL   ARKAMERA = %TRIM(KAMERA)
C     XLATE1:XLATE2 XLATE(P) ARKAMERA ARKAMERA            
C       ENDIF                
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE FILEX              
C       MOVEL(P) FILEX ARFILEX            
C       ENDIF                
C *     --------------------------------------
C *     Artikel/Nachricht aktualisieren
C *     --------------------------------------
C       UPDATE ARTIKELF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITEARTPN              
C          
C *     --------------------------------------
C *     Auf Artikel/Nachricht weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTARTPN              
C       ELSE                
C       MOVE ARTIKELSAVE ARTIKELDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Artikel/Nachricht weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTARTPN              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C     XLATE2:XLATE1 XLATE(P) ARTITEL TITEL            
C     XLATE2:XLATE1 XLATE(P) ARTITEL2 TITEL2            
C       MOVEL(P) ARNFM NFM            
C       MOVEL(P) ARCHAT CHAT            
C       MOVEL(P) ARPTZ PTZ            
C       MOVEL(P) ARFLIP FLIP            
C     XLATE2:XLATE1 XLATE(P) ARTEXT TEXT            
C     XLATE2:XLATE1 XLATE(P) ARKAMERA KAMERA            
C       ENDSL                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBEDTAW BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Antwort ändern
C *     --------------------------------------
C     *BLANKS WHENNE REMOVE              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Antwort ändern
C *     --------------------------------------
C     METHOD IFEQ PUT              
C     METHOD OREQ POST              
C     METHOD OREQ DELETE              
C          
C *     --------------------------------------
C *     Antwort aktualisieren
C *     --------------------------------------
C       OPEN ANTWORTP       77  
C     AWKEY CHAIN ANTWORTF       77 77  
C     *IN77 IFEQ *OFF              
C          
C       MOVE ANTWORTDS ANTWORTSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *BLANKS IFNE REMOVE              
C     *BLANKS ORNE TEXT              
C     *BLANKS ORNE SUBMIT              
C     METHOD OREQ DELETE              
C       MOVE DATETIME AWDATCHG            
C       EVAL   AWTEXT = %TRIM(TEXT)
C     XLATE1:XLATE2 XLATE(P) AWTEXT AWTEXT            
C       ENDIF                
C *     --------------------------------------
C *     Antwort aktualisieren
C *     --------------------------------------
C       UPDATE ANTWORTF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTAW              
C       ELSE                
C       MOVE ANTWORTSAVE ANTWORTDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTAW              
C          
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       OTHER                
C     XLATE2:XLATE1 XLATE(P) AWTEXT TEXT            
C       ENDSL                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEUMIT BEGSR                
C       CLEAR   MITGLIEDDS            
C *     --------------------------------------
C *     Neues Mitglied anlegen
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Neues Mitglied anlegen
C *     --------------------------------------
C     *BLANKS WHENNE MITGLIED              
C          
C *     --------------------------------------
C *     Neues Mitglied anlegen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Mitgliedsname prüfen
C *     --------------------------------------
C       MOVEL(P) MITGLIED OBJEKT            
C       EXSR OBJEKTNAME              
C       MOVEL(P) OBJEKTX MITGLIEDX            
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Webmaster?
C *     --------------------------------------
C     WEBMASTER$ IFNE MITGLIEDX              
C     MAMAIL ANDNE MAIL              
C          
C *     --------------------------------------
C *     Webmaster?
C *     --------------------------------------
C     WEBMASTER$ OREQ MITGLIEDX              
C     MAMAIL ANDEQ MAIL              
C          
C *     --------------------------------------
C *     Benutzername prüfen
C *     --------------------------------------
C     2 SUBST(P) MITGLIEDX CHAR2            
C     '.' IFNE CHAR2              
C     '..' ANDNE CHAR2              
C     '20' ANDNE CHAR2              
C          
C *     --------------------------------------
C *     E-Mail-Adresse prüfen
C *     --------------------------------------
C     '@' SCAN MAIL POS     77 78  
C     *IN78 IFEQ *ON              
C          
C *     --------------------------------------
C *     Mandant lesen
C *     --------------------------------------
C       OPEN MANDANTP       77  
C     MAMAN CHAIN MANDANTP       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Nummer des letzten Mitglieds ermitteln
C *     --------------------------------------
C       OPEN MITGLIEDL1       77  
C     MIKEY1MAX SETGT MITGLIEDL1       77  
C   N77 MIKEY1MAX READPE MITGLIEDL1       77 77  
C   77   CLEAR   MITGLIEDDS            
C *     --------------------------------------
C *     Nummer des neuen Mitglieds ermitteln
C *     --------------------------------------
C     *HIVAL SUB 1 NEMIT            
C     MIMIT IFLE NEMIT              
C     MIMIT ADD 1 NEMIT            
C       CLEAR   MITGLIEDDS            
C *     --------------------------------------
C *     Neues Mitglied anlegen
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C          
C       MOVE MITGLIEDDS MITGLIEDSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD MAMAN MIMAN            
C     *ZERO ADD NEMIT MIMIT            
C       MOVEL(P) MITGLIEDX MINAV            
C       MOVEL(P) TITEL MITITEL            
C       MOVEL(P) TITEL2 MITITEL2            
C       MOVEL(P) MAIL MIMAIL            
C       MOVEL(P) 'X' MISMILYS            
C       MOVEL(P) 'X' MISTERNE            
C       MOVEL(P) 'X' MISPARKLE            
C       MOVE DATETIME MIDAT            
C       MOVE DATETIME MIDATPWD            
C       MOVE DATETIME MIDATPF            
C       MOVE DATETIME MIDATAKT            
C       MOVE DATETIME MIGELPN            
C       MOVE DATETIME MIGELART            
C       CLEAR   MINEUPF            
C       CLEAR   MINEUAKT            
C       CLEAR   MIONLINE            
C          
C *     --------------------------------------
C *     Angezeigter Name nicht angegeben?
C *     --------------------------------------
C     *BLANKS IFEQ MITITEL              
C       MOVEL(P) MITGLIED MITITEL            
C       ENDIF                
C *     --------------------------------------
C *     Neues Kennwort für Mitglied erzeugen
C *     --------------------------------------
C       EXSR KENNWORTNEU              
C          
C *     --------------------------------------
C *     Kennwort übernehmen
C *     --------------------------------------
C       MOVEL(P) PWD3 MIPWD            
C       MOVEL(P) PWD3 MIPWD2            
C          
C *     --------------------------------------
C *     Neues Mitglied anlegen
C *     --------------------------------------
C       WRITE MITGLIEDF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     E-Mail mit Kennwort senden
C *     --------------------------------------
C       MOVEL(P) SPNEUMIT SUBJECT            
C       MOVEL(P) SPNEUMIT2 LONGMSG            
C       EXSR SENDMAIL              
C       CLEAR   KENNWORT3            
C *     --------------------------------------
C *     E-Mail mit Mitgliedsname senden
C *     --------------------------------------
C       MOVEL(P) SPNEUMITX SUBJECT            
C       MOVEL(P) SPNEUMITX2 LONGMSG            
C       EXSR SENDMAILX              
C       EXSR REDIRECTALL              
C       ELSE                
C       MOVE MITGLIEDSAVE MITGLIEDDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     E-Mail mit Mitmachversuch senden
C *     --------------------------------------
C     METHOD IFEQ POST              
C     *BLANKS IFEQ REDIRECT              
C       MOVEL(P) MITGLIED MINAV            
C       MOVEL(P) TITEL MITITEL            
C       MOVEL(P) TITEL2 MITITEL2            
C       MOVEL(P) MAIL MIMAIL            
C       MOVEL(P) SPNEUMITV SUBJECT            
C       MOVEL(P) SPNEUMITV2 LONGMSG            
C       EXSR SENDMAILV              
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf vorherige Seite weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C       ENDSL                
C       ENDSR                
C          
  X * DBNEUMIT SETGT BAR$NEUED    
  X * DBNEUMIT READPE BAR$NEUED    
  X  
C     MIKEY1MAX KLIST                
C       KFLD   MAMAN            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEURUB BEGSR                
C       CLEAR   RUBRIKDS            
C *     --------------------------------------
C *     Neue Rubrik anlegen
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Neue Rubrik anlegen
C *     --------------------------------------
C     *BLANKS WHENNE RUBRIK              
C          
C *     --------------------------------------
C *     Neue Rubrik anlegen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Rubrikname prüfen
C *     --------------------------------------
C       MOVEL(P) RUBRIK OBJEKT            
C       EXSR OBJEKTNAME              
C       MOVEL(P) OBJEKTX RUBRIKX            
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Rubrikname darf nicht Webmaster sein
C *     --------------------------------------
C     WEBMASTER$ IFNE RUBRIKX              
C          
C *     --------------------------------------
C *     Rubrikname prüfen
C *     --------------------------------------
C     2 SUBST(P) RUBRIKX CHAR2            
C     '.' IFNE CHAR2              
C     '..' ANDNE CHAR2              
C          
C *     --------------------------------------
C *     Mandant lesen
C *     --------------------------------------
C       OPEN MANDANTP       77  
C     MAMAN CHAIN MANDANTP       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Nummer der letzten Rubrik ermitteln
C *     --------------------------------------
C       OPEN RUBRIKL1       77  
C     RUKEY1MAX SETGT RUBRIKL1       77  
C   N77 RUKEY1MAX READPE RUBRIKL1       77 77  
C   77   CLEAR   RUBRIKDS            
C *     --------------------------------------
C *     Nummer der neuen Rubrik ermitteln
C *     --------------------------------------
C     *HIVAL SUB 1 NERUB            
C     RURUB IFLE NERUB              
C     RURUB ADD 1 NERUB            
C       CLEAR   RUBRIKDS            
C *     --------------------------------------
C *     Neue Rubrik anlegen
C *     --------------------------------------
C       OPEN RUBRIKP       77  
C          
C       MOVEL(P) RUNAV MYNAV            
C       MOVEL(P) RUFILEX MYFILEX            
C       MOVE RUBRIKDS RUBRIKSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD MAMAN RUMAN            
C     *ZERO ADD NERUB RURUB            
C       MOVEL(P) RUBRIKX RUNAV            
C       MOVEL(P) TITEL RUTITEL            
C       MOVEL(P) TITEL2 RUTITEL2            
C       MOVEL(P) FILEX RUFILEX            
C       MOVEL(P) SERIE RUSERIE            
C       MOVE DATETIME RUDAT            
C          
C *     --------------------------------------
C *     Falls Titel nicht angegeben
C *     --------------------------------------
C     *BLANKS IFEQ RUTITEL              
C       MOVEL(P) RUBRIK RUTITEL            
C       ENDIF                
C *     --------------------------------------
C *     Neue Rubrik anlegen
C *     --------------------------------------
C       WRITE RUBRIKF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITERUB              
C          
C *     --------------------------------------
C *     Auf Rubrik weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTRUB2              
C       ELSE                
C       MOVE RUBRIKSAVE RUBRIKDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Galerie weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTRUB2S              
C       ENDSL                
C       ENDSR                
C          
  X * DBNEURUB SETGT BAR$NEUED    
  X * DBNEURUB READPE BAR$NEUED    
  X  
C     RUKEY1MAX KLIST                
C       KFLD   MAMAN            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEUSMILY BEGSR                
C       CLEAR   SMILYDS            
C *     --------------------------------------
C *     Neues Smily anlegen
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Neues Smily anlegen
C *     --------------------------------------
C     *BLANKS WHENNE SMILY              
C          
C *     --------------------------------------
C *     Neues Smily anlegen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Smilyname prüfen
C *     --------------------------------------
C       MOVEL(P) SMILY OBJEKT            
C       EXSR OBJEKTNAME              
C       MOVEL(P) OBJEKTX SMILYX            
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Smilyname prüfen
C *     --------------------------------------
C     2 SUBST(P) SMILYX CHAR2            
C     '.' IFNE CHAR2              
C     '..' ANDNE CHAR2              
C          
C *     --------------------------------------
C *     Neues Smily anlegen
C *     --------------------------------------
C       OPEN SMILYP       77  
C          
C       MOVEL(P) SMNAV MYNAV            
C       MOVEL(P) SMFILEX MYFILEX            
C       MOVE SMILYDS SMILYSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD MAMAN SMMAN            
C       MOVEL(P) SMILYX SMNAV            
C       MOVEL(P) TITEL SMTITEL            
C       MOVEL(P) FILEX SMFILEX            
C          
C *     --------------------------------------
C *     Falls Titel nicht angegeben
C *     --------------------------------------
C     *BLANKS IFEQ SMTITEL              
C       MOVEL(P) SMILYX SMTITEL            
C       ENDIF                
C *     --------------------------------------
C *     Neues Smily anlegen
C *     --------------------------------------
C       WRITE SMILYF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITESMILY              
C          
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTSMILY2              
C       ELSE                
C       MOVE SMILYSAVE SMILYDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTSMILY2              
C       ENDSL                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEUARTPN BEGSR                
C       CLEAR   ARTIKELDS            
C *     --------------------------------------
C *     Neuen Artikel anlegen
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Neuen Artikel anlegen
C *     --------------------------------------
C     *BLANKS WHENNE TEXT              
C     *BLANKS ORNE FILEX              
C          
C *     --------------------------------------
C *     Neuen Artikel anlegen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Benutzer lesen
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Nummer des letzten Artikels ermitteln
C *     --------------------------------------
C       OPEN ARTIKELL1       77  
C     ARKEY1MAX SETGT ARTIKELL1       77  
C   N77 ARKEY1MAX READPE ARTIKELL1       77 77  
C   77   CLEAR   ARTIKELDS            
C *     --------------------------------------
C *     Nummer des neuen Artikels ermitteln
C *     --------------------------------------
C     *HIVAL SUB 1 NEART            
C     ARART IFLE NEART              
C     ARART ADD 1 NEART            
C       CLEAR   ARTIKELDS            
C *     --------------------------------------
C *     Artikel/Nachricht anlegen
C *     --------------------------------------
C       OPEN ARTIKELP       77  
C          
C     *ZERO ADD ARART MYART            
C       MOVEL(P) ARFILEX MYFILEX            
C       MOVE ARTIKELDS ARTIKELSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD MAMAN ARMAN            
C     *ZERO ADD BEMIT ARMIT            
C     *ZERO ADD NEART ARART            
C     XLATE1:XLATE2 XLATE(P) TITEL ARTITEL            
C     XLATE1:XLATE2 XLATE(P) TITEL2 ARTITEL2            
C       MOVEL(P) FILEX ARFILEX            
C       MOVEL(P) NFM ARNFM            
C       MOVEL(P) CHAT ARCHAT            
C       MOVEL(P) PTZ ARPTZ            
C       MOVEL(P) FLIP ARFLIP            
C       MOVE DATETIME ARDATCHG            
C       MOVE DATETIME ARDATAW            
C       MOVE DATETIME ARDAT            
C     *ZERO ADD WWMIT ARPN            
C     *ZERO ADD WWRUB ARRUB            
C       EVAL   ARTEXT   = %TRIM(TEXT)
C     XLATE1:XLATE2 XLATE(P) ARTEXT ARTEXT            
C       EVAL   ARKAMERA = %TRIM(KAMERA)
C     XLATE1:XLATE2 XLATE(P) ARKAMERA ARKAMERA            
C          
C *     --------------------------------------
C *     Artikel/Nachricht anlegen
C *     --------------------------------------
C       WRITE ARTIKELF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITEARTPN              
C          
C *     --------------------------------------
C *     Auf Artikel/Nachricht weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTARTPN2              
C          
C *     --------------------------------------
C *     Neue Antwort bei Nachricht
C *     --------------------------------------
C       EXSR DBNEUAWPN              
C       ELSE                
C       MOVE ARTIKELSAVE ARTIKELDS            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Benutzer aktualisieren
C *     --------------------------------------
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf letzten Artikel weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       OPEN ARTIKELL1       77  
C     ARKEY1MAX SETGT ARTIKELL1       77  
C   N77 ARKEY1MAX READPE ARTIKELL1       77 77  
C   N77   EXSR REDIRECTARTPN2              
C       ENDSL                
C       ENDSR                
C          
  X * DBNEUARTPN SETGT BAR$NEUED    
  X * DBNEUARTPN READPE BAR$NEUED    
  X * DBNEUARTPN SETGT BAR$NEUED    
  X * DBNEUARTPN READPE BAR$NEUED    
  X  
C     ARKEY1MAX KLIST                
C       KFLD   MAMAN            
C       KFLD   BEMIT            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * DBFRX EXSR BAR$NEUED    
  X  
C     DBNEUAW BEGSR                
C       CLEAR   ANTWORTDS            
C *     --------------------------------------
C *     Neue Antwort anlegen
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Neue Antwort anlegen
C *     --------------------------------------
C     *BLANKS WHENNE TEXT              
C          
C *     --------------------------------------
C *     Neue Antwort anlegen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Artikel lesen
C *     --------------------------------------
C       OPEN ARTIKELP       77  
C     ARKEY CHAIN ARTIKELF       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Nummer der letzten Antwort ermitteln
C *     --------------------------------------
C       OPEN ANTWORTL1       77  
C     AWKEY1MAX SETGT ANTWORTL1       77  
C   N77 AWKEY1MAX READPE ANTWORTL1       77 77  
C   77   CLEAR   ANTWORTDS            
C *     --------------------------------------
C *     Nummer der neuen Antwort ermitteln
C *     --------------------------------------
C     *HIVAL SUB 1 NEAW            
C     AWAW IFLE NEAW              
C     AWAW ADD 1 NEAW            
C          
C *     --------------------------------------
C *     Doppelte Antworten vermeiden
C *     --------------------------------------
C       EVAL   NETEXT = %TRIM(TEXT)
C     XLATE1:XLATE2 XLATE(P) NETEXT NETEXT            
C     AWTEXT IFNE NETEXT              
C     AWAUT ORNE BEMIT              
C       CLEAR   ANTWORTDS            
C *     --------------------------------------
C *     Antwort anlegen
C *     --------------------------------------
C       OPEN ANTWORTP       77  
C          
C       MOVE ANTWORTDS ANTWORTSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD ARMAN AWMAN            
C     *ZERO ADD ARMIT AWMIT            
C     *ZERO ADD ARART AWART            
C     *ZERO ADD NEAW AWAW            
C     *ZERO ADD BEMIT AWAUT            
C       MOVE DATETIME AWDAT            
C       MOVE DATETIME AWDATCHG            
C       EVAL   AWTEXT = %TRIM(TEXT)
C     XLATE1:XLATE2 XLATE(P) AWTEXT AWTEXT            
C          
C *     --------------------------------------
C *     Antwort anlegen
C *     --------------------------------------
C       WRITE ANTWORTF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTAW2              
C          
C *     --------------------------------------
C *     Datum der neuen Antwort eintragen
C *     --------------------------------------
C     ARDATAW IFLT DATETIME              
C       MOVE DATETIME ARDATAW            
C          
C *     --------------------------------------
C *     Neue Antwort bei Nachricht
C *     --------------------------------------
C       EXSR DBNEUAWPN              
C       ELSE                
C       MOVE ANTWORTSAVE ANTWORTDS            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Artikel aktualisieren
C *     --------------------------------------
C       UPDATE ARTIKELF       77  
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Auf letzte Antwort weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       OPEN ANTWORTL1       77  
C     AWKEY1MAX SETGT ANTWORTL1       77  
C   N77 AWKEY1MAX READPE ANTWORTL1       77 77  
C   N77   EXSR REDIRECTAW2              
C       ENDSL                
C       ENDSR                
C          
  X * DBNEUAW SETGT BAR$NEUED    
  X * DBNEUAW READPE BAR$NEUED    
  X * DBNEUAW SETGT BAR$NEUED    
  X * DBNEUAW READPE BAR$NEUED    
  X  
C     AWKEY1MAX KLIST                
C       KFLD   ARMAN            
C       KFLD   ARMIT            
C       KFLD   ARART            
C          
  X * DBNEUARTPN EXSR BAR$NEUED    
  X * DBNEUAW EXSR BAR$NEUED    
  X  
C     DBNEUAWPN BEGSR                
C *     --------------------------------------
C *     Neue Antwort bei Nachricht
C *     --------------------------------------
C     NOPN IFNE ARPN              
C          
C *     --------------------------------------
C *     Neue Antwort für Sender
C *     --------------------------------------
C     ARMIT IFNE ARPN              
C       OPEN MITGLIEDL1       77  
C     MIKEY1ARMIT CHAIN MITGLIEDL1       77 77  
C   N77   EXSR NEUPN              
C       ENDIF                
C *     --------------------------------------
C *     Neue Antwort für Empfänger
C *     --------------------------------------
C       OPEN MITGLIEDL1       77  
C     MIKEY1ARPN CHAIN MITGLIEDL1       77 77  
C   N77   EXSR NEUPN              
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUAWPN CHAIN BAR$NEUED    
  X  
C     MIKEY1ARMIT KLIST                
C       KFLD   ARMAN            
C       KFLD   ARMIT            
C          
  X * DBNEUAWPN CHAIN BAR$NEUED    
  X  
C     MIKEY1ARPN KLIST                
C       KFLD   ARMAN            
C       KFLD   ARPN            
C          
  X * ANFRAGEAG EXSR BAR$NEUED    
  X  
C     DBNEUAG BEGSR                
C       CLEAR   AGENTDS            
C *     --------------------------------------
C *     Neuen Agent anlegen
C *     --------------------------------------
C          
C *     --------------------------------------
C *     Mandant lesen
C *     --------------------------------------
C       OPEN MANDANTP       77  
C     MAMAN CHAIN MANDANTP       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Nummer des letzten Agenten ermitteln
C *     --------------------------------------
C       OPEN AGENTL1       77  
C     AGKEY1MAX SETGT AGENTL1       77  
C   N77 AGKEY1MAX READPE AGENTL1       77 77  
C   77   CLEAR   AGENTDS            
C *     --------------------------------------
C *     Nummer des neuen Agenten ermitteln
C *     --------------------------------------
C     *HIVAL SUB 1 NEAG            
C     AGAG IFLE NEAG              
C     AGAG ADD 1 NEAG            
C       CLEAR   AGENTDS            
C *     --------------------------------------
C *     Agent anlegen
C *     --------------------------------------
C       OPEN AGENTP       77  
C          
C       MOVE AGENTDS AGENTSAVE            
C *     --------------------------------------
C *     Werte übernehmen
C *     --------------------------------------
C     *ZERO ADD MAMAN AGMAN            
C     *ZERO ADD NEAG AGAG            
C       MOVE DATETIME AGDAT            
C       EVAL   AGAGENT = %TRIM(AGENT)
C          
C *     --------------------------------------
C *     Agent anlegen
C *     --------------------------------------
C       WRITE AGENTF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Auf Agent weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTAG2              
C       ELSE                
C       MOVE AGENTSAVE AGENTDS            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Mandant aktualisieren
C *     --------------------------------------
C       UPDATE MANDANTF       77  
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUAG SETGT BAR$NEUED    
  X * DBNEUAG READPE BAR$NEUED    
  X  
C     AGKEY1MAX KLIST                
C       KFLD   MAMAN            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEUFILE BEGSR                
C       SELECT    
C *     --------------------------------------
C *     Textdatei anlegen / Bild hochladen
C *     --------------------------------------
C     *BLANKS WHENNE FILENAME              
C          
C *     --------------------------------------
C *     Textdatei anlegen / Bild hochladen
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Textdatei anlegen / Bild hochladen
C *     --------------------------------------
C     *BLANKS IFEQ FILEX              
C     *NULL ANDEQ FILEPTR              
C       EVAL FILEPTR    = %ADDR(BUFVTEXT)
C       EVAL BUFV       = %TRIM(TEXT)
C     *ZERO ADD BUFVLEN FILELEN            
C          
C *     --------------------------------------
C *     Daten in ASCII umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( EBCDIC:0:
C         BUFVTEXT:BUFVLEN:
C         ASCII:0:0:BUFVLEN:
C         BUFVTEXT:RCVLEN:
C         DUMMY:FB)
C       ENDIF                
C *     --------------------------------------
C *     Textdatei anlegen / Bild hochladen
C *     --------------------------------------
C     '/\?*':'----' XLATE(P) FILENAME MYFILENAME            
C     '/\?*':'----' XLATE(P) FILENAME MYFILENAME            
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       EXSR IFS$WRITEFILE              
C          
C *     --------------------------------------
C *     Auf Verzeichnis weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTALL              
C       ENDIF                
C *     --------------------------------------
C *     Auf Portal weiterleiten
C *     --------------------------------------
C     '1' WHENEQ SUCCESS              
C       EXSR REDIRECTALL              
C       ENDSL                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBNEUPWD BEGSR                
C *     --------------------------------------
C *     Neues Kennwort per E-Mail
C *     --------------------------------------
C     *BLANKS IFNE MITGLIED              
C          
C *     --------------------------------------
C *     Neues Kennwort per E-Mail
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Mitgliedsname prüfen (alle zulassen)
C *     --------------------------------------
C       MOVEL(P) MITGLIED OBJEKT            
C       EXSR OBJEKTNAME              
C       MOVEL(P) OBJEKTX MITGLIEDX            
C **   *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Mitglied suchen
C *     --------------------------------------
C     UPPER:LOWER XLATE(P) MITGLIEDX ELEMENT9            
C       MOVEL(P) ELEMENT9 MINAV            
C     MINAV IFEQ ELEMENT9              
C     *BLANKS ANDNE ELEMENT9              
C          
C       OPEN MITGLIEDLN       77  
C     MIKEYN3 CHAIN MITGLIEDLN       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Neues Kennwort für Mitglied erzeugen
C *     --------------------------------------
C       EXSR KENNWORTNEU              
C          
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       MOVEL(P) PWD3 MIPWD2            
C       UPDATE MITGLIEDF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     E-Mail mit Kennwort senden
C *     --------------------------------------
C       MOVEL(P) SPNEUPWD SUBJECT            
C       MOVEL(P) SPNEUPWD2 LONGMSG            
C       EXSR SENDMAIL              
C       EXSR REDIRECTALL              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C **     ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUPWD CHAIN BAR$NEUED    
  X  
C     MIKEYN3 KLIST                
C       KFLD   MAMAN            
C       KFLD   MINAV            
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBCHGPWD BEGSR                
C *     --------------------------------------
C *     Kennwort ändern
C *     --------------------------------------
C     *BLANKS IFNE KENNWORT1              
C     *BLANKS ANDNE KENNWORT2              
C     *BLANKS ANDNE KENNWORT3              
C     KENNWORT2 ANDEQ KENNWORT3              
C          
C *     --------------------------------------
C *     Kennwort ändern
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Kennwort für Benutzer verschlüsseln
C *     --------------------------------------
C       EXSR KENNWORTBEN              
C          
C *     --------------------------------------
C *     Kennwort prüfen
C *     --------------------------------------
C     PWD1 IFEQ BEPWD              
C     PWD1 OREQ BEPWD2              
C          
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Kennwort geändert
C *     --------------------------------------
C       MOVE DATETIME MIDATPWD            
C          
C *     --------------------------------------
C *     Kennwort für Mitglied verschlüsseln
C *     --------------------------------------
C       EXSR KENNWORTMIT              
C          
C *     --------------------------------------
C *     Neues Kennwort übernehmen
C *     --------------------------------------
C       MOVEL(P) PWD3 MIPWD            
C       MOVEL(P) PWD3 MIPWD2            
C       UPDATE MITGLIEDF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     E-Mail mit Kennwort senden
C *     --------------------------------------
C       MOVEL(P) SPCHGPWD SUBJECT            
C       MOVEL(P) SPCHGPWD2 LONGMSG            
C       EXSR SENDMAIL              
C       EXSR REDIRECTALL              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBCHGMAIL BEGSR                
C *     --------------------------------------
C *     E-Mail-Adresse ändern
C *     --------------------------------------
C     *BLANKS IFNE KENNWORT1              
C     *BLANKS ANDNE MAIL              
C          
C *     --------------------------------------
C *     E-Mail-Adresse ändern
C *     --------------------------------------
C     METHOD IFEQ POST              
C          
C *     --------------------------------------
C *     Kennwort für Benutzer verschlüsseln
C *     --------------------------------------
C       EXSR KENNWORTBEN              
C          
C *     --------------------------------------
C *     Kennwort prüfen
C *     --------------------------------------
C     PWD1 IFEQ BEPWD              
C     PWD1 OREQ BEPWD2              
C          
C *     --------------------------------------
C *     E-Mail-Adresse übernehmen
C *     --------------------------------------
C     '@' SCAN MAIL POS     77 78  
C     *IN78 IFEQ *ON              
C          
C *     --------------------------------------
C *     Mitglied aktualisieren
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     E-Mail-Adresse übernehmen
C *     --------------------------------------
C       MOVEL(P) MAIL MIMAIL            
C       UPDATE MITGLIEDF       77  
C     *IN77 IFEQ *OFF              
C          
C *     --------------------------------------
C *     E-Mail mit E-Mail-Adresse senden
C *     --------------------------------------
C       MOVEL(P) SPCHGMAIL SUBJECT            
C       MOVEL(P) SPCHGMAIL2 LONGMSG            
C       EXSR SENDMAIL              
C       EXSR REDIRECTALL              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Werte vorbelegen
C *     --------------------------------------
C       ELSE                
C       MOVEL(P) MIMAIL MAIL            
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBDLTARTPN BEGSR                
C *     --------------------------------------
C *     Artikel/Nachricht ausblenden
C *     --------------------------------------
C       OPEN ARTIKELP       77  
C     ARKEY CHAIN ARTIKELF       77 77  
C     *IN77 IFEQ *OFF              
C       MOVEL(P) 'X' ARDLT            
C       UPDATE ARTIKELF       77  
C       ENDIF                
C       EXSR REDIRECTARTPNX              
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBDLTAW BEGSR                
C *     --------------------------------------
C *     Antwort ausblenden
C *     --------------------------------------
C       OPEN ANTWORTP       77  
C     AWKEY CHAIN ANTWORTF       77 77  
C     *IN77 IFEQ *OFF              
C       MOVEL(P) 'X' AWDLT            
C       UPDATE ANTWORTF       77  
C       ENDIF                
C       EXSR REDIRECTAWX              
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBRCLARTPN BEGSR                
C *     --------------------------------------
C *     Artikel/Nachricht einblenden
C *     --------------------------------------
C       OPEN ARTIKELP       77  
C     ARKEY CHAIN ARTIKELF       77 77  
C     *IN77 IFEQ *OFF              
C       CLEAR   ARDLT            
C       UPDATE ARTIKELF       77  
C       ENDIF                
C       EXSR REDIRECTARTPNX              
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBRCLAW BEGSR                
C *     --------------------------------------
C *     Antwort einblenden
C *     --------------------------------------
C       OPEN ANTWORTP       77  
C     AWKEY CHAIN ANTWORTF       77 77  
C     *IN77 IFEQ *OFF              
C       CLEAR   AWDLT            
C       UPDATE ANTWORTF       77  
C       ENDIF                
C       EXSR REDIRECTAWX              
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBGELPN BEGSR                
C *     --------------------------------------
C *     Alle Nachrichten gelesen
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C       MOVE DATETIME MIGELPN            
C       MOVE DATETIME MIDATPF            
C       CLEAR   MINEUPF            
C       UPDATE MITGLIEDF       77  
C       ENDIF                
C       EXSR REDIRECTALL              
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBGELART BEGSR                
C *     --------------------------------------
C *     Alle Artikel gelesen
C *     --------------------------------------
C       OPEN MITGLIEDP       77  
C     MIKEY CHAIN MITGLIEDF       77 77  
C     *IN77 IFEQ *OFF              
C       MOVE DATETIME MIGELART            
C       MOVE DATETIME MIDATAKT            
C       CLEAR   MINEUAKT            
C       UPDATE MITGLIEDF       77  
C       ENDIF                
C       EXSR REDIRECTALL              
C       ENDSR                
C          
  X * LISTEFRAGEL EXSR BAR$LISTE    
  X  
C     DBRMVAW BEGSR                
C     *ZERO IFNE AWMAN              
C     *BLANKS ANDNE DEBUG              
C *     --------------------------------------
C *     Antwort entfernen
C *     --------------------------------------
C       OPEN ANTWORTP       77  
C     AWKEY CHAIN ANTWORTF       77 77  
C     *IN77 IFEQ *OFF              
C     *ZERO SUB AWMAN AWMAN            
C       UPDATE ANTWORTF       77  
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBLOGIN BEGSR                
C *     --------------------------------------
C *     Anmelden
C *     --------------------------------------
C     NOMIT IFNE BEMIT              
C       EXSR REDIRECTALL              
C       ENDIF                
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBLOGIN3 BEGSR                
C *     --------------------------------------
C *     Zutritt verboten (Privat)
C *     --------------------------------------
C       ENDSR                
C          
  X * NEUEDT CASEQ BAR$NEUED    
  X  
C     DBLOGOUT BEGSR                
C *     --------------------------------------
C *     Abmelden
C *     --------------------------------------
C       EXSR SESSIONENDE              
C       EXSR REDIRECTALL              
C       ENDSR                
C          
  X * DBEDTMIT EXSR BAR$NEUED    
  X * DBEDTMIT EXSR BAR$NEUED    
  X * DBEDTRUB EXSR BAR$NEUED    
  X * DBEDTRUB EXSR BAR$NEUED    
  X * DBEDTSMILY EXSR BAR$NEUED    
  X * DBEDTSMILY EXSR BAR$NEUED    
  X * DBEDTIDX EXSR BAR$NEUED    
  X * DBEDTIDX EXSR BAR$NEUED    
  X * DBEDTNAV EXSR BAR$NEUED    
  X * DBEDTNAV EXSR BAR$NEUED    
  X * DBNEUMIT EXSR BAR$NEUED    
  X * DBNEUMIT EXSR BAR$NEUED    
  X * DBNEUFILE EXSR BAR$NEUED    
  X * DBNEUFILE EXSR BAR$NEUED    
  X * DBNEUPWD EXSR BAR$NEUED    
  X * DBCHGPWD EXSR BAR$NEUED    
  X * DBCHGMAIL EXSR BAR$NEUED    
  X * DBGELPN EXSR BAR$NEUED    
  X * DBGELART EXSR BAR$NEUED    
  X * DBLOGIN EXSR BAR$NEUED    
  X * DBLOGOUT EXSR BAR$NEUED    
  X  
C     REDIRECTALL BEGSR                
C     WWTYP IFEQ TYPPF              
C     WWTYP OREQ TYPAKT              
C     WWTYP OREQ TYPBAR              
C     WWTYP OREQ TYPMMM              
C     WWTYP OREQ TYPGAL              
C     WWTYP OREQ TYPNAV              
C     WWTYP OREQ TYPIDX              
C     WWTYP OREQ TYPMIT              
C     WWTYP OREQ TYPRUB              
C     WWTYP OREQ TYPSMILY              
C *     --------------------------------------
C *     Auf Element weiterleiten
C *     --------------------------------------
C       MOVEL(P) ELEMENT REDIRECT            
C       CLEAR   REDIRECT#            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT ELEMENT2 :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDIF                
C *     --------------------------------------
C *     Auf Portal weiterleiten
C *     --------------------------------------
C     *BLANKS IFEQ REDIRECT              
C       MOVEL(P) INDEXNAV REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDIF                
C       ENDSR                
C          
  X * DBNEURUB EXSR BAR$NEUED    
  X  
C     REDIRECTRUB2 BEGSR                
C *     --------------------------------------
C *     Auf Rubrik weiterleiten
C *     --------------------------------------
C       MOVEL(P) RUNAV REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDSR                
C          
  X * DBNEURUB EXSR BAR$NEUED    
  X  
C     REDIRECTRUB2S BEGSR                
C *     --------------------------------------
C *     Auf Galerie weiterleiten
C *     --------------------------------------
C       MOVEL(P) TYPGAL NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) NANAV REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDSR                
C          
  X * DBNEUSMILY EXSR BAR$NEUED    
  X * DBNEUSMILY EXSR BAR$NEUED    
  X  
C     REDIRECTSMILY2 BEGSR                
C     WWTYP IFEQ TYPSMILYS              
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C       MOVEL(P) ELEMENT REDIRECT            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT ELEMENT2 :0 REDIRECT            
C       ENDIF                
C *     --------------------------------------
C *     Auf Smily weiterleiten
C *     --------------------------------------
C       CAT '/' :0 REDIRECT            
C       CAT SMNAV :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDSR                
C          
  X * DBEDTARTPN EXSR BAR$NEUED    
  X * DBEDTARTPN EXSR BAR$NEUED    
  X * REDIRECTARTPNX EXSR BAR$NEUED    
  X  
C     REDIRECTARTPN BEGSR                
C     WWTYP IFEQ TYPPN              
C     WWTYP OREQ TYPART              
C *     --------------------------------------
C *     Auf Artikel weiterleiten
C *     --------------------------------------
C       MOVEL(P) ELEMENT REDIRECT            
C       CLEAR   REDIRECT#            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT ELEMENT2 :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDIF                
C       ENDSR                
C          
  X * DBDLTARTPN EXSR BAR$NEUED    
  X * DBRCLARTPN EXSR BAR$NEUED    
  X  
C     REDIRECTARTPNX BEGSR                
C     PFADXX IFNE XML              
C     PFADXX ANDNE RSS              
C     PFADXX ANDNE ATOM              
C     NOCHAT ANDNE ARCHAT              
C *     --------------------------------------
C *     Auf Artikel weiterleiten
C *     --------------------------------------
C       MOVEL(P) TYPFRD NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) NANAV REDIRECT            
C       CLEAR   REDIRECT#            
C       ELSE                
C *     --------------------------------------
C *     Auf Artikel weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTARTPN              
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUARTPN EXSR BAR$NEUED    
  X * DBNEUARTPN EXSR BAR$NEUED    
  X  
C     REDIRECTARTPN2 BEGSR                
C     WWTYP IFEQ TYPMIT              
C     WWTYP OREQ TYPRUB              
C *     --------------------------------------
C *     Auf neuen Artikel weiterleiten
C *     --------------------------------------
C       CLEAR   REDIRECT            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       ENDIF                
C *     --------------------------------------
C *     Auf neuen Artikel weiterleiten
C *     --------------------------------------
C       OPEN MITGLIEDL1       77  
C     MIKEY1ART3 CHAIN MITGLIEDL1       77 77  
C     *IN77 IFEQ *OFF              
C       CAT MINAV :0 REDIRECT            
C     *ZERO ADD ARART NUM            
C       EXSR NUMSTR              
C       CAT '/' :0 REDIRECT            
C       CAT STR :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDIF                
C       ENDSR                
C          
  X * DBEDTAW EXSR BAR$NEUED    
  X * DBEDTAW EXSR BAR$NEUED    
  X * REDIRECTAWX EXSR BAR$NEUED    
  X  
C     REDIRECTAW BEGSR                
C     WWTYP IFEQ TYPAW              
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT ELEMENT2 :0 REDIRECT            
C       MOVEL(P) ELEMENT REDIRECT#            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT PFADREL1 :0 REDIRECT            
C       CAT ELEMENT3 :0 REDIRECT            
C       MOVEL(P) ELEMENT2 REDIRECT#            
C       ENDIF                
C       ENDSR                
C          
  X * DBDLTAW EXSR BAR$NEUED    
  X * DBRCLAW EXSR BAR$NEUED    
  X  
C     REDIRECTAWX BEGSR                
C     PFADXX IFNE XML              
C     PFADXX ANDNE RSS              
C     PFADXX ANDNE ATOM              
C     NOCHAT ANDNE ARCHAT              
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C       MOVEL(P) TYPFRD NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT NANAV :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ELSE                
C *     --------------------------------------
C *     Auf Antwort weiterleiten
C *     --------------------------------------
C       EXSR REDIRECTAW              
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUAW EXSR BAR$NEUED    
  X * DBNEUAW EXSR BAR$NEUED    
  X  
C     REDIRECTAW2 BEGSR                
C     WWTYP IFEQ TYPPN              
C     WWTYP OREQ TYPART              
C     WWTYP OREQ TYPBAR              
C *     --------------------------------------
C *     Auf neue Antwort weiterleiten
C *     --------------------------------------
C       MOVEL(P) ELEMENT REDIRECT            
C       ELSE                
C       MOVEL(P) PFADREL1 REDIRECT            
C       CAT ELEMENT2 :0 REDIRECT            
C       ENDIF                
C *     --------------------------------------
C *     Auf neue Antwort weiterleiten
C *     --------------------------------------
C     *ZERO ADD AWAW NUM            
C       EXSR NUMSTR              
C       MOVEL(P) STR REDIRECT#            
C       ENDSR                
C          
  X * DBNEUAG EXSR BAR$NEUED    
  X  
C     REDIRECTAG2 BEGSR                
C *     --------------------------------------
C *     Auf Agent weiterleiten
C *     --------------------------------------
C       MOVEL(P) TYPANFRAGEN NATYP            
C       EXSR NATYPNAV              
C       MOVEL(P) PFADREL REDIRECT            
C       CAT NANAV :0 REDIRECT            
C     *ZERO ADD AGAG NUM            
C       EXSR NUMSTR              
C       CAT '/' :0 REDIRECT            
C       CAT STR :0 REDIRECT            
C       CLEAR   REDIRECT#            
C       ENDSR                
C          
  X * SENDHTML EXSR BAR$SEND    
  X  
C     GELESEN BEGSR                
C     WWTYP IFEQ TYPPN              
C     WWTYP OREQ TYPART              
C     WWTYP OREQ TYPFRA              
C     WWTYP OREQ TYPFRR              
C     WWTYP OREQ TYPBAR              
C       EXSR LINKADDNEU              
C       MOVEL(P) LINKADD LINKADDSAVE            
C *     --------------------------------------
C *     Artikel als gelesen markieren
C *     --------------------------------------
C       OPEN GELESENP       77  
C     GEKEY CHAIN GELESENF       77 77  
C     *ZERO ADD ARMAN GEMAN            
C     *ZERO ADD ARMIT GEMIT            
C     *ZERO ADD ARART GEART            
C     *ZERO ADD BEMIT GEBEN            
C       MOVE DATETIME GEDATAW            
C   77   WRITE GELESENF       78  
C   N77   UPDATE GELESENF       78  
C          
C     *BLANKS IFNE LINKADDSAVE              
C *     --------------------------------------
C *     Hinweis auf Neues zurücksetzen
C *     --------------------------------------
C       SELECT    
C     NOPN WHENNE ARPN              
C       EXSR GELESENPF              
C     NORUB WHENNE ARRUB              
C       EXSR GELESENAKT              
C       ENDSL                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * GELESEN CHAIN BAR$NEUED    
  X  
C     GEKEY KLIST                
C       KFLD   ARMAN            
C       KFLD   ARMIT            
C       KFLD   ARART            
C       KFLD   BEMIT            
C          
  X * GELESEN EXSR BAR$NEUED    
  X  
C     GELESENPF BEGSR                
C *     --------------------------------------
C *     Hinweis auf Neues zurücksetzen
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C       CLEAR   BENEUPF            
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDSR                
C          
  X * GELESEN EXSR BAR$NEUED    
  X  
C     GELESENAKT BEGSR                
C *     --------------------------------------
C *     Hinweis auf Neues zurücksetzen
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C       CLEAR   BENEUAKT            
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDSR                
C          
  X * LISTEPFNEU EXSR BAR$LISTE    
  X  
C     RESETMITPF BEGSR                
C *     --------------------------------------
C *     Hinweis auf Neues setzen/zurücksetzen
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C     *BLANKS IFNE LINKADD              
C       MOVEL(P) 'X' BENEUPF            
C       ELSE                
C     DATETIME SUBDUR 5:*MN BEDATPF            
C       ENDIF                
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDSR                
C          
  X * LISTEAKTNEU EXSR BAR$LISTE    
  X  
C     RESETMITAKT BEGSR                
C *     --------------------------------------
C *     Hinweis auf Neues setzen/zurücksetzen
C *     --------------------------------------
C       OPEN BENUTZERL       77  
C     BEKEY CHAIN BENUTZERF       77 77  
C     *IN77 IFEQ *OFF              
C     *BLANKS IFNE LINKADD              
C       MOVEL(P) 'X' BENEUAKT            
C       ELSE                
C     DATETIME SUBDUR 5:*MN BEDATAKT            
C       ENDIF                
C       UPDATE BENUTZERF       77  
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUFILE EXSR BAR$NEUED    
  X  
C     IFS$WRITEFILE BEGSR                
C **   *BLANKS IFNE FILEX              
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C     WWTYP IFEQ TYPNEUFILE              
C     WWTYP OREQ TYPNEUFILE2              
C     PFADLEN3 SUBST(P) PFAD PFAD3            
C       ELSE                
C       MOVEL(P) PFAD PFAD3            
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C     *BLANKS IFNE FILEX              
C     *BLANKS ANDNE MYFILENAME              
C     ' ' CHECKR MYFILENAME POS            
C     ' ' CHECKR FILEX LEN            
C     POS IFGE LEN              
C       SUB LEN POS            
C       ADD 1 POS            
C     LEN SUBST(P) MYFILENAME:POS MYFILEXX            
C     UPPER:LOWER XLATE(P) MYFILEXX MYFILEXX            
C     UPPER:LOWER XLATE(P) FILEX FILEXX            
C     MYFILEXX IFEQ FILEXX              
C       CLEAR   FILEX            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CLEAR   PATHIFS            
C       CLEAR   FILEIFS            
C       CLEAR   FILEIFSMIN            
C       CLEAR   FILEIFSDLT            
C          
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL PATHIFS     = %TRIM(MAPFAD)   +'/'
C          
C *     --------------------------------------
C *     Neue Anlage
C *     --------------------------------------
C       EVAL FILEIFS     = %TRIM(PATHIFS)  +
C         %TRIM(PFAD3)    +'/'+
C         %TRIM(MYFILENAME) +
C         %TRIM(FILEX)
C          
C *     --------------------------------------
C *     Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = ''
C          
C *     --------------------------------------
C *     Alte Anlage
C *     --------------------------------------
C       EVAL FILEIFSDLT  = FILEIFS
C          
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CALL 'IFS$WRITE' IFS$WRITEPARM     77  
C **     ENDIF                
C       ENDSR                
C          
  X * DBEDTRUB EXSR BAR$NEUED    
  X * DBNEURUB EXSR BAR$NEUED    
  X  
C     IFS$WRITERUB BEGSR                
C     *BLANKS IFNE FILEX              
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CLEAR   PATHIFS            
C       CLEAR   FILEIFS            
C       CLEAR   FILEIFSMIN            
C       CLEAR   FILEIFSDLT            
C          
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL PATHIFS     = %TRIM(MAPFAD)   +'/'
C          
C *     --------------------------------------
C *     Neue Anlage
C *     --------------------------------------
C     *BLANKS IFNE RUFILEX              
C     '-' ANDNE RUFILEX              
C       EVAL FILEIFS     = %TRIM(PATHIFS)  +
C         %TRIM(RUNAV)    +
C         %TRIM(RUFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = %TRIM(PATHIFS)  +
C         %TRIM(RUNAV)    +
C           MIN+MINX
C          
C *     --------------------------------------
C *     Alte Anlage
C *     --------------------------------------
C     *BLANKS IFNE MYFILEX              
C     '-' ANDNE MYFILEX              
C       EVAL FILEIFSDLT  = %TRIM(PATHIFS)  +
C         %TRIM(MYNAV)    +
C         %TRIM(MYFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CALL 'IFS$WRITE' IFS$WRITEPARM     77  
C       ENDIF                
C       ENDSR                
C          
  X * DBEDTNAV EXSR BAR$NEUED    
  X  
C     IFS$WRITENAV BEGSR                
C     *BLANKS IFNE FILEX              
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CLEAR   PATHIFS            
C       CLEAR   FILEIFS            
C       CLEAR   FILEIFSMIN            
C       CLEAR   FILEIFSDLT            
C          
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL PATHIFS     = %TRIM(MAPFAD)   +'/'
C          
C *     --------------------------------------
C *     Neue Anlage
C *     --------------------------------------
C     *BLANKS IFNE NAFILEX              
C     '-' ANDNE NAFILEX              
C       EVAL FILEIFS     = %TRIM(PATHIFS)  +
C         %TRIM(NANAV)    +
C         %TRIM(NAFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = %TRIM(PATHIFS)  +
C         %TRIM(NANAV)    +
C           MIN+MINX
C          
C *     --------------------------------------
C *     Alte Anlage
C *     --------------------------------------
C     *BLANKS IFNE MYFILEX              
C     '-' ANDNE MYFILEX              
C       EVAL FILEIFSDLT  = %TRIM(PATHIFS)  +
C         %TRIM(MYNAV)    +
C         %TRIM(MYFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CALL 'IFS$WRITE' IFS$WRITEPARM     77  
C       ENDIF                
C       ENDSR                
C          
  X * DBEDTSMILY EXSR BAR$NEUED    
  X * DBNEUSMILY EXSR BAR$NEUED    
  X  
C     IFS$WRITESMILY BEGSR                
C     *BLANKS IFNE FILEX              
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CLEAR   PATHIFS            
C       CLEAR   FILEIFS            
C       CLEAR   FILEIFSMIN            
C       CLEAR   FILEIFSDLT            
C          
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL PATHIFS     = %TRIM(MAPFAD)   +'/'+
C         %TRIM(SMILYNAV) +'/'
C          
C *     --------------------------------------
C *     Neue Anlage
C *     --------------------------------------
C     *BLANKS IFNE SMFILEX              
C     '-' ANDNE SMFILEX              
C       EVAL FILEIFS     = %TRIM(PATHIFS)  +
C         %TRIM(SMNAV)    +
C         %TRIM(SMFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = %TRIM(PATHIFS)  +
C         %TRIM(SMNAV)    +
C           MIN+MINX
C          
C *     --------------------------------------
C *     Smilys ohne Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = ''
C          
C *     --------------------------------------
C *     Alte Anlage
C *     --------------------------------------
C     *BLANKS IFNE MYFILEX              
C     '-' ANDNE MYFILEX              
C       EVAL FILEIFSDLT  = %TRIM(PATHIFS)  +
C         %TRIM(MYNAV)    +
C         %TRIM(MYFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CALL 'IFS$WRITE' IFS$WRITEPARM     77  
C       ENDIF                
C       ENDSR                
C          
  X * DBEDTARTPN EXSR BAR$NEUED    
  X * DBNEUARTPN EXSR BAR$NEUED    
  X  
C     IFS$WRITEARTPN BEGSR                
C     *BLANKS IFNE FILEX              
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CLEAR   PATHIFS            
C       CLEAR   FILEIFS            
C       CLEAR   FILEIFSMIN            
C       CLEAR   FILEIFSDLT            
C          
C *     --------------------------------------
C *     Mitglied des Artikels lesen
C *     --------------------------------------
C       OPEN MITGLIEDL1       77  
C     MIKEY1ART3 CHAIN MITGLIEDL1       77 77  
C     *IN77 IFEQ *OFF              
C          
C     MIMIT IFEQ ARMIT              
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL PATHIFS     = %TRIM(MAPFAD)   +'/'+
C         %TRIM(MINAV)    +'/'
C          
C *     --------------------------------------
C *     Neue Anlage
C *     --------------------------------------
C     *BLANKS IFNE ARFILEX              
C     '-' ANDNE ARFILEX              
C       EVAL FILEIFS     = %TRIM(PATHIFS)  +
C         %CHAR(ARART)    +
C         %TRIM(ARFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Minibild
C *     --------------------------------------
C       EVAL FILEIFSMIN  = %TRIM(PATHIFS)  +
C         %CHAR(ARART)    +
C           MIN+MINX
C          
C *     --------------------------------------
C *     Alte Anlage
C *     --------------------------------------
C     *BLANKS IFNE MYFILEX              
C     '-' ANDNE MYFILEX              
C       EVAL FILEIFSDLT  = %TRIM(PATHIFS)  +
C         %CHAR(MYART)    +
C         %TRIM(MYFILEX)
C       ENDIF                
C *     --------------------------------------
C *     Anlage übernehmen
C *     --------------------------------------
C       CALL 'IFS$WRITE' IFS$WRITEPARM     77  
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * IFS$WRITEFILE CALL BAR$NEUED    
  X * IFS$WRITERUB CALL BAR$NEUED    
  X * IFS$WRITENAV CALL BAR$NEUED    
  X * IFS$WRITESMILY CALL BAR$NEUED    
  X * IFS$WRITEARTPN CALL BAR$NEUED    
  X  
C     IFS$WRITEPARM PLIST                
C       PARM   FILEPTR            
C       PARM   FILELEN            
C       PARM   PATHIFS            
C       PARM   FILEIFS            
C       PARM   FILEIFSMIN            
C       PARM   FILEIFSDLT            
C       PARM FORMATMIN FORMAT            
C          
  X * REDIRECTARTPN2 CHAIN BAR$NEUED    
  X * IFS$WRITEARTPN CHAIN BAR$NEUED    
  X  
C     MIKEY1ART3 KLIST                
C       KFLD   ARMAN            
C       KFLD   ARMIT            
C          
  X * *MAIN* EXSR BAR$MAIN    
  X * *PSSR EXSR BAR$MAIN    
  X  
C     ANFRAGE BEGSR                
C       CLEAR   ANFRAGEDS            
C *     --------------------------------------
C *     Agent
C *     --------------------------------------
C       EXSR ANFRAGEAG              
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C     'Pingdom' SCAN AGENT       77 78  
C     *IN78 IFEQ *OFF              
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C       OPEN ANFRAGEP       77  
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C     *ZERO ADD MAMAN AFMAN            
C     *ZERO ADD SIZE6 AFSIZE            
C     *ZERO ADD STATUS AFSTATUS            
C       MOVE DATETIME AFDAT            
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C       MOVEL(P) DNT AFDNT            
C       MOVEL(P) TYP AFTYP            
C       MOVEL(P) WWTYP AFTYP2            
C       MOVEL(P) PSSR AFPSSR            
C       MOVEL(P) SPAM$ AFSPAM$            
C       MOVEL(P) DEBUG AFDEBUG            
C       MOVEL(P) METHOD AFMETHOD            
C   23   MOVEL(P) 'X' AFSECURE            
C          
C *     --------------------------------------
C *     Mobile
C *     --------------------------------------
C     *BLANKS IFNE MOBILE              
C       MOVEL(P) 'X' AFMOBILE            
C       ENDIF                
C *     --------------------------------------
C *     Schmal
C *     --------------------------------------
C     *BLANKS IFNE SCHMAL              
C       MOVEL(P) 'X' AFSCHMAL            
C       ENDIF                
C *     --------------------------------------
C *     Anmeldedaten?
C *     --------------------------------------
C     *BLANKS IFNE BENUTZER              
C     *BLANKS ANDNE KENNWORT              
C       MOVEL(P) 'X' AFLOGIN            
C       ENDIF                
C *     --------------------------------------
C *     Weiterleiten?
C *     --------------------------------------
C     *BLANKS IFNE LOCABS              
C       MOVEL(P) 'X' AFWEITER            
C       ENDIF                
C *     --------------------------------------
C *     Unterseite?
C *     --------------------------------------
C     TARGETPARENT IFEQ TARGET              
C       MOVEL(P) 'X' AFSUB            
C       ENDIF                
C *     --------------------------------------
C *     Noindex
C *     --------------------------------------
C     NOROBOTS IFEQ ROBOTS              
C     NOINDEXFOLLOW OREQ ROBOTS              
C       MOVEL(P) 'X' AFNOINDEX            
C       ENDIF                
C *     --------------------------------------
C *     Nofollow
C *     --------------------------------------
C     NOROBOTS IFEQ ROBOTS              
C     INDEXNOFOLLOW OREQ ROBOTS              
C       MOVEL(P) 'X' AFNOFOLLOW            
C       ENDIF                
C *     --------------------------------------
C *     Anfragen
C *     --------------------------------------
C     WWTYP IFEQ TYPHISTORY              
C     WWTYP OREQ TYPBESUCHE              
C     WWTYP OREQ TYPBESUCHER              
C     WWTYP OREQ TYPANFRAGEN              
C **     MOVEL(P) 'X' AFANFRAGE            
C       ENDIF                
C *     --------------------------------------
C *     Anfrage-Objekt
C *     --------------------------------------
C     WWTYP IFEQ TYPICN              
C     WWTYP OREQ TYPOBJ              
C     WWTYP OREQ TYPBLASE              
C     WWTYP OREQ TYPSMILY              
C       EXSR ANFRAGEOBJEKT              
C       ENDIF                
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C     ' ' CHECKR ELEMENTMIN LEN2            
C     ' ' CHECKR PFAD LEN            
C       SUB LEN2 LEN     78  
C   78 LEN SUBST(P) PFAD PFAD2     77  
C   N78   CLEAR   PFAD2            
C     '/' CAT PFAD2 PFAD2            
C     ' ' CHECKR PFAD2 LEN     77 78  
C   78   SUBST(P) PFAD2:LEN CHAR     77  
C   N78   CLEAR   CHAR            
C     '/' IFEQ CHAR              
C       CAT INDEXNAV :0 PFAD2            
C       ENDIF                
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C     *ZERO ADD LEN AFPFADLEN            
C       MOVEL(P) ELEMENTMIN AFPFADMIN            
C       MOVEL(P) PFADX AFPFADX            
C          
C *     --------------------------------------
C *     Pfad
C *     --------------------------------------
C       EVAL   AFPFAD      = %TRIMR(PFAD2)
C          
C *     --------------------------------------
C *     STMF
C *     --------------------------------------
C     *BLANKS IFNE STMF              
C       EVAL   AFSTMF      =  '/' + STMF
C       ENDIF                
C *     --------------------------------------
C *     Referrer
C *     --------------------------------------
C       EVAL   AFREFERRER  =  REFERRER
C          
C *     --------------------------------------
C *     Suche / Farbe / Agent
C *     --------------------------------------
C       EVAL   AFSUCHE     = %TRIMR(SUCHE)
C     XLATE1:XLATE2 XLATE(P) AFSUCHE AFSUCHE            
C       MOVEL(P) WWFARBE AFFARBE            
C     *ZERO ADD AGAG AFAG            
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C     ' ' IFNE DNT              
C     '0' ANDNE DNT              
C       CLEAR   AFTYP            
C       CLEAR   AFTYP2            
C       CLEAR   AFPFAD            
C       CLEAR   AFPFADX            
C       CLEAR   AFPFADLEN            
C       CLEAR   AFPFADMIN            
C       CLEAR   AFNOINDEX            
C       CLEAR   AFNOFOLLOW            
C       CLEAR   AFREFERRER            
C       CLEAR   AFSUCHE            
C       CLEAR   AFFARBE            
C       CLEAR   AFSIZE            
C       CLEAR   AFSTMF            
C       ENDIF                
C *     --------------------------------------
C *     Zeit für Seitenaufbau ermitteln
C *     --------------------------------------
C       EXSR DAUERINF              
C     *ZERO ADD DAUER AFDAUER            
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C     'Web Explorer' SCAN AGENT       77 78  
C   N78   CALL 'ANFRAGE' ANFRAGEPARM     77  
C          
C *     --------------------------------------
C *     Anfrage aufzeichnen
C *     --------------------------------------
C       CALL QSNDDTAQ QSNDPARM     77  
C          
C     *IN77 IFEQ *ON              
C       WRITE ANFRAGEF       77  
C       ENDIF                
C *     --------------------------------------
C *     Anfrage melden
C *     --------------------------------------
C     'Web Explorer' SCAN AGENT       77 78  
C     *IN78 IFEQ *ON              
C       MOVEL(P) 'Web Explorer' SUBJECT            
C       EVAL LONGMSG =    %TRIM(HTTP) +
C                    %TRIM(PFAD) +
C                    %TRIM(PFADX)
C       EXSR SENDMAILX              
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * ANFRAGE CALL BAR$NEUED    
  X  
C     ANFRAGEPARM PLIST                
C       PARM   DTAQDS            
C       PARM '1' SUBMIT            
C          
  X * ANFRAGE CALL BAR$NEUED    
  X  
C     QSNDPARM PLIST                
C       PARM   DTAQ            
C       PARM   DTAQLIB            
C       PARM ANFRAGEDSLEN ANFRAGEDSLENX            
C       PARM   ANFRAGEDS            
C          
  X * ANFRAGE EXSR BAR$NEUED    
  X  
C     ANFRAGEOBJEKT BEGSR                
C *     --------------------------------------
C *     Anfrage-Objekt
C *     --------------------------------------
C     *BLANKS IFEQ AFANFRAGE              
C       MOVEL(P) TYPANFRAGEN NATYP            
C       EXSR NATYPNAV              
C     HTTP CAT(P) NANAV :0 LINK            
C     UPPER:LOWER XLATE(P) LINK LINK            
C     ' ' CHECKR LINK LEN            
C          
C *     --------------------------------------
C *     Anfrage-Objekt
C *     --------------------------------------
C       CLEAR   LINK2            
C     LEN SUBST(P) REFERRER LINK2     77  
C     UPPER:LOWER XLATE(P) LINK2 LINK2            
C     LINK2 IFEQ LINK              
C       MOVEL(P) 'X' AFANFRAGE            
C       ENDIF                
C *     --------------------------------------
C *     Anfrage-Objekt
C *     --------------------------------------
C     *BLANKS IFEQ AFANFRAGE              
C       MOVEL(P) TYPBESUCHER NATYP            
C       EXSR NATYPNAV              
C     HTTP CAT(P) NANAV :0 LINK            
C     UPPER:LOWER XLATE(P) LINK LINK            
C     ' ' CHECKR LINK LEN            
C          
C *     --------------------------------------
C *     Anfrage-Objekt
C *     --------------------------------------
C       CLEAR   LINK2            
C     LEN SUBST(P) REFERRER LINK2     77  
C     UPPER:LOWER XLATE(P) LINK2 LINK2            
C     LINK2 IFEQ LINK              
C       MOVEL(P) 'X' AFANFRAGE            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * ANFRAGE EXSR BAR$NEUED    
  X  
C     ANFRAGEAG BEGSR                
C *     --------------------------------------
C *     Agent
C *     --------------------------------------
C       OPEN AGENTL2       77  
C     AGKEY2 CHAIN AGENTL2       77 77  
C     *IN77 IFEQ *ON              
C          
C *     --------------------------------------
C *     Agent anlegen
C *     --------------------------------------
C       EXSR DBNEUAG              
C     AGKEY2 CHAIN AGENTL2       77 77  
C   77   CLEAR   AGENTDS            
C       ENDIF                
C       ENDSR                
C          
  X * ANFRAGEAG CHAIN BAR$NEUED    
  X * ANFRAGEAG CHAIN BAR$NEUED    
  X  
C     AGKEY2 KLIST                
C       KFLD   MAMAN            
C       KFLD   AGENT            
C          
  X * DBNEUAWPN EXSR BAR$NEUED    
  X * DBNEUAWPN EXSR BAR$NEUED    
  X  
C     NEUPN BEGSR                
C *     --------------------------------------
C *     E-Mail senden bei neuer Nachricht
C *     --------------------------------------
C     BEMIT IFNE MIMIT              
C       MOVEL(P) SPNEUPN SUBJECT            
C       MOVEL(P) SPNEUPN2 LONGMSG            
C       EXSR SENDMAIL              
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUMIT EXSR BAR$NEUED    
  X * DBNEUPWD EXSR BAR$NEUED    
  X * DBCHGPWD EXSR BAR$NEUED    
  X * DBCHGMAIL EXSR BAR$NEUED    
  X * NEUPN EXSR BAR$NEUED    
  X  
C     SENDMAIL BEGSR                
C *     --------------------------------------
C *     E-Mail senden
C *     --------------------------------------
C       EXSR SENDMAIL2              
C       CALL 'MAIL' SENDMAILPARM     77  
C       ENDSR                
C          
  X * SENDMAIL CALL BAR$NEUED    
  X  
C     SENDMAILPARM PLIST                
C       PARM MAMAIL MLFROM            
C       PARM MATITEL MLFROMNAME            
C       PARM MIMAIL MLTO            
C       PARM MITITEL MLTONAME            
C       PARM SUBJECT MLSUBJECT            
C       PARM LONGMSG MLLONGMSG            
C       PARM '1' MLSUBMIT            
C          
  X * DBNEUMIT EXSR BAR$NEUED    
  X * ANFRAGE EXSR BAR$NEUED    
  X * SENDMAILV EXSR BAR$NEUED    
  X * SESSION5 EXSR BAR$SID    
  X  
C     SENDMAILX BEGSR                
C *     --------------------------------------
C *     E-Mail senden
C *     --------------------------------------
C       EXSR SENDMAIL2              
C       CALL 'MAIL' SENDMAILXPARM     77  
C       ENDSR                
C          
  X * SENDMAILX CALL BAR$NEUED    
  X  
C     SENDMAILXPARM PLIST                
C       PARM MAMAIL MLFROM            
C       PARM MATITEL MLFROMNAME            
C       PARM MAMAIL MLTO            
C       PARM MATITEL MLTONAME            
C       PARM SUBJECT MLSUBJECT            
C       PARM LONGMSG MLLONGMSG            
C       PARM '1' MLSUBMIT            
C          
  X * DBNEUMIT EXSR BAR$NEUED    
  X  
C     SENDMAILV BEGSR                
C *     --------------------------------------
C *     E-Mail senden
C *     --------------------------------------
C       EXSR SENDMAILX              
C       ENDSR                
C          
  X * SENDMAIL EXSR BAR$NEUED    
  X * SENDMAILX EXSR BAR$NEUED    
  X  
C     SENDMAIL2 BEGSR                
C *     --------------------------------------
C *     // im Text suchen und ersetzen
C *     --------------------------------------
C     MAILN SCAN LONGMSG POS     77 78  
C     *IN78 DOWEQ *ON              
C       EVAL LONGMSG = %REPLACE(NN:LONGMSG:POS:MAILNLEN)
C     MAILN SCAN LONGMSG:POS POS     77 78  
C       ENDDO                
C *     --------------------------------------
C *     /// im Text suchen und ersetzen
C *     --------------------------------------
C     MAILP SCAN LONGMSG POS     77 78  
C     *IN78 DOWEQ *ON              
C       EVAL LONGMSG = %REPLACE(PP:LONGMSG:POS:MAILPLEN)
C     MAILP SCAN LONGMSG:POS POS     77 78  
C       ENDDO                
C *     --------------------------------------
C *     Benutzername
C *     --------------------------------------
C     MAILBENUTZER SCAN LONGMSG POS     77 78  
C   78   EVAL LONGMSG    = %REPLACE(%TRIM(MINAV):
C       LONGMSG:POS:MAILBENUTZERLEN)
C *     --------------------------------------
C *     Kennwort
C *     --------------------------------------
C     MAILKENNWORT SCAN LONGMSG POS     77 78  
C   78   EVAL LONGMSG    = %REPLACE(%TRIM(KENNWORT3):
C       LONGMSG:POS:MAILKENNWORTLEN)
C *     --------------------------------------
C *     Angezeigter Name
C *     --------------------------------------
C     MAILTITEL SCAN LONGMSG POS     77 78  
C   78   EVAL LONGMSG    = %REPLACE(%TRIM(MITITEL):
C       LONGMSG:POS:MAILTITELLEN)
C *     --------------------------------------
C *     E-Mail-Adresse
C *     --------------------------------------
C     MAILMAIL SCAN LONGMSG POS     77 78  
C   78   EVAL LONGMSG    = %REPLACE(%TRIM(MIMAIL):
C       LONGMSG:POS:MAILMAILLEN)
C *     --------------------------------------
C *     Web-Adresse
C *     --------------------------------------
C     MAILWEB SCAN LONGMSG POS     77 78  
C   78   EVAL LONGMSG    = %REPLACE(%TRIM(HTTP):
C       LONGMSG:POS:MAILWEBLEN)
C       ENDSR                
C          
  X * DBFRT CHAIN BAR$NEUED    
  X * DBNEUARTPN CHAIN BAR$NEUED    
  X * GELESENPF CHAIN BAR$NEUED    
  X * GELESENAKT CHAIN BAR$NEUED    
  X * RESETMITPF CHAIN BAR$NEUED    
  X * RESETMITAKT CHAIN BAR$NEUED    
  X  
C     BEKEY KLIST                
C       KFLD   MAMAN            
C       KFLD   BEMIT            
C          
  X * DBEDTMIT CHAIN BAR$NEUED    
  X * DBNEUPWD CHAIN BAR$NEUED    
  X * DBCHGPWD CHAIN BAR$NEUED    
  X * DBCHGMAIL CHAIN BAR$NEUED    
  X * DBGELPN CHAIN BAR$NEUED    
  X * DBGELART CHAIN BAR$NEUED    
  X  
C     MIKEY KLIST                
C       KFLD   MAMAN            
C       KFLD   MIMIT            
C          
  X * DBEDTARTPN CHAIN BAR$NEUED    
  X * DBNEUAW CHAIN BAR$NEUED    
  X * DBDLTARTPN CHAIN BAR$NEUED    
  X * DBRCLARTPN CHAIN BAR$NEUED    
  X  
C     ARKEY KLIST                
C       KFLD   ARMAN            
C       KFLD   ARMIT            
C       KFLD   ARART            
C          
  X * DBEDTAW CHAIN BAR$NEUED    
  X * DBDLTAW CHAIN BAR$NEUED    
  X * DBRCLAW CHAIN BAR$NEUED    
  X * DBRMVAW CHAIN BAR$NEUED    
  X  
C     AWKEY KLIST                
C       KFLD   AWMAN            
C       KFLD   AWMIT            
C       KFLD   AWART            
C       KFLD   AWAW            
C          
  X * NEUEDT EXSR BAR$NEUED    
  X  
C     WEITER BEGSR                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C          
C       SELECT    
C *     --------------------------------------
C *     Externe Adresse
C *     --------------------------------------
C     *BLANKS WHENNE WWW              
C       MOVEL(P) WWW LOCABS            
C          
C *     --------------------------------------
C *     Internes Weiterleiten
C *     --------------------------------------
C     *BLANKS WHENNE REDIRECT              
C     *BLANKS ORNE REDIRECT#              
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     PFADXX IFEQ XML              
C     PFADXX OREQ RSS              
C     PFADXX OREQ ATOM              
C     *BLANKS IFNE REDIRECT#              
C     '/' CAT REDIRECT# :0 REDIRECT#            
C       CAT REDIRECT# :0 REDIRECT            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     INDEXNAV IFEQ REDIRECT              
C       MOVEL(P) '/.' REDIRECT            
C       EXSR WEITER2              
C       CAT REDIRECT :0 LOCABS            
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       ELSE                
C       EXSR WEITER2              
C       CAT REDIRECT :0 LOCABS            
C       CAT PFADX :0 LOCABS            
C       ENDIF                
C *     --------------------------------------
C *     Parameter kodieren
C *     --------------------------------------
C       MOVEL(P) QUERY$ QUERYLOC            
C          
C *     --------------------------------------
C *     Parameter kodieren
C *     --------------------------------------
C     *BLANKS IFNE SUCHE              
C       MOVEL(P) SUCHE MYTITEL            
C       EXSR MYTITELXQUERY              
C       EXSR MYTITELXUTF8              
C     *BLANKS COMP QUERYLOC       78  
C   78   CAT '?' :0 QUERYLOC            
C   N78   CAT '&' :0 QUERYLOC            
C       CAT SUCHENAME :0 QUERYLOC            
C       CAT MYTITEL :0 QUERYLOC            
C       ENDIF                
C *     --------------------------------------
C *     Anker für Weiterleiten
C *     --------------------------------------
C     PFADXX IFNE XML              
C     PFADXX ANDNE RSS              
C     PFADXX ANDNE ATOM              
C     NOCHAT ANDEQ ARCHAT              
C     *BLANKS IFNE REDIRECT#              
C     PREFIX CAT REDIRECT# :0 REDIRECT#            
C     '#' CAT REDIRECT# :0 REDIRECT#            
C       CAT REDIRECT# :0 QUERYLOC            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       CAT QUERYLOC :0 LOCABS            
C       ENDSL                
C       ENDSR                
C          
  X * WEITER EXSR BAR$NEUED    
  X * WEITER EXSR BAR$NEUED    
  X  
C     WEITER2 BEGSR                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       MOVEL(P) PFAD PFAD3            
C       EXSR WEITER3              
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     *BLANKS IFNE PFADREL1              
C     3 SUBST(P) REDIRECT CHAR3            
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     CHAR3 DOWEQ PFADREL1              
C       EXSR WEITER3              
C       SUBST(P) REDIRECT:4 REDIRECT            
C     3 SUBST(P) REDIRECT CHAR3            
C       ENDDO                
C       ENDIF                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     '/.' IFNE REDIRECT              
C     *BLANKS IFNE PFAD3              
C       CAT '/' :0 PFAD3            
C       ENDIF                
C       CAT REDIRECT :0 PFAD3            
C       ENDIF                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       MOVEL(P) PFAD3 REDIRECT            
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       MOVEL(P) REDIRECT MYTITEL            
C       EXSR MYTITELXQUERY              
C       EXSR MYTITELXUTF8              
C       MOVEL(P) MYTITEL REDIRECT            
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       MOVEL(P) HTTP LOCABS            
C     ' ' CHECKR REDIRECT LOCLEN            
C     ' ' CHECKR LOCABS LOCPOS            
C       ADD 1 LOCPOS            
C          
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C       SELECT    
C     LOCLEN WHENLT 1              
C     *ZERO ADD 1 LOCLEN            
C     LOCLEN WHENGT LOCABSLEN              
C     *ZERO ADD LOCABSLEN LOCLEN            
C       ENDSL                
C       ENDSR                
C          
  X * WEITER2 EXSR BAR$NEUED    
  X * WEITER2 EXSR BAR$NEUED    
  X  
C     WEITER3 BEGSR                
C *     --------------------------------------
C *     Neue Adresse ermitteln
C *     --------------------------------------
C     ' ' CHECKR PFAD3 LEN            
C     1 SUBST(P) PFAD3:LEN CHAR            
C     CHAR DOWNE '/'              
C     LEN ANDGT 1              
C       SUB 1 LEN            
C     1 SUBST(P) PFAD3:LEN CHAR            
C       ENDDO                
C     LEN IFGT 1              
C       SUB 1 LEN            
C     LEN SUBST(P) PFAD3 PFAD3            
C       ELSE                
C       CLEAR   PFAD3            
C       ENDIF                
C       ENDSR                
C          
  X * DBNEUMIT EXSR BAR$NEUED    
  X * DBNEURUB EXSR BAR$NEUED    
  X * DBNEUSMILY EXSR BAR$NEUED    
  X * DBNEUPWD EXSR BAR$NEUED    
  X * SESSION2 EXSR BAR$SID    
  X * SESSION4 EXSR BAR$SID    
  X  
C     OBJEKTNAME BEGSR                
C *     --------------------------------------
C *     Objektname prüfen
C *     --------------------------------------
C     UPPER:LOWER XLATE(P) OBJEKT OBJEKTX            
C          
C *     --------------------------------------
C *     Objektname prüfen
C *     --------------------------------------
C     OBJEKTCHARS CHECK OBJEKTX POS     77  
C   77   SUBST(P) OBJEKTX:POS OBJEKT3            
C   N77   CLEAR   OBJEKT3            
C     *BLANKS COMP OBJEKT3       77 77  
C          
C     *IN77 IFEQ *OFF              
C *     --------------------------------------
C *     Objektname prüfen
C *     --------------------------------------
C       MOVEL(P) OBJEKTX ELEMENTNAV            
C       EXSR ELEMENTMINSR              
C     *BLANKS COMP ELEMENTMIN       77 77  
C       ENDIF                
C       ENDSR                

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