//************************************************************************ //*** Update routine for Update-Utility //************************************************************************ //*** Update.inc //*** Version: 5.2 //*** Copyright (c) 2000 NordTeam Gruppen //*** (Code has been clarified OPEN SOURCE 22/9 2000). //*** //*** Author......: Allan Kim Eriksen //*** Created.....: 25-09-2000 //*** Last updated: 11-12-2008 //************************************************************************ // This is actually the updating part. // The update collects its directories from the registrationdatabase under DEFAULTS // Update database = Directories for the databasefiles // Update filelist = Indicate filelist-name including path // Update description = Indicate path to descriptionfiles //************************************************************************ Use noexcacc.pkg Global_Variable String sTestMode Global_Variable String gsActFile Define cFieldBlock For 8 Define cSegmentMax For 17 // including segment 0 Define cSegmentBlock For 3 Define cMaxFilelistEntry For 4095 Define cKnownIssuesBlock For 6 // Properties for reading descriptionfiles // Each line read is spit into theese properties. ("ID, value1, value2, value3") Property String pID public "" // ID Property String pV1 public "" // value 1 Property String pV2 public "" // value 2 Property String pV3 public "" // value 3 // Properties to control the new alias files or renamed logical names Property Integer pNewOrRenamedEntry public 0 Property String pSaveRootname public "" Property String pSaveLogicalName public "" Property String pSaveDisplayName public "" // Property to restore dfpath for each time a database has been restructured. Property String psDFPath public "" Object aDatFile is An Array // Recordlength: 18 (one record only) // item 0: COMPRESSION // item 1: DISPLAY NAME // item 2: DRIVER // item 3: INTEGRITY CHECK // item 4: SYSTEM FILE // item 5: LAST INDEX NUMBER // item 6: LOCK TYPE // item 7: LOGICAL NAME // item 8: MAX RECORDS // item 9: MULTIUSER // item 10: FILE NUMBER // item 11: (not used) // item 12: RECORD IDENTITY // item 13: RECORD LENGTH // item 14: REUSE DELETED RECORDS // item 15: REVISION // item 16: ROOT NAME // item 17: TRANSACTION End_Object Object aDatField is An Array // Recordlength: 8 = cFieldBlock (first record block not used = RECNUM) // #0: NAME // #1: MAIN INDEX // #2: LENGTH // #3: OFFSET // #4: PRECISION // #5: RELATED FIELD // #6: RELATED FILE // #7: TYPE End_Object Object aDatIndex is An Array // Recordlength: 51 = cSegmentMax * cSegmentBlock (first record block not used = index.0) // #0: CASE // #1: DIRECTION // #2: FIELD End_Object Object aDatIndexType is An Array // Recordlength: 1 (first record block not used = index.0) // #0: TYPE End_Object Object aDatIndexNrSeg is An Array // Recordlength: 1 (first record block not used = index.0) // #0: number of segments in a index stored in aDatIndex End_Object Object aDatSegMod is An Array End_Object Object aTempDatIndex is An Array // as aDatIndex but only for one index at a time. // Used when there is a difference in the use of database drivers. Property Integer piNoOfSegments End_Object Object aInitdata is An Array // Recordlength: 1 (first record block not used = RECNUM) // #0: Init Data for field End_Object Object aInitIndexMark is An Array End_Object Object aNewFileList is An Array // Recordlength: 3 (first record block not used = file number 0) // #0: Rootname // #1: Logicalname // #2: Displayname End_Object Object aKnownIssues is An Array // Recordlength: cKnownIssuesBlock // Each line read is spit into items. ("Command, value1, value2, value3, value4, value5") // #0: Command // #1: Value 1 // #2: Value 2 // #3: Value 3 // #4: Value 4 // #5: Value 5 End_Object Function DescribeFieldtype Integer iFieldType Returns String String sMessage If (iFieldType = DF_ASCII) Move "ASCII" to sMessage If (iFieldType = DF_BCD) Move "NUMMERIC" to sMessage If (iFieldType = DF_DATE) Move "DATE" to sMessage If (iFieldType = DF_TEXT) Move "TEXT" to sMessage If (iFieldType = DF_BINARY) Move "BINARY" to sMessage If (iFieldType = DF_OVERLAP) Move "OVERLAP" to sMessage Function_Return sMessage End_Function // Returns the new filenumber from the descriptionfiles for Logical Name Function NewFileNumber Global String sLogicalName Returns Integer Integer iNewNumber iMaxItem iActItem Integer iFilenum oNewFilelist String sTest Move (aNewFilelist(Self)) to oNewFilelist Trim sLogicalName to sLogicalName Uppercase sLogicalname Move -1 to iNewNumber // Entry has been removed from the new filelist Move 0 to iFilenum // Start at top of current filelist Repeat Increment iFilenum Get string_value of oNewFilelist Item ((iFilenum * 3) + 1) to sTest Trim sTest to sTest Uppercase sTest If (sTest = sLogicalname) Begin Move iFilenum to iNewNumber Move 0 to iFilenum // Stop the search in the filelist End Until ((iFilenum = 0) or (iFilenum = cMaxFilelistEntry)) Function_Return iNewNumber End_Function // Returns the old filenumber from the filelist for Logical Name Function OldFileNumber Global String sLogicalName Returns Integer Integer iOldNumber iMaxItem iActItem Integer iFilenum String sTest Trim sLogicalName to sLogicalName Uppercase sLogicalname Move -1 to iOldNumber // Entry has been added to the new filelist Move 0 to iFilenum // Start at top of current filelist Repeat Get_Attribute DF_FILE_NEXT_USED of iFilenum to iFilenum If iFilenum Begin Get_Attribute DF_FILE_LOGICAL_NAME of iFilenum to sTest Trim sTest to sTest Uppercase sTest If (sTest = sLogicalname) Begin Move iFilenum to iOldNumber Move 0 to iFilenum // Stop the search in the filelist End End Until (iFilenum = 0) Function_Return iOldNumber End_Function // Returns the new field number from the descriptionfiles for Field Name Function NewFieldNumber Global String sFieldname Returns Integer Integer iNewFieldnumber oDatfield iMaxItem iActItem oKnownIssues String sTest sCommand Trim sFieldname to sFieldname Uppercase sFieldname Move (aDatField(Self)) to oDatField Move (aKnownIssues(Self)) to oKnownIssues // Examine if the fieldname can be found in the descriptionfiles. Move -1 to iNewFieldnumber // Field has been deleted Get item_count of oDatField to iMaxItem Move 0 to iActItem If (sFieldname = "DFRECNUM") Move "RECNUM" to sFieldname If (sFieldname = "RECNUM") Move 0 to iNewFieldNumber While ((iActItem < iMaxItem) and (iNewFieldNumber = -1)) Get string_value of oDatField Item iActItem to sTest Trim sTest to sTest Uppercase sTest If (sTest = "DFRECNUM") Move "RECNUM" to sTest If (sTest = sFieldName) calc (iActItem / cFieldBlock) to iNewFieldNumber Add cFieldBlock to iActItem Loop If (iNewFieldNumber = -1) Begin // The fieldname could not be found. Try to examint known issues for deleted or renamed fieldnames. Get item_count of oKnownIssues to iMaxItem Move 1 to iActItem While (iActItem < iMaxItem) Get string_value of oKnownIssues Item iActItem to sTest If (sTest = sFieldname) Begin Get string_value of oKnownIssues Item (iActItem - 1) to sCommand If (sCommand = "IDENTICAL") Begin // The fieldname has been renamed. Get string_value of oKnownIssues Item (iActItem + 1) to sTest Move iMaxItem to iActItem Move sTest to sFieldname End // DELETE is obsolete. End Add cKnownIssuesBlock to iActItem Loop // and search the old fieldname again. Move -1 to iNewFieldnumber // Field has been deleted Get item_count of oDatField to iMaxItem Move 0 to iActItem If (sFieldname = "RECNUM") Move 0 to iNewFieldNumber While ((iActItem < iMaxItem) and (iNewFieldNumber = -1)) Get string_value of oDatField Item iActItem to sTest Trim sTest to sTest Uppercase sTest If (sTest = "DFRECNUM") Move "RECNUM" to sTest If (sTest = sFieldName) calc (iActItem / cFieldBlock) to iNewFieldNumber Add cFieldBlock to iActItem Loop End Function_Return iNewFieldNumber End_Function // Returns the old field number from the databasefile for Field Name Function OldFieldNumber Global String sFieldname Integer Filenum Returns Integer Integer iOldFieldnumber oDatfield iActPos iNoOfFields oKnownIssues Integer iMaxItem iActItem String sTest sCommand Trim sFieldname to sFieldname Uppercase sFieldname Move (aKnownIssues(Self)) to oKnownIssues // Examine if the fieldname can be found in the database. Move -1 to iOldFieldnumber // Field has been added If (sFieldname = "DFRECNUM") Move "RECNUM" to sFieldname If (sFieldname = "RECNUM") Move 0 to iOldFieldNumber Get_Attribute DF_FILE_NUMBER_FIELDS of Filenum to iNoOfFields Move 0 to iActPos While ((iActPos =< iNoOfFields) and (iOldFieldNumber = -1)) Get_Attribute DF_FIELD_NAME of Filenum iActPos to sTest Trim stest to stest Uppercase sTest If (sTest = "DFRECNUM") Move "RECNUM" to sTest If (sTest = sFieldName) Move iActPos to iOldFieldNumber Increment iActPos Loop If (iOldFieldNumber = -1) Begin // The fieldname could not be found. Try to examint known issues for deleted or renamed fieldnames. Get item_count of oKnownIssues to iMaxItem Move 2 to iActItem While (iActItem < iMaxItem) Get string_value of oKnownIssues Item iActItem to sTest If (sTest = sFieldname) Begin Get string_value of oKnownIssues Item (iActItem - 2) to sCommand If (sCommand = "IDENTICAL") Begin // The fieldname has been renamed. Get string_value of oKnownIssues Item (iActItem - 1) to sTest Move iMaxItem to iActItem Move sTest to sFieldname End // DELETE is obsolete. End Add cKnownIssuesBlock to iActItem Loop // and search the old fieldname again. Move -1 to iOldFieldnumber // Field has been added If (sFieldname = "RECNUM") Move 0 to iOldFieldNumber Get_Attribute DF_FILE_NUMBER_FIELDS of Filenum to iNoOfFields Move 0 to iActPos While ((iActPos =< iNoOfFields) and (iOldFieldNumber = -1)) Get_Attribute DF_FIELD_NAME of Filenum iActPos to sTest Trim stest to stest Uppercase sTest If (sTest = "DFRECNUM") Move "RECNUM" to sTest If (sTest = sFieldName) Move iActPos to iOldFieldNumber Increment iActPos Loop End Function_Return iOldFieldNumber End_Function // Function copied from Sture Andersen's string.utl (part of VDFQuerty) Function StripFromLastOccurance Global String src# String val# Returns String Integer len# search_len# String tmp# Length val# to search_len# If search_len# eq 0 Function_Return src# Repeat Length src# to len# If len# le search_len# Function_Return "" Move (Right(src#,search_len#)) to tmp# If tmp# eq val# Function_Return (Left(src#,len#-search_len#)) Move (Left(src#,len#-1)) to src# Loop End_Function // Returns true if the file in the database and the file from the descriptionsfiles // uses the same database driver. Function UsesSameDriver Global Integer iFilenum Returns Boolean String sDrv1 sDrv2 Boolean bDriverIsSame Move True to bDriverIsSame Get_Attribute DF_FILE_DRIVER of iFilenum to sDrv1 Get string_value of (aDatFile(Self)) Item 2 to sDrv2 If (Trim(sDrv1) <> Trim(sDrv2)) Move False to bDriverIsSame Function_Return bDriverIsSame End_Function // Returns the true rootname of a file without any driver database identification. // Rootname is also Uppercased. Function RootnameNoID String sRootname Returns String Get ParseFileName sRootname to sRootname // Remove any path or driver prefix. Move (Uppercase(sRootname)) to sRootname // Remove driver suffix. Move (Replace(".INT", sRootname, "")) to sRootname Move (Replace(".DAT", sRootname, "")) to sRootname Function_Return sRootname End_Function Procedure DoUpdate String sWorkspaceFile String sDescriptionfiles String strDFPath strTemp strTest sFileIn sFiledir sInDir sFilelist String sDirLine dfil fFil sFileout filknownissues filinit String sCommandLine sCommand kp1 kp2 kp3 kp4 kp5 Integer iCommaPos iEraseMarked iSegment iCase iDirection Integer iLastBackSlash iActPos retval iNoOfFields iFieldType iNoOfFieldsNTD String sRootname sMessage sLogicalName sDisplayName String sDatafilePath Integer iFilenum StructHandle iReadFields Integer iNoOfFields2 iIndexnumber Lastindex iHandle Integer oInitIndexMark iNoInitRecords hID String vASCII vTEXT vBINARY vOVERLAP String vBCD sFieldname sDrivername Date vDATE Integer iActPos2 iFound iLength Integer iFieldSize iActPos3 Integer indextype oCallback iNumSegments oInitdata iFieldnumber Integer iSrchField iFieldFound iForceInit oNewFileList Number nWorkOffset nNoRecords nMaxRec n nNewMaxRec nNumRec nv Integer iUpdateNeeded iNewFileNumber Integer iSeqFile iSeqTest iNoOfFiles iItem Handle hDir hoWorkspace Boolean bDeleteOk String sTest Integer oDatFile iHour iMinute Date dCurrentDate // Redirect errormessages to our ovn error-object (the view) Set OldErrId to Error_Object_Id // remember the original errorobject Move Self to Error_Object_Id sysdate4 dCurrentDate ihour iminute Set piActFilenumber to 0 Set psActFilename to "" // Get objectID's Move (aInitdata(Self)) to oInitdata Move (aInitIndexMark(Self)) to oInitIndexMark Move (pcallback(cnt3DBox(Update_vw(Self)))) to oCallback Move (aDatFile(Self)) to oDatFile Move (aNewFilelist(Self)) to oNewFilelist // Erase data in arrays Send delete_data to oInitdata Send delete_data to oInitIndexMark Send delete_data to oDatFile Send delete_data to oNewFilelist Move sDescriptionfiles to sInDir Append sInDir "\" // Open the workspace Get phoWorkspace of oApplication to hoWorkspace Send DoClearPaths of hoWorkspace Get OpenWorkspaceFile of hoWorkspace sWorkspaceFile to retval If (retval = wsWorkspaceOpened) Begin // Use the directory in which the filelist is placed for the test- and errorfile. Get psFilelist of hoWorkspace to sFilelist Get ExtractFilePath sFilelist to sFiledir Send cursor_wait to (cursor_control(current_object)) // Start by indicating that the update didn't finnish // This will only be corrected if the update will finnish completly and the user may have // chosen to ignore/continue at errors. Move (sFiledir + "OPDSTAT.TXT") to sFileout Get Seq_New_Channel to iSeqFile Direct_Output channel iSeqfile sFileout Writeln channel iSeqFile "ERROR" Close_Output channel iSeqFile Send Seq_Release_Channel iSeqFile // If not testmode delete any cache files. If (Trim(sTestMode) <> "YES") Begin // For DAC drivers Move (sFiledir + "*.cch") to sFileout Get create U_cDirectory to hDir Get SearchSingleDirectory of hDir sFileOut DIRMODE_FILES_ONLY to iNoOfFiles Decrement iNoOfFiles For iItem from 0 to iNoOfFiles Get SearchResult of hDir item iItem LIST_FILENAME to sFileout Move (sFiledir + sFileout) to sFileout Get FileDelete sFileout to bDeleteOk Loop Send destroy of hDir // Wva Fix: For Mertech data drivers Move (sFiledir + "*.td") to sFileout Get create U_cDirectory to hDir Get SearchSingleDirectory of hDir sFileOut DIRMODE_FILES_ONLY to iNoOfFiles Decrement iNoOfFiles For iItem from 0 to iNoOfFiles Get SearchResult of hDir item iItem LIST_FILENAME to sFileout Move (sFiledir + sFileout) to sFileout Get FileDelete sFileout to bDeleteOk Loop Send destroy of hDir End // Check to see if the databasefiles are in use. // This is commented out so it is possible to make updates on databases that are partial opened. // I.e. shared database files that is not needed to be updated. // Get noexclusiveaccess to retval // If (retval = 1) Begin // Move "The databasefiles are in use! One or more users have access to the database " to sMessage // Append sMessage "and therefore the databasefiles cannot be updated. " // Append sMessage "Please terminate all applications that are using the databasefiles. The update is aborted!" // Send stop_box sMessage "Exclusive access is not possible." // If (pAbort(Self)) Abort // End // If (retval = 2) Begin // Move "One ore more databasefiles listed in the filelist are not found or corrupt! " to sMessage // Append sMessage "The update is aborted!" // Send stop_box sMessage "Missing or corrupt databasefiles." // If (pAbort(Self)) Abort // End // Run through the directory counting NTA-files for the progressbars sake Get create U_cDirectory to hDir Get SearchSingleDirectory of hDir (sInDir+"*.nta") DIRMODE_FILES_ONLY to iNoOfFiles Set piMaximum of (pStatus(cnt3DBox(Self))) to iNoOfFiles Set piPosition of (pStatus(cnt3DBox(Self))) to 0 Decrement iNoOfFiles // If testmode is on, make a filereport for difference (compare) If (Trim(sTestMode) = "YES") Begin Move (sFiledir + "TESTUPD.TXT") to sFileout Set pTestFile to sFileout Get Seq_New_Channel to iSeqTest Direct_Output channel iSeqTest sFileout Writeln channel iSeqTest "*** UPDATETEST ***" Writeln channel iSeqTest "Date: " dCurrentDate " " iHour ":" iMinute Writeln channel iSeqTest " " Writeln channel iSeqTest "The databasefiles in " strTemp " are tested to match the description files in "sInDir "." Writeln channel iSeqTest "Any changes reported are changes that would have been made to the databasefiles " ; "if they were restructured to match the description files." Writeln channel iSeqTest "Note that none of the reported changes has been effected." Writeln channel iSeqTest " " End // Run through the directory for NTA-files. // NB: There is no need to remember each physical file that has been updated. Of course it would be waste of time // to update the same file twice (or more) when alias files are in use. But the compare routine would return that // the database file does NOT need to be updated because it has already been updated the first time. And the compare // is quite quick. // alias NTA-files. For iItem from 0 to iNoOfFiles Get SearchResult of hDir item iItem LIST_FILENAME to sDirLine Uppercase sDirLine to sDirLine Set piPosition of (pStatus(cnt3DBox(Self))) to iItem Move (sInDir + sDirLine) to dfil Get vFilePathExists dfil to retval If retval Begin Pos ".NTA" in sDirLine Left sDirLine to sLogicalName (strmark -1) Set psActFilename to sLogicalname Move "" to sDatafilePath Move sLogicalName to gsActFile Send DoLoadDescriptionfiles sLogicalName sInDir Send DoLoadKnownIssues sLogicalName sInDir // iFilenum Get CheckDatabasefile sLogicalName (If(Trim(sTestMode) = "YES", True, False)) iSeqTest to iUpdateNeeded If ((iUpdateNeeded > 0) and (Trim(sTestMode) <> "YES")) Begin If ((sLogicalname <> "CODETYPE") and (sLogicalname <> "CODEMAST")) Begin Send DoUpdateDatabasefile sLogicalName End End If (Trim(sTestMode) <> "YES") Begin If ((sLogicalname <> "CODETYPE") and (sLogicalname <> "CODEMAST")) Begin Send DoInitializeFile sLogicalName sInDir // Codetype and Codemast gets initialized later. End End Get string_value of oDatFile item 16 to sRootname Get string_value of oDatFile item 7 to sLogicalName Get string_value of oDatFile item 1 to sDisplayName Get integer_value of oDatFile item 10 to iFilenum Set array_value of oNewFilelist ((iFilenum * 3) + 0) to sRootname Set array_value of oNewFilelist ((iFilenum * 3) + 1) to sLogicalName Set array_value of oNewFilelist ((iFilenum * 3) + 2) to sDisplayname End Set piActFilenumber to 0 Set psActFilename to "" Loop Send destroy of hDir // Initialize codetype and codemast. // This is done here since they may or may not be present in the filelist. If they are not in the filelist (which is normal) // it would not be initialized in the above while-loop. Send DoInitializeFile "CODETYPE" sInDir Send DoInitializeFile "CODEMAST" sInDir // Examine the filelist to see if any files has been renamed or removed acording to the descriptionfiles. // This is only needed in testmode. If (Trim(sTestMode) = "YES") Begin Move -1 to iNewFileNumber // Entry has been renamed or removed from the new filelist Move 0 to iFilenum // Start at top of current filelist Repeat Get_Attribute DF_FILE_NEXT_USED of iFilenum to iFilenum If iFilenum Begin Get_Attribute DF_FILE_LOGICAL_NAME of iFilenum to sLogicalName Trim sLogicalName to sLogicalName Uppercase sLogicalName Get NewFileNumber sLogicalName to iNewFilenumber If (iNewFilenumber = -1) Begin Get_Attribute DF_FILE_ROOT_NAME of iFilenum to sRootname If (Trim(sRootname) <> "FLEXERRS") Begin Writeln channel iSeqTest sLogicalName " has been renamed or removed from the filelist. " Writeln channel iSeqTest " " End End End Until (iFilenum = 0) Writeln channel iSeqTest " " Writeln channel iSeqTest "*** END OF UPDATETEST ***" Close_Output channel iSeqTest Send Seq_Release_Channel iSeqTest End Else Begin // If not in testmode do update the filelist with new entries. // In stead of updating every entry a compare is done to see if the update is needed. // This speeds up the update of the new filelist. // Further more ROOTNAME will only be updated if the filename (and location) has changed regardless of its extention or driver prefix // This makes it possible to update Non-dataflex files based on dataflex file descriptions. // If the rootname exists as an INT file add the driver prefix automatically. In that way it is possible for the desciption file // to have a description Of a native dataflex alias file that needs to connect to a INT file. Set piActFilenumber to 0 Set psActFilename to "FILELIST" Set piPosition of oCallback to 0 Set piMaximum of oCallback to cMaxFilelistEntry For iFilenum from 1 to cMaxFilelistEntry Get string_value of oNewFilelist ((iFilenum * 3) + 0) to sRootname Get RootnameNoID sRootname to sRootname Get_Attribute DF_FILE_ROOT_NAME of iFilenum to sTest Get RootnameNoID sTest to sTest If (sRootname <> sTest) Begin // Check to see if it is needed to add the INT extention automatically. Get_File_Path (sRootname+".INT") to sTest Move (Trim(sTest)) to sTest If (sTest <> "") Begin Get DriverFromINTFile sTest to sDrivername Move (sDrivername + ":" + sRootname) to sRootname End Set_Attribute DF_FILE_ROOT_NAME of iFilenum to sRootname End Get string_value of oNewFilelist ((iFilenum * 3) + 1) to sLogicalName Get_Attribute DF_FILE_LOGICAL_NAME of iFilenum to sTest If (sLogicalName <> sTest) Set_Attribute DF_FILE_LOGICAL_NAME of iFilenum to sLogicalName Get string_value of oNewFilelist ((iFilenum * 3) + 2) to sDisplayname Get_Attribute DF_FILE_DISPLAY_NAME of iFilenum to sTest If (sDisplayname <> sTest) Set_Attribute DF_FILE_DISPLAY_NAME of iFilenum to sDisplayName Set piPosition of oCallback to iFilenum Loop End Set piPosition of (pStatus(cnt3DBox(Self))) to iNoOfFiles Set piPosition of (pWorking(cnt3DBox(Self))) to 100 // For empty records Set piPosition of oCallback to 0 Set piMaximum of oCallback to 100 Set piPosition of oCallback to 100 Sleep 1 Send cursor_ready to (cursor_control(current_object)) Set piActFilenumber to 0 Set psActFilename to "" Set piPosition of (pStatus(cnt3DBox(Self))) to 0 Set piPosition of (pWorking(cnt3DBox(Self))) to 0 Set piPosition of oCallback to 0 Move (sFiledir + "OPDSTAT.TXT") to sFileout Get Seq_New_Channel to iSeqFile Direct_Output channel iSeqFile sFileout Writeln channel iSeqfile "OK" Close_Output channel iSeqfile Send Seq_Release_Channel iSeqFile End Send DoClearPaths of hoWorkspace // Redirect errormessages back to the original errorobject Get OldErrId to hId Move hId to Error_object_Id End_Procedure Procedure Error_report Integer iErrorNumber Integer iLinenumber String Error_mess // Our own error-handler Integer hId iSendFurther retval Integer iFilenumber String sHead sMessage sFilename If (error_processing_state(Self)) Procedure_Return // An error is already being taking care off Set error_processing_state to True If (iErrorNumber = 4285) Begin // Attempt to access unsupported attribute Set error_processing_state to True Procedure_Return End Send cursor_ready to (cursor_control(current_object)) Get piActFilenumber to iFilenumber Get psActFilename to sFilename Move "Updateerror" to sHead Move "An error occurred during the update. " to sMessage Append sMessage (Character(13)) (Character(10)) "File: " iFilenumber " - " sFilename Append sMessage (Character(13)) (Character(10)) "Status: " iErrorNumber Get OldErrId to hId Get Error_Description of hId iErrorNumber Error_mess to Error_mess Append sMessage (Character(13)) (Character(10)) "Text: " Error_mess Repeat Get Message_Box sMessage sHead MB_ABORTRETRYIGNORE MB_ICONERROR to retval If (retval = MBR_ABORT) Abort // retry has been disabled. Until (retval = MBR_IGNORE) // if iSendFurther begin // get OldErrId to hId // send Error_report to hId Error_info Error_mess // set ovffejl to 1 // end Send cursor_wait to (cursor_control(current_object)) Set Error_processing_state to False End_Procedure Procedure DoLoadDescriptionFiles String sLogicalName String sFilePath Integer oDatFile oDatField oDatIndex oDatIndexType oDatIndexNrSeg Integer i icnt iIndexBase iActIndex iActSegment iSegmentBase iSeqFile String sFilename sLine sID sV1 sV2 sV3 iTmp Move (aDatFile(Self)) to oDatFile Move (aDatField(Self)) to oDatField Move (aDatIndex(Self)) to oDatIndex Move (aDatIndexType(Self)) to oDatIndexType Move (aDatIndexNrSeg(Self)) to oDatIndexNrSeg Send Delete_data to oDatFile Send Delete_data to oDatField Send Delete_data to oDatIndex Send Delete_data to oDatIndexType Send Delete_data to oDatIndexNrSeg For iActIndex From 1 to 16 Set array_value of oDatIndexNrSeg Item iActIndex to 0 Loop Move (sFilePath + sLogicalname + ".NTA") to sFilename Get Seq_New_Channel to iSeqFile Direct_Input Channel iSeqFile sFilename Send DoGetLineFromFile iSeqFile 1 While (not(Seqeof)) Get pID to sID Get pV1 to sV1 If (sID = "COMPRESSION") Set array_value of oDatFile Item 0 to sV1 If (sId = "DISPLAY NAME") Set array_value of oDatFile Item 1 to sV1 If (sId = "DRIVER") Set array_value of oDatFile Item 2 to sV1 If (sId = "INTEGRITY CHECK") Set array_value of oDatFile Item 3 to sV1 If (sId = "SYSTEM FILE") Set array_value of oDatFile Item 4 to sV1 If (sId = "LAST INDEX NUMBER") Set array_value of oDatFile Item 5 to sV1 If (sId = "LOCK TYPE") Set array_value of oDatFile Item 6 to sV1 If (sId = "LOGICAL NAME") Set array_value of oDatFile Item 7 to sV1 If (sId = "MAX RECORDS") Set array_value of oDatFile Item 8 to sV1 If (sId = "MULTIUSER") Set array_value of oDatFile Item 9 to sV1 If (sId = "FILE NUMBER") Set array_value of oDatFile Item 10 to sV1 If (sId = "RECORD IDENTITY") Set array_value of oDatFile Item 12 to sV1 If (sId = "RECORD LENGTH") Set array_value of oDatFile Item 13 to sV1 If (sId = "REUSE DELETED RECORDS") Set array_value of oDatFile Item 14 to sV1 If (sId = "REVISION") Set array_value of oDatFile Item 15 to sV1 If (sId = "ROOT NAME") Set array_value of oDatFile Item 16 to sV1 If (sId = "TRANSACTION") Set array_value of oDatFile Item 17 to sV1 Send DoGetLineFromFile iSeqFile 1 Loop Close_Input Channel iSeqFile Send Seq_Release_Channel iSeqFile Move (sFilePath + sLogicalname + ".NTB") to sFilename Get Seq_New_Channel to iSeqFile Direct_Input Channel iSeqFile sFilename Send DoGetLineFromFile iSeqFile 2 While (not(Seqeof)) Get pID to sID Get pV1 to iActIndex Get pV2 to sV2 calc (iActIndex * cFieldBlock) to iIndexBase If (sID = "NAME") Set array_value of oDatField Item (iIndexBase + 0) to sV2 If (sID = "MAIN INDEX") Set array_value of oDatField Item (iIndexBase + 1) to sV2 If (sID = "LENGTH") Set array_value of oDatField Item (iIndexBase + 2) to sV2 If (sID = "OFFSET") Set array_value of oDatField Item (iIndexBase + 3) to sV2 If (sID = "PRECISION") Set array_value of oDatField Item (iIndexBase + 4) to sV2 If (sID = "RELATED FIELD") Set array_value of oDatField Item (iIndexBase + 5) to sV2 If (sID = "RELATED FILE") Set array_value of oDatField Item (iIndexBase + 6) to sV2 If (sID = "TYPE") Set array_value of oDatField Item (iIndexBase + 7) to sV2 Send DoGetLineFromFile iSeqFile 2 Loop Close_Input Channel iSeqFile Send Seq_Release_Channel iSeqFile Move (sFilePath + sLogicalname + ".NTC") to sFilename Get Seq_New_Channel to iSeqFile Direct_Input Channel iSeqfile sFilename Send DoGetLineFromFile iSeqFile 3 While (not(Seqeof)) Get pID to sID Get pV1 to iActIndex Get pV2 to iActSegment Get pV3 to sV3 Calc ((iActIndex * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase If (sID = "TYPE") Set array_value of oDatIndexType Item iActIndex to sV3 If (sID = "CASE") Set array_value of oDatIndex Item (iSegmentBase + 0) to sV3 If (sID = "DIRECTION") Set array_value of oDatIndex Item (iSegmentBase + 1) to sV3 If (sID = "FIELD") Set array_value of oDatIndex Item (iSegmentBase + 2) to sV3 // Remember the number of segments for each index. Get integer_value of oDatIndexNrSeg Item iActIndex to iTmp If (iTmp < iActSegment) Set array_value of oDatIndexNrSeg Item iActIndex to iActSegment Send DoGetLineFromFile iSeqFile 3 Loop Close_Input Channel iSeqfile Send Seq_Release_Channel iSeqFile End_Procedure Procedure DoGetLineFromFile Integer iSeqFile Integer iVcount String sID sValue Integer i Set pID to "" Set pV1 to "" Set pV2 to "" Set pV3 to "" Read Channel iSeqFile sID Trim sId to sID Uppercase sID Set pId to sID For i From 1 to iVcount Read Channel iSeqfile sValue Trim sValue to sValue If (i = 1) Set pV1 to sValue If (i = 2) Set pV2 to sValue If (i = 3) Set pV3 to sValue Loop Readln channel iSeqFile sValue End_Procedure Procedure DoLoadKnownIssues String sLogicalName String sFilePath //integer iFilenum String filKnownIssues sCommandLine sCommand kp1 kp2 kp3 kp4 kp5 Integer retval iCommaPos iDESTNoOfFields iSRCNoOfFields Integer iActPos oKnownIssues iActItem iSeqFile Move (aKnownIssues(Self)) to oKnownIssues Send delete_data to oKnownIssues Move 0 to iActItem // Find out if there is a "Known Issues"-file for the databasefile. // Get integer_value of (aDatFile(self)) item 11 to iSrcNoOfFields // Get_attribute DF_FILE_NUMBER_FIELDS of iFilenum to iDESTNoOfFields Move (sFilePath + sLogicalName + ".NTK") to filknownissues Get vFilePathExists filknownissues to retval If retval Begin Get Seq_New_Channel to iSeqFile Direct_Input Channel iSeqFile filKNOWNISSUES While (not(Seqeof)) Readln Channel iSeqFile sCommandLine Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to sCommand (iCommaPos-1) Trim sCommand to sCommand Uppercase sCommand to sCommand Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to kp1 (iCommaPos-1) Trim kp1 to kp1 Uppercase kp1 to kp1 Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to kp2 (iCommaPos-1) Trim kp2 to kp2 Uppercase kp2 to kp2 Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to kp3 (iCommaPos-1) Trim kp3 to kp3 Uppercase kp3 to kp3 Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to kp4 (iCommaPos-1) Trim kp4 to kp4 Uppercase kp4 to kp4 Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) Pos "," in sCommandLine to iCommaPos If (not(iCommaPos)) Move (Length(sCommandLine)+1) to iCommaPos Left sCommandLine to kp5 (iCommaPos-1) Trim kp5 to kp5 Uppercase kp5 to kp5 Right sCommandLine to sCommandLine (Length(sCommandLine)-iCommaPos) // Showln sCommand " " kp1 " " kp2 " " kp3 " " kp4 " " kp5 Set array_value of oKnownIssues Item iActItem to sCommand Increment iActItem Set array_value of oKnownIssues Item iActItem to kp1 Increment iActItem Set array_value of oKnownIssues Item iActItem to kp2 Increment iActItem Set array_value of oKnownIssues Item iActItem to kp3 Increment iActItem Set array_value of oKnownIssues Item iActItem to kp4 Increment iActItem Set array_value of oKnownIssues Item iActItem to kp5 Increment iActItem Loop Close_Input Channel iSeqFile Send Seq_Release_Channel iSeqFile End End_Procedure // Returns True if there is more than one integer value difference or // if there is difference in the number of decimals. // Used to see if there are differences in non-dataflex files and dataflex files. Function IsNummericDifference Number nNewValue Number nOldValue Returns Boolean Integer iNewValue iOldValue Number nNewDec nOldDec Move (Integer(nNewValue)) to iNewValue Move (Integer(nOldValue)) to iOldValue If (iNewValue > (iOldValue + 1)) Function_Return True Move (nNewValue - iNewValue) to nNewDec // 0.somevalue (ie 0.4 = room for 4 decimals) Move (nOldValue - iOldValue) to nOldDec // 0.somevalue (ie 0.2 = room for 2 decimals) If (nNewDec <> nOldDec) Function_Return True Function_Return False End_Function // Calculating Overlap start field. Function NewOverlapStart Integer iOverlabField Returns Integer Integer iOffset iLength iCntField iActOffset iMaxItem iNoOfFields iFoundField String sFieldType Get integer_value of aDatField Item ((iOverlabField * cFieldBlock) + 3) to iOffset Move 0 to iFoundField Get item_count of aDatField to iMaxItem Move (iMaxItem - cFieldBlock) to iMaxItem Move (iMaxItem / cFieldBlock) to iNoOfFields Repeat Increment iCntField Get String_value of aDatField Item ((iCntField * cFieldBlock) + 7) to sFieldType If (sFieldType <> "Overlap") Begin Get integer_value of aDatField Item ((iCntField * cFieldBlock) + 3) to iActOffset If (iActOffset <= iOffset) Move iCntField to iFoundField End Until (iActOffset > iOffset or iCntField >= iNoOfFields) Function_Return iFoundField End_Function // Calculating Overlap end field. Function NewOverlapEnd Integer iOverlabField Returns Integer Integer iOffset iLength iCntField iActOffset iMaxItem iNoOfFields iFoundField String sFieldType Get integer_value of aDatField Item ((iOverlabField * cFieldBlock) + 3) to iOffset Get integer_value of aDatField Item ((iOverlabField * cFieldBlock) + 2) to iLength Move (iOffset + iLength) to iOffset Move 0 to iFoundField Get item_count of aDatField to iMaxItem Move (iMaxItem - cFieldBlock) to iMaxItem Move (iMaxItem / cFieldBlock) to iNoOfFields Repeat Increment iCntField Get String_value of aDatField Item ((iCntField * cFieldBlock) + 7) to sFieldType If (sFieldType <> "Overlap") Begin Get integer_value of aDatField Item ((iCntField * cFieldBlock) + 3) to iActOffset If (iActOffset < iOffset) Move iCntField to iFoundField End Until (iActOffset >= iOffset or iCntField >= iNoOfFields) Function_Return iFoundField End_Function // Calculating Overlap start field. Function OldOverlapStart Integer iFilenumber Integer iOverlabField Returns Integer Integer iOffset iCntField iActOffset iMaxItem iNoOfFields iFoundField iFieldType iLength Get_Attribute DF_FIELD_OFFSET of iFilenumber iOverlabField to iOffset Move 0 to iFoundField Get_Attribute DF_FILE_NUMBER_FIELDS of iFilenumber to iNoOfFields Repeat Increment iCntField Get_Attribute DF_FIELD_TYPE of iFilenumber iCntField to iFieldType If (iFieldType <> DF_OVERLAP) Begin Get_Attribute DF_FIELD_OFFSET of iFilenumber iCntField to iActOffset If (iActOffset <= iOffset) Move iCntField to iFoundField End Until (iActOffset > iOffset or iCntField >= iNoOfFields) Function_Return iFoundField End_Function // Calculating Overlap end field. Function OldOverlapEnd Integer iFilenumber Integer iOverlabField Returns Integer Integer iOffset iCntField iActOffset iMaxItem iNoOfFields iFoundField iFieldType iLength Get_Attribute DF_FIELD_OFFSET of iFilenumber iOverlabField to iOffset Get_Attribute DF_FIELD_LENGTH of iFilenumber iOverlabField to iLength Move (iOffset + iLength) to iOffset Move 0 to iFoundField Get_Attribute DF_FILE_NUMBER_FIELDS of iFilenumber to iNoOfFields Repeat Increment iCntField Get_Attribute DF_FIELD_TYPE of iFilenumber iCntField to iFieldType If (iFieldType <> DF_OVERLAP) Begin Get_Attribute DF_FIELD_OFFSET of iFilenumber iCntField to iActOffset If (iActOffset < iOffset) Move iCntField to iFoundField End Until (iActOffset >= iOffset or iCntField >= iNoOfFields) Function_Return iFoundField End_Function // Build a new temp datindex array (new index definition) // If an overlap is used the corresponding fields are used instead. // Underlap fields are converted as a complete field. Procedure DoBuildUpTempDatIndex Integer iIndex Integer iNoOfSegments iSegmentBase iMaxItem iField iActSegment Integer iOverlapStart iOverLapEnd iActOverlapField String sCase sDirection sFieldType Move cSegmentBlock to iMaxItem // segment 0 not used Send Delete_Data of aTempDatIndex Get integer_value of aDatIndexNrSeg Item iIndex to iNoOfSegments For iActSegment From 1 to iNoOfSegments Calc ((iIndex * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Get string_value of aDatIndex Item (iSegmentBase + 0) to sCase Get string_value of aDatIndex Item (iSegmentBase + 1) to sDirection Get integer_value of aDatIndex Item (iSegmentBase + 2) to iField Get string_value of aDatField Item ((iField * cFieldblock) + 7) to sFieldType If (sFieldType = "Overlap") Begin Get NewOverlapStart iField to iOverlapStart Get NewOverlapEnd iField to iOverlapEnd For iActOverlapField From iOverlapStart to iOverlapEnd Get string_value of aDatField ((iActOverlapField * cFieldblock) + 7) to sFieldType If (sFieldType <> "Overlap") Begin Set array_value of aTempDatIndex Item iMaxItem to sCase Increment iMaxItem Set array_value of aTempDatIndex Item iMaxItem to sDirection Increment iMaxItem Set array_value of aTempDatIndex Item iMaxItem to iActOverlapField Increment iMaxItem End Loop End Else Begin Set array_value of aTempDatIndex Item iMaxItem to sCase Increment iMaxItem Set array_value of aTempDatIndex Item iMaxItem to sDirection Increment iMaxItem Set array_value of aTempDatIndex Item iMaxItem to iField Increment iMaxItem End Loop Move (iMaxItem - cSegmentBlock) to iNoOfSegments Move (iNoOfSegments / cSegmentBlock) to iNoOfSegments Set piNoOfSegments of aTempDatIndex to iNoOfSegments End_Procedure Function CheckDatabaseFile String sLogicalName Integer iTest Integer iSeqTest Returns Integer String strTemp strTest sRootname sv sFieldName sDriverName Integer iNewFilenum iOldFileNum Filenum iMaxItem iActItem Integer iLastBackSlash iLength nv oDatFile tstnv iRootFound Integer iDifference iNoOfFields iActPos iNewFieldNumber Integer oDatField iRelField iRelFile iTstRelfield iTstRelFile Integer iNoOfIndex iNoOfSegments iIndexDiff iActSegment iSegmentBase Integer iDmpCnt iNewSegCnt oDatIndexType oDatIndexNrSeg oDatIndex Integer iDatSegMod iSpcNv oDatSegMod iRepDifOk Integer iDFRECNUM iRECNUM iStartField iStartField2 iEndField iEndField2 Integer oTempDatIndex Number nFieldLength1 nFieldLength2 Boolean bUseTempDatIndex Move (aDatFile(Self)) to oDatFile Move (aDatField(Self)) to oDatField Move (aDatIndexType(Self)) to oDatIndexType Move (aDatIndexNrSeg(Self)) to oDatIndexNrSeg Move (aDatIndex(Self)) to oDatIndex Move (aDatSegMod(Self)) to oDatSegMod Send delete_data to oDatSegMod Move (aTempDatIndex(Self)) to oTempDatIndex Move 0 to iDifference Set pNewOrRenamedEntry to False Get OldFileNumber sLogicalName to iOldFilenum Set piActFilenumber to iOldFileNum If (iOldFileNum = -1) Begin // Either the filelist entry is new or the DF_FILE_LOGICAL_NAME has changed. // Check to see if this is a new filelist entry for an existing databasefile (New Alias). // This is also the case for a logical name that has been renamed. Get string_value of oDatFile item 16 to sRootname Get RootFileExists sRootName to iRootFound If iRootFound Begin // An existing databasefile with same Root name has been found // Treat this new (or renamed) entry as an existing entry, so that the databasefile can be updated if needed. // This entry is used as an temporary entry in the existing database while the check database file and update procedure is in // progress. Set pNewOrRenamedEntry to True Get integer_value of oDatFile Item 10 to iOldFileNum Send DoAddTempEntry iOldFileNum If (iTest) Begin Writeln Channel iseqtest sLogicalName " has changed logical name or is an new alias file at file number " iOldFileNum "." Get string_value of oDatFile Item 1 to strTemp Writeln Channel iseqtest sLogicalName ' displayname is "' (toansi(strTemp)) '".' Writeln Channel iseqtest sLogicalName " rootname is " sRootname "." Writeln Channel iseqtest " " End End End If (iOldFileNum <> -1) Begin Move iOldfileNum to Filenum //Open Filenum Mode DF_EXCLUSIVE Open Filenum Mode DF_SHARE // While testing it is not needed to have exclusive access to the database. If (Found) Begin // File has been opened successful Get_Attribute DF_FILE_ROOT_NAME of Filenum to sRootname // Root_name may return the complete path! Move sRootname to strTemp Length strTemp to iLastBackSlash Move iLastBackSlash to iLength Repeat Mid strTemp to strTest 1 iLastBackSlash Decrement iLastBackSlash Until ((strTest = "\") or (iLastBackSlash = -1)) Increment iLastBackSlash Right strTemp to strTemp (iLength - iLastBackSlash) Move strTemp to sRootname // move (strTemp + ".dat") to strTemp // get_file_path strTemp to sDatafilePath // *** FILE definition If (UsesSameDriver(Filenum)) Begin Get_Attribute DF_FILE_COMPRESSION of Filenum to nv Move "" to sv If (nv = DF_FILE_COMPRESS_NONE) Move "None" to sv If (nv = DF_FILE_COMPRESS_FAST) Move "Fast" to sv If (nv = DF_FILE_COMPRESS_STANDARD) Move "Standard" to sv If (nv = DF_FILE_COMPRESS_CUSTOM) Move "Custom" to sv Get string_value of oDatFile Item 0 to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed file compression from " sv " to " strTest ". " End End Get_Attribute DF_FILE_DISPLAY_NAME of Filenum to sv Get string_value of oDatFile Item 1 to strTest If (strTest <> sv) Begin // increment iDifference - The change does not need an update of the databasefile since the filelist // is updated seperately. The database file does not have an information of display name If (iTest) Writeln Channel iseqtest sLogicalName ' has changed file display name from "' (ToAnsi(sv)) '" to "' (toAnsi(strTest)) '". ' End Get_Attribute DF_FILE_DRIVER of Filenum to sDriverName Get string_value of oDatFile Item 2 to strTest // Do not report the difference in driverdatabase since descriptionfiles normally are made on native dataflex files. // If (strTest <> sDriverName) Begin // Increment iDifference // If (iTest) Writeln Channel iseqtest sLogicalName " has changed file drive from " sDriverName " to " strTest ". " // End If (sDriverName = "DATAFLEX") Begin Get_Attribute DF_FILE_INTEGRITY_CHECK of Filenum to nv Move "" to sv If (nv = DFTRUE) Move "Yes" to sv Else Move "No" to sv Get string_value of oDatFile item 3 to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln channel iseqtest sLogicalName " has changed file integrity check from " sv " to " strTest ". " End End Get_Attribute DF_FILE_IS_SYSTEM_FILE of Filenum to nv Move "" to sv If (nv = DFTRUE) Move "Yes" to sv Else Move "No" to sv Get string_value of oDatFile Item 4 to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed system file status from " sv " to " strTest ". " End Get_Attribute DF_FILE_LOCK_TYPE of Filenum to nv Move "" to sv If (nv = DF_LOCK_TYPE_NONE) Move "None" to sv If (nv = DF_LOCK_TYPE_FILE) Move "File" to sv If (nv = DF_LOCK_TYPE_RECORD) Move "Record" to sv Get string_value of oDatFile Item 6 to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin // Report only if dataflex files. Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed file lock type from " sv " to " strTest ". " End End // Difference in DF_FILE_LOGICAL_NAME has caused in -1 in iOldFilenumber // DF_FILE_LOGIN currently not in NTA-definition If (sDriverName = "DATAFLEX") Begin Get_Attribute DF_FILE_MAX_RECORDS of Filenum to nv Get integer_value of oDatFile item 8 to tstnv If (tstnv > nv) Begin If (UsesSameDriver(Filenum)) Begin // Report only if dataflex files. Increment iDifference If (iTest) Begin // Max records is larger in the description. This makes it possible to make an initial max records for // dataflex files // It does not report the change of Writeln channel iSeqTest sLogicalName " has changed file max records from " (String(nv)) " to " (String(tstnv)) ". " End End End End Get_Attribute DF_FILE_MULTIUSER of Filenum to nv Move "" to sv If (nv = DF_FILE_USER_MULTI) Move "Yes" to sv If (nv = DF_FILE_USER_SINGLE) Move "No" to sv Get string_value of oDatFile Item 9 to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed multiuser status from " sv " to " strTest ". " End Get integer_value of oDatFile Item 10 to nv If (nv <> Filenum) Begin // increment iDifference - The change does not need an update of the databasefile since the filelist // is updated seperately. The database file does not have an information of filenumber. If (iTest) Writeln Channel iseqtest sLogicalName " has changed filenumber from " Filenum " to " nv ". " End // DF_FILE_OWNER currently not in NTA-definition // DF_FILE_PHYSICAL_NAME currently not in NTA-definition Get_Attribute DF_FILE_RECORD_IDENTITY of Filenum to sv Move (Integer(sv)) to iDFRECNUM // Will be 0 in dataflex files. Get string_value of oDatFile Item 12 to strTest Move (Integer(strTest)) to iRECNUM If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed record identity from " sv " to " strTest ". " End End Get_Attribute DF_FILE_RECORD_LENGTH of Filenum to sv Get string_value of oDatFile Item 13 to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed record length from " sv " to " strTest ". " End End Get_Attribute DF_FILE_REUSE_DELETED of Filenum to nv Move "" to sv If (nv = DF_FILE_DELETED_NOREUSE) Move "No" to sv If (nv = DF_FILE_DELETED_REUSE) Move "Yes" to sv Get string_value of oDatFile Item 14 to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin // Report only if dataflex files. Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed reuse deleted records from " sv " to " strTest ". " End End Get_Attribute DF_FILE_REVISION of Filenum to sv Get string_value of oDatFile Item 15 to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed file revision from " sv " to " strTest ". " End End Get_Attribute DF_FILE_ROOT_NAME of Filenum to sv Get string_value of oDatFile item 16 to strTest Get RootnameNoID sv to sv Get RootnameNoID strTest to strTest If (strTest <> sv) Begin Get_Attribute DF_FILE_ROOT_NAME of Filenum to sv Get string_value of oDatFile Item 16 to strTest // increment iDifference - The change does not need an update of the databasefile since the filelist // is updated seperately. The database file does not have an information of Rootname. // Further more it should only show the difference if the filename changes regardless of its extention. If (iTest) Writeln Channel iseqtest sLogicalName " has changed file rootname from " sv " to " strTest ". " End Get_Attribute DF_FILE_TRANSACTION of Filenum to nv Move "" to sv If (nv = DF_FILE_TRANSACTION_NONE) Move "None" to sv If (nv = DF_FILE_TRANSACTION_CLIENT_ATOMIC) Move "Client atomic" to sv If (nv = DF_FILE_TRANSACTION_SERVER_ATOMIC) Move "Server atomic" to sv If (nv = DF_FILE_TRANSACTION_SERVER_LOGGED) Move "Server logged" to sv Get string_value of oDatFile Item 17 to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " has changed file transaction from " sv " to " strTest ". " End End // DF_FILE_TYPE currently not in NTA-definition // *** FIELD definition Get_Attribute DF_FILE_NUMBER_FIELDS of Filenum to iNoOfFields For iActPos From 1 to iNoOfFields // Fieldnumber is iActPos Get_Attribute DF_FIELD_NAME of Filenum iActPos to sFieldName Get NewFieldNumber sFieldName to iNewFieldNumber If (iNewFieldNumber <> -1) Begin If (iNewFieldNumber <> 0) Begin // Skip RECNUM and DFRECNUM Trim sFieldName to sFieldname // Uppercase sFieldname // it is allowed to have lowercase characters in fieldnames. Thanks to Nathan Sudell. Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 0) to strTest If (strTest <> sFieldName) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldname " has been renamed to " strTest "." End If (iActPos <> iNewFieldNumber) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "fieldnumber from " iActPos " to " iNewFieldNumber "." End Get_Attribute DF_FIELD_INDEX of Filenum iActPos to sv Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 1) to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "main index from " sv " to " strTest "." End End Get_Attribute DF_FIELD_LENGTH of Filenum iActPos to sv Get string_value of oDatField item ((iNewFieldNumber * cFieldblock) + 2) to strTest If (strTest <> sv) Begin Move 0 to iRepDifOk Move sv to nFieldLength1 Move strTest to nFieldLength2 If (UsesSameDriver(Filenum)) Increment iRepDifOk Else Begin // Date fields and number fields can have difference length between non-dataflex files and dataflex files. // and still hold the information required (ie date fields are 4 length in Pervasive and 6 in dataflex) Get_Attribute DF_FIELD_TYPE of Filenum iActPos to nv Move "" to sv If (nv = DF_ASCII) Move "Ascii" to sv If (nv = DF_BCD) Move "Nummeric" to sv If (nv = DF_DATE) Move "Date" to sv If (nv = DF_TEXT) Move "Text" to sv If (nv = DF_BINARY) Move "Binary" to sv If (nv = DF_OVERLAP) Move "Overlap" to sv Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 7) to strTest If (strTest <> sv) Increment iRepDifOk Else Begin If (sv = "Date") Begin // Do not report the difference on dates. End If (sv = "Nummeric") Begin If (IsNummericDifference(Self, nFieldLength2, nFieldLength1) = True) Increment iRepDifOk End If (sv = "Ascii") Increment iRepDifOk If (sv = "Text") Increment iRepDifOk If (sv = "Binary") Increment iRepDifOk If (sv = "Overlap") Begin // Examine overlap to se if it has chaged start field and end field Get NewOverlapStart iNewFieldNumber to iStartField Get OldOverlapStart Filenum iActPos to iStartField2 If (iStartField <> iStartField2) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "overlap start field from " iStartField2 " to " iStartField "." End Get NewOverlapEnd iNewFieldNumber to iEndField Get OldOverlapEnd Filenum iActPos to iEndField2 If (iEndField <> iEndField2) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "overlap end field from " iEndField2 " to " iEndField "." End End End End If (iRepDifOk > 0) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "field length from " nFieldLength1 " to " nFieldLength2 "." End End Get_Attribute DF_FIELD_OFFSET of Filenum iActPos to sv Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 3) to strTest Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 7) to strTemp If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iDifference If ((iTest) and (strTemp = "OVERLAP")) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "field offset from " sv " to " strTest "." End End Get_Attribute DF_FIELD_PRECISION of Filenum iActPos to sv Get string_value of oDatField item ((iNewFieldNumber * cFieldblock) + 4) to strTest If (strTest <> sv) Begin Move 0 to iRepDifOk Move sv to nFieldLength1 Move strTest to nFieldLength2 If (UsesSameDriver(Filenum)) Increment iRepDifOk Else Begin // Date fields fields can have difference precision values between non-dataflex files and dataflex files. // (ie precision on date fields are 3 length in MSSQL and 0 in dataflex) Get_Attribute DF_FIELD_TYPE of Filenum iActPos to nv If (nv = DF_BCD or nv = DF_OVERLAP) Increment iRepDifOk End If (iRepDifOk > 0) Begin Increment iDifference If (iTest) Writeln channel iseqtest sLogicalName "." sFieldName " has changed " ; "field precision from " sv " to " strTest "." End End Get_Attribute DF_FIELD_RELATED_FIELD of Filenum iActPos to iRelField Get_Attribute DF_FIELD_RELATED_FILE of Filenum iActPos to iRelFile Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 5) to iTstRelField Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 6) to iTstRelFile If ((iTstRelField <> iRelField) or (iTstRelFile <> iRelFile)) Begin Increment iDifference If (iTest) Begin Write Channel iseqtest sLogicalName "." sFieldName " has changed " ; "field relation from " iRelFile "." iRelField " to " iTstRelFile "." iTstRelField If ((iTstRelFile = 0) and (iTstRelField = 0)) Writeln Channel iseqtest " (relation cleared)." Else If ((iRelFile = 0) and (iRelField = 0)) Writeln Channel iseqtest " (new relation)." Else Writeln Channel iseqtest "." End End Get_Attribute DF_FIELD_TYPE of Filenum iActPos to nv Move "" to sv If (nv = DF_ASCII) Move "Ascii" to sv If (nv = DF_BCD) Move "Nummeric" to sv If (nv = DF_DATE) Move "Date" to sv If (nv = DF_TEXT) Move "Text" to sv If (nv = DF_BINARY) Move "Binary" to sv If (nv = DF_OVERLAP) Move "Overlap" to sv Get string_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 7) to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has changed " ; "field type from " sv " to " strTest "." End End End Else Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName "." sFieldName " has been deleted." End Loop // Examine the array to se if any new fields has been added. Get item_count of oDatField to iMaxItem Move 8 to iActItem // 0-7 (recnum - not present in array) While (iActItem < iMaxItem) Get string_value of oDatField Item iActItem to sFieldName Get OldFieldNumber sFieldName Filenum to nv If (nv = -1) Begin Increment iDifference If (iTest) Begin calc (iActItem / cFieldBlock) to iActPos Writeln Channel iseqtest sLogicalName "." sFieldName " has been inserted as field number " iActPos "." Get string_value of oDatField Item (iActItem + 1) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Main index, " sv Get string_value of oDatField Item (iActItem + 2) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Length, " sv Get string_value of oDatField Item (iActItem + 3) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Offset, " sv Get string_value of oDatField Item (iActItem + 4) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Precision, " sv Get string_value of oDatField Item (iActItem + 5) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Related field, " sv Get string_value of oDatField Item (iActItem + 6) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Related file, " sv Get string_value of oDatField Item (iActItem + 7) to sv Writeln Channel iseqtest sLogicalName "." sFieldName " - Type, " sv End End Add cFieldBlock to iActItem Loop // *** INDEX definition Get_Attribute DF_FILE_LAST_INDEX_NUMBER of Filenum to iNoOfIndex For iActPos From 1 to iNoOfIndex // Indexnumber is iActPos Move 0 to iIndexDiff Move False to bUseTempDatIndex For nv From 1 to 16 Set array_value of oDatSegMod Item nv to 0 Loop Get_Attribute DF_INDEX_NUMBER_SEGMENTS of Filenum iActPos to iNoOfSegments // If (not(UsesSameDriver(Filenum))) Begin // If not dataflex file check to see if this is the primary index. If so do not report any changes. If (sDriverName <> "DATAFLEX") Begin // If not dataflex file check to see if this is the primary index. If so do not report any changes. If (iNoOfSegments = 1) Begin Get_Attribute DF_INDEX_SEGMENT_FIELD of Filenum IActPos 1 to sv If (Integer(sv) = iDFRECNUM) Move 0 to iNoOfSegments End If (iNoOfSegments) Begin Send DoBuildUpTempDatIndex iActPos Move True to bUseTempDatIndex End End If (iNoOfSegments) Begin If (bUseTempDatIndex = False) Get integer_value of oDatIndexNrSeg Item iActPos to nv Else Get piNoOfSegments of oTempDatIndex to nv If ((iNoOfSegments <> nv) and (nv <> 0)) Increment iIndexDiff If (nv = 0) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " INDEX " iActPos " has been deleted." End Get_Attribute DF_INDEX_TYPE of Filenum iActPos to iSpcnv Move "" to sv If (iSpcnv = DF_INDEX_TYPE_ONLINE) Move "Online" to sv If (iSpcnv = DF_INDEX_TYPE_BATCH) Move "Batch" to sv Get string_value of oDatIndexType Item iActPos to strTest If (strTest <> sv) Begin Increment iDifference If (iTest) Writeln Channel iseqtest sLogicalName " INDEX " iActPos " has changed " ; "indextype from " sv " to " strTest "." End // If there is a structure difference in the index then dump the old and the new index // It does not make sence to describe the differences since a delete of one segment in the new // index would result in many difference-reports of the next segments. If ((iNoOfSegments = nv) and (nv <> 0)) Begin For iActSegment From 1 to iNoOfSegments If (bUseTempDatIndex = False) Calc ((iActPos * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Else Move (iActSegment * cSegmentBlock) to iSegmentBase Get_Attribute DF_INDEX_SEGMENT_CASE of Filenum IActPos iActSegment to nv Move "" to sv If (nv = DF_CASE_USED) Move "Used" to sv If (nv = DF_CASE_IGNORED) Move "Ignored" to sv If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 0) to strTest Else Get string_value of oTempDatIndex Item (iSegmentBase + 0) to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iIndexDiff End End Get_Attribute DF_INDEX_SEGMENT_DIRECTION of Filenum IActPos iActSegment to nv Move "" to sv If (nv = DF_ASCENDING) Move "Ascending" to sv If (nv = DF_DESCENDING) Move "Descending" to sv If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 1) to strTest Else Get string_value of oTempDatIndex Item (iSegmentBase + 1) to strTest If (strTest <> sv) Increment iIndexDiff Get_Attribute DF_INDEX_SEGMENT_FIELD of Filenum IActPos iActSegment to nv If (bUseTempDatIndex = False) Get integer_value of oDatIndex Item (iSegmentBase + 2) to tstnv Else Get integer_value of oTempDatIndex Item (iSegmentBase + 2) to tstnv If (nv = iDFRECNUM) Move iRECNUM to nv // Make DFRECNUM = RECNUM If (tstnv <> nv) Begin Increment iIndexDiff Get_Attribute DF_FIELD_NAME of Filenum nv to sFieldname Get NewFieldNumber sFieldName to iNewFieldNumber If (iNewFieldNumber = tstnv) Set array_value of oDatSegMod Item iActSegment to 2 End // Examine the field to see if any changes in fieldtype, length or precision // are present. If so, the index needs to be reindexed. // NB. Updated files will ALWAYS be reindexed. This is only to ensure that the // test, does report the change in the index structure. // Do not examine RECNUM here If (tstnv <> 0) Begin Get_Attribute DF_FIELD_TYPE of Filenum nv to iSpcNv Move "" to sv If (iSpcnv = DF_ASCII) Move "Ascii" to sv If (iSpcnv = DF_BCD) Move "Nummeric" to sv If (iSpcnv = DF_DATE) Move "Date" to sv If (iSpcnv = DF_TEXT) Move "Text" to sv If (iSpcnv = DF_BINARY) Move "Binary" to sv If (iSpcnv = DF_OVERLAP) Move "Overlap" to sv Get string_value of oDatField Item ((tstnv * cFieldblock) + 7) to strTest If (strTest <> sv) Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End Get_Attribute DF_FIELD_LENGTH of Filenum nv to sv Get string_value of oDatField Item ((tstnv * cFieldblock) + 2) to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End Else Begin // Date fields and number fields can have difference length between non-dataflex files and dataflex files. // and still hold the information required (ie date fields are 4 length in Pervasive and 6 in dataflex) If (iSpcnv = DF_DATE) Begin // Do not report the difference on dates. End Else If (iSpcnv = DF_BCD) Begin Move sv to nFieldLength1 Move strTest to nFieldLength2 If (IsNummericDifference(Self, nFieldLength2, nFieldLength1) = True) Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End End Else Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End End End Get_Attribute DF_FIELD_PRECISION of Filenum nv to sv Get string_value of oDatField Item ((tstnv * cFieldblock) + 4) to strTest If (strTest <> sv) Begin If (UsesSameDriver(Filenum)) Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End Else Begin // number fields can have different precision between non-dataflex files and dataflex files. // and still hold the information required (ie number fields are 1 left ciffer larger in Pervasive than dataflex files) If (IsNummericDifference(Self, nFieldLength2, nFieldLength1) = True) Begin Increment iIndexDiff Set array_value of oDatSegMod Item iActSegment to 1 End End End End Loop End End // Get integer_value Of oDatIndexNrSeg Item iActPos To nv If (iIndexDiff > 0) Begin Increment iDifference If (iTest) Begin Writeln Channel iseqtest sLogicalName " INDEX " iActPos " has changed structure:" Writeln Channel iseqtest " ************** FROM ************** *************** TO ***************" Writeln Channel iseqtest " Fields Case Direction Fields Case Direction " Writeln Channel iseqtest " ---------------------------------- ----------------------------------" If (bUseTempDatIndex = False) Get integer_value of oDatIndexNrSeg Item iActPos to iNewSegCnt Else Get piNoOfSegments of oTempDatIndex to iNewSegCnt Move iNewSegCnt to iDmpCnt If (iNoOfSegments > iNewSegCnt) Move iNoOfSegments to iDmpCnt For iActSegment From 1 to iDmpCnt If (iActSegment <= iNoOfSegments) Begin Move " " to sv Get_Attribute DF_INDEX_SEGMENT_FIELD of Filenum IActPos iActSegment to nv Get_Attribute DF_FIELD_NAME of Filenum nv to strTest Append sv strTest (Repeat(" ",(15 - (Length(strTest))))) " " Get_Attribute DF_INDEX_SEGMENT_CASE of Filenum IActPos iActSegment to nv If (UsesSameDriver(Filenum)) Begin If (nv = DF_CASE_USED) Append sv "Used " If (nv = DF_CASE_IGNORED) Append sv "Ignored " End Else Append sv "(na) " Get_Attribute DF_INDEX_SEGMENT_DIRECTION of Filenum IActPos iActSegment to nv If (nv = DF_ASCENDING) Append sv "Ascending " If (nv = DF_DESCENDING) Append sv "Descending " Write sv End Else Write " " If (iActSegment <= iNewSegCnt) Begin Move " " to sv If (bUseTempDatIndex = False) Calc ((iActPos * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Else Move (iActSegment * cSegmentBlock) to iSegmentBase If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 2) to nv Else Get string_value of oTempDatIndex Item (iSegmentBase + 2) to nv Get string_value of oDatField Item ((nv * cFieldblock) + 0) to strTest If (nv = 0) Move "RECNUM" to strTest Append sv strTest (Repeat(" ",(15 - (Length(strTest))))) " " If (UsesSameDriver(Filenum)) Begin If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 0) to strTest Else Get string_value of oTempDatIndex Item (iSegmentBase + 0) to strTest Append sv strTest (Repeat(" ",(7 - (Length(strTest))))) " " End Else Append sv "(na) " If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 1) to strTest Else Get string_value of oTempDatIndex Item (iSegmentBase + 1) to strTest Append sv strTest (Repeat(" ",(10 - (Length(strTest))))) " " Get integer_value of oDatSegMod Item iActSegment to nv If (nv = 1) Append sv " (field modification)" If (nv = 2) Append sv " (new field number)" Write sv End Writeln " " Loop End End Loop // Examine the array to se if any new indexes has been added. Get integer_value of oDatFile Item 5 to iNoOfIndex // Last index number For iActPos From 1 to iNoOfIndex Get integer_value of oDatIndexNrSeg Item iActPos to nv Get_Attribute DF_INDEX_NUMBER_SEGMENTS of Filenum iActPos to iNoOfSegments If ((iNoOfSegments = 0) and (nv > 0)) Begin Increment iDifference If (iTest) Begin Writeln Channel iseqtest sLogicalName " INDEX " iActPos " has been added." Writeln Channel iseqtest " ************** NEW *************** " Writeln Channel iseqtest " Fields Case Direction " Writeln Channel iseqtest " ---------------------------------- " Get integer_value of oDatIndexNrSeg Item iActPos to iNewSegCnt For iActSegment From 1 to iNewSegCnt Move " " to sv Calc ((iActPos * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Get string_value of oDatIndex Item (iSegmentBase + 2) to nv Get string_value of oDatField Item ((nv * cFieldblock) + 0) to strTest If (nv = 0) Move "RECNUM" to strTest Append sv strTest (Repeat(" ",(15 - (Length(strTest))))) " " Get string_value of oDatIndex Item (iSegmentBase + 0) to strTest Append sv strTest (Repeat(" ",(7 - (Length(strTest))))) " " Get string_value of oDatIndex Item (iSegmentBase + 1) to strTest Append sv strTest (Repeat(" ",(10 - (Length(strTest))))) " " Writeln sv Loop End End Loop If ((iTest) and (iDifference > 0)) Writeln Channel iseqtest " " // make space between each description of files. If ((iTest) and (iDifference = 0)) Begin Writeln Channel iseqtest sLogicalname " has not changed." Writeln Channel iseqtest " " // make space between each description files. End End Close Filenum End Else Begin // This is a new file. Increment iDifference Get integer_value of oDatFile Item 10 to nv If (iTest) Begin Writeln Channel iseqtest sLogicalName " is a new file that has been added as file number " nv "." Get string_value of oDatFile Item 1 to strTemp Writeln Channel iseqtest sLogicalName ' displayname is "' (toansi(strTemp)) '".' Writeln Channel iseqtest sLogicalName " rootname is " sRootname "." Writeln Channel iseqtest " " // make space between each description files. End End If (pNewOrRenamedEntry(Self)) Begin // The entry examined is a temporary entry, that needs to be removed again. Get integer_value of oDatFile Item 10 to iOldFileNum Send DoRemoveTempEntry iOldFilenum Set pNewOrRenamedEntry to False End Function_Return iDifference End_Function // Calculate the actual length for an overlap field. // Private (Used by DoUpdateDatabasefile) Function CalcOverlapLength Integer iFilenumber Integer iStartField Integer iEndField Returns Integer Integer iLength iNoOfFields iStartOffset iEndOffset iFieldType iCntField iTempField Get_Attribute DF_FIELD_OFFSET of iFilenumber iStartField to iStartOffSet Get_Attribute DF_FILE_NUMBER_FIELDS of iFilenumber to iNoOfFields Move 0 to iEndOffset Move 0 to iTempField Move iEndField to iCntField Repeat Increment iCntField If (iCntField > iNoOffields) Create_Field iFilenumber At iTempField Get_Attribute DF_FIELD_TYPE of iFilenumber iCntField to iFieldType If (iFieldType <> DF_OVERLAP) Begin Get_Attribute DF_FIELD_OFFSET of iFilenumber iCntField to iEndOffset Move (iEndOffset - iStartOffset) to iLength End Until (iEndOffset > 0 or iCntField >= iNoOfFields) If (iTempField <> 0) Delete_Field iFilenumber iTempField Function_Return iLength End_Function Procedure RestructureExistingFields Integer iFileHandle String sDatDriverName Integer iNoOfFields Integer iActPos Integer iNewFieldNumber Integer eCurrentDfType Integer nv Handle oDatField String sFieldName String strTest String sFieldType Move (aDatField(Self)) to oDatField Get_Attribute DF_FILE_NUMBER_FIELDS of iFileHandle to iNoOfFields For iActPos from 1 to iNoOfFields Get_Attribute DF_FIELD_NAME of iFileHandle iActPos to sFieldName Get NewFieldNumber sFieldName to iNewFieldNumber If (iNewFieldNumber <> -1) Begin If (iNewFieldNumber <> 0) Begin // Skip RECNUM and DFRECNUM Get string_value of oDatField item ((iNewFieldNumber * cFieldblock) + 0) to strTest If (sFieldName <> strTest) Set_Attribute DF_FIELD_NAME of iFileHandle iActPos to strTest // If fieldname has been renamed Get string_value of oDatField item ((iNewFieldNumber * cFieldblock) + 7) to sFieldType Get_Attribute DF_FIELD_TYPE of iFileHandle iActPos to eCurrentDfType Case Begin Case (sFieldType = "Ascii") If (eCurrentDfType<>DF_ASCII) Begin Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_ASCII End Case Break Case (sFieldType = "Nummeric") If (eCurrentDfType<>DF_BCD) Begin Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_BCD End Case Break Case (sFieldType = "Date") If (eCurrentDfType<>DF_DATE) Begin Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_DATE End Case Break Case (sFieldType = "Text") If (eCurrentDfType<>DF_TEXT) Begin Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_TEXT End Case Break Case (sFieldType = "Binary") If (eCurrentDfType<>DF_BINARY) Begin Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_BINARY End Case Break Case (sFieldType = "Overlap") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_OVERLAP If (UsesSameDriver(iFileHandle)) Begin Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 2) to nv Set_Attribute DF_FIELD_LENGTH of iFileHandle iActPos to nv Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 3) to nv Set_Attribute DF_FIELD_OFFSET of iFileHandle iActPos to nv End Else Begin Set_Attribute DF_FIELD_LENGTH of iFileHandle iActPos to 1 // Temporary Set_Attribute DF_FIELD_OFFSET of iFileHandle iActPos to 1 // Temporary End Case Break Case End If (sFieldType <> "Overlap" and sFieldType <> "Date") Begin Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 2) to nv Set_Attribute DF_FIELD_LENGTH of iFileHandle iActPos to nv End If (sFieldType = "Nummeric" or sFieldType = "Overlap") Begin Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 4) to nv Set_Attribute DF_FIELD_PRECISION of iFileHandle iActPos to nv End Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 6) to nv Set_Attribute DF_FIELD_RELATED_FILE of iFileHandle iActPos to nv Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 5) to nv Set_Attribute DF_FIELD_RELATED_FIELD of iFileHandle iActPos to nv End End Loop End_Procedure // RestructureExistingFields Procedure DoUpdateDatabasefile String sLogicalName String strTemp strTest sRootname sv sFieldName sDatDriverName sFieldType Integer iNewFilenum iOldFileNum Filenum iMaxItem iActItem Integer iLastBackSlash iLength nv oDatFile tstnv iRootFound Integer iDifference iNoOfFields iActPos iNewFieldNumber Integer oDatField iRelField iRelFile iTstRelfield iTstRelFile Integer iNoOfIndex iNoOfSegments iIndexDiff iActSegment iSegmentBase Integer iDmpCnt iNewSegCnt oDatIndexType oDatIndexNrSeg oDatIndex Integer iDatSegMod iSpcNv oDatSegMod oCallback oWorking Integer iFileHandle iNoOfRecords iNoOfRecords2 Integer iDFRECNUM iPrimaryIndex iStartField iEndField oTempDatIndex Integer iTempField iRestructureOptions Boolean bUseTempDatIndex bDoDelete bDoUpdate Move (aDatFile(Self)) to oDatFile Move (aDatField(Self)) to oDatField Move (aDatIndexType(Self)) to oDatIndexType Move (aDatIndexNrSeg(Self)) to oDatIndexNrSeg Move (aDatIndex(Self)) to oDatIndex Move (aDatSegMod(Self)) to oDatSegMod Move (aTempDatIndex(Self)) to oTempDatIndex Move (pCallback(cnt3DBox(Self))) to oCallback Move (pWorking(cnt3DBox(Self))) to oWorking Set piPosition of oWorking to 0 Set piMaximum of oWorking to 4 Set pNewOrRenamedEntry to False Get OldFileNumber sLogicalName to iOldFilenum If (iOldFileNum = -1) Begin // Either the filelist entry is new or the DF_FILE_LOGICAL_NAME has changed. // Check to see if this is a new filelist entry for an existing databasefile (New Alias). // This is also the case for a logical name that has been renamed. Get string_value of oDatFile Item 16 to sRootname Get RootFileExists sRootName to iRootFound If iRootFound Begin // An existing databasefile with same Root name has been found // Treat this new (or renamed) entry as an existing entry, so that the databasefile can be updated if needed. // This entry is used as an temporary entry in the existing database while the check database file and update procedure is in // progress. Set pNewOrRenamedEntry to True Get integer_value of oDatFile Item 10 to iOldFileNum Send DoAddTempEntry iOldFileNum End End If (iOldFileNum <> -1) Begin Move iOldfileNum to Filenum Open Filenum Mode DF_EXCLUSIVE If (Found) Begin // File has been opened successful Get_Attribute DF_FILE_RECORDS_USED of Filenum to iNoOfRecords Get_Attribute DF_FILE_DRIVER of Filenum to sDatDriverName // The Structure_end command makes .BAD files even though there aren't any dublicate records by // DF_STRUCTEND_OPT_NONE when dealing with dataflex files. Therefore a rebuild of the databasefile is forced through. If (sDatDriverName = "DATAFLEX") Move DF_STRUCTEND_OPT_FORCE to iRestructureOptions Else Move DF_STRUCTEND_OPT_NONE to iRestructureOptions Set piPosition of oWorking to 1 // Start by deleting all indexes. At the end of restructuring the files, indexes are rebuild and reindexed. Move Filenum to iFileHandle Structure_Start iFileHandle sDatDriverName Get_Attribute DF_FILE_LAST_INDEX_NUMBER of iFileHandle to iNoOfIndex For iActPos From 1 to iNoOfIndex Get_Attribute DF_INDEX_NUMBER_SEGMENTS of iFileHandle iActPos to iNoOfSegments If (iNoOfSegments) Begin Move True to bDoDelete If (sDatDriverName = "MSSQLDRV" or sDatDriverName = "SQL_DRV") Begin // Leave RECNUM index alive. If (iNoOfSegments = 1) Begin Get_Attribute DF_FILE_RECORD_IDENTITY of iFileHandle to iDFRECNUM Get_Attribute DF_INDEX_SEGMENT_FIELD of iFileHandle iActPos 1 to nv If (nv = iDFRECNUM) Move False to bDoDelete End End If (bDoDelete = True) Delete_Index iFileHandle iActPos End Loop Structure_End iFileHandle iRestructureOptions "" oCallback Set piPosition of oCallback to 0 Open Filenum Mode DF_EXCLUSIVE Set piPosition of oWorking to 2 Move Filenum to iFileHandle Structure_Start iFileHandle sDatDriverName // Delete old fields, and make sure that the data for the field has been erased. Get_Attribute DF_FILE_NUMBER_FIELDS of iFileHandle to iNoOfFields For iActPos From 1 to iNoOfFields Get_Attribute DF_FIELD_NAME of iFileHandle iActPos to sFieldName Get NewFieldNumber sFieldName to iNewFieldNumber If (iNewFieldNumber = -1) Begin Delete_Field iFileHandle iActPos Move 0 to iActPos // Start over Decrement iNoOfFields End Loop // Add new fields so that they can be modified as existing fields. Get item_count of oDatField to iMaxItem Move 8 to iActItem // 0-7 (recnum - not present in array) While (iActItem < iMaxItem) Get string_value of oDatField Item iActItem to sFieldName Get OldFieldNumber sFieldName iFileHandle to nv If (nv = -1) Begin calc (iActItem / cFieldBlock) to iActPos Get_Attribute DF_FILE_NUMBER_FIELDS of iFileHandle to iNoOfFields If (iActPos > iNoOfFields) Create_Field iFileHandle Else Create_Field iFileHandle At iActPos Set_Attribute DF_FIELD_NAME of iFileHandle iActPos to sFieldName // So that the modify routine can buildup the new field. End Add cFieldBlock to iActItem Loop // Modify the file Set piPosition of oWorking to 3 If (sDatDriverName <> "MSSQLDRV" and sDatDriverName <> "SQL_DRV") Begin Get string_value of oDatFile Item 0 to strTest If (strTest = "None") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_NONE If (strTest = "Fast") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_FAST If (strTest = "Standard") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_STANDARD If (strTest = "Custom") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_CUSTOM End // Only set integrity check if dataflex files. If (sDatDriverName = "DATAFLEX") Begin Get string_value of oDatFile Item 3 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_INTEGRITY_CHECK of iFileHandle to DFTRUE If (strTest = "No") Set_Attribute DF_FILE_INTEGRITY_CHECK of iFileHandle to DFFALSE End Get string_value of oDatFile Item 4 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_IS_SYSTEM_FILE of iFileHandle to DFTRUE If (strTest = "No") Set_Attribute DF_FILE_IS_SYSTEM_FILE of iFileHandle to DFFALSE Get string_value of oDatFile Item 9 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_MULTIUSER of iFileHandle to DF_FILE_USER_MULTI If (strTest = "No") Set_Attribute DF_FILE_MULTIUSER of iFileHandle to DF_FILE_USER_SINGLE // Only set lock type if dataflex files If (sDatDriverName = "DATAFLEX") Begin Get string_value of oDatFile Item 6 to strTest If (strTest = "None") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_NONE If (strTest = "File" or strTest = "Record") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_FILE // If (strTest = "Record") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_RECORD End // Only set max records if dataflex files. If (sDatDriverName = "DATAFLEX") Begin If (UsesSameDriver(iFileHandle)) Begin Get_Attribute DF_FILE_MAX_RECORDS of Filenum to nv Get string_value of oDatFile item 8 to tstnv If (tstnv > nv) Begin Set_Attribute DF_FILE_MAX_RECORDS of iFileHandle to tstnv End End End // Only set reuse deleted space if Dataflex files If (sDatDriverName = "DATAFLEX") Begin Get string_value of oDatFile Item 14 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_REUSE_DELETED of iFileHandle to DF_FILE_DELETED_REUSE If (strTest = "No") Set_Attribute DF_FILE_REUSE_DELETED of iFileHandle to DF_FILE_DELETED_NOREUSE End Get string_value of oDatFile item 17 to strTest If (strTest = "None") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_NONE If (strTest = "Client atomic") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_CLIENT_ATOMIC If (sDatDriverName <> "DATAFLEX") Begin If (strTest = "Server atomic") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_SERVER_ATOMIC If (strTest = "Server logged") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_SERVER_LOGGED End // Modify existing fields Send RestructureExistingFields iFileHandle sDatDriverName // Rearrange Overlap fields for non dataflex files If (not(UsesSameDriver(iFileHandle))) Begin For iActPos From 1 to iNoOfFields Get string_value of oDatField Item ((iActPos * cFieldblock) + 7) to strTest If (strTest = "Overlap") Begin Get NewOverlapStart iActPos to iStartField Get_Attribute DF_FIELD_OFFSET of iFileHandle iStartField to nv Set_Attribute DF_FIELD_OFFSET of iFileHandle iActPos to nv Get NewOverlapEnd iActPos to iEndField Get CalcOverlapLength iFileHandle iStartField iEndField to tstnv Set_Attribute DF_FIELD_LENGTH of iFileHandle iActPos to tstnv End Loop End // Rebuild indexes Set piPosition of oWorking to 3 Get integer_value of oDatFile Item 5 to iNoOfIndex // Last index number Move False to bUseTempDatIndex For iActPos From 1 to iNoOfIndex If (sDatDriverName = "MSSQLDRV") Begin Get_Attribute DF_INDEX_NUMBER_SEGMENTS of iFileHandle iActPos to iNoOfSegments If (iNoOfSegments = 0) Create_Index iFileHandle At tstnv // The new indexnumber is iActPos Get_Attribute DF_FILE_RECORD_IDENTITY of iFileHandle to iDFRECNUM End Else Create_Index iFileHandle At tstnv // The new indexnumber is iActPos If (not(UsesSameDriver(iFileHandle))) Begin Send DoBuildUpTempDatIndex iActPos Move True to bUseTempDatIndex End If (bUseTempDatIndex = False) Get integer_value of oDatIndexNrSeg Item iActPos to iNoOfSegments Else Get piNoOfSegments of oTempDatIndex to iNoOfSegments If (iNoOfSegments > 0) Begin Set_Attribute DF_INDEX_NUMBER_SEGMENTS of iFileHandle iActPos to iNoOfSegments Get string_value of oDatIndexType Item iActPos to strTest If (strTest = "Online") Set_Attribute DF_INDEX_TYPE of iFileHandle iActPos to DF_INDEX_TYPE_ONLINE If (strTest = "Batch") Set_Attribute DF_INDEX_TYPE of iFileHandle iActPos to DF_INDEX_TYPE_BATCH For iActSegment From 1 to iNoOfSegments If (bUseTempDatIndex = False) Calc ((iActPos * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Else Move (iActSegment * cSegmentBlock) to iSegmentBase If (bUseTempDatIndex = False) Get integer_value of oDatIndex Item (iSegmentBase + 2) to nv Else Get integer_value of oTempDatIndex Item (iSegmentBase + 2) to nv If (sDatDriverName = "MSSQLDRV") Begin If (nv = 0) Move iDFRECNUM to nv End Set_Attribute DF_INDEX_SEGMENT_FIELD of iFileHandle IActPos iActSegment to nv If (UsesSameDriver(Filenum)) Begin Get string_value of oDatIndex Item (iSegmentBase + 0) to strTest If (strTest = "Used") Set_Attribute DF_INDEX_SEGMENT_CASE of iFileHandle IActPos iActSegment to DF_CASE_USED If (strTest = "Ignored") Set_Attribute DF_INDEX_SEGMENT_CASE of iFileHandle IActPos iActSegment to DF_CASE_IGNORED End If (bUseTempDatIndex = False) Get string_value of oDatIndex Item (iSegmentBase + 1) to strTest Else Get string_value of oTempDatIndex Item (iSegmentBase + 1) to strTest If (strTest = "Ascending") Set_Attribute DF_INDEX_SEGMENT_DIRECTION of iFileHandle IActPos iActSegment to DF_ASCENDING If (strTest = "Descending") Set_Attribute DF_INDEX_SEGMENT_DIRECTION of iFileHandle IActPos iActSegment to DF_DESCENDING Loop End Loop // Now delete indexes that does not contain any segments in the description file. // Indexes with no segments were created just to get the next indexes created at the right place. For iActPos From 1 to iNoOfIndex Get integer_value of oDatIndexNrSeg Item iActPos to iNoOfSegments If (iNoOfSegments = 0) Begin Move True to bDoDelete If (sDatDriverName = "MSSQLDRV" or sDatDriverName = "SQL_DRV") Begin Get_Attribute DF_INDEX_NUMBER_SEGMENTS of iFileHandle iActPos to iNoOfSegments If (iNoOfSegments = 1) Begin Get_Attribute DF_FILE_RECORD_IDENTITY of iFileHandle to iDFRECNUM Get_Attribute DF_INDEX_SEGMENT_FIELD of iFileHandle iActPos 1 to nv If (nv = iDFRECNUM) Move False to bDoDelete End End If (bDoDelete = True) Delete_Index iFileHandle iActPos End Loop // Modify fieldsetting for Field indexes. Has to be set after the rebuilding of indexes Set piPosition of oWorking to 4 Get_Attribute DF_FILE_NUMBER_FIELDS of iFileHandle to iNoOfFields For iActPos From 1 to iNoOfFields Get_Attribute DF_FIELD_NAME of iFileHandle iActPos to sFieldName Get NewFieldNumber sFieldName to iNewFieldNumber If (iNewFieldNumber <> -1) Begin Move True to bDoUpdate If (sDatDriverName = "MSSQLDRV") Begin Get_Attribute DF_FIELD_TYPE of iFileHandle iActPos to nv If (nv = DF_OVERLAP) Move False to bDoUpdate End If (bDoUpdate = True) Begin Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 1) to nv Set_Attribute DF_FIELD_INDEX of iFileHandle iActPos to nv End End Loop If (sDatDriverName = "DATAFLEX") Begin Get integer_value of oDatFile Item 13 to nv Set_Attribute DF_FILE_RECORD_LENGTH of iFileHandle to nv End Structure_End iFileHandle iRestructureOptions "" oCallback Set piPosition of oCallback to 0 Open Filenum Mode DF_EXCLUSIVE Get_Attribute DF_FILE_RECORDS_USED of Filenum to iNoOfRecords2 If (iNoOfRecords <> iNoOfRecords2) Error 950 End Close Filenum End Else Begin // This is a new file //Get string_value of oDatFile Item 2 to sDatDriverName Move "DATAFLEX" to sDatDriverName // For now always make new files as dat files. Set piPosition of oWorking to 4 // Add new files, its fields and indexes. Move 0 to iFileHandle // The new file is assigned the next free filenumber, but the filelist is corrected later. Structure_Start iFileHandle sDatDriverName Get string_value of oDatFile item 16 to strTest // Rootname Get RootnameNoID strTest to strTest Set_Attribute DF_FILE_PHYSICAL_NAME of iFileHandle to strTest // Header info. Get string_value of oDatFile Item 0 to strTest If (strTest = "None") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_NONE If (strTest = "Fast") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_FAST If (strTest = "Standard") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_STANDARD If (strTest = "Custom") Set_Attribute DF_FILE_COMPRESSION of iFileHandle to DF_FILE_COMPRESS_CUSTOM Get string_value of oDatFile Item 3 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_INTEGRITY_CHECK of iFileHandle to DFTRUE If (strTest = "No") Set_Attribute DF_FILE_INTEGRITY_CHECK of iFileHandle to DFFALSE Get string_value of oDatFile Item 4 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_IS_SYSTEM_FILE of iFileHandle to DFTRUE If (strTest = "No") Begin Set_Attribute DF_FILE_IS_SYSTEM_FILE of iFileHandle to DFFALSE // Only set max records if dataflex files. If (sDatDriverName = "DATAFLEX") Begin Get string_value of oDatFile item 8 to tstnv If (tstnv > |CI$00feffff) Move |CI$00feffff to tstnv Set_Attribute DF_FILE_MAX_RECORDS of iFileHandle to tstnv End // Only set reuse deleted space if Dataflex files If (sDatDriverName = "DATAFLEX") Begin Get string_value of oDatFile item 14 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_REUSE_DELETED of iFileHandle to DF_FILE_DELETED_REUSE If (strTest = "No") Set_Attribute DF_FILE_REUSE_DELETED of iFileHandle to DF_FILE_DELETED_NOREUSE End End Get string_value of oDatFile Item 9 to strTest If (strTest = "Yes") Set_Attribute DF_FILE_MULTIUSER of iFileHandle to DF_FILE_USER_MULTI If (strTest = "No") Set_Attribute DF_FILE_MULTIUSER of iFileHandle to DF_FILE_USER_SINGLE Get string_value of oDatFile Item 6 to strTest If (strTest = "None") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_NONE If (strTest = "File" or strTest = "Record") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_FILE // If (strTest = "Record") Set_Attribute DF_FILE_LOCK_TYPE of iFileHandle to DF_LOCK_TYPE_RECORD Get string_value of oDatFile item 17 to strTest If (strTest = "None") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_NONE If (strTest = "Client atomic") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_CLIENT_ATOMIC If (sDatDriverName <> "DATAFLEX") Begin If (strTest = "Server atomic") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_SERVER_ATOMIC If (strTest = "Server logged") Set_Attribute DF_FILE_TRANSACTION of iFileHandle to DF_FILE_TRANSACTION_SERVER_LOGGED End // Fields Get item_count of oDatField to iMaxItem Move 8 to iActItem // 0-7 (recnum - not present in array) While (iActItem < iMaxItem) calc (iActItem / cFieldBlock) to iActPos Move iActPos to iNewFieldNumber Create_Field iFileHandle Get string_value of oDatField Item iActItem to sFieldName Set_Attribute DF_FIELD_NAME of iFileHandle iActPos to sFieldName Get string_value of oDatField item ((iNewFieldNumber * cFieldblock) + 7) to sFieldType If (sFieldType = "Ascii") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_ASCII If (sFieldType = "Nummeric") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_BCD If (sFieldType = "Date") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_DATE If (sFieldType = "Text") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_TEXT If (sFieldType = "Binary") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_BINARY If (sFieldType = "Overlap") Set_Attribute DF_FIELD_TYPE of iFileHandle iActPos to DF_OVERLAP Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 2) to nv Set_Attribute DF_FIELD_LENGTH of iFileHandle iActPos to nv If (sFieldType = "Overlap") Begin Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 3) to nv Set_Attribute DF_FIELD_OFFSET of iFileHandle iActPos to nv End If (sFieldType = "Nummeric" or sFieldType = "Overlap") Begin // In some cases it does not set the field length correctly for text fields if the field precision is set also. // That is also the case even if field precision is set to 0! Get integer_value of oDatField item ((iNewFieldNumber * cFieldblock) + 4) to nv Set_Attribute DF_FIELD_PRECISION of iFileHandle iActPos to nv End // WvA fix: // Some drivers like this to be set in the order file, field. Get integer_value Of oDatField Item ((iNewFieldNumber * cFieldblock) + 6) To nv Set_Attribute DF_FIELD_RELATED_FILE Of iFileHandle iActPos To nv Get integer_value of oDatField Item ((iNewFieldNumber * cFieldblock) + 5) to nv Set_Attribute DF_FIELD_RELATED_FIELD of iFileHandle iActPos to nv Add cFieldBlock to iActItem Loop // Indexes Get integer_value of oDatFile Item 5 to iNoOfIndex // Last index number For iActPos From 1 to iNoOfIndex Create_Index iFileHandle At tstnv // The new indexnumber is iActPos Get integer_value of oDatIndexNrSeg Item iActPos to iNoOfSegments If (iNoOfSegments > 0) Begin Set_Attribute DF_INDEX_NUMBER_SEGMENTS of iFileHandle iActPos to iNoOfSegments Get string_value of oDatIndexType Item iActPos to strTest If (strTest = "Online") Set_Attribute DF_INDEX_TYPE of iFileHandle iActPos to DF_INDEX_TYPE_ONLINE If (strTest = "Batch") Set_Attribute DF_INDEX_TYPE of iFileHandle iActPos to DF_INDEX_TYPE_BATCH For iActSegment From 1 to iNoOfSegments Calc ((iActPos * cSegmentMax * cSegmentBlock) + (iActSegment * cSegmentBlock)) to iSegmentBase Get integer_value of oDatIndex Item (iSegmentBase + 2) to nv Set_Attribute DF_INDEX_SEGMENT_FIELD of iFileHandle IActPos iActSegment to nv Get string_value of oDatIndex Item (iSegmentBase + 0) to strTest If (strTest = "Used") Set_Attribute DF_INDEX_SEGMENT_CASE of iFileHandle IActPos iActSegment to DF_CASE_USED If (strTest = "Ignored") Set_Attribute DF_INDEX_SEGMENT_CASE of iFileHandle IActPos iActSegment to DF_CASE_IGNORED Get string_value of oDatIndex Item (iSegmentBase + 1) to strTest If (strTest = "Ascending") Set_Attribute DF_INDEX_SEGMENT_DIRECTION of iFileHandle IActPos iActSegment to DF_ASCENDING If (strTest = "Descending") Set_Attribute DF_INDEX_SEGMENT_DIRECTION of iFileHandle IActPos iActSegment to DF_DESCENDING Loop End Loop // Modify fieldsetting for Field indexes. Has to be set after the rebuilding of indexes Get_Attribute DF_FILE_NUMBER_FIELDS of iFileHandle to iNoOfFields For iActPos From 1 to iNoOfFields Get integer_value of oDatField Item ((iActPos * cFieldblock) + 1) to nv Set_Attribute DF_FIELD_INDEX of iFileHandle iActPos to nv Loop If (sDatDriverName <> "DATAFLEX") Begin Get integer_value of oDatFile item 12 to nv Set_Attribute DF_FILE_RECORD_IDENTITY of iFileHandle to nv End Get integer_value of oDatFile item 13 to nv Set_Attribute DF_FILE_RECORD_LENGTH of iFileHandle to nv Structure_End iFileHandle iRestructureOptions "" oCallback Set piPosition of oCallback to 0 // Open iFileHandle mode DF_EXCLUSIVE // Provoke an error if there is something wrong with the new datfile. // Close iFileHandle // Find the new filenumber first! End If (pNewOrRenamedEntry(Self)) Begin // The entry examined is a temporary entry, that needs to be removed again. Get integer_value of oDatFile Item 10 to iOldFileNum Send DoRemoveTempEntry iOldFilenum Set pNewOrRenamedEntry to False End Set piPosition of oWorking to 0 Set piMaximum of oWorking to 100 End_Procedure // Initialize the new datafile with initializingdata if those are present. // If a record already exist it will only be overridden if FORCE INIT has been // selected for the current record. // Check to see if there is an initialize-file for the databasefile. Procedure DoInitializeFile String sLogicalName String sFilePath String filinit strTest strTemp Integer retval oWorking iIndexnumber iNoInitRecords iReadFields Integer iFilenum iOldFilenum oInitIndexMark oInitData Integer iActPos iSegment iNumSegments iFieldNumber iNoOfFields n Integer iForceInit iFieldFound iSrchField Integer iSeqfile Move (pWorking(cnt3DBox(Self))) to oWorking Move (aInitdata(Self)) to oInitData Move (aInitIndexMark(Self)) to oInitIndexMark Move (sFilePath + sLogicalName + ".NTI") to filinit Get vFilePathExists filinit to retval If retval Begin Get OldFileNumber sLogicalName to iOldFilenum // Eventhough codetype and codemast might be present in the filelist, they are opened directly here // so they can be initialized whether or not the are present in the filelist. If ((iOldFileNum <> -1) or (sLogicalName = "CODETYPE") or (sLogicalName="CODEMAST")) Begin Move iOldfileNum to iFilenum If (sLogicalName = "CODETYPE") Begin Open "CODETYPE" as 207 Mode DF_SHARE Move 207 to iFilenum End Else If (sLogicalname = "CODEMAST") Begin Open "CODEMAST" as 208 Mode DF_SHARE Move 208 to iFilenum End Else Begin Open iFilenum Mode DF_SHARE End Set piPosition of oWorking to 0 Get Seq_New_Channel to iSeqfile Direct_Input Channel iSeqFile filINIT Readln Channel iSeqFile iIndexnumber iNoInitRecords iReadFields // If there hasn't been indicated an index this will be 0 (RECNUM). Set piMaximum of oWorking to iNoInitRecords Get_Attribute DF_INDEX_NUMBER_SEGMENTS of iFilenum iIndexnumber to iNumSegments Get_Attribute DF_FILE_NUMBER_FIELDS of iFilenum to iNoOfFields Send delete_data to oInitIndexMark Send delete_data to oInitData For iActPos From 1 to iNoOfFields Set array_value of oInitIndexMark Item iActPos to 0 // Initialiser Loop For iSegment From 1 to iNumSegments Get_Attribute DF_INDEX_SEGMENT_FIELD of iFilenum iIndexnumber iSegment to iFieldnumber Set array_value of oInitIndexMark Item iFieldnumber to 1 Loop Move 1 to n While (n =< iNoInitRecords) // For n From 1 to iNoInitRecords For iActPos From 1 to iNoOfFields Set array_value of oInitData Item iActPos to "" Loop Readln Channel iSeqFile iForceInit For iActPos From 1 to iReadFields Readln Channel iSeqFile strTest Trim strTest to strTest Move 0 to iFieldFound Move 1 to iSrchField While ((iSrchField =< iNoOfFields) and (iFieldFound = 0)) // Get String_value of oFields item (iSrchField*cFieldBlock) to strTemp Get_Attribute DF_FIELD_NAME of iFilenum iSrchField to strTemp If (Trim(strTemp) = strTest) Move iSrchField to iFieldFound Increment iSrchField Loop Readln Channel iSeqfile strTemp Set array_value of oInitData Item iFieldFound to strTemp Loop Clear iFilenum For iActPos From 1 to iNoOfFields Get integer_value of oInitIndexMark Item iActPos to retval If retval Begin Get string_value of oInitData Item iActPos to strTemp Set_Field_Value iFilenum iActPos to strTemp End Loop Lock // Even though the file has been opened in DF_EXCLUSIVE mode the RULES for // for multi-user integrity still applies and may provoke a status 4155 - // Edit requires reread and find during lock. // Therefore lock/unlock commands. If iIndexnumber Vfind iFilenum iIndexnumber eq Else indicate Found False If ( ((Found=True) and (iForceInit=True)) or (Found=False) ) Begin For iActPos From 1 to iNoOfFields Get integer_value of oInitIndexMark Item iActPos to retval If not retval Begin Get string_value of oInitData Item iActPos to strTemp Set_Field_Value iFilenum iActPos to strTemp End Loop Saverecord iFilenum End Unlock Set piPosition of oWorking to n Increment n Loop Close iFilenum Close_Input Channel iSeqfile Send Seq_Release_Channel iSeqfile Set piMaximum of oWorking to 100 Set piPosition of oWorking to 0 End End End_Procedure Function ExtentionExists Global String sRootname Returns Boolean If not ".INT" in sRootname Begin If not ".DAT" in sRootname Begin Function_Return False End End Function_Return True End_Function // Assume that there is not a rootname.DAT and rootname.INT at the same time! // In that way it is possible for the desciption file to have a description of a native dataflex alias file // that needs to connect to a INT file. Function RootFileExists Global String sRootname Returns Integer String sOk sTestRootname Move "" to sOk Get RootnameNoID sRootname to sTestRootname Get_File_Path (sTestRootname + ".DAT") to sOk If (sOk = "") Begin Get_File_Path (sTestRootname + ".INT") to sOk End Move (Trim(sOk)) to sOk If (sOk <> "") Function_Return 1 Function_Return 0 End_Function Procedure DoAddTempEntry Integer iEntryNumber String sTemp sTest sOk Integer oDatFile Move (aDatFile(Self)) to oDatFile Get_Attribute DF_FILE_ROOT_NAME of iEntryNumber to sTemp Set pSaveRootname to sTemp Get_Attribute DF_FILE_LOGICAL_NAME of iEntryNumber to sTemp Set pSaveLogicalName to sTemp Get_Attribute DF_FILE_DISPLAY_NAME of iEntryNumber to sTemp Set pSaveDisplayName to sTemp Get string_value of oDatFile Item 16 to sTemp // Rootname // Find out if an INT extention is needed. Move (Trim(sTemp)) to sTemp If (ExtentionExists(sTemp) = False) Begin Get_File_Path (sTemp+".DAT") to sOk Move (Trim(sOk)) to sOk If (sOk = "") Begin // If .dat file found extention is not needed, if not found try searching for the .int file Get_File_Path (sTemp+".INT") to sOk Move (Trim(sOk)) to sOk If (sOk <> "") Move (sTemp+".INT") to sTemp End End Set_Attribute DF_FILE_ROOT_NAME of iEntryNumber to sTemp Get string_value of oDatFile Item 7 to sTemp // Logicalname Set_Attribute DF_FILE_LOGICAL_NAME of iEntryNumber to sTemp Get string_value of oDatFile Item 1 to sTemp // Displayname Set_Attribute DF_FILE_DISPLAY_NAME of iEntryNumber to sTemp End_Procedure Procedure DoRemoveTempEntry Integer iEntryNumber String sTemp Get pSaveRootname to sTemp Set_Attribute DF_FILE_ROOT_NAME of iEntryNumber to sTemp Get pSaveLogicalName to sTemp Set_Attribute DF_FILE_LOGICAL_NAME of iEntryNumber to sTemp Get pSaveDisplayName to sTemp Set_Attribute DF_FILE_DISPLAY_NAME of iEntryNumber to sTemp End_Procedure // **WvA jun-14-2007: Add support for driver prefixes // // Takes the root file name of the entry in the filelist and // returns the filename of the file. // The function takes the .INT and .DAT postfixes into account // as well as all the available driver prefixes. // Function FileNameFromRootName String sFilename Returns String String sFile Move (Uppercase(sFileName)) to sFile If (Pos(":",sFile)<>0) Begin // A colon in the name indicates that our rootname contains a driver prefix, remove it. Move (Right(sFile,Length(sFile)-Pos(":",sFile))) to sFile Append sFile ".INT" End If not ".INT" in sFile Append sFile ".DAT" Function_Return sFile End_Function // FileNameFromRootName // Opens the INT file and get the driver_name. // Returns empty if not found. Function DriverFromINTFile String sCurrentFile Returns String String sLine sDriver Integer iSeqFilenumber Boolean bDrvFound Move (Trim(sCurrentFile)) to sCurrentFile Move (Uppercase(sCurrentFile)) to sCurrentFile Move (toAnsi(sCurrentFile)) to sCurrentFile If (sCurrentFile contains ".INT") Begin Move False to bDrvFound Get Seq_New_Channel to iSeqFilenumber Direct_Input Channel iSeqFilenumber sCurrentFile While ((bDrvFound = False) and (not(SeqEof))) Readln sLine If (sLine contains "DRIVER_NAME ") Begin Move (Remove(sLine, 1, 12)) to sDriver Move True to bDrvFound End Loop Close_Input Channel iSeqFilenumber Send Seq_Release_Channel iSeqFilenumber End Function_Return sDriver End_Function