A way to list all the Tables inside a Super TPS file e.g. TpsTableList Zuper
This is done using a feature of the TPS Driver SEND(File,'PNM=...). This requires a Table be Open … so you have to know the Structure 
. To work around that I Create() my own Table __List-Tps-Temp-File__ that I can open. To not alter the original TPS file I make a Copy() and Create() in that.
This is what I came up … alternative ways or ideas ???
PROGRAM !TpsTableList.exe Utility by Carl Barnes based on Table Remove by Jeff Slarve
!Usage: TpsTableList YourTpsFile [Password]
MsgCaption EQUATE('TPS Table List ')
MAP
ListTablesMain PROCEDURE()
ListTPSTables PROCEDURE(STRING pTpsSuperFileName,<STRING pOwnerID>, *CSTRING OutTableList),LONG,PROC
Err4Msg PROCEDURE(Byte NoCRLF=0),STRING !Fromat ErrorCode() & Error() & FileError... for Message() Stop() Halt() or Log file (NoCRLF)
END
CODE
ListTablesMain()
RETURN
ListTablesMain PROCEDURE()
TpsFile2List CSTRING(261) !File name on Command line
TpsFilePwd CSTRING(101) !Password from Command line
TmpCopyTPS CSTRING(261) !Copy of cmdline TPS file so leave orignal untouched
TableList CSTRING(4000)
CODE
SYSTEM{PROP:FontName}='Segoe UI' ; SYSTEM{PROP:FontSize}=10
DO HouseKeepingRtn
IF NOT COMMAND('1')
MESSAGE('TpsTableList.exe: ' & |
'||<9>A commandline program designed for the quick' & |
'|<9>list of \!Table''s within a TOPSPEED "super" file.' & |
'||Usage:|<9>TpsTableList YourTpsFile [Password]|',MsgCaption,ICON:Help)
RETURN
END
TpsFile2List = CLIP(LONGPATH(COMMAND('1')))
TpsFilePwd = CLIP(COMMAND('2'))
IF ~EXISTS(TpsFile2List) THEN !Does the command line file exist?
IF EXISTS(TpsFile2List & '.TPS') THEN !No ... what about with .TPS Extension
TpsFile2List = TpsFile2List & '.TPS' ! Yes so add .TPS
ELSE ! No they get error
MESSAGE('The File Name does not exist:||'& TpsFile2List , |
MsgCaption,ICON:Help)
RETURN
END
END
TmpCopyTPS = '.\~TpsTblListTemp~' & Clock() &'.TpsTmp'
COPY(TpsFile2List,TmpCopyTPS)
IF ERRORCODE() THEN
Message('Copy to create Temp Tps file failed' & |
'|| Copy From: '& TpsFile2List & |
'| Copy To: '& TmpCopyTPS & |
'|' & Err4Msg(), MsgCaption, ICON:Exclamation)
RETURN
END
!Edge case - Could file be Read Only, fix with change attributes?
! STOP('TpsFile2List<9>=' & TpsFile2List &'<13,10>TmpCopyTPS<9>='& TmpCopyTPS)
IF ListTPSTables(TmpCopyTPS,TpsFilePwd, TableList) THEN
MESSAGE('TPS List failed on "' & TpsFile2List &'"'& |
CHOOSE(NOT TpsFilePwd,'','<13,10>Using Password: "'& TpsFilePwd & '"' ) & |
Err4Msg(), MsgCaption &' Error',ICON:EXCLAMATION,,,MSGMODE:CANCOPY)
ELSE
REMOVE(TmpCopyTPS)
SETCLIPBOARD(TableList)
CASE MESSAGE(CLIP(TpsFile2List) &'||'& CLIP(TableList) , |
MsgCaption,Icon:Tick,'Close|Copy List',,MSGMODE:CANCOPY)
OF 2 ; SETCLIPBOARD(TableList)
END
END
REMOVE(TmpCopyTPS)
DO HouseKeepingRtn
RETURN
HouseKeepingRtn ROUTINE !Remove any Tmp Copy incase Orphaned
DATA
QNdx LONG,AUTO
DirTmpQ QUEUE(FILE:Queue),PRE(DirTmpQ)
END ! DirTmpQ:Name DirTmpQ:ShortName(8.3?) DirTmpQ:Date DirTmpQ:Time DirTmpQ:Size DirTmpQ:SizeU DirTmpQ:Attrib
CODE
DIRECTORY(DirTmpQ,'.\~TpsTblListTemp*.TpsTmp',ff_:NORMAL)
LOOP QNdx = 1 TO RECORDS(DirTmpQ)
GET(DirTmpQ,QNdx)
REMOVE(DirTmpQ:Name)
END
EXIT
!-----------------------------------------------------------------------------
ListTPSTables PROCEDURE(STRING pTpsSuperFileName,<STRING pOwnerID>, *CSTRING OutTableList)!,LONG,PROC
TmpTableName PSTRING(64) !Name of Table to Create then Open
TmpFullName STRING(400),STATIC !Name of TPS super file, expect it is Temp Copy
OwnerID CSTRING(101),STATIC
ListTmpFile FILE,DRIVER('TOPSPEED'),NAME(TmpFullName),PRE(LstTmpFile),OWNER(OwnerID),ENCRYPT,CREATE
Record RECORD
TmpField STRING(1)
END
END
NextPNM STRING(128)
PnmList ANY
CODE
IF NOT pTpsSuperFileName
OutTableList = 'No File Name so no Tables'
RETURN 0
END
IF ~OMITTED(pOwnerID) THEN OwnerID = CLIP(pOwnerID).
TmpTableName = '__List-Tps-Temp-File__' & Clock()
TmpFullName = CLIP(pTpsSuperFileName) &'\!' & TmpTableName
CREATE(ListTmpFile) ; IF ERRORCODE() THEN RETURN ERRORCODE().
SHARE(ListTmpFile) ; IF ERRORCODE() THEN RETURN ERRORCODE().
LOOP 200 TIMES
NextPNM = SEND(ListTmpFile,'PNM=' & NextPNM )
IF ~NextPNM THEN BREAK.
IF UPPER(NextPNM) = UPPER(TmpTableName) THEN CYCLE.
PnmList = CHOOSE(~PnmList,'',PnmList &'<13,10>') & CLIP(NextPNM)
END
CLOSE(ListTmpFile)
REMOVE(ListTmpFile)
OutTableList = PnmList
RETURN 0 !ERRORCODE()
!-----------------------------------------------------------------------------
Err4Msg PROCEDURE(Byte NoCRLF=0)!,STRING
!Example: IF ERRORCODE() THEN STOP('Failed ADD(xxx)' & Err4Msg()).
!Note: Return starts '<13,10><13,10>Error Code:' so no need to put in the Message()
CODE
IF ~ERRORCODE() THEN RETURN ''.
IF ~NoCRLF THEN
RETURN '<13,10><13,10>Error Code: ' & ERRORCODE()&' '&ERROR() & |
CHOOSE(~FILEERRORCODE(),'','<13,10>Driver Error: ' & FILEERRORCODE()&' '&FILEERROR() ) & |
CHOOSE(~ERRORFILE(),'','<13,10>File Name: ' & ERRORFILE() )
END
!NoCRLF<>0 is 1 line format for use by logging
RETURN ERRORCODE()&' '&ERROR() & | ! {148}
CHOOSE(~FILEERRORCODE(),'',' [Driver ' & FILEERRORCODE()&' '&FILEERROR() &']' ) & |
CHOOSE(~ERRORFILE(),'',' {{' & ERRORFILE() & '}' )
Project_TpsTableList.zip (14.3 KB)
Project contains example Zuper.TPS with 8 tables. Also ZuperBad.TPS that’s a text file so causes driver errors.