Consulta sobre TDolphin

[cmsoft]

Hola Gente:
Una consulta sobre TDolphin: Con CheckError puedo capturar un error al agregar un registro con clave primaria duplicada, o un registro que intenta romper la integridad referencial? O el control es manual desde el programa?
Si es posible capturar el error, alguien tiene un ejemplo?
Gracias de antemano

[joseluisysturiz]

Las claves primarias para que no se dupliquen puedes controlarlas al diseñar las tablas, por lo menos yo lo hago asi, al igual en mi PRG uso una busqueda por si acaso, aca te dejo un ejemplo sencillo..espero te sirva y sea sobre lo que hablas, saludos...

// PARA VALIDAR NO SE REPITA CAMPO CLAVE
FUNCTION existe( cQuery, aVar, cVar )
// cVar CONTROLA EL CAMPO POR EL CUAL SE HACE LA VALIDACION, ES DECIR ES EL CAMPO CLAVE
// cQuery LA CONSULTA
// aVar ES EL VALOR ENTRADO...


LOCAL lRet := .f. // CONTROLA EL RETORNO SI EXISTE aVar

IF !EMPTY( cValToChar( aVar ) ) // SE ESCRIBIO ALGO EN EL CAMPO CLAVE

IF cQuery:Seek( aVar, cVar ) > 0 // SI ENCUENTRA EL VALOR, EXISTE
MSGALERT( "Valor ya Registrado...", oDatos:cTitMsg )

ELSE
lRet := .t.

ENDIF

ELSE
MSGALERT("Campo no puede quedar Vacio", oDatos:cTitMsg)

ENDIF

RETURN( lRet )

[cmsoft]

Gracias José Luis por la respuesta.
Exactamente así lo hago, pero el control es manual. Si la base de datos tiene definida una clave primaria, o un campo con valor unico, previamente a grabar tengo que verificar que los datos sean correctos mediante un seek o find. Igualmente para cuando son datos que afectarían a la integridad referencial de la base no? Porque sino, da un error en tiempo de ejecución... Seguiré mirando...

[horacio]

Para el uso de claves primarias, si no son externas, utilizo un archivo que lleve esa clave y un triggers sobre la base de datos que contiene dicha clave, evitando la duplicidad. Saludos

[Daniel Garcia-Gil]

Hola

te dejo un ejemplo usando el servidor de pruebas de dolphin
el primer ejemplo muestra como el error es producido sin procesarlo y la salida del sistema
las otras dos forma te muestro como procesar el error

Dolphin tiene 2 formas diferentes de manejar los errores
1) controlados por el mismo dolphin y puedes capturar el error usando TRY/CATCH
2) controlarlo por una funcion propia

EJEMPLO 1 (sin procesal el error)

Code: Select all  Expand view  RUN

#include "tdolphin.ch"
#include "fivewin.ch"


FUNCTION Main()

   local oServer
   local aColumns := { "id", "name", "last" }
   local aValues  := { 8, "name 8", "last 8" }
   
   CONNECT oServer HOST "dolphintest.sitasoft.net" ;
                   USER "test_dolphin" ;
                   PASSWORD "123456" ;
                   PORT 3306 ;

   
   SELECTDB "dolphin_man"
   
   oServer:Execute( "DELETE FROM test WHERE id=8" );
   
   INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
   
   ? "insertado", "ahora producimos el error y saldra el programa"
   
   //se produce el error y sale el programa
   INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
         
   oServer:End()
   
RETURN NIL
 

EJEMPLO 2 (usando TRY/CATCH)

Code: Select all  Expand view  RUN

#include "tdolphin.ch"
#include "fivewin.ch"

FUNCTION Main()

   local oServer
   local aColumns := { "id", "name", "last" }
   local aValues  := { 8, "name 8", "last 8" }
   local oError
   
   CONNECT oServer HOST "dolphintest.sitasoft.net" ;
                   USER "test_dolphin" ;
                   PASSWORD "123456" ;
                   PORT 3306

   
   SELECTDB "dolphin_man"
   
   oServer:Execute( "DELETE FROM test WHERE id=8" );
   
   INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
   
   ? "insertado", "ahora producimos el error y lo capturamos con TRY/CATCH"
   
   TRY
      INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
   CATCH oError
      ShowError( oError )  
   END
         
   oServer:End()
   
RETURN NIL

FUNCTION ShowError( oError )

   MsgInfo( "   Descripción:  " + oError:Description+CRLF+;
            "      Sub Code:  " + STR(oError:SubCode)+CRLF+;
            "      Severity:  " + STR(oError:Severity)+CRLF+;
            "     SubSystem:  " + oError:SubSystem+CRLF+;
            "     Operation:  " + oError:Operation )
           
