subroutine tappbackup_sub(dummy) * Changes and modification * ??/??/?? ??? Original programmer. * 01/30/96 DMG Change to add Notes sources, Datasets and Reporistory Reports. * 02/22/96 CS Fixed the table copy process to remove relational indexes * Inserts. $insert DB_MGMT_EQUATES $insert fserrors_hdr $insert fserrors_100 $insert fserrors_400 $insert msg_equates $insert repository_equates $insert sysrepos_col_equates $insert systable_names * Equates. EQU FALSE$ TO 0 EQU TRUE$ TO 1 EQU NULL$ TO '' EQU CRLF$ TO \0D0A\ EQU APPNAME$ TO "Application Backup" EQU WINID$ TO "APPBACKUP" EQU OPBACKUP$ TO "Backup" EQU OPRESTORE$ TO "Restore" EQU BACKUP$ TO "_BACKUP" EQU TYPEIDS$ TO "APPNOTE,APPROW,DATASOURCE,DBCOMPONENT,DBCOMPONENTEXE,DBCOLUMN,DBTABLE,DLL,DOC,IMAGE,MSG,OIEVENT,OIEVENTDBG,OIEVENTEXE,OIREPORT,OIWIN,OIWINEXE,OSFILE,POPUP,STPROC,STPROCDBG,STPROCEXE,STPROCINS,WINEXE" EQU TARGETS$ TO "LH,,LH,LH,LH,COLUMN,TABLE,OS,OS,OS,LH,LH,LH,LH,LH,LH,LH,OS,LH,LH,LH,LH,LH,OS" * 1/18/96 - DMG - Added in the new datatypes. * DMG 1/18/96 - the concation operator within this string is to get around that a string can only have 255 chars EQU DESTLIST$ TO "SYSREPOSAPPNOTES,,SYSREPOSDATASOURCES,SYSREPOSDBCOMPONENTS,SYSREPOSDBCOMPONENTEXES,,,DLL,DOC,IMAGE,SYSREPOSMESSAGES,SYSREPOSEVENTS,SYSREPOSEVENTEXES,SYSREPOSEVENTEXES,SYSREPOSREPORTS,SYSREPOSWINS,SYSREPOSWINEXES,OSFILE,SYSREPOSPOPUPS,SYSPROCS,SYSOBJ,":"SYSOBJ,SYSPROCS,WINEXE" EQU SETSTAT_OK$ TO 0 EQU SETSTAT_ERR$ TO 1 EQU SETSTAT_APPEND$ TO -1 EQU V119_DELETE$ TO 'D' EQU V119_EXTRACT$ TO 'E' EQU V119_INIT$ TO 'I' EQU V119_MERGE$ TO 'M' EQU V119_SORT$ TO 'S' EQU V119_VALUES$ TO 'V' EQU V119_WRITE$ TO 'W' EQU MAX_LEN$ TO 32000 ;* Threshold for creating temporary file. EQU MAX_SEND_SIZE$ TO 32000 ;* Target size for sending data back. EQU EXTRACT_SIZE$ TO 32000 ;* Size of blocks that v119 sends back. * Subroutine / function declarations. declare subroutine repos_checkformat, attach_table, mkdir, create_table, v119 declare subroutine create_table, copy_table, detach_volume, update_index declare subroutine define_database, initrnd, set_property, set_fserror declare subroutine utility, msg, set_status, send_event, get_status declare function msg, get_property, repository, getappid declare function get_repos_entities, resolve_path, msg * PROGRAM TOP * utility( "CURSOR", 'H') ;* Put up hourglass. * Initialization... winId = WINID$ msgRow = '' tableList = '' errorSummary = "Code - Detail" : @FM bErrors = FALSE$ bProcessErr = FALSE$ bCopyHdr = FALSE$ bLongList = FALSE$ errStat = FALSE$ SSPLIST = '' @file.error = '' bMerged = FALSE$ ;* The sort file only needs to merged once. * Create a temporary sortfile name (8 characters in length). if len( @STATION) then sortfile = @STATION[ -8, 8] end else initrnd timedate() sortfile = rnd( 90000000) + 10000000 end sortfile := ".SFX" * Extract the parameters. controls = winId:".OPERATION_OPT" : @RM : winId:".LOCATION_EDIT" controls := @RM : winId:".COPYDATA_CHK" properties = "VALUE" : @RM : "TEXT" : @RM : "CHECK" retval = get_property( controls, properties) operation = field( retval, @RM, 1, 1) location = field( retval, @RM, 2, 1) bCopyData = field( retval, @RM, 3, 1) if location else msgRow = "A location is required!" msgRow = "BOk" msgRow = APPNAME$ msgRow = '!' msg( winId, msgRow) return end if location[ -1, 1] = '\' then location[ -1, 1] = '' end appid = getappid()<1> /* Copy Table now removes relational indexes so there is no need to stop unless the users wants to CS*/ if operation = OPBACKUP$ then gosub analyze if errorList then convert @FM to CRLF$ in errorList msgRow = "Relational Indexes will not be copied from the following tables:" msgRow := CRLF$ : CRLF$ : errorList : CRLF$ msgRow := "Press Ok to continue" msgRow< MICON$ > = '!' msgRow< MTYPE$ > = "BOC" response = msg( WINID$, msgRow) If response = Char(27) Then return ; *Check to see if the user wants to abort end end * Validate the location. If no backup files exist, create them. tempSysRepos = SYSREPOS_FILE$ : BACKUP$ attach_table( location, tempSysRepos, GLOBAL$, '', status) if get_status(errcode) then * Table doesn't exist. Create it. if errcode<1,1> = "FS":FS_INVALID_MAP_QUALIFIER$ then set_status( SETSTAT_OK$, TRUE$) end begin case case operation = OPBACKUP$ * Prompt for creation of backup location. msgRow = "Backup files do not exist on ": location: ".": CRLF$: "Create?" msgRow = "BNYC" msgRow = '?' msgRow = APPNAME$ bCreate = msg( WINID$, msgRow) if bCreate = 1 else return ;* Chose No or Cancel. * Make sure the directory exists. mkdir( location:char(0), status) * Create the sysrepos-backup table. create_table( location, tempSysRepos, 0, GLOBAL$, '', '') if get_status() then return end utility( "CURSOR", 'H') case operation = OPRESTORE$ * No backup data here! msgRow = "There is no data on " : location msgRow = "BOk" msgRow = '!' msgRow = APPNAME$ : "- Error" msg( WINID$, msgRow) return case 1 end case end else if operation = OPBACKUP$ then * If backing up, prompt for overwriting. msgRow = "Backup files already exist on ": location: "." msgRow := " If this application has been backed up at this" msgRow := " location previously, the existing data will be lost." msgRow := CRLF$: "Continue?" msgRow< MTYPE$> = "BNYC" msgRow< MDEFBTN$> = 2 msgRow< MICON$> = '!' bOverwrite = msg( WINID$, msgRow) if bOverwrite = 1 else return gosub clearData end end * Open required tables. if operation = OPBACKUP$ then sysreposSrc = SYSREPOS_FILE$ sysreposDst = SYSREPOS_FILE$:BACKUP$ end else sysreposSrc = SYSREPOS_FILE$:BACKUP$ sysreposDst = SYSREPOS_FILE$ end open sysreposSrc to fhSysReposSrc else set_fserror() return end open sysreposDst to fhSysReposDst else set_fserror() return end open SYSTABLES_FILE$ to fhSysTables else set_fserror() return end moreInfo = TRUE$ ;* We can handle over 64k. loop * Get list of entities for this application. set_property( winID:".STATUS_TEXT", "TEXT", "Selecting...") if operation = OPBACKUP$ then * Backup logic. Get list of entities, making multiple calls if * there is over 64K worth of names. * Arguments are APPID, TYPEID, CLASSID, ReturnFlags, ExpandNames, RemoteRepository, fMoreInfo (>64k). entList = get_repos_entities( appid, '', '', FALSE$, TRUE$, FALSE$, moreInfo) if len( moreInfo) then * List is > 64K...we'll need to make multiple calls. bLongList = TRUE$ end end else * Operation is "RESTORE" (OPRESTORE$). if bLongList then * 2nd - nth time through this loop. This occurs only if the * list to restore is greater than 64K. gosub ExtractSort end else * First time through...select SYSREPOS_BACKUP table and retrieve * the list of entities. select fhSysReposSrc ;* 1st time...create list of entities. done = FALSE$ entList = '' loop readnext entid else done = TRUE$ until done * Only restore objects from this application. if entid[ 1, '*'] = appid then entList := entid : @FM if (len( entList) > MAX_LEN$) then * List has reached threshold...use temp sort-file. if bLongList else * Need to create sort-file. gosub InitSort if errStat then return end bLongList = TRUE$ end * Sort and store what we have. Refresh list. gosub DoSort entList = '' end end repeat if bLongList else * List is under threshold...no temp-file was necessary. moreInfo = NULL$ end if len( entList) then * Sort & process current entity-list. gosub DoSort if entList[ -1, 1] = @FM then entList[ -1, 1] = '' end if bLongList then * Merge lists and extract first block. entList = '' gosub MergeSort gosub ExtractSort end end end if get_status() then return * Count the number of entities we currently have. numEntities = count( entList, @fm) + (entList # NULL$) * Initialize the status & progress bars. set_property( winID:".STATUS_TEXT", "TEXT", '') gosub InitProgressBar * Process entities...bail out if error flag is set in process loop. bProcessErr = FALSE$ gosub ProcessEntities if bProcessErr then goto Exit * If there are more entities...get them! while len( moreInfo) repeat if (operation = OPRESTORE$) and bLongList then * Temporary sort-file was used...delete it. gosub deleteSort end * Detach the backup location. detach_volume( location, status) * If DBTABLEs were restored...save the database definition. if operation = OPRESTORE$ then if tableList then set_property( winID:".STATUS_TEXT", "TEXT", "Updating...") define_database( @dbid, 1, '', 0) end end * Clear status & progress controls. controls = winID:".STATUS_TEXT" : @RM : winID:".PROGRESS_BAR" controls := @RM : winID:".ENTITYID" properties = "TEXT" : @RM : "SIZE" : @RM : "TEXT" values = '' : @RM : minBar : @RM : '' set_property( controls, properties, values) * We're done! msgRow = "The " : operation : " of " : appid : " is complete." exit: if bErrors then errorsID = appid:"*ERRORS" msgRow = "Error detail has been written" msgRow := " to data row":CRLF$:"'":errorsID:"'":CRLF$:"in the 'SYSLISTS'" msgRow := " table and can be viewed using the system editor." end msgRow< MICON$> = '!' msgRow< MCAPTION$> = "Application Backup" msg( WINID$, msgRow) if bErrors then open SYSLISTS_FILE$ to fhSysLists then write errorSummary to fhSysLists, errorsID else set_fserror() end end else set_fserror() end end send_event( WINID$, "CLOSE") RETURN /* ----------------------------------------------------------------------- */ analyze: * Tables with relational indexing cannot be copied. errorList = '' if bCopyData then set_property( winId:".STATUS_TEXT", "TEXT", "Analyzing...") dbTables = get_repos_entities( appid, "DBTABLE", '') numTables = count( dbTables, @FM) + ( dbTables ne '') for tableCntr = 1 to numTables dbName = field( dbTables< tableCntr>, KEYSEP$, 4, 1) if dbName[ 1, 1] = '!' then open dbName to fhBang then read bangRow from fhBang, dbName then indexPos = 4 loop tempInfo = bangRow< 1, 1, indexPos> while tempInfo convert @TM:'*' to @FM:@VM in tempInfo indexType = tempInfo<3> if indexType = 3 or indexType = 5 then errorList<-1> = dbName end indexPos += 1 repeat end end end next tableCntr set_property( winId:".STATUS_TEXT", "TEXT", '') end return /* ----------------------------------------------------------------------- */ clearData: * Clear previous backup data. set_property( winID:".STATUS_TEXT", "TEXT", "Clearing...") sysreposDst = SYSREPOS_FILE$:BACKUP$ open sysreposDst to fhTemp then select fhTemp done = FALSE$ loop readnext tempId else done = TRUE$ until done tempAppid = field( tempId, KEYSEP$, APPID$, 1) if tempAppid = appid then delete fhTemp, tempId else NULL end repeat end set_property( winID:".STATUS_TEXT", "TEXT", '') return /* ----------------------------------------------------------------------- */ InitProgressBar: * Initialize progress bar. maxBar = get_property( winID:".PROGRESS_BACK", "SIZE") maxWidth = maxBar<3> minBar = fieldstore( maxBar, @fm, 3, 1, 0) currBar = minBar backColor = 255 controls = winID:".PROGRESS_BAR" : @RM : winID:".PROGRESS_BAR" controls := @RM : winID:".ENTITY_LABEL" properties = "SIZE" : @RM : "BACKCOLOR" : @RM : "ENABLED" values = currBar : @RM : backColor : @RM : TRUE$ set_property( controls, properties, values) return /* ----------------------------------------------------------------------- */ ProcessEntities: * Process the entities. doneList = '' ;* Keep track of types already processed (for initialization). currType = '' for entCounter = 1 to numEntities entid = entList< entCounter> appid = field( entid, KEYSEP$, APPID$, 1) typeid = field( entid, KEYSEP$, TYPEID$, 1) classid = field( entid, KEYSEP$, CLASSID$, 1) entityid = field( entid, KEYSEP$, ENTITYID$, 1) locate typeid in TYPEIDS$ using ',' setting typePos then backupType = field( TARGETS$, ',', typePos, 1) bodySpec = field( DESTLIST$, ',', typePos, 1) bCopyHdr = TRUE$ bCopyBody = TRUE$ set_property( winId:".ENTITYID", "TEXT", entid) end else backupType = '' end begin case case backupType = "LH" if operation = OPBACKUP$ then sourceTable = bodySpec destTable = bodySpec:BACKUP$ end else sourceTable = bodySpec:BACKUP$ destTable = bodySpec end * Prepare the destination for the backup. This is done once for each type. locate typeid in doneList using @fm setting donePos else if operation = OPBACKUP$ then create_table( location, destTable, 0, GLOBAL$, '', 0) if get_status(errcode) then if errcode<1,1> = 'FS':FS_FILE_ALREADY_EXISTS$ then set_status( SETSTAT_OK$, TRUE$) end else gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end attach_table( location, destTable, GLOBAL$, '',status) if get_status() then gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end doneList<-1> = typeid * Retrieve list of system procs. open SYSENV_FILE$ to fhSysEnv then read SSPList from fhSysEnv, "SYSPROCNAMES" else SSPList = '' end else SSPList = '' end end else attach_table( location, sourceTable, GLOBAL$, '',status) if get_status() then gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end end * Open the table and transfer the body. if currType = typeid else open sourceTable to fhSrc else ;* Open source table. set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end open destTable to fhDest else ;* Open Destination table. set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end if typeid[ 1, 6] = "STPROC" then * Don't backup system procedures. if appid = "SYSPROG" and typeid = "STPROCEXE" then locate entityid in SSPList using @FM setting nothing then bCopyBody = FALSE$ bCopyHdr = FALSE$ end end begin case case typeid = "STPROCDBG" procid = '@':entityid case typeid = "STPROCEXE" procid = '$':entityid case 1 procid = entityid end case bodyID = if appid = "SYSPROG" then procid else procid:KEYSEP$:appid end else bodyID = appid : KEYSEP$ : classid : KEYSEP$ : entityid end if bCopyBody then read entBody from fhSrc, bodyID else entBody = '' write entBody to fhDest, bodyID else set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end case backupType = "OS" if operation = OPBACKUP$ then srcSpec = repository( "GETSUBKEY" , entid) destDir = location : '\' : bodySpec dosfile = srcSpec[ -1, "B\"] dstSpec = destDir : '\' : dosfile * Create the directory (done only once). locate typeid in doneList using @fm setting nothing else mkdir( destDir:char(0), status) end end else read entHdr from fhSysReposSrc, entid then dstSpec = entHdr< SYSREP_SUB_KEY$> dosfile = dstSpec[ -1, "B\"] destDir = dstSpec[ 1, (col1() - 1)] srcSpec = location : '\' : bodySpec : '\' : dosfile mkdir( destDir:char(0), status) end else @file.error< FSMSG$> = entid set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end * Transfer the file. osopen srcSpec to hSrc else @file.error = FS_READ_FILE_DNE$ @file.error< FSMSG$> = srcSpec set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end osopen dstSpec to hDst else oswrite '' to dstSpec osopen dstSpec to hDst else @file.error = FS_READ_FILE_DNE$ @file.error< FSMSG$> = dstSpec set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end offset = 0 loop osbread osData from hSrc at offset length 16384 doserr = status() while osData and not(doserr) osbwrite osData to hDst at offset doserr = status() until doserr offset += len( osData) repeat if doserr then set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end osclose hSrc osclose hDst case backupType = "COLUMN" if operation = OPBACKUP$ then * Don't copy system-table headers. if entityid[ 1, 3] = "SYS" or entityid[ 1, '.'] = "ACCESSIBLE_COLUMNS" then bCopyHdr = FALSE$ end * Post-beta 1 fix...don't copy DBCOLUMNs that are duped in SYSPROG. if appid = "CARPARTS" then sysprogEnt = "SYSPROG": KEYSEP$: typeid: KEYSEP$: classid: KEYSEP$: entityid read sysprogHdr from fhSysReposSrc, sysprogEnt then bCopyHdr = FALSE$ end end end case backupType = "TABLE" if operation = OPBACKUP$ then srcName = entityid destName = entityid:BACKUP$ destLocation = location subkey = repository( "GETSUBKEY", entid) bfs = subkey< 1, 2> dbid = subkey< 1, 3> end else srcName = entityid:BACKUP$ destName = entityid read entHdr from fhSysReposSrc, entid then subkey = entHdr< SYSREP_SUB_KEY$> destLocation = subkey< 1, 1> bfs = subkey< 1, 2> dbid = subkey< 1, 3> end else @file.error< FSMSG$> = entid set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end if bCopyData then attach_table( location, srcName, dbid, '', status) if get_status() then gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end end * Copy the entire table (skip '!' & 'DICT.'). if bCopyData then if entityid[1,1] = '!' or entityid[1,5] = "DICT." or entityid[1,3] = "SYS" or entityid = "ACCESSIBLE_COLUMNS" else if bfs = "RTP57" then read systablesRow from fhSysTables, srcName then copy_table( srcName, destLocation, dbid, destName, '', '', TRUE$, '', status, TRUE$ ) if get_status(errcode) then if errcode<1,1> = "FS267" or errcode<1,1> = "FS259" then msgRow = "Table ":errcode<1,2>:" has relational indexing on it and" msgRow := " cannot be copied until the indexes are removed." msgRow< MICON$> = '!' msg( WINID$, msgRow) end if errcode<1,1> = "FS100" or errcode<1,1> = "FS109" then set_status( SETSTAT_OK$, TRUE$) end else gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end if operation = OPRESTORE$ then attach_table( destLocation, destName, dbid, '',status) if get_status() else tableList<-1> = destName end end end end end end if operation = OPBACKUP$ then * Don't backup system tables. if entityid[1,3] = "SYS" or entityid[1,8] = "DICT.SYS" or entityid[1,4] = "!SYS" or entityid = "ACCESSIBLE_COLUMNS" then bCopyHdr = FALSE$ end * Post-beta 1 fix...don't copy DBTABLEs that are duped in SYSPROG. if appid = "CARPARTS" then sysprogEnt = "SYSPROG": KEYSEP$: typeid: KEYSEP$: classid: KEYSEP$: entityid read sysprogHdr from fhSysReposSrc, sysprogEnt then bCopyHdr = FALSE$ end end end case 1 end case currType = typeid * Copy the entity header. if bCopyHdr then read entHdr from fhSysReposSrc, entid then write entHdr to fhSysReposDst, entid else set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end else set_fserror() gosub promptErr if bContinue then goto nextEntity end else bProcessErr = TRUE$ return end end end * Update progress bar. * Cannot update if > 64k because it's an unresolved list. if bLongList then set_property( winID:".STATUS_TEXT", "TEXT", "Processing...") end else if not( mod(entCounter,10)) or (entCounter = numEntities) then pctText = (int( entCounter/numEntities * 100)) : '%' pctText = fmt( pctText, "C#15") newWidth = int( (entCounter/numEntities) * maxWidth) currBar = fieldstore( currBar, @fm, 3, 1, newWidth) controls = winID:".STATUS_TEXT" : @RM : winID:".PROGRESS_BAR" properties = "TEXT" : @RM : "SIZE" values = pctText : @RM : currBar set_property( controls, properties, values) end end nextEntity: next entCounter return /* ----------------------------------------------------------------------- */ PromptErr: * Display error info & prompt for continuing. bErrors = TRUE$ get_status( errcode) set_status( SETSTAT_OK$, '') msgRow = "An error was encountered." : CRLF$ msgRow := "Error code: ": errcode<1,1> : CRLF$ msgRow := "Detail: ": errcode<1,2> : CRLF$ : CRLF$ msgRow := "Continue?" msgRow< MICON$> = '!' msgRow< MTYPE$> = "BNY" msgRow< MTEXTWIDTH$> = "300" msgRow< MCAPTION$> = "Application Backup Error" answer = msg( winID, msgRow) if answer = 1 then bContinue = TRUE$ end else bContinue = FALSE$ end swap @VM with " - " in errcode errorSummary<-1> = errcode return /* ----------------------------------------------------------------------- */ InitSort: * Initialize the sort file. osdelete sortFile v119( V119_INIT$, sortFile, '', '', '', sortStat) if sortStat else @FILE.ERROR = FS_SYS_SORT_INIT_ERR$ set_fserror() errStat = TRUE$ end return /* ----------------------------------------------------------------------- */ DeleteSort: * Delete the sort file. v119( V119_DELETE$, sortFile, '', '', '', sortStat) return /* ----------------------------------------------------------------------- */ DoSort: * Sort the data. If long sort, write to temp file. convert \FEFD\ to \FFFE\ in entList if entList[ -1, 1] <> @RM then entList := @RM end v119( V119_SORT$, '', 'A', 'L', entList, '') if bLongList then v119( V119_WRITE$, sortFile, '', '', entList, sortStat) if sortStat else @FILE.ERROR = FS_SYS_SORT_WRITE_ERR$ set_fserror() errStat = TRUE$ end end convert \FFFE\ to \FEFD\ in entList return /* ----------------------------------------------------------------------- */ MergeSort: * Merge the data in the temp file. v119( V119_MERGE$, sortFile , 'A', 'L', '', sortStat) bMerged = TRUE$ if sortStat else @FILE.ERROR = FS_SYS_SORT_MERGE_ERR$ set_fserror() errStat = TRUE$ end return /* ----------------------------------------------------------------------- */ ExtractSort: * Determine the extract operation (long or short) and do it. if bLongList then if bMerged else gosub mergeSort if errStat then return end entList = '' v119( 'V', sortFile, 'A', 'L', entList, sortStat) if sortStat else @FILE.ERROR = FS_SYS_SORT_EXTRACT_ERR$ errStat = TRUE$ return end end * If less than max size, there's no more in temp file. if len( entList) < EXTRACT_SIZE$ then moreInfo = '' end else moreInfo = TRUE$ end if bLongList then convert \FFFE\ to \FEFD\ in entList end entList[ -1, 1] = '' return