Jmsilva

Via ADO também!

Pelo teste que fiz por aqui esta lib pertence a Fivewin. Lib FiveH.lib Minha versão 17.05

No Harbour = hbrtl.lib e XHarbour=rtl.lib

oBrw:lSeekBar := .t. oBrw:bClrEdits := {|| {CLR_HRED,CLR_YELLOW}} Olá, alguém já se aventurou a testar o "lseekbar", pesquisa da coluna. No meu teste ele ativa mas não permitea digitação no get e nem ativa o cursor! Se alguém tiver algum exemplo bacana e puder compartilhar!

https://www.diadoacbr.com.br/#palestrantes

Edu, esta classe eu criei e funciona perfeitamente no meu projeto, algumas dicas: Veja se ajuda! - http://fivetechsoft.com/wiki/doku.php?id=fwh_ado_api - Lib da fivewin ***====================================================================*** *** Sistema....: WSACE- *** *** Rotina.....: T_SqlAdo.PRG *** *** Linguagem..: Harbour/Fivewin *** *** Programador: JMSILVA *** *** Data.......: 13/09/2016 *** ***====================================================================*** #INCLUDE "FIVEWIN.CH" #INCLUDE "ERROR.CH" //tratamento de erro falta **============================================================================= CLASS TSqlADO **============================================================================= DATA cDBSql,cHost,cDsn PROTECTED DATA hCon,hStmt HIDDEN DATA aErrors INIT {} DATA lSuccess INIT .T. PROTECTED DATA nRecCount INIT 0 DATA cTitle,cLastErro DATA cFileErro PROTECTED DATA nLast_Insert_ID INIT 0 // EM TESTE FALTA IMPLEMENTAR METHOD New() CONSTRUCTOR METHOD Server(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD MariaDB(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD MySql(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD Close() METHOD IsErrorSql() INLINE !::lSuccess METHOD MsgError() INLINE ::cLastErro METHOD IdError() INLINE IIF(::lSuccess,0,-1) METHOD GetVersion() METHOD PathDB() INLINE ::cHost+::cDBSql METHOD GetDBase() INLINE ::cDBSql //nao funciona no odbc //begin/roll/commit METHOD SqlTransact() INLINE ::Exec("Begin Transaction") //SqlTransact(::hEnv,::hDbc) METHOD SqlCommit() INLINE ::Exec("Commit Transaction") //(::hEnv,::hDbc) METHOD SqlRollBack() INLINE ::Exec("Rollback Transaction") //SQLTransact(::hEnv,::hDbc,SQL_ROLLBACK) //SQLRollBack(::hEnv,::hDbc) METHOD Exec(cCmdSql,lQuery) METHOD Query(cCmdSql) //feito METHOD QueryRow(cCmdSql) METHOD SqlUseArea(cAlias,cCmdSql) METHOD RecCount(cTable,cWhere) METHOD GetLastId() INLINE ::nLast_Insert_ID //ultimo registro adicionado METHOD IsRunLastId() INLINE .T. METHOD IsTable( cTable ) METHOD ListTables() METHOD ListFields(cTable) METHOD SqlSeek(P1) METHOD IsField(P1,P2) METHOD GravaErro(P1) //Exclusiva -ODBC METHOD CursorFields(P1) //lSQL METHOD SqlGetData(nField) PROTECTED /*SqlFreeStmt livra estouro de memoria do servidor sql*/ METHOD SqlFreeStmt() INLINE ::hStmt:Close() PROTECTED //ado METHOD SetLastId(cSql) METHOD SqlFistStmt() METHOD SqlLastStmt() ENDCLASS **============================================================ METHOD New() CLASS TSqlADO **============================================================ Return Self **=============================================================== METHOD Server( cServer, cBanco, cUser, cPwd) CLASS TSqlADO **=============================================================== Local cDir := cFilePath( GetModuleFileName( GetInstance() ) ) Local cFileLog := cDir+"log\Odbc_erro.log" //fica aberto Local oErr ::cTitle := "SqlServer Via ADODB" ::cFileErro := cDir+"log\SqlServer.log" ::cDBSql := cBanco ::cHost := cServer ::cDsn := "Driver=SQL Server; Server="+cServer+"; Database="+cBanco+";"+; "UID="+cUser+"; PWD="+cPwd+";" Begin Sequence Try //https://www.w3schools.com/asp/ado_ref_connection.asp ::hCon :=CreateObject("ADODB.Connection") ::hCon:CursorLocation := 3 //adUseClient //tem haver RecordCount() ::hCon:Open(::cDsn) //MsgStop(::hCon:Provider) //https://www.w3schools.com/asp/prop_conn_provider.asp Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Connection") FW_ShowAdoError(::hCon,.F.) Break End // MsgStop(FW_RDBMSName( ::hCon )) //e legal Try ::hStmt:=CreateObject("ADODB.Recordset") ::hStmt:ActiveConnection := ::hCon Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Recordset") MsgStop("Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10),"ADODB.Recordset") Break End End Squence Return Self **=============================================================== METHOD MariaDB(cServer,cBanco,cUser,cPwd) CLASS TSqlADO **=============================================================== Local cDir := cFilePath(GetModuleFileName(GetInstance())) Local cFileLog := cDir+"log\Odbc_erro.log" Local oErr ::cTitle := "MariaDB Via ADODB" ::cFileErro := cDir+"log\MariaDB.log" ::cDBSql := cBanco ::cHost := cServer ::cDsn := "Driver={MariaDB ODBC 3.1 Driver }; Server="+cServer+"; Database="+cBanco+";"+; "UID="+cUser+"; PWD="+cPwd+";Port=3306;Option=3;" Begin Sequence Try ::hCon :=CreateObject("ADODB.Connection") ::hCon:CursorLocation := 3 //adUseClient //tem haver RecordCount() ::hCon:Open(::cDsn) Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Connection") FW_ShowAdoError(::hCon,.T.) Break End Try ::hStmt:=CreateObject("ADODB.Recordset") ::hStmt:ActiveConnection := ::hCon Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Recordset") MsgStop("Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10),"ADODB.Recordset") Break End End Squence Return Self **=============================================================== METHOD MySql(cServer,cBanco,cUser,cPwd) CLASS TSqlADO **=============================================================== Local cDir := cFilePath(GetModuleFileName(GetInstance())) Local cFileLog := cDir+"log\Odbc_erro.log" Local oErr ::cTitle := "MySql Via ADODB" ::cFileErro := cDir+"log\Mysql.log" ::cDBSql := cBanco ::cHost := cServer ::cDsn := "Driver={MySQL ODBC 3.51 Driver}; Server="+cServer+"; Database="+cBanco+";"+; "UID="+cUser+"; PWD="+cPwd+";Port=3306;Option=3;" Begin Sequence Try ::hCon :=CreateObject("ADODB.Connection") ::hCon:CursorLocation := 3 //adUseClient //tem haver RecordCount() ::hCon:Open(::cDsn) Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Connection") FW_ShowAdoError(::hCon,.T.) Break End Try ::hStmt:=CreateObject("ADODB.Recordset") ::hStmt:ActiveConnection := ::hCon Catch oErr ::lSuccess := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) ::GravaErro("ADODB.Recordset") MsgStop("Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10)) Break End End Squence Return Self **=============================================================== METHOD Close() CLASS TSqlADO **=============================================================== ::hCon:Close() Return Nil **=============================================================== METHOD IsTable(cName) CLASS TSqlADO **=============================================================== Local lTable := Fw_AdoTableExists(cName,::hCon) Return lTable **=============================================================== METHOD Exec(cCmdSql,lQuery) CLASS TSqlADO **=============================================================== Local oErr,lRet:=.T. Default(@lQuery,.F.) //este parametro faz funcionar recCount TRY If lQuery ::hStmt:Open(cCmdSql) //query select Else ::hCon:Execute(cCmdSql) //exec insert Endif CATCH oErr lRet := .F. ::cLastErro := "Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10) MsgStop("Operacao: "+oErr:operation+" - Descrição: "+oErr:Description+Chr(10),"xxx") ::GravaErro(cCmdSql) End Return lRet **============================================================ METHOD RecCount(cTable,cWhere) CLASS TSqlADO **============================================================ Local cSql := "Select Count(*) as count From "+cTable ::nRecCount := 0 If PCount() == 0 //sem parametros Return Nil Endif If !Empty(cWhere) cSql += "Where "+cWhere Endif If ::Exec(cSql,.T.) ::hStmt:MoveFirst() ::nRecCount := ::hStmt:Fields:Item(0):Value ::SqlFreeStmt() Endif Return Nil **============================================================= METHOD SqlUseArea(cAlias,cCmdSql) CLASS TSqlADO **============================================================= Local aFields:={},nI,nMin:=500 If !::Exec(cCmdSql,.T.) MsgStop("Desculpe! Falha na abertura do arquivo "+cAlias+".","wSace") Return .F. Endif ::nRecCount := ::hStmt:RecordCount() aFields := ::CursorFields() If Select(cAlias)> 0; (cAlias)->(DBCloseArea()); Endif HB_DbCreateTemp(cAlias,aFields,"SIXCDX") If ::nRecCount > nMin; Sys_Meter(1,::nRecCount,::cTitle) ; Endif If !::hStmt:Bof(); ::hStmt:MoveFirst(); Endif //da erro se for vazio DO WHILE !::hStmt:Eof() DBAppend() For nI:=1 TO ::hStmt:Fields:Count //começou no zero FieldPut(nI,::SqlGetData(nI-1)) //grava no temp da colocar try catch para gravar erro Next If ::nRecCount > nMin; Sys_Meter(2); Endif ::hStmt:MoveNext() //if LastRec() > 100 ; exit; endif //---------------------------------------teste Enddo If ::nRecCount > nMin; Sys_Meter(3); Endif ::SqlFreeStmt() //limpa finaliza hStmt ::nRecCount := 0 DBGoTop() Return .T. **============================================================= METHOD SqlGetData(nField) CLASS TSqlADO **============================================================= Local uData := ::hStmt:Fields:Item(nField):Value Return uData **============================================================= METHOD Query(cCmdSql) CLASS TSqlADO **============================================================= Local aBuffer:={},nLen,nI,nRow:=1 If !::Exec(cCmdSql,.T.) ::SQLFreeStmt() //limpa Return {} Endif nLen := ::hStmt:Fields:Count If ::nRecCount > 500; Sys_Meter(1,::nRecCount,::cTitle) ; Endif If !::hStmt:Bof(); ::hStmt:MoveFirst(); Endif //da erro se for vazio DO WHILE !::hStmt:Eof() AAdd(aBuffer,Array(nLen)) For nI:=1 TO nLen aBuffer[nRow,nI] := ::SqlGetData(nI-1) Next If ::nRecCount > 500; Sys_Meter(2); Endif ::hStmt:MoveNext() nRow++ Enddo If ::nRecCount > 500; Sys_Meter(3); Endif ::nRecCount := 0 ::SQLFreeStmt() //limpa Return aBuffer **============================================================= METHOD QueryRow(cCmdSql) CLASS TSqlADO **============================================================= Local aFields,lFound := .T. Local nCol,oTupla := HBClass():New("Tupla") Begin Sequence If !::Exec(cCmdSql,.T.) ::SqlFreeStmt() //limpa lFound := .F. Break Endif aFields := ::CursorFields() For nCol := 1 To Len(aFields) oTupla:AddData(aFields[nCol,1],::SqlGetData(nCol-1)) // uma linha Next End Sequence ::SqlFreeStmt() //limpa oTupla:AddData("lFound",lFound) oTupla:Create() Return oTupla:Instance() **======================================================================= METHOD SetLastId(cCmdSql) CLASS TSqlADO **======================================================================= Local aVet := ::Query(cCmdSql) ::nLast_Insert_ID := 0 If Len(aVet) > 0 ::nLast_Insert_ID := aVet[1,1] Endif Return Nil **======================================================================= METHOD ListFields(cTable) CLASS TSqlADO **======================================================================= Local cSql := "SELECT * FROM "+AllTrim(cTable)+" WHERE 1=0;" Local aFields If !::Exec(cSql,.T.) //criar e carrega hStmt se .t. ::SqlFreeStmt() //limpa Return {} Endif aFields := ::CursorFields(.T.) ::SQLFreeStmt() //limpa If Len(aFields) == 0 Return {} Endif Return aFields **============================================================= METHOD CursorFields(lSql) CLASS TSqlADO //funciona ADODB **============================================================= Local nI,aFields //:= FwAdoStruct(::hStmt) Default(@lSql,.F.) aFields := FwAdoStruct(::hStmt) If !lSql For nI:=1 TO Len(aFields) aFields[nI] := ASize(aFields[nI],4) Next Endif Return aFields **======================================================================= METHOD ListTables() CLASS TSqlADO **======================================================================= Local aFiles := Fw_AdoTables(::hCon) Return aFiles **======================================================================= METHOD GetVersion() CLASS TSqlADO **======================================================================= Local cSql := "SELECT @@VERSION;" Local aVet := ::Query(cSql),cValue := " " If Len(aVet) > 0 cValue := aVet[1,1] Endif Return cValue **=================================================================== METHOD SqlSeek(cSQL) CLASS TSqlADO **=================================================================== Local oRow oRow := ::QueryRow(cSQL) Return oRow:lFound **=================================================================== METHOD IsField(t,c) CLASS TSqlADO ** RETORNA= TRUE / FALSE **=================================================================== Local lRET:=.F.,aVET:={} IF !Empty(c) aVET := ::ListFields(t) IF Len(aVET) > 0 //RETORNA UMA CELULA VAZIA IF AScan(aVET,{|X| Upper(Trim(X[1])) == Upper(c)}) > 0 lRET :=.T. ENDIF ENDIF ENDIF Return(lRET) **============================================================ METHOD SqlFistStmt() CLASS TSqlADO **============================================================ ::hStmt:MoveFirst() Return Nil **============================================================ METHOD SqlLastStmt() CLASS TSqlADO **============================================================ ::hStmt:MoveLast() Return Nil **========================================================= METHOD GravaErro(cMessage) CLASS TSqlADO **========================================================= Local nCt cMessage += hb_eol()+::MsgError()+hb_eol() // grava mensagem em um arquivo log //////////////////////////////////////// SET CONSOLE OFF SET PRINTER TO (::cFileErro) ADDITIVE SET DEVICE TO PRINTER SET PRINTER ON QOUT("**==================================================================") QOUT("Data:") QQOUT(TRANSF(DATE(),"@E")) QQOUT(" Hr:") QQOUT(TIME()) QQOut(" Operador: ") QQOut(M->pCOD+"-"+M->pOPE) QOUT("**==================================================================") QOUT(cMessage) QOut(::MsgError()) nCt := 2 DO WHILE !Empty(ProcName(nCt)) QOUT("Rotina...", Trim(ProcName(nCt)) + "("+LTrim(Str(ProcLine(nCt)))+")") nCt++ ENDDO SET DEVICE TO SCREEN SET PRINTER OFF SET PRINTER TO SET CONSOLE ON Return NIL