RETURN NIL
 

EJEMPLO 3 (funcion propia)

Code: Select all  Expand view  RUN

#include "tdolphin.ch"
#include "fivewin.ch"

FUNCTION Main()

   local oServer
   local aColumns := { "id", "name", "last" }
   local aValues  := { 8, "name 8", "last 8" }
   
   CONNECT oServer HOST "dolphintest.sitasoft.net" ;
                   USER "test_dolphin" ;
                   PASSWORD "123456" ;
                   PORT 3306 ;
                   ON ERROR VerificaError( Self, nError, lInternal, cExtra )

   
   SELECTDB "dolphin_man"
   
   oServer:Execute( "DELETE FROM test WHERE id=8" );
   
   INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
   
   ? "insertado", "ahora producimos el error y NO saldra el programa"
   
   //se produce el error y sale el programa
   INSERTMYSQL TO "test" COLUMNS acolumns VALUES aValues
         
   oServer:End()
   
RETURN NIL

FUNCTION VerificaError( oServer, nError, lInternal, cExtra )

   ? "SE PRODUJO UN ERROR EN LA SENTENCIA", ;
     "Codigo del Error:" + Str( nError ),;
     "Descripcion: " + oServer:ErrorTxt() + " " + If( ! Empty( cExtra ), cExtra, "" ), ;
     If( lInternal, "Error Interno", "Error desde MySql" )
     
   //si queremos q el programa salga podriamos generar el objeto error y obligarlo a salir
   //para mejor ejemplo consulta la funcion Dolphin_DefError
   
   //descomentar la siguiente linea para generar el objeto error y obligar la salida del programa
   //Dolphin_DefError( oServer, nError, lInternal, cExtra )

RETURN NIL
 

[cmsoft]

Muchas gracias por las respuestas!
Clarísimo!!
Un abrazo.

[cmsoft]

Daniel:
Incorporé la opción de la función propia y el resultado es excelente, si bien es apropiado que haga los controles básicos por programa para que los mensajes sean en castellano y sea más amigable, el incorporar la función me permite seguir ejecutando el programa y usar todo el poder de MySql.
Muchas gracias por el aporte!

[devtuxtla]

Hola Daniel.

Tienes un manual que explique desde cero todas las funciones de tdolphin ?

Saludos

[Daniel Garcia-Gil]

Hola

No, es lamentable pues me considero totalmente inepto para construir un manual, algunos se han ofrecido a redactarlo, pero sin exito alguno

[devtuxtla]

Hola Daniel.

Si eso nos pasa a muchos.

Sin embargo, he intentado usar tu propuesta de tdolphin, sin exito, basicamente por que sigo pensando como se usan las tablas DBF.

Tengo un proyecto nuevo para desarrollar y quisiera hacerlo con tdolphin desde cero, pero requiero conocer todas las habilidsades de la herramienta antes de iniciar el proyecto y no estar haciendo preguntas cada vez que se presenta un problema.

Cual seria tu recomendacion para iniciar desde cero ?

Saludos

[Marcelo Roggeri]

Hola aprovecho este hilo para hacer una consulta a Daniel sobre uno de los ejemplos, es sobre el archivo testfile.prg.
Logro compilarlo y ejecutarlo pero no se que tipo de archivo debo abrir.
Y de paso les consuto otra duda, estoy haciendo un pequeño ABM de clientes relacionados con la tabla de localidades y a su vez esta con la tabla de provincias, y la duda que tengo es si como hacer las relaciones y mostrarlos en un browse.
Estoy buscandolo en los samples pero aun no lo encontre no se si esta ese ejemplo.
Saludos desde Argentina a todo el foro
Marcelo.

[nnicanor]

Testfile es un pequeño ejemplo de como podemos subir y descargar cualquier tipo de archivo en una tabla, importante que tengamos una columna con el nombre del archivo o la extension para poder determinar como abrirlo una vez lo bajemos de la base de datos, aqui les pongo el testfile modificado para mi proyecto.

Code: Select all  Expand view  RUN

#include "xbrowse.ch"
#include "fivewin.ch"
#include "recursos.ch"
#include "hbcompat.ch"

#ifndef __XHARBOUR__
#define CurDrive  hb_curdrive
#endif


FUNCTION Menu_Anexo( cDoc )

   LOCAL oWnd3
   LOCAL oMenu

   cDocu := cDoc
   
   MENU oMenu POPUP 2007
       MENUITEM "Cargar Archivo" ACTION LoadFile( cDoc )
       MENUITEM "Listar Archivos" ACTION DataBrowse( cDoc )
   ENDMENU

