Favor Ayuda Urgente Actualiza Registros DBF Con Word

[remtec]

Hola Hmpaquito

Muchas gracias por tu atencion.

Me imagino que tu tienes muy buena experiencia con este tipo de campos memo.

He leido que han tenido problemas algunas personas con campos memos guardados en FPT, en mi caso me da terror, pues para el uso que le debo dar, debo estar muy seguro, ya que la informacion que debo guardar, es informarcion que debe estar dispuesta por 5 años, bajo exigencia Legal, la que puede ser solicitada y requerida para auditoria, por el ministerio de salud u organismos judiciales. Esto me compromete como programador muy fuertemente.

Lamentablemente hoy luchamos con otros tipos de tecnologias Web, que manejan muy bien las Bases a distancias, me siento aferradado luchando con la competencia y con la vision y requerimientos de los clientes, a un nivel que un sistema EXE, no les puede entregar.

Hoy esto me complica, ya que la gran mayoria de los Centros de Salud con toma de Examenes, envian los examenes a servicios externos via web, para que sean informados, posteriormente, estos resultados de los examenes, son remitidos, via correo normalmente en formato Word Office, en el centro de salud, este archivo debe ser Transcrito al Sistema de Registro de Informes, que en mi caso, lo tengoo con Bases DBF, hoy todos requieren minimisar el uso y tiempo de Digitadoras, para lo cual, entre menos digitan, mucho mejor.

Lamento en ser tan extenso en exponer mi caso, no se si otro Colega Desarrolle Sistemas para Centros de Salud, se que hay Venezuela, trate de contactarlo, pero no resulto, solo para obtener algo de orientacion diferente.

Muchos Saludos y un Feliz Fin de Año, Muchos Exitos y Bendiciones para el 2019.

Antonio

Muchos Saludos.

[cmsoft]

Te respondi, pero se ve que estabas conectado junto conmigo y mi respuesta quedo antes que la tuya

[remtec]

Hola Cesar

Como siempre atento a ayudar.

Muchas Gracias.

Entiendo tu sugerencia, pero en mi caso no puedo aplicarla.

Los Resultados de Examenes Medicos, al igual que las Fichas Clinicas, son protegidas bajo Ley Medica, por lo que el acceso o actualizacion, debe ser por usuarios autorizados, debe quedar registro, del acceso, tipo de actualizacion o impresion del informe.

Los Informes solo pueden ser solicitados por el Paciente Titular, Auditoria Ministerio de Salud o Tribunal de Justicia.

Es porque que deben quedar bajo seguridad extrema, por lo que no puedo aplicar tu sugerencia, de dejar en una carpeta los archivos WORD, con identificacion del folio, esto seria muy complicado y estaria violando exigencias y normas legales.

Hoy me aferro a luchar con la competencia de otras tecnologias Web, requerimientos de los clientes de poder accesar remotamente desde cualquier lugar a sus sistemas y la moda, estar en la Web, hoy con este Sistema EXE, estoy lejos de cumplir con esas exigencias, pero por lo menos satisfacer la solicitud de acualizaciones de datos, cada dia la tenemos mas complicada como programador.

Muchos Saludos y un Feliz Fin de Año, muchas Bendiciones y Exitos para el 2019.

Muchos Saludos
Antonio.

[cmsoft]

Hoy me aferro a luchar con la competencia de otras tecnologias Web, requerimientos de los clientes de poder accesar remotamente desde cualquier lugar a sus sistemas y la moda, estar en la Web, hoy con este Sistema EXE, estoy lejos de cumplir con esas exigencias, pero por lo menos satisfacer la solicitud de acualizaciones de datos, cada dia la tenemos mas complicada como programador.

Antonio, si el caso es asi, puedes optar un sistema mixto, y Fivewin es perfecto para eso. Yo utilizo mucho este tipo de "mezcla" entre sistemas de escritorio y sistemas web. Obviamente tienes que migrar una parte de tu sistema a MySql, pero no es un proceso tan complicado, y aca vas a encontrar toda la ayuda que necesitas.
Personalmente considero que Fivewin es una gran herramienta, sobre todo para la parte operativa de cualquier sistema.
Conta conmigo para cualquier cosa que necesites, no soy un experto pero tengo varios desarrollos funcionando de esa manera y son totalmente funcionales.
No te des por vencido que tienes una gran herramienta en tus manos.
Te deseo un feliz año

[remtec]

Cesar

Realmente te pasaste, muy agradecido por siempre estar dispuesto a ayudarme,

