Asunto: Extraer - Get documentos de tabla Oracle LONG RAW con Delphi
Tengo una tabla de Oracle con un campo de tipo LONG RAW, estoy buscando alguna aplicación que obtenga / extraiga el documento de ese campo LONG RAW, pero quiero que sea capaz de extraer todos los documentos de la tabla. Esta tabla también tiene un campo de tipo VARCHAR2 que contiene el nombre del documento que se guardó.
Me gustaría poder guardar los documentos extraídos en diferentes carpetas, según el inicio del nombre del documento.
Me gustaría que la aplicación pudiera generar y guardar los respectivos documentos según el "FACT", "CONTA", "CAJA".
¿hay algo por Internet que haga esto o parecido en Delphi?
Nota: utilizo ODBC para conectarme a Oracle con Delphi.
Publicado:
Vie May 04, 2007 5:41 am
alonsojpd Administrador/Moderador
Registrado: Sep 16, 2003 Mensajes: 2687
Asunto: Re: Extraer - Get documentos de tabla Oracle LONG RAW con De
Anuncios
varios escribió:
Tengo una tabla de Oracle con un campo de tipo LONG RAW, estoy buscando alguna aplicación que obtenga / extraiga el documento de ese campo LONG RAW, pero quiero que sea capaz de extraer todos los documentos de la tabla. Esta tabla también tiene un campo de tipo VARCHAR2 que contiene el nombre del documento que se guardó.
Me gustaría poder guardar los documentos extraídos en diferentes carpetas, según el inicio del nombre del documento.
Me gustaría que la aplicación pudiera generar y guardar los respectivos documentos según el "FACT", "CONTA", "CAJA".
¿hay algo por Internet que haga esto o parecido en Delphi?
Nota: utilizo ODBC para conectarme a Oracle con Delphi.
Te adjuntamos el código fuente completo de una de nuestras aplicaciones, que en breve colocaremos en la zona de descargas. Más o menos hace lo que propones, es muy configurable:
* Admite cualquier ODBC (probado con Oracle y MySQL).
* Se le puede indicar el nombre del campo que contiene el fichero y el del campo que contiene el nombre del fichero.
* Conexión con la Base de Datos por ODBC configurable (usuario, contraseña, etc).
* Carpeta de destino de la extracción de documentos, también lista con asignación de carpetas según un criterio (caracteres de inicio y fin del nombre del fichero).
* Ejecuta cualquier consulta SQL para extraer todos los documentos del resultado o sólo uno seleccionado.
* Pestaña con log del resultado de la extracción.
* Reemplazar / no reemplazar documentos existentes en destino.
* Etc
El código fuente complento en Delphi 6, sin utilizar ningún componente adicional, sólo: TSaveDialog, TOpenDialog, TDataSource, TQuery, TDatabase, TButton, TBitBtn, TMemo, TDBGrid, TValueListEditor, TCheckBox, TStaticText y TEdit:
//Lee una cadena de texto de un INI
function leCadINI (clave, cadena : string; defecto : string) : string;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := readString (clave, cadena, defecto);
finally
free;
end;
end;
//Lee un entero de un INI
function leEntINI (clave, cadena : string; defecto : integer) : integer;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := readInteger (clave, cadena, defecto);
finally
free;
end;
end;
//Lee un booleano de un INI
function leBoolINI (clave, cadena : string; defecto : boolean) : boolean;
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
result := readbool (clave, cadena, defecto);
finally
free;
end;
end;
//escribe un Booleano en un INI
procedure esBoolINI (clave, cadena : string; valor : boolean);
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
writeBool (clave, cadena, valor);
finally
free;
end;
end;
//Escribe un entero en un INI
procedure esEntINI (clave, cadena : string; valor : integer);
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
writeInteger (clave, cadena, valor);
finally
free;
end;
end;
//escribe una cadena de texto en un INI
procedure esCadINI (clave, cadena, valor : string);
begin
with tinifile.create (changefileext(paramstr(0),'.INI')) do
try
writeString (clave, cadena, valor);
finally
free;
end;
end;
function TformMenuPrincipal.obtenerCarpetaDestinoAsignada (codigo : string) : string;
var i : integer;
begin
Result := '';
for i := 1 to tablaAsignacion.RowCount - 1 do
if tablaAsignacion.Cells [0, i] = codigo then
Result := tablaAsignacion.Cells [1,i] + '\';
end;
procedure TformMenuPrincipal.bExtraerActualClick(Sender: TObject);
var
documentoExtraer : string;
rutaDocumentoExtraer : string;
campoCLOB : string;
campoNombre : string;
begin
if tcConsulta.Active then
begin
campoCLOB := txtNombreCampoCLOB.Text;
campoNombre := txtNombreCampoDocumento.Text;
if tcConsulta.FieldByName(campoCLOB).IsBlob then
begin
if tcConsulta.fieldbyname(campoCLOB).IsNull then
MessageDlg('El registro seleccinado no tiene documento asociado.',
mtWarning, [mbok], 0)
else
begin
try
documentoExtraer := tcConsulta.fieldbyname(campoNombre).AsString;
rutaDocumentoExtraer := txtRuta.text + '\' + documentoExtraer;
TBlobField (tcConsulta.FieldByName(campoCLOB)).SaveToFile
(rutaDocumentoExtraer);
MessageDlg('Se ha extraído correctamente el documento: ' +
chr(13)+ chr(13) + rutaDocumentoExtraer, mtInformation, [mbok], 0);
except
raise;
end;
end;
end
else
MessageDlg('El campo [' + txtNombreCampoCLOB.Text +
'] no es de tipo CLOB, RAW.', mtWarning, [mbok], 0);
end
else
MessageDlg('No hay datos para extraer. Ejecute una consulta SQL ' +
'antes de extraer el documento.', mtWarning, [mbok], 0);
end;
begin
if tcConsulta.Active then
begin
nombreCampoDoc := txtNombreCampoDocumento.Text;
nombreCampoLob := txtNombreCampoCLOB.Text;
if not tcConsulta.FieldByName(nombreCampoLob).IsBlob then
MessageDlg('El campo [' + nombreCampoLob +
'] no es de tipo CLOB, RAW.', mtWarning, [mbok], 0)
else
begin
if MessageDlg('Se van a extraer todos los documentos de los ' +
'registros de la consulta SQL actual ¿desea continuar ' +
'con el proceso?', mtConfirmation, [mbyes,mbno], 0) = mryes then
begin
Screen.Cursor := crHourGlass;
tcConsulta.DisableControls;
tcConsulta.First;
nombreCampoDoc := txtNombreCampoDocumento.Text;
rutaRaiz := txtRuta.text + '\';
if opSepararDocumentos.Checked then
begin
posIni := strtoint(txtDiscriminarPosInicio.Text);
nCaracteres := strtoint(txtDiscriminarnCaracteres.Text);
end
else
begin
posIni := 0;
nCaracteres := 0;
end;
while not tcConsulta.Eof do
begin
try
nombreDoc := tcConsulta.fieldbyname(nombreCampoDoc).AsString;
subcarpetaIniFin := '';
if opSepararDocumentos.Checked then
begin
subcarpetaIniFin := copy (nombreDoc, posIni, nCaracteres);
subcarpetaAsignacion := obtenerCarpetaDestinoAsignada (subcarpetaIniFin);
if subcarpetaAsignacion <> '' then
begin
if not DirectoryExists(subcarpetaAsignacion) then
MkDir(subcarpetaAsignacion);
end;
subcarpetaIniFin := subcarpetaIniFin + '\';
if not DirectoryExists(rutaRaiz + subcarpetaIniFin) then
MkDir(rutaRaiz + subcarpetaIniFin);
end;
rutaSubcarpeta := rutaRaiz + subcarpetaIniFin + nombreDoc;
{ TODO : Falta check para reemplazo de fichero en las carpetas de los usuarios }
existeFichero := FileExists(rutaSubcarpeta);
if existeFichero then
guardardoc := opReemplazar.Checked
else
guardarDoc := true;
if guardarDoc then
begin
if tcConsulta.FieldByName(nombreCampoLob).IsNull then
txtLog.Lines.Add('REGISTRO SIN DOCUMENTO - ' + nombreDoc)
else
TBlobField (tcConsulta.FieldByName(nombreCampoLob)).SaveToFile(
rutaSubcarpeta);
if existeFichero then
txtLog.Lines.Add('REEMPLAZADO - ' + rutaSubcarpeta)
else
txtLog.Lines.Add('EXTRAÍDO - ' + rutaSubcarpeta);
end
else
txtLog.Lines.Add('NO REEMPLAZADO - ' + rutaSubcarpeta);
if DirectoryExists(subcarpetaAsignacion) then
begin
ok := CopyFile(PChar(rutaSubcarpeta), PChar(subcarpetaAsignacion +
nombreDoc), true);
if ok = true then
txtLog.Lines.Add('EL FICHERO - ' + rutaSubcarpeta +
' HA SIDO COPIADO CORRRECTAMENTE A ' + subcarpetaAsignacion
+ nombreDoc )
else
txtLog.Lines.Add('ERROR AL COPIAR EL FICHERO - ' + rutaSubcarpeta +
' A ' + subcarpetaAsignacion + nombreDoc );
end
else
txtLog.Lines.Add('ERROR AL COPIAR - ' + rutaSubcarpeta +
' EN ' + subcarpetaAsignacion);
except
Screen.Cursor := crDefault;
exit;
raise;
end;
tcConsulta.Next;
end;
tcConsulta.EnableControls;
Screen.Cursor := crDefault;
end;
end;
end
else
MessageDlg('No hay datos para extraer. Ejecute una consulta SQL ' +
'antes de extraer los documentos.', mtInformation, [mbok], 0);
end;
procedure TformMenuPrincipal.bTEliminarTodosClick(Sender: TObject);
begin
tablaAsignacion.Strings.Clear;
end;
procedure TformMenuPrincipal.bTGuardarClick(Sender: TObject);
begin
tablaAsignacion.Strings.SaveToFile(ExtractFilePath(Application.ExeName) +
'asignacion.txt');
end;
procedure TformMenuPrincipal.bTEliminarClick(Sender: TObject);
begin
try
if tablaAsignacion.RowCount > 1 then
tablaAsignacion.DeleteRow(tablaAsignacion.Row);
except
raise;
end;
end;
procedure TformMenuPrincipal.bTInsertarClick(Sender: TObject);
begin
tablaAsignacion.InsertRow(InputBox ('Código', 'Código',''), 'C:\', false);
end;
ficheroSQL := ExtractFilePath(Application.ExeName) + 'sql.txt';
if FileExists(ficheroSQL) then
txtSQL.Lines.LoadFromFile(ficheroSQL);
end;
procedure TformMenuPrincipal.BitBtn1Click(Sender: TObject);
begin
dlAbrir.Title := 'Selección de fichero de asignación';
dlAbrir.Filter := 'Archivos de texto (*.txt)|*.txt|Todos los archivos (*.*)|*.*';
if dlAbrir.Execute then
begin
if MessageDlg('Se reemplazará la lista actual por la nueva ¿desea continuar?',
mtConfirmation, [mbyes, mbno], 0) = mryes then
tablaAsignacion.Strings.LoadFromFile(dlAbrir.FileName);
end;
end;
procedure TformMenuPrincipal.tablaAsignacionExit(Sender: TObject);
begin
bTGuardarClick(Self);
end;
procedure TformMenuPrincipal.FormClose(Sender: TObject;
var Action: TCloseAction);
var
ficheroSQL : string;
begin
bTGuardarClick(Self);
ficheroSQL := ExtractFilePath(Application.ExeName) + 'sql.txt';
txtSQL.Lines.SaveToFile(ficheroSQL);
esCadINI('Extraer documentos', 'Campo LOB', txtNombreCampoCLOB.Text);
esCadINI('Extraer documentos', 'Nombre campo LOB',txtRuta.Text);
esCadINI('BD', 'Campo nombre documento', txtNombreCampoDocumento.Text);
esBoolINI ('Extraer documentos', 'Reemplazar ficheros', opReemplazar.Checked);
esBoolINI ('Asignación carpetas', 'Duplicados', opAsignacionSinDuplicados.Checked);
procedure TformMenuPrincipal.bGuardarLogClick(Sender: TObject);
begin
dlGuardar.Filter := 'Archivos de log (*.log)|*.log|Todos los archivos (*.*)|*.*';
dlGuardar.FileName := 'resultado_extracción.log';
if dlGuardar.Execute then
txtLog.Lines.SaveToFile(dlGuardar.FileName);
end;
procedure TformMenuPrincipal.opAsignacionSinDuplicadosClick(
Sender: TObject);
begin
if opAsignacionSinDuplicados.Checked then
tablaAsignacion.KeyOptions := [keyEdit,keyAdd,keyDelete,keyUnique]
else
tablaAsignacion.KeyOptions := [keyEdit,keyAdd,keyDelete];
end;
procedure TformMenuPrincipal.FormShow(Sender: TObject);
begin
tabLista.Show;
end;
Puede publicar nuevos temas en este foro No puede responder a temas en este foro No puede editar sus mensajes en este foro No puede borrar sus mensajes en este foro No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A