Na linha do objeto say e combo, acrescenta UPDATE. Após o :Hide() ou : Show () vc acrescenta oDlg:Update ()

Dá para usar conexão via Odbc e ADO, o sal server é sem novidades, quanto ao Oracle nunca testei

Sugestão: Usar esquema parecido.

Só usei boletos.

Sim

Boas práticas de hj é sobre pesquisa INCREMENTAL em TBrowse com uso BackGound - Rotina em segundo plano. Tenho interesse por processamento paralelo e BackGround, o primeiro não consegui ainda, sei que tem parâmetros para incluir na compilação, mas não deu certo, o segundo consegui, no caso a rotina abaixo está rodando tbrowse() em uma tabela 'temp' indexada por nome, ao precionar F3 abre get para digitar e o conteúdo GET vai "Refresh() ando" no Browse. Se curtiu tecle "Joinha" oTB:ForceStable() nKEY := Inkey(0) IF nKEY == K_ESC EXIT ELSEIF nKEY == K_F3 /*processamento em segundo plano*/ HB_IdleAdd( {|| HB_BackGroundRun() } ) nTask := HB_BackGroundAdd( {|| RefreshTB(oTB) }, 1000 ) SET BACKGROUND TASKS ON /*------------------------------*/ cChave := Space(35) //BOX3DOF(14,16,18,58) @ 14,16 clear to 18,58 DispBox(14,16,18,58,2,"n/b") @ 16,20 GET cChave PICT "@!" READ HB_BackGroundDel( nTask ) oTB:RefreshAll() Endif **---------------------------------------------------------------------- Function RefreshTB(oTB) //fica rodando BackGround **---------------------------------------------------------------------- Local cTela,oGet:=GetActive() Static cLast := '' If HB_IsObject(oGet) .and. cLast != oGet:buffer cTela := SaveScreen(14,16,18,58) TEMP->(DBSEEK(oGet:buffer,.T.)) oTB:RefreshAll() oTB:ForceStable() Restscreen(14,16,18,58,cTela) cLast := oGet:buffer oGet:SetFocus() Endif Return .t. xHarbour/Harbour, FiveWin, SqlRdd e Pelles C - Editor xEdit

