Cpkmask
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
************************************************************************ * * * 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