RETURN oMenu

//--------------------------------------------//

Function LoadFile1( cDocu )

LOCAL cFile := cGetFile( "*.*", "Seleccione un Archivo" )
LOCAL uData
LOCAL oDlg

TRY

   IF ! Empty( cFile )

        ??? "Leyendo Archivo"
       
      uData = D_ReadFile( cFile )

      ??? "Archivo leido"

      nTamb := len( udata )
      nTamk := int( nTamb / 1024 )
      nTam := nTamb / ( 1024 * 1024 )

      if nTam > 6

          MsgStop( "No puede subir el archivo que intenta anexar tiene "+alltrim( str( nTam,6,1 ) )+ "MB"+;
                      ", El limite maximo por archivo es 5 MB"+CRLF+CRLF+;
                         "Si necesita subir un archivo mas grande dividalo en varios archivos","Atencion")
      else

            ???  "Identificando tamaños"

           if nTamb > ( 1024 * 1024 )
       
              cTam := alltrim( str( nTam, 6, 1 ) )+ " MBytes"
           
           elseif nTamb > 1024
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " KBytes"
       
           else
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " Bytes"

           endif

             ??? "Haciendo consulta para verificar existencia"

           oQryU := oServer:Query("Select id, filename, tam from files where filename ='"+ GetOnlyName( cFile ) +"' and numdoc ='"+cDocu+"'")
               
           if oQryU:LastREc() > 0
               
              IF msgyesno("Esta seguro de Reemplazar el Archivo "+CRLF+CRLF+;
                          GetOnlyName( cFile ) + " que ya existe ?","Atencion")
               
                   oServer:SqlQuery("update files set file = load_file('/xampp/mysql/bin/files/"+GetOnlyName( cFile )+"') where filename ='"+ GetOnlyName( cFile ) +"' and numdoc = '"+cDocu+"'")
           
                 Endif

            else

              IF msgyesno("Esta seguro de Anexar el Archivo "+CRLF+CRLF+;
                        GetOnlyName( cFile ) + " ?","Atencion")

                 if conexion_ftp(cFile)
       
                       oServer:Insert( "files", { "numdoc", "filename", "tam" }, { cDocu, GetOnlyName( cFile ), cTam  } )
                        oServer:SqlQuery("update files set file = load_file('/xampp/mysql/bin/files/"+GetOnlyName( cFile )+"') where filename ='"+ GetOnlyName( cFile ) +"' and numdoc = '"+cDocu+"'")
               
                     endif

              endif
               
           Endif
    
           oQryU:End()
       
         Msginfo("Archivo Guardado Satisfactoriamente !!")     
       
     ENDIF 

  ENDIF

CATCH oErr

     ShowError( oErr )
     RETURN NIL

END

RETURN

//--------------------------------------------//

Function LoadFile( cDocu )
Local oDlg, aGet1, aGet2, cDescrip:= space(80), cFile:=space(120)
/* LOCAL cFile := cGetFile( "Imagen Bitmap (*.bmp)| *.bmp|" +         ;
                         "Imagen JPEG   (*.jpg)| *.jpg|" +          ;
                         "Imagen GIF    (*.gif)| *.gif|"  +         ;
                         "Word          (*.doc*)| *.doc*|" +          ;
                         "Excel         (*.xls*)| *.xls*|" +          ;
                         "PowerPoint    (*.ppt*)| *.ppt*|" +          ;
                         "Adobe PDF     (*.pdf)| *.pdf|" +          ;
                         "Archivo Texto (*.txt)| *.txt|" +          ;
                         "Todos         (*.*)| *.*"             ;
                        ,"Seleccione un Archivo", 4 )

  */

   DEFINE DIALOG oDlg RESOURCE "BUSCAFILE" FONT oFontb // TRANSPARENT


    REDEFINE GET aGet1 VAR cDescrip ID 101            ;
             PICTURE "@X"                             ;
             OF oDlg UPDATE

    REDEFINE GET aGet2 VAR cFile ID 102               ;
             PICTURE "@X"                             ;
             OF oDlg UPDATE  READONLY


    REDEFINE BTNBMP oBot1 ID 301 RESOURCE "FOLDER_ADD_16" TOOLTIP "Buscar Archivo" OF oDlg  ;
           ACTION ( cFile := cGetFile( "Imagen Bitmap (*.bmp)| *.bmp|" +         ;
                                      "Imagen JPEG   (*.jpg)| *.jpg|" +          ;
                                      "Imagen GIF    (*.gif)| *.gif|"  +         ;
                                      "Word          (*.doc*)| *.doc*|" +          ;
                                      "Excel         (*.xls*)| *.xls*|" +          ;
                                      "PowerPoint    (*.ppt*)| *.ppt*|" +          ;
                                      "Adobe PDF     (*.pdf)| *.pdf|" +          ;
                                      "Archivo Texto (*.txt)| *.txt|" +          ;
                                      "Todos         (*.*)| *.*"             ;
                                      ,"Seleccione un Archivo", 9 ) , ;
                    iif(empty( cDescrip ), cDescrip := padr(GetOnlyName( cFile ),80) ,) ,;
                          aGet1:Refresh() ,;
                    aGet2:Refresh() , oBot2:Refresh()  )

     REDEFINE BUTTON oBot2 ID 1 OF oDlg ;
       Action ( msgrun("Subiendo el Archivo a la base de datos ......",;
                       "Por favor espere",;
                            {|| Sube_archivo( cDocu, cFile, cDescrip ) } ), oDlg:End() );
        WHEN ! empty( cDescrip ) .and. file( cFile )                   


     REDEFINE BUTTON oBot3 ID 2 OF oDlg ;
        Action oDlg:End()


    ACTIVATE DIALOG oDlg CENTERED


