Saudações... Estou postando aqui para quem precisar ou simplesmente for curioso como eu, uma aplicação que desenvolvi para referencia cruzada. Com ela é possível por exemplo saber qual programa acessa tal tabela, ou qual programa x chama o programa y. É possível, por exemplo, gerar uma lista de programas que tem a include X e compilá-los. Entre outras possibilidades. Qualquer dúvida estou a disposição... Definição da tabela utilizada para armazenar as informações do xref: Código: UPDATE DATABASE "?" ADD TABLE "x_ref" AREA "Schema Area" DUMP-NAME "x_ref" ADD FIELD "programa" OF "x_ref" AS character FORMAT "x(40)" INITIAL "" LABEL "Programa" POSITION 2 SQL-WIDTH 24 ORDER 10 ADD FIELD "arquivo" OF "x_ref" AS character FORMAT "x(40)" INITIAL "" LABEL "Arquivo" POSITION 3 SQL-WIDTH 80 ORDER 30 ADD FIELD "linha" OF "x_ref" AS integer FORMAT ">>>>9" INITIAL "0" LABEL "Linha" POSITION 4 SQL-WIDTH 4 ORDER 40 ADD FIELD "tipo" OF "x_ref" AS character FORMAT "x(12)" INITIAL "" LABEL "Tipo" POSITION 5 SQL-WIDTH 24 ORDER 50 ADD FIELD "objeto" OF "x_ref" AS character FORMAT "x(40)" INITIAL "" LABEL "Objeto" POSITION 6 SQL-WIDTH 80 ORDER 60 ADD FIELD "dt-xref" OF "x_ref" AS date FORMAT "99/99/9999" INITIAL ? LABEL "Data" POSITION 7 SQL-WIDTH 4 ORDER 70 ADD FIELD "hr-xref" OF "x_ref" AS integer FORMAT "99,999" INITIAL "0" LABEL "Hora" POSITION 8 SQL-WIDTH 4 ORDER 80 ADD FIELD "path" OF "x_ref" AS character FORMAT "x(50)" INITIAL "" LABEL "Path" POSITION 9 SQL-WIDTH 100 ORDER 20 ADD INDEX "programa" ON "x_ref" AREA "Schema Area" PRIMARY INDEX-FIELD "programa" ASCENDING INDEX-FIELD "arquivo" ASCENDING INDEX-FIELD "linha" ASCENDING INDEX-FIELD "objeto" ASCENDING INDEX-FIELD "tipo" ASCENDING ADD INDEX "objeto" ON "x_ref" AREA "Schema Area" INDEX-FIELD "objeto" ASCENDING INDEX-FIELD "tipo" ASCENDING INDEX-FIELD "programa" ASCENDING ADD INDEX "w_obj" ON "x_ref" AREA "Schema Area" WORD INDEX-FIELD "objeto" ASCENDING . PSC cpstream=ISO8859-1 . 0000001604 Programa xref.p Código: /*============================================================================== Programa...: xref Descricao..: Gerenciador de referencia cruzada XREF e compila‡ao Autor......: Jefferson Ferreira Alegria Data.......: 19/05/2008 Obs........: ==============================================================================*/ def temp-table t-prog field nome as char field path as char field data as date field hora as int field tamanho as int index pk is unique primary nome. def menu mnu-pop dcolor 3 pfcolor 1 menu-item mnu-compila label '&Compilar programa' menu-item mnu-list-prog label '&Lista de programas' rule menu-item mnu-about label '&Sobre xref.p...'. FUNCTION File-Size return char (size as int) FORWARD. /* -------------------------------------------------------------------------- */ def var v-prog like x_ref.programa view-as fill-in size 12 by 1. def var v-obj like x_ref.objeto view-as fill-in size 24 by 1. def var v-tipo like x_ref.tipo view-as combo-box inner-lines 10. def query br-xref for x_ref. def browse br-xref query br-xref disp x_ref.programa format 'X(12)' x_ref.linha x_ref.tipo x_ref.objeto format 'X(45)' with size 80 by 17 no-box. def rect linha1 size 80 by 1 graphic-edge. def rect linha2 size 80 by 1 graphic-edge. def var v-title as char format 'X(80)' view-as text. def frame f-main v-title at col 01 row 01 no-label dcolor 1 v-prog at col 02 row 03 v-tipo at col 25 row 03 v-obj at col 48 row 03 br-xref at col 01 row 05 help ' ENTER=VISUALIZAR LINHA NO ARQUIVO' linha1 at col 01 row 04 linha2 at col 01 row 22 with size 80 by 22 at col 1 row 1 no-box side-labels. /* -------------------------------------------------------------------------- */ def var txt as char view-as editor size 80 by 17 buffer-chars 400 pfcolor 3. def frame f-view txt at col 01 row 01 help ' F4=RETORNAR' with size 80 by 17 at col 01 row 05 dcolor 3 no-box no-labels overlay. /* -------------------------------------------------------------------------- */ def var v-path as char format 'X(50)' view-as fill-in size 47 by 1. def button bt-compila label 'F1-Compila' auto-go. def button bt-compf4 label 'F4-Cancelar' auto-endkey. def button bt-lista label 'Carrega lista'. def query q-progs for t-prog. def browse br-progs query q-progs disp t-prog.nome format 'X(20)' string(t-prog.data,'99/99/9999') + ' ' + string(t-prog.hora,'HH:MM:SS') format 'X(19)' File-Size(t-prog.tamanho) format 'X(12)' with size 56 by 08 no-box no-labels multiple. def rect linha3 size 54 by 1 graphic-edge. def rect linha4 size 54 by 1 graphic-edge. def frame f-compila v-path at col 02 row 02 label 'Pasta' linha3 at col 02 row 03 pfcolor 3 linha4 at col 02 row 12 pfcolor 3 br-progs at col 01 row 04 help ' ESPA€O=MARCA/DESMARCA CTRL-A=TODOS/NENHUM' bt-compila at col 14 row 13 bt-lista at col 27 row 13 bt-compf4 at col 43 row 13 with size 58 by 15 row 7 view-as dialog-box dcolor 3 side-labels title dcolor 3 ' Compila programas '. /*============================================================================== TRIGGERS ==============================================================================*/ on return of v-tipo apply 'TAB' to self. on return of v-obj apply 'GO' to frame f-main. on go of frame f-main do: assign v-prog v-tipo v-obj. run Browse. return no-apply. end. /* -------------------------------------------------------------------------- */ on value-changed of br-xref in frame f-main do: hide message no-pause. message (if avail x_ref then string(x_ref.arquivo, ' X(56) ') + chr(179) + ' ' + string(x_ref.dt-xref,'99/99/9999') + ' ' + string(x_ref.hr-xref,'HH:MM:SS') + ' ' else ''). end. /* -------------------------------------------------------------------------- */ on default-action of br-xref do: do on endkey undo, leave with frame f-view: txt:read-file(x_ref.arquivo). txt:cursor-offset = txt:convert-to-offset(x_ref.linha,1). txt:visible = true. disable all. enable txt. wait-for 'GO' of frame f-main focus txt. end. hide frame f-view. apply 'value-changed' to br-xref. end. /* -------------------------------------------------------------------------- */ on choose of menu-item mnu-compila run Compila. on choose of menu-item mnu-list-prog run Lista-Programas. /* -------------------------------------------------------------------------- */ on choose of menu-item mnu-about do: message color reverse skip 'Desenvolvido por: ' skip ' Jefferson Ferreira Alegria' skip ' jeffersonalegria@gmail.com' skip(1) view-as alert-box title ' XREF '. end. /* -------------------------------------------------------------------------- */ on go of frame f-compila do: if br-progs:num-selected-rows < 1 then do: message 'Nenhum programa selecionado' view-as alert-box title ''. return no-apply. end. end. on leave of v-path do: assign v-path. close query q-progs. file-info:file-name = v-path. if file-info:full-pathname = ? then do: message color reverse 'Pasta nao encontrada' view-as alert-box title ''. return no-apply. end. run Refresh-Files(v-path). end. on value-changed of br-progs do: apply 'cursor-down' to self. return no-apply. end. on CTRL-A of br-progs do: if self:num-selected-rows = num-results("q-progs") then self:deselect-rows(). else self:select-all(). end. on choose of bt-lista run Load-Lista. /*============================================================================== MAIN-BLOCK ==============================================================================*/ MAIN-BLOCK: DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK WITH FRAME f-main: run Inicio. disp v-title. enable all. apply 'VALUE-CHANGED' to br-xref. wait-for 'CLOSE' of this-procedure. END. hide all. pause 0. /*============================================================================== P R O C E D U R E S ==============================================================================*/ PROCEDURE Inicio: def var i as int. &scoped-define tipos ",ACCESS,CREATE,DELETE,FUNCTION,GLOBAL-VARIABLE,INCLUDE,NEW-SHR-TEMP,NEW-SHR-V ARIABLE,NEW-SHR-WORK,PROCEDURE,REFERENCE,RUN,SEARCH,SHR-TEMPTABLE,SHR-WORKFILE,SORT-ACCESS,SORT-BY-EXP,UPDATE" v-tipo:add-last({&tipos}) in frame f-main. v-title = string('XREF - Referencia Cruzada',' X(57) ') + chr(179) + ' F12=MENU DE OP€OES'. menu mnu-pop:popup-only = true. current-window:popup-menu = menu mnu-pop:handle. current-window:menu-key = 'F12'. txt:read-only in frame f-view = true. file-info:file-name = '.'. v-path = file-info:full-pathname. status input off. END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Browse: assign v-prog = (if v-prog = ? then '' else trim(v-prog)) v-obj = (if v-obj = ? then '' else trim(v-obj)). disp v-prog v-obj with frame f-main. if v-obj > ' ' then open query br-xref preselect each x_ref no-lock where x_ref.objeto contains v-obj + "*" and (v-tipo = '' or x_ref.tipo = v-tipo) and (v-prog = '' or x_ref.programa begins v-prog) by x_ref.programa by x_ref.linha. else if v-prog > ' ' then open query br-xref preselect each x_ref no-lock where x_ref.programa begins v-prog and (v-tipo = '' or x_ref.tipo = v-tipo) by x_ref.programa by x_ref.linha. else open query br-xref preselect each x_ref no-lock where x_ref.tipo = v-tipo by x_ref.programa by x_ref.linha. apply 'VALUE-CHANGED' to br-xref. apply 'ENTRY' to br-xref. END PROCEDURE. /* -------------------------------------------------------------------------- */ FUNCTION ProgressBar RETURNS LOG (msg as char, pct as dec): def var p as int. p = max(0, min(50, int(trunc(pct / 2, 0)))). msg = ' ' + (if trim(msg) > ' ' then trim(msg) else 'Processando...'). hide message no-pause. message color normal msg. message color normal ' ' + fill(chr(219),p) + fill(chr(177),50 - p). return true. END FUNCTION. /* -------------------------------------------------------------------------- */ PROCEDURE Compila: def var i as int. menu mnu-pop:sensitive = false. do on endkey undo, leave with frame f-compila: disp v-path. enable all. apply 'LEAVE' to v-path. wait-for 'go' of frame f-compila focus v-path. status default ''. do i = 1 to br-progs:num-selected-rows: br-progs:fetch-selected-row(i). ProgressBar('Compilando ' + t-prog.path + '...', dec(i) / dec(br-progs:num-selected-rows) * 100). run Compila-File(t-prog.path). end. hide message no-pause. end. hide frame f-compila. menu mnu-pop:sensitive = true. END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Compila-File: def input param p-file as char. compile value(p-file) xref "./xref". run Atualiza-Xref(p-file). os-delete './xref'. END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Atualiza-Xref: def input param p-file as char. def var c as char extent 8. def var p as char. def var dt as date. def var hr as int. &scoped-define ignorar "CPINTERNAL,CPSTREAM,COMPILE,STRING,DLL-ENTRY,PUBLISH,SUBSCRIBE,UNSUBSCRIBE,SHR-FRAME,NEW-SHR-FRAME,SHR-WORKTABLE,NEW-SHR-WORKTABLE,EXTERN" assign dt = today hr = time p = entry(num-entries(p-file,'/'),p-file,'/'). for each x_ref where x_ref.programa = p: delete x_ref. end. input from './xref'. repeat: import c[1] c[2] c[3] c[4] c[5] c[6] c[7] c[8]. if lookup(c[4], {&ignorar}) > 0 then next. if lookup(c[4],'CREATE,DELETE,ACCESS,SORT-ACCESS,REFERENCE,UPDATE') > 0 and c[5] = 'TEMPTABLE' or c[5] = 'WORKTABLE' or c[6] = 'TEMPTABLE' or c[6] = 'WORKTABLE' or c[7] = 'TEMPTABLE' or c[7] = 'WORKTABLE' or c[8] = 'TEMPTABLE' or c[8] = 'WORKTABLE' then next. p = entry(num-entries(c[1],'/'),c[1],'/'). create x_ref. assign x_ref.programa = p x_ref.path = c[1] x_ref.arquivo = c[2] x_ref.linha = int(c[3]) x_ref.tipo = c[4] x_ref.objeto = substr(c[5],1,50) x_ref.dt-xref = dt x_ref.hr-xref = hr. if lookup(c[4],'ACCESS,SORT-ACCESS,REFERENCE,UPDATE,SEARCH') > 0 then if c[5] = 'SHARED' then x_ref.objeto = c[5] + ' ' + c[6]. else x_ref.objeto = c[5] + '.' + c[6]. if c[4] = 'SEARCH' and c[7] = 'WHOLE-INDEX' then x_ref.objeto = x_ref.objeto + ' ' + 'WHOLE-INDEX'. if c[4] = 'RUN' then x_ref.objeto = lc(x_ref.objeto). if c[4] = 'PROCEDURE' then x_ref.objeto = entry(1,c[5]). end. input close. END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Lista-Programas: if not query br-xref:is-open or num-results("br-xref") < 1 then do: message color reverse 'Nenhum programa disponivel' view-as alert-box title ''. return. end. empty temp-table t-prog. output to ./lista.xref. get first br-xref. do while avail(x_ref): if not can-find(first t-prog where t-prog.nome = x_ref.path) then do: create t-prog. assign t-prog.nome = x_ref.path. put unformatted x_ref.path skip. end. get next br-xref. end. output close. message color reverse "Lista de programas salva" skip "no arquivo 'lista.xref'" view-as alert-box title ''. END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Load-Lista: def var c as char. if search('./lista.xref') = ? then do: message "Lista 'lista.xref' nao encontrada" view-as alert-box title ''. return. end. apply 'ENTRY' to br-progs in frame f-compila. empty temp-table t-prog. input from "./lista.xref". repeat: import unformatted c. file-info:file-name = c. if file-info:full-pathname = ? then next. if can-find(first t-prog where t-prog.nome = file-info:full-pathname) then next. create t-prog. assign t-prog.nome = entry(num-entries(file-info:file-name,'/'), file-info:file-name, '/') t-prog.path = file-info:full-pathname t-prog.data = file-info:file-mod-date t-prog.hora = file-info:file-mod-time t-prog.tamanho = file-info:file-size. end. input close. open query q-progs preselect each t-prog. br-progs:select-all(). END PROCEDURE. /* -------------------------------------------------------------------------- */ PROCEDURE Refresh-Files: def input param p-path as char. def var a as char extent 3. empty temp-table t-prog. input from os-dir(p-path). repeat: import a[1] a[2] a[3]. if a[3] <> 'F' then next. if num-entries(a[1],'.') < 2 then next. if entry(num-entries(a[1],'.'),a[1],'.') <> 'p' then next. file-info:file-name = a[2]. if can-find(first t-prog where t-prog.nome = a[1]) then next. create t-prog. assign t-prog.nome = a[1] t-prog.path = a[2] t-prog.data = file-info:file-mod-date t-prog.hora = file-info:file-mod-time t-prog.tamanho = file-info:file-size. end. input close. open query q-progs preselect each t-prog. END PROCEDURE. /* -------------------------------------------------------------------------- */ FUNCTION File-Size return char (size as int): def var d as dec. def var i as int initial 1. def var rv as char. d = size. do while d > 1024: d = d / 1024. i = i + 1. end. rv = fill(' ',80) + trim(string(d, if i = 1 then '>,>>9' else '>>>,>>>,>>9.99')) + entry(i,', KB, MB, GB'). return substr(rv, length(rv) - 11, 12). END FUNCTION.
