-
Notifications
You must be signed in to change notification settings - Fork 0
/
PL0011.cbl
138 lines (110 loc) · 3.59 KB
/
PL0011.cbl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
*----------------------------------------------------------------
*| Realizado por..: Fecha:
*| Aplicacion.....:
*| Sistema........:
*| Area...........:
*| Descripcion....:
*| Funcion........:
*|
*----------------------------------------------------------------
*| Mantenimientos efectuados
*| --FECHA-- --RESPONSABLE-- --------DESCRIPCION DE AJUSTE------
*| xx/xx/xx
*| xx/xx/xx
*----------------------------------------------------------------
IDENTIFICATION DIVISION.
PROGRAM-ID. PL0010.
ENVIRONMENT DIVISION.
special-names.
call-convention 74 is winapi.
FILE-CONTROL.
SELECT TEXTVAR
ASSIGN TO TEXTVAR-PATH
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS RESERVADA
ACCESS IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD TEXTVAR.
01 REG-TEXTVAR.
02 CODTBL &LIKE CODTBL
02 ESPACO PIC XX VALUE "0A".
02 ARGBUS &LIKE ARGBUS
02 FUNCIO &LIKE FUNCIO
WORKING-STORAGE SECTION.
01 FF-EURO-G PIC X(6) VALUE "200482".
01 FF-EURO PIC S9(3)V999
REDEFINES FF-EURO-G.
77 OAS-EURO001 PIC S9(12)V999.
77 OAS-EURO002 PIC S9(12)V999.
77 OAS-EURO003 PIC S9(12)V999.
77 OAS-EURO004 PIC S9(12)V999.
77 OAS-EURO005 PIC S9(12)V999.
77 OAS-EURO006 PIC S9(12)V999.
77 OAS-EURO007 PIC S9(12)V999.
77 OAS-EURO008 PIC S9(12)V999.
77 OAS-EURO009 PIC S9(12)V999.
* Registo com nomes dos campos pretendidos no ecran - alterar
01 FROW-WK.
&CAMPOS MSTTBL
77 TEXTVAR-PATH PIC X(256) VALUE SPACES.
77 RESERVADA PIC XX VALUE "00".
* VARIAVEIS AUXILIARES
77 BYTE-1 PIC X.
* Variavel para mensagem de erro
LINKAGE SECTION.
01 PARAM-WRITE.
02 OPERACAO PIC X(6).
02 FICHEIRO PIC X(20).
02 TEXTO PIC X(160).
01 NOVA-VAR PIC X(10).
PROCEDURE DIVISION USING PARAM-WRITE.
INICIO.
*-------
PERFORM INICIALIZACIONES
PERFORM TRATA-PESQ
.
FIN-PROGRAMA.
*-------------
CLOSE TEXTVAR
&COMIT WORK
EXIT PROGRAM.
STOP RUN.
INICIALIZACIONES.
*-----------------
&LDAREA1
STRING "C:\"
"OUTPUTT1" ".TXT"
INTO TEXTVAR-PATH
END-STRING
OPEN OUTPUT TEXTVAR
.
TRATA-PESQ.
*-----------
INITIALIZE REG-MSTTBL
MOVE "USERID" TO CODTBL OF REG-MSTTBL
&STR MSTTBL,MSTTBL01,NL,[1500],CODTBL,
PERFORM VARYING PTR-MSTTBL FROM 1 BY 1 UNTIL PTR-MSTTBL >
IO-NUMREC
MOVE CORR ARR-REG-MSTTBL(PTR-MSTTBL) TO REG-MSTTBL
PERFORM WRITE-TXT
IF PTR-MSTTBL = 1500 THEN
MOVE ARR-REG-MSTTBL(PTR-MSTTBL) TO REG-MSTTBL
&STR MSTTBL,MSTTBL01,GT,[1500],CODTBL,ARGBUS
INITIALIZE PTR-MSTTBL
testes
END-PERFORM
.
WRITE-TXT.
*----------
MOVE CORR REG-MSTTBL TO REG-TEXTVAR
* MOVE X"0D" TO BYTE-1
* MOVE BYTE-1 TO REG-TEXTVAR(4:1)
* MOVE X"0A" TO BYTE-1
* MOVE BYTE-1 TO REG-TEXTVAR(6:1)
WRITE REG-TEXTVAR
.
NADA.
*-----
DISPLAY "NADA"
.