// ************************************************************************
// *** Database maintenance
// ************************************************************************
// *** NtDBmnt.src
// *** Version: 18.2.x
// *** Copyright (c) 2000 - 2006 NordTeam Gruppen
// *** Copyright (c) 2007 -      NOVAX A/S
// ***
// *** Author......: Allan Greis Eriksen
// *** Created.....: 2000-03-16
// *** Last updated: 2018-03-06
// ************************************************************************
Use windows.pkg
Use dfpanel.pkg
Use dferror.pkg
Use dfline.pkg
Use datadict.pkg
Use flexole.pkg
Use cApplication.pkg
Use SelectWorkspace.dg
Use cFilesystem.pkg
Use Std_help.pkg
Use cSWS.pkg
Use Progresspanel.pkg

Set_Argument_Size 1024000

Global_Variable String gsDrivername gsArg1 gsArg2 sCommand kp1 kp2 kp3 kp4 kp5
Global_Variable Integer gidriverFunction giArg giReturnValue giObjectID giSet giFilenr bBufferSet
Global_Variable Integer giBuffSize
Global_Variable Integer giErrorStop
Global_Variable String gsWSFile

Move "DATAFLEX" to gsDrivername
Get make_set to giSet
Object aFilenr is An Array
End_Object
Move 0 to giArg
Move "" to gsArg1
Move 65536 to giBuffSize

Object oFilesystem is a cFilesystem
    Set pbErrorAsVDFError to True
End_Object

// Set the timer for the progressbar to 5000 records instead of default 100 records
Set_Attribute DF_RUNTIME_PROGRESS_FREQUENCY to 5000

// Set max sort buffer to 64 Mb
Call_Driver 0 gsDrivername Function FLEX_SET_MAX_SORT_BUFFER ;
                   Callback giArg ;
                   Passing  gsArg1 gsArg1 giBuffsize ;
                   Result   bBufferSet

Move (aFilenr(Self)) to giFilenr

Function NuDato Desktop Returns Date   
    DateTime dtDato
    Move (CurrentDateTime()) to dtDato
    Function_Return (Date(dtDato))
End_Function

// 8 characters like "09:00:00"
Function NuTidSek Desktop Returns String
    DateTime dtDato                   
    String sTimer sMinutter sSekunder sTid
    Move (CurrentDateTime()) to dtDato
    Move (DateGetHour(dtDato)) to sTimer                      
    Move (Right("0" + sTimer, 2)) to sTid
    Move (DateGetMinute(dtDato)) to sMinutter
    Move (sTid + ":" + Right("0" + sMinutter, 2)) to sTid
    Move (DateGetSecond(dtDato)) to sSekunder
    Move (sTid + ":" + Right("0" + sSekunder, 2)) to sTid
    Function_Return sTid
End_Function

Procedure DoFindWSFile
    String sLinie sFil
    Boolean bFundet
    tsSearchResult[] lsSearchResult
    Get_Current_Directory to sLinie
    Get FileSearch of oFilesystem (sLinie+"\*.ws") DIRMODE_FILES_ONLY to lsSearchResult
    If (SizeOfArray(lsSearchResult) > 0) Begin
        Move (Uppercase(lsSearchResult[0].sFilename)) to sFil
        Move (Replace(".WS", sFil, "")) to gsWSfile
    End
End_Procedure
Send DoFindWSFile


Object oApplication is a cApplication
    Set psCompany to "NOVAX A/S"
    Set psProduct to "NOVAX Database maintenance - open source version"
    Set psVersion to "18.2.1"
    Set pbEnterKeyAsTabKey to True
    Set psAutoOpenWorkspace to ""
    Procedure OnCreate
      String sWorkspace 
      Move gsWSfile to sWorkspace
      If sWorkspace ne "" Send DoOpenWorkspace sWorkspace
    End_Procedure
End_Object