Tendre en consideracion tu ofrecimiento, hare un analisis de la solucion, considerando lo ultimo que me has indicado y resolvere, pues estoy muy complicado con esta solucion, se que es un tema no comun, pero debo cumplir con las exigencias, la competencia esta golpeando la puerta y con soluciones que son mucho mas llamativas y de moda, ya me recuerda lo que vivi con Clipper.

Esto lo vere con suma Urgencia, por lo que estoy aternamente agradecido por tu ofrecimiento y disposicion a ayudarme, estare molestandote los primeros dias de Enero, siempre que no sea una molestia.

Muchas Felicidades y una Hermosa Noche de Fin de año para ti y tu familia.

Muchos Saludos.
Antonio.

[jnavas]

Saludos
Con este programa almaceno cualquier archivo en tablas DBF, MySQL, SQLSERVER

viewtopic.php?f=6&t=30337&p=214527&hilit=almacenar#p214527

[jnavas]

Code: Select all  Expand view

// Almacena archivos de cualquier tipo en una tabla DBF o Gestor MySQL/SQLSERVER
// Juan navas jnavas@datapronet.com jnadaptapro@gmail.com
// Este programa fue extraido del sistema ERP AdaptaPro www.datapronet.com utiliza MYSQL
// Este ejemplo es mi aporte al foro de FiveWin, se puede utilizar en cualquier gestor de base de datos utilizando campos Memos
// El mecanismo es: A partir del Archivo BMP o Binario, Genera un archivo comprimido ZIP,texto mediante MIME, se fracciona en paginas y se almacena
// Para recuperarlo: Lee el contenido del memo, genera el archivo TEXTO, luego genera el archivo comprimido, finalmente se descomprime y genera el archivo nuevamente en la carpeta filerecover
// Requiere Libreria hbzlib.LIB
// Ejecucion desde la consola: savefilebmp <Nombre de Cualquier Archivo>
// Si no se indica el nombre del archivo, guardara el mismo binario y luego lo recupera en la carpeta filerecover
// Esta funcionalidad la hemos ýmplementado con campos BLOB y LONGTEXT en MYSQL.

#include "FiveWin.ch"

FUNCTION MAIN(cFile)
  LOCAL aPag
  LOCAL cBin     :=Lower(GetModuleFileName( GetInstance() ))
  LOCAL cFileDir:="FILES.DBF"
  LOCAL cFilePag:="FILESPAG.DBF"
  LOCAL aFile,I

  DEFAULT cFile:=cBin

  SET DELETE ON

  IF !FILE(cFile)
     MsgAlert("Archivo "+cFile+" no Existe")
     RETURN NIL
  ENDIF

  ISTABLAS(cFileDir,cFilePag)

  aFile:=DIRECTORY(cFile)
  aPag :=GETPAGES(cFile)

?  IF Empty(aPag)
     MsgAlert("Archivo no gener¾ Paginado")
     RETURN NIL
  ENDIF

  SELECT A
  USE (cFileDir) EXCLU
  GO TOP
  // Remueve el COntenido
  DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
  PACK

  APPEND BLANK
  REPLACE FILE  WITH cFile
  REPLACE SIZE  WITH aFile[1,2]
  REPLACE PAGES WITH LEN(aPag)
  COMMIT

  // BROWSE()

  SELECT B
  USE (cFilePag) EXCLU
  GO TOP
  // Remueve el COntenido
  DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
  PACK

  FOR I=1 TO LEN(aPag)
     APPEND BLANK
     REPLACE FILE  WITH cFile
     REPLACE PAGE  WITH I
     REPLACE MEMO  WITH aPag[I]
     COMMIT
  NEXT I

  // BROWSE()

  CLOSE ALL

  RECUPERAR(cFile)

RETURN NIL

FUNCTION cFileTemp(cExt)
LOCAL cFile:="tmp"+STRTRAN(LSTR(SECONDS()),".","")+cExt
RETURN cFile

FUNCTION lstr(nValue)
RETURN ALLTRIM(STR(nValue))