Link: https://dokumen.site/download/sqlrdd-manual-a5b39ef6b2bcbe caso alguém tenha interesse!

Static Procedure FastTurbo(cAlias,cFileSql) Local aStru := (cAlias)->(DbStruct()) Local cSql,nTupla:=2 Local nMaxTupla := 1000 If Sr_File(cFileSql) SR_DropTable(cFileSql) EndIf DbCreate(cFileSql,aStru,"SQLRDD") DbSelectArea(cAlias) DbGotop() cSql := SqlInsert(cFileSql) DBSkip() While !Eof() If nTupla > nMaxTupla // Limita a qtde maxima de linha no sqlserver SR_GetConnection():Execute( cSql ) cSql := SqlInsert(cFileSql) //fields e values nTupla:=2 Else cSql += SqlValue() //values Endif DbSkip() nTupla++ EndDo SR_GetConnection():Execute( cSql ) SR_GetConnection():Commit() Return // funcao que monta string para comando insert do banco de dados Static Function SqlInsert(cTable) Local aStru := DbStruct() Local nI Local aCampos := {} Local cRet := "SET NOCOUNT ON;"+Chr(13)+Chr(10) Local uVal For nI := 1 to Len(aStru) uVal := FieldGet(nI) If Empty(uVal) uVal := "null" Else uVal := Sr_cDbValue(uVal) EndIf aadd(aCampos,{aStru[nI,1],uVal}) Next cRet := "INSERT INTO "+cTable+" (" For nI := 1 to Len(aCampos) If nI > 1 cRet+="," EndIf cRet+=aCampos[nI,1] Next cRet+=") VALUES (" For nI := 1 to Len(aCampos) If nI > 1 cRet+="," EndIf cRet+=aCampos[nI,2] Next cRet+=")" Return cRet // funcao que monta string para comando insert do banco de dados Static Function SqlValue() Local aStru := DbStruct() Local nI Local aCampos := {} Local cRet := "",cSql Local uVal For nI := 1 to Len(aStru) uVal := FieldGet(nI) If Empty(uVal) uVal := "null" Else uVal := Sr_cDbValue(uVal) EndIf aadd(aCampos,{aStru[nI,1],uVal}) Next cRet+=",(" For nI := 1 to Len(aCampos) If nI > 1 cRet+="," EndIf cRet+=aCampos[nI,2] Next cRet+=")" Return cRet Eduardo com a tua implementação aplicando a sugestão do Alex, baixou em 2 segundos os testes do seu exemplo. Ficou muito boa sua rotina, mais uma vez parabéns!