Return

//--------------------------------------------//

Function Sube_archivo( cDocu, cFile , cDescrip )
LOCAL uData
LOCAL oDlg

TRY

   IF ! Empty( cFile )

        ??? "Leyendo Archivo"
       
      // uData := D_ReadFile( cFile )

      uData  := memoread( cFile )

      ??? "Archivo leido"

      nTamb := len( udata )
      nTamk := int( nTamb / 1024 )
      nTam := nTamb / ( 1024 * 1024 )


      if nTam > nMaxFSize //2

          MsgStop( "No puede subir el archivo que intenta anexar, tiene "+alltrim( str( nTam,6,1 ) )+ "MB, "+;
                      "El limite maximo por archivo es "+alltrim( str( nMaxFSize,6,1 ) )+" MB"+CRLF+CRLF+;
                         "Si necesita subir un archivo mas grande dividalo en varios archivos","Atencion")
      else

            ???  "Identificando tamaños"

           if nTamb > ( 1024 * 1024 )
       
              cTam := alltrim( str( nTam, 6, 1 ) )+ " MBytes"
           
           elseif nTamb > 1024
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " KBytes"
       
           else
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " Bytes"

           endif
       
           if ! oServer:Insert( "files", { "numdoc", "filename","file", "tam","descripcion","fecha" }, { cDocu, GetOnlyName( cFile ), uData, cTam, cDescrip, date()  } )

      //   if conexion_ftp(cFile)
       
        //      oServer:Insert( "files", { "numdoc", "filename", "tam" }, { cDocu, GetOnlyName( cFile ), cTam  } )
        //       oServer:SqlQuery("update files set file = load_file('c:/xampp/mysql/bin/files/"+GetOnlyName( cFile )+"') where filename ='"+ GetOnlyName( cFile ) +"' and numdoc = '"+cDocu+"'")
       
              MsgInfo("No se pudo subir el archivo a la Base de Datos")
               
          endif

       ENDIF   

   ENDIF

CATCH oErr

     ShowError( oErr )
     RETURN NIL

END

RETURN

//-------------------------------------------//