FUNCTION GETPAGES(cFileOrg)
    LOCAL cFileZip :=cFileTemp(".ZIP")
    LOCAL cFileMime:=cFileTemp(".TXT")
    LOCAL aFiles   :={},nSize:=0,oFile,cMemo:=""
    LOCAL cBin     :=Lower(cFilePath(GetModuleFileName( GetInstance() )))
    LOCAL aPages:={},I,aTotal:={},nTotal:=0,lZip:=.F.
    LOCAL aPag     :={},nPage
    LOCAL nFileMax :=(1024**4)*2 // Tama±o maximo permitido para almacenar, en paginado el limite esta en la capacidad de la tabla
    LOCAL nPageSize:=(1024**2)/2 // Tama±o maximo de la Pagina, limite campo MEMO . Utilizado en MySQL para campos LONGTEXT

    nPageSize:=65555 // Capacidad para tablas DBF

    CursorWait()

    IF !(":"$cFileOrg)
       cFileOrg:=cBin+cFileOrg
    ENDIF

    cFileOrg :=Lower(cFileOrg)

    AADD(aFiles,cFileOrg)

    IF !(":"$cFileOrg)

       MsgAlert("Es necesario Indicar la Ruta Completa del Archivo "+cFileOrg+CRLF+;
                  "Ejemplo "+cBin+"\docs\documento.doc")

       RETURN 0

    ENDIF

    IF !FILE(cFileOrg)
       MsgAlert("Archivo "+cFileOrg+" no Existe")
       RETURN 0
    ENDIF

    IF UPPE(cFileExt(cFileOrg))="ZIP"
       cFileZip:=cFileOrg
       lZip    :=.T.
    ELSE
       // El Archivo Original es Comprimido en Formato Zip
       HB_ZipFile( cFileZip, aFiles, 9,,.T., NIL, .F., .F. )
    ENDIF

    // El Archivo MIME es Convertido en Formato TEXTO Segun Mime
    FMimeEnc(cFileZip,cFileMime)

    // Valida el Tama±o con el Archivo MIME
    nSize:=DIRECTORY(cFileMime)[1,2]

    IF nSize>nFileMax
      MsgAlert("Archivo "+cFileMime+" Tama±o "+LSTR(nSize)+",Supera el LÝmite "+LSTR(nFileMax))
      RETURN {}
    ENDIF

    // Determinamos las Pßginas que seran empleadas

    nPage :=MAX(INT(nSize/nPageSize),1)
    aPages:={}

    FOR I=1 TO nPage
       AADD(aPages,{MIN(nPageSize,nSize)})
    NEXT I

    aTotal:=ATOTALES(aPages)

    // Remanente de la Ultima Pßgina
    IF nSize>aTotal[1]
       AADD(aPages,{nSize-aTotal[1]})
    ENDIF

    // Se Extra Pagina por Pagina del Arhivo MIME
    oFile:=TFILE():New(cFileMime)

    FOR I=1 TO LEN(aPages)
       cMemo:=oFile:cGetStr( aPages[I,1] )
       AADD(aPag,cMemo)
       nTotal:=nTotal+LEN(cMemo)
    NEXT I

    oFile:End()

    ferase(cFileMime)

    IF !lZip
       ferase(cFileZip)
    ENDIF

RETURN aPag

FUNCTION ATOTALES(aData)
   LOCAL aTotal,I,U

   aTotal:=ARRAY(LEN(aData[1]))

   Aeval( aTotal,{ |a,n| aTotal[n]:=0 })

   FOR I=1 TO LEN(aData)

      FOR U=1 TO LEN(aData[I])
        aTotal[U]:=aTotal[U]+aData[I,U]
      NEXT U

   NEXT I

RETURN aTotal

PROCE ISTABLAS(cFileDir,cFilePag)
  LOCAL aStruct:={}

  IF FILE(cFileDir)
     RETURN
  ENDIF

  AADD(aStruct,{"FILE", "C",250,0})
  AADD(aStruct,{"SIZE", "N",12 ,0})
  AADD(aStruct,{"PAGES","N",3  ,0})

  dbcreate(cFileDir, aStruct)

  aStruct:={}
  AADD(aStruct,{"FILE","C",250,0})  // Archivo
  AADD(aStruct,{"PAGE","N",4  ,0})  // Memo
  AADD(aStruct,{"MEMO","M",0  ,0})  // Numero de la Pagina, es necesario el Orden para su Recuperaci¾n

  dbcreate(cFilePag, aStruct)

RETURN

