Attribute VB_Name = "SystemFunctions"
Option Explicit

'*****30/04/2004
'BackupDB changed due to Win98 not being able to run dbengine.compactdatabase
Public Sub BackupDB()
On Error GoTo BackupDB_Err
   Dim conFilePath As String
   Dim conFolderPath As String
   Dim X As Long
   Dim fso, MyFile

   'close connection
   Main.cn.Close
   'allow a moment for the connection to be released
   For X = 0 To 10000
   Next X

   conFilePath = App.Path & "\"
   conFolderPath = conFilePath & "Backup\" & Format(Date, "yyyymmm") & "\"
   
   'check if backup directory exists
   If Dir(conFilePath & "Backup\", vbDirectory) <> "" Then 'directory exists
      'check if folder exists for this month's backup
      If Dir(conFolderPath, vbDirectory) <> "" Then 'directory exists
         ' Delete the previous backup file if it exists.
         If Dir(conFolderPath & "AscotData.bak") <> "" Then
            Kill conFolderPath & "AscotData.bak"
         End If
      Else
         'create the directory
         MkDir conFolderPath
      End If
   Else
      MkDir conFilePath & "Backup\"
      'create the directory
      MkDir conFolderPath
   End If
   
   '(Create Backup)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set MyFile = fso.GetFile(conFilePath & "AscotData.mdb")
   MyFile.Copy (conFolderPath & "AscotData.bak")
   
   'call openConnection procedure on main form
   Main.OpenConnection
Exit_BackupDB:
   Exit Sub
   
BackupDB_Err:
   MsgBox Err.Description
   Resume Exit_BackupDB
End Sub

Public Sub BackupDB_MonthEnd(pDate As String)
On Error GoTo BackupDB_Err
   Dim conFilePath As String
   Dim conFolderPath As String
   Dim X As Long
   Dim fso, MyFile

   'close connection
   Main.cn.Close
   'allow a moment for the connection to be released
   For X = 0 To 10000
   Next X

   conFilePath = App.Path & "\"
   conFolderPath = conFilePath & "Backup\" & pDate & "\"
   
   'check if backup directory exists
   If Dir(conFilePath & "Backup\", vbDirectory) <> "" Then 'directory exists
      'check if folder exists for this month's backup
      If Dir(conFolderPath, vbDirectory) <> "" Then 'directory exists
         ' Delete the previous backup file if it exists.
         If Dir(conFolderPath & "AscotData.bak") <> "" Then
            Kill conFolderPath & "AscotData.bak"
         End If
      Else
         'create the directory
         MkDir conFolderPath
      End If
   Else
      MkDir conFilePath & "Backup\"
      'create the directory
      MkDir conFolderPath
   End If
   
   '(Create Backup)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set MyFile = fso.GetFile(conFilePath & "AscotData.mdb")
   MyFile.Copy (conFolderPath & "AscotData.bak")
   
   'call openConnection procedure on main form
   Main.OpenConnection
Exit_BackupDB:
   Exit Sub
   
BackupDB_Err:
   MsgBox Err.Description
   Resume Exit_BackupDB
End Sub

Public Sub BackupDB_old()
On Error GoTo BackupDB_Err
   Dim conFilePath As String
   Dim conFolderPath As String
   Dim X As Long
   
   'close connection
   Main.cn.Close
   'allow a moment for the connection to be released
   For X = 0 To 10000
   Next X

   conFilePath = App.Path & "\"
   conFolderPath = conFilePath & "Backup\" & Format(Date, "yyyymmm") & "\"
   
   'if temp file exists, delete it
   If Dir(conFilePath & "AscotTemp.mdb") <> "" Then
      Kill conFilePath & "AscotTemp.mdb"
   End If
   ' Compact the database to a temp file. (compact current database)
   DBEngine.CompactDatabase conFilePath & "AscotData.mdb", conFilePath & "AscotTemp.mdb", , , ";pwd=Bl@dd3r"
   
   'check if backup directory exists
   If Dir(conFilePath & "Backup\", vbDirectory) <> "" Then 'directory exists
      'check if folder exists for this month's backup
      If Dir(conFolderPath, vbDirectory) <> "" Then 'directory exists
         ' Delete the previous backup file if it exists.
         If Dir(conFolderPath & "AscotData.bak") <> "" Then
            Kill conFolderPath & "AscotData.bak"
         End If
      Else
         'create the directory
         MkDir conFolderPath
      End If
   Else
      MkDir conFilePath & "Backup\"
      'create the directory
      MkDir conFolderPath
   End If
   
   '(Create Backup)
   DBEngine.CompactDatabase conFilePath & "AscotData.mdb", conFolderPath & "AscotData.bak", , , ";pwd=Bl@dd3r"
   
   ' Delete the current database
   Kill conFilePath & "AscotData.mdb"
   ' rename the temp file (compacted database) to the original file name.
   Name conFilePath & "AscotTemp.mdb" As conFilePath & "AscotData.mdb"

   'call openConnection procedure on main form
   Main.OpenConnection
Exit_BackupDB:
   Exit Sub
   
BackupDB_Err:
   MsgBox Err.Description
   Resume Exit_BackupDB
End Sub

Public Sub CompactDB()
On Error GoTo CompactDB_Err
   Dim conFilePath As String
   Dim X As Integer
   
   'close connection
   If Main.cn.State = 1 Then
      Main.cn.Close
   End If
   'allow a moment for the connection to be released
   For X = 0 To 10000
   Next X

   conFilePath = App.Path & "\"
   'if temp file exists, delete it
   If Dir(conFilePath & "AscotTemp.mdb") <> "" Then
      Kill conFilePath & "AscotTemp.mdb"
   End If
   ' Compact the database to a temp file. (compact current database)
   DBEngine.CompactDatabase conFilePath & "AscotData.mdb", conFilePath & "AscotTemp.mdb", , , ";pwd=Bl@dd3r"
   
   ' Delete the previous database.
   If Dir(conFilePath & "AscotData.mdb") <> "" Then
      Kill conFilePath & "AscotData.mdb"
   End If
   
   'rename temp database
   Name conFilePath & "AscotTemp.mdb" As conFilePath & "AscotData.mdb"

   'call openConnection procedure on main form
Exit_CompactDB:
   Main.OpenConnection
   Exit Sub
   
CompactDB_Err:
   MsgBox Err.Description
   Resume Exit_CompactDB
End Sub

Public Function ZeroPadIR(strField As String) As String
   Dim DesiredLength As Integer
   
   ZeroPadIR = ""
   strField = Trim(strField)
   DesiredLength = 5
   ZeroPadIR = String(DesiredLength - Len(strField), "0") + strField
End Function

Public Function ConvertNull(d As Variant) As Variant
   ConvertNull = IIf(IsNull(d), 0, d)
End Function

Public Function NullToString(strValue As Variant) As String
   NullToString = IIf(IsNull(strValue), "", strValue)
End Function

Public Function ReturnToTab(A As Integer) As Integer
   If A = 13 Then  ' The ENTER key.
      SendKeys "{tab}"    ' Set the focus to the next control.
      A = 0        ' Ignore this key.
   End If
   ReturnToTab = A
End Function

Public Function BackspaceToBackTab(A As Integer) As Integer
   If A = 8 Then  ' The BACKSPACE key.
      SendKeys "+{tab}"    ' Set the focus to the previous control.
      A = 0        ' Ignore this key.
   End If
   BackspaceToBackTab = A
End Function

Public Function NumberFormat(strNumber As String) As String
   Dim dblNumber As Variant
   If IsNumeric(Trim(strNumber)) Then
      dblNumber = CDbl(strNumber)
   Else
      dblNumber = 0
   End If
   NumberFormat = Format(dblNumber, "###,##0.00")
End Function

Public Sub SetListViewItemColour(LI As ListItem, i)
   Dim X As Integer
   LI.ForeColor = i
   For X = 1 To LI.ListSubItems.Count
      LI.ListSubItems(X).ForeColor = i
   Next X
End Sub

Public Function Left_Form_Load(w As Double)
   Left_Form_Load = (Main.ScaleWidth - w) / 2
End Function

Public Function Top_Form_Load(h As Double)
   Top_Form_Load = (Main.ScaleHeight - h) / 3
End Function

Public Function Clean_Negative_Value(d As Double) As Double
   Clean_Negative_Value = d
   If d < 0 And d > -0.01 Then
      Clean_Negative_Value = 0
   End If
   If d < 0.01 And d > 0 Then
      Clean_Negative_Value = 0
   End If
End Function