Cobol, Micro Focus 32, dicas
Usando Comandos D.O.S.
Ativa Mouse
Tratamento Janelas
Tratamento Sombras
Registro Bloqueado
Current-Date
High-Values
Leitura Teclado
Caracter Maiusculo
Tabela Cores
String (concatenar)
Receber Parametros D.O.S.
Altera Path atual
Ler diretorio Atual
Arquivo temporario em memoria
Usando Comandos D.O.S.:
01 ws-x91. 03 ws-x91resultado pic 9(02) comp-x value zeroes. 03 ws-x91funcao pic 9(02) comp-x value 15. 03 ws-x91param. 05 ws-x91param1 pic 9(02) comp-x value 12. 05 ws-x91param2 pic x(12) value spaces. 05 ws-x91param2-r redefines ws-x91param2. 07 ws-x91param2n pic x(08). 07 ws-x91param2e pic x(04). 01 ws-resultado pic x(01) comp-x. 01 ws-funcao pic x(01) comp-x value 35. 01 ws-comando. 02 ws-comando1 pic x(01) comp-x value zeroes. 01 ws-linha-comando pic x(24) value spaces. 01 ws-linha-comando-r redefines ws-linha-comando. 02 ws-linha-cmd1 pic x(05). 02 ws-linha-cmd2 pic x(12). 02 ws-linha-cmd3 pic x(07). . . . move 'type ' to ws-linha-cmd1 move label-fprn to ws-linha-cmd2 move ' > lpt1' to ws-linha-cmd3 display ws-linha-comando upon command-line call x"91" using ws-resultado ws-funcao ws-comando.
Ativa Mouse:
. . . 03 ws-mouse-detalhe pic 9(02) comp-x value 67. 03 ws-mouse-posicao. 05 ws-mposx pic 9(04) comp-x. 05 ws-mposy pic 9(04) comp-x. 05 ws-mstatus pic 9(04) comp-x. 03 ws-mouse. 05 ws-mouse-funcao pic 9(02) comp-x. 05 ws-mouse-param pic 9(02) comp-x. . . . move 64 to ws-mouse-funcao. move 1 to ws-mouse-param. call x"af" using ws-mouse-funcao ws-mouse-param. move 66 to ws-mouse-funcao. call x"af" using ws-mouse-funcao ws-mouse-param. . . . accept t01-codigo. if pf-mouse go to r020-mouse-dados. if pf-esc go to r020-fim. if pf-up go to r020-fim. . . . r020-mouse-dados. call x'af' using ws-mouse-detalhe ws-mouse-posicao. add 1 to ws-mposy. add 1 to ws-mposx. if ws-mposy = 04 if ws-mposx = 75 or ws-mposx = 76 or ws-mposx = 77 go to r020-fim.
Tratamento Janelas:
. . . 01 ws-janela. 03 ws-jan-tela pic 9(0004) comp-x value 0. 03 ws-jan-buffer pic x(2000) value spaces. 03 ws-jan-atributos pic x(2000) value spaces. 03 ws-jan-tamanho pic 9(0004) comp-x value 2000. . . . call "CBL_READ_SCR_CHATTRS" using ws-jan-tela ws-jan-buffer ws-jan-atributos ws-jan-tamanho. display tela01. call "CBL_WRITE_SCR_CHATTRS" using ws-jan-tela ws-jan-buffer ws-jan-atributos ws-jan-tamanho.
Tratamento Sombras:
. . . 01 ws-tela-sombra. 03 ws-sombra-posicao. 05 ws-sombra-linha pic x(01) comp-x. 05 ws-sombra-coluna pic x(01) comp-x. 03 ws-sombra-atributo pic x(01) value x'08'. 03 ws-sombra-tamanho pic 9(04) comp-x value zeroes. . . . move 07 to ws-sombra-linha. move 69 to ws-sombra-coluna. move 01 to ws-sombra-tamanho. perform until ws-sombra-linha > 16 call 'cbl_write_scr_n_attr' using ws-sombra-posicao ws-sombra-atributo ws-sombra-tamanho add 1 to ws-sombra-linha end-perform. move 17 to ws-sombra-linha. move 09 to ws-sombra-coluna. move 61 to ws-sombra-tamanho. call 'cbl_write_scr_n_attr' using ws-sombra-posicao ws-sombra-atributo ws-sombra-tamanho.
Registro Bloqueado:
. . . select fcpcom assign to disk organization indexed access dynamic record com-key lock mode manual status fs-com. select fcpcom assign to disk organization indexed access dynamic record com-key lock mode exclusive status fs-com. . . . 03 fs-par pic x(02) value spaces. 03 fs-par-r redefines fs-par. 05 fs-par1 pic x(01). 05 fs-par2 pic 9(02) comp-x. . . . open input fpar. if fs-par not = '00' go to r002-finalizacao. move 1 to par-codigo. read fpar with lock. if fs-par not = '00' close fpar if fs-par1 = '9' if fs-par2 = 68 move 30 to ws-mens-tipo dos * call 'rmsg1' using ws-usuario ws-dados-mensagem dos * cancel 'rmsg1' win * call 'rmsg1w' using ws-usuario ws-dados-mensagem win * cancel 'rmsg1w' go to r001-parametro else move 3 to ws-mens-tipo dos * call 'rmsg1' using ws-usuario ws-dados-mensagem dos * cancel 'rmsg1' win * call 'rmsg1w' using ws-usuario ws-dados-mensagem win * cancel 'rmsg1w' go to r002-finalizacao. move par-casas-decimais to ws-decimais. move par-bloq-estoq-zero to ws-bloq-estoq-zero. close fpar. outro... 03 ws-fale-status. 05 ws-fale-status1 pic x(01) value zeroes. 05 ws-fale-status2 pic x(01) value zeroes. 05 ws-fale-status2-r redefines ws-fale-status2. 07 ws-fale-status3 pic 9(02) comp-x. 03 ws-status-cod pic 9(03) value zeroes. move zeroes to ws-status-cod. if ws-fale-status1 = '9' move ws-fale-status3 to ws-status-cod. read arquivo with no lock key is chave. if ws-fale-status1 not = '0' and ws-fale-status1 = '9' and ws-status-cod = 068 mensagem registro bloqueado.
Current-Date:
03 ws-data-calendario pic x(21) value spaces. 03 ws-data-calendario-r redefines ws-data-calendario. 05 ws-calend-ano pic 9(04). 05 ws-calend-mes pic 9(02). 05 ws-calend-dia pic 9(02). 05 ws-calend-hora pic 9(06). 05 ws-calend-resto pic x(07). move function current-date to ws-data-calendario.
High-Values:
move high-values to chave start arq key is not greater chave read arq previous if status not = 00 go to fim
Leitura Teclado:
01 ws-codigo1 pic 9(04) value zeroes. 01 ws-caracter pic 9(02) comp-x. xxxx. call "cbl_read_kbd_char" using ws-caracter. move ws-caracter to ws-codigo1. if ws-codigo1 = zeroes go to xxxx. display (00, 00) ws-codigo1.
Caracter Maiusculo:
01 ws-fields. 03 ws-xxxxx pic x(40) value spaces. . . . call 'cbl_toupper' using ws-xxxx by value 040. on exception cancel 'cbl_toupper' display 'erro carregar rotina' not on exception cancel 'cbl_toupper'.
Tabela Cores:
background-color / foreground-color 0 - black 1 - blue 2 - green 3 - cyan 4 - red 5 - magenta 6 - brown or yellow 7 - white 03 ws-cfundo. 05 ws-fdo-fdo pic 9(02) value 00. 05 ws-fdo-car pic 9(02) value 07. 03 ws-cmov. 05 ws-mov-fdo pic 9(02) value 03. 05 ws-mov-car pic 9(02) value 00. 03 ws-copc. 05 ws-opc-fdo pic 9(02) value 01. 05 ws-opc-car pic 9(02) value 07. 03 ws-csel. 05 ws-sel-fdo pic 9(02) value 06. 05 ws-sel-car pic 9(02) value 07. 03 ws-cmsg. 05 ws-msg-fdo pic 9(02) value 00. 05 ws-msg-car pic 9(02) value 07.
String (concatenar):
03 ws-fields. 05 ws-path pic x(100) value spaces. 05 ws-label pic x(100) value spaces. 05 ws-saida pic x(100) value spaces. . . . move "c:\usr\cpd\" to ws-path. move "teste.dat" to ws-label. move spaces to ws-saida. String ws-path ws-label Delimited " " Into ws-saida End-String. display ws-saida at 0101. ****** resultado: c:\usr\cpd\teste.dat
Receber Parametro D.O.S.:
03 ws-fields. 05 ws-parametros pic x(100) value spaces. . . . move accept ws-parametros from command-line.
Altera Path Atual:
03 ws-AlteraPath. 05 ws-AlteraPathNew pic x(100). 05 ws-AlteraPathStatus pic x(002) comp-x value zeroes. . . . move "c:\usr\cpd\" to ws-AlteraPathNew. call 'Cbl_Change_Dir' using ws-AlteraPathNew returnig ws-AlteraPathStatus.
Ler diretorio Atual:
03 ws-ReadDir. 05 ws-path-name pic x(128). 05 ws-path-name-length pic x comp-x. 05 ws-status-code pic x(002) comp-5. call "Cbl_Read_Dir" using ws-path-name ws-path-name-length ws-status-code.
Arquivo temporario em memoria:
$SET FILETYPE "14"
Rebuild
Converte IDXFORMAT"4" para LII (Microsoft Focus Level II format) xm rebuild 1fbai.dat, fbai.dat /s:MF4 /t:LII rebuild options: XM Micro Focus COBOL File Management Utility Version 3.4.23 Copyright (C) 1985-1996 Micro Focus Ltd. Conversion Usage: rebuild in-file,out-file [/s..][/o..][/r..][/t..][/k..][/c..][/i][/v] Reorganization of indexed file Usage: rebuild in-file,out-file [/c..][/x..][/i][/v][/d{/k}] Rebuild index Usage: rebuild in-file [/c..][/k..][/i][/v][/e][/q] Display file information Usage: rebuild in-file /n Validation of file Usage: rebuild in-file /f:[cn][dn] Options: /s:source format - index file format of input file MS1, MS2, MS2X, C-ISAM, LII, BTRV, MF or MF4 /t:target format - index file format of output file C-ISAM, LII, BTRV, MF or MF4 /o:organization[i] - for input file - s, r or i [i] for conversion to indexed output /r:Freclen /r:Vminrec-maxrec /k:{{keystart+keylen[,]}*[d][:]}* /x:keyofreference /i - display information /v - display running count /e - continue after duplicate key error /n - no output - just display file information /c:[dn][in] - compression - data or index d - n in range 0-255 i - n in range 0-7 (0 for no compression) /d - rebuild corrupt data file Fixes 9/18 problems. /q - quick rebuild, /i and /e options ignored /f:[cn][dn] - checks integrity of file c - level of checking to perform [0-63] + 1 - Check data file structure + 2 - Check free space [FSL] structure + 4 - Check FSL entries match data file + 8 - Check index file structure +16 - Check index and data match +32 - Check all keys against data file 63 - Do all checks n - level of messages to be displayed [0-5] 0 - No display 1 - Display errors