Here is a more complex sample. Let us suppose you already have a DD with tables created but you wish to deliver a new update of your application where some structure changes must be made in order for the new update to work properly. Then all we need is check the current table structures on the DD and compare to some other source, either supplied on an external file or coded inside the update. Here I do the second. I do a lot of it by constructing SQL statements to alter a table. You may look up any SQL command syntax on the ADS help files including the ALTER TABLE statement.
Code: Select all | Expand
#include "ads.ch"
#include "dbstruct.ch"
#define CRLF chr(13)+chr(10)
#xcommand DEFAULT <uVar1> := <uVal1> ;
[, <uVarN> := <uValN> ] => ;
<uVar1> := iif( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
[ <uVarN> := iif( <uVarN> == nil, <uValN>, <uVarN> ); ]
REQUEST ADS
request hb_gt_win //needed for console mode app.
Static cPath
*-----------------------------------------------------------------------------------------------------
Function Main()
local nerr
SetMode( 50, 80 ) //25 lines by 80 columns console
rddRegister( "ADS", 1 )
rddSetDefault( "ADS" )
adsSetServerType( ADS_LOCAL_SERVER )
AdsLocking( .t. ) //NON-compatible locking mode
Set Deleted ON
cPath := hb_ArgV( 1 )
DEFAULT cpath := ""
if !empty( cPath ) .and. right( cPath, 1 ) != "\" ;cPath += "\" ;endif
if !ConnectToDD()
Return nil
endif
CheckTables( GetTableStructures() )
showStructure()
AdsDisconnect() //disconnect from test_dd
wait
return nil
*-----------------------------------------------------------------------------------------------------
//Ideally you would store the dd name and path and server type on an .ini file or
//send both strings as parametrs to the application.
//
//once connected we don't need table's paths anymore as the dd knows where they reside.
static Function ConnectToDD()
if !AdsConnect60( cpath + "test_dd.add", ADS_LOCAL_SERVER, "adssys", "password" )
Alert( "Cannot connect LOCAL Server to dd: " + cpath + "test_dd.add" + Str( AdsGetLastError() ) )
Return .f.
endif
Return .t.
*-----------------------------------------------------------------------------------------------------
static Function GetTableStructures()
local all_files_struc := {}
aadd( all_files_struc,{ "customers.adt VIA ADSADT ",;
{ { "cust_id" , "C", 10, 0 },;
{ "customer_name", "C", 25, 0 },;
{ "Logical" , "L", 10 , 0 },;
{ "date" , "D", 0, 0 },;
{ "Sequence" , "AutoInc", 07, 0 },; //ADT extended field type (EFT)
{ "TStamp" , "TimeStamp", 01, 0 },; //EFT
{ "Integer_field", "I", 04, 0 },; //EFT
{ "Currency_double", "curdouble", 0, 2 } ,; //EFT
{ "raw" , "raw", 25, 0 },; //EFT
{ "rowversion" , "rowversion", 0, 0 },; //EFT
{ "modtime" , "modtime", 0, 0 },; //EFT
{ "Double" , "Double", 4, 0 },; //EFT
{ "Image" , "Binary", 10, 0 },; //RDD sees Image,Binary,Blob as Binary
{ "time" , "time", 0, 0 },; //EFT
{ "VarChar" , "V", 10, 0 },; //EFT
{ "short_integer", "I", 02, 0 },; //EFT
{ "Notes" , "M", 10, 0 } } } )
/* although valid field types, currently rddads does not support
field types ciCharacter, Money, VarBinary. But they will work just fine SQL
or ACE ADSCreateTable()
{ "ciCharacter" , "ciCharacter", 10 , 0 },; //case insensitive
{ "Money_Field" , "Y", 8, 4 },; //extended field type Money
{ "VarBinary" , "Q", 10, 0 },; //extended field type
*/
aadd( all_files_struc, { "sales.dbf VIA ADSVFP STRICT", ;
{ { "cust_id" , "C", 10, 0 },;
{ "invoice" , "C", 15, 0 },;
{ "item_id" , "C", 15, 0 },;
{ "Date" , "D", 8, 0 },;
{ "Logical" , "L", 10 , 0 },;
{ "TStamp" , "TimeStamp", 01, 0 },;//VFP extended field type
{ "Sequence" , "autoincrement", 0, 0 },; //VFP extended field type
{ "Units" , "I", 04, 0 },; //VFP extended field type
{ "Double" , "Double", 4, 0 },; //VFP extended field type
{ "VarChar" , "VarCharFox", 10 , 0 },; //VFP extended field type
{ "VarBinary" , "Q", 10, 0 },; //VFP extended field type
{ "Price" , "Y", 0, 0 },; //VFP extended field type Money
{ "Image" , "Binary", 10, 0 },; //VFP extended field type
{ "Notes" , "M", 10, 0 } } } )
aadd( all_files_struc, { "items.dbf VIA ADSNTX", ;
{ { "item_id" , "C", 15, 0 },;
{ "Desc" , "C", 25, 0 },;
{ "Price" , "N", 07, 2 } } } )
Return all_files_struc
*-----------------------------------------------------------------------------------------------------
static function CheckTables( aFiles )
local isStrict
local cFileType
local cTable, cExt, cFileName
local aStruc, n
local aDDFiles := AdsDirectory() //ACE32 function call returns array of tables in dd
for each aStruc IN aFiles
isStrict := .f. ////allow only the exact structure sent with no extra fields on table
cFileName := lower( aStruc[ 1 ] )
cFileName := SplitTableName( cFileName, @isStrict, @cFileType )
AdsSetFileType( cFileType )
hb_FNameSplit( cFileName,,@cTable, @cExt )
if aScan( aDDfiles, cTable ) == 0
qout( "creating an ntx table ", ctable )
dbcreate( cTable, aStruc[ 2 ] )
AdsDDAddTable( cTable, cTable + iif( cFileType == ADS_ADT, ".adt", ".dbf" ), "" )
else
CheckTableStructure( aStruc, cTable, isStrict )
endif
next
return nil
*-----------------------------------------------------------------------------------------------------
static function SplitTableName( cFileName, isStrict, cFileType )
local nPos
DEFAULT isStrict := .f.
DEFAULT cFileType := ADS_ADT //presume .adt when not using VIA as part of tablename
if at( " STRICT", upper( cFileName ) ) > 0
isStrict := .t.
cFileName := lower( alltrim( strtran( cFileName, " STRICT", "" ) ) )
Endif
if ( nPos := at( " VIA ", upper( cFileName ) ) ) > 0
cFileType := iif( "CDX" $ upper( substr( cFileName, nPos ) ), ADS_CDX, ;
iif( "VFP" $ upper( substr( cFileName, nPos ) ), ADS_VFP ,;
iif( "NTX" $ upper( cFileName ), ADS_NTX, ADS_ADT ) ) )
cFileName := lower( alltrim( Left( cFileName, nPos -1 ) ) )
Endif
return cFileName
*-----------------------------------------------------------------------------------------------------
static Function CheckTableStructure( aTable, cTable, isStrict )
local aStruc := aTable[ 2 ]
local cAlias, n
qOut( "Checking structure of table: " + cTable )
if TableStrucIsChanged( cTable, @aStruc, @cAlias, isStrict ) //aStruc may change if !isStrict
UpdateTableStruc( cTable, aStruc, cAlias )
endif
(cAlias)->( dbCloseArea() )
Return Nil
*-----------------------------------------------------------------------------------------------------
static Function TableStrucIsChanged( cFileName, aStruc, cAlias, isStrict )
local isChanged := .f.
local nPos := 0
local i := 0
local afStruc //afStruc is the found file structure
local j
cAlias := cFileName
Dbusearea( .t. , "ADS", cFileName, cAlias, .f. ) //exclusive use is needed to update table struc
afStruc := ( cAlias )->( dbstruct() )
while ++i <= len( aStruc ) .and. !isChanged
if len( aStruc ) > len( afStruc ) .or. ;
( nPos := aScan( afStruc, { |e| trim( upper( aStruc[ i, DBS_NAME ] ) ) == ;
Trim( upper( e[ DBS_NAME ] ) ) } ) ) == 0 .or. ;
; //if field names are equal then continue by comparing field types
upper( aStruc[ i, DBS_TYPE] ) != afStruc[ nPos, DBS_TYPE ] .or. ;
;//Avoid comparing field length when autoinc, date,memo,money,raw,rowversion,curdouble ...
( !(TransFieldName( aStruc[ i ] ) $ ;
"MONEY,LOGICAL,CURDOUBLE,ROWVERSION,RAW,MODTIME,DOUBLE,BINARY,IMAGE,BLOB,AUTOINC,TIME,TIMESTAMP,DATE,MEMO") .and. ;
( aStruc[ i, 3 ] > afStruc[ nPos, DBS_LEN ] .or. ;
aStruc[ i, DBS_DEC ] <> afStruc[ nPos, DBS_DEC ] ) )
qOut( "Table ", cFileName, " needs a structure update on field ", aStruc[ i, DBS_NAME ] )
isChanged := .t.
Endif
End
if isStrict .and. len( afStruc ) > len( aStruc )
isChanged := .t.
endif
if !isStrict //if not strict then keep old fields for backward compatibility
for j := 1 to len( afstruc )//first insert new fields
i := 0 ; npos := 0
while ++i <= len( astruc ) .and. nPos == 0
if alltrim( upper( afstruc[ j, DBS_NAME ] ) ) == alltrim( upper( astruc[ i, DBS_NAME ] ) )
nPos := i
endif
end
if nPos == 0
aadd( astruc, afstruc[ j ] )
endif
next j
Endif
Return isChanged
*-----------------------------------------------------------------------------------------------------
static Function UpdateTableStruc( cTable, aStruc, cAlias )
local cAdd := alltrim( Fields2Add( aStruc, (calias)->( dbStruct() ) ) )
local cDel := alltrim( Fields2Del( astruc, (calias)->( dbStruct() ) ) )
local cMod := alltrim( Fields2Chn( aStruc, (calias)->( dbstruct() ) ) )
local cErr, cSQL, isOk
(calias)->( dbclosearea() )
cAdd := SQLAlterStm( "ADD", left( cAdd, len( cAdd ) -1 ) )
cDel := SQLAlterStm( "DROP", left( cDel, len( cDel ) -1 ) )
cMod := SqlAlterStm( "ALTER", left( cMod, len( cMod ) -1 ) )
cSQL := "ALTER TABLE " + cTable + cAdd + cDel + cMod
if empty( cadd + cdel + cmod )
Alert( "Update string could not be determined. Table " + alltrim( cTable ) )
else
ExecuteSQL( cSQL )
ENDIF
return( Nil )
*-----------------------------------------------------------------------------------------------------
Static Function SQLAlterStm( cAction, cColInfo )
local cStr := ""
local aParsed := hb_aTokens( cColInfo, ";" )
local a
local Elem, cFldType
//if alter column then: a[1] -old field name, a[2] -new field name, a[3] -field type, a[4] -field length, a[5] -field decimals
//if add column then: a[1] new field name, a[2] -field type, a[3] -field length, a[4] -field decimals
if empty( cAction )
RETURN cStr
Endif
if cAction == "DROP"
FOR EACH Elem IN aParsed
cStr += " DROP " + elem + " "
NEXT
endif
if cAction $ [ADDALTER]
FOR EACH Elem IN aParsed
a := hb_aTokens( elem, "," )
cFldType := upper( a[ iif( cAction == "ADD", 2, 3 ) ] )
cStr += iif( cAction == "ADD", " ADD COLUMN [" + alltrim( a[ 1 ] ) + "]", ;
" ALTER COLUMN [" + alltrim( a[ 1 ] ) + "] " )
do case
case cFldType == "CHARACTER" .or. cFldType == "C"
cstr += iif( cAction == "ADD", ;
" Char(" + alltrim( a[ 3 ] ),;
" [" + a[ 2 ] + "] Char( " + alltrim( a[ 4 ] ) ) + ") "
case cFldType == "NUMERIC" .or. cFldType == "N"
cstr += iif( cAction == "ADD", ;
" Numeric(" + alltrim( a[ 3 ] ) +"," + alltrim( a[ 4 ] ),;
" [" + a[ 2 ] + "] Numeric (" + alltrim( a[ 4 ] ) + "," + a[ 5 ] ) + ") "
case cFldType == "D"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Date "
case cFldType == "L"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Logical "
case cFldType == "M"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Memo "
case cFldType == "Y"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Money "
case cFldType == "T"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " TimeStamp"
case left( cFldType, 1 ) == "A"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " AutoInc "
case cFldType == "I"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + ;
iif( a[ iif( cAction == "ADD", 3, 4 ) ] == "2", " Short ", " Integer " )
case cFldType == "DOUBLE" .or. cFldType == "O"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Double( " +;
alltrim( a[ iif( cAction == "ADD", 3, 4 ) ] ) + ") "
case cFldType == "CURDOUBLE" .or. cFldType == "O"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " CurDouble( " +;
alltrim( a[ iif( cAction == "ADD", 4, 5 ) ] ) + ") "
case "VARCHAR" $ cFldType .or. cFldType == "V"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " VarChar( "+;
alltrim( a[ iif( cAction == "ADD", 3, 4 ) ] ) + ") "
case "VARBINARY" $ cFldType .or. cFldType == "Q"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Varbinary( "+;
alltrim( a[ iif( cAction == "ADD", 3, 4 ) ] ) + ") "
case "RAW" $ cFldType
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Raw (" +;
alltrim( a[ iif( cAction == "ADD", 3, 4 ) ] ) + ") "
case "CICHARACTER" $ cFldType
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " CIChar (" +;
alltrim( a[ iif( cAction == "ADD", 3, 4 ) ] ) + ") "
case cFldType $ "BLOB,IMAGE,BINARY"
cStr += iif( cAction == "ADD", "", " [" + a[ 2 ] + "] " ) + " Blob"
otherwise
cStr += iif( cAction == "ADD", " ", " [" + a[ 2 ] + "] " ) + cFldType
Endcase
NEXT
Endif
RETURN cStr
*-------------------------------------------------------------------------------------------------------------------------------
static function Fields2Add( aStruc, adbStruc )
local c := ""
local i
local cFieldName
DEFAULT adbStruc := {}
for i := 1 to len( aStruc )
cFieldName := upper( alltrim( aStruc[ i, DBS_NAME ] ) )
if aScan( adbStruc, { |e| cFieldName == upper( alltrim( e[ DBS_NAME ] ) ) } ) == 0
c += cFieldName + "," + ;
aStruc[ i, DBS_TYPE ] + "," + ;
alltrim( str( aStruc[ i, DBS_LEN ] ) ) + "," + ;
alltrim( str( aStruc[ i, DBS_DEC ] ) ) + ";"
endif
next i
return c
*-------------------------------------------------------------------------------------------------------------------------------
static function Fields2Del( astruc, adbStruc )
local c := ""
local i
local cFieldName
for i := 1 to len( adbStruc )
cFieldName := upper( alltrim( adbStruc[ i, DBS_NAME ] ) )
if aScan( aStruc, { |e| cFieldName == upper( alltrim( e[ DBS_NAME ] ) ) } ) == 0
c += cFieldName + ";"
endif
next i
return c
*-------------------------------------------------------------------------------------------------------------------------------
static function Fields2Chn( aStruc, adbstruc )
local cRet := ""
local i
local nPos
local cFieldName
for i := 1 to len( aStruc )
cFieldName := upper( alltrim( aStruc[ i, DBS_NAME ] ) )
nPos := aScan( adbStruc, { |e| upper( alltrim( e[ DBS_NAME ] ) ) == cFieldName } )
if nPos != 0 .and. ( upper( aStruc[ i, DBS_TYPE] ) <> adbStruc[ nPos, DBS_TYPE ] .or. ;
;//don't compare field length for integer, short, date, time, binary, memo, AutoInc)
( !(TransFieldName( aStruc[ i ] ) $ ;
"MONEY,LOGICAL,CURDOUBLE,ROWVERSION,RAW,MODTIME,DOUBLE,BINARY,IMAGE,BLOB,AUTOINC,TIME,TIMESTAMP,DATE,MEMO") .and. ;
( aStruc[ i, DBS_LEN ] > adbStruc[ nPos, DBS_LEN ] .or. ;
aStruc[ i, DBS_DEC ] <> adbStruc[ nPos, DBS_DEC ] ) ) )
cRet += adbStruc[ nPos, DBS_NAME ] + "," + ;
aStruc[ i, DBS_NAME ] + "," + ;
aStruc[ i, DBS_TYPE ] + "," + ;
alltrim( str( aStruc[ i, DBS_LEN ] ) ) + "," + ;
alltrim( str( aStruc[ i, DBS_DEC ] ) ) +";"
endif
next i
return cRet
*-------------------------------------------------------------------------------------------------------------------------------
static function showStructure()
local aFiles := GetTableStructures()
local cFileName, cFileType, aStruc
local ctable, cext
local i
for i := 1 to len( aFiles )
cFileName := SplitTableName( afiles[ i, 1 ],, @cFileType )
hb_FNameSplit( cFileName,,@cTable, @cExt )
AdsSetFileType( cFileType )
Dbusearea( .t. , "ADS", cTable, cTable, .f. )
aStruc := ( cTable )->( dbStruct() )
( cTable )->( dbclosearea() )
qOut( "Structure of table ", cFileName )
aEval( aStruc, { |e| qout( e[ DBS_NAME ], e[ DBS_TYPE ], e[ DBS_LEN ], e[ DBS_DEC ] ) } )
wait "any key to continue"
next
return Nil
*-------------------------------------------------------------------------------------------------------------------------------
static function ExecuteSQL( cSql )
local isOk := .f.
AdsCacheOpenCursors( 0 )
if AdsCreateSQLStatement(, ADS_ADT)
isOk := AdsExecuteSQLDirect( cSQL )
endif
if !isOk
Alert( "AdsExecuteSQLDirect() failed with error "+ Str( ADSGetLastError() ) )
qOut( cSQL )
endif
HB_INLINE() { hb_rddReleaseCurrentArea(); } //only good for non-cursor returning sql
return nil
*-------------------------------------------------------------------------------------------------------------------------------
//translate single characters returned by the RDD for some field types
//to full word field types
static function TransFieldName( aField )
local cFldType := upper( aField[ DBS_TYPE ] )
do case
case cFldType == "Y"
return "MONEY"
case cFldType == "C"
return "CHARACTER"
case cFldType == "N"
return "NUMERIC"
case cFldType == "M"
return "MEMO"
case cFldType == "V"
return "VARCHAR"
case cFldType == "Q"
return "VARBINARY"
case cFldType == "I"
return iif( aField[ DBS_DEC ] == 2, "SHORT", "INTEGER" )
case cFldType == "D"
return "DATE"
case cFldType == "L"
return "LOGICAL"
endcase
return cFldType
*-------------------------------------------------------------------------------------------------------------------------------
static function TestRIRule()
local cParent := "customers"
local cChild := "sales"
local nerr
AdsSetFileType( ADS_ADT )
Dbusearea( .t. , "ADS", "customers", cParent, .t. ) //exclusive use is needed to update table struc
qout( "cust_id:", (cParent)->cust_id )
(cParent)->( dbDelete() )
qout( "cust_id:", (cParent)->cust_id, neterr() )
if ( nErr := ADSGetLastError() ) != 0
Alert( "Delete Failed with " + cStr( nErr ) )
endif
browse()
(cParent)->( dbclosearea() )
return nil
*-------------------------------------------------------------------------------------------------------------------------------
/* aadd( all_files_struc,{ "customers.adt VIA ADSADT ",;
{ { "cust_id" , "CHARACTER", 10, 0 },;
{ "Sequence" , "AutoInc", 07, 0 },; //ADT extended field type autoincrement
{ "customer_name", "CHARACTER", 25, 0 },;
{ "Logical" , "Logical", 10 , 0 },;
{ "date" , "date", 0, 0 },;
{ "time" , "time", 0, 0 },; //extended field type
{ "TStamp" , "TimeStamp", 01, 0 },; //extended field type
{ "Integer_field", "Integer", 03, 0 },; //extended field type
{ "short_integer", "short", 03, 0 },; //extended field type
{ "Money_Field" , "Money", 09, 2 },; //extended field type
{ "Currency_double", "curdouble", 0, 2 } ,; //extended field type
{ "raw" , "raw", 25, 0 },; //extended field type
{ "rowversion" , "rowversion", 0, 0 },; //extended field type
{ "modtime" , "modtime", 0, 0 },; //extended field type
{ "Double" , "Double", 4, 0 },; //extended field type
{ "VarBinary" , "VarBinary", 10, 0 },; //extended field type
{ "VarChar" , "VarChar", 10, 0 },; //extended field type
{ "Image" , "Image", 10, 0 },; //extended field type
{ "Binary" , "Binary", 0, 0 },; //extended field type
{ "Notes" , "MEMO", 10, 0 } } } )
// { "ciCharacter" , "ciCharacter", 10 , 0 }}})//,; //case insensitive
aadd( all_files_struc, { "sales.dbf VIA ADSVFP STRICT", ;
{ { "cust_id" , "CHARACTER", 10, 0 },;
{ "invoice" , "CHARACTER", 15, 0 },;
{ "item_id" , "CHARACTER", 15, 0 },;
{ "Date" , "DATE", 8, 0 },;
{ "Logical" , "Logical", 10 , 0 },;
{ "TStamp" , "TimeStamp", 01, 0 },; //VFP extended field type
{ "Sequence" , "autoincrement", 0, 0 },; //VFP extended field type
{ "Units" , "Integer", 03, 0 },; //VFP extended field type
{ "Price" , "Money", 09, 2 },; //VFP extended field type
{ "Double" , "Double", 4, 0 },; //VFP extended field type
{ "VarChar" , "VarCharFox", 10 , 0 },; //VFP extended field type
{ "VarBinary" , "VarBinaryFox", 10, 0 },; //VFP extended field type
{ "Image" , "Image", 10, 0 },; //VFP extended field type
{ "Notes" , "Memo", 10, 0 } } } )
*-------------------------------------------------------------------------------------------------------------------------------
static function CreateNewTable( cFile, aStruc )
local cSQl := "CREATE TABLE "+ lower( cfile ) + " ( "
local aElem, nTmp
local isOk
local cADD := Fields2Add( aStruc )
local aFieldDesc, aParsed
cAdd := SQLAlterStm( "ADD", cAdd )
cAdd := Substr( StrTran( cAdd, "ADD COLUMN", ", " + CRLF ), 3 )
cSql += cAdd
cSql := SubStr( cSql, 1, rAt( ",", cSql ) -1 )
cSql += ") IN DATABASE ;"
ExecuteSQL( cSql )
Return Nil
*/
Reinaldo.