FUNCTION RECUPERAR(cFile)
   LOCAL cFileDir:="FILES.DBF"
   LOCAL cFilePag:="FILESPAG.DBF"
   LOCAL cFileZip :=cFileTemp(".ZIP")
   LOCAL cFileMime:=cFileTemp(".TXT")
   LOCAL I,cDirOut:="filerecover\"

   LOCAL aPag    :={}
   LOCAL oFile

   lMkDir(cDirOut)

   SELECT A
   USE (cFileDir)
   GO TOP
   LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)

   IF !FOUND()
      CLOSE ALL
      MsgAlert("Archivo "+cFile+" no Encontrado en Tabla "+cFileDir)
      RETURN .F.
   ENDIF

   SELECT B
   USE (cFilePag) EXCLU
   GO TOP
   // Ubica el Contenido
   LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)

   WHILE !EOF() .AND. ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
      AADD(aPag,ALLTRIM(FIELD->MEMO))
      SKIP
   ENDDO

   CLOSE ALL

   // Desde DBF hacia MIME
   oFile:=TFILE():New(cFileMime)
   AEVAL(aPag,{|a,n| oFile:PutStr(a)})
   oFile:End()

   // De MIME a ZIP
   ferase(cFileZip)
   FMimeDec(cFileMime,cFileZip)
   ferase(cFileMime)

   // Recuperaci¾n desde ZIP
   HB_UNZIPFILE( cFileZip , {|| nil }, .t., NIL, cDirOut , NIL )
   ferase(cFileZip)

   MsgAlert("Archivo recuperado en carpeta "+cDirOut)

   IF !cFileExt(cFile)="EXE"
     SHELLEXECUTE(NIL,"open",cFile)
   ENDIF

RETURN .T.

[remtec]

Hola Juan

Muchas gracias por tu Ayuda, revisare lo que me envias y comentare.

Muchas Felicidades en esta noche de Fin de Año, te deseo muchas bendiciones y exitos para el año 2019.

Muchos Saludos.
Antonio

[carlos vargas]

Creo que en lo personal, dado los requerimientos debes trabajar con mysql sin perder tiempo.
eso te dará seguridad, facilidad.

Code: Select all  Expand view

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos()
   PRIVATE oDlgD, oBrwD
   PRIVATE nNumero, cNombre
   PRIVATE oQryDoc

   IF !( oQryAbog:RecCount() > 0 )
      MsgAlert( "No hay registros, nada que documentar." )
      RETURN
   ENDIF

   nNumero := oQryAbog:NUM_ABOG
   cNombre := oQryAbog:NOMBRE_L

   oQryDoc := oServer:Query( "select * from abogadosdoc where num_abog=&1 order by fdi desc", { nNumero } )

   IF oServer:NetErr()
      MsgAlert( oServer:ErrorTxt() )
      RETURN
   ENDIF

   DEFINE DIALOG oDlgD NAME "DLG_ABOGD" OF oDlg ICON GetIcon() FONT oFontD

   REDEFINE GET nNumero ;
      ID 101 OF oDlgD ;
      WHEN FALSE

   REDEFINE GET cNombre ;
      ID 102 OF oDlgD ;
      WHEN FALSE

   REDEFINE XBROWSE oBrwD DATASOURCE oQryDoc ID 103 OF oDlgD ;
      HEADERS "Descripción de documento", "Fecha/Reg." ;
      COLUMNS "descripcion", "fdi" ;
      SIZES 290, 060 ;
      FONT oFontD

   WITH OBJECT oBrwD
      :MyConfig()
      :lHScroll      := FALSE
      :nHeaderHeight := 36
      :nFreeze       := 2
      :bLDblClick    := {|| IIf( oQryDoc:RecCount() > 0, Abog_Documentos_Visualizar(), NIL ) }
      :bDropFiles    := {|nRow, nCol, aFiles| Abog_Documentos_Arrastrar( aFiles ) }
   END

   REDEFINE BUTTONBMP ;
      ID 104 OF oDlgD ;
      BITMAP "BMS_ADD" ;
      TOOLTIP "Agregar documento." ;
      ACTION Abog_Documentos_Agregar()

   REDEFINE BUTTONBMP ;
      ID 105 OF oDlgD ;
      BITMAP "BMS_DEL" ;
      TOOLTIP "Quitar documento." ;
      WHEN oBrwD:nLen>0 ;
      ACTION Abog_Documentos_Borrar()

   REDEFINE BUTTONBMP ;
      ID 106 OF oDlgD ;
      BITMAP "BMS_VIEW" ;
      TOOLTIP "Visualizar documento." ;
      WHEN oBrwD:nLen>0 ;
      ACTION Abog_Documentos_Visualizar()

   REDEFINE BUTTONBMP ;
      ID 107 OF oDlgD ;
      BITMAP "BMS_TOFILE" ;
      TOOLTIP "Extraer documento." ;
      WHEN oBrwD:nLen>0 ;
      ACTION Abog_Documentos_Extraer()

   REDEFINE BUTTON ;
      ID 201 OF oDlgD ;
      ACTION oDlgD:END()

   ACTIVATE DIALOG oDlgD ON INIT ( DragAcceptFiles( oBrwD:hWnd, TRUE ), 1 )

   oQryDoc:End()