Static FUNCTION GetOnlyName( cFile )

   LOCAL nRat

   IF ! Empty( cFile )
      nRat = RAt( "\", cFile )
      cFile = SubStr( cFile, nRat + 1 )
   ENDIF

RETURN cFile

//--------------------------------------------//

Function DataBrowse( cDocu )

   LOCAL oQry
   LOCAL oDlg
   LOCAL oBrw


   oQry = oServer:Query( "SELECT id, descripcion, filename,tam,fecha FROM files where numdoc = '"+cDocu+"' order by ID desc" )


   DEFINE DIALOG oDlg TITLE "Historial Anexos" SIZE 850, 400 FONT oFontb// TRANSPARENT

   @ 0, 0 XBROWSE oBrw OF oDLg FIELDS oQry:id, oQry:fecha,oQry:descripcion, AllTrim( oQry:filename ), oQry:tam ;
          HEADERS "ID","Fecha","Descripcion","Archivo","Tamaño";
          COLSIZES 50,80,290,290,80 ;
          JUSTIFY .F.,.F.,.F., .F.,AL_RIGHT ;
          LINES ;
          ON DBLCLICK SaveToTMP( oQry:Id, oQry )


   oBrw:SetDolphin( oQry, .f., .f. )
   
   oBrw:bPopUp        := { |o| ColMenu( o, oQry , oBrw ) }
   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW //MARQSTYLE_HIGHLWIN7
   oBrw:bKeyDown      := {|nKey| iif(nKey==13, SaveToTMP( oQry:Id, oQry ),) }
   oBrw:CreateFromCode()

   oDlg:oClient = oBrw

   ACTIVATE DIALOG oDlg ;
            ON INIT ( oDlg:Resize() ) ;
            CENTERED

   oQry:End()

RETURN

//------------------------------------------------//

static function ColMenu( oCol, oQry, oBrw )

   local oPop

   MENU oPop POPUP 2007
      MENUITEM "Guardar en carpeta" ACTION SaveToDisk( oCol:oBrw:aCols[ 1 ]:Value, oQry )
      MENUITEM "Eliminar registro"  ACTION iif( msgnoyes("Quiere eliminar este registro","Precaucion"), ;
                                                  ( oQry:Delete(), oQry:Refresh(), oBrw:Refresh() ) ,)

   ENDMENU

return oPop

//------------------------------------------------//

Static Function SaveToDisk( uValue, oQry )

   LOCAL nHandle
   LOCAL cDir := cGetDir( "Seleccione una Carpeta",;
                          CurDrive() + ":\" + GetCurDir() + "\" )
   LOCAL oQryFind

   IF ! Empty( cDir )

      oQry:Seek( uValue, "id", , , , .F. )

      cursorwait()

      oQryFind = TDolphinQry():New( "select file from files where id=" + ClipValue2Sql( uValue ), oQry:oServer )

      nHandle := FCreate( cDir + "\" + AllTrim( oQry:filename ) )

      IF FError() # 0
         MsgInfo( "Error grabando Archivo " + cDir + "\" + AllTrim( oQry:filename ) )
         RETURN
      ENDIF

      FWrite( nHandle, oQryFind:file, Len( oQryFind:file ) )
      FClose( nHandle )

        cursorarrow()
       
        cFilename := alltrim(oQry:filename)
       
      MsgInfo( "Archivo Guardado en la Carpeta: " + cDir )

      oQryFind:End()

        if Msgyesno("Desea Abrir el Archivo ?")
       
            open_archivo( cDir, cFilename )
       
        endif

   ENDIF

RETURN

//------------------------------------------------//

Static Function SaveToTMP( uValue, oQry )

   LOCAL nHandle, hWnd:=GetActiveWindow()
   LOCAL cDir := GetEnv("TEMP")

   LOCAL oQryFind

   oQry:Seek( uValue, "id", , , , .F. )

   cursorwait()

   oQryFind = TDolphinQry():New( "select file from files where id=" + ClipValue2Sql( uValue ), oQry:oServer )

    cFilename := AllTrim( oQry:filename )

//  if ! cFileExt( cFilename ) $ "JPG,JIF,GIF,BMP,DIB,RLE,TGA,PCX"

     nHandle := FCreate( cDir + "\" + cFilename )

     IF FError() # 0

      //   MsgInfo( "Error grabando Archivo " + cDir + "\" + AllTrim( oQry:filename ) )
         RETURN

     ENDIF

     FWrite( nHandle, oQryFind:file, Len( oQryFind:file ) )
     FClose( nHandle )

//   ENDIF

    cursorarrow()

    cImage := oQryFind:file
       
   oQryFind:End()

    open_archivo( cDir, cFilename, cImage )

RETURN

//-----------------------------------------//

Function open_archivo( cDir, cFilename, cImage )
hWnd:=GetActiveWindow()

        do case
       
        //  case cFileExt( cFilename ) == "PDF"

        //     Main_Pdf( cDir+"\"+cFilename )

          case  cFileExt( cFilename ) $ "XLSX,DOCX,PPTX"
       
         //   ShellExecute(hWnd,"open","excel.exe",'"'+cDir+"\"+cFilename+'"',,1)

              ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)

          case cFileExt( cFilename ) $ "JPG,JIF,GIF,BMP,DIB,RLE,TGA,PCX,PDF"
       
            //  VerImagen( cDir, cFilename, cImage )
       
              ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)
       
           otherwise
           
            ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)


        endcase
       

Return

//-----------------------------------------//

function Main_pdf(cFile)

   local oWnd, oActiveX

   DEFINE WINDOW oWnd TITLE "Controles Visor PDF" //TRANSPARENT

   oActiveX = TActiveX():New( oWnd, "AcroPDF.PDF.1" ) // Use "AcroPDF.PDF.1" for Acrobat Reader 7

   oWnd:oClient = oActiveX // To fill the entire window surface

   oActiveX:Do( "LoadFile", cFile  )
   oActiveX:Do( "SetCurrentPage", 1 )

   ACTIVATE WINDOW oWnd

return nil


//-----------------------------------------//

Static FUNCTION ShowError( oError )

  cErr:= " Error: No se pudo Subir el Archivo !!"+CRLF+;
         " Descripción  : " + oError:Description+CRLF+;
         " SubSystem    : " + oError:SubSystem+CRLF+;
         " Error Number : " + Str( oError:SubCode )+CRLF+;
         " Severity     : " + Str( oError:Severity )+CRLF

    mSginfo( cErr )

RETURN NIL

//-----------------------------------------------//

Slds

[nnicanor]

Para aclarar la las funciones para subir archivos a la base es sube_archivo()

para descargarlos uso la funcion savetotmp()

Para ver todos los archivos en la tabla uso la funcion databrowse()

Aqui esta el ejempo con todo lo necesario, en el anterior hay funciones par subir y bajar los archivos via ftp al servidor por una dificultad que se me presento con la funcion D_ReadFile() al final lo solucione usando memoread()

Code: Select all  Expand view  RUN

#include "xbrowse.ch"
#include "fivewin.ch"
#include "recursos.ch"
#include "hbcompat.ch"

#ifndef __XHARBOUR__
#define CurDrive  hb_curdrive
#endif


FUNCTION Menu_Anexo( cDoc )

   LOCAL oWnd3
   LOCAL oMenu

   cDocu := cDoc
   
   MENU oMenu POPUP 2007
       MENUITEM "Cargar Archivo" ACTION LoadFile( cDoc )
       MENUITEM "Listar Archivos" ACTION DataBrowse( cDoc )
   ENDMENU

RETURN oMenu

//--------------------------------------------//

Function LoadFile( cDocu )
Local oDlg, aGet1, aGet2, cDescrip:= space(80), cFile:=space(120)
/* LOCAL cFile := cGetFile( "Imagen Bitmap (*.bmp)| *.bmp|" +         ;
                         "Imagen JPEG   (*.jpg)| *.jpg|" +          ;
                         "Imagen GIF    (*.gif)| *.gif|"  +         ;
                         "Word          (*.doc*)| *.doc*|" +          ;
                         "Excel         (*.xls*)| *.xls*|" +          ;
                         "PowerPoint    (*.ppt*)| *.ppt*|" +          ;
                         "Adobe PDF     (*.pdf)| *.pdf|" +          ;
                         "Archivo Texto (*.txt)| *.txt|" +          ;
                         "Todos         (*.*)| *.*"             ;
                        ,"Seleccione un Archivo", 4 )

  */

   DEFINE DIALOG oDlg RESOURCE "BUSCAFILE" FONT oFontb // TRANSPARENT


    REDEFINE GET aGet1 VAR cDescrip ID 101            ;
             PICTURE "@X"                             ;
             OF oDlg UPDATE

    REDEFINE GET aGet2 VAR cFile ID 102               ;
             PICTURE "@X"                             ;
             OF oDlg UPDATE  READONLY


    REDEFINE BTNBMP oBot1 ID 301 RESOURCE "FOLDER_ADD_16" TOOLTIP "Buscar Archivo" OF oDlg  ;
           ACTION ( cFile := cGetFile( "Imagen Bitmap (*.bmp)| *.bmp|" +         ;
                                      "Imagen JPEG   (*.jpg)| *.jpg|" +          ;
                                      "Imagen GIF    (*.gif)| *.gif|"  +         ;
                                      "Word          (*.doc*)| *.doc*|" +          ;
                                      "Excel         (*.xls*)| *.xls*|" +          ;
                                      "PowerPoint    (*.ppt*)| *.ppt*|" +          ;
                                      "Adobe PDF     (*.pdf)| *.pdf|" +          ;
                                      "Archivo Texto (*.txt)| *.txt|" +          ;
                                      "Todos         (*.*)| *.*"             ;
                                      ,"Seleccione un Archivo", 9 ) , ;
                    iif(empty( cDescrip ), cDescrip := padr(GetOnlyName( cFile ),80) ,) ,;
                          aGet1:Refresh() ,;
                    aGet2:Refresh() , oBot2:Refresh()  )

     REDEFINE BUTTON oBot2 ID 1 OF oDlg ;
       Action ( msgrun("Subiendo el Archivo a la base de datos ......",;
                       "Por favor espere",;
                            {|| Sube_archivo( cDocu, cFile, cDescrip ) } ), oDlg:End() );
        WHEN ! empty( cDescrip ) .and. file( cFile )                   


     REDEFINE BUTTON oBot3 ID 2 OF oDlg ;
        Action oDlg:End()


    ACTIVATE DIALOG oDlg CENTERED


Return

//--------------------------------------------//

Function Sube_archivo( cDocu, cFile , cDescrip )
LOCAL uData
LOCAL oDlg

TRY

   IF ! Empty( cFile )

        ??? "Leyendo Archivo"
       
      // uData := D_ReadFile( cFile )

      uData  := memoread( cFile )

      ??? "Archivo leido"

      nTamb := len( udata )
      nTamk := int( nTamb / 1024 )
      nTam := nTamb / ( 1024 * 1024 )


      if nTam > nMaxFSize //2

          MsgStop( "No puede subir el archivo que intenta anexar, tiene "+alltrim( str( nTam,6,1 ) )+ "MB, "+;
                      "El limite maximo por archivo es "+alltrim( str( nMaxFSize,6,1 ) )+" MB"+CRLF+CRLF+;
                         "Si necesita subir un archivo mas grande dividalo en varios archivos","Atencion")
      else

            ???  "Identificando tamaños"

           if nTamb > ( 1024 * 1024 )
       
              cTam := alltrim( str( nTam, 6, 1 ) )+ " MBytes"
           
           elseif nTamb > 1024
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " KBytes"
       
           else
       
              cTam := alltrim( str( nTamk, 6, 0 ) )+ " Bytes"

           endif
       
           if ! oServer:Insert( "files", { "numdoc", "filename","file", "tam","descripcion","fecha" }, { cDocu, GetOnlyName( cFile ), uData, cTam, cDescrip, date()  } )

       
              MsgInfo("No se pudo subir el archivo a la Base de Datos")
               
          endif

       ENDIF   

   ENDIF

CATCH oErr

     ShowError( oErr )
     RETURN NIL

END

RETURN

//-------------------------------------------//

Static FUNCTION GetOnlyName( cFile )

   LOCAL nRat

   IF ! Empty( cFile )
      nRat = RAt( "\", cFile )
      cFile = SubStr( cFile, nRat + 1 )
   ENDIF

RETURN cFile

//--------------------------------------------//

Function DataBrowse( cDocu )

   LOCAL oQry
   LOCAL oDlg
   LOCAL oBrw


   oQry = oServer:Query( "SELECT id, descripcion, filename,tam,fecha FROM files where numdoc = '"+cDocu+"' order by ID desc" )


   DEFINE DIALOG oDlg TITLE "Historial Anexos" SIZE 850, 400 FONT oFontb// TRANSPARENT

   @ 0, 0 XBROWSE oBrw OF oDLg FIELDS oQry:id, oQry:fecha,oQry:descripcion, AllTrim( oQry:filename ), oQry:tam ;
          HEADERS "ID","Fecha","Descripcion","Archivo","Tamaño";
          COLSIZES 50,80,290,290,80 ;
          JUSTIFY .F.,.F.,.F., .F.,AL_RIGHT ;
          LINES ;
          ON DBLCLICK SaveToTMP( oQry:Id, oQry )


   oBrw:SetDolphin( oQry, .f., .f. )
   
   oBrw:bPopUp        := { |o| ColMenu( o, oQry , oBrw ) }
   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW //MARQSTYLE_HIGHLWIN7
   oBrw:bKeyDown      := {|nKey| iif(nKey==13, SaveToTMP( oQry:Id, oQry ),) }
   oBrw:CreateFromCode()

   oDlg:oClient = oBrw

   ACTIVATE DIALOG oDlg ;
            ON INIT ( oDlg:Resize() ) ;
            CENTERED

   oQry:End()

RETURN

//------------------------------------------------//

static function ColMenu( oCol, oQry, oBrw )

   local oPop

   MENU oPop POPUP 2007
      MENUITEM "Guardar en carpeta" ACTION SaveToDisk( oCol:oBrw:aCols[ 1 ]:Value, oQry )
      MENUITEM "Eliminar registro"  ACTION iif( msgnoyes("Quiere eliminar este registro","Precaucion"), ;
                                                  ( oQry:Delete(), oQry:Refresh(), oBrw:Refresh() ) ,)

   ENDMENU

return oPop

//------------------------------------------------//

Static Function SaveToTMP( uValue, oQry )

   LOCAL nHandle, hWnd:=GetActiveWindow()
   LOCAL cDir := GetEnv("TEMP")

   LOCAL oQryFind

   oQry:Seek( uValue, "id", , , , .F. )

   cursorwait()

   oQryFind = TDolphinQry():New( "select file from files where id=" + ClipValue2Sql( uValue ), oQry:oServer )

    cFilename := AllTrim( oQry:filename )

//  if ! cFileExt( cFilename ) $ "JPG,JIF,GIF,BMP,DIB,RLE,TGA,PCX"

     nHandle := FCreate( cDir + "\" + cFilename )

     IF FError() # 0

      //   MsgInfo( "Error grabando Archivo " + cDir + "\" + AllTrim( oQry:filename ) )
         RETURN

     ENDIF

     FWrite( nHandle, oQryFind:file, Len( oQryFind:file ) )
     FClose( nHandle )

//   ENDIF

    cursorarrow()

    cImage := oQryFind:file
       
   oQryFind:End()

    open_archivo( cDir, cFilename, cImage )

RETURN

//-----------------------------------------//

Function open_archivo( cDir, cFilename, cImage )
hWnd:=GetActiveWindow()

        do case
       
        //  case cFileExt( cFilename ) == "PDF"

        //     Main_Pdf( cDir+"\"+cFilename )

          case  cFileExt( cFilename ) $ "XLSX,DOCX,PPTX"
       
         //   ShellExecute(hWnd,"open","excel.exe",'"'+cDir+"\"+cFilename+'"',,1)

              ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)

          case cFileExt( cFilename ) $ "JPG,JIF,GIF,BMP,DIB,RLE,TGA,PCX,PDF"
       
            //  VerImagen( cDir, cFilename, cImage )
       
              ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)
       
           otherwise
           
            ShellExecute(,"Open",'"'+cDir+"\"+cFilename+'"',,,3)


        endcase
       

Return

//-----------------------------------------//

function Main_pdf(cFile)

   local oWnd, oActiveX

   DEFINE WINDOW oWnd TITLE "Controles Visor PDF" //TRANSPARENT

   oActiveX = TActiveX():New( oWnd, "AcroPDF.PDF.1" ) // Use "AcroPDF.PDF.1" for Acrobat Reader 7

   oWnd:oClient = oActiveX // To fill the entire window surface

   oActiveX:Do( "LoadFile", cFile  )
   oActiveX:Do( "SetCurrentPage", 1 )

   ACTIVATE WINDOW oWnd

return nil


//-----------------------------------------//

Static FUNCTION ShowError( oError )

  cErr:= " Error: No se pudo Subir el Archivo !!"+CRLF+;
         " Descripción  : " + oError:Description+CRLF+;
         " SubSystem    : " + oError:SubSystem+CRLF+;
         " Error Number : " + Str( oError:SubCode )+CRLF+;
         " Severity     : " + Str( oError:Severity )+CRLF

    mSginfo( cErr )

RETURN NIL

//-----------------------------------------------//

Slds

[Marcelo Roggeri]

Hola Nicanor, muchas gracias por tu explicación y por el código, ya me estoy poniendo a verlo y analizarlo. Creo encontrarle una buena aplicación al mismo. Te cuento que estoy iniciandome con Dolphin y todo me es nuevo.
Un abrazo a la distancia.
Marcelo

[nnicanor]

Creo que en el codigo falta esto.

Slds

Code: Select all  Expand view  RUN

//------------------------------------------------//

static function ColMenu( oCol, oQry, oBrw )

   local oPop

   MENU oPop POPUP 2007
      MENUITEM "Guardar en carpeta" ACTION SaveToDisk( oCol:oBrw:aCols[ 1 ]:Value, oQry )
      MENUITEM "Eliminar registro"  ACTION iif( msgnoyes("Quiere eliminar este registro","Precaucion"), ;
                                                  ( oQry:Delete(), oQry:Refresh(), oBrw:Refresh() ) ,)

   ENDMENU

return oPop

//------------------------------------------------//

Static Function SaveToDisk( uValue, oQry )

   LOCAL nHandle
   LOCAL cDir := cGetDir( "Seleccione una Carpeta",;
                          CurDrive() + ":\" + GetCurDir() + "\" )
   LOCAL oQryFind

   IF ! Empty( cDir )

      oQry:Seek( uValue, "id", , , , .F. )

     cursorwait()

      oQryFind = TDolphinQry():New( "select file from files where id=" + ClipValue2Sql( uValue ), oQry:oServer )

      nHandle := FCreate( cDir + "\" + AllTrim( oQry:filename ) )

      IF FError() # 0
         MsgInfo( "Error grabando Archivo " + cDir + "\" + AllTrim( oQry:filename ) )
         RETURN
      ENDIF

      FWrite( nHandle, oQryFind:file, Len( oQryFind:file ) )
      FClose( nHandle )

        cursorarrow()
       
        cFilename := alltrim(oQry:filename)
       
      MsgInfo( "Archivo Guardado en la Carpeta: " + cDir )

      oQryFind:End()

        if Msgyesno("Desea Abrir el Archivo ?")
       
            open_archivo( cDir, cFilename )
       
        endif

   ENDIF

RETURN

//------------------------------------------------//