Eduardo, executei seu prg, realmente ficou bem mais rápido. Show!

Sim, estou meio atarefado no momento, assim que fizer os testes relatarei os resultados

Vou testar, tenho uma tabela que demora muito....blz Parabéns! #boaspraticas

Olá Júlio Fernandes! boa tarde! A Lib que você citou desconheço! Vou disponibilizar um material que tenho e funciona perfeitamente em um dos meus sistemas, caso tenha alguma dificuldade pode me contactar por aqui ou pelo email: saa50@bol.com.br https://drive.google.com/open?id=1Q7DuZASQlH5nVkqNkbLcrvC14dzAA5yd Um abraço JMSilva

Boa tarde ! Alguém já passou por isso ? EX: tabbanco -> Campos: codbanco char(5), numbanco numeric(3), nome varchar(20) //033 - 33 - Santander Comando: Select * From tabbanco a where a.codbanco = 33; // não da erro no sql studio e nem no sistema Certo seria : Select * From tabbanco a where a.codbanco = '033' //tipos iguais Observe que esta comparando campos com tipo de diferente. Existe alguma configuração no SqlServer para inibir este problema ?

Fwh versão 20.02 New: FW_ValidCreditCard( cardNo, @cIssuer, @cInfo ) --> lValidNumcIssuer --> Visa, MasterCard, etc.cInfo --> More details reg. bank, debit/credit, country, etc