RETURN

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos_Agregar()
   LOCAL cArchivo := ""
   LOCAL cDescripcion := Space( 80 )
   LOCAL nNumDocu
   LOCAL oError

   cArchivo := cGetFile( "Archivo | *.*", "Seleccione archivo a adjuntar ", 1, GetFolderMyDocuments(), XBL_OPENFILE, XBL_WITHLONGNAME )

   IF !Empty( cArchivo )

      IF MsgGet( "Agregar un archivo", "Descripción de archivo", @cDescripcion, "@!", "BM_DOCUMENT" )
         IF !Empty( cDescripcion )

            CursorWait()
            WaitOn( "Agregando documento, espere un momento!" )
            oServer:lThrowError := TRUE

            TRY
               oServer:BeginTransaction()

               IF ( nNumDocu := IncCount( "control", "cont_docu" ) ) > 0
                  oServer:Insert2( "abogadosdoc", { { "num_abog"   , nNumero      }, ;
                                                    { "num_docu"   , nNumDocu     }, ;
                                                    { "descripcion", cDescripcion }, ;
                                                    { "fdi"        , Date()       } } )

                  oServer:Insert2( "documentos",  { { "num_docu", nNumDocu                           }, ;
                                                    { "nombre"  , cFileNoPath( cArchivo )            }, ;
                                                    { "archivo" , HB_StrToHex( FileStr( cArchivo ) ) } } )
               ENDIF

               oServer:Commit()

               oQryDoc:ReQuery()

            CATCH oError
               oServer:Rollback()
               ShowError( oError )
            END
         ENDIF

         CursorArrow()
         WaitOff()
         oServer:lThrowError := FALSE

      ENDIF
   ENDIF

   oDlgD:Update()
   oBrwD:Refresh()

RETURN

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos_Borrar()
   LOCAL lBorrar  := TRUE
   LOCAL nNumDocu := 0
   LOCAL oError

   IF !( oQryDoc:RecCount() > 0 )
      MsgAlert( "No hay documentos que borrar." )
      RETURN
   ELSE
      IF MsgNoYes( "Desea borrar documento seleccionado?" )
         nNumDocu := oQryDoc:NUM_DOCU

         CursorWait()
         WaitOn( "Borrando documento, espere un momento!" )
         oServer:lThrowError := TRUE

         TRY
            oServer:BeginTransaction()

            oServer:Execute( "delete from abogadosdoc where num_docu=" + Var2Str( nNumDocu ) )
            oServer:Execute( "delete from documentos  where num_docu=" + Var2Str( nNumDocu ) )

            oServer:Commit()

            oQryDoc:ReQuery()
         CATCH oError
            oConn:Rollback()
            ShowError( oError )
         END

         CursorArrow()
         WaitOff()
         oServer:lThrowError := FALSE

      ENDIF
   ENDIF

   oDlgD:Update()
   oBrwD:Refresh()

RETURN

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos_Visualizar()

   IF oQryDoc:RecCount() == 0
      MsgAlert( "No hay documentos que borrar." )
      RETURN
   ENDIF

   VisorDocumentos( oQryDoc:NUM_DOCU )

RETURN

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos_Extraer()

   IF oQryDoc:RecCount() == 0
      MsgAlert( "No hay documentos que extraer y guardar en disco." )
      RETURN
   ENDIF

   ExtraerDocumentos( oQryDoc:NUM_DOCU )

RETURN

/*-------------------------------------------------------------------------------------------------*/

STATIC PROCEDURE Abog_Documentos_Arrastrar()
   LOCAL cArchivo := ""
   LOCAL cDescripcion := Space( 80 )
   LOCAL nNumDocu
   LOCAL oError

   IF Len( aFiles )<>1
      MsgAlert( "Arrastre un archivo a la vez." )
      RETURN
   ENDIF

   cArchivo := aFiles[ 01 ]

   IF !Empty( cArchivo )

      IF MsgGet( "Agregar un archivo", "Descripción de archivo", @cDescripcion, "@!", "BM_DOCUMENT" )
         IF !Empty( cDescripcion )

            CursorWait()
            WaitOn( "Agregando documento, espere un momento!" )
            oServer:lThrowError := TRUE

            TRY
               oServer:BeginTransaction()

               IF ( nNumDocu := IncCount( "control", "cont_docu" ) ) > 0
                  oServer:Insert2( "abogadosdoc", { { "num_abog"   , nNumero      }, ;
                                                    { "num_docu"   , nNumDocu     }, ;
                                                    { "descripcion", cDescripcion }, ;
                                                    { "fdi"        , Date()       } } )

                  oServer:Insert2( "documentos",  { { "num_docu", nNumDocu                           }, ;
                                                    { "nombre"  , cFileNoPath( cArchivo )            }, ;
                                                    { "archivo" , HB_StrToHex( FileStr( cArchivo ) ) } } )
               ENDIF

               oServer:Commit()

               oQryDoc:ReQuery()

            CATCH oError
               oServer:Rollback()
               ShowError( oError )
            END
         ENDIF

         CursorArrow()
         WaitOff()
         oServer:lThrowError := FALSE

      ENDIF
   ENDIF

   oDlgD:Update()
   oBrwD:Refresh()

RETURN
 

Estructura de tabla


En el codigo anterior se visualiza los documentos con los programas nativos, se necesitaría word o excel para archivos doc o xls, o adobe para pdf.
con este código se previsualzia con una herramienta de oracle (contro ocx) que permite visualizar 500 formatos.
http://www.fivetechsupport.com/forums/viewtopic.php?f=6&t=32550&start=30

Code: Select all  Expand view

/*-------------------------------------------------------------------------------------------------*/

PROCEDURE Concesiones_ViewDoc()
   LOCAL oWnd, oOcx
   LOCAL cFileName, cExtension

   IF COND->( Eof() )
      MsgAlert( TC( IDS_CONC_EOF_VIEWDOC ) )
      RETURN
   ENDIF

   WaitOn( TC( IDS_VIEW_PREPAREFILE ) )
   CursorWait()

   cFileName  := GetFolderMyTemp() + "\" + RTrim ( COND->NOMBRE )
   cExtension := Upper( cFileExt( cFileName ) )

   COND->( AdsBlob2File( cFileName , "DOCUMENTO" ) )

   WaitOff()
   CursorArrow()

   IF !Empty( cExtension ) .and. cExtension $ "PDF_XLS_DOC_XLSX_DOCX_PPT_PPTX_JPG_PNG_BMP"
      ShellExecute( oDlgE:hWnd, "open", cFileName )
   ELSE
      IF !IsActiveX( "oixctrl.oixctrl.2" )
         MsgStop( TC( IDS_VIEW_NOINSTALLOCX ) )
         RETURN
      ENDIF

      DEFINE WINDOW oWnd TITLE TC( IDS_VIEW_TITLE ) ICON GetIcon()

      DEFINE BUTTONBAR OF oWnd 3D SIZE 60, 60 2010
      DEFINE BUTTON NAME "TB_SALIR" OF oWnd:oBar ACTION oWnd:END() PROMPT TC( IDS_VIEW_TB1 )

      oOcx := TActiveX():New( oWnd, "oixctrl.oixctrl.2" )

      oWnd:oClient := oOcx
      oWnd:SetSize( 800, 600 )

      oOcx:ViewFile( FALSE, cFileName )

      ACTIVATE WINDOW oWnd ON INIT oWnd:MAXIMIZE() VALID ( oOcx:Close(), oOcx := NIL, FileDelete( cFileName ), TRUE )
   ENDIF

RETURN

[jnavas]

Code: Select all  Expand view

// Almacena archivos de cualquier tipo en una tabla DBF o Gestor MySQL/SQLSERVER
// Juan navas jnavas@datapronet.com jnadaptapro@gmail.com
// Este programa fue extraido del sistema ERP AdaptaPro www.datapronet.com utiliza MYSQL
// Este ejemplo es mi aporte al foro de FiveWin, se puede utilizar en cualquier gestor de base de datos utilizando campos Memos
// El mecanismo es: A partir del Archivo BMP o Binario, Genera un archivo comprimido ZIP,texto mediante MIME, se fracciona en paginas y se almacena
// Para recuperarlo: Lee el contenido del memo, genera el archivo TEXTO, luego genera el archivo comprimido, finalmente se descomprime y genera el archivo nuevamente en la carpeta filerecover
// Requiere Libreria hbzlib.LIB
// Ejecucion desde la consola: savefilebmp <Nombre de Cualquier Archivo>
// Si no se indica el nombre del archivo, guardara el mismo binario y luego lo recupera en la carpeta filerecover
// Esta funcionalidad la hemos ýmplementado con campos BLOB y LONGTEXT en MYSQL.

