Here is an Alpha 5 pack table global function shown below and attached as a Zip file. It checks for the table in use and conditionally packs.
Regards,
Ira J. Perlow
Computer Systems Design & Associates
[email protected]
function PackTable as N(TableName as C)
' Created by Computer Systems Design & Associates
' Copyright 2000 Computer Systems Design & Associates, All Rights Reserved
' Last Update: June 15, 2000
' Purpose: Packs a table if it is available exclusively for packing
' Input: TableName = Name of Table to pack
' Output: The number of tables packed. Zero indicates nothing was packed
' Errors: If TableName is blank, the current table of the active layout
' or doesn't exist, then a zero is returned
' Typical Usage:
' PackTable("Invoices") ' Pack Invoice table if available
' Examples:
' PackTable("Invoices")
' Notes:
' Set inital return value
PackTable=0
' Get current table's name
curtbl=Table.Current().Name_Get()
'Possible values for Mode are:
' 16 (Read only, exclusive)
' 18 (Read/write,exclusive),
' 64 (Read only, shared)
' 66 (Read/write, shared).
' Set value here because Alpha 5's constants don't always work
file_rw_exclusiv=18
tblnam=trim(TableName)
' If table name is not blank, then check
IF .not.(tblnam=="")
' If table name is not current table, then check
IF .not.(UT(curtbl)==UT(tblnam))
' Set error flag initially to 0
errflag=0
' Set error handler
ON ERROR GOTO Error_handler
' Try to open the table exclusively
tbl=table.open(tblnam,file_rw_exclusiv)
' Clear error handling
ON ERROR GOTO 0
' See if error flag has changed
IF errflag=0
' If error flag is still 0, then pack the table
' Display table name in the Trace Window
' trace.writeln("Repacking "+tblnam)
:Statusbar.Set_Text("Packing Table "+tblnam)
tbl.pack()
:Statusbar.Set_Text("Packing Table "+tblnam+" complete")
tbl.close()
' Set return value
PackTable=1
ELSE
:Statusbar.Set_Text("Unable to Pack Table "+tblnam)
ui_msg_box("Error",msg,UI_ATTENTION_SYMBOL)
END IF
END IF
END IF
END
error_handler:
err=error_code_get()
msg=error_text_get(err)
errflag=1
RESUME NEXT
END
end function
Regards,
Ira J. Perlow
Computer Systems Design & Associates
[email protected]
function PackTable as N(TableName as C)
' Created by Computer Systems Design & Associates
' Copyright 2000 Computer Systems Design & Associates, All Rights Reserved
' Last Update: June 15, 2000
' Purpose: Packs a table if it is available exclusively for packing
' Input: TableName = Name of Table to pack
' Output: The number of tables packed. Zero indicates nothing was packed
' Errors: If TableName is blank, the current table of the active layout
' or doesn't exist, then a zero is returned
' Typical Usage:
' PackTable("Invoices") ' Pack Invoice table if available
' Examples:
' PackTable("Invoices")
' Notes:
' Set inital return value
PackTable=0
' Get current table's name
curtbl=Table.Current().Name_Get()
'Possible values for Mode are:
' 16 (Read only, exclusive)
' 18 (Read/write,exclusive),
' 64 (Read only, shared)
' 66 (Read/write, shared).
' Set value here because Alpha 5's constants don't always work
file_rw_exclusiv=18
tblnam=trim(TableName)
' If table name is not blank, then check
IF .not.(tblnam=="")
' If table name is not current table, then check
IF .not.(UT(curtbl)==UT(tblnam))
' Set error flag initially to 0
errflag=0
' Set error handler
ON ERROR GOTO Error_handler
' Try to open the table exclusively
tbl=table.open(tblnam,file_rw_exclusiv)
' Clear error handling
ON ERROR GOTO 0
' See if error flag has changed
IF errflag=0
' If error flag is still 0, then pack the table
' Display table name in the Trace Window
' trace.writeln("Repacking "+tblnam)
:Statusbar.Set_Text("Packing Table "+tblnam)
tbl.pack()
:Statusbar.Set_Text("Packing Table "+tblnam+" complete")
tbl.close()
' Set return value
PackTable=1
ELSE
:Statusbar.Set_Text("Unable to Pack Table "+tblnam)
ui_msg_box("Error",msg,UI_ATTENTION_SYMBOL)
END IF
END IF
END IF
END
error_handler:
err=error_code_get()
msg=error_text_get(err)
errflag=1
RESUME NEXT
END
end function
Comment