http://fivewin.com.br/index.php?/topic/28336-pequisa-avençada/ Veja meu POST, veja se ajuda.

ex1: Filtro('maur?cio*rebou?as') ex2: Filtro('ana*ur?cio*rebou?as') **========================================================================== Static Function Filtro(cKey) **========================================================================== cKey := StrTran(cKey,".","*") cKey := StrTran(cKey,"-","") cKey := StrTran(cKey,"/","") cKey := alltrim(cKey) If !Empty(cKey) cKey := "*"+Alltrim(cKey)+"*" CADCLI->(DbSetFilter({|| WildMatch(cKey,Upper(CADCLI->CPF+" "+CADCLI->NOME+" "+; CADCLI->CARGO+" "+CADCLI->ENDRES+" "+DToS(CADCLI->DTUPD)))})) Else CADCLI->(DbSetFilter(Nil)) Endif CADCLI->(DBGoTop()) oBrw[1]:Refresh() Return Nil PARECIDO COM LIKE...BLZ

Para quem usa banco dados via SQL, minha dica e gravar em uma tabela errorlog, que pode ser acessando remotamente. Ficou legal.

Meus sentimentos aos familiares!

Poderia testar o comando SET DEFAULT TO <NOMEDAPASTADESEJADA> para saber se funciona!