#include "FiveWin.ch"

FUNCTION MAIN(cFile)
  LOCAL aPag
  LOCAL cBin     :=Lower(GetModuleFileName( GetInstance() ))
  LOCAL cFileDir:="FILES.DBF"
  LOCAL cFilePag:="FILESPAG.DBF"
  LOCAL aFile,I

  DEFAULT cFile:=cBin

  SET DELETE ON

  IF !FILE(cFile)
     MsgAlert("Archivo "+cFile+" no Existe")
     RETURN NIL
  ENDIF

  ISTABLAS(cFileDir,cFilePag)

  aFile:=DIRECTORY(cFile)
  aPag :=GETPAGES(cFile)

?  IF Empty(aPag)
     MsgAlert("Archivo no gener¾ Paginado")
     RETURN NIL
  ENDIF

  SELECT A
  USE (cFileDir) EXCLU
  GO TOP
  // Remueve el COntenido
  DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
  PACK

  APPEND BLANK
  REPLACE FILE  WITH cFile
  REPLACE SIZE  WITH aFile[1,2]
  REPLACE PAGES WITH LEN(aPag)
  COMMIT

  // BROWSE()

  SELECT B
  USE (cFilePag) EXCLU
  GO TOP
  // Remueve el COntenido
  DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
  PACK

  FOR I=1 TO LEN(aPag)
     APPEND BLANK
     REPLACE FILE  WITH cFile
     REPLACE PAGE  WITH I
     REPLACE MEMO  WITH aPag[I]
     COMMIT
  NEXT I

  // BROWSE()

  CLOSE ALL

  RECUPERAR(cFile)

RETURN NIL

FUNCTION cFileTemp(cExt)
LOCAL cFile:="tmp"+STRTRAN(LSTR(SECONDS()),".","")+cExt
RETURN cFile

FUNCTION lstr(nValue)
RETURN ALLTRIM(STR(nValue))


FUNCTION GETPAGES(cFileOrg)
    LOCAL cFileZip :=cFileTemp(".ZIP")
    LOCAL cFileMime:=cFileTemp(".TXT")
    LOCAL aFiles   :={},nSize:=0,oFile,cMemo:=""
    LOCAL cBin     :=Lower(cFilePath(GetModuleFileName( GetInstance() )))
    LOCAL aPages:={},I,aTotal:={},nTotal:=0,lZip:=.F.
    LOCAL aPag     :={},nPage
    LOCAL nFileMax :=(1024**4)*2 // Tama±o maximo permitido para almacenar, en paginado el limite esta en la capacidad de la tabla
    LOCAL nPageSize:=(1024**2)/2 // Tama±o maximo de la Pagina, limite campo MEMO . Utilizado en MySQL para campos LONGTEXT

    nPageSize:=65555 // Capacidad para tablas DBF

    CursorWait()

    IF !(":"$cFileOrg)
       cFileOrg:=cBin+cFileOrg
    ENDIF

    cFileOrg :=Lower(cFileOrg)

    AADD(aFiles,cFileOrg)

    IF !(":"$cFileOrg)

       MsgAlert("Es necesario Indicar la Ruta Completa del Archivo "+cFileOrg+CRLF+;
                  "Ejemplo "+cBin+"\docs\documento.doc")

       RETURN 0

    ENDIF

    IF !FILE(cFileOrg)
       MsgAlert("Archivo "+cFileOrg+" no Existe")
       RETURN 0
    ENDIF

    IF UPPE(cFileExt(cFileOrg))="ZIP"
       cFileZip:=cFileOrg
       lZip    :=.T.
    ELSE
       // El Archivo Original es Comprimido en Formato Zip
       HB_ZipFile( cFileZip, aFiles, 9,,.T., NIL, .F., .F. )
    ENDIF

    // El Archivo MIME es Convertido en Formato TEXTO Segun Mime
    FMimeEnc(cFileZip,cFileMime)

    // Valida el Tama±o con el Archivo MIME
    nSize:=DIRECTORY(cFileMime)[1,2]

    IF nSize>nFileMax
      MsgAlert("Archivo "+cFileMime+" Tama±o "+LSTR(nSize)+",Supera el LÝmite "+LSTR(nFileMax))
      RETURN {}
    ENDIF

    // Determinamos las Pßginas que seran empleadas

    nPage :=MAX(INT(nSize/nPageSize),1)
    aPages:={}

    FOR I=1 TO nPage
       AADD(aPages,{MIN(nPageSize,nSize)})
    NEXT I

    aTotal:=ATOTALES(aPages)

    // Remanente de la Ultima Pßgina
    IF nSize>aTotal[1]
       AADD(aPages,{nSize-aTotal[1]})
    ENDIF

    // Se Extra Pagina por Pagina del Arhivo MIME
    oFile:=TFILE():New(cFileMime)

    FOR I=1 TO LEN(aPages)
       cMemo:=oFile:cGetStr( aPages[I,1] )
       AADD(aPag,cMemo)
       nTotal:=nTotal+LEN(cMemo)
    NEXT I

    oFile:End()

    ferase(cFileMime)

    IF !lZip
       ferase(cFileZip)
    ENDIF

