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

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

000010 IDENTIFICATION DIVISION.
000020***************************************************************
000030* プリンタ占有プログラム (PRINTER LOCK) *
000040***************************************************************
000050* 作成者 江須扇
000060* 作成日 2003年10月26日
000070 PROGRAM-ID. PRLOCK.
000080 ENVIRONMENT DIVISION.
000090 CONFIGURATION SECTION.
000100 SOURCE-COMPUTER. EXPRES5800.
000110 OBJECT-COMPUTER. EXPRES5800.
000120 INPUT-OUTPUT SECTION.
000130 FILE-CONTROL.
000140    SELECT LP-F ASSIGN TO LP-PRN999.
000150 I-O-CONTROL.
000160    APPLY SHIFT-CODE ON LP-F.
000170 DATA DIVISION.
000180 FILE SECTION.
000190 FD LP-F
000200    LABEL RECORD OMITTED
000210 LINAGE IS 66 LINES.
000220 01 LP-REC.
000230    03 FILLER PIC X(200).
000240 WORKING-STORAGE SECTION.
000250 01 TIMER PIC 9(04).
000260*
000270*
000280 SCREEN SECTION .
000290 SD GAMEN END STATUS IS ENDSTS.
000300 01 HAJIMEDSP CLEAR SCREEN.
000310    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101004".
000320    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101407".
000330    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0325402".
000340    02 LINE 03 COLUMN 25 PIC N(18) VALUE
000350        NC">>PRN999プリンタ占有<<".
000360    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0357407".
000370 01 HAJIMEDSP2.
000380    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101004".
000390    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0101407".
000400    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0325402".
000410    02 LINE 03 COLUMN 25 PIC N(18) VALUE
000420        NC">>PRN999プリンタ占有<<".
000430    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0357407".
000440    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0721164".
000450    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0721404".
000460    02 LINE 07 COLUMN 24 PIC N(18) VALUE
000470        NC"   ※ 状 態 表 示 ※".
000480    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0761104".
000490    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0761407".
000500    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821104".
000510    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0821401".
000520    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0861100".
000530    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0862000".
000540    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0863004".
000550    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0863407".
000560    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921104".
000570    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0921401".
000580    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0961100".
000590    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0962000".
000600    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0963004".
000610    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"0963407".
000620    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021104".
000630    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1021401".
000640    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1061100".
000650    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1062000".
000660    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1063004".
000670    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1063407".
000680    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121104".
000690    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1121401".
000700    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1161100".
000710    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1162000".
000720    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1163004".
000730    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1163407".
000740    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221104".
000750    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1221401".
000760    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1261100".
000770    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1262000".
000780    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1263004".
000790    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1263407".
000800    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321106".
000810    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1321401".
000820    02 LINE 13 COLUMN 24 PIC N(18) VALUE
000830        NC"  PRN999プリンタ占有中".
000840    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1361100".
000850    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1362000".
000860    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1363004".
000870    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1363407".
000880    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421104".
000890    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1421401".
000900    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1461100".
000910    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1462000".
000920    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1463004".
000930    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1463407".
000940    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521104".
000950    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1521401".
000960    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1561100".
000970    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1562000".
000980    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1563004".
000990    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1563407".
001000    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621104".
001010    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1621401".
001020    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1661100".
001030    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1662000".
001040    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1663004".
001050    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1663407".
001060    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721104".
001070    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1721401".
001080    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1761100".
001090    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1762000".
001100    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1763004".
001110    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1763407".
001120    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821144".
001130    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1821401".
001140    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1861100".
001150    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1862000".
001160    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1863004".
001170    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1863407".
001180    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1922000".
001190    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1963004".
001200    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"1963407".
001210    02 LINE 01 COLUMN 01 PIC X(09) VALUE ""27E2"2221006".
001220    02 LINE 22 COLUMN 24 PIC N(18) VALUE
001230        NC" どれかのPFキーを押してください。".
001240************************************************************
001250 PROCEDURE DIVISION.
001260 HAJIME.
001270    DISPLAY HAJIMEDSP WITH BYPASS.
001280    MOVE 0010 TO TIMER.
001290    CALL "CBLTIMER" USING TIMER.
001300    OPEN OUTPUT LP-F.
001310*
001320 OWARI.
001330    DISPLAY HAJIMEDSP2 WITH BYPASS.
001340    CALL "CBLTIMER" USING TIMER.
001350    IF FUNCTION-KEY = ""FF"" OR ""00"" GO TO OWARI.
001360    CLOSE LP-F.
001370    STOP RUN.




1-

BluesBB ©Sting_Band