Resultado do teste: 20 segundos usando tabela temporária em memória.
Harbour 3.4 fork atualizado e compilado ontem.
Código: Selecionar todos
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "dbinfo.ch"
#include "fileio.ch"
#include "hbdyn.ch"
#include "hbthread.ch"
#include "hbhrb.ch"
#include "common.ch"
#include "error.ch"
#include "hboo.ch"
#include "inkey.ch"
#include "hbclass.ch"
#include "common.ch"
#include "Memoedit.ch"
#include "hbcompat.ch"
FUNCTION MAIN()
thread static cx := "00:00:00"
thread static nTimeOut := 0
LOCAL cTeste1:=Space(8), cTeste2:=Space(8), cTeste3:=Space(8), cteste:="1", oElemento, a
LOCAL aField[26]
/*
* Estrutura do arquivo: ConRec.DBF
*/
aField[01] := {"COCLI" , "C", 8, 0}
aField[02] := {"NOMECLI" , "C", 30, 0}
aField[03] := {"CODPRO" , "C", 6, 0}
aField[04] := {"DESCPROD" , "C", 30, 0}
aField[05] := {"QTDE" , "N", 10, 3}
aField[06] := {"PRECO" , "N", 12, 2}
aField[07] := {"DESCONTO" , "N", 12, 2}
aField[08] := {"VENDA" , "C", 6, 0}
aField[09] := {"DTCOMPRA" , "D", 8, 0}
aField[10] := {"PRAZO" , "N", 5, 0}
aField[11] := {"VENCIMENTO", "D", 8, 0}
aField[12] := {"PAGO" , "C", 1, 0}
aField[13] := {"VALORPG" , "N", 12, 2}
aField[14] := {"DATAPG" , "D", 8, 0}
aField[15] := {"COBRAR" , "C", 1, 0}
aField[16] := {"CODCOBRAD" , "C", 3, 0}
aField[17] := {"DTCOBRANC" , "D", 8, 0}
aField[18] := {"DTAGENDAM" , "D", 8, 0}
aField[19] := {"COMISSAO" , "N", 12, 2}
aField[20] := {"VLRCOMIS" , "N", 12, 2}
aField[21] := {"DTFECHAM" , "D", 8, 0}
aField[22] := {"HORARECEB" , "C", 5, 0}
aField[23] := {"TIPODOC" , "C", 1, 0}
aField[24] := {"NRDOC" , "C", 20, 0}
aField[25] := {"TAXAADM" , "N", 12, 2}
aField[26] := {"CANCELADO" , "C", 1, 2}
IF ! hb_FileExists( "CONREC.DBF" )
fErase( "CONREC.CDX" )
DbCreate( "CONREC", aField, "DBFCDX", .T., "CONREC" )
INDEX ON COCLI TAG COCLI TO CONREC //TEMPORARY
FOR I:=1 TO 3000000
Inkey()
IF LastKey() = 27
EXIT
ENDIF
@ 01,01 SAY Transform( I, "9999999" )
CONREC->( DbAppend() )
CONREC->COCLI := StrZero( I, 8 )
CONREC->NOMECLI := Replicate( "N", 30 )
CONREC->CODPRO := StrZero( 1, 6 )
CONREC->DESCPROD := Replicate( "D", 30 )
CONREC->QTDE := 1.000
CONREC->PRECO := 1.00
CONREC->DESCONTO := 1.00
CONREC->VENDA := StrZero( 1, 6 )
CONREC->DTCOMPRA := Date()
CONREC->PRAZO := 30
CONREC->VENCIMENTO := Date() + 30
CONREC->PAGO := "N"
CONREC->VALORPG := 1.00
CONREC->DATAPG := Date()
CONREC->COBRAR := "S"
CONREC->CODCOBRAD := "000"
CONREC->DTCOBRANC := Date()
CONREC->DTAGENDAM := Date()
CONREC->COMISSAO := 1.00
CONREC->VLRCOMIS := 1.00
CONREC->DTFECHAM := Date()
CONREC->HORARECEB := Left( Time(), 5 )
CONREC->TIPODOC := "T"
CONREC->NRDOC := StrZero( I, 20 )
CONREC->TAXAADM := 1.00
CONREC->CANCELADO := IF( Mod( I, 5000 ) = 0, "S", "N" )
IF Mod( I, 10000 ) = 0 //A cada 10000 registros faz um Commit na tabela
CONREC->( DbCommit() )
ENDIF
CONREC->( DbUnlock() )
NEXT
CONREC->( DbCommit() )
DbCloseAll()
ENDIF
nSecIni := Seconds()
DbCreate("mem:tstMemory", aField, "DBFCDX", .T., "tstMemory")
APPEND FROM ConRec.DBF FOR field->Cancelado == 'S' WHILE Evento() //para não sobrecarregar a aplicação
hb_Alert("Tempo total -> " + SecToTime( Seconds() - nSecIni ))
RETURN Nil
FUNCTION Evento
hwg_DoEvents()
RETURN .T.
FUNCTION SaidaSistema()
hwg_ExitProcess()
RETURN Nil
FUNCTION Sombra()
LOCAL Tela1, Tela2, Tela3, Tela4
_Li:=hb_PValue(1)
_Ci:=hb_PValue(2)
_Lf:=hb_PValue(3)
_Cf:=hb_PValue(4)
IF _Cf >= MaxCol() + 1
_Cf := MaxCol()
ENDIF
Tela3 := SaveScreen( _Li+1, _Cf+1, _Lf+1, _Cf+1 )
Tela4 := SaveScreen( _Lf+1, _Ci+1, _Lf+1, _Cf+1 )
FOR Tela1 := 2 TO Len(Tela3) STEP 2
Tela2 := Shadow( ASC( SubStr( Tela3, Tela1, 1 ) ) )
Tela3 := Stuff(Tela3, Tela1, 1, Tela2)
END
FOR Tela1 := 2 TO Len( Tela4 ) STEP 2
Tela2 := Shadow( ASC( SubStr( Tela4, Tela1, 1 ) ) )
Tela4 := Stuff( Tela4, Tela1, 1, Tela2 )
END
RestScreen( _Li+1, _Cf+1, _Lf+1, _Cf+1, Tela3 )
RestScreen( _Lf+1, _Ci+1, _Lf+1, _Cf+1, Tela4 )
RETURN Nil
FUNCTION Shadow()
LOCAL Var1, Var2, Var3
_Car := hb_PValue(1)
Var1 := _Car % 16
Var2 := ( _Car - Var1 ) / 16
Var3 := { 0, 0, 8, 8, 0, 8, 0, 8, 0, 1, 2, 3, 4, 5, 6, 7 }
Var1 := Var3[ Var1 + 1 ]
Var2 := Var3[ Var2 + 1 ]
RETURN Chr( 16 * Var2 + Var1 )
FUNCTION RestauraWvt()
wvg_SetForegroundWindow( hb_gtInfo( HB_GTI_WINHANDLE ) )
hwg_SendMessage( hb_gtInfo( HB_GTI_WINHANDLE ), WM_SYSCOMMAND, SC_RESTORE, 0 )
RETURN Nil
FUNCTION Execute( cProgram, cParameter, lEspera )
LOCAL oShell, lOk := .T., nStyle
lEspera := hb_DefaultValue(lEspera, .T.)
TRY
oShell := Win_OleCreateObject( "WScript.Shell" )
CATCH
TRY
oShell := Win_OleCreateObject( "WScript.Shell" )
CATCH
lOk := .F.
END
END
IF lOk
TRY
/*
intWindowStyle
Description
0 Hides the window and activates another window.
1 Activates and displays a window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
2 Activates the window and displays it as a minimized window.
3 Activates the window and displays it as a maximized window.
4 Displays a window in its most recent size and position. The active window remains active.
5 Activates the window and displays it in its current size and position.
6 Minimizes the specified window and activates the next top-level window in the Z order.
7 Displays the window as a minimized window. The active window remains active.
8 Displays the window in its current state. The active window remains active.
9 Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
10 Sets the show-state based on the state of the program that started the application.
*/
nStyle := 3//1
//oShell:Run("sumatrapdf.exe -print-to-default -reuse-instance -lang pt "+cSource, nStyle, lEspera)
//oShell:Run("sumatrapdf.exe -print-to "+'"'+cPrinter+'"'+" -reuse-instance -lang pt "+cSource, nStyle, lEspera)
oShell:Run(cProgram +" "+cParameter, nStyle, lEspera)
CATCH
hwg_MsgStop("Erro executando "+cProgram, "Erro")
lOk := .F.
END
oShell := Nil
ENDIF
RETURN lOk
/*********************************************************************/
INIT FUNCTION AppSetup()
//ANNOUNCE hwg_ErrSys
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
REQUEST HB_CODEPAGE_PTISO
HB_LANGSELECT("PT")
HB_CDPSELECT( "PT850" )
REQUEST DBFNTX
REQUEST DBFCDX
REQUEST HB_MEMIO
RddSetDefault("DBFCDX")
SET TYPEAHEAD TO 0
SET INTENSITY ON
SET SCOREBOARD OFF
SET DELETED ON
SET SAFETY OFF
SET DATE ANSI
SET ESCAPE ON
SET DATE FORMAT "DD/MM/YY"
SET DELIMITERS TO
SET EXCLUSIVE OFF
SET WRAP ON
SET EPOCH TO 1920
//SET OPTIMIZE ON
SET AUTOPEN OFF
//SET DBFLOCKSCHEME TO DB_DBFLOCK_CLIPPER
SET MESSAGE TO 24 CENTER
hb_gtReload( "WVT" )
SetMode(26, 80)
SetColor("W+/B")
CLS
IniciaJanela()
RETURN Nil
FUNCTION IniciaJanela()
cTituloJanela:="Teste Diversos"
HB_gtInfo( HB_GTI_FONTNAME, "Lucida Console")
HB_gtInfo( HB_GTI_WINTITLE, cTituloJanela)
HB_gtInfo( HB_GTI_ICONFILE, "P:\GERAL\HARBOUR\HARB_WIN.ICO" )
HB_gtInfo( HB_GTI_CLOSABLE, .F. )
HB_gtInfo( HB_GTI_ISGRAPHIC, .T. )
HB_gtInfo( HB_GTI_STDERRCON, .T. )
HB_gtInfo( HB_GTI_COMPATBUFFER, .T. )
HB_gtInfo( HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
HB_gtInfo( HB_GTI_SPEC, HB_GTS_SHOWWINDOW, SW_NORMAL )
HB_gtInfo( HB_GTI_MAXIMIZED, .T. )
//HB_gtInfo( HB_GTI_ISFULLSCREEN, .T. ) // tela cheia
RETURN Nil
FUNCTION HB_GTSYS()
REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_GT_WVG
REQUEST HB_GT_WGU
REQUEST HB_GT_WVT
RETURN Nil
#pragma BEGINDUMP
#pragma comment( lib, "shell32.lib" )
#include "hbapi.h"
#include <windows.h>
HB_FUNC( _OPENHELPFILE )
{
HINSTANCE hInst;
LPCTSTR lpPath = (LPTSTR) hb_parc( 1 );
LPCTSTR lpHelpFile = (LPTSTR) hb_parc( 2 );
hInst = ShellExecute( 0, "open", lpHelpFile, 0, lpPath, SW_SHOW );
hb_retnl( (LONG) hInst );
return;
}
#pragma ENDDUMP
#pragma BEGINDUMP
#include <windows.h>
#include <shlobj.h>
#include <math.h>
#include "hbapi.h"
#include "hbvm.h"
#include "hbstack.h"
#include "hbapiitm.h"
HB_FUNC( SETENVIRONMENTVARIABLE2 )
{
hb_retl( SetEnvironmentVariableA( (LPCSTR) hb_parcx( 1 ),
(LPCSTR) hb_parcx( 2 )
) ) ;
}
#pragma ENDDUMP
#pragma BEGINDUMP
#include <windows.h>
#include <tchar.h>
#include <stdio.h>
#include <hbapi.h>
char * LToStr( long );
HB_FUNC( ENVPARAM )
{
LPTSTR lpszVariable;
LPTCH lpvEnv;
char * pszBuffer = NULL;
int iLastLen = 0;
// Get a pointer to the environment block.
lpvEnv = GetEnvironmentStrings();
// If the returned pointer is NULL, exit.
if (lpvEnv == NULL)
{
printf("GetEnvironmentStrings failed (%d)\n", GetLastError());
return ;
}
// Variable strings are separated by NULL byte, and the block is
// terminated by a NULL byte.
lpszVariable = (LPTSTR) lpvEnv;
while (*lpszVariable)
{
char * newBuffer;
int iLen = lstrlen( lpszVariable );
pszBuffer = hb_xrealloc( pszBuffer, iLastLen + iLen + 2 );
hb_xmemcpy( pszBuffer+iLastLen, lpszVariable, iLen );
hb_xmemcpy( pszBuffer+iLastLen+iLen, "\r\n", 2 );
iLastLen += iLen + 2;
lpszVariable += lstrlen(lpszVariable) + 1;
}
FreeEnvironmentStrings(lpvEnv);
hb_retc( pszBuffer );
}
#pragma ENDDUMP
#pragma BEGINDUMP
#include "windows.h"
#include "time.h"
#include "hbapi.h"
#define VK_ZERO 0x30
HB_FUNC( PEGAINATIVIDADE2 )
{
LASTINPUTINFO lpi;
lpi.cbSize = sizeof (LASTINPUTINFO);
GetLastInputInfo (&lpi);
hb_retnd( ( DOUBLE ) ( GetTickCount() - lpi.dwTime ) / CLOCKS_PER_SEC );
}
HB_FUNC( GETINPUTSTATE )
{
LASTINPUTINFO lpi;
lpi.cbSize = sizeof(LASTINPUTINFO);
if (!GetLastInputInfo(&lpi))
{
hb_retni(0);
}
hb_retni(lpi.dwTime);
}
HB_FUNC( ENVIATECLA2 )
{
keybd_event(hb_parnl( 1 ), 0, 0, 0);
}
#pragma ENDDUMP
#pragma begindump
#include <shlobj.h>
#include <windows.h>
#include "hbapi.h"
HB_FUNC( PRESSKEY )
/*
Testa a tecla e pressiona
Recebe o valor da tecla
*/
{
BYTE keyState[256];
GetKeyboardState((LPBYTE)&keyState);
if (keyState[hb_parni(1)] == 0) // testa se a tecla est ativa
{
// Simula pressionamento
keybd_event( hb_parni(1), 0, KEYEVENTF_EXTENDEDKEY | 0, 0 );
keybd_event( hb_parni(1), 45, KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0 );
}
}
HB_FUNC( PRESSMOUSE )
/*
Simula pressionamento dos botäes do mouse
Recebe
.T. - Esquerdo
.F. - Direito
*/
{
if ( hb_parl(1) )
{
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) ;
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) ;
}
else
{
mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0) ;
mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0) ;
}
}
HB_FUNC( HB_SENDKEY2 )
{
INPUT input;
input.type = INPUT_KEYBOARD;
input.ki.wVk = hb_parnl( 1 );
input.ki.wScan = 0;
input.ki.dwFlags = 0;
input.ki.time = 0;
input.ki.dwExtraInfo = 0;
hb_retnl( SendInput( 1, &input, sizeof( input ) ) );
}
HB_FUNC( HB_MOVE )
{
INPUT Input = { 0 };
Input.type = INPUT_MOUSE;
Input.mi.dx = (LONG) hb_parnl( 1 );
Input.mi.dy = (LONG) hb_parnl( 2 );
// set move cursor directly
Input.mi.dwFlags = MOUSEEVENTF_MOVE | MOUSEEVENTF_ABSOLUTE;
SendInput(1, &Input, sizeof(INPUT));
}
static HB_BOOL hb_ctGetWinCord( int * piTop, int * piLeft,
int * piBottom, int * piRight )
{
int iMaxRow = hb_gtMaxRow();
int iMaxCol = hb_gtMaxCol();
hb_gtGetPosEx( piTop, piLeft );
if( HB_ISNUM( 1 ) )
*piTop = hb_parni( 1 );
if( HB_ISNUM( 2 ) )
*piLeft = hb_parni( 2 );
if( HB_ISNUM( 3 ) )
{
*piBottom = hb_parni( 3 );
if( *piBottom > iMaxRow )
*piBottom = iMaxRow;
}
else
*piBottom = iMaxRow;
if( HB_ISNUM( 4 ) )
{
*piRight = hb_parni( 4 );
if( *piRight > iMaxCol )
*piRight = iMaxCol;
}
else
*piRight = iMaxCol;
return *piTop >= 0 && *piLeft >= 0 &&
*piTop <= *piBottom && *piLeft <= *piRight;
}
HB_FUNC( SCREENTEXTO ) /* HB_EXTENSION */
{
int iTop, iLeft, iBottom, iRight;
if( hb_ctGetWinCord( &iTop, &iLeft, &iBottom, &iRight ) )
{
char * pBuffer;
char * szText;
HB_SIZE nSize = ( HB_SIZE ) ( iBottom - iTop + 1 ) * ( iRight - iLeft + 1 );
szText = pBuffer = ( char * ) hb_xgrab( nSize + 1 );
while( iTop <= iBottom )
{
int iCol = iLeft;
while( iCol <= iRight )
{
int iColor;
HB_BYTE bAttr;
HB_USHORT usChar;
hb_gtGetChar( iTop, iCol, &iColor, &bAttr, &usChar );
*szText++ = ( char ) usChar;
++iCol;
}
++iTop;
}
hb_retclen_buffer( pBuffer, nSize );
}
else
hb_retc_null();
}
HB_FUNC( PLAYSOUND ) /* HB_EXTENSION */
{
PlaySound(TEXT((LPCSTR) hb_parcx( 1 )), NULL, SND_SYNC);
//PlaySound(TEXT((LPCSTR) hb_parcx( 1 )), NULL, SND_FILENAME | SND_NODEFAULT);
//PlaySound(TEXT("SystemStart"), NULL, SND_ALIAS);
}
#pragma enddump