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"
Enviado: 16 Out 2007 10:12