RETURN aPag

FUNCTION ATOTALES(aData)
   LOCAL aTotal,I,U

   aTotal:=ARRAY(LEN(aData[1]))

   Aeval( aTotal,{ |a,n| aTotal[n]:=0 })

   FOR I=1 TO LEN(aData)

      FOR U=1 TO LEN(aData[I])
        aTotal[U]:=aTotal[U]+aData[I,U]
      NEXT U

   NEXT I

RETURN aTotal

PROCE ISTABLAS(cFileDir,cFilePag)
  LOCAL aStruct:={}

  IF FILE(cFileDir)
     RETURN
  ENDIF

  AADD(aStruct,{"FILE", "C",250,0})
  AADD(aStruct,{"SIZE", "N",12 ,0})
  AADD(aStruct,{"PAGES","N",3  ,0})

  dbcreate(cFileDir, aStruct)

  aStruct:={}
  AADD(aStruct,{"FILE","C",250,0})  // Archivo
  AADD(aStruct,{"PAGE","N",4  ,0})  // Memo
  AADD(aStruct,{"MEMO","M",0  ,0})  // Numero de la Pagina, es necesario el Orden para su Recuperaci¾n

  dbcreate(cFilePag, aStruct)

RETURN

FUNCTION RECUPERAR(cFile)
   LOCAL cFileDir:="FILES.DBF"
   LOCAL cFilePag:="FILESPAG.DBF"
   LOCAL cFileZip :=cFileTemp(".ZIP")
   LOCAL cFileMime:=cFileTemp(".TXT")
   LOCAL I,cDirOut:="filerecover\"

   LOCAL aPag    :={}
   LOCAL oFile

   lMkDir(cDirOut)

   SELECT A
   USE (cFileDir)
   GO TOP
   LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)

   IF !FOUND()
      CLOSE ALL
      MsgAlert("Archivo "+cFile+" no Encontrado en Tabla "+cFileDir)
      RETURN .F.
   ENDIF

   SELECT B
   USE (cFilePag) EXCLU
   GO TOP
   // Ubica el Contenido
   LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)

   WHILE !EOF() .AND. ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
      AADD(aPag,ALLTRIM(FIELD->MEMO))
      SKIP
   ENDDO

   CLOSE ALL

   // Desde DBF hacia MIME
   oFile:=TFILE():New(cFileMime)
   AEVAL(aPag,{|a,n| oFile:PutStr(a)})
   oFile:End()

   // De MIME a ZIP
   ferase(cFileZip)
   FMimeDec(cFileMime,cFileZip)
   ferase(cFileMime)

   // Recuperaci¾n desde ZIP
   HB_UNZIPFILE( cFileZip , {|| nil }, .t., NIL, cDirOut , NIL )
   ferase(cFileZip)

   MsgAlert("Archivo recuperado en carpeta "+cDirOut)

   IF !cFileExt(cFile)="EXE"
     SHELLEXECUTE(NIL,"open",cFile)
   ENDIF

RETURN .T.

[jnavas]

Saludos
No veo las respuestas que he publicado sobre este caso

[remtec]

Juan

Mil disculpas y muchas gracias por responder.

He tenido un problema con mi notebook donde tengo instalados los sistemas y el ambiente de desarrollo, he tenido que formatear y reinstalar todo,

Estoy revisando todo lo comentado sobre mi pregunta, realizare pruebas sobre lo que me sugieres y comentare, a mi urgencia, se me agrego este problema, pero ya estoy retomando todo.

Muchos Saludos

Antonio