FiveTech Support Forums

/*
  2 REVISION, 5 Threads corriendo....always!!
   Example multiThreads index.
   One thread by table , and one thread by index.
   2010 Rafa Carmona

   Thread Main
        |--------->  table for test.dbf
        |                        |----> Thread child index fname
        |                        |
        |                        |----->Thread child index fcode
   c:\> ..\..\bin\win\bcc\hbmk2 -mt indexpms -lhbcpage -Le:\harbour\trunk\harbour\lib\win\bcc


 */
#include "hbclass.ch"
#include "hbthread.ch"
#include "inkey.ch"
#include "common.ch"

REQUEST HB_CODEPAGE_ES850, HB_CODEPAGE_ES850C
REQUEST HB_LANG_ES

#define N_THREADS 5

STATIC nTecla
STATIC s_num_procesos
STATIC s_aLineas := { 1, 16, 32, 48, 64 }
static s_hMutex

proc Main( cTable_Dbf )
    Local nSeconds
    Local cDbf, lProcesa := .F.
    Local aFicheros, x
    Local aDbfs, aNtxs, aKeys , aDesc, aFor, aSel
    Local aThreads := {}
    Local nProceso := 0, nLinea, lSalir := .F., nIndex
    Local nLen_Table
    Local nPosTable

    DEFAULT cTable_Dbf TO "TODOS"

     //HB_SetCodePage( "ES850C" ) En xHarbour
    set( _SET_CODEPAGE, "ES850C" )  // Para Clipper Compatible

    HB_LANGSELECT('ES')
    Set( _SET_LANGUAGE, "ES" )

    setmode( 25,80 )
    cls

    if empty( cTable_Dbf )
       ctable_dbf := ""
    endif

    @01,0 SAY padc( hb_ansitooem( "  Indexación múltiple. (c)2010 Rafa Carmona" ), 80 )COLOR "N*/W*"
    @23,0 SAY padc( "Pulse ESC para cancelar." , 80) COLOR "R+/N"

    aFicheros := LoadArray()
    aDbfs := aFicheros[1]
    aNtxs := aFicheros[2]
    aKeys := aFicheros[3]
    aFor  := aFicheros[4]

    nLen_Table := len( aDbfs )
    nPosTable  := 1
    nSeconds := Seconds()
    s_num_procesos := 0
    s_hMutex := hb_mutexCreate()



   while nPosTable <= nLen_Table

        if ( nTecla := inkey() ) = K_ESC
           exit
        endif

        if N_THREADS = s_num_procesos // No se ha muerto ningun proceso
          loop
        endif

        cDbf := aDbfs[ nPosTable ]

        do case
           case UPPER( cTable_Dbf  ) == "TODOS"
                lProcesa := .T.
           case UPPER( alltrim( cTable_Dbf ) ) == UPPER( alltrim( cDbf ) )
                lProcesa := .T.
           otherwise
                lProcesa := .F.
        end case

        if lProcesa .and. file( cDbf+".dbf" )
           hb_mutexLock( s_hMutex )
           s_num_procesos++
           hb_mutexUnLock( s_hMutex )
           hb_threadStart( @aCreateIndexe(), cDbf, aNtxs[ nPosTable ], aKeys[ nPosTable ], aFor[ nPosTable ]  )
           hb_idleSleep(0.05)
        endif

        nPosTable++
    end while

  @23,1 SAY "Espere, terminado reindexaciones pendientes..." + space( 50 ) COLOR "R*/N"
  hb_threadWaitForAll() // Esperamos a los ultimos.
  @23,1 SAY "Proceso de indexacion terminado..." + Str( (Seconds() - nSeconds) /60 ) + space( 50 ) COLOR "W+/N"

return


function aCreateIndexe( cFile, aNtx, aExpr, aFor )
       Local nContador := 1
       Local cFileNtx, cExpr
       Local aThreads := {}
       Local cAlias, cFor
       Local  nP, x

       for x := 1 to 5
          nPosLinea := s_aLineas[ x ]
          if !empty( nPosLinea )
              s_aLineas[x] := 0  // Quita del array esa linea disponible para pintar
              exit
          endif
       next

       @ 2, nPosLinea CLEAR TO 15, nPosLinea + 14 // Limpiamos cuadrado

       hb_dispOutAt( 2, nPosLinea , cFile )

       use ( cFile )
       cAlias := alias()
       hb_dbDetach( cAlias )  // Libero el alias

       for each cFileNtx in aNtx
           cExpr  := aExpr[ cFileNtx:__enumindex ]
           cFor   := aFor[ cFileNtx:__enumindex ]
           nPos   := cFileNtx:__enumindex
           delete file ( cFileNtx +".ntx")  // Se borra el fichero, por ahorro de espacio en disco.
           aadd( aThreads, hb_threadStart( @crea(), cAlias,cExpr, cFileNtx, cFor, nPos, nPosLinea ) )
           if ( nTecla := inkey() ) = K_ESC  // No protegemos variable static
              exit
           endif
       next

       aEval( aThreads, { |x| hb_threadJoin( x ) } )  // Espera que termine los hilos hijos

       hb_dbRequest( cAlias, , , .T.)  // Restaura el alias
       close

       // Vuelve a coloar la linea como disponible para pintar
       s_aLineas[x] := nPosLinea
       hb_mutexLock( s_hMutex )
       s_num_procesos--
       hb_mutexUnLock( s_hMutex )

RETURN .T.

proc crea( cAlias, cExpr, cFileNtx, cFor, nPos, nPosLinea )
      Local nContador := 1

       hb_dbRequest( cAlias, , , .T.)  // Restaura el alias
       if empty( cfor )
           INDEX ON &(cExpr) TO &(cFileNtx) ;
                 EVAL {|| hb_dispOutAt( nPos +3, nPosLinea, padr( cFileNtx,8 )+ "-"+alltrim( hb_valtostr( nContador) ), "GR+/N" ), nContador += INT( LASTREC() / 100 ) , .T. } ;
                 EVERY INT( LASTREC() / 100 )
//                 EVAL {|| hb_dispOutAt( nPos +2, nPosLinea, padr( cFileNtx,8 )+ "-"+ padr( cExpr,20)+ " # " +alltrim( hb_valtostr( nContador) ), "GR+/N" ), nContador += INT( LASTREC() / 100 ) , .T. } ;
       else
           INDEX ON &(cExpr) TO &(cFileNtx) FOR &(cFor) ;
                 EVAL {|| hb_dispOutAt( nPos +3, nPosLinea, padr( cFileNtx,8 )+ "-"+alltrim( hb_valtostr( nContador) ), "GR+/N" ), nContador += INT( LASTREC() / 100 ) , .T. } ;
                 EVERY INT( LASTREC() / 100 )
       endif
       hb_dbDetach( cAlias )          // Libera el alias


return