Function FilSti Global String sFilename Returns String
    String sFildir
    Get_File_Path sFileName to sFildir
    Get ExtractFilePath sFildir to sFildir
    If (Right(sFildir, 1) = "\") Begin 
        Move (Left(sFildir, (Length(sFildir) - 1))) to sFildir
    End
    Function_Return sFildir
End_Function


Function TekstIndex Global Handle hFilenum Returns String
    String sTekst
    Integer iLastIndexNumber iCurrentIndex iAntalSegmenter
    Get_Attribute DF_FILE_LAST_INDEX_NUMBER of hFilenum to iLastIndexNumber
    For iCurrentIndex from 1 to iLastIndexNumber
        Get_Attribute DF_INDEX_NUMBER_SEGMENTS of hFilenum iCurrentIndex to iAntalSegmenter
        If (iAntalSegmenter > 0) Begin
            Move (sTekst * String(iCurrentIndex)) to sTekst
        End
    Loop
    Function_Return sTekst
End_Function


Function CheckFilesError Global Integer iExclusiveCheck Returns Integer
    Integer iRetVal AntalFiler iIdx Filenum
    String rootname sSti
    Handle hoWorkspace
    String strWSP strDescription
    Get phoWorkspace of ghoApplication to hoWorkspace
    Get psDescription of hoWorkspace to strDescription
    Get psWorkspaceName of hoWorkspace to strWSP

    Set Statustekst of oUpdateStatusPanel to ("Examine workspace " + strDescription + ".")

    Move 0 to Filenum //Find antallet af filer i filelisten
    Move 0 to gierrorstop
    Send delete_data to giset
    Send delete_data to gifilenr
    Set pAntalDatFiler to 0
    Repeat
        Get_Attribute DF_FILE_NEXT_USED of FileNum to FileNum
        If Filenum Begin
            Get_Attribute DF_FILE_ROOT_NAME of FileNum to Rootname
            Trim rootname to rootname
            Uppercase rootname 
            If (Rootname <> "FLEXERRS" and Left(rootname, 9) <> "MSSQLDRV:") Begin
                Get find_element of giset Rootname to iIdx
                If (iIdx < 0) Begin
                    Get msg_add_element of giset Rootname to iIdx   //Tilf›jer kun nye navne
                    Set array_value of giFilenr item iIdx to FileNum
                End
            End
        End
    Until (FileNum = 0)
    Get item_count of giset to AntalFiler
    Send FileprogresseStatus of oUpdateStatusPanel 0 AntalFiler 0
    Set pAntalDatFiler to Antalfiler

    Move 0 to iIdx
    Move 0 to gierrorstop
    While ((iIdx < Antalfiler) and (giErrorstop <> 1))
        Get string_value of giSet item iIdx to Rootname
        Get integer_value of giFilenr item iIdx to Filenum
        Move 0 to gierrorstop
        If not "." IN Rootname Append rootname ".DAT"
        Move (FilSti(Rootname)) to sSti
        If (sSti = "") Error 907 rootname
        Else Begin
            If iExclusiveCheck Begin
                Open FileNum Mode DF_EXCLUSIVE 0
                If (not(Found)) Error 908 rootname
                Close FileNum
            End
        End
        If (gierrorstop <> 2) Begin
            Increment iIdx
            Send FileprogresseStatus of oUpdateStatusPanel -1 -1 iIdx
        End
    Loop
    If (gierrorstop) Increment iRetVal
    Send FileprogresseStatus of oUpdateStatusPanel 0 100 0
    Function_Return iRetVal
End_Function

Object hoved is a BasicPanel
    Set Location to 18 18
    Set Sysmenu_Icon to True
    Set Minimize_Icon to False
    Set Maximize_Icon to False
    Set View_mode to viewmode_normal
    Set Border_style to Border_Dialog
    Set Size to 115 293
    Set Label to "NOVAX - Database maintenance v18.2.1"

    Property Integer er_aktiveret Public False
    Property Integer pForceRepair Public 0
    Property Integer pAutomode public False
    Property String pCommand public ""
    Property String pParameter1 public ""
    Property Integer pAutoError public 0
    Property Integer OldErrId public 0
    Property Integer Error_processing_state public False
    Property String logdir public ""
    Property Integer pAntalDatFiler public 0   // Number of physical tables

    Set OldErrId to Error_Object_Id
    Move Self to Error_Object_Id

    Object oSWS is a cSWS
    End_Object

    Procedure skriv String sUd
        String sLogdir
        Integer iFilnr
        Get logdir to sLogdir
        Append sLogdir "\ntdbmnt.log"
        Get Seq_New_Channel to iFilnr
        Append_Output Channel iFilnr sLogdir
        Write Channel iFilnr (nudato(Self)) " " (nutidsek(Self)) ">"
        Writeln Channel iFilnr sUd
        Close_Output Channel iFilnr
        Send Seq_Release_Channel iFilnr
    End_Procedure

    Function DeleteAllIndexFiles String sSti String sRootname Returns Boolean
        Boolean bSletOk bFindes
        String sSammenSat
        Integer iIndex
        For iIndex From 1 to 15
            Move (sSti + sRootname + ".K" + (String(iIndex))) to sSammenSat
            Get FileExists of oFilesystem sSammensat to bFindes
            If (bFindes) Begin
                Get FileDelete of oFilesystem sSammenSat to bSletOk
                If (bSletOk = False) Function_Return False
            End
        Loop
        Function_Return True
    End_Function
    
    
    Procedure SetDfOpenPathToCurrentDataFile String sTable
        String sPath
        Get_File_Path sTable to sPath
        Get ExtractFilePath sPath to sPath
        Set_Attribute DF_OPEN_PATH to sPath
    End_Procedure
    
    
    Procedure ResetDfOpenPath
        Handle hoWorkspace
        String sPath
        Get phoWorkspace of ghoApplication to hoWorkspace
        Get psDfPath of hoWorkspace to sPath
        Set_Attribute DF_OPEN_PATH to sPath
    End_Procedure


    Procedure Initalize_new_WS
        String wkspckey strTemp strDFPath strWSP strDescription Rootname sSti sWR sFil
        Integer wkspfejl wkspadgang Filenum AntalFiler iFundet
        Handle hoWorkspace
        Boolean bOk
        Get phoWorkspace of ghoApplication to hoWorkspace
        Move 0 to wkspfejl
        Move 0 to wkspadgang
        Get psDescription of hoWorkspace to strDescription
        Get psWorkspaceName of hoWorkspace to strWSP
        Get psHome of hoWorkspace to sSti

        Send skriv ("Selecting workspace "+strDescription)
        Set enabled_state of (cmdReindex(Self)) to True
        Set enabled_state of (cmdResize(Self)) to True
        Set enabled_state of (cmdRebuild(Self)) to True
        Set enabled_state of (cmdAuto(Self)) to True
        Set enabled_state of (cmdRepair(Self)) to True
        Set enabled_state of (cmdCleanUp(Self)) to True
        Set enabled_state of (cmdDatecheck(Self)) to True
        Set enabled_state of (cmdDoNothing(Self)) to False
        Set Enabled_State of (cmdDoNothing2(Self)) to False
        Set Enabled_State of (cmdDoNothing3(Self)) to False
        
        Move "C:\" to sFil
        Append sFil StrWSP ".CFG"

        // Show the current selected workspace
        Set value of tAktform to strDescription
    End_Procedure

    Object oOpenDialog is a OpenDialog
        Set Dialog_Caption to "Select a Workspace File"
        Set Filter_String to "Workspace Files (*.ws)|*.ws"

        Procedure Default_Initial_Folder
            String sSti
            Handle hoWorkspace
            Get phoWorkspace of ghoApplication to hoWorkspace
            Get psProgramPath of hoWorkspace to sSti
            Set Initial_Folder to sSti
        End_Procedure

        Send Default_Initial_Folder

    End_Object

    Procedure Request_Select_WorkSpace
        Handle hoWorkspace
        Boolean bFileSelected
        String sWorkspaceFile sError
        Integer iFejl
        Move 0 to gierrorstop
        Get phoWorkspace of ghoApplication to hoWorkspace

        Get Show_Dialog of oOpenDialog to bFileSelected
        If (bFileSelected = True) Begin
            Send DoClearPaths of hoWorkspace
            Get File_Name of oOpenDialog to sWorkspaceFile
            Get OpenWorkspaceFile of hoWorkspace sWorkspaceFile to iFejl
            If (iFejl <> wsWorkspaceOpened) Begin
                Get OpenWorkspaceErrorMessage of hoWorkspace iFejl to sError
                Send Stop_Box sError "Error Opening Workspace"
                Move 1 to gierrorstop
            End
            Else Send Initalize_new_WS
        End
    End_Procedure

    // Can open both .SWS and .WS files.
    Procedure DoOpenWSFile
        Handle hoWorkspace
        Boolean eOpened
        String sWorkspace sBesked
        Move 0 to gierrorstop
        Get phoWorkspace of ghoApplication to hoWorkspace
        Send DoClearPaths of hoWorkspace
        Get OpenWorkspaceFile of hoWorkspace gsWSFile to eOpened
        If (eOpened <> wsWorkspaceOpened) Begin
            Get OpenWorkspaceErrorMessage of hoWorkspace eOpened to sBesked
            Send stop_box ("An error occured during opening of "+gsWSFile+"\n"+sBesked)
            Move 1 to gierrorstop
        End
        Else Send Initalize_new_WS
    End_Procedure

    Procedure DoResize
        String Rootname Besked Displayname Logicalname
        Integer Filenum iMaxRec iNumRec StructHandle iNyMaxRec antalFiler
        Integer iDummy iIdx isSysFile
        Send Initialize_StatusPanel of oUpdateStatusPanel "NOVAX - Database maintenance - Resize" "" ""
        Send Start_StatusPanel of oUpdateStatusPanel
        Send cursor_wait to (cursor_control(current_object))
        Send skriv "Resize-process started."
        Get checkFilesError True to iDummy
        If not iDummy Begin
            Get pAntalDatFiler to AntalFiler
            Move 0 to gierrorstop
            Send FileprogresseStatus of oUpdateStatusPanel 0 antalFiler 0
            Move 0 to iIdx
            Move 0 to gierrorstop
            While ((iIdx < Antalfiler) and (giErrorstop <> 1))
                Get string_value of giSet Item iIdx to Rootname
                Get integer_value of giFilenr Item iIdx to Filenum
                Move 0 to gierrorstop
                Get_Attribute DF_FILE_DISPLAY_NAME of FileNum to Displayname
                Set Statustekst of oUpdateStatusPanel to ("Resize examines " + displayname + ".")
                indicate Found False
                If (left(Uppercase(Trim(Rootname)), 9) <> "MSSQLDRV:") Begin
                    Open FileNum Mode DF_EXCLUSIVE
                End
                If (Found) Begin     // Opening the file was a success
                    Get_Attribute DF_FILE_MAX_RECORDS of FileNum to iMaxRec
                    Get_Attribute DF_FILE_RECORDS_USED of FileNum to iNumRec
                    Get_Attribute DF_FILE_IS_SYSTEM_FILE of FileNum to isSysFile
                    If (isSysFile = False) Begin  // Skip systemfiles
                        If ((iNumRec * 1.15) > iMaxRec) Begin   // Almost full (max. 15% left)
                            Set Statustekst of oUpdateStatusPanel to ("Resizing " + displayname + ".")
                            Move FileNum to StructHandle
                            calc (iNumRec * 1.4) to iNyMaxRec   // Max records to 140% of current use.
                            calc (Integer(iNyMaxRec / 100) * 100) to iNyMaxRec  // In the 100's
                            If (iNyMaxRec < 1000) Move 1000 to iNyMaxRec          // At least 1000 records.
                            If (iNyMaxRec <= iMaxRec) Move (iMaxRec + 100) to iNyMaxRec    // If rounding resulted in the same size.
                            Structure_Start StructHandle
                                Set_Attribute DF_FILE_MAX_RECORDS of StructHandle to iNyMaxRec
                            Structure_End StructHandle DF_STRUCTEND_OPT_NONE "" ghoCallbackProgressBar
                            Move "New FileSize to " to besked
                            Append besked (Uppercase(Trim(Rootname))) (Character(13)) (Character(10))
                            Append besked "Changed from " iMaxRec " to " iNyMaxRec
                            Send cursor_ready to (cursor_control(current_object))
                            If (not(pAutoMode(Self))) Begin
                                Send Stop_StatusPanel of oUpdateStatusPanel
                                Send info_box besked
                                Send Start_StatusPanel of oUpdateStatusPanel
                            End
                            Send skriv besked
                            Send cursor_wait to (cursor_control(current_object))
                        End
                    End
                End
                Close FileNum
                If (gierrorstop <> 2) Begin
                    Increment iIdx
                    Send FileprogresseStatus of oUpdateStatusPanel -1 -1 iIdx
                End
            Loop
        End
        If (not(gierrorstop)) Send skriv "Resize-process ended."
        Else Send skriv "Resize-process stopped."
        Send cursor_ready to (cursor_control(current_object))
        Send ClearAllPB of oUpdateStatusPanel
        Send Stop_StatusPanel of oUpdateStatusPanel
    End_Procedure

    Procedure DoRepairPart1
        String Rootname Besked Physicalname Displayname Logicalname
        Integer Filenum iRepok RetVal fundet antalFiler iForce iDummy iIdx
        Send Initialize_StatusPanel of oUpdateStatusPanel "NOVAX - Database maintenance - Repair" "" ""
        Send Start_StatusPanel of oUpdateStatusPanel
        Send cursor_wait to (cursor_control(current_object))
        Send delete_data to giset
        Send skriv "Repair-process started."
        Get checkFilesError False to iDummy
        If not iDummy Begin
            Get pForceRepair to iForce
            Get pAntalDatFiler to AntalFiler
            Move 0 to gierrorstop
            Send FileprogresseStatus of oUpdateStatusPanel 0 antalFiler 0
            Move 0 to iIdx
            Move 0 to gierrorstop
            While ((iIdx < Antalfiler) and (giErrorstop <> 1))
                Get string_value of giSet Item iIdx to Rootname
                Get integer_value of giFilenr Item iIdx to Filenum
                Move 0 to gierrorstop
                Get_Attribute DF_FILE_DISPLAY_NAME of FileNum to Displayname
                Move 0 to giObjectID
                Move "" to gsArg1
                Move "1" to gsArg2  // Do NOT sort the file when in the process of reparing.
                Move 0 to giArg
                Move 0 to giReturnValue
                Set Statustekst of oUpdateStatusPanel to ("Repair examines " + displayname + ".")
                Move 0 to iRepok
                Move rootname to gsArg1
                Call_Driver FileNum gsDrivername Function FLEX_GET_REPAIRS_NEEDED callback giObjectID passing gsArg1 gsArg2 giArg result giReturnValue
                If (giReturnValue = FLEX_HEADER_OK) Begin
                    // Filen is ok, do nothing.
                End
                If (giReturnValue = FLEX_BLOCK0_BAD) Begin
                    // Record definition in the file is defect.
                    Move 1 to iRepok
                    Error 903 rootname

                End
                If (giReturnValue = FLEX_HEADER_BAD) Begin
                    // Header section in the file is defect.
                    Move 1 to iRepok
                    Error 904 rootname
                End
                If (giReturnValue = FLEX_HEADER_INTEGRITY_OFF) Begin
                    // Header_integrity er disabled in the file. No .HDR for the repair.
                End
                If (giReturnValue = FLEX_HEADER_UNREADABLE) Begin
                    // The file cannot be read/controlled and can not be repared.
                    Error 905 rootname
                End
                If ((iRepok > 0) or (iForce = True)) Begin
                    Set Statustekst of oUpdateStatusPanel to ("Repairs " + displayname + ".")
                    Call_Driver FileNum gsDrivername Function FLEX_REPAIR_FILE callback ghoCallbackProgressBar passing gsArg1 gsArg2 giArg result giReturnValue
                    If lasterr eq 4265 Begin
                        Error 906 rootname
                    End
                End

                If (gierrorstop <> 2) Begin
                    Increment iIdx
                    Send FileprogresseStatus of oUpdateStatusPanel -1 -1 iIdx
                End
            Loop
        End
        If (not(gierrorstop)) Send skriv "Repair-process ended."
        Else Send skriv "Repair-process stopped."
        Send cursor_ready to (cursor_control(current_object))
        Send ClearAllPB of oUpdateStatusPanel
        Send Stop_StatusPanel of oUpdateStatusPanel
    End_Procedure

    Procedure DoAutoReindex
        Integer aktFilelist Filenum maxFilelist iSelect antalfiler indextype
        Integer indexnummer SidsteIndex Retval iHandle
        Integer iIdx iDummy
        String Fildir Rootname besked displayname logicalname sFil sIndexes
        Boolean bSletOk
        Send Initialize_StatusPanel of oUpdateStatusPanel "NOVAX - Database maintenance - Autoreindexing" "" ""
        Send Start_StatusPanel of oUpdateStatusPanel
        Send skriv "AutoReindex-process started."
        Get checkFilesError False to iDummy   // Exclusive access is examined from DoResize
        If not iDummy Begin
            Get pAntalDatFiler to AntalFiler
            Send FileprogresseStatus of oUpdateStatusPanel 0 antalfiler 0
            Move 0 to iIdx
            Move 0 to gierrorstop
            While ((iIdx < Antalfiler) and (giErrorstop <> 1))
                Get string_value of giSet Item iIdx to Rootname
                Get integer_value of giFilenr Item iIdx to Filenum
                Move 0 to gierrorstop
                Get_Attribute DF_FILE_DISPLAY_NAME of FileNum to Displayname
                Set Statustekst of oUpdateStatusPanel to ("Auto-Reindex examines " + displayname + ".")
                indicate Found False
                If (left(Uppercase(Trim(Rootname)), 9) <> "MSSQLDRV:") Begin
                    Open FileNum Mode DF_EXCLUSIVE
                End
                If (Found) Begin
                    Get_Attribute DF_FILE_LAST_INDEX_NUMBER of FileNum to Sidsteindex
                    Move "" to sIndexes
                    Move (FilSti(rootname + ".DAT")) to fildir
                    Append fildir "\"
                    Move (fildir + rootname + ".BAD") to sFil
                    Uppercase sFil
                    Get FileDelete of oFilesystem sFil to bSletOk
                    Set Statustekst of oUpdateStatusPanel to ("Auto-Reindex reindexes "+displayname + ".")
                    If Sidsteindex Begin
                        Get DeleteAllIndexFiles fildir rootname to bSletOk
                        Get TekstIndex Filenum to sIndexes
                        If (sIndexes <> "") Begin
                            Send SetDfOpenPathToCurrentDataFile (rootname + ".DAT")
                            Sort Filenum sIndexes ((DF_SORT_OPTION_BAD_DATA_FILE) ior (DF_SORT_OPTION_DUP_DATA_FILE)) ghoCallbackProgressBar
                            Send ResetDfOpenPath
                        End
                    End
                    Send CallbackStatus of oUpdateStatusPanel 0 100 0
                    Get FileExists of oFilesystem sFil to Retval
                    If retval Begin
                        Error 902 displayname
                    End
                    Close FileNum
                End
                If (gierrorstop <> 2) Begin
                    Increment iIdx
                    Send FileprogresseStatus of oUpdateStatusPanel -1 -1 iIdx
                End
            Loop
        End
        If (not(gierrorstop)) Send skriv "AutoReindex-process ended."
        Else Send skriv "AutoReindex-process stopped."
        Send cursor_ready to (cursor_control(current_object))
        Send ClearAllPB of oUpdateStatusPanel
        Send Stop_StatusPanel of oUpdateStatusPanel
    End_Procedure

    Procedure DoCleanUp
        Integer aktFilelist Filenum maxFilelist iSelect antalfiler
        Integer indexnummer SidsteIndex Retval 
        String Fildir Rootname besked displayname logicalname filename
        String sType sLine sDummy sIndexes
        Integer iOrgRecId iDupRecId iDummy iIdx
        Number nDubRec nBadRec
        Boolean bSletOk
        Integer iFilnr
        Send Initialize_StatusPanel of oUpdateStatusPanel "NOVAX - Database maintenance - Clean up" "" ""
        Send Start_StatusPanel of oUpdateStatusPanel
        Send skriv "CleanUp-process started."
        Get checkFilesError True to iDummy
        If not iDummy Begin
            Get pAntalDatFiler to AntalFiler
            Move 0 to gierrorstop
            Send FileprogresseStatus of oUpdateStatusPanel 0 antalfiler 0
            Move 0 to iIdx
            Move 0 to gierrorstop
            While ((iIdx < Antalfiler) and (giErrorstop <> 1))
                Get string_value of giSet Item iIdx to Rootname
                Get integer_value of giFilenr Item iIdx to Filenum
                Move 0 to gierrorstop
                Get_Attribute DF_FILE_DISPLAY_NAME of FileNum to Displayname
                Set Statustekst of oUpdateStatusPanel to ("Oprydning examines " + displayname + ".")
                Move (FilSti(rootname + ".DAT")) to fildir
                Append fildir "\"
                Move (fildir + rootname + ".BAD") to filename
                Uppercase filename
                Get FileExists of oFilesystem filename to Retval
                If retval Begin
                    Move 0 to nDubRec
                    Move 0 to nBadRec
                    Get Seq_New_Channel to iFilnr
                    Direct_Input Channel iFilnr filename
                    Repeat
                        Read Channel iFilnr sType
                        Trim sType to sType
                        If (sType = "DUPLICATE") Begin
                            Read Channel iFilnr iOrgRecid
                            Readln Channel iFilnr iDupRecId
                            If ((not(Seqeof)) and (iOrgRecId <> 0) and (iDupRecId <> 0)) Increment nDubRec
                        End
                        Else If (sType = "BAD") Begin
                            Readln Channel iFilnr sDummy
                            If (not(Seqeof)) Increment nBadRec
                        End
                        Else Readln sDummy  //Kan v‘re field dump i hexform
                    Until (Seqeof)
                    Close_Input Channel iFilnr
                    Send Seq_Release_Channel iFilnr
                    Move "" to besked
                    If (nDubRec <> 0) Begin
                        Append besked "The table "
                        Append besked displayname " contains " nDubRec " chain(s) with dublicate records. " (Character(13)) (Character(10)) (Character(13)) (Character(10))
                    End
                    If (nBadRec <> 0) Begin
                        Append besked "The table "
                        Append besked displayname " contains " nBadRec " record(s) with invalid data. " (Character(13)) (Character(10)) (Character(13)) (Character(10))
                    End
                    Append besked "Clean up this file?"
                    If (nDubRec > 2) Begin
                        Append besked (Character(13)) (Character(10)) (Character(13)) (Character(10))
                        Append besked "WARNING! Since there are more than 2 chains with dublicate records in the file "
                        Append besked "the function REPAIR should be processed before attempting a clean up." 
                    End
                    Send Stop_StatusPanel of oUpdateStatusPanel
                    Get yesno_box besked "Error in records" to RetVal
                    Send Start_StatusPanel of oUpdateStatusPanel
                    If (RetVal = MBR_YES) Begin
                        Open FileNum Mode DF_EXCLUSIVE
                        If (nBadRec <> 0) Begin
                            Set Statustekst of oUpdateStatusPanel to ("Cleaning up in "+displayname+".")
                            Get TekstIndex Filenum to sIndexes
                            If (sIndexes <> "") Begin
                                Send SetDfOpenPathToCurrentDataFile (rootname + ".DAT")
                                Sort Filenum sIndexes DF_SORT_OPTION_BAD_DATA_FIXUP ghoCallbackProgressBar
                                Send ResetDfOpenPath
                            End
                            Get FileDelete of oFilesystem Filename to bSletOk
                            Get DeleteAllIndexFiles fildir rootname to bSletOk
                            Send SetDfOpenPathToCurrentDataFile (rootname + ".DAT")
                            Sort Filenum "" DF_SORT_OPTION_DUP_DATA_FILE ghoCallbackProgressBar
                            Send ResetDfOpenPath
                            Send CallbackStatus of oUpdateStatusPanel 0 100 0
                            Get FileExists of oFilesystem filename to Retval
                            If retval Begin
                                Error 902 displayname
                            End
                        End
                        Get Seq_New_Channel to iFilnr
                        Direct_Input Channel iFilnr filename
                        Repeat
                            Read Channel iFilnr sType
                            Trim sType to sType
                            If (sType = "DUPLICATE") Begin
                                Read Channel iFilnr iOrgRecid
                                Readln Channel iFilnr iDupRecId
                                If ((not(Seqeof)) and (iOrgRecId <> 0) and (iDupRecId <> 0)) Begin
                                    Clear FileNum
                                    Set_Field_Value FileNum 0 to iDupRecId
                                    Vfind FileNum 0 2    // Find EQ via recnum
                                    If (Found) Delete FileNum
                                End
                            End
                            Else If (sType = "BAD") Begin
                                Readln Channel iFilnr sDummy
                            End
                            Else Readln channel iFilnr sDummy  // Can be field dump in hex form.
                        Until (Seqeof)
                        Close FileNum
                        Close_Input Channel iFilnr
                        Send Seq_Release_Channel iFilnr
                        Open FileNum Mode DF_EXCLUSIVE
                        Get FileDelete of oFilesystem Filename to bSletOk
                        Set Statustekst of oUpdateStatusPanel to ("Clean up is reindexing "+displayname+".")
                        Get DeleteAllIndexFiles fildir rootname to bSletOk
                        Get TekstIndex Filenum to sIndexes
                        If (sIndexes <> "") Begin
                            Send SetDfOpenPathToCurrentDataFile (rootname + ".DAT")
                            Sort Filenum sIndexes (DF_SORT_OPTION_BAD_DATA_FILE ior DF_SORT_OPTION_DUP_DATA_FILE) ghoCallbackProgressBar
                            Send ResetDfOpenPath
                        End
                        Send CallbackStatus of oUpdateStatusPanel 0 100 0
                        Get FileExists of oHtmlHelp filename to Retval
                        If retval Begin
                            Error 902 displayname
                        End
                        Close FileNum
                    End
                End
                If (gierrorstop <> 2) Begin
                    Increment iIdx
                    Send FileprogresseStatus of oUpdateStatusPanel -1 -1 iIdx
                End
            Loop
        End
        If (not(gierrorstop)) Send skriv "CleanUp-process ended."
        Else Send skriv "CleanUp-process stopped."
        Send cursor_ready to (cursor_control(current_object))
        Send ClearAllPB of oUpdateStatusPanel
        Send Stop_StatusPanel of oUpdateStatusPanel
    End_Procedure

    Procedure DoReadLine Integer iFilnr
        String sCommandLine
        Integer iCommaPos
        Readln Channel iFilnr 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)
    End_Procedure

    Procedure DoShowLog
        String sLogDir
        Get logdir to sLogdir
        Append sLogdir "\ntdbmnt.log"
        Runprogram Shell Background sLogDir 
    End_Procedure

    Object cmdAuto is a button
        Set Location to 40 3
        Set Size to 21 69
        Set label to "Auto"
        Set FlatState to True
        Procedure onClick
            Set pForceRepair to False
            Send DoRepairPart1
            If (not(gierrorstop)) Send DoResize
            If (not(gierrorstop)) Send DoAutoReindex
        End_Procedure
    End_Object

    Object cmdRepair is a button
        Set Location to 40 76
        Set Size to 21 69
        Set label to "Repair"
        Set FlatState to True
        Procedure onClick
            Set pForceRepair to True
            Send popup to (pRepair(Self))
        End_Procedure
    End_Object
    
    Object cmdRebuild is a button
        Set Location to 40 149
        Set Size to 21 69
        Set label to "Rebuild"
        Set enabled_state to False
        Set FlatState to True
        Procedure onClick
            Send popup to (pRebuild(Self))
        End_Procedure
    End_Object

    Object cmdCleanUp is a button
        Set Location to 40 222
        Set Size to 21 69
        Set label to "Clean up"
        Set enabled_state to False
        Set FlatState to True
        Procedure onClick
            Send DoCleanUp
        End_Procedure
    End_Object

    Object cmdResize is a button
        Set Location to 65 3
        Set Size to 21 69
        Set label to "Resize"
        Set FlatState to True
        Procedure onClick
            Send DoResize
        End_Procedure
    End_Object

    Object cmdReindex is a button
        Set Location to 65 76
        Set Size to 21 69
        Set label to "Reindex"
        Set FlatState to True
        Procedure onClick
            Send popup to (pIndex(Self))
        End_Procedure
    End_Object

    Object cmdDatecheck is a button
        Set Location to 65 149
        Set Size to 21 69
        Set label to "Date check"
        Set FlatState to True
        Procedure onClick
            Send popup to (pDatocheck(Self))
        End_Procedure
    End_Object

    Object cmdDoNothing2 is a button
        Set Location to 65 222
        Set Size to 21 69
        Set label to ""
        Set enabled_state to False
        Set FlatState to True
        Procedure onClick
        End_Procedure
    End_Object

    Object cmdDoNothing is a button
        Set Size to 21 69
        Set Location to 91 3
        Set label to ""
        Set FlatState to True
        Set Enabled_State to False
        Procedure onClick
        End_Procedure
    End_Object

    Object cmdDoNothing3 is a button
        Set Size to 21 69
        Set Location to 90 76
        Set label to ""
        Set FlatState to True
        Procedure onClick
        End_Procedure
    End_Object

    Object cmdLog is a button
        Set Size to 21 69
        Set Location to 90 149
        Set label to "Log"
        Set FlatState to True
        Procedure onClick
            Send DoShowLog
        End_Procedure
    End_Object

    Object cmdExit is a button
        Set Size to 21 69
        Set Location to 90 222
        Set label to "Exit"
        Set FlatState to True
        Procedure onClick
            Abort
        End_Procedure
    End_Object

    Procedure Activate
        String pa1 pa2 pa3 sDir
        Integer iEngage iFirsttimer
        Integer er_aktiv
        Get er_aktiveret to er_aktiv
        If (not(er_aktiv)) Begin
            get_current_directory to sDir
