Jump to content
Fivewin Brasil

Jmsilva

Membros
  • Posts

    718
  • Joined

  • Last visited

  • Days Won

    14

Everything posted by Jmsilva

  1. A título de curiosidade, não conheço ttxtprev, poderia disponibilizar informações sobre. Como help, onde baixar ou até mesmo um exemplo se possível. Se É free ?
  2. ConectaBD():Close() muda para final veja se funciona, pode ser isso.
  3. Ótimo Natal para todos, boas festas!
  4. Exatamente isso, COALESCE e IsNull vc tem o mesma utilidade no MariaDB e Sql Server, respectivamente. Tanto que se vc usar SR_SQLParse()+ SR_SQLCodeGen() a SQLRDD ajusta automaticamente a instrução para compatibilizar com os diversos bancos compatível. No Oracle, por exemplo, a função correspondente e a NVL().
  5. https://www.microsoft.com/pt-br/download/details.aspx?id=30438 SQL express 2008. Caso queira outra versão e só pesquisar sql express
  6. ***====================================================================*** *** Sistema....: WSACE- *** *** Rotina.....: X_SqlServerPRG *** *** Linguagem..: Harbour/Fivewin *** *** Programador: JMSILVA *** *** Data.......: 13/09/2016 *** ***====================================================================*** #INCLUDE "fivewin.ch" #include "Sql.ch" #include "error.ch" #define SQL_NVARCHAR -9 #define SQL_DB2_CLOB -99 #define SQL_FAKE_LOB -100 #define SQL_FAKE_DATE -101 #define SQL_FAKE_NUM -102 #define SQL_GUID -11 #define SQL_WCHAR -8 #define SQL_WVARCHAR SQL_NVARCHAR #define SQL_WLONGVARCHAR -10 #define SQL_C_WCHAR SQL_WCHAR #Define AERRORS_MAXLEN 100 #define SQL_COMMIT 0 #define SQL_ROLLBACK 1 #define SQL_INDEX_ALL 1 static hODBC32 //libs ODBCcp32.lib e odbc32.lib **============================================================================= CLASS TSqlOdbc **============================================================================= DATA cDBSql,cHost,cDsn PROTECTED DATA hEnv,hDbc,hStmt HIDDEN DATA aErrors INIT {} DATA lSuccess INIT .F. PROTECTED DATA nRecCount INIT 0 DATA cTitle DATA cFileErro PROTECTED DATA nLast_Insert_ID INIT 0 // EM TESTE FALTA IMPLEMENTAR METHOD New() CONSTRUCTOR METHOD Server(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD Mysql(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD MariaDB(cServer, cBanco, cUser, cPwd) CONSTRUCTOR //METHOD RDDODBC() CONSTRUCTOR //METHOD Cria(cServer, cBanco, cUser, cPwd) CONSTRUCTOR METHOD Close() METHOD IsErrorSql() INLINE !::lSuccess METHOD MsgError() METHOD IdError() INLINE IIF(::lSuccess,0,-1) METHOD GetVersion() METHOD PathDB() INLINE ::cHost+::cDBSql METHOD GetDBase() INLINE ::cDBSql //nao funciona no odbc //bgen/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) 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(lDateAsStr ) METHOD SqlGetData(nField,aFields) PROTECTED METHOD SqlGetInfo( nType ) METHOD SqlSetConnOptions( nType, uBuffer ) METHOD SqlGetConnOptions( nType ) METHOD ListViews() METHOD SqlAllocStmt() PROTECTED /*SqlFreeStmt livra estouro de memoria do servidor sql*/ METHOD SqlFreeStmt() METHOD SetLastId(cSql) METHOD SqlFistStmt() METHOD SqlLastStmt() ENDCLASS **============================================================ METHOD New() CLASS TSqlOdbc **============================================================ If hODBC32 == nil hODBC32 = LoadLib32( "ODBC32.dll" ) Endif Return Self /* **=============================================================== METHOD RDDODBC() CLASS TSqlOdbc **=============================================================== oRdd := TRddOdbc():New(::cDsn)//, cUser, cPwd) Return Self */ **=============================================================== METHOD Server( cServer, cBanco, cUser, cPwd) CLASS TSqlOdbc **=============================================================== Local nRet,cDir := cFilePath( GetModuleFileName( GetInstance() ) ) Local cFileLog := cDir+"log\Odbc_erro.log" //fica aberto //IniODBC32() //odbc32.prg ::cTitle := "SqlServer Via ODBC" ::cFileErro := cDir+"log\SqlServer.log" ::cDBSql := cBanco ::cHost := cServer ::cDsn := "Driver=SQL Server; Server="+cServer+"; Database="+cBanco+";"+; "UID="+cUser+"; PWD="+cPwd+";" BEGIN SEQUENCE If SQLAllocEnv( @::hEnv ) != SQL_SUCCESS ::GravaErro("SQLAllocEnv()") BREAK Endif If SQLAllocConnect( ::hEnv, @::hDbc )!= SQL_SUCCESS ::GravaErro("SQLAllocConnect()") BREAK Endif nRet := SQLDriverConnect( ::hDbc, @::cDsn ) If nRet != SQL_SUCCESS .and. nRet != SQL_SUCCESS_WITH_INFO ::GravaErro("SQLDriverConnect()") BREAK Endif ::lSuccess := .T. ::SqlSetConnOptions(SQL_AUTOCOMMIT,AUTOCOMMIT_ON ) //Seta o AutoCommit ::SqlSetConnOptions(SQL_OPT_TRACEFILE,cFileLog) //seta log do sql 105 ::Exec("SET NOCOUNT ON;") //EMOTTA //SQL_CURRENT_QUALIFIER == 109 - saber o nome do banco de dados //MsgStop(::SqlGetConnOptions(SQL_CURRENT_QUALIFIER),"Banco de dados") //SQLAllocStmt() //carrega hStmt // MsgStop(SQLColumns(::hStmt,'','',"TB_CADCHQ","CPF")) //MsgStop(SQLCol(::hStmt,"TB_CADCHQ","CPF")) END SEQUENCE Return Self **=============================================================== METHOD MySql(cServer,cBanco,cUser,cPwd) CLASS TSqlOdbc **=============================================================== Local nRet,cDir := cFilePath( GetModuleFileName( GetInstance() ) ) Local cFileLog := cDir+"log\Odbc_erro.log" //IniODBC32() //odbc32.prg ::cTitle := "MySql Via ODBC" ::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;" //::cDsn := "Driver={MySQL ODBC 3.51 Driver};Server=Localhost;Database=dbwsace;User=root;Password=;Port=3306;Option=3;" //show funcionou BEGIN SEQUENCE If SQLAllocEnv( @::hEnv ) != SQL_SUCCESS ::GravaErro("SQLAllocEnv()") BREAK Endif If SQLAllocConnect( ::hEnv, @::hDbc )!= SQL_SUCCESS ::GravaErro("SQLAllocConnect()") BREAK Endif nRet := SQLDriverConnect( ::hDbc, @::cDsn ) If nRet != SQL_SUCCESS .and. nRet != SQL_SUCCESS_WITH_INFO ::GravaErro("SQLDriverConnect()") BREAK Endif ::lSuccess := .T. ::SqlSetConnOptions(SQL_AUTOCOMMIT,AUTOCOMMIT_ON ) //Seta o AutoCommit ::SqlSetConnOptions(SQL_OPT_TRACEFILE,cFileLog) //seta log do sql 105 //SQL_CURRENT_QUALIFIER == 109 - saber o nome do banco de dados //MsgStop(::SqlGetConnOptions(SQL_CURRENT_QUALIFIER),"Banco de dados") //SQLAllocStmt() //carrega hStmt END SEQUENCE Return Self **=============================================================== METHOD MariaDB(cServer,cBanco,cUser,cPwd) CLASS TSqlOdbc **=============================================================== Local nRet,cDir := cFilePath( GetModuleFileName( GetInstance() ) ) Local cFileLog := cDir+"log\Odbc_erro.log" //IniODBC32() //odbc32.prg ::cTitle := "MariaDB Via ODBC" ::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;" //aDsn := OdbcDsnEntries() //::cDsn := aDsn[3] //MsgStop(::cDsn) BEGIN SEQUENCE If SQLAllocEnv( @::hEnv ) != SQL_SUCCESS ::GravaErro("SQLAllocEnv()") BREAK Endif If SQLAllocConnect( ::hEnv, @::hDbc )!= SQL_SUCCESS ::GravaErro("SQLAllocConnect()") BREAK Endif nRet := SQLDriverConnect( ::hDbc, @::cDsn ) If nRet != SQL_SUCCESS .and. nRet != SQL_SUCCESS_WITH_INFO ::GravaErro("SQLDriverConnect()") BREAK Endif ::lSuccess := .T. ::SqlSetConnOptions(SQL_AUTOCOMMIT,AUTOCOMMIT_ON ) //Seta o AutoCommit ::SqlSetConnOptions(SQL_OPT_TRACEFILE,cFileLog) //seta log do sql 105 //SQL_CURRENT_QUALIFIER == 109 - saber o nome do banco de dados //MsgStop(::SqlGetConnOptions(SQL_CURRENT_QUALIFIER),"Banco de dados") //SQLAllocStmt() //carrega hStmt END SEQUENCE Return Self /* **=============================================================== METHOD Cria( cServer, cBanco, cUser, cPwd) CLASS TSqlOdbc **=============================================================== ::cDBSql := cBanco ::cHost := cServer ::oFWSQL := Maria_Connect(::cHost, , cUser, cPwd, 3306) //MsgStop(::oFWSql:Ping(),"ping") If ::IsErrorSql() GravaErro(::MsgError()) Else ::oFWSql:CreateDB(::cDBSql) //, [cCharSet] ) ::oFWSql:SelectDB(::cDBSql) ::oFWSql:SetAutoCommit(.T.) Endif Return Nil */ **=============================================================== METHOD Close() CLASS TSqlOdbc **=============================================================== SQLDisconnect( ::hDbc ) SQLFreeConnect( ::hDbc ) SQLFreeEnv( ::hEnv ) ::SQLFreeStmt() ::hEnv := 0 ::hDbc := 0 ::hStmt := 0 //EndODBC32() //odbc32.prg If hODBC32 != nil FreeLib32( hODBC32 ) hODBC32 = nil Endif Return Nil **=============================================================== METHOD IsTable(cName) CLASS TSqlOdbc **=============================================================== Local lTable := .F. ::SQLAllocStmt() If SQLFile( ::hStmt, cName ) == SQL_SUCCESS lTable := SqlFetch( ::hStmt ) == SQL_SUCCESS Endif ::SQLFreeStmt() Return lTable **=============================================================== METHOD Exec(cCmdSql) CLASS TSqlOdbc **=============================================================== ::SqlAllocStmt() //SQLPrepare(::hStmt, cCmdSql) //?? estudar If SQLExecDirect(::hStmt,cCmdSql) != SQL_SUCCESS ::GravaErro(cCmdSql) ::SQLFreeStmt() Return .F. Endif Return .T. **============================================================ METHOD RecCount(cTable,cWhere) CLASS TSqlOdbc **============================================================ Local oRow,cSql := "Select Count(*) as count From "+cTable ::nRecCount := 0 If PCount() == 0 //sem parametros Return Nil Endif If !Empty(cWhere) cSql += "Where "+cWhere Endif oRow := ::QueryRow(cSql) If oRow:lFound If ValType(oRow:Count) == "N" ::nRecCount := oRow:Count ElseIf ValType(oRow:Count) == "C" //mysql ::nRecCount := Val(AllTrim(oRow:Count)) Endif Endif Return Nil **============================================================= METHOD SqlUseArea(cAlias,cCmdSql) CLASS TSqlOdbc **============================================================= Local aFields,nI,nLen,uData,nMin:=500 If !::Exec(cCmdSql ) MsgStop("Desculpe! Falha na abertura do arquivo "+cAlias+".","wSace") Return .F. Endif //::SqlLastStmt() //testes IDEIA E PEGAR TOTAL DE RECNO aFields := ::CursorFields() If Select(cAlias)> 0; (cAlias)->(DBCloseArea()); Endif HB_DbCreateTemp(cAlias,aFields,"SIXCDX") nLen := Len(aFields) If ::nRecCount > nMin; Sys_Meter(1,::nRecCount,::cTitle) ; Endif DO WHILE SqlFetch(::hStmt ) == SQL_SUCCESS DBAppend() For nI:=1 TO nLen uData := ::SqlGetData(nI,aFields) FieldPut(nI,uData) //grava no temp da colocar try catch para gravar erro Next If ::nRecCount > nMin; Sys_Meter(2); Endif Enddo If ::nRecCount > nMin; Sys_Meter(3); Endif ::SqlFreeStmt() //limpa finaliza hStmt ::nRecCount := 0 DBGoTop() Return .T. **============================================================= METHOD SqlGetData(nField,aFields) CLASS TSqlOdbc **============================================================= Local uData,bTransform Local nType,nLen,nSpecType,nRet //Local lIsNull nType := aFields[ nField ][ SQLNTYPE ] nLen := aFields[ nField ][ SQLLEN ] + 1 nSpecType := aFields[ nField ][ SQLTTYPE ] bTransform := aFields[ nField ][ SQLBTRANS ] //nRet := SQLGetData( ::hStmt, nField, nSpecType, nLen, @uData, @lIsNull ) nRet := SQLGetTextData( ::hStmt, nField, @uData, @nLen ) If nRet == SQL_SUCCESS //.and. !lIsNull uData := Eval(bTransform, uData, nLen-1) If ValType(uData) == "D" //server uData := IIF(uData == SToD("19000101"),CToD(''),uData) Endif Endif Return uData **============================================================= METHOD Query(cCmdSql) CLASS TSqlOdbc **============================================================= Local aFields,aBuffer:={},nLen,nI,nRow:=1,uData If !::Exec(cCmdSql) ::SQLFreeStmt() //limpa Return {} Endif aFields := ::CursorFields() nLen := Len(aFields) If ::nRecCount > 500; Sys_Meter(1,::nRecCount,::cTitle) ; Endif DO WHILE SqlFetch(::hStmt ) == SQL_SUCCESS AAdd(aBuffer,Array(nLen)) For nI:=1 TO nLen uData := ::SqlGetData(nI,aFields) aBuffer[nRow,nI] := uData Next nRow++ If ::nRecCount > 500; Sys_Meter(2); Endif Enddo If ::nRecCount > 500; Sys_Meter(3); Endif ::nRecCount := 0 ::SQLFreeStmt() //limpa Return aBuffer **============================================================= METHOD QueryRow(cCmdSql) CLASS TSqlOdbc **============================================================= Local aFields,lFound := .T. Local nCol,oTupla := HBClass():New("Tupla") Begin Sequence If !::Exec(cCmdSql) //.or. SqlFetch(::hStmt ) != SQL_SUCCESS lFound := .F. Break Endif If SqlFetch(::hStmt ) != SQL_SUCCESS lFound := .F. Break Endif aFields := ::CursorFields() For nCol := 1 To Len(aFields) oTupla:AddData(aFields[nCol,1],::SqlGetData(nCol,aFields)) // uma linha Next End Sequence ::SqlFreeStmt() //limpa oTupla:AddData("lFound",lFound) oTupla:Create() Return oTupla:Instance() **======================================================================= METHOD SetLastId(cCmdSql) CLASS TSqlOdbc **======================================================================= Local aVet := ::Query(cCmdSql) ::nLast_Insert_ID := 0 If Len(aVet) > 0 ::nLast_Insert_ID := aVet[1,1] Endif Return Nil **======================================================================= METHOD SqlFreeStmt() CLASS TSqlOdbc **======================================================================= If HB_IsNumeric(::hStmt) SQLFreeStmt(::hStmt,SQL_DROP) Endif Return nil **======================================================================= METHOD SQLAllocStmt() CLASS TSqlOdbc **======================================================================= ::SqlFreeStmt() //limpa pra nao estouro de memoria SQLAllocStmt(::hDbc,@::hStmt) Return nil **======================================================================= METHOD ListFields(cTable) CLASS TSqlOdbc **======================================================================= Local cSql := "SELECT * FROM "+cTable+" WHERE 1=0;" Local aVet,aFields:={} if !::Exec(cSql) //criar e carrega hStmt Return {} endif aVet := ::CursorFields() ::SQLFreeStmt() //limpa If Len(aVet) == 0 Return {} Endif AEval(aVet,{|aStr| AAdd(aFields,{aStr[1],aStr[2],aStr[3],aStr[4]})}) Return aFields **============================================================= METHOD CursorFields( lDateAsStr ) CLASS TSqlOdbc **============================================================= Local aFields := {} Local n, nFields := 0, nRet := 0 Local nType := 0, nLen := 0, nDec := 0, lNull := .f., cName := "", cType Local nCtype, bTrans //NO FUTURO PODE SER TRATADA DEFAULT lDateAsStr := .F. //para data ser do tipo "D" nRet := SQLNumResultCols(::hStmt, @nFields) if nRet != SQL_SUCCESS .and. nRet != SQL_SUCCESS_WITH_INFO ::GravaErro("SQLNumResultCols()") Return {} endif for n = 1 to nFields nRet := SQLDescribeCol(::hStmt, n, @cName, @nType, @nLen, @nDec, @lNull) //nRet := SQLDesc32(::hStmt, n, @cName, @nType, @nLen, @nDec, @lNull) if nRet != SQL_SUCCESS .and. nRet != SQL_SUCCESS_WITH_INFO ::GravaErro("SQLDescribeCol()") Return {} endif do case case nType == SQL_CHAR .or. nType == SQL_VARCHAR cType = "C" case nType == SQL_BIT cType = "L" case nType == SQL_NUMERIC .or. nType == SQL_DECIMAL .OR. ; nType == SQL_INTEGER .or. nType == SQL_SMALLINT .OR. ; nType == SQL_FLOAT .or. nType == SQL_REAL .OR. ; nType == SQL_DOUBLE .or. nType == SQL_TINYINT cType = "N" case nType == SQL_DATE .or. nType == SQL_TIMESTAMP // (smalldatetime) //se campo estiver como datatime sera tam=23 e dec=3 if !lDateAsStr cType := "D" else cType := "C" endif case nType == SQL_TIME cType = "C" case nType == SQL_LONGVARCHAR .or. nType == SQL_LONGVARBINARY cType = "M" //case nType == SQL_NVARCHAR //= -9 jms /*O tipo SQL_NVARCHAR = -9 esta voltando de campo date por isso acrescentei Este tipo não existe no sql.ch soemnte sqlodbc.ch xhb comercial*/ /*TIVE QUE USAR DATATIME NO LUGAR TIPO DATE*/ otherwise cType := "U" endcase do case ///case nType == SQL_NVARCHAR //= -9 jms // nCtype := SQL_DATE // É 9 case nType == SQL_TIMESTAMP //smalldatatime nCtype := SQL_TIMESTAMP otherwise nCtype := SQL_CHAR endcase if (nType == SQL_DOUBLE .or. nType == SQL_FLOAT) .and. nDec == 0 nDec = Set(_SET_DECIMALS) endif if nType == SQL_BINARY .and. nLen = 8 // Timestamp Varbinary(8) nLen := 16 endif // IF Unicode (nChar) multiply by 3 his length if nType < SQL_BIT //.and. nType != SQL_NVARCHAR //= -9 jms nLen *= 3 endif nLen := Min(nLen, FIELD_MAXLENGTH) do case case nType == SQL_LONGVARCHAR .Or. nType == SQL_VARBINARY .Or. ; nType == SQL_LONGVARBINARY .Or. nType == SQL_CHAR .or. ; nType == SQL_VARCHAR bTrans := {|v, l| Padr(v, l)} case nType == SQL_BIT bTrans := {|v| (Asc(v) != 48)} case nType == SQL_NUMERIC .or. nType == SQL_DECIMAL .or. ; nType == SQL_SMALLINT .or. nType == SQL_INTEGER .or. ; nType == SQL_DOUBLE .or. nType == SQL_FLOAT .or. ; nType == SQL_REAL .or. nType == SQL_TINYINT bTrans := {|v| Val(v)} if nDec >= nLen .or. nType == SQL_DOUBLE .or. nType == SQL_FLOAT ; .or. nType == SQL_REAL nDec := Set(_SET_DECIMALS) endif nLen := 15 // Maximum numeric width supported by Clipper without loosing decimal exactness case nType == SQL_DATE //mysql date format if !lDateAsStr bTrans := {|v| stod(Left(v, 4)+Substr(v, 6, 2)+Substr(v, 9, 2))} else bTrans := {|v| v} endif //case nType == SQL_NVARCHAR //= -9 jms //bTrans := {|v| MsgStop(v,ValType(v)),stod(Left(v, 4)+Substr(v, 6, 2)+Substr(v, 9, 2))} // bTrans := {|v| Stod(Str(Bin2I(SubStr(v, 1, 2)),4)+; // StrZero(Bin2I(SubStr(v, 3, 2)),2)+; // StrZero(Bin2I(SubStr(v, 5, 2)),2))} case nType == SQL_TIMESTAMP if !lDateAsStr bTrans := {|v| Stod(Str(Bin2I(SubStr(v, 1, 2)),4)+; StrZero(Bin2I(SubStr(v, 3, 2)),2)+; StrZero(Bin2I(SubStr(v, 5, 2)),2))} else bTrans := {|v| Str(Bin2I(SubStr(v, 1, 4)),4)+"-"+; StrZero(Bin2I(SubStr(v, 3, 2)),2)+"-"+; StrZero(Bin2I(SubStr(v, 5, 2)),2)+" "+; StrZero(Bin2I(SubStr(v, 7, 2)),2)+":"+; StrZero(Bin2I(SubStr(v, 9, 2)),2)+":"+; StrZero(Bin2I(SubStr(v, 11, 2)),2)+"."+; StrZero(Bin2I(SubStr(v, 13, 3)),3)} endif otherwise bTrans := {|v| v} endcase cName := AllTrim(cName) cType := IIF(cType == "U","C",cType) //Ajuste tecnico pata tipo date que -9 no server AAdd( aFields,; { cName, cType, nLen, nDec, lNull, nType, nCtype, bTrans,.f. } ) next Return aFields **======================================================================= METHOD ListTables() CLASS TSqlOdbc **======================================================================= Local aFiles := {},cMask :="TB_%" Local cTable, cType ::SQLAllocStmt() if SQLFile( ::hStmt, cMask ) != SQL_SUCCESS //::NewError( "TOdbc:SQLFile()",, hStmt ) Return {} endif Do While SqlFetch(::hStmt ) == SQL_SUCCESS cTable := Space(255) cType := Space(255) if SqlGetData(::hStmt, 3 ,SQL_CHAR,255, @cTable) != SQL_SUCCESS exit endif if SqlGetData(::hStmt, 4 ,SQL_CHAR,255, @cType) != SQL_SUCCESS exit endif if cType = "TABLE" .OR. cType = "VIEW" //.or. (lViews .and. cType = "VIEW") Aadd(aFiles, cTable) endif Enddo ::SQLFreeStmt() //limpa Return aFiles **======================================================================= METHOD ListViews() CLASS TSqlOdbc **======================================================================= Local aFiles := {},cMask := "%" Local cTable, cType ::SQLAllocStmt() if SQLFile( ::hStmt, cMask ) != SQL_SUCCESS Return {} endif Do While SqlFetch(::hStmt ) == SQL_SUCCESS cTable := Space(255) cType := Space(255) if SqlGetData(::hStmt, 3 ,SQL_CHAR,255, @cTable) != SQL_SUCCESS exit endif if SqlGetData(::hStmt, 4 ,SQL_CHAR,255, @cType) != SQL_SUCCESS exit endif if cType == "VIEW" //.or. (lViews .and. cType = "VIEW") Aadd(aFiles, cTable) endif Enddo ::SQLFreeStmt() //limpa Return aFiles **======================================================================= METHOD GetVersion() CLASS TSqlOdbc **======================================================================= Local cSql := "SELECT @@VERSION;" Local aVet := ::Query(cSql),cValue := " " If Len(aVet) > 0 cValue := aVet[1,1] Endif Return cValue **======================================================================= METHOD SqlGetInfo( nType ) CLASS TSqlOdbc //não server pra nada **======================================================================= Local cBuffer := Space( 256 ) SQLGetInfo( ::hDbc, nType, @cBuffer ) Return cBuffer **nType = ver sql.ch 101 ao 110 //destaque 105 e 109 **======================================================================= METHOD SqlGetConnOptions( nType ) CLASS TSqlOdbc **======================================================================= Local cBuffer := Space( 256 ) SQLGetConnectOption( ::hDbc, nType, @cBuffer ) Return cBuffer **nType = ver sql.ch 101 ao 110 **======================================================================= METHOD SqlSetConnOptions( nType, uBuffer ) CLASS TSqlOdbc **======================================================================= If SQLSetConnectOption( ::hDbc, nType, uBuffer ) != SQL_SUCCESS Return .F. Endif Return .T. **=================================================================== METHOD SqlSeek(cSQL) CLASS TSqlOdbc **=================================================================== Local oRow oRow := ::QueryRow(cSQL) Return oRow:lFound **=================================================================== METHOD IsField(t,c) CLASS TSqlOdbc ** 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 GravaErro(cMessage) CLASS TSqlOdbc **========================================================= Local nCt,cErrorClass,nType,cErrorMsg SQLError(::hEnv,::hDbc,::hStmt,@cErrorClass,@nType,@cErrorMsg) Default(@cErrorClass,'') Default(@nType,0) Default(@cErrorMsg,'') cMessage += hb_eol()+::MsgError()+hb_eol() cMessage += "1-ErrorClass: "+cErrorClass+hb_eol()+; "2-Type: "+Str(nType)+hb_eol()+; "3-ErrorMsg: "+cErrorMsg // 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 **============================================================================== METHOD MsgError() CLASS TSqlOdbc **============================================================================== Local cErrorMsg cErrorMsg := SQLGetDiagRec(::hStmt) //MsgStop(cErrorMsg) Return cErrorMsg **============================================================ METHOD SqlFistStmt() CLASS TSqlOdbc **============================================================ Local nRet,nRows //, aRowStatus LOCAL aFields := ::CursorFields() //SQL_FETCH_FIRST == ver sql.ch nRet := SQLExtendedFetch(::hStmt,SQL_FETCH_FIRST,1,@nRows,0) //@aRowStatus ) MsgInfo(::SqlGetData(1,aFields),"sqldata") MsgStop(Str(nRows),"nrows - top") Return (nRet==SQL_SUCCESS) **============================================================ METHOD SqlLastStmt() CLASS TSqlOdbc **============================================================ Local nRet,nRows //, aRowStatus LOCAL aFields := ::CursorFields() //SQL_FETCH_LAST == ver sql.ch nRet := SQLExtendedFetch(::hStmt,SQL_FETCH_FIRST,1,@nRows,0)//@aRowStatus ) MsgInfo(::SqlGetData(1,aFields),"sqldata1") MsgInfo(::SqlGetData(2,aFields),"sqldata2") MsgStop(nRows,"nrows-botretorno") Return (nRet==SQL_SUCCESS) Com esta classe que fiz, vc consegue acessar mssql via odbc, não tem nada haver com SQLRDD. ok Veja se ajuda!
  7. Procedure UpLoad() Local aFiles,cFile,cTable,nTime,cRDD,oErr,aDBF,nI,cDir Set AutOpen OFF cDir := CurDirX()+"arq\" ////func da xhb - curdirx() aDBF := Directory( cDir+"*.dbf") //func da xhb aFiles :={} For nI:=1 TO Len(aDBF) AAdd(aFiles,Trim(aDBF[nI,1])) Next XBrowse(aFiles) //Sys_Meter(1,0,"Importando o arquivo") nTime:=Seconds() For Each cFile IN aFiles cTable := Lower(cFileNoExt(cFile)) If File(cDir+cFile) .and. !SR_ExistTable(cTable) Try cRDD := IIF(File(cDir+cFile+".dbt"),"DBFCDX","DBFNTX") DBUseArea(.T.,cRDD,cDir+cFile,"TEMP",.F.) If LastRec() > 0 //Sys_Meter(2,LastRec(),"Importando o arquivo "+cFile+".DBF") FastTurbo(cTable) Endif DBCloseArea() Catch oErr //XBrowser oErr title cFile MsgStop('erro') DBCloseArea() End Endif Next MsgStop(SecToTime(Seconds()-nTime),"Tempo de conversão de Dbf para Sql") //Sys_Meter(3) Return **===================================================================== Static Function FastTurbo(cTable) Local aStru := DBStruct() Local cSql If Sr_ExistTable(cTable) Sr_DropTable(cTable) Endif DBCreate(cTable,aStru,"SQLRDD") DBGoTop() Do While !Eof() cSql := SqlInsert(cTable,aStru) Sr_GetConnection():Execute(cSql) DBSkip() //Sys_Meter(2) Enddo Sr_GetConnection():Commit() Return nil **===================================================================== Static Function SqlInsert(cTable,aStru) Local nI,uVal,aCampos:={},cSql For nI:=1 To Len(aStru) uVal := FieldGet(nI) uVal := SQL_String(uVal,.T.) AAdd(aCampos,{aStru[nI,1],uVal}) Next //Define os campos cSql := "Insert Into "+cTable+" ("+aCampos[1,1] For nI:=2 To Len(aCampos) cSql += ","+aCampos[nI,1] Next //define os dados cSql += ") Values ("+aCampos[1,2] For nI:=2 To Len(aCampos) cSql += ","+aCampos[nI,2] Next cSql+=");" Return cSql **======================================================================= FUNCTION Sql_String(xValue,lIsNull,nID ) //SR_cDBValue( <uData>, [<nSystemID>] ) ==> cQuotedString **======================================================================= Local cType := ValType(xValue) Default(@lIsNull,.F.) Default(@nID,SR_GetConnection():nSystemID) If cType == "C" //corrige aspas simples xValue := StrTran(xValue,"'"," ") Endif xValue := SR_SQLQuotedString(xValue,nID) //nid=tipo de banco sql If !lIsNull IF (cType IN "CD") .AND. xValue == "NULL" xValue := "''" ElseIF cType == "N" .AND. xValue == "NULL" xValue := "0" Endif Endif Return xValue Fiz checklist na rotina, acertei alguns pontos, faltou eu postar a rotina Sql_String() que formata os dados, a falta dela pode ter causado o erro.
  8. Edu não pude simular o seu erro ainda, para semana farei isso, mas causa provável como o próprio erro evidência, está na criação do banco de dados, tipo innodb, myISAM. Tem comandos próprios do mysql para reparar isso.
  9. https://github.com/FiveTechSoft/FWH_tools
  10. //============================================================================== Procedure UpLoad() Local aFiles,cFile,cTable,nTime,cRDD,oErr,aDBF,nI Set AutOpen OFF aDBF := Directory(DefPath()+"\arq\*.DBF") aFiles :={} For nI:=1 TO Len(aDBF) AAdd(aFiles,Trim(aDBF[nI,1])) Next //Sys_Meter(1,0,"Importando o arquivo") nTime:=Seconds() For Each cFile IN aFiles cTable := Lower(cFileNoExt(cFile)) If File(cFile+".dbf") .and. !SR_ExistTable(cFile) Try cRDD := IIF(File(cFile+".dbt"),"DBFCDX","DBFNTX") DBUseArea(.T.,cRDD,cFile,"TEMP",.F.) If LastRec() > 0 //Sys_Meter(2,LastRec(),"Importando o arquivo "+cFile+".DBF") FastTurbo(cTable) Endif DBCloseArea() Catch oErr XBrowser oErr title cFile DBCloseArea() End Endif Next MsgStop(SecToTime(Seconds()-nTime),"Tempo de conversão de Dbf para Sql") //Sys_Meter(3) Return **===================================================================== Static Function FastTurbo(cTable) Local aStru := DBStruct() Local cSql If Sr_ExistTable(cTable) Sr_DropTable(cTable) Endif DBCreate(cTable,aStru,"SQLRDD") DBGoTop() Do While !Eof() cSql := SqlInsert(cTable,aStru) Sr_GetConnection():Execute(cSql) DBSkip() Sys_Meter(2) Enddo Sr_GetConnection():Commit() Return nil **===================================================================== Static Function SqlInsert(cTable,aStru) Local nI,uVal,aCampos:={},cSql For nI:=1 To Len(aStru) uVal := FieldGet(nI) uVal := SQL_String(uVal,.T.) AAdd(aCampos,{aStru[nI,1],uVal}) Next //Define os campos cSql := "Insert Into "+cTable+" ("+aCampos[1,1] For nI:=2 To Len(aCampos) cSql += ","+aCampos[nI,1] Next //define os dados cSql += ") Values ("+aCampos[1,2] For nI:=2 To Len(aCampos) cSql += ","+aCampos[nI,2] Next cSql+=");" Return cSql Edu, se vc conseguiu fazer a conexão, basta ajustar pasta do seus arquivos para carregar aDBF. Uso a SQLRDD e estou muito contente, não encontro nenhuma dificuldade, banco criado pela sqlrdd é usado por aplicativos web e android, claro que se faz necessário tomar certos cuidados como: -Set delete off -Não cria índices sintéticos - sempre criar tabela via SQLRDD - Controle transacional blz
  11. Jovem se puder liste as libs do borland (bcc) que vc usa no seu projeto. Me lembro que tem haver com elas e não com a lib do HB. Mas no momento não tenho como precisar.
  12. Pelles C 9.0, uma alternativa!
  13. Senhores gostaria de saber se é desta forma que Srs. usam VSCode, preciso criar script acrescentando cada .prg novo. E para compilar seleciono o .bat e no menu terminal seleciono o executar arquivo ativo. Ou tem outra forma de gerenciar o projeto de forma mais simples.
  14. Sim tbm vou na raça! mas só para saber a fivewin já tem o debug. Gráfico https://drive.google.com/file/d/1xvFGd52hhFn80Oz57Oz8sQ4DggRfjsm9/view?usp=sharing Console https://drive.google.com/file/d/1BhABOw8hTXAA5xhPHRvVfupT9lqhKTLL/view?usp=sharing
  15. Assim como o Linhares, além VSCode também recomendo xEdit 7.0 da Xailer. Muito simples, versátil e fácil de configurar, vc pode usar tanto xHarbour como Harbour. segue link, Free: https://download.xailer.com/?download=3
  16. Provavelmente é o atributo de permissões entre o usuário e as permissões da tabela. Vc precisa configurar isto através do sgdb. Caso precise de ajuda através do Anydesk estou a disposição.
  17. Provavelmente é o atributo de permissões entre o usuário e as permissões da tabela. Vc precisa configurar isto através do sgdb.
  18. @Jorge Andrade Caro amigo Jorge Andrade ou quem mais usa ACBR Boletos, gostaria de saber se o banco 376 JP Morgan tem Layout homologado para boletos nas versões mais novas da DLL. a que tenho não contempla. att. JMSilva
  19. Jmsilva

    Ftp

    Veja se ajuda: #include "Directry.ch" #include "fivewin.ch" #include "hbstruct.ch" Static oVar FUNCTION Main() Local cFile := "File.zip" STRUCTURE oVar MEMBER lOpen INIT .F. MEMBER cDir INIT "Repos" MEMBER cPassword INIT "123456" MEMBER cUSBStick INIT "ftp://nome_do_usuario_ftp:senha@localhost" ENDSTRUCTURE //CONEXÃO oVar:oFtp := TIpClientFtp():New(oVar:cUSBStick) oVar:oFtp:oUrl:cPassword := oVar:cPassword oVar:oFtp:nDefaultPort := 21 //porta oVar:lOpen := oVar:oFtp:open() IF oVar:lOpen //entra no diretório oVar:oFtp:cwd(oVar:cDir) //UpLoad oVar:oFtp:uploadFile(cFile) MsgInfo(oVar:oFtp:cReply +CRLF+"Upload Concluído") //Download oVar:oFtp:downloadFile( "C:\temp\file01.zip",cFile) MsgInfo(oVar:oFtp:cReply +CRLF+"Download concluído") oVar:oFtp:cwd("..") //volta um nível de diretório //Finaliza oVar:oFtp:Close() Endif Return Nil Se o diretório não existir pode criar com oVar:oFtp:mkd(oVar:cDir)
  20. Não uso o setkey, faço assim: OGETG:bKeyDown := { |nKey| If(nKey=VK_F2, LOCGRU(OGETG,DGRU,ODSGRU),Nil) } Desta forma o F2 faz a chamada somente quando estiver no get, e ainda posso definir, funções diferente para cada get.
  21. Qual seria o tipo de campo ideal? Blob ?
  22. Se vc usa a lib fivewin pode usar a funções ARead() e ASave(). Excelente veja exemplo no link abaixo. https://wiki.fivetechsoft.com/doku.php?id=fivewin_function_aread
  23. Olá alguém conhece ou tem canal YouTube com vídeo mostrando a configuração do xHarbour no VSCode ? JMSILVA
×
×
  • Create New...