Clipper On Line • Ver Tópico - *** ADOxb - BIblioteca de funções de Acesso SQL ***

*** ADOxb - BIblioteca de funções de Acesso SQL ***

Discussão sobre SQL

Moderador: Moderadores

 

Mensagempor FARLEY RIBEIRO » 14 Nov 2007 14:27

Caro Rochinha...

Desculpe a ignorância mas não sei pq não estou conseguindo ...

Exibe a mensagem "Nenhum RDD especificado"

Criei um bd de dados no access "siac.mdb" (codigo (integer), descricao char(40)

Salvei o arquivo adoxb.ch, adoxb.prg e customer.prg com o código abaixo

#include "FiveWin.ch"
#include "Splitter.ch"
#include "adoxb.ch"

//----------------------------------------------------------------------------//
function main()

// Necessária para criar objetos e variaveis visiveis o tempo todo

ADOSetRDD( "ACCESS" ) // << ---------- definindo o RDD

if ADORDDDefault() = "ACCESS" // ADOMDB
   StrDatabase := ".\siac.mdb"
   StrConnection := "Provider= MicroSoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";"
endif

MsgRun( "Conectando via "+ADORDDDefault()+"..." )

ADO CONNECT StrConnection

// Abre as tabelas
ADO USE clientes

// Verifica se ja possuem dados
ADO SELECT clientes
nRegistros := ADORecCount()
if nRegistros = 0
   ADO APPEND BLANK
   ADO REPLACE codigo WITH "0001"
   ADO REPLACE nome   WITH "JOSE CARLOS DA ROCHA"
   ADO COMMIT
endif

ADO CLOSE ALL

return nil

#include "adoxb.prg"


Veja o arquivo fonte completo aqui...
http://www.badongo.com/pt/file/5136629

O que está acontecendo?

Grato

Farley
Borland BCC(5.51)/PellesC(5.01)/Fivewin(2.6)/xHarbour.org(0.99.50)/Med(3.02)/DBFNTX/DBFCDX /WvWToools(0.83)
Avatar de usuário

FARLEY RIBEIRO
Usuário Nível 2

Usuário Nível 2
 
Mensagens: 82
Data de registro: 24 Jul 2007 10:26
Cidade/Estado: MONTES CLAROS-MG
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Mensagempor rochinha » 14 Nov 2007 23:09

Amiguinho

Fiz testes com seu exemplo e notei que o erro ocorre pois sua ADOXB.CH e ADOXB.PRG estão desatualizadas em relação ao codigo completo que esta postado no inicio do tópico.

Recorte os codigos e salve-os novamente e recompile.

O unico erro que voce deverá ter depois é a falta de criação da tabela CLIENTES.

Entenda que um .MDB não é uma tabela como um .DBF é na verdade um container de tabelas e dentro deles deverão existir as tabelas clientes e siglas para teste.

Reveja o tópico desde o inicio e veja os exemplos que te mostram com clareza o porque da criação das mesmas.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Mensagempor clodoaldomonteiro » 05 Dez 2007 23:52

Rochinha!
Todas as bases de dados que vc mencionou tem que usar um sistema gerenciador de base de dados, não teria nenhum substituto do DBF com gerenciamento interno, pelo prórpio aplicativo?

Pois o bom do clipper era poder fazer tudo no sistema mesmo, sem sistema por fora, ´mas fica aquela coisa que DBF não é seguro.

Sou novato com o xharbour e ainda tenho muitas dúvidas.

Grato pela atenção.
At. Clodoaldo Monteiro
Linguagens: Clipper / Harbour
Área de Atuação: Sistemas de gestão para Prefeituras Municipais
Fones: (86)3223-0653, 98859-0236
www.simplesinformatica.com.br
Avatar de usuário

clodoaldomonteiro
Usuário Nível 4

Usuário Nível 4
 
Mensagens: 741
Data de registro: 30 Dez 2006 12:17
Cidade/Estado: Teresina-PI
Curtiu: 110 vezes
Mens.Curtidas: 31 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor gvc » 12 Jun 2008 15:47

[clodoaldomonteiro]
O que acontece é que o clipper administrar arquivos de dados que na verdade são arquivos textos com dados formatados.
Qdo vc esta trabalhando com um SGDB como MySQL/Oracle, o SGDB esta trabalhando na máquina o tempo todo. O seu sistema manda requisição de dados e o SGDB processa o pedido e dispõe os dados para o sistema. Por isso a sua consulta retorna um ponteiro com o resultado.
O mesmo vale para o ADS. Fica uma parte rodando no servidor. O seu sistema roda o RDD ADS fazendo a comunicação com o ADS do servidor. Este administra os arquivos, mesmo estes sendo DBF. O ADS abre os arquivos solicitados como exclusivos para ele trabalhar. Assim vc não consegue abrir um DBF já aberto pelo ADS senão usar o gerenciador do mesmo.
Existem muitos softwares administradores. Aqui o pessoal usou o Toad a algum tempo (tem uma versão gratuita agora). Agora estão usando o PLSQL Developer. Os dois são muito bons mesmo.

Espero ter ajudado. Boa sorte.
"TRS-80/Sincler/Apple/PC - Clipper Winter 85, tlink 1.0 [pc 10 MHz - 640K] {NEZ 8000 2Kb RAM}"
{POG - Programação Orientada a Gambiarra}
Avatar de usuário

gvc
Colaborador

Colaborador
 
Mensagens: 1269
Data de registro: 23 Ago 2005 10:57
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor rochinha » 12 Jun 2008 16:57

Amiguinho Clodoaldo,

Quando o DBF foi concebido para ser usado com o dBase(nem me lembro se dBase II) possuia manipulacao compartilhada, com dBase III em diante sim, as redes existentes eram gerenciadas por Novell, Lantastic, etc, todas rodando sob um sistema operacional monousuario o qual não sofria interferencias de outros programas pois na memoria só existiam drivers, o aplicativo e os DBFs. As redes eram mais seguras e os dados também por serem centralizadas num servidor que só executava o modulo central da rede.

Mesmo assim ainda existia o vilão da corrupçao, geralmente causada por quedas de força, ja que no-breaks pessoais ainda iriam aparecer.

Com o uso de redes ponto-a-ponto, começamos a ter os tão conhecidos problemas de travamentos, corrupçao, etc, causados pelas redes. Depois as redes se tornaram mais heterogeneas, com versões diferentes de Windows, falhas dos drivers controladores, perdas de conexão momentaneas em momentos criticos, etc.

Os SGDBs de hoje trabalham da mesma forma que as redes trabalhavam antes, centralizando o processo.

O dBase quando aberto pela rede é praticamente esticado do servidor para os terminal, pense em um chiclete, estique-o de sua boca com uma mão e depois com a outra mão puxe outra ponta, continue puxando ate uma parte romper.

Esta analogia é praticamente uma digitalizaçao de uma quebra que causa uma perda de dados ou corrupção.

O dBase foi concebido para armazenar dados e na época, como existia o pensamento de que memória e poder de processamento não cresceriam ou chegariam ao ano 2000, ninguém se preocupou em aprofundar tais recursos mas como sua vida foi se prolongando, foram aparecendo melhorias e ferramentas mais afinadas como Summer, Clipper 5 e seus RDDs até chegarmos ao que vemos hoje com Leto e outras alternativas de suporte a vida do DBF.

Se iremos continuar usando ainda pelos proximos 10 anos?

Digo que provavelmente sim, pois o tempo voa e os arranjos feitos sobre os RDDs poderão proporcionar o uso de todo o tipo de arquivo de dados, inclusive o vovo DBF.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor gvc » 12 Jun 2008 18:07

[mestre Rochinha]
O nome original era Vulcan -Planeta natal do Sr. Spoke, Jornada nas Estrelas.
Para vender, a Aston & Tate mudou o nome para DBase II. Era em assembler e rodava em CP/M.

possuia manipulacao compartilhada
- ??? Juro que não entendi. Antes do DBase III Plus, não dava para compartilhar arquivos. E eu juro que não consegui compartilhar mesmo com ele.

Na verdade, os No-Break já existiam, só que o preço era assustador. Funcionavam com baterias externas, normalmente as de carro. Tb existiam/existem os gerados.

A primeira rede que eu "coloquei a mão" foi uma Novell Lite. Seu executável tinha que ter atributo R/O. Apesar de falarem bem da Lantastic, eu nunca consegui trabalhar com ela. Tinha uma outra que trabalhava com 8 bits e ligava só duas máquinas. O cara que eu ví usando deixava mais desligado do que ligado. Era uma bomba.

Qto ao tempo de vida, é difícil prever qualquer coisa, mas temos muitos sistemas legados e alguns clientes não querem invertir em um SGDB. Existem alguns SGDB gratuitos, mas ainda tem que investir em uma máquina só para ele. Não é aconselhavel rodar o banco em uma máquina que esta sendo usada para trabalho normal. O usuário faz algo, trava a máquina e o banco fica travado para todos os usuários.

Juro que dá para ficar a noite e a madrugada toda falando sobre isso (no bar, é claro), mas vamos manter os "pés no chão".
"TRS-80/Sincler/Apple/PC - Clipper Winter 85, tlink 1.0 [pc 10 MHz - 640K] {NEZ 8000 2Kb RAM}"
{POG - Programação Orientada a Gambiarra}
Avatar de usuário

gvc
Colaborador

Colaborador
 
Mensagens: 1269
Data de registro: 23 Ago 2005 10:57
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor gilsonpaulo » 14 Jul 2008 18:38

Caro rochinha, ao tentar compilar o codigo que o nosso amigo Farley Ribeiro postou ocorre o seguinte erro.
Tem alguma ideia do que poder ser, sendo que atualizei a adoxb.ch e adoxb.prg e customer.prg

MAKE Version 5.2 Copyright (c) 1987, 2000 Borland
HARBOUR customer.prg -oobj\customer.c -n -m -b -iC:\xharbour\INCLUDE;C:\FWH\INCLUDE;C:\xharbour\include;C:\borland\bcc55\include
xHarbour Compiler build 1.1.0 (SimpLex)
Copyright 1999-2007, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'customer.prg'...

100

100

100

200

300

400

500

600

700

800

900

1000

100

200

100

200

100

200

300

400

500

600

700

800

900

1000

1100

1200

1300

1400

1500

adoxb.ch(52) Error E0017 Ambiguous match pattern in #translate/#command

100

200

300

100

200

300

400

adoxb.ch(52) Error E0017 Ambiguous match pattern in #translate/#command

100

200

300

100

200

300

400

500

600

700

800

2 errors

No code generated

** error 1 ** deleting obj\customer.c

Para efeito de duvidar segue o adoxb.prg:
**************************************************************************************
*
* Cursor Location
*
* adUseServer           2 Atua no lado servidor
* adUseClient           3 Atua no lado cliente
*
* Cursor Type
*
* adOpenForwardOnly     0 O cursor so navega para frente. Bom para listar dados
* adOpenKeyset          1 Nao permite ver os registro adicionados e eliminados
* adOpenDynamic         2 Aceita todas operacoes do utilizador e dos outros
* adOpenStatic          3 Serve apenas para procurar dados ou gerar relatorios
*
* Lock Type Enum - Contantes de Seguranca
*
* adLockReadOnly        1 Apenas pode ler os registros
* adLockPessimistic     2 O fornecedor dos dados fecha o registro apos edicao
* adLockOptimistic      3 O fornecedor dos dados fecha o registro apos chamar o update
* adLockBatchOptimistic 4 O mesmo que Optmistic mas para sequencia de comandos
*
* AllowNumsEnum
*
* adIndexNullsAllow     0
* adIndexNullsDisallow  1
* adIndexNullsIgnore    2
* adIndexNullsIgnoreAny 4
*
**************************************************************************************

#command ADO CONNECT <StrDriver> [<disconected:DISCONECTED>] => ADOCONNECT( <StrDriver>, [<.disconected.>] )
#command ADO DISCONNECT             => ADODISCONNECT()
#command ADO APPEND BLANK           => ADOAPPEND()
#command ADO EDIT                   => ADOEDIT()
#command ADO COMMIT [<save:SAVE>]   => ADOCOMMIT( [<.save.>] )
#command ADO SKIP                   => ADOSKIP( 1 )
#command ADO SKIP <num>             => ADOSKIP( <num> )
#command ADO DELETE                 => ADODELETE()
#command ADO REPLACE <f1> WITH <v1> => ADOREPLACE( <(f1)>, <v1> )
#command ADO GOTOP                  => ADOGOTOP()
#command ADO GOBOTTOM               => ADOGOBOTTOM()
#command ADO SET FILTER TO          => ADOSETFILTER()
#command ADO SET FILTER TO <xpr>    => ADOSETFILTER( <xpr> )
#command ADO SAVE <(CfILE)>         => ADOSAVE( <(CfILE)> )
#command ADO EXECUTE <*Sql*>        => ADOEXECUTE( <(Sql)> )
#command ADO LOCATE <xpr>           => ADOLOCATE( <xpr> )
#command ADO REGLOCK                => ADOREGLOCK()
#command ADO CLOSE                  => ADOCLOSE()
#command ADO CLOSE ALL              => ADOCLOSEALL()
#command ADO USE                    => ADOUSE()
#command ADO USE <(StrDatabase)> [<shared:SHARED>] => ADOUSE( <(StrDatabase)>, [<.shared.>] )
#command ADO SORT ON [<(cF)>][<(x)>]=> ADOSORT( [<(cF)>][, <(x)>] )
#command ADO SELECT <(cRecordSet)>  => ADOSELECT( <(cRecordSet)> )

#xcommand ADO SQL DELETE <*cSQL*>   => ADOEXECUTE( 'DELETE '+ <(cSQL)> )
#xcommand ADO SQL INSERT <*cSQL*>   => ADOEXECUTE( 'INSERT '+ <(cSQL)> )
#xcommand ADO SQL UPDATE <*cSQL*>   => ADOEXECUTE( 'UPDATE '+ <(cSQL)> )
#xcommand ADO SQL ALTER  <*cSQL*>   => ADOEXECUTE( 'ALTER ' + <(cSQL)> )
#xcommand ADO SQL CREATE <*cSQL*>   => ADOEXECUTE( 'CREATE '+ <(cSQL)> )
#xcommand ADO SQL DROP   <*cSQL*>   => ADOEXECUTE( 'DROP '  + <(cSQL)> )
#xcommand ADO SQL RENAME <*cSQL*>   => ADOEXECUTE( 'RENAME '+ <(cSQL)> )
#xcommand ADO SQL UPDATE <*cSQL*>   => ADOEXECUTE( 'UPDATE '+ <(cSQL)> )
#xcommand ADO SQL GRANT  <*cSQL*>   => ADOEXECUTE( 'GRANT ' + <(cSQL)> )
#xcommand ADO SQL REVOKE <*cSQL*>   => ADOEXECUTE( 'REVOKE '+ <(cSQL)> )

/*---- Lock Type Enum ----*/
#define adLockReadOnly        1
#define adLockPessimistic     2
#define adLockOptimistic      3
#define adLockBatchOptimistic 4

/*---- AllowNumsEnum ----*/
#define adIndexNullsAllow     0
#define adIndexNullsDisallow  1
#define adIndexNullsIgnore    2
#define adIndexNullsIgnoreAny 4

/*---- CursorTypeEnum Values ----*/
#define adOpenForwardOnly 0
#define adOpenKeyset 1
#define adOpenDynamic 2
#define adOpenStatic 3

/*---- LockTypeEnum Values ----*/
#define adLockReadOnly 1
#define adLockPessimistic 2
#define adLockOptimistic 3
#define adLockBatchOptimistic 4

/*---- CursorLocationEnum Values ----*/
#define adUseServer 2
#define adUseClient 3

/*---- DataTypeEnum Values ----*/
#define adEmpty 0
#define adTinyInt 16
#define adSmallInt 2
#define adInteger 3
#define adBigInt 20
#define adUnsignedTinyInt 17
#define adUnsignedSmallInt 18
#define adUnsignedInt 19
#define adUnsignedBigInt 21
#define adSingle 4
#define adDouble 5
#define adCurrency 6
#define adDecimal 14
#define adNumeric 131
#define adBoolean 11
#define adError 10
#define adUserDefined 132
#define adVariant 12
#define adIDispatch 9
#define adIUnknown 13
#define adGUID 72
#define adDate 7
#define adDBDate 133
#define adDBTime 134
#define adDBTimeStamp 135
#define adBSTR 8
#define adChar 129
#define adVarChar 200
#define adLongVarChar 201
#define adWChar 130
#define adVarWChar 202
#define adLongVarWChar 203
#define adBinary 128
#define adVarBinary 204
#define adLongVarBinary 205
#define adChapter 136
#define adFileTime 64
#define adPropVariant 138
#define adVarNumeric 139
#define adArray &H2000

/*---- GetRowsOptionEnum Values ----*/
#define adGetRowsRest -1

/*---- PositionEnum Values ----*/
#define adPosUnknown -1
#define adPosBOF -2
#define adPosEOF -3

/*---- BookmarkEnum Values ----*/
#define adBookmarkCurrent 0
#define adBookmarkFirst 1
#define adBookmarkLast 2

/*---- MarshalOptionsEnum Values ----*/
#define adMarshalAll 0
#define adMarshalModifiedOnly 1

/*---- AffectEnum Values ----*/
#define adAffectCurrent 1
#define adAffectGroup 2
#define adAffectAllChapters 4

/*---- ResyncEnum Values ----*/
#define adResyncUnderlyingValues 1
#define adResyncAllValues 2

/*---- CompareEnum Values ----*/
#define adCompareLessThan 0
#define adCompareEqual 1
#define adCompareGreaterThan 2
#define adCompareNotEqual 3
#define adCompareNotComparable 4

/*---- FilterGroupEnum Values ----*/
#define adFilterNone 0
#define adFilterPendingRecords 1
#define adFilterAffectedRecords 2
#define adFilterFetchedRecords 3
#define adFilterConflictingRecords 5

/*---- SearchDirectionEnum Values ----*/
#define adSearchForward 1
#define adSearchBackward -1

/*---- PersistFormatEnum Values ----*/
#define adPersistADTG 0
#define adPersistXML 1

/*---- StringFormatEnum Values ----*/
#define adClipString 2

/*---- ConnectPromptEnum Values ----*/
#define adPromptAlways 1
#define adPromptComplete 2
#define adPromptCompleteRequired 3
#define adPromptNever 4

/*---- ConnectModeEnum Values ----*/
#define adModeUnknown 0
#define adModeRead 1
#define adModeWrite 2
#define adModeReadWrite 3
#define adModeShareDenyRead 4
#define adModeShareDenyWrite 8
#define adModeShareExclusive 12
#define adModeShareDenyNone 16

/*---- EventReasonEnum Values ----*/
#define adRsnAddNew 1
#define adRsnDelete 2
#define adRsnUpdate 3
#define adRsnUndoUpdate 4
#define adRsnUndoAddNew 5
#define adRsnUndoDelete 6
#define adRsnRequery 7
#define adRsnResynch 8
#define adRsnClose 9
#define adRsnMove 10
#define adRsnFirstChange 11
#define adRsnMoveFirst 12
#define adRsnMoveNext 13
#define adRsnMovePrevious 14
#define adRsnMoveLast 15

/*---- SchemaEnum Values ----*/
#define adSchemaProviderSpecific -1
#define adSchemaAsserts 0
#define adSchemaCatalogs 1
#define adSchemaCharacterSets 2
#define adSchemaCollations 3
#define adSchemaColumns 4
#define adSchemaCheckConstraints 5
#define adSchemaConstraintColumnUsage 6
#define adSchemaConstraintTableUsage 7
#define adSchemaKeyColumnUsage 8
#define adSchemaReferentialConstraints 9
#define adSchemaTableConstraints 10
#define adSchemaColumnsDomainUsage 11
#define adSchemaIndexes 12
#define adSchemaColumnPrivileges 13
#define adSchemaTablePrivileges 14
#define adSchemaUsagePrivileges 15
#define adSchemaProcedures 16
#define adSchemaSchemata 17
#define adSchemaSQLLanguages 18
#define adSchemaStatistics 19
#define adSchemaTables 20
#define adSchemaTranslations 21
#define adSchemaProviderTypes 22
#define adSchemaViews 23
#define adSchemaViewColumnUsage 24
#define adSchemaViewTableUsage 25
#define adSchemaProcedureParameters 26
#define adSchemaForeignKeys 27
#define adSchemaPrimaryKeys 28
#define adSchemaProcedureColumns 29
#define adSchemaDBInfoKeywords 30
#define adSchemaDBInfoLiterals 31
#define adSchemaCubes 32
#define adSchemaDimensions 33
#define adSchemaHierarchies 34
#define adSchemaLevels 35
#define adSchemaMeasures 36
#define adSchemaProperties 37
#define adSchemaMembers 38
#define adSchemaTrustees 39

/*---- FieldStatusEnum Values ----*/
#define adFieldOK 0
#define adFieldCantConvertValue 2
#define adFieldIsNull 3
#define adFieldTruncated 4
#define adFieldSignMismatch 5
#define adFieldDataOverflow 6
#define adFieldCantCreate 7
#define adFieldUnavailable 8
#define adFieldPermissionDenied 9
#define adFieldIntegrityViolation 10
#define adFieldSchemaViolation 11
#define adFieldBadStatus 12
#define adFieldDefault 13
#define adFieldIgnore 15
#define adFieldDoesNotExist 16
#define adFieldInvalidURL 17
#define adFieldResourceLocked 18
#define adFieldResourceExists 19
#define adFieldCannotComplete 20
#define adFieldVolumeNotFound 21
#define adFieldOutOfSpace 22
#define adFieldCannotDeleteSource 23
#define adFieldReadOnly 24
#define adFieldResourceOutOfScope 25
#define adFieldAlreadyExists 26
#define adFieldPendingInsert &H10000
#define adFieldPendingDelete &H20000
#define adFieldPendingChange &H40000
#define adFieldPendingUnknown &H80000
#define adFieldPendingUnknownDelete &H100000

/*---- SeekEnum Values ----*/
#define adSeekFirstEQ &H1
#define adSeekLastEQ &H2
#define adSeekAfterEQ &H4
#define adSeekAfter &H8
#define adSeekBeforeEQ &H10
#define adSeekBefore &H20

/*---- ADCPROP_UPDATECRITERIA_ENUM Values ----*/
#define adCriteriaKey 0
#define adCriteriaAllCols 1
#define adCriteriaUpdCols 2
#define adCriteriaTimeStamp 3

/*---- ADCPROP_ASYNCTHREADPRIORITY_ENUM Values ----*/
#define adPriorityLowest 1
#define adPriorityBelowNormal 2
#define adPriorityNormal 3
#define adPriorityAboveNormal 4
#define adPriorityHighest 5

/*---- ADCPROP_AUTORECALC_ENUM Values ----*/
#define adRecalcUpFront 0
#define adRecalcAlways 1

/*---- ADCPROP_UPDATERESYNC_ENUM Values ----*/

/*---- ADCPROP_UPDATERESYNC_ENUM Values ----*/

/*---- MoveRecordOptionsEnum Values ----*/
#define adMoveUnspecified -1
#define adMoveOverWrite 1
#define adMoveDontUpdateLinks 2
#define adMoveAllowEmulation 4

/*---- CopyRecordOptionsEnum Values ----*/
#define adCopyUnspecified -1
#define adCopyOverWrite 1
#define adCopyAllowEmulation 4
#define adCopyNonRecursive 2

/*---- StreamTypeEnum Values ----*/
#define adTypeBinary 1
#define adTypeText 2

/*---- LineSeparatorEnum Values ----*/
#define adLF 10
#define adCR 13
#define adCRLF -1

/*---- StreamOpenOptionsEnum Values ----*/
#define adOpenStreamUnspecified -1
#define adOpenStreamAsync 1
#define adOpenStreamFromRecord 4

/*---- StreamWriteEnum Values ----*/
#define adWriteChar 0
#define adWriteLine 1

/*---- SaveOptionsEnum Values ----*/
#define adSaveCreateNotExist 1
#define adSaveCreateOverWrite 2

/*---- FieldEnum Values ----*/
#define adDefaultStream -1
#define adRecordURL -2

/*---- StreamReadEnum Values ----*/
#define adReadAll -1
#define adReadLine -2

/*---- RecordTypeEnum Values ----*/
#define adSimpleRecord 0
#define adCollectionRecord 1
#define adStructDoc 2


Adoxb.prg
****************************************************************************************
*
* CursorType
*
* adOpenForwardOnly     0 O cursor so navega para frente. Bom para listar dados
* adOpenKeyset          1 Nao permite ver os registro adicionados e eliminados
* adOpenDynamic         2 Aceita todas operacoes do utilizador e dos outros
* adOpenStatic          3 Serve apenas para procurar dados ou gerar relatorios
*
* LockTypeEnum - Contantes de Seguranca
*
* adLockReadOnly        1 Apenas pode ler os registros
* adLockPessimistic     2 O fornecedor dos dados fecha o registro apos edicao
* adLockOptimistic      3 O fornecedor dos dados fecha o registro apos chamar o update
* adLockBatchOptimistic 4 O mesmo que Optmistic mas para sequencia de comandos
*
* SortOrdEnum - Contantes de Ordenacao
*
* adSortAscending       1 Ordem ascendente
* adSortDescending      2 Ordem descendente
*
****************************************************************************************

#include "adoxb.ch"
#ifndef _ADO_xHarbour_
        #define _ADO_Harbour_
#endif

*
*---------------------------------------------------------
Function ADOSetRDD( cRDDName )
   public cADORDD := iif( cRDDName=NIL, "DBF", cRDDName )
   PUBLIC aRecordSet, oRecordSet, nConnection, nRecordSet, aIndexOrder, nIndexOrder, ;
          StrConnection, aADOConection, oADOConection, oADOErrDescription, oADOIndex, ;
          oADOCatalog, oADOTable, oADOStream
   nConnection        := 1
   aADOConection      := {}
   oADOConection      := Array(10)
   return cADORDD

*
*---------------------------------------------------------
#ifdef _ADO_Harbour_
Function ADOConnect( StrDriver )
   //PUBLIC aRecordSet, oRecordSet, nRecordSet, aIndexOrder, nIndexOrder, StrConnection, oADOConection, oADOErrDescription, oADOIndex, oADOCatalog, oADOTable
   aRecordSet         := {}
   oRecordSet         := Array(50)
   oADOIndex          := Array(10)
   nRecordSet         := 0
   aIndexOrder        := {}
   nIndexOrder        := 1
   StrConnection      := StrDriver
   AADD( aADOConection, StrDriver ) // Controla numero de conexoes
   nConnection        := len( aADOConection )
   oADOConection[nConnection] := TOLEAUTO():New("ADODB.connection")
   oADOStream         := TOLEAUTO():New("ADODB.Stream")
   oADOErrDescription := TOLEAUTO():New("ADODB.Err")
   oADOIndex          := TOLEAUTO():New("ADOX.Index")
   oADOCatalog        := TOLEAUTO():New("ADOX.Catalog")
   oADOConection[nConnection]:CommandTimeOut    := 200
   oADOConection[nConnection]:ConnectionTimeOut := 10
   oADOConection[nConnection]:CursorLocation    := adUseClient
   oADOConection[nConnection]:Mode              := adModeShareDenyNone // adModeRead 1, adModeWrite 2, adModeReadWrite 3
   oADOConection[nConnection]:Open( StrConnection )
   return 'connected'
   #endif _ADO_Harbour_

*
*---------------------------------------------------------
#ifdef _ADO_Harbour_
Function ADODBCREATE( cDatabase )
   oADOCreateCatalog := TOLEAUTO():New("ADOX.Catalog")
   StrConnection := "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cDatabase
   oADOCreateCatalog:Create( StrConnection )
   return .t.

Function ADOCREATE( cTable, aFields )
   //local oADOTable := TOLEAUTO():New("ADOX.Table")
   //oADOCatalog:ActiveConnection := StrConnection
   //oADOTable:Name := cTable
   //for i = 1 to len( aFields )
   //    oADOTable:Columns:Append( aFields[i][1], GetFieldType(aFields[i][2]), aFields[i][3] )
   //next
   //oADOCatalog:Tables:Append( oADOTable )
   //oADOTable:Close()
   //oADOTable:End()
   //
   //oADOCreateCatalog := TOLEAUTO():New("ADOX.Catalog")
   //oADOCreateTable   := TOLEAUTO():New("ADOX.Table")
   //oADOCreateCatalog:Create( StrConnection )
   //oADOCreateTable:Name := cTable
   //for i = 1 to len( aFields )
   //    oADOCreateTable:Columns:Append( aFields[i][1], GetFieldType(aFields[i][2]) ) //, aFields[i][3] )
   //next
   //oADOCreateCatalog:Tables:Append( cTable )
   //return .t.
   #endif _ADO_Harbour_

*
*---------------------------------------------------------
#ifdef _ADO_Harbour_
Function ADOIndex( cTable, cIDXField, cIDXName, cIDXAscend )
   local adSortAscending := 1, adSortDescending := 2
   local oADOTable := TOLEAUTO():New("ADOX.Table")
   cIDXAscend := iif( cIDXAscend = nil, .t., cIDXAscend )
   if .not. ADOFILE( "INDEXES" )
      oADOCatalog:ActiveConnection := StrConnection
      oADOTable:Name := "INDEXES"
      oADOTable:Columns:Append( "NumField", adInteger, 20 )
      oADOTable:Columns:Append( "TextField", adVarWChar, 20 )
      oADOCatalog:Tables:Append( oADOTable )
   endif
   AADD( aIndexOrder, cTable )
   nIndexOrder        := len( aIndexOrder )
   oADOIndex[nIndexOrder] := TOLEAUTO():New("ADOX.Index")
   oADOIndex[nIndexOrder]:Name       := cIDXName
   oADOIndex[nIndexOrder]:Columns:Append( cIDXField )
   oADOIndex[nIndexOrder]:Columns( cIDXField ):SortOrder = iif( cIDXAscend, adSortAscending, adSortDescending )
   //oADOIndex[nIndexOrder]:PrimaryKey := .t.
   //oADOIndex[nIndexOrder]:Unique     := .t.
   oADOIndex[nIndexOrder]:IndexNulls := adIndexNullsAllow
   // Adciona o indice criado ao catalogo
   //oADOCatalog:Tables( cTable ) //:Indexes:Append( oADOIndex[nIndexOrder] )
   oADOTable:Indexes:Append( oADOIndex )
   oADOCatalog:Tables:Append( oADOTable )
   oADOTable:Close()
   oADOTable:End()
   return .t.
   #endif _ADO_Harbour_

*
*---------------------------------------------------------
#ifdef _ADO_Harbour_
Function ADOUse( cDatabase, lShared )
   local oError
   if cADORDD = "XML"
      cDatabase := cDatabase + ".xml"
   endif
   if cADORDD = "XLS"
      cDatabase := "[" + cDatabase + "$]"
   endif
   if cDatabase = NIL
      oRecordSet[nRecordSet]:Close()
      oRecordSet[nRecordSet]:End()
   else
      AADD( aRecordSet, cDatabase )
      cRecordSet := cDatabase
      nRecordSet := len( aRecordSet )
      oRecordSet[nRecordSet] := TOleAuto():New( "ADODB.Recordset" )
      if cADORDD = "XML"
         oRecordSet[nRecordSet]:Open( cDatabase, StrConnection, 1, 3 )
      else
         oRecordSet[nRecordSet]:CacheSize      := 50
         oRecordSet[nRecordSet]:CursorLocation := adUseClient
         if lShared = .t.
            oRecordSet[nRecordSet]:CursorType  := adOpenDynamic
            oRecordSet[nRecordSet]:LockType    := adLockOptimistic
         else
            oRecordSet[nRecordSet]:CursorType  := adOpenStatic
            oRecordSet[nRecordSet]:LockType    := adLockPessimistic
         endif
         oRecordSet[nRecordSet]:Open( "Select * from " + cDatabase, StrConnection, iif(lShared=.t.,3,1), 3 )
      endif
      ADOGOTOP() // oRecordSet[nRecordSet]:MoveFirst()
   endif
   * CursorType
   *
   * adOpenForwardOnly     0 O cursor so navega para frente. Bom para listar dados
   * adOpenKeyset          1 Nao permite ver os registro adicionados e eliminados
   * adOpenDynamic         2 Aceita todas operacoes do utilizador e dos outros
   * adOpenStatic          3 Serve apenas para procurar dados ou gerar relatorios
   *
   * LockTypeEnum - Contantes de Seguranca
   *
   * adLockReadOnly        1 Apenas pode ler os registros
   * adLockPessimistic     2 O fornecedor dos dados fecha o registro apos edicao
   * adLockOptimistic      3 O fornecedor dos dados fecha o registro apos chamar o update
   * adLockBatchOptimistic 4 O mesmo que Optmistic mas para sequencia de comandos
   return .t.
   #endif _ADO_Harbour_

*
*---------------------------------------------------------
#ifdef _ADO_Harbour_
Function ADOConnectRemote( StrDSN, StrServer )
   PUBLIC aRecordSet, oRecordSet, nRecordSet, aIndexOrder, nIndexOrder, StrConnection, oADOConection, oADOErrDescription, oADOIndex, oADOCatalog
   aRecordSet    := {}
   oRecordSet    := Array(50)
   oADOIndex     := Array(10)
   nRecordSet    := 0
   aIndexOrder   := {}
   nIndexOrder   := 1
   StrConnection := StrDriver
   oADOConection := TOLEAUTO():New("RDS.DataControl")
   oADOConection:ExecuteOptions := adcExecAsync
   oADOConection:Connect        := "DSN=" + StrDriver
   oADOConection:Server         := StrServer
   oADOConection:Refresh()
   return .t.
   #endif _ADO_Harbour_

*
*---------------------------------------------------------
Function ADOConnected()
   if !(valtype(oADOConection[nConnection]) = "O")
      return .f. // Nao foi definido o Objecto
   endif
   if valtype(oADOConection) = "L"
      return .f. // Se ja existe a variavel mas nao foi definida como Objeto
   endif
   cADOConectionState := oADOConection[nConnection]:State
   return iif( cADOConectionState=1, .t., .f. )

*
*---------------------------------------------------------
Function MsgAlert( cMsg )
   Alert( cMsg )
   return .t.

*
*---------------------------------------------------------
Function ADOSetDriver( StrDatabase, StrSenha, StrUsuario, StrServer, StrPort )
   public cADORDD := iif( cRDDName=NIL, "DBASE", cRDDName )
   StrConnection := ""
   StrDriver     := ADORDDDefault()
   if StrDriver = "DBASE"
      StrConnection := "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";Extended Properties=dBASE IV;"
   endif
   if StrDriver = "ACCESS" // ADOMDB
      StrConnection := "Provider= MicroSoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";"
   endif
   if StrDriver = "FIREBIRD" // ADOGDB
      StrConnection := "DRIVER=Firebird/InterBase(r) driver; UID="+StrSenha+"; PWD="+StrUsuario+"; DBNAME="+StrDatabase
   endif
   if StrDriver = "MYSQL" // ADOMySQL
      StrConnection := "driver={MySQL ODBC 3.51 Driver};database=" + StrDatabase + ;
                       ";server=" + StrServer + ;
                       ";uid=" + StrUsuario + ;
                       ";pwd=" + StrSenha + ;
                       ";option=35"
   endif
   if StrDriver = "PARADOX" // ADOPX
      StrConnection := "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";Extended Properties=Paradox 5.x;"
   endif
   if StrDriver = "SQL"
      StrConnection := "Provider=MSDASQL;Data Source=SQLExpress;User ID=Administrador;Password=konectiva;"
   endif
    if ADORDDDefault() = "XMLDB" // ADOXML
       StrConnection := "Provider=MSPersist"
    endif
    if ADORDDDefault() = "XML" // ADOXML
       StrConnection := "Provider=MSDAOSP;Data Source=MSXML2.DSOControl.2.6"
    endif
   if StrDriver = "XLS" // ADOXLS
      StrConnection := [Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\adoxls.xls;Extended Properties="Excel 8.0;HDR=Yes;IMEX=1"]
   endif
   if StrDriver = "REMOTE" // ADORDS
      StrConnection := "Provider=MS Remote;Remote Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";Remote Server=" + StrServer
   endif
   return StrConnection

*
*---------------------------------------------------------
Function ADORDDDefault(qADORDD)
   default cADORDD := "Nenhum RDD especificado."
   //if (qADORDD = nil)
   //   cADORDD := qADORDD
   //endif
   return cADORDD

*
*---------------------------------------------------------
Function ADOFile( cFile )
   if cADORDD = "XML" .or. cADORDD = "XLS"
      return file( cFile )
   else
      oADOCatalog := oADOConection[nConnection]:OpenSchema(adSchemaTables)
      do while .not. oADOCatalog:EOF()
         if upper(alltrim(oADOCatalog:Fields( "TABLE_NAME" ):Value)) = upper(alltrim(cFile))
            return .t.
         endif
         oADOCatalog:MoveNext()
      enddo
   endif
   return .f.

*
*---------------------------------------------------------
Function ADOAlias()
   if nRecordSet < 1
      return ""
   else
      return aRecordSet[nRecordSet]
   endif

*
*---------------------------------------------------------
Function ADOFCount()
   if nRecordSet < 1
      return ""
   else
      return aRecordSet[nRecordSet]:Fields:Count()
   endif

*
*---------------------------------------------------------
Function ADOBEGINTRANSACTION()
   oADOConection[nConnection]:BeginTrans()
   return .t.

*
*---------------------------------------------------------
Function ADOCOMMITTRANSACTION()
   oADOConection[nConnection]:CommitTrans()
   return .t.

*
*---------------------------------------------------------
Function GetFieldType(FieldType)
   do Case
      Case FieldType = "C"
           return adVarWChar
      Case FieldType = "N"
           return adInteger
      Case FieldType = "M"
           return adText
      Case FieldType = "L"
           return adBoolean
      Case FieldType = "D"
           return adDate
   Endcase

*
*---------------------------------------------------------
Function ADOSetOrder( nIDXOrder )
   oRecordSet[nRecordSet]:Index = oADOIndex[nIDXOrder]:Name
   return .t.

*
*---------------------------------------------------------
Function ADODISConnect()
   oADOConection[nConnection]:Close()
   oADOErrDescription:Close()
   oADOIndex:Close()
   oADOCatalog:Close()
   oADOConection[nConnection]:End()
   oADOErrDescription:End()
   oADOIndex:End()
   oADOCatalog:End()
   return .t.

*
*---------------------------------------------------------
Function ADOAppend()
   oRecordSet[nRecordSet]:AddNew()
   return .t.

*
*---------------------------------------------------------
Function ADOEdit()
   oRecordSet[nRecordSet]:Edit()
   return .t.

*
*---------------------------------------------------------
Function ADOCommit( lSave )
   lSave := iif( lSave = nil, .f., lSave )
   oRecordSet[nRecordSet]:Update()
   if lSave
      oRecordSet[nRecordSet]:Save( alltrim(aRecordSet[nRecordSet]), adPersistXML )
   endif
   marca := oRecordSet[nRecordSet]:BookMark
   oRecordSet[nRecordSet]:Requery()
   oRecordSet[nRecordSet]:BookMark = marca
   return .t.

*
*---------------------------------------------------------
Function ADORequery()
   oRecordSet[nRecordSet]:Requery()
   return .t.

*
*---------------------------------------------------------
Function ADOReSync()
   oRecordSet[nRecordSet]:ReSync()
   return .t.

*
*---------------------------------------------------------
Function ADOUpdateBatch()
   oRecordSet[nRecordSet]:UpdateBatch()
   return .t.

*
*---------------------------------------------------------
Function ADOCommitAll()
   for i = 1 to len(aRecordSet)
       oRecordSet[nRecordSet]:Update()
   next
   return .t.

*
*---------------------------------------------------------
Function ADOSave( cfile )
   oRecordSet[nRecordSet]:Save( cFile, adPersistXML )
   return .t.

*
*---------------------------------------------------------
Function ADOReglock()
   //oRecordSet[nRecordSet]:CursorLocation := 2
   //oRecordSet[nRecordSet]:CursorType     := 0
   //oRecordSet[nRecordSet]:LockType       := 3
   return .t.

*
*---------------------------------------------------------
Function ADOSkip( nSkip )
   LOCAL nRec := oRecordSet[nRecordSet]:AbsolutePosition()
   oRecordSet[nRecordSet]:Move( iif( nSkip = nil, 1, nSkip ) )
   IF oRecordSet[nRecordSet]:EOF(); oRecordSet[nRecordSet]:MoveLast() ; ENDIF
   IF oRecordSet[nRecordSet]:BOF(); oRecordSet[nRecordSet]:MoveFirst(); ENDIF
   return oRecordSet[nRecordSet]:AbsolutePosition() - nRec

*
*---------------------------------------------------------
Function ADODelete()
   oRecordSet[nRecordSet]:Delete()
   oRecordSet[nRecordSet]:Move( -1 )
   if cADORDD = "XML" // ".XML" $ upper(aRecordSet[nRecordSet])
      oRecordSet[nRecordSet]:Save( alltrim(aRecordSet[nRecordSet]), adPersistXML )
   endif
   return .t.

*
*---------------------------------------------------------
Function ADOGoTo( nRec )
   //oRecordSet[nRecordSet]:BookMark :=  nRec
   return .t.

*
*---------------------------------------------------------
Function ADOGoTop()
   if .not. ADOBof()
      if ADORecCount() > 0
         oRecordSet[nRecordSet]:MoveFirst()
      endif
   endif
   return .t.

*
*---------------------------------------------------------
Function ADOGoBottom()
   if .not. ADOEof()
      if ADORecCount() > 0
         oRecordSet[nRecordSet]:MoveLast()
      endif
   endif
   return .t.

*
*---------------------------------------------------------
Function ADORecno()
   if nRecordSet < 0
      return 0
   else
      return oRecordSet[nRecordSet]:AbsolutePosition()
   endif

*
*---------------------------------------------------------
Function ADORecCount()
   if nRecordSet < 1
      return 0
   else
      nRecord := oRecordSet[nRecordSet]:AbsolutePosition()
      nRecord := iif(nRecord=nil,-1,nRecord)
      if nRecord < 1 //.or. .not. ( oRecordSet[nRecordSet]:EOF() = oRecordSet[nRecordSet]:BOF() )
         return 0
      else
         return oRecordSet[nRecordSet]:RecordCount()
      endif
   endif

*
*---------------------------------------------------------
Function ADOSetFilter( xpr )
   if xpr = NIL
      oRecordSet[nRecordSet]:Filter := 0
   else
      oRecordSet[nRecordSet]:Filter := xpr
   endif
   return .t.

*
*---------------------------------------------------------
Function ADODeleted( criterio )
   if oRecordSet[nRecordSet]:Status = adRecDeleted
      return .t.
   endif
   return .f.

*
*---------------------------------------------------------
Function ADOClose()
   _RecordSet := len( aRecordSet )
   ADEL( aRecordSet, nRecordSet )
   ASIZE( aRecordSet, _RecordSet-1 )
   oRecordSet[nRecordSet]:End()
   return .t.

*
*---------------------------------------------------------
Function ADOCloseAll()
   for i = 1 to len(aRecordSet)
       oRecordSet[nRecordSet]:End()
   next
   aRecordSet := {}
   nRecordSet := 0
   return .t.

*
*---------------------------------------------------------
Function ADOExecute( cSql )
   aADODefines := {}
   AADD( aADODefines, { "VOID("   , "0(" } )
   AADD( aADODefines, { "BYTE("   , "1(" } )
   AADD( aADODefines, { "CHAR("   , "2(" } )
   AADD( aADODefines, { "WORD("   , "3(" } )
   AADD( aADODefines, { "INT("    , "7(" } )
   AADD( aADODefines, { "BOOLEAN(", "5(" } )
   AADD( aADODefines, { "HDC("    , "6(" } )
   AADD( aADODefines, { "LONG("   , "7(" } )
   AADD( aADODefines, { "STRING(" , "8(" } )
   AADD( aADODefines, { "LPSTR("  , "9(" } )
   AADD( aADODefines, { "PTR("    ,"10(" } )
   AADD( aADODefines, { "DOUBLE(" ,"11(" } )
   AADD( aADODefines, { "DWORD("  ,"12(" } )
   for i = 1 to len( aADODefines )
       cSql := StrTran( cSql, aADODefines[i][2], aADODefines[i][1] )
   next
   //adolog( cSql )
   oADOConection[nConnection]:Execute( cSql )
   return .t.

Function ADOInsertInto( cSql )
   cSql := StrTran( cSql, '"', "'" )
   cSql := "INSERT INTO " + cSql
//? cSql
   oADOConection[nConnection]:Execute( cSql )
   return .t.

*
*---------------------------------------------------------
Function ADOBOF()
   return iif( ADORecCount() > 0, oRecordSet[nRecordSet]:Bof, .t. )

*
*---------------------------------------------------------
Function ADOEOF()
   return iif( ADORecCount() > 0, oRecordSet[nRecordSet]:Eof, .t. )

*
*---------------------------------------------------------
Function ADOFOUND()
   return !oRecordSet[nRecordSet]:Eof

*
*---------------------------------------------------------
Function ADOFind( criterio )
   ADOLocate( criterio )
   return .t.

*
*---------------------------------------------------------
Function ADOLocate( criterio )
   local _nBookMark := oRecordSet[nRecordSet]:Bookmark
   oRecordSet[nRecordSet]:MoveFirst()
   oRecordSet[nRecordSet]:Find( criterio )
   if oRecordSet[nRecordSet]:Eof()
      oRecordSet[nRecordSet]:BookMark := _nBookmark
      return .f.
   else
      return .t.
   endif

*
*---------------------------------------------------------
Function ADOSort( cField, nModo )
   if valtype(cField)='N'
      cField := oRecordSet[nRecordSet]:Fields( cStrField ):Name
   endi
   if cField = Nil
      Return upper(oRecordSet[nRecordSet]:Sort)
   else
      oRecordSet[nRecordSet]:Sort := cField + iif( nModo = NIL, " ASC", " DESC" )
      oRecordSet[nRecordSet]:MoveFirst()
   endif
   return .t.

*
*---------------------------------------------------------
Function ADOFiles( cTable )
   return iif(oRecordSet[nRecordSet]:Table(cTable)==cTable,.t.,.f.)

*
*---------------------------------------------------------
Function ADOAREAS()
   return nRecordSet

*
*---------------------------------------------------------
Function ADOSelect( cRecordSet )
   if cRecordSet = nil
   else
      if cADORDD = "XLS"
         cRecordSet := "[" + cRecordSet + "$]"
      endif
      nRecordSet := ASCAN( aRecordSet, cRecordSet )
      nRecordSet := iif( nRecordSet = 0, 1, nRecordSet )
   endif
   //ADOGotop()
   return nRecordSet

*
*---------------------------------------------------------
Function ADOLOG( cMensagem )
   local nHandle
   if .not. file( "ADOERRO.TXT" )
      nHandle := fcreate("ADOERRO.TXT",0)
   else
      nHandle := fopen("ADOERRO.TXT",1)
      length  := fseek(nHandle,0,2)
      fseek(nHandle,length)
   endif
   fwrite(nHandle, cMensagem )
   fclose(nHandle)
   return NIL

*
*---------------------------------------------------------
Function ADOReplace( cCampo, xDado )
   LOCAL uVal,xValor,nTipo,cType,nLong,cQuery,lRepassa := .f., lBlob := .f.,;
         StrFileName
   uVal  := oRecordSet[nRecordSet]:Fields( cCampo ):Value
   nTipo := oRecordSet[nRecordSet]:Fields( cCampo ):Type
   cType := TypeDat(nTipo,cCampo)
   nLong := oRecordSet[nRecordSet]:Fields( cCampo ):DefinedSize
   if ! Empty( xDado )
      if ValType( xDado ) = 'D'
         if nTipo=  7 .or. nTipo=133 .or. nTipo=135
            if empty( xDado )
               xDado := date()
            endif
            lRepassa := .t.
         endif
      endif
      if ValType( xDado ) = 'N'
         if nTipo=17 .or. nTipo= 14 .or. nTipo=  5 .or. nTipo=  3 .or. nTipo=131 .or. nTipo=  2 .or. nTipo=  6 .or. ;
            nTipo= 4 .or. nTipo=020 .or. nTipo=018 .or. nTipo=019 .or. nTipo= 21 .or. nTipo=138 .or. nTipo=139
            lRepassa := .t.
         endif
      endif
      if ValType( xDado ) = 'C'
         if nTipo=202 .or. nTipo=130 .or. nTipo=200 .or. nTipo=201 .or. nTipo=129 .or. nTipo= 72
            xDado := substr( xDado, 1, nLong )
            lRepassa := .t.
         endif
         if nTipo=201 .or. nTipo=203 .or. nTipo=205 .or. nTipo=128
            StrFileName := Alltrim(StrZero(Random(99999999),8))+".APL"
            MemoWrit( StrFileName, xDado )
            lRepassa := .t.
            lBlob    := .t.
         endif
      endif
      if ValType( xDado ) = 'L'
         if nTipo= 11 .or. nTipo= 16
            lRepassa := .t.
         endif
      endif
      if ValType( xDado ) = 'M' .or. ValType( xDado ) = 'I'
         if nTipo=201 .or. nTipo=203 .or. nTipo=205 .or. nTipo=128
            lRepassa := .t.
            lBlob    := .t.
         endif
      endif
      if lRepassa
         if lBlob // adolog( ccampo+"-"+ctype+"-"+strzero(ntipo,3)+"-"+ValType( xDado ) )
            oADOStream:Type := 1 // adTypeBinary
            oADOStream:Open()
            oADOStream:LoadFromFile( StrFileName )
            oRecordSet[nRecordSet]:Fields( cCampo ):Value := oADOStream:Read()
            oADOStream:Close()
         else
            oRecordSet[nRecordSet]:Fields( cCampo ):Value := xDado
         endif
      endif
   endif
   return .t.

*
*---------------------------------------------------------
Function ADOField( cStrField )
   LOCAL uVal,nTipo,cType,nLong,xValor:=nil,StrFileName
   if valtype(cStrField)='C'
      cStrField := upper(alltrim(cStrField))
   endif
   if nRecordSet > 0
      uVal  := oRecordSet[nRecordSet]:Fields( cStrField ):Value
      nTipo := oRecordSet[nRecordSet]:Fields( cStrField ):Type
      cType := TypeDat(nTipo,cStrField)
      nLong := oRecordSet[nRecordSet]:Fields( cStrField ):DefinedSize
      do case
         case cType='C'; xValor:=if(empty(uVal),spac(nLong),uVal+spac(nLong-len(uVal)))
         case cType='D'; xValor:=if(empty(uVal),ctod('')                    ,uVal)
         case cType='N'; xValor:=if(empty(uVal),0                           ,uVal)
         case cType='L'; xValor:=if(empty(uVal),.f.                         ,uVal)
         case cType='M' .or. cType='I'
              StrFileName := Alltrim(StrZero(Random(99999999),8))+".APL"
              oADOStream:Type := 1 // adTypeBinary
              oADOStream:Open()
              oADOStream:Write( oRecordSet[nRecordSet]:Fields( cStrField ) )
              oADOStream:LoadFromFile( oRecordSet[nRecordSet]:Fields( StrFileName ), 2 ) // adSaveCreateOverWrite
              oADOStream:Close()
              xValor := MemoRead( StrFileName )
         otherwise     ; xValor:=         uVal
      endcase
   endif
   RETURN xValor

*
*---------------------------------------------------------
Function ADOFieldBlank( cStrField )
   LOCAL uVal,nTipo,cType,nLong,xValor:=nil
   if valtype(cStrField)='C'
      cStrField := upper(alltrim(cStrField))
   endif
   if nRecordSet > 0
      uVal  := oRecordSet[nRecordSet]:Fields( cStrField ):Value
      nTipo := oRecordSet[nRecordSet]:Fields( cStrField ):Type
      cType := TypeDat(nTipo,cStrField)
      nLong := oRecordSet[nRecordSet]:Fields( cStrField ):DefinedSize
      do case
         case cType='C'; xValor:=space(nLong)
         case cType='D'; xValor:=ctod('  /  /  ')
         case cType='N'; xValor:=0
         case cType='L'; xValor:=.f.
         otherwise     ; xValor:=''
      endcase
   endif
   RETURN xValor

*
*---------------------------------------------------------
Function TypeDat(nTipo,cField)
   do case
      case nTipo=8.or.nTipo=12.or.nTipo=72.or.nTipo=129.or.nTipo=130.or.(nTipo>=200.and.nTipo<=203)
           // adBSTR             8
           // adGUID             72
           // adChar             129
           // adWChar            130
           // adVarChar          200
           // adLongVarChar      201
           // adVarWChar         202
           // adLongVarWChar     203
           return 'C'

      case nTipo= 17.or.nTipo= 16.or.nTipo= 14.or.nTipo=  5.or.nTipo=  3.or.nTipo=131.or.nTipo= 2 .or.nTipo=  6.or.;
           nTipo=  4.or.nTipo=020.or.nTipo=018.or.nTipo=019.or.nTipo= 21.or.nTipo=138.or.nTipo=139
           // adSmallInt         2
           // adInteger          3
           // adSingle           4
           // adDouble           5
           // adCurrency         6
           // adDecimal          14
           // adTinyInt          16
           // adUnsignedTinyInt  17
           // adUnsignedSmallInt 18
           // adUnsignedInt      19
           // adBigInt           20
           // adUnsignedBigInt   21
           // adNumeric          131
           // adPropVariant      138
           // adVarNumeric       139
           return 'N' // Numerico

      case nTipo=  7.or.nTipo=64.or.nTipo=133.or.nTipo=134.or.nTipo=135
           // adDate             7
           // adFileTime         64
           // adDBDate           133
           // adDBTime           134
           // adDBTimeStamp      135
           return 'D' // Data

      case nTipo= 11
           // adBoolean          11
           return 'L' // Logico

      case nTipo=203.or.nTipo=128
           // adLongVarWChar     203
           // adPropVariant      138
           return 'M' // Memo

      case nTipo=128.or.nTipo=204.or.nTipo=205
           // adBinary           128
           // adVarBinary        204
           // adLongVarBinary    205
           return 'I' // Imagem

   otherwise
      alert('Tipo de dado invalido: Campo '+cField+' Type='+str(nTipo))
   endcase
   return 'U'

*
*---------------------------------------------------------
Function isRSEmpty()
   return ((oRecordSet[nRecordSet]:BOF()=.t.) .and. (oRecordSet[nRecordSet]:EOF()=.t.))

*
*---------------------------------------------------------
Function ADOGetSQL( sqlFileName )
   sqlFileName = sqlFileName + ".SQL"
   if file(sqlFileName)
      cSql := MemoRead( sqlFileName )
      oADOConection:Execute( cSql )
   endif
   return nil

*
*---------------------------------------------------------
Function ADOUseRemote( cDatabase, lShared )
   local oError
   if cDatabase = NIL
      oRecordSet[nRecordSet]:Close()
   else
      AADD( aRecordSet, cDatabase )
      cRecordSet := cDatabase
      nRecordSet := len( aRecordSet )
      oRecordSet[nRecordSet] := oADOConection
      if cADORDD = "XML" // ".XML" $ upper(cDatabase)
         oRecordSet[nRecordSet]:Open( cDatabase, StrConnection, 1, 3 )
      else
         oRecordSet[nRecordSet]:CacheSize      := 50
         oRecordSet[nRecordSet]:CursorLocation := adUseClient
         if lShared = .t.
            oRecordSet[nRecordSet]:CursorType  := 1 // adOpenKeySet
            oRecordSet[nRecordSet]:LockType    := adLockBatchOptimistic
         else
            oRecordSet[nRecordSet]:CursorType  := adOpenStatic
            oRecordSet[nRecordSet]:LockType    := adLockPessimistic
         endif
         oRecordSet[nRecordSet]:Sql( "Select * from " + cDatabase, StrConnection )
      endif
      oRecordSet[nRecordSet]:MoveFirst()
   endif
   return .t.

function Random( nMaximo )
   static nRandom
   local nTemporal
   nMaximo = if( nMaximo == NIL, 65535, nMaximo )
   if nRandom == NIL
      nRandom = seconds()
   endif
   nTemporal = ( nRandom * seconds() ) % ( nMaximo + 1 )
   nRandom = nTemporal + seconds()
   RETURN int( nTemporal )


Customer.prg
#include "FiveWin.ch"
#include "Splitter.ch"

#include "adoxb.ch"

static oWnd, oClients, oClient, oName
static cName
static oSplit

//----------------------------------------------------------------------------//
function CUSTOMER(cTitle)
    public oMenu, user_nivel := 5
    default cTitle := "coloque um nome"

    // Necessária para criar objetos e variaveis visiveis o tempo todo
    ADOSetRDD( "ACCESS" )

    if ADORDDDefault() = "ACCESS" // ADOMDB
       StrDatabase   := ".\adomdb.mdb"
       StrConnection := "Provider= MicroSoft.Jet.OLEDB.4.0;Data Source="+StrDatabase+";"
    endif
    if ADORDDDefault() = "FIREBIRD" // ADOGDB
       StrDatabase   := ".\adogdb.gdb"
       StrConnection := "DRIVER=Firebird/InterBase(r) driver; UID=sysdba; PWD=masterkey; DBNAME="+StrDatabase
    endif
    if ADORDDDefault() = "MYSQL" // ADOMySQL
       StrDatabase   := [adomysql]
       StrServer     := [127.0.0.1]
       StrPort       := 3306
       StrUserID     := [root]
       StrUserPWD    := []
       StrDriver     := "MySQL ODBC 3.51 Driver"
       StrConnection := "driver={" + StrDriver +"};database=" + StrDatabase + ;
                        ";server=" + StrServer + ;
                        ";uid=" + StrUserID + ;
                        ";pwd=" + StrUserPWD + ;
                        ";option=35"
    endif
    if ADORDDDefault() = "PARADOX" // ADOPX
       StrConnection := "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\;Extended Properties=Paradox 5.x;"
    endif
    if ADORDDDefault() = "XML" // ADOXML
       StrConnection := "Provider=MSPersist"
    endif
    if ADORDDDefault() = "REMOTE" // ADORDS
       StrConnection := "Provider=MS Remote;Remote Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:/Inetpub/wwwroot/scripts/ASP/UAPortal/ua_portal.mdb;Remote Server=http://localhost/uaportal/"
    endif

    MsgRun( "Conectando via "+ADORDDDefault()+"..." )

    ADO CONNECT StrConnection

    // Cria tabelas se nao existirem
    if ADOFile( "clientes" )
    else
       MsgRun( "Criando tabela CLIENTES..." )
       ADO EXECUTE "DROP TABLE clientes"
       ADO EXECUTE "CREATE TABLE clientes (nome char(45), email char(45), unique(nome))"
    endif
    if ADOFile( "siglas" )
    else
       MsgRun( "Criando tabela SIGLAS..." )
       ADO EXECUTE "DROP TABLE siglas"
       ADO EXECUTE "CREATE TABLE siglas (uf char(2), estado char(20), unique(uf))"
    endif

    // Abre as tabelas
    ADO USE clientes
    ADO USE siglas

    // Verifica se ja possuem dados
    ADO SELECT clientes
    nRegistros := ADORecCount()
    if nRegistros = 0
       ADO APPEND BLANK
       ADO REPLACE nome        WITH "JOSE CARLOS DA ROCHA"
       ADO REPLACE email       WITH "IROCHINHA@ITELEFONICA.COM.BR"
       ADO COMMIT
    endif

    ADO SELECT siglas
    nRegistros := ADORecCount()
    if nRegistros = 0
       ADO APPEND BLANK
       ADO REPLACE uf          WITH "SP"
       ADO REPLACE estado      WITH "SAO PAULO"
       ADO COMMIT
       ADO APPEND BLANK
       ADO REPLACE uf          WITH "RJ"
       ADO REPLACE estado      WITH "RIO DE JANEIRO"
       ADO COMMIT
    endif

    ADO CLOSE ALL

    SET _3DLOOK ON
    DEFINE WINDOW oWnd TITLE cTitle MDI MENU BuildMenu()           
                DEFINE BUTTONBAR OF oWnd
               SET MESSAGE OF oWnd TO cTitle CENTERED
    ACTIVATE WINDOW oWnd VALID MsgYesNo( "Tem certeza?" )
    return nil

//----------------------------------------------------------------------------//
function BuildMenu()
   local oMenu
   MENU oMenu
      MENUITEM "&Cadastros"
      MENU
         MENUITEM "&Clientes..." ACTION  Clientes() MESSAGE "Cadastro de Clientes"
         SEPARATOR
         MENUITEM "&Sair"        ACTION oWnd:End()  MESSAGE "Termina Aplicativo"
      ENDMENU
      oMenu:AddMdi()              // Add standard MDI menu options
   ENDMENU
   return oMenu

//----------------------------------------------------------------------------//
function Clientes(bPrc, bAdc, bAlt, bExc, bImp, bSai)
    LOCAL oIco, oBar, oGet
    LOCAL cTitle := "Manutencao de Clientes"
    LOCAL oDlg, oBrw, nRec
    LOCAL aData := {}
    LOCAL nFor
    LOCAL oLbx, cItem
    LOCAL btnPrc, btnAdc, btnAlt, btnExc, btnImp, btnsai
    DEFAULT bPrc    := { || RecPrc( oLbx ) },;
            bAdc    := { || RecInc( oLbx ) },;
            bAlt    := { || RecAlt( oLbx ) },;
            bExc    := { || RecExc( oLbx ) },;
            bImp    := { || RecImp( oLbx ) },;
            bSai    := { || oDlg2:End() }
    if oClients != nil
       return nil
    endif
    DEFINE WINDOW oClients TITLE cTitle MDICHILD ICON oIco
    DEFINE BUTTONBAR oBar OF oClients
    DEFINE BUTTON OF oBar ACTION RecAlt(oLbx)
    nSplitH := 400
    ADO USE clientes
    //ADO SORT ON nome
    //? "Areas    : " + str( ADOAREAS() ),;
    //  "Tabela   : " + ADOALIAS(),;
    //  "Registros: " + str( ADORECCOUNT() )
    @ 0,0 LISTBOX oLbx FIELDS ADOField( "nome" ), ADOField( "email" ) ;
         HEADERS "Nome","email" ;
         FIELDSIZES 350,250 ;
         PIXEL SIZE 1000,1000 OF oClients
    oLbx:cAlias         := "ARRAY" // ADO devolve tabelas em arrays
    oLbx:bLogicLen   := { || ADORecCount() }
    oLbx:bGoTop      := { || ADOGotop() }
    oLbx:bGoBottom := { || ADOGoBottom() }
    oLbx:bSkip         := { | nSkip | ADOSkip( nSkip ) }
    oLbx:bRClicked   := {| nRow, nCol | RecMenu( nRow, nCol, oLbx ) }
    oLbx:bLDblClick  := {| nRow, nCol | RecAlt(oLbx) }
    oLbx:nStyle        := 1
    oLbx:nLineStyle  := 3
    // -> Estilo FLAT
    oLbx:nHeaderStyle  := 2
    oLbx:nHeaderHeight := 20
    oLbx:nLineHeight   := 15
    oLbx:nStyle        := nOr( WS_CHILD, WS_VSCROLL, WS_HSCROLL, WS_VISIBLE, WS_TABSTOP )

    oClients:SetControl( oLbx )
    ACTIVATE WINDOW oClients MAXIMIZED VALID( oClients := nil, ADOCLOSEALL(), .t. )

return nil

//----------------------------------------------------------------------------//
function RecMenu( nRow, nCol, oLbx )
   local oPopup
   MENU oPopup POPUP
        MENUITEM "&Incluir novo registro"  RESOURCE "bmp_binoculo" ACTION RecInc( oLbx )
        MENUITEM "&Alterar registro atual" RESOURCE ""             ACTION RecAlt( oLbx )
        MENUITEM "&Excluir registro atual" RESOURCE ""             ACTION RecExc( oLbx )
        SEPARATOR
        MENUITEM "&Procurar registro"      RESOURCE ""             ACTION RecPrc( oLbx )
        SEPARATOR
        MENUITEM "&Imprimir Listagem"      RESOURCE ""             ACTION RecImp( oLbx )
   ENDMENU
   ACTIVATE POPUP oPopup AT nRow, nCol OF oLbx
   return nil

//----------------------------------------------------------------------------//
function GenReport()
   local oWnd, oIco
   DEFINE ICON oIco FILENAME "..\icons\print.ico"
   DEFINE WINDOW oWnd MDICHILD TITLE "Clients report" ;
      VSCROLL HSCROLL ICON oIco
   ACTIVATE WINDOW oWnd
   return nil

//----------------------------------------------------------------------------//
function Show2Client()
   local oIco
   if oClient != nil
      return nil
   endif
   DEFINE ICON oIco FILENAME "..\icons\Person.ico"
   DEFINE DIALOG oClient RESOURCE "Client" ;
      ICON oIco
   REDEFINE SAY ID 3 OF oClient   // To get the proper color
   REDEFINE SAY ID 4 OF oClient
   REDEFINE SAY ID 5 OF oClient
   REDEFINE GET oName VAR cName ID ID_NAME OF oClient
   REDEFINE BUTTON ID ID_NEXT OF oClient ACTION GoNext()
   SELECT Sales     // We select Sales to properly initialize the Browse
   REDEFINE LISTBOX FIELDS ID ID_SALES OF oClient
   ACTIVATE DIALOG oClient CENTERED NOWAIT ;
      VALID ( oClient := nil, .t. )           // Destroy the object
   SELECT Clients
   return nil

//----------------------------------------------------------------------------//
function ChangeClient()
   if oClient != nil
      cName = AllTrim( Clients->Last ) + ", " + Clients->First
      oName:Refresh()
   endif
   return nil

//----------------------------------------------------------------------------//
function GoNext()
   if oClients != nil
      oClients:oControl:GoDown()
   else
      SKIP
      if EoF()
         GO BOTTOM
      endif
   endif
   ChangeClient()
   return nil

FUNCTION CLEARCHR( CICCGC )
   CICCGC = STRTRAN(CICCGC, '>', '')
   CICCGC = STRTRAN(CICCGC, '<', '')
   CICCGC = STRTRAN(CICCGC, '.', '')
   CICCGC = STRTRAN(CICCGC, '-', '')
   CICCGC = STRTRAN(CICCGC, '(', '')
   CICCGC = STRTRAN(CICCGC, ')', '')
   CICCGC = STRTRAN(CICCGC, '=', '')
   CICCGC = STRTRAN(CICCGC, '+', '')
   CICCGC = STRTRAN(CICCGC, '\', '')
   CICCGC = STRTRAN(CICCGC, '/', '')
   CICCGC = STRTRAN(CICCGC, '*', '')
   CICCGC = STRTRAN(CICCGC, ['], '')
   CICCGC = ALLTRIM(CICCGC)
   RETURN CICCGC

function fun( oque )
  msgstop( oque )
  return .t.
function tgsetmode( oque )
  return .t.
function tooltip( oque )
  return .t.
FUNCTION NewCapFirst
parameter string
declare excesao[7]
excesao[1] = " Do "
excesao[2] = " Dos "
excesao[3] = " Da "
excesao[4] = " Das "
excesao[5] = " De "
excesao[6] = " E "
excesao[7] = " Del "
novotexto = space(1)+lower(string)
fim = len(string)
for i = 1 to fim
   if substr(novotexto,i,1) = " "
      novotexto = stuff(novotexto,i+1,1,upper(substr(novotexto,i+1,1)))
   endif
next
tamanho = len(excesao)
for i = 1 to tamanho
   if excesao[i]$novotexto   && tamanho
      novotexto = stuff(novotexto,AT(excesao[i],novotexto),;
      len(excesao[i]),lower(excesao[i]))
   endif
next
RETURN(ltrim(novotexto))

//-----------------------------------------------------------
static function  RecPrc(oLbx)
    Local odlg1
    Local cCodigo:=0
    Local cSair:=" "
    Local sql
    DEFINE DIALOG oDlg1 From 0,0 To 160,250  PIXEL;
           TITLE " Procura na Tabela em Access "
    DEFINE FONT oFont NAME "FIXEDSYS" SIZE 10, -10    && Use a Nonproportional font
    SET FONT OF oDlg1 TO oFont                         && so characters line up in Says
    @ 02,05 say "Codigo : " OF oDlg1
    @ 02.2,10 get cCodigo   OF oDlg1 picture "9999" size 20,10
    @ 02.7 , 10 button "Procurar"  of oDlg1 size 40,12 action (cSair:="*",oDlg1:End())
    ACTIVATE DIALOG oDlg1 centered
    if cSair="*"
       //locate for (odbf:cAlias)->field_0001 = cCodigo
       criterio = "idpessoa Like '" + cCodigo + "%'"
       //oRs:MoveFirst()
       //oRs:Find criterio, 0, adSearchFoward
       if eof()
          msgAlert("NÆo encontrado !!!")
          go top
       endif
       oLbx:Refresh()
    endif
    return nil

//-----------------------------------------------------------
static function  RecInc(oLbx)
    LOCAL odlg3
    LOCAL cNome     := space(40)
    LOCAL cTelefone := space(14)
    LOCAL cEmail    := space(40)
    LOCAL cSair     := " "
    DEFINE DIALOG oDlg3 From 0,0 To 230,500 PIXEL TITLE " Inclusao na Tabela em Access "
           DEFINE FONT oFont NAME "FIXEDSYS" SIZE 10, -10    && Use a Nonproportional font
           SET FONT OF oDlg3 TO oFont                         && so characters line up in Says
           @ 02,05 say "Nome_____: " OF oDlg3
           @ 04,05 say "Email____: " OF oDlg3
           //
           @ 02.2,10 get cNome     OF oDlg3 picture "@!" size 150,10
           @ 04.4,10 get cEmail    OF oDlg3 picture "@!" size 150,10
           //
           @ 04.7 , 15 button "Salvar"   of oDlg3 size 40,12 action (cSair:="*",oDlg3:End())
    ACTIVATE DIALOG oDlg3 centered
    if cSair="*"
       ADO APPEND BLANK
       ADO REPLACE nome        WITH alltrim( cNome )
       ADO REPLACE email       WITH alltrim( cEmail )
       ADO COMMIT
       oLbx:Refresh()
    endif
    return nil

//-----------------------------------------------------------
static function  RecAlt(oLbx)
    LOCAL odlg3
    LOCAL nRegistro := ADORecno()
    //LOCAL cNome     := PadR( ADOField( "nome" ), 40 )
    //LOCAL cEmail    := PadR( ADOField( "email" ), 40 )
    LOCAL cNome     := ADOField( "nome" )
    LOCAL cEmail    := ADOField( "email" )
    LOCAL cSair     := " "
    DEFINE DIALOG oDlg3 From 0,0 To 230,500 PIXEL TITLE " Inclusao na Tabela em Access "
           DEFINE FONT oFont NAME "FIXEDSYS" SIZE 10, -10    && Use a Nonproportional font
           SET FONT OF oDlg3 TO oFont                        && so characters line up in Says
           //
           @ 02,05 say "Nome_____: " OF oDlg3
           @ 04,05 say "Email____: " OF oDlg3
           //
           @ 02.2,10 get cNome     OF oDlg3 picture "@!" size 150,10
           @ 04.4,10 get cEmail    OF oDlg3 picture "@!" size 150,10
           //
           @ 04.7 , 15 button "Salvar"   of oDlg3 size 40,12 action (cSair:="*",oDlg3:End())
    ACTIVATE DIALOG oDlg3 centered
    if cSair="*"
       ADO REPLACE nome       WITH alltrim( cNome )
       ADO REPLACE email      WITH alltrim( cEmail )
       ADO COMMIT
       oLbx:Refresh()
    endif
    return nil

//-----------------------------------------------------------
static function  RecExc(oLbx)
    if MsgYesNo( "Excluir este Registro ?", "Por Favor, confirme" )
       ADO DELETE
       //ADO SKIP
       oLbx:Refresh()
    endif
    return nil

//-----------------------------------------------------------
static function RecImp( oLbx )
/*
    local oRpt
    local n
    local cAlias := If( oLbx != nil, oLbx:cAlias, Alias() )
    REPORT oRpt TITLE "Relatorio: " + cAlias ;
           HEADER "Data: " + DToC( Date() ) + ", Hora: " + Time() ;
           FOOTER "Pagina: " + Str( oRpt:nPage, 3 ) ;
           PREVIEW
           if Empty( oRpt ) .or. oRpt:oDevice:hDC == 0
              return nil
           endif
           for n = 1 to FCount()
               oRpt:AddColumn( TrColumn():New( { FInfo1( cAlias, n ) },,;
                     { FInfo2( cAlias, n ) },,,,,,,,,, oRpt ) )
           next
    ENDREPORT
    ACTIVATE REPORT oRpt
    GO TOP
*/
    return nil

//--------------------------------------------
static function FInfo1( cAlias, n )
return { || ( cAlias )->( FieldName( n ) ) }

//-----------------------------------------------------------
static function FInfo2( cAlias, n )
return { || ( cAlias )->( FieldGet( n ) ) }

Function DbfDbt()
Return Nil

#include "adoxb.prg"
gilsonpaulo
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 135
Data de registro: 02 Fev 2008 10:30
Cidade/Estado: Quatro Barras
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor asimoes » 14 Ago 2008 09:39

Olá Rochinha,

Existe algum exemplo executando uma stored procedure do oracle?
Nós estamos querendo sair do clipper para o xharbour, estamos usando o oraclip, conhece?
O problema é achar exemplos de execução de storeds procedures, mais uma pergunta o SQLRDD comercial tem este recurso?

[]´s

Alexandre
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor gilsonpaulo » 05 Out 2010 08:32

Amigo Rochinha, estou tentando usar a adoxb mas estou com pequenos erros.:

----------------------------- xHarbour Error Log ------------------------------

Date...............: 10/05/10
Time...............: 08:19:22

Application name...: C:\Sist\OS\OS.EXE
Workstation name...: GS01
Available memory...: 128288
Current disk.......: C
Current directory..: Sist\OS
Free disk space....: 63575773184

Operating system...: Windows XP Professional 5.01.2600 Service Pack 3
xHarbour version...: xHarbour build 1.2.1 Intl. (SimpLex) (Rev. 6740)
xHarbour built on..: Oct  3 2010 10:18:27
C/C++ compiler.....: Borland C++ 5.5.1 (32 bit)
Multi Threading....: NO
VM Optimization....: 2

Current Area ......:1

-------------------------- Environmental Information --------------------------

SET ALTERNATE......: OFF
SET ALTFILE........:
SET AUTOPEN........: ON
SET AUTORDER.......: 0
SET AUTOSHARE......: 0
SET BACKGROUNDTASKS: OFF
SET BACKGROUNDTICK.: 1000
SET BELL...........: OFF
SET BLINK..........: .T.
SET CANCEL.........: ON
SET CENTURY........: OFF
SET COLOR..........: W/N,N/W,N/N,N/N,N/W
SET CONFIRM........: OFF
SET CONSOLE........: ON
SET COUNT..........: 0
SET CURSOR.........: 1
SET DATE FORMAT....: MM/DD/YY
SET DBFLOCKSCHEME..: 0
SET DEBUG..........: OFF
SET DECIMALS.......: 2
SET DEFAULT........:
SET DEFEXTENSIONS..: ON
SET DELETED........: OFF
SET DELIMCHARS.....: ::
SET DELIMETERS.....: OFF
SET DEVICE.........: SCREEN
SET DIRCASE........: 0
SET DIRSEPARATOR...: \
SET EOL............: 13
SET EPOCH..........: 1900
SET ERRORLOG.......: ERROR.LOG,.F.
SET ERRORLOOP......: 8
SET ESCAPE.........: ON
SET EVENTMASK......: 128
SET EXACT..........: OFF
SET EXCLUSIVE......: ON
SET EXIT...........: OFF
SET EXTRA..........: OFF
SET EXTRAFILE......:
SET FILECASE.......: 0
SET FIXED..........: OFF
SET FORCEOPT.......: OFF
SET HARDCOMMIT.....: ON
SET IDLEREPEAT.....: ON
SET INSERT.........: OFF
SET INTENSITY......: ON
SET LANGUAGE.......: EN
SET MARGIN.........: 0
SET MBLOCKSIZE.....: 0
SET MCENTER........: OFF
SET MESSAGE........: 0
SET MFILEEXT.......:
SET OPTIMIZE.......: ON
SET OUTPUTSAFETY...: ON
SET PATH...........:
SET PRINTER........: OFF
SET PRINTERJOB.....:
SET PRINTFILE......: PRN
SET SCOREBOARD.....: ON
SET SCROLLBREAK....: ON
SET SOFTSEEK.......: OFF
SET STRICTREAD.....: OFF
SET TRACE..........: ON
SET TRACEFILE......: TRACE.LOG
SET TRACESTACK.....: 2
SET TRIMFILENAME...: .F.
SET TYPEAHEAD......: 50
SET UNIQUE.........: OFF
SET VIDEOMODE......: 0
SET WRAP...........: OFF

---------------------------Detailed Work Area Items----------------------------

-------------------- Internal Error Handling Information  ---------------------

Subsystem Call ....: TOleAuto
System Code .......: 65535
Default Status ....: .F.
Description .......:
Operation .........: TOLEAUTO:NEW
Arguments .........:  [ 1] = Type: C Val: ADODB.Err
Involved File .....:
Dos Error Code ....: 0

Trace Through:
----------------
TOLEAUTO:NEW          :     334 in Module: source\rtl\win32ole.prg
TOLEAUTO:NEW          :     346 in Module: source\rtl\win32ole.prg
ADOCONNECT            :      57 in Module: C:\Sist\OS\ADOXB.PRG
MAIN                  :      26 in Module: C:\Sist\OS\GB.000

############################## Video Screen Dump ##############################

+--------------------------------------------------------------------------------+
|                                                                                |
|Error TOleAuto/65535  : TOLEAUTO:NEW Arguments: ( [ 1] = Type: C Val: ADODB.Err)|
|                                                                                |
|                                                                                |
|Error at ...: TOLEAUTO:NEW(334) in Module: source\rtl\win32ole.prg              |
|Called from : TOLEAUTO:NEW(346) in Module: source\rtl\win32ole.prg              |
|Called from : ADOCONNECT(57) in Module: C:\Sist\OS\ADOXB.PRG                    |
|Called from : MAIN(26) in Module: C:\Sist\OS\GB.000                             |


Segue o fonte do prg

#include "adoxb.ch"

request HB_GT_WIN

Function Main()

ADOSetRDD( "mysql" )
     
ADORDDDefault("mysql")

StrDatabase := [gs]
StrServer := [192.168.0.100]
StrPort := 3306
StrUserID := [root]
StrUserPWD := []
StrDriver := "MySQL ODBC 3.51 Driver"

StrConnection := "driver={" + StrDriver +"};database=" + StrDatabase + ;
                     ";server=" + StrServer + ;
                     ";uid=" + StrUserID + ;
                     ";pwd=" + StrUserPWD + ;
                     ";option=35"

ADO CONNECT StrConnection

ADO USE CLIENTE
ADO SELECT CLIENTE
browse()
ADO APPEND BLANK
ADO REPLACE CODIGO WITH 00000001
ADO REPLACE NOME WITH "GILSON PAULO SCHUCK"
ADO COMMIT
ADO USE
return nil


Desde ja agradeço qualquer ajuda.
gilsonpaulo
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 135
Data de registro: 02 Fev 2008 10:30
Cidade/Estado: Quatro Barras
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor rochinha » 09 Nov 2010 11:31

Amiguinho,

Pelo que pude reparar a linha referida tenta vincular um recurso ADO que pode não ser acessado em sua instalação de S.O. ou o conjunto de bibliotecas OLE não compatibilizem-se.

Voce usa xHarbour, troque o TOLEAUTO() por CREATEOBJECT() e verifique se as bibliotecas de acesso OLE estão sendo bem empregadas na compilação.

Desabilite a linha 57 no ADOxB.PRG.

Verifique também se o driver ODBC compativel com o seu MySQL esteja instalado.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor pauloa1 » 04 Abr 2011 17:10

Olá Rochinha!

Uso xHarbou 1.21 + wvw+hwgui+dbfcdx

Quero mudar de dbf para firebird.

Li todo o seu post, minha dúvida é:

O pessoal em geral usam sqlrdd(pago) para migrar dbf para BD.

Com essas funções que vc criou ao meu ver ficou parecido um sqlrdd , certo?

Em termos de velocidade os dois seriam parecidos?

Ou mesmo com essas funções ainda tem muita diferença que compense eu pagar por um sqlrdd?

Paulo
pauloa1
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 223
Data de registro: 25 Jun 2008 14:57
Cidade/Estado: Augusto Pestana-RS
Curtiu: 2 vezes
Mens.Curtidas: 11 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor rochinha » 04 Abr 2011 21:35

Amiguinho,

A biblioteca apresentada tem o intuito de mostrar a manipulação da API fornecida pelo ADO.

Se bem que quando esbocei a mesma nem sequer existia o RDD para ADO.

O RDD existente hoje para ADO e SQL estão muito maduros e mais estáveis. Sugiro que faça uso deles nas versões 2.0 e posteriores do Harbour.

Com pouquissimas linhas voce conseguira manipular bases relacionais e/ou DBFs via comandos SQL.

Acho uma boa voce usar comandos SQL para acesso a DBFs para que vá aprendendo a manipular esta forma de obtenção de dados.

Nunca coloquei em testes o fator velocidade, ainda uso esta biblioteca em meu sistema para acesso a dados remotos, pois ainda uso a versão .45 do Harbour.

Sugiro antes de voce implantar acesso nativo SQL em seu aplicativo que produza em separado um pequeno aplicativo que manipule estes comandos, como append, update, where, delete, join, etc.

Veja também que enganei o compilador usando xcommand bem parecidos com os comandos nativos para DBF de forma a facilitar a programação.

Boa sorte
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor pauloa1 » 04 Abr 2011 22:53

Obrigado pela Resposta Rochinha.

Não entendi direito, existe o rddsql e um rdd para ADO. Isso ou estou falando bobagem?

Como faço para usar comandos sql via dbf?

Paulo
pauloa1
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 223
Data de registro: 25 Jun 2008 14:57
Cidade/Estado: Augusto Pestana-RS
Curtiu: 2 vezes
Mens.Curtidas: 11 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor rochinha » 05 Abr 2011 01:02

Amiguinho,

Existem sim, todos estes RDD, que beleza é o mundo Harbour.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Re: *** ADOxb - BIblioteca de funções de Acesso SQL ***

Mensagempor pauloa1 » 05 Abr 2011 09:48

Que blz!
Onde encontro esse rdd para Ado?
Ele tem no xHarbour.gov?

Paulo
pauloa1
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 223
Data de registro: 25 Jun 2008 14:57
Cidade/Estado: Augusto Pestana-RS
Curtiu: 2 vezes
Mens.Curtidas: 11 vezes

Anterior Próximo



Retornar para SQL

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 9 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro