旧家イトウ家の小技裏技(その7)

2:COBOLサンプルプログラム2
江須扇 10/26 13:37

000010 IDENTIFICATION DIVISION.
000020***************************************************************
000030* プリンタ占有プログラム起動 (PRLOCK CALL) *
000040***************************************************************
000050* 作成者 江須扇
000060* 作成日 2003年10月26日
000070 PROGRAM-ID. PRLCKC.
000080 ENVIRONMENT DIVISION.
000090 CONFIGURATION SECTION.
000100 SOURCE-COMPUTER. EXPRESS5800.
000110 OBJECT-COMPUTER. EXPRESS5800.
000120 DATA DIVISION.
000130 WORKING-STORAGE SECTION.
000140 01 SPAWN-REC1.
000150    02 SPAWN11 PIC X(256).
000160 01 SPAWN-REC2.
000170    02 SPAWN21 PIC 9(04).
000180 01 SPAWN-REC3.
000190    02 SPAWN31 PIC X(10).
000200    02 SPAWN32 PIC X(02).
000210    02 SPAWN33 PIC X(10).
000220    02 SPAWN34 PIC X(08).
000230 01 TIMER PIC 9(04).
000240*
000250*
000260 SCREEN SECTION .
000270 SD GAMEN END STATUS IS ENDSTS.
000280 01 HAJIMEDSP CLEAR SCREEN.
000290    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101004".
000300    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101407".
000310    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0324402".
000320    02 LINE 03 COLUMN 24 PIC N(18) VALUE
000330       NC">>プリンタ占有プログラム起動<<".
000340    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0358407".
000350 01 HAJIMEDSP2.
000360    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0721164".
000370    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0721404".
000380    02 LINE 07 COLUMN 24 PIC N(18) VALUE
000390       NC"   ※ 状 態 表 示 ※".
000400    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0761104".
000410    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0761407".
000420    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821104".
000430    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821403".
000440    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0861100".
000450    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0862000".
000460    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0863004".
000470    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0863407".
000480    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921104".
000490    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921403".
000500    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0961100".
000510    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0962000".
000520    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0963004".
000530    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0963407".
000540    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021104".
000550    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021403".
000560    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1061100".
000570    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1062000".
000580    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1063004".
000590    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1063407".
000600    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121104".
000610    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121403".
000620    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1161100".
000630    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1162000".
000640    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1163004".
000650    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1163407".
000660    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221104".
000670    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221403".
000680    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1261100".
000690    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1262000".
000700    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1263004".
000710    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1263407".
000720    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321106".
000730    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321403".
000740    02 LINE 13 COLUMN 23 PIC N(18) VALUE
000750       NC"  プリンタ占有プログラム起動中".
000760    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1361100".
000770    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1362000".
000780    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1363004".
000790    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1363407".
000800    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421104".
000810    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421403".
000820    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1461100".
000830    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1462000".
000840    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1463004".
000850    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1463407".
000860    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521104".
000870    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521403".
000880    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1561100".
000890    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1562000".
000900    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1563004".
000910    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1563407".
000920    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621104".
000930    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621403".
000940    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1661100".
000950    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1662000".
000960    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1663004".
000970    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1663407".
000980    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721104".
000990    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721403".
001000    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1761100".
001010    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1762000".
001020    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1763004".
001030    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1763407".
001040    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821144".
001050    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821403".
001060    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1861100".
001070    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1862000".
001080    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1863004".
001090    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1863407".
001100    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1922000".
001110    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1963004".
001120    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1963407".
001130 01 SPOOLDSP.
001140    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821403".
001150    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921403".
001160    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021403".
001170    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121403".
001180    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221403".
001190    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321403".
001200    02 LINE 13 COLUMN 23 PIC N(18) VALUE
001210       NC"  #SPOOLプログラム起動中".
001220    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421403".
001230    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521403".
001240    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621403".
001250    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721403".
001260    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821403".
001270 01 OWARIDSP.
001280    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821402".
001290    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921402".
001300    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021402".
001310    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121402".
001320    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221402".
001330    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321402".
001340    02 LINE 13 COLUMN 24 PIC N(18) VALUE
001350       NC" プリンタ占有プログラム起動終了".
001360    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421402".
001370    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521402".
001380    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621402".
001390    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721402".
001400    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821402".
001410*
001420*
001430*
001440************************************************************
001450 PROCEDURE DIVISION.
001460 HAJIME.
001470    DISPLAY HAJIMEDSP WITH BYPASS.
001480    MOVE 0010 TO TIMER.
001490    CALL "CBLTIMER" USING TIMER.
001500    MOVE "PRLOCK,FIL=TESTLML,ATTACH=MANUAL;" TO SPAWN11.
001510    MOVE 0033 TO SPAWN21.
001520    MOVE "MODE=DEFER" TO SPAWN31.
001530    CALL "SYSSPAWN" USING SPAWN-REC1 SPAWN-REC2 SPAWN-REC3.
001540    DISPLAY HAJIMEDSP2 WITH BYPASS.
001550*
001560    CALL "CBLTIMER" USING TIMER.
001570    MOVE "#SPOOL,ATTACH=MANUAL;" TO SPAWN11.
001580    MOVE 0021 TO SPAWN21.
001590    MOVE "MODE=DEFER" TO SPAWN31.
001600    CALL "SYSSPAWN" USING SPAWN-REC1 SPAWN-REC2 SPAWN-REC3.
001610    DISPLAY SPOOLDSP WITH BYPASS.
001620*
001630    CALL "CBLTIMER" USING TIMER.
001640    DISPLAY OWARIDSP WITH BYPASS.
001650*
001660    CALL "CBLTIMER" USING TIMER.
001670    STOP RUN.





1-

BluesBB ©Sting_Band