Cpkmask

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Wechseln zu: Navigation, Suche
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
CPKMASK  CSECT RESIDENT
* NEUE MASKE 'LOGIN-MENU' WIRD BEI STATANM=X'FF' AUSGEGEBEN.
* ZUS. BASISREGISTER R9. ACHTUNG, DIE ERSTEN BEFEHLE M U E S S E N 
* R13 ZUR BASISADRESSIERUNG VERWENDEN BIS R9 GELADEN IST !!!!
** V3.0A00
* MASKE KORRIGIERT.
** V2.0A04
* BEI ANSPRUNG VON CPCLOCK DARF REG 7 + 8 NICHT GESAVET WERDEN.
** V2.0A03
* ACHTUNG ! KEIN CHECK AUF BUFFERENDE (CIRKA NACH 6900 BYTES)
* DA MELDUNG PARTNER TABEL FULL (ZCP0005) EHER AUFTRITT
*
* WENN Z4 GESETZT (FF) WERDEN AKTUELLE PAC'S AUSGEGEBEN
* WENN Z2 GESETZT (FF) WIRD KEIN TEXT ANGEHAENGT (NACH PAC'S VOR CMD)
* SONST WIRD TEXT Z2 (LEN.80) AUSGEGEBEN
* WENN Z3 GESETZT (FF) WIRD DER STRING "CMD:" AUSGEGEBEN
* WENN Z6 GESETZT (FF) WIRD PAC NACH TERMOUTA GESCHRIEB.
* 
* WENN Z5 = 00 WIRD EIN FELD NACH LINKS GESPRUNGEN
* (DUNKELGESTEUERT BEI PW EINGABE)
*
*
         PRINT NOGEN
*---------------------------------------------------------------------*
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*---------------------------------------------------------------------*
         GPARMOD 31
CPKMASK  AMODE ANY
CPKMASK  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
*
* R7 RUECKSPRADRESSE:   BASR  R7,R13
*
         USING *,R13,R9
         CLM   R8,B'1000',=X'FF'    VON CPCLOCK ????
         BNE   BEGKM
** AUS CPCLOCK
         MVI   CLKMOD,X'FF'
         B     BEG
SAV7     DS    3F              REG 7 BIS REG9  (REG9 = BASIS)
BEGKM    STM   R7,R9,SAV7
         USING STATEIN,R3
         USING USEREIN,R4
*---------------------------------------------------------------------*
*        E X T R N ' S
*---------------------------------------------------------------------*
         EXTRN ERRTEXT
         EXTRN Z2
         EXTRN Z3
         EXTRN Z4
         EXTRN Z5
         EXTRN Z6
         EXTRN TEXT1
         EXTRN OUTPUT2
         EXTRN ERR15
         EXTRN TERMOUTA
         EXTRN OUTPUT1
         EXTRN CPVER
*---------------------------------------------------------------------*
BEG      EQU   *
         LA    R1,4095          |
         LA    R9,1(R13,R1)     |  BASISREGISTER LADEN
*
         XR    R8,R8
         MVI   STATK,X'10'
         MVC   STATAKTP,=H'0'
         L     R8,=A(Z4)
         USING Z4,R8
** AKT. PAC'S AUSGEBEN ??
         CLI   Z4,X'FF'
         BNE   F111
         L     R4,USERPAGA
         L     R5,USERPAGE
         MVC   0(6,R15),=X'27841ED81DC8'
*        MVC   0(6,R15),=X'27841DC81ED8'
         A     R15,=F'6'
         A     R14,=F'6'
         L     R8,=A(TEXT1)
         USING TEXT1,R8
         MVC   0(88,R15),TEXT1
         A     R15,=F'88'
         A     R14,=F'88'
LOOPK    EQU   *
         A     R4,=A(X'100')
         CLI   USPID+1,X'00'
         BE    GOTKN 
         L     R8,=A(OUTPUT2)
         USING OUTPUT2,R8
         MVC   OUTPUT2(80),=CL80' '
         MVC   OUTPUT2(4),USPAC
         MVC   OUTPUT2+5(8),USPNA  
         MVC   OUTPUT2+14(8),USCPNAME
         MVC   OUTPUT2+23(8),USPRO
         MVC   OUTPUT2+32(4),USTYP
         MVC   OUTPUT2+37(15),USERROR
         CLC   USRC,=F'0'
         BE    W130
         L     R8,=A(ERR15)
         USING ERR15,R8
         ST    15,ERR15
         UNPK  OUT15,USRC(5)
         TR    OUT15,HX-240
         L     R8,=A(OUTPUT2)
         USING OUTPUT2,R8
         MVC   OUTPUT2+53(8),OUT15
* WENN FREE BYTE GESTETZT IST WIRD DER EINTRAG GELOESCHT
W130     EQU   *
         MVC   OUTPUT2+61(2),=X'2798'
         MVC   0(63,R15),OUTPUT2
         A     R15,=F'63'
         A     R14,=F'63'
         CLI   USFREE,C'F'
         BNE   GOTKN
         CLI   USDEC,C'D'
         BNE   F0
         MVI   USFREE,C'D'
         MVC   USAID,=F'0'
         MVC   USCID,=F'0'
         MVI   USOKZ,X'00'
         MVC   USLEN,=F'0'
         MVC   USADR1,=F'0'
         MVC   USADR2,=F'0'
         MVC   USADR3,=F'0'
         MVC   USADR4,=F'0'
         MVC   USLOE1,USLOE1SA
         MVC   USRC,=F'0'
         MVC   USNEA,=XL8'3650350000000000'
         MVC   USERROR,=CL15'DECL SEQ:'
         MVC   USERROR+10(4),USSEQSA
         MVC   USSEQ,USSEQSA
         MVC   USKEY1,=C'0000'
         MVC   USLOE2,USLOE2SA
         XC    USLOE3(25),USLOE3
         MVC   USTEXTA,=F'0'
         MVC   USTEXTE,=F'0'
         MVC   USTERMS,=F'0'
         MVC   USIN,=F'0'
         MVC   USLEN,=F'0'
         MVC   USRES,=F'0'
         MVC   USCO,=F'0'
         MVC   USEI,=F'0'
         MVC   USRPBA,=F'0'
         MVC   USCCBA,=F'0'
         B     GOTKN
F0       XC    USCPNAME(250),USCPNAME
GOTKN    EQU   *
         CR    R4,R5
         BL    LOOPK
         L     R8,=A(Z4)
         USING Z4,R8
F111     MVI   Z4,X'FF'
** TEXT ANHAENGEN VOR CMD, NACH PAC'S ??
         L     R8,=A(Z2)
         USING Z2,R8
         CLI   Z2,X'FF'
         BE    F20         ** NEIN           
** Z2 ALS TEXT ANHAENGEN
         MVC   0(80,R15),Z2
         A     R15,=F'80'
         A     R14,=F'80'
         MVI   Z2,X'FF'
F20      EQU   *
** STRING CMD: AUSGEBEN ??
         L     R8,=A(Z3)
         USING Z3,R8
         CLI   Z3,X'FF'
         BNE   F21        ** NEIN
** STRING CMD: ANHAENGEN
         MVI   Z3,X'FF'
         MVC   0(4,R15),=CL4'CMD:'
         A     R15,=F'4'
         A     R14,=F'4'
F21      MVC   0(4,R15),=X'27841ED7'
         A     R15,=F'4'
         A     R14,=F'4'
** FELD FUER PASSWORTEINGABE MOD. ??
         L     R8,=A(Z5)
         USING Z5,R8
         CLI   Z5,X'FF'
         BE    P3         ** NEIN
**  PW-MENU  ODER  ANMELDUNG ??
         CLI   STATANM,STATANMP
         BE    CPKPWM     **  PW-MENU
**  ANMELDE-MENU !!
         L     R5,=A(OUTPUT1)
         MVC   CPNPTAST(27),0(R5)
         L     R5,=A(CPVER)
         MVC   CPNVER(6),1(R5)
         LA    R5,CPMENUN
         LH    R6,CPMENUNL
         MVI   Z5,X'FF'
         B     X6MENU
** JA ! PASSWORT-MENU
CPKPWM   EQU   *
         L     R5,=A(OUTPUT1)                 A(KONST) AUS MCP002
         MVC   CPMPTAST(27),0(R5)
         L     R5,=A(CPVER)               AUS MCP002
         MVC   CPMVER(6),1(R5)
         LA    R5,CPMENUT        NICHT FF  MENU MIT PASSWORT
         LH    R6,CPMENUL        LEN MENU
         MVI   Z5,X'FF'
         B     X6MENU
         MVC   0(2,R15),=X'27C7'
         A     R15,=F'2'
         A     R14,=F'2'
P3       MVI   Z5,X'FF'
         L     R8,=A(TERMOUTA)
         USING TERMOUTA,R8
         L     R5,TERMOUTA
         L     R8,=A(Z6)
         USING Z6,R8
         CLI   Z6,X'FF'
         BNE   X6
         MVC   112(4,R5),USPAC   SYSZ
         MVI   Z6,X'00'          * PAC RESET
X6       EQU   *
         L     R8,=A(TERMOUTA)
         USING TERMOUTA,R8
         L     R5,TERMOUTA
         LR    R6,R14
X6MENU   EQU   *
         DROP  R8
         LA    R2,STATEI
         L     R4,STAIDCP  
         L     R8,STATCID
         L     R14,STATRPBA
         YSEND RPB=(R14),CID=(R8),AREA=(R5),AREALN=(R6),AID=(R4),      -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    W28
         L     R8,=A(ERRTEXT)
         USING ERRTEXT,R8
         MVC   ERRTEXT(20),=CL20'S/KMASK/YSEND03'
         CLM   R15,B'1110',=X'10040C'
         BNE   X5
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    X6
         MVC   ERRTEXT(20),=CL20'S/KMASK/YSEND03/SOL'
X5       EQU   *   WENN R15 <> 0   DANN AUSGEBEN TEXT IN MCP002
**X5       BAS   R14,FEHLER
* NACH AUSGABE DER CP-MASKE --> BLEIBE IM LINE MODUS
*>>>  RUECKSPRUNG <<<<<<<<<<<
W28      EQU   *
         CLI   CLKMOD,X'FF'     AUS CPCLOCK ???
         BNE   W28CLK
         MVI   CLKMOD,X'00'     RESET
         BR    R7            NACH CPCLOCK
W28CLK   LM    R7,R9,SAV7    !! ACHTUNG, R9 IST BASISREGISTER !!
         BR    R7
*---------------------------------------------------------------------*
CLKMOD   DC    X'00'
HX       DC    C'0123456789ABCDEF'
         DS    0F
OUT15    DS    L9
         DS    CL20        SCHUTZ
         DS    0F
         LTORG              <<<<<<<<<<<<<<<<<
CPMENUT  DS    0F
         DC    X'10401B20614040455165005040004121'
*        DC    X'1B206148400000004040000000'    PAR00D   ANZ-ZEILE
*        DC    X'21'
CPMPTAST DS    XL27       BEREICH FUER PROG TASTEN UEBER V(KONST)
         DC    X'27822784'
         DC    X'1ED81D7C'     NP   HELL GESCHUETZT
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                    ___________         '
         DC    C'     _____________                      '
         DC    C'                   /           \        '
         DC    C'    |             \                     '
         DC    C'                  | |~~~~~~~~~| |       '
         DC    C'    | |~~~~~~~~~~| |                    '
         DC    C'                  | |          ~        '
         DC    C'    | |          | |                    '
         DC    C'                  | |                   '
         DC    C'    | |          | |                    '
         DC    C'                  | |                   '
         DC    C'    | |__________| |                    '
         DC    C'                  | |                   '
         DC    C'    |             /                     '
         DC    C'                  | |                   '
         DC    C'    | |~~~~~~~~~~~                      '
         DC    C'                  | |          _        '
         DC    C'    | |                                 '
         DC    C'                  | |_________| |       '
         DC    C'    | |                                 '
         DC    C'                   \           / onnecti'
         DC    C'on  | | rogramm                         '
         DC    C'                    ~~~~~~~~~~~         '
         DC    C'    ~~~                                 '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'________________________________________'
         DC    C'________________________________________'
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                (c) by Siemens-Nixdorf-I'
         DC    C'nformationssysteme AG                   '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                            All Rights R'
         DC    C'eserved                                 '
         DC    C'________________________________________'
         DC    C'________________________________________'
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                                        '
         DC    X'1ED81DC2'         HELL UNTERSTRICHEN
         DC    C'CP is in state LOCK. Please enter passwo'
         DC    C'rd '
         DC    X'1E7C1DC4'     NICHT GESCHUETZT
         DC    C'        '
         DC    X'1ED81D7C'     NP   HELL GESCHUETZT
         DC    C'               Version '
CPMVER   DC    CL6'X.XXXX'
         DC    C'                                        '
         DC    C'                                        '
         DC    X'27C7'      TBL
CPMENUTL EQU   *
CPMENUL  DC    Y(CPMENUTL-CPMENUT)
         DS    0F
CPMENUN  DS    0F
         DC    X'10401B20614040455165005040004121'
CPNPTAST DS    XL27       BEREICH FUER PROG TASTEN UEBER V(KONST)
         DC    X'27822784'
         DC    X'1ED81D7C'     NP   HELL GESCHUETZT
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                    ___________         '
         DC    C'     _____________                      '
         DC    C'                   /           \        '
         DC    C'    |             \                     '
         DC    C'                  | |~~~~~~~~~| |       '
         DC    C'    | |~~~~~~~~~~| |                    '
         DC    C'                  | |          ~        '
         DC    C'    | |          | |                    '
         DC    C'                  | |                   '
         DC    C'    | |__________| |                    '
         DC    C'                  | |                   '
         DC    C'    |             /                     '
         DC    C'                  | |                   '
         DC    C'    | |~~~~~~~~~~~                      '
         DC    C'                  | |          _        '
         DC    C'    | |                                 '
         DC    C'                  | |_________| |       '
         DC    C'    | |                                 '
         DC    C'                   \           / onnecti'
         DC    C'on  | | rogramm                         '
         DC    C'                    ~~~~~~~~~~~         '
         DC    C'    ~~~                                 '
         DC    C'________________________________________'
         DC    C'________________________________________'
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                       '
         DC    X'1ED81DC2'
         DC    C'L O G I N  -  P r'
         DC    C' o c e d e r e'
         DC    X'1ED81D7C'     NP   HELL GESCHUETZT
         DC    C'                          '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'                       VT-Name     : '   
         DC    X'1E7C1DC4'       NICHT GESCHUETZT
CPNVTN   DC    C'        '
         DC    X'1ED81D7C'       NP   HELL  GESCHUETZT
         DC    C'                                   '
         DC    C'                       Password    : '    
         DC    X'1E7C1DC4'       NICHT GESCHUETZT
CPNPASS  DC    C'        '
         DC    X'1ED81D7C'       NP   HELL  GESCHUETZT
         DC    C'                                   '
         DC    C'                                        '
         DC    C'                                        '
         DC    C'________________________________________'
         DC    C'________________________________________'
         DC    C'                                        '
         DC    C'                                        '
         DC    C' Version '        
CPNVER   DC    CL6'X.XXXX'
         DC    C'   /   '
         DC    C'Copyright (C) Siemens Nixdorf '
         DC    C'Informationssysteme AG 1991 '             
         DC    C'                                        '
         DC    C'                                        '
         DC    X'27C727C7'  2 * TBL
CPMENUNE EQU   *
CPMENUNL DC    Y(CPMENUNE-CPMENUN)
         DS    0F
*
*---------------------------------------------------------------------*
*        D S E C T ' S
*---------------------------------------------------------------------*
         STATEIN
         EJECT
         USEREIN
         END