boa tarde,
esqueci de postar o código da package PCK_ARQUIVO, utilizada pela procedure para incluir linhas em um arquivo e executa-lo.
Selecionar tudo
PACKAGE pck_arquivo IS
-- Atributos
diretorio varchar2(500);
nome varchar2(500);
extensao varchar2(5);
caminho varchar2(1005);
function alterar_pontuacao_decimal(par_valor number) return varchar2;
procedure prc_busca;
procedure prc_insere_log(par_comando varchar2);
procedure prc_determina_diretorio(par_caminho_diretorio varchar2);
procedure prc_executa(par_caminho_arquivo varchar2 default null);
procedure prc_determina_atributos(par_caminho_arquivo in out varchar2);
procedure prc_executa_host(par_descricao_comando varchar2,
par_sincrono boolean default false);
procedure prc_abrir(par_ds_metodo varchar2);
--
procedure prc_incluir_linha(par_ds_valor varchar2);
--
procedure prc_encerrar;
END;
PACKAGE BODY pck_arquivo IS
out_file text_io.file_type;
function fnc_existe_diretorio(i_diretorio varchar2) return boolean is
out_file Text_IO.File_Type;
begin
out_file := Text_IO.Fopen(i_diretorio || 'temp.txt', 'w');
Text_IO.Fclose(out_file);
host('del ' || i_diretorio || 'temp.txt', no_screen);
return true;
exception
when others then
Text_IO.Fclose(out_file);
return false;
end;
function fnc_existe_arquivo(i_caminho_arquivo varchar2, i_tipo_metodo varchar2 default 'R') return boolean is
out_file Text_IO.file_type;
begin
out_file := Text_IO.Fopen(i_caminho_arquivo, i_tipo_metodo);
Text_IO.Fclose(out_file);
return true;
exception
when others then
Text_IO.Fclose(out_file);
return false;
end;
function alterar_pontuacao_decimal(par_valor number) return varchar2 is
begin
return ltrim(rtrim(to_char(par_valor, '999G999G990D00', 'NLS_NUMERIC_CHARACTERS=,.')));
end;
--
-- Metodos Privados
procedure prc_inicializa_atributos is
begin
diretorio := null;
nome := null;
extensao := null;
end;
procedure prc_determina_atributos(par_caminho_arquivo in out varchar2) is
begin
diretorio := substr(par_caminho_arquivo, 1, instr(par_caminho_arquivo, '\', -1));
nome := substr(par_caminho_arquivo,
instr(par_caminho_arquivo, '\', -1) + 1,
instr(par_caminho_arquivo, '.', -1) - instr(par_caminho_arquivo, '\', -1) - 1);
extensao := substr(par_caminho_arquivo, instr(par_caminho_arquivo, '.', -1) - length(par_caminho_arquivo));
if extensao is null or length(extensao) < 3 then
extensao := 'csv';
end if;
--
if ltrim(rtrim(diretorio)) is null then
diretorio := 'c:\Temp\';
end if;
--
pck_arquivo.prc_determina_diretorio(diretorio);
--
if par_caminho_arquivo is not null and not pck_arquivo.fnc_existe_arquivo(par_caminho_arquivo, 'W') then
nome := null;
end if;
if nome is null then
dbms_random.initialize(to_char(sysdate, 'ss'));
nome := 'Planilha_'||abs(dbms_random.random);
end if;
--
caminho := diretorio||nome||'.'||extensao;
par_caminho_arquivo := caminho;
end prc_determina_atributos;
procedure prc_valida_atributos is
begin
if pck_arquivo.diretorio is null or pck_arquivo.nome is null or pck_arquivo.extensao is null then
fgalproc(3, 'Todos atributos do arquivo devem estar preenchidos.');
end if;
end;
procedure prc_gera_erro_log(par_msg_erro varchar2) is
out_file Text_IO.File_Type;
va_caminho_arq_erro varchar2(200) := pck_arquivo.diretorio || 'temp.txt';
begin
out_file := Text_IO.Fopen(va_caminho_arq_erro, 'w');
Text_IO.Put_Line(out_file, par_msg_erro);
Text_IO.Fclose(out_file);
fgalproc(3,
'Erro ao popular o arquivo ' || pck_arquivo.diretorio || pck_arquivo.nome || '.' || pck_arquivo.extensao || '. Erro: ' || par_msg_erro);
exception
when others then
Text_IO.Fclose(out_file);
end;
--
procedure prc_insere_log(par_comando varchar2) is
out_file text_io.file_type;
va_arquivo_log varchar2(100):='c:\Temp\log_execucao.txt';
begin
if fnc_existe_arquivo(va_arquivo_log) then
out_file:=text_io.fopen(va_arquivo_log, 'A');
else
out_file:=text_io.fopen(va_arquivo_log, 'W');
end if;
Text_IO.Put_Line(out_file, TO_CHAR(SYSDATE, 'DD/MM/YYYY HH24:MI:SS')||' - '||par_comando);
Text_IO.FClose(out_file);
exception
when others then
Text_IO.FClose(out_file);
fgalproc(1, 'Erro: '||sqlerrm);
end;
--
-- Metodos públicos
procedure prc_busca is
va_caminho_arquivo varchar2(1000);
begin
if pck_arquivo.diretorio is null then
pck_arquivo.diretorio := 'C:\';
end if;
prc_inicializa_atributos;
va_caminho_arquivo := get_file_name(directory_name => pck_arquivo.diretorio,
file_name => null,
file_filter => 'Todos os arquivos (*.*)|*.*|',
message => null,
dialog_type => open_file,
select_file => true);
if va_caminho_arquivo is not null then
prc_determina_atributos(va_caminho_arquivo);
end if;
end;
procedure prc_determina_diretorio(par_caminho_diretorio in varchar2) is
va_caminho_arquivo varchar2(1000);
i number := 0;
begin
-- Determina em qual pasta o arquivo é descarregado
if par_caminho_diretorio is null then
pck_arquivo.diretorio := 'C:\Temp\';
else
pck_arquivo.diretorio := par_caminho_diretorio;
end if;
if not fnc_existe_diretorio(pck_arquivo.diretorio) then
host('mkdir ' || pck_arquivo.diretorio, no_screen);
end if;
--
if not fnc_existe_diretorio(pck_arquivo.diretorio) then
loop
pck_arquivo.diretorio := get_file_name(directory_name => pck_arquivo.diretorio,
file_name => null,
file_filter => null,
message => 'Selecione um diretório com permissão de escrita',
dialog_type => open_file,
select_file => false);
if pck_arquivo.diretorio is not null then
pck_arquivo.diretorio := pck_arquivo.diretorio || '\';
exit when fnc_existe_diretorio(pck_arquivo.diretorio);
fgalproc(1, 'Não foi possível baixar o arquivo para a pasta ' || pck_arquivo.diretorio || '. Selecione outra pasta.');
else
exit;
end if;
end loop;
end if;
end;
procedure prc_executa(par_caminho_arquivo varchar2 default null) is
ole_item ITEM;
va_caminho_arquivo varchar2(1002):=pck_arquivo.caminho;
begin
pck_arquivo.prc_encerrar;
if par_caminho_arquivo is not null then
va_caminho_arquivo := par_caminho_arquivo;
end if;
ole_item := FIND_ITEM('OLE_ARQUIVO');
IF NOT ID_NULL(ole_item) THEN
Forms_OLE.Initialize_Container(ole_item, va_caminho_arquivo);
END IF;
IF Forms_OLE.Server_Active(ole_item) = FALSE THEN
Forms_OLE.Activate_Server(ole_item);
END IF;
--
Forms_OLE.Exec_Verb(ole_item, 1);
--Forms_OLE.Exec_Verb(ole_item,'Edit');
--
end;
procedure prc_executa_host(par_descricao_comando varchar2,
par_sincrono boolean default false) is
begin
prc_insere_log(par_descricao_comando);
if par_sincrono then
host(par_descricao_comando, no_screen);
else
host(par_descricao_comando);
end if;
end;
--
procedure prc_abrir(par_ds_metodo varchar2) is
begin
pck_arquivo.prc_valida_atributos;
out_file := Text_IO.Fopen(pck_arquivo.caminho, par_ds_metodo);
end;
--
procedure prc_incluir_linha(par_ds_valor varchar2) is
begin
if not Text_IO.Is_Open(out_file) then
prc_abrir('W');
end if;
Text_IO.Put_Line(out_file, par_ds_valor);
end;
--
procedure prc_encerrar is
begin
if Text_IO.Is_Open(out_file) then
Text_IO.Fclose(out_file);
end if;
end;
end;
Pré-requisitos para utilizar a procedure prc_executa:
1) Inclua um item do tipo OLE CONTAINER em qualquer bloco, preferencialmente em um bloco do tipo controle com uma única linha.
2) Renomeie este item para OLE_ARQUIVO;
Inclua em algum bloco de sua aplicação um item do tipo OLE CONTAINER OLE_ARQUIVO