//            send info_box sDir
            If (Right(Trim(sDir),1)) eq "\" Move (Left(Trim(sDir), (Length(sDir) -1))) to sDir
            Set logdir to sDir
            Set er_aktiveret to True
            Move 1 to ifirsttimer
            Cmdline pa1
            Cmdline pa2
            Cmdline pa3
            Trim pa1 to pa1
            Trim pa2 to pa2
            Trim pa3 to pa3
            Uppercase pa1
            Uppercase pa2
            Uppercase pa3
            If pa1 Begin
                Set pAutomode to True
                Increment iEngage
                Set pCommand to ""
                If (pa1 = "A") Begin
                    Set pCommand to "Autoreindex"
                    Set pParameter1 to pa2
                End
            End
        End
        Forward Send activate
        If (not(pAutomode(Self))) If (ifirsttimer) Send Initalize_new_WS
        If iEngage Send DoEngageAuto
    End_Procedure


    Use pIndex.dg
    Use pRebuild.dg
    Use pRepair.dg
    Use pDatoCheck.dg

    Procedure DoEngageAuto
        Get pParameter1 to gsWSfile
        If (Pos(".SWS", gsWSFile) > 0) Begin
            Set psFileName of oSWS to gsWSFile
            Get WsFile of oSWS to gsWSFile
        End
        If ((pCommand(Self)) = "Autoreindex") Begin
            Send skriv "Auto-process started."
            Send DoOpenWSFile
            If (pAutoError(Self)) Abort
            Send Keyaction to (cmdAuto(Self))
            If (not(gierrorstop)) Send skriv "Auto-process ended."
            Else Send skriv "Auto-process stopped."
        End

        Abort  //Afslut altid med at lukke programmet.

    End_Procedure


    Procedure Error_report Integer fejlnr Integer Linienr String Error_mess
        Integer hId videresend retval iKunOkKnap
        String besked strWSP  sSystemFejltekst
        If (error_processing_state(Self)) Procedure_Return
        Set error_processing_state to True

        Move 0 to iKunOkKnap

        If (fejlnr = 72) Begin
            // Do nothing!       File not open
            Set Error_processing_state to False
            Procedure_Return
        End
        If (fejlnr = 75) Begin
            // Do Nothing!       Can't open data (.DAT) file
            Set Error_processing_state to False
            Procedure_Return
        End
        If (fejlnr = 901) Begin
            Move "No access to workspace " to besked
            Append besked Error_mess "."
            Move besked to Error_mess
        End
        If (fejlnr = 902) Begin
            Move "Error while reindexing for " to besked
            Append besked Error_mess "."
            Move besked to Error_mess
        End
        If (fejlnr = 903) Begin
            Move "BLOCK 0 BAD for " to besked
            Append besked Error_mess ". Reparing."
            Move besked to Error_mess
            Increment iKunOkKnap
        End
        If (fejlnr = 904) Begin
            Move "HEADER BAD for " to besked
            Append besked Error_mess ". Reparing."
            Move besked to Error_mess
            Increment iKunOkKnap
        End
        If (fejlnr = 905) Begin
            Move "HEADER UNREADABLE for " to besked
            Append besked Error_mess ". Reparing."
            Move besked to Error_mess
            Increment iKunOkKnap
        End
        If (fejlnr = 906) Begin
            Move "Was not able to repair " to besked
            Append besked Error_mess "."
            Move besked to Error_mess
        End
        If (fejlnr = 907) Begin
            Move "Was not able to find " to besked
            Append besked Error_mess "."
            Move besked to Error_mess
            //move 1 to gierrorstop
        End
        If (fejlnr = 908) Begin
            Move "Exclusive access denied for " to besked
            Append besked Error_mess "."
            Move besked to Error_mess
           // move 1 to gierrorstop
        End
        If (fejlnr = 4177) Begin
            // Move "File access violation, file may be in use by another program." to besked
            // append besked Error_mess "."
            // move besked to Error_mess

            // Do nothing!
            Set Error_processing_state to False
            Procedure_Return
        End
        If (fejlnr = 4265) Begin
            // Unable to open file
            // Do nothing!
            Set Error_processing_state to False
            Procedure_Return
        End
        If (fejlnr = 4358) Begin
            // Rawfile Command Error
            // Do nothing!
            Set Error_processing_state to False
            Procedure_Return
        End

        If (pAutoMode(Self)) Begin
            Set pAutoError to fejlnr
        End
        Else Move 1 to videresend    
        
        If (Error_Text_Available(Desktop, fejlnr)) Begin
            Move (Error_Text(Desktop, fejlnr)) to sSystemFejltekst
        End                                                       
        
        Move "ERROR: Status #" to besked
        Append besked fejlnr " at line " linienr  
        If (sSystemFejltekst <> "") Append besked " - " sSystemFejltekst
        If (Error_mess <> "") Append besked " - " Error_mess
        Send skriv besked                              

        If videresend Begin
            If iKunOkKnap Begin
                Get Message_Box besked "Maintenance error" MB_OK MB_ICONERROR to retval
            End
            Else Begin
                Get Message_Box besked "Maintenance error" MB_ABORTRETRYIGNORE MB_ICONERROR to retval
                If (retval = MBR_ABORT) Begin
                    Move 1 to gierrorstop
                    Send skriv "*USER ABORT*"
                End
                If (retval = MBR_RETRY) Begin
                    Move 2 to gierrorstop
                    Send skriv "*USER RETRY*"
                End
                If (retval = MBR_IGNORE) Begin
                    Move 0 to gierrorstop
                    Send skriv "*USER IGNORE*"
                End
            End
        End

        Set Error_processing_state to False
    End_Procedure

    Object cmdWorkspace is a button
        Set Location to 9 15
        Set Size to 21 69
        Set label to "Workspace"
        Set FlatState to True
        Procedure onClick
            Send Request_Select_workspace
        End_Procedure
    End_Object

    Object tAktForm is a TextBox
        Set auto_size_state to False
        Set Location to 9 98
        Set size to 21 181
        Set value to "(not found)"
        Set focus_mode to nonfocusable
        Set Justification_Mode to (jmode_center +jmode_vcenter)
        Set border_style to Border_Normal
    End_Object

End_Object

Start_UI (hoved(Self))
