VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DPC_Tools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
Private Declare Function LoadLibrary Lib "Kernel32" Alias "LoadLibraryA" _
   (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "Kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadIconFromDLL Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function GetLocaleInfoA Lib "Kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMiliseconds As Long)

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const C_ERRORRAISE As Long = 2500
Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SCREEN_NAME As String = "DPC_Tools"

Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    InvalidValue = C_ERRORRAISE + 14              ' load function failed ... bad sql
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Type TRect
    Top As Long
    Left As Long
    Width As Long
    Height As Long
End Type

Private mc_Error As Long
Private mc_OfferTemplate As Long
Private mc_A_Config As Long
Private mc_Security_Alias As Long
Private mb_Initialized  As Boolean
Private mo_References As Dictionary
Private mo_BatchRequest As Collection
Private ms_BatchTransaction As String
Private mb_InBatchTransaction As Boolean

#If LIVE = 1 Then
  Private mo_Db As Object
  Private mo_FSO As Object
#Else
  Private mo_Db As ARMSYSCOMLib.ArmDb
  Private mo_FSO As FileSystemObject
#End If

Private mo_ToolTipsCollection As New Collection

Public Property Set ArmDb(ByRef lo_Db As Object)
On Error GoTo ErrHandler
  
  Set mo_Db = lo_Db
  Exit Property
ErrHandler:
  Call errorHandler("ArmDb.Set")
End Property

Public Property Get Name() As String
  Name = SCREEN_NAME
End Property

#If LIVE = 1 Then
Public Sub Load_A_COM()
#Else
Public Sub Load_A_COM()
#End If
On Error GoTo ErrHandler

  If mb_Initialized Then
      Call Err.Raise(ArmErr.CPTAlreadyInitialized)
  End If
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  Set mo_References = New Dictionary
  Set mo_BatchRequest = New Collection
  mb_InBatchTransaction = False
  ms_BatchTransaction = ""
  mb_Initialized = True
  Exit Sub
ErrHandler:
  Call errorHandler("Load_A_COM")
End Sub

#If LIVE = 1 Then
Public Sub Unload_A_COM()
#Else
Public Sub Unload_A_COM()
#End If
On Error GoTo ErrHandler

Dim lo_Object As Object

  If Not mo_Db Is Nothing Then
    If mc_A_Config <> 0 Then
      Call mo_Db.Close(mc_A_Config)
      mc_A_Config = 0
    End If
    If mc_Security_Alias <> 0 Then
      Call mo_Db.Close(mc_Security_Alias)
      mc_Security_Alias = 0
    End If
    If mc_Error <> 0 Then
      Call mo_Db.Close(mc_Error)
      mc_Error = 0
    End If
    If mc_OfferTemplate <> 0 Then
      Call mo_Db.Close(mc_OfferTemplate)
      mc_OfferTemplate = 0
    End If
  End If
      
  For Each lo_Object In mo_ToolTipsCollection
    Debug.Print ("Undeleted tooltips for hWnd:" & lo_Object.FormhWnd)
    Call lo_Object.Destroy
  Next

  Call ClearCollection(mo_ToolTipsCollection)
  
  Call mo_References.RemoveAll
  Set mo_References = Nothing
  
  If mb_InBatchTransaction Then
    Debug.Print ("In Batch transaction !")
    Err.Raise ArmErr.CPTAlreadyInitialized, "mb_InBatchTransaction", "Application did not finish batch transaction: " & ms_BatchTransaction
  End If
  Set mo_BatchRequest = Nothing
  mb_Initialized = False
  Exit Sub
ErrHandler:
  Call errorHandler("Unload_A_COM")
End Sub

#If LIVE = 1 Then
Public Sub Load_A_ComControls(ByVal ao_Controls As Object, ByVal ao_Db As Object, ByVal as_Language_Code As String, Optional al_hWnd = 0)
#Else
Public Sub Load_A_ComControls(ByVal ao_Controls As Object, ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Language_Code As String, Optional al_hWnd = 0)
#End If
On Error GoTo ErrHandler

Dim lo_Control As Object
Dim lo_ToolTip As Object

  For Each lo_Control In ao_Controls
    Select Case UCase(TypeName(lo_Control))
    Case "ARMCOMBOBOX"
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    Case "ARMPICKER"
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    Case "TOOLBARCONTROL"
      lo_Control.Language = as_Language_Code
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    Case "ARMGRID"
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    Case "ARMTREEVIEW"
      Set lo_Control.ArmDb = ao_Db
      lo_Control.Language = as_Language_Code
      Call lo_Control.Load_A_COM
    Case "ARMCHECKVIEW"
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    Case "A_CALOCX"
      lo_Control.Language = as_Language_Code
      Call lo_Control.reinit_cal
    Case "TOOLBR"
      Set lo_Control.ArmDb = ao_Db
      Call lo_Control.Load_A_COM
    End Select
  Next
  
  'save hWnd because of tooltip usage
  If al_hWnd <> 0 Then
            
      Set lo_ToolTip = New clsToolTip
      
      Call mo_ToolTipsCollection.Add(lo_ToolTip, CStr(al_hWnd))
            
      With lo_ToolTip
        
        Call .Create(al_hWnd)
        
        .MaxTipWidth = 240 'wordwrap 240 chars
        .DelayTime(ttDelayShow) = 20000  ' Show the tooltip for 20 seconds.
        .ToolTipHeaderShow = True
        
      End With
  End If
  
  Exit Sub
ErrHandler:
  Call errorHandler("Load_A_ComControls")
End Sub

Public Sub Unload_A_ComControls(ByVal ao_Controls As Object, Optional al_hWnd = 0)
On Error GoTo ErrHandler

Dim lo_Control As Object
Dim lo_ToolTip As Object
Dim ll_Idx As Long

  For Each lo_Control In ao_Controls
    Select Case UCase(TypeName(lo_Control))
    Case "ARMCOMBOBOX"
      Call lo_Control.Unload_A_COM
    Case "ARMPICKER"
      Call lo_Control.Unload_A_COM
    Case "TOOLBARCONTROL"
      Call lo_Control.Unload_A_COM
    Case "ARMGRID"
      Call lo_Control.Unload_A_COM
    Case "ARMTREEVIEW"
      Call lo_Control.Unload_A_COM
    Case "ARMCHECKVIEW"
      Call lo_Control.Unload_A_COM
    Case "TOOLBR"
      Call lo_Control.Unload_A_COM
    End Select
  Next
  
  'process tooltip array
  If al_hWnd <> 0 Then
    
        Set lo_ToolTip = mo_ToolTipsCollection.Item(CStr(al_hWnd))
        
        If Not lo_ToolTip Is Nothing Then
            Call lo_ToolTip.Destroy
            Call mo_ToolTipsCollection.Remove(CStr(al_hWnd))
            Set lo_ToolTip = Nothing
        End If
  
  End If
  
  Exit Sub
ErrHandler:
  Call errorHandler("Unload_A_ComControls")
End Sub

Public Function GetCodeLookup(ByVal ae_CodeConversion As eDPCCodeConversionBaeurer) As String
On Error GoTo ErrHandler

  Select Case ae_CodeConversion
  Case eDPCCodeConversionBaeurer.ccUnitOfMeasure
    GetCodeLookup = "DPC_Baeurer_UoM"
  Case eDPCCodeConversionBaeurer.ccCurrency
    GetCodeLookup = "DPC_Baeurer_Currency"
  Case eDPCCodeConversionBaeurer.ccCountry
    GetCodeLookup = "DPC_Baeurer_Country"
  Case eDPCCodeConversionBaeurer.ccPBorder
    GetCodeLookup = "DPC_Baeurer_PBorder"
  Case Else
    Err.Raise ArmErr.InvalidArgument, "ae_CodeConversion", "Invalid conversion lookup ae_CodeConversion: " & ae_CodeConversion
  End Select
  Exit Function
ErrHandler:
  Call errorHandler("GetCodeLookup")
End Function

Public Function GetConversionCode(ByVal as_CodeLookup As String) As eDPCCodeConversionBaeurer
On Error GoTo ErrHandler

  Select Case UCase(as_CodeLookup)
  Case UCase("DPC_Baeurer_UoM")
    GetConversionCode = eDPCCodeConversionBaeurer.ccUnitOfMeasure
  Case UCase("DPC_Baeurer_Currency")
    GetConversionCode = eDPCCodeConversionBaeurer.ccCurrency
  Case UCase("DPC_Baeurer_Country")
    GetConversionCode = eDPCCodeConversionBaeurer.ccCountry
  Case UCase("DPC_Baeurer_PBorder")
    GetConversionCode = eDPCCodeConversionBaeurer.ccPBorder
  Case Else
    Err.Raise ArmErr.InvalidArgument, "as_CodeLookup", "Invalid code lookup ae_CodeConversion: " & as_CodeLookup
  End Select
  Exit Function
ErrHandler:
  Call errorHandler("GetConversionCode")
End Function

#If LIVE = 1 Then
Public Function ConvertCodeFromBaeurer(ByVal ao_Db As Object, ByVal ae_CodeConversion As eDPCCodeConversionBaeurer, ByVal as_CodeOut As String) As String
#Else
Public Function ConvertCodeFromBaeurer(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ae_CodeConversion As eDPCCodeConversionBaeurer, ByVal as_CodeOut As String) As String
#End If
On Error GoTo ErrHandler

Dim lc_Cursor As Long
Dim ls_Request As String

  ConvertCodeFromBaeurer = ""
  ls_Request = "SELECT AC_CodeIn "
  ls_Request = ls_Request & "FROM A_CodeTranslator "
  ls_Request = ls_Request & "WHERE "
  ls_Request = ls_Request & "AC_CodeLookup = $AC_CodeLookup$ AND "
  ls_Request = ls_Request & "AC_CodeOut = $AC_CodeOut$"
    
  ls_Request = Replace(ls_Request, "$AC_CodeLookup$", SQLStr(GetCodeLookup(ae_CodeConversion)), , , vbTextCompare)
  ls_Request = Replace(ls_Request, "$AC_CodeOut$", SQLStr(as_CodeOut), , , vbTextCompare)
  
  lc_Cursor = OpenSQLSafe(ao_Db, ls_Request)
  If ao_Db.RowCount(lc_Cursor) = 1 Then
    ConvertCodeFromBaeurer = ao_Db.GetFields(lc_Cursor, "AC_CodeIn")
  Else
    Err.Raise ArmErr.InvalidArgument, "as_CodeIn", "Invalid conversion code ae_CodeConversion: " & ae_CodeConversion & " as_CodeOut: " & as_CodeOut
  End If
  Call ao_Db.Close(lc_Cursor)
  Exit Function
ErrHandler:
  Call ao_Db.Close(lc_Cursor)
  Call errorHandler("ConvertCodeFromBaeurer")
End Function

#If LIVE = 1 Then
Public Function ConvertCodeToBaeurer(ByVal ao_Db As Object, ByVal ae_CodeConversion As eDPCCodeConversionBaeurer, ByVal as_CodeIn As String) As String
#Else
Public Function ConvertCodeToBaeurer(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ae_CodeConversion As eDPCCodeConversionBaeurer, ByVal as_CodeIn As String) As String
#End If
On Error GoTo ErrHandler

Dim lc_Cursor As Long
Dim ls_Request As String

  ConvertCodeToBaeurer = ""
  ls_Request = "SELECT AC_CodeOut "
  ls_Request = ls_Request & "FROM A_CodeTranslator "
  ls_Request = ls_Request & "WHERE "
  ls_Request = ls_Request & "AC_CodeLookup = $AC_CodeLookup$ AND "
  ls_Request = ls_Request & "AC_CodeIn = $AC_CodeIn$"
  
  ls_Request = Replace(ls_Request, "$AC_CodeLookup$", SQLStr(GetCodeLookup(ae_CodeConversion)), , , vbTextCompare)
  ls_Request = Replace(ls_Request, "$AC_CodeIn$", SQLStr(as_CodeIn), , , vbTextCompare)
  
  lc_Cursor = OpenSQLSafe(ao_Db, ls_Request)
  If ao_Db.RowCount(lc_Cursor) = 1 Then
    ConvertCodeToBaeurer = ao_Db.GetFields(lc_Cursor, "AC_CodeOut")
  Else
    Err.Raise ArmErr.InvalidArgument, "as_CodeIn", "Invalid conversion code ae_CodeConversion: " & ae_CodeConversion & " as_CodeIn: " & as_CodeIn
  End If
  Call ao_Db.Close(lc_Cursor)
  Exit Function
ErrHandler:
  Call ao_Db.Close(lc_Cursor)
  Call errorHandler("ConvertCodeToBaeurer")
End Function

#If LIVE = 1 Then
Public Function GetNextID(ByVal ao_Db As Object, ByVal as_A_Id As String) As String
#Else
Public Function GetNextID(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_A_Id As String) As String
#End If
On Error GoTo ErrHandler
Dim ls_Data As String

  ls_Data = ao_Db.SQLNextID(as_A_Id)
  If ls_Data = "" Then
      Err.Raise ArmErr.CompFncFailed, "mo_Db.SQLNextID", "SQLNextID failed for key: " & as_A_Id
  End If
  GetNextID = ls_Data
  Exit Function
ErrHandler:
  Call errorHandler("GetNextID")
End Function

#If LIVE = 1 Then
Public Function GetLastIdentity(ByVal ao_Db As Object) As Long
#Else
Public Function GetLastIdentity(ByVal ao_Db As ARMSYSCOMLib.ArmDb) As Long
#End If
On Error GoTo errorHandler
  
  GetLastIdentity = Val(SelectValue(ao_Db, "SELECT @@IDENTITY"))
  Exit Function
errorHandler:
  Call errorHandler("GetLastIdentity")
End Function

#If LIVE = 1 Then
Public Function IsConnected(ByVal ao_Db As Object) As Boolean
#Else
Public Function IsConnected(ByVal ao_Db As ARMSYSCOMLib.ArmDb) As Boolean
#End If
On Error GoTo errorHandler
  
  IsConnected = Val(SelectValue(ao_Db, "SELECT @@SPID")) <> 0
  Exit Function
errorHandler:
  IsConnected = False
  Call ao_Db.Disconnect
End Function

#If LIVE = 1 Then
Public Function ReconnectSafe(ByVal ao_Db As Object, ByVal as_Server As String, ByVal as_Db As String, ByVal as_Login As String, ByVal as_Password As String, ByVal as_Source As String) As Boolean
#Else
Public Function ReconnectSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Server As String, ByVal as_Db As String, ByVal as_Login As String, ByVal as_Password As String, ByVal as_Source As String) As Boolean
#End If
On Error GoTo ErrHandler

  If Not ao_Db.IsConnected Then
    If Not ao_Db.Connect(as_Server, as_Db, as_Login, as_Password, as_Source) Then
      Call MsgBox("Error connecting to server: " & as_Server & " Error: " & ao_Db.LastErrorMessage, vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
      ReconnectSafe = False
      Exit Function
    End If
  End If
  ReconnectSafe = True
  Exit Function
ErrHandler:
  Call ao_Db.Disconnect
  Call errorHandler("ReconnectSafe")
End Function

#If LIVE = 1 Then
Public Function SelectValue(ByVal ao_Db As Object, ByVal as_Request As String, Optional av_Col As Variant = 0) As Variant
#Else
Public Function SelectValue(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional av_Col As Variant = 0) As Variant
#End If
On Error GoTo ErrHandler

Dim ll_Cursor As Long

  SelectValue = Empty
  ll_Cursor = OpenSQLSafe(ao_Db, as_Request)
  If ao_Db.RowCount(ll_Cursor) = 1 Then
    SelectValue = ao_Db.GetFields(ll_Cursor, av_Col)
  End If
  Call ao_Db.Close(ll_Cursor)
  Exit Function
ErrHandler:
  Call errorHandler("SelectValue")
End Function

#If LIVE = 1 Then
Public Function ExistsRecord(ByVal ao_Db As Object, ByVal as_Request As String) As Boolean
#Else
Public Function ExistsRecord(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String) As Boolean
#End If
On Error GoTo ErrHandler

Dim ll_Cursor As Long

  ExistsRecord = False
  ll_Cursor = OpenSQLSafe(ao_Db, as_Request)
  If ao_Db.RowCount(ll_Cursor) > 0 Then
    ExistsRecord = ao_Db.GetFields(ll_Cursor, 0)
  End If
  Call ao_Db.Close(ll_Cursor)
  Exit Function
ErrHandler:
  Call errorHandler("ExistsRecord")
End Function

Public Function SqlBool(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler
    
  If IsNull(av_Data) Then
    SqlBool = "NULL"
  Else
    SqlBool = IIf(av_Data, "'X'", "''")
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlBool")
End Function

Public Function SqlInt(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SqlInt = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If Trim(CStr(av_Data)) <> "" Then
      SqlInt = CStr(av_Data)
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlInt")
End Function

Public Function SqlIntKey(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SqlIntKey = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If CStr(av_Data) = "0" Then av_Data = ""
  If Trim(CStr(av_Data)) <> "" Then
      SqlIntKey = CStr(av_Data)
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlIntKey")
End Function

Public Function SqlIntIn(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler
Dim ls_Data As String
Dim ll_Idx As Long

  If IsNull(av_Data) Then
    ls_Data = "NULL"
  ElseIf IsArray(av_Data) Then
    ls_Data = ""
    For ll_Idx = 0 To UBound(av_Data)
      If ls_Data <> "" Then ls_Data = ls_Data & ","
      ls_Data = ls_Data & SqlInt(av_Data(ll_Idx))
    Next
    If ls_Data = "" Then ls_Data = "NULL"
  Else
    ls_Data = SqlInt(Val(av_Data))
  End If
  SqlIntIn = ls_Data
  Exit Function
ErrHandler:
  Call errorHandler("SqlIntIn")
End Function

Public Function SqlStrKey(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SqlStrKey = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If Trim(CStr(av_Data)) <> "" Then
      SqlStrKey = SQLStr(CStr(av_Data))
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlStrKey")
End Function

Public Function SqlDbl(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SqlDbl = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If Trim(CStr(av_Data)) <> "" Then
      SqlDbl = Str(av_Data)
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlDbl")
End Function

Public Function SqlDate(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SqlDate = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If (Trim(CStr(av_Data)) <> "") And (Val(av_Data) <> 0) Then
      SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlDate")
End Function

Public Function SQLDateTime(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

  SQLDateTime = "NULL"
  If IsNull(av_Data) Then av_Data = ""
  If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
      SQLDateTime = "'" & Format(av_Data, "yyyy-mm-dd hh:mm:ss") & "'"
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SqlDateTime")
End Function

Public Function SQLStr(ByVal av_Data As Variant, Optional ByVal al_MaxLength As Long = 8000) As String
On Error GoTo ErrHandler

  If IsNull(av_Data) Then av_Data = ""
  SQLStr = "'" & Replace(Left(CStr(av_Data), al_MaxLength), "'", "''") & "'"
  Exit Function
ErrHandler:
  Call errorHandler("SqlStr")
End Function

Public Function SqlStrIn(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler
Dim ls_Data As String
Dim ll_Idx As Long

  If IsNull(av_Data) Then
    ls_Data = "NULL"
  ElseIf IsArray(av_Data) Then
    ls_Data = ""
    For ll_Idx = 0 To UBound(av_Data)
      If ls_Data <> "" Then ls_Data = ls_Data & ","
      ls_Data = ls_Data & SQLStr(av_Data(ll_Idx))
    Next
    If ls_Data = "" Then ls_Data = "NULL"
  Else
    ls_Data = SQLStr(Trim(Str(av_Data)))
  End If
  SqlStrIn = ls_Data
  Exit Function
ErrHandler:
  Call errorHandler("SqlStrIn")
End Function

Public Function ToQtyM2(ByVal ad_QtyPCS As Double, ByVal ad_Surface As Double) As Double
On Error GoTo ErrHandler
  
  ToQtyM2 = Round(ad_QtyPCS * ad_Surface, 2)
  Exit Function
ErrHandler:
  Call errorHandler("ToQtyM2")
End Function

Public Function ToQtyPCS(ByVal ad_QtyM2 As Double, ByVal ad_Surface As Double) As Double
On Error GoTo ErrHandler
  
  If ad_Surface > 0 Then
    ToQtyPCS = Round(ad_QtyM2 / ad_Surface, 0)
  Else
    ToQtyPCS = 0
  End If
  Exit Function
ErrHandler:
  Call errorHandler("ToQtyPCS")
End Function

Public Function ToQtyPU(ByVal al_QtyPCS As Long, ByVal al_PU As Long) As Long
On Error GoTo ErrHandler

Dim ll_QtyPU As Long

  If al_PU > 0 Then
    ll_QtyPU = al_QtyPCS \ al_PU
    If (al_QtyPCS Mod al_PU) > 0 Then ll_QtyPU = ll_QtyPU + 1
  Else
    ll_QtyPU = 0
  End If
  ToQtyPU = ll_QtyPU
  Exit Function
ErrHandler:
  Call errorHandler("ToQtyPU")
End Function

Public Function FromPricePCStoM2(ByVal ad_PricePCS As Double, ByVal ad_Surface As Double) As Double
On Error GoTo ErrHandler
  
  If ad_Surface > 0 Then
    FromPricePCStoM2 = ad_PricePCS / ad_Surface
  Else
    FromPricePCStoM2 = 0
  End If
  Exit Function
ErrHandler:
  Call errorHandler("FromPricePCStoM2")
End Function

Public Function FromPriceM2toPCS(ByVal ad_PriceM2 As Double, ByVal ad_Surface As Double) As Double
On Error GoTo ErrHandler
  
  FromPriceM2toPCS = ad_PriceM2 * ad_Surface
  Exit Function
ErrHandler:
  Call errorHandler("FromPriceM2toPCS")
End Function

Public Function FromPricePCStoPU(ByVal ad_PricePCS As Double, ByVal al_PU As Long) As Double
On Error GoTo ErrHandler

  FromPricePCStoPU = ad_PricePCS * al_PU
  Exit Function
ErrHandler:
  Call errorHandler("FromPricePCStoPU")
End Function

Public Function FromPricePUtoPCS(ByVal ad_PricePU As Double, ByVal al_PU As Long) As Double
On Error GoTo ErrHandler
  
  If al_PU > 0 Then
    FromPricePUtoPCS = ad_PricePU / al_PU
  Else
    FromPricePUtoPCS = 0
  End If
  Exit Function
ErrHandler:
  Call errorHandler("FromPricePCStoPU")
End Function

Public Function ConvertUM_CodeToDPCQtyType(ByVal as_UM_Code As String) As eDPCQtyType
On Error GoTo ErrHandler

  If StrComp(as_UM_Code, DPC_UOM_PCS, vbTextCompare) = 0 Then
    ConvertUM_CodeToDPCQtyType = eDPCQtyType.qtPCS
  ElseIf StrComp(as_UM_Code, DPC_UOM_M2, vbTextCompare) = 0 Then
    ConvertUM_CodeToDPCQtyType = eDPCQtyType.qtM2
  ElseIf StrComp(as_UM_Code, DPC_UOM_PU, vbTextCompare) = 0 Then
    ConvertUM_CodeToDPCQtyType = eDPCQtyType.qtPU
  Else
    ConvertUM_CodeToDPCQtyType = eDPCQtyType.qtUnknown
  End If
  Exit Function
ErrHandler:
  Call errorHandler("ConvertUM_CodeToDPCQtyType")
End Function

Public Function ConvertDPCQtyTypeToUM_Code(ByVal ae_QtyType As eDPCQtyType) As String
On Error GoTo ErrHandler

  If ae_QtyType = eDPCQtyType.qtPCS Then
    ConvertDPCQtyTypeToUM_Code = DPC_UOM_PCS
  ElseIf ae_QtyType = eDPCQtyType.qtM2 Then
    ConvertDPCQtyTypeToUM_Code = DPC_UOM_M2
  ElseIf ae_QtyType = eDPCQtyType.qtPU Then
    ConvertDPCQtyTypeToUM_Code = DPC_UOM_PU
  Else
    ConvertDPCQtyTypeToUM_Code = DPC_UOM_UNKNOWN
  End If
  Exit Function
ErrHandler:
  Call errorHandler("ConvertDPCQtyTypeToUM_Code")
End Function

#If LIVE = 1 Then
Public Function SelectExchangeRate(ByVal ao_Db As Object, ByVal as_CURR_Code1 As String, ByVal as_CURR_Code2 As String, ByVal ad_Date As Date)
#Else
Public Function SelectExchangeRate(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_CURR_Code1 As String, ByVal as_CURR_Code2 As String, ByVal ad_Date As Date)
#End If
On Error GoTo ErrHandler

Dim ld_LineRate1 As Double, ld_LineRate2 As Double
Dim ls_Req As String

  If (as_CURR_Code1 = "") Or (as_CURR_Code2 = "") Then
    SelectExchangeRate = 0
  ElseIf StrComp(as_CURR_Code1, as_CURR_Code2, vbTextCompare) = 0 Then
    SelectExchangeRate = 1
  ElseIf StrComp(as_CURR_Code1, "USD", vbTextCompare) = 0 Then
    ls_Req = "exec DPC_Exchange_Rates_sel $CURR_Code$, $EXCH_Date$"
    ls_Req = Replace(ls_Req, "$CURR_Code$", SQLStr(as_CURR_Code2), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$EXCH_Date$", SqlDate(ad_Date), , , vbTextCompare)
    ld_LineRate1 = SelectValue(ao_Db, ls_Req, "EXCH_Rate")
    If ld_LineRate1 = 0 Then
      SelectExchangeRate = 0
    Else
      SelectExchangeRate = 1 / ld_LineRate1
    End If
  ElseIf StrComp(as_CURR_Code2, "USD", vbTextCompare) = 0 Then
    ls_Req = "exec DPC_Exchange_Rates_sel $CURR_Code$, $EXCH_Date$"
    ls_Req = Replace(ls_Req, "$CURR_Code$", SQLStr(as_CURR_Code1), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$EXCH_Date$", SqlDate(ad_Date), , , vbTextCompare)
    SelectExchangeRate = SelectValue(ao_Db, ls_Req, "EXCH_Rate")
  Else
    ls_Req = "exec DPC_Exchange_Rates_sel $CURR_Code$, $EXCH_Date$"
    ls_Req = Replace(ls_Req, "$CURR_Code$", SQLStr(as_CURR_Code1), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$EXCH_Date$", SqlDate(ad_Date), , , vbTextCompare)
    ld_LineRate1 = SelectValue(ao_Db, ls_Req, "EXCH_Rate")
    
    ls_Req = "exec DPC_Exchange_Rates_sel $CURR_Code$, $EXCH_Date$"
    ls_Req = Replace(ls_Req, "$CURR_Code$", SQLStr(as_CURR_Code2), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$EXCH_Date$", SqlDate(ad_Date), , , vbTextCompare)
    ld_LineRate2 = SelectValue(ao_Db, ls_Req, "EXCH_Rate")
    
    If ld_LineRate2 = 0 Then
      SelectExchangeRate = 0
    Else
      SelectExchangeRate = ld_LineRate1 / ld_LineRate2
    End If
  End If
  Exit Function
ErrHandler:
  Call errorHandler("SelectExchangeRate")
End Function

#If LIVE = 1 Then
Public Function LoadDPCImage(ByVal ao_Db As Object, ByVal ao_FSO As Object, ByVal as_Path As String, ByVal al_IMG_Id As Long) As StdPicture
#Else
Public Function LoadDPCImage(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_FSO As FileSystemObject, ByVal as_Path As String, ByVal al_IMG_Id As Long) As StdPicture
#End If
On Error GoTo ErrHandler

Dim ls_PicName As String

  Set LoadDPCImage = Nothing
  If al_IMG_Id = 0 Then Exit Function
  If right(as_Path, 1) <> "\" Then as_Path = as_Path & "\"
  
  If Not ao_FSO.FolderExists(as_Path) Then
    Call ao_FSO.CreateFolder(as_Path)
  End If
  
  ls_PicName = as_Path & "IMG" & al_IMG_Id & ".jpg"
  If Not ao_FSO.FileExists(ls_PicName) Then
    If Not ao_Db.BlobToFileSQL("SELECT IMG_File FROM DPC_Image WHERE IMG_Id=" & al_IMG_Id, ls_PicName, True, False) Then
      Err.Raise ArmErr.CompFncFailed, "BlobToFileSQL", "Image download failed IMG_Id:" & al_IMG_Id & " Name: " & ls_PicName & " - " & ao_Db.LastErrorMessage
      Exit Function
    End If
  End If
  Set LoadDPCImage = LoadPicture(ls_PicName)
  Exit Function
ErrHandler:
  Call errorHandler("LoadDPCImage")
End Function

#If LIVE = 1 Then
Public Sub DrawDPCImage(ByVal ao_Db As Object, ByVal ao_FSO As Object, ByVal as_Path As String, ByVal al_IMG_Id As Long, ByVal ao_Canvas As PictureBox, Optional ByVal as_Message As String = "", Optional ByVal ab_Valid As Variant)
#Else
Public Sub DrawDPCImage(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_FSO As FileSystemObject, ByVal as_Path As String, ByVal al_IMG_Id As Long, ByVal ao_Canvas As PictureBox, Optional ByVal as_Message As String = "", Optional ByVal ab_Valid As Variant)
#End If
On Error GoTo ErrHandler

Dim lf_AspectRatioX As Double
Dim lf_AspectRatioY As Double
Dim lf_Width As Double
Dim lf_Height As Double
Dim lo_image As StdPicture
Dim ls_Req As String

  Set ao_Canvas.Picture = Nothing
  Set lo_image = LoadDPCImage(ao_Db, ao_FSO, as_Path, al_IMG_Id)
  If lo_image Is Nothing Then
    If as_Message <> "" Then
      Call PrintMessage(ao_Canvas, as_Message)
    End If
    Exit Sub
  End If
  
  lf_Width = ao_Canvas.ScaleX(lo_image.Width, vbHimetric, vbTwips)
  lf_Height = ao_Canvas.ScaleY(lo_image.Height, vbHimetric, vbTwips)
  
  If (lf_Height > ao_Canvas.ScaleHeight) Or (lf_Width > ao_Canvas.ScaleWidth) Then
    lf_AspectRatioX = ao_Canvas.ScaleWidth / lf_Width
    lf_AspectRatioY = ao_Canvas.ScaleHeight / lf_Height
    If lf_AspectRatioX < lf_AspectRatioY Then
      lf_Width = lf_Width * lf_AspectRatioX
      lf_Height = lf_Height * lf_AspectRatioX
    Else
      lf_Width = lf_Width * lf_AspectRatioY
      lf_Height = lf_Height * lf_AspectRatioY
    End If
  End If
  Call ao_Canvas.PaintPicture(lo_image, (ao_Canvas.ScaleWidth - lf_Width) / 2, (ao_Canvas.ScaleHeight - lf_Height) / 2, lf_Width, lf_Height)
  
  If StrComp(GetAConfigData("DPC_ImageValidation"), "X", vbTextCompare) = 0 Then
    If IsMissing(ab_Valid) Then
      ls_Req = "exec DPC_ImageInfo_sel $IMI_Id$, $Language_Code$"
      ls_Req = ReplacePlaceHolder(ls_Req, "$IMI_Id$", SqlInt(al_IMG_Id))
      ls_Req = ReplacePlaceHolder(ls_Req, "$Language_Code$", SQLStr("E"))
      ab_Valid = StrComp(SelectValue(ao_Db, ls_Req, "IMI_Valid"), "X", vbTextCompare) = 0
    End If
    If Not ab_Valid Then
      ao_Canvas.ForeColor = vbRed
      ao_Canvas.FillColor = vbRed
      ao_Canvas.FillStyle = FillStyleConstants.vbFSSolid
      ao_Canvas.BorderStyle = BorderStyleConstants.vbBSSolid
      ao_Canvas.DrawWidth = 5
      ao_Canvas.DrawStyle = DrawStyleConstants.vbSolid
      Call DrawLine(ao_Canvas, 0, 0, ao_Canvas.ScaleWidth, ao_Canvas.ScaleHeight)
    End If
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("DrawDPCImage")
End Sub

Public Sub PrintMessage(ByVal ao_Canvas As PictureBox, ByVal as_Message As String)
On Error GoTo ErrHandler
  
  ao_Canvas.CurrentX = (ao_Canvas.ScaleWidth - ao_Canvas.TextWidth(as_Message)) / 2
  ao_Canvas.CurrentY = (ao_Canvas.ScaleHeight - ao_Canvas.TextHeight(as_Message)) / 2
  ao_Canvas.Print as_Message
  Exit Sub
ErrHandler:
  Call errorHandler("PrintMessage")
End Sub

Public Sub DrawLine(ByVal ao_Canvas As PictureBox, ByVal ad_X1 As Double, ByVal ad_Y1 As Double, ByVal ad_X2 As Double, ByVal ad_Y2 As Double)
On Error GoTo ErrHandler
  
  ao_Canvas.Line (ad_X1, ad_Y1)-(ad_X2, ad_Y2)
  Exit Sub
ErrHandler:
  Call errorHandler("")
End Sub

Public Function HasContainer(ByRef aControl As Control, ByRef aContainer As Object) As Boolean
    
    HasContainer = False
    Dim lControl As Control
    
    Set lControl = aControl
    While Not (lControl Is Nothing)
        On Error GoTo NotFound
        If lControl.Container Is aContainer Then
            Set lControl = Nothing
            HasContainer = True
            Exit Function
        End If
        Set lControl = lControl.Container
    Wend

NotFound:
    Set lControl = Nothing
    HasContainer = False
End Function

Public Sub ClearFrame(ByRef ao_Controls As Object, ByVal ao_Frame As Frame)
On Error GoTo ErrHandler

Dim ll_Idx As Long, ll_Count As Long, lo_Control As Object
Dim lsa_Tag() As String

  ll_Count = ao_Controls.Count - 1
  For ll_Idx = 0 To ll_Count
    Set lo_Control = ao_Controls.Item(ll_Idx)
    
    If HasContainer(lo_Control, ao_Frame) Then
      lsa_Tag = Split(lo_Control.Tag, SEP1)
      Select Case UCase(TypeName(lo_Control))
      Case "TEXTBOX"
        lo_Control.Text = ""
      Case "ARMCOMBOBOX"
        Set lo_Control.SelectedItem = Nothing
      Case "ARMPICKER"
        Call lo_Control.Clear
      Case "A_CALOCX"
        lo_Control.reinit_cal
      Case "CHECKBOX"
        lo_Control.Value = vbUnchecked
      Case "ARMCHECKVIEW"
        Call lo_Control.Init
      Case "FRAME", "LABEL", "TOOLBARCONTROL", "COMMANDBUTTON", _
           "TABSTRIP", "DRIVELISTBOX", "DIRLISTBOX", "FILELISTBOX", "LISTVIEW"
        'do nothing
      Case "ARMGRID"
        lo_Control.ClearGrid
        lo_Control.Requests = ""
      Case "LISTBOX"
        lo_Control.ListIndex = -1
      Case "PICTUREBOX"
        Set lo_Control.Picture = Nothing
      Case "OPTIONBUTTON"
        Dim lv_Values As Variant
        lv_Values = Split(lo_Control.Tag, SEP)
        If UBound(lv_Values) >= 1 Then
            lo_Control.Value = lv_Values(1)
        Else
            lo_Control.Value = False
        End If
      Case "ARMTREEVIEW"
          'Call lo_Control.Clear
      Case "SHAPE"
        'do nothing
      Case Else
          Debug.Print "ClearFrame " & UCase(TypeName(lo_Control))
      End Select
    End If
  Next
  Set lo_Control = Nothing
  Exit Sub
ErrHandler:
  Set lo_Control = Nothing
  Call errorHandler("ClearFrame")
End Sub

Public Sub EnableFrame(ByRef aControls As Object, ByRef aContainer As Object, ByVal aEnabled As Boolean)
On Error GoTo ErrHandler

  Dim lIdx As Long, lCount As Long
  Dim lControl As Control
  
  lCount = aControls.Count - 1
  
  For lIdx = 0 To lCount
      Set lControl = aControls.Item(lIdx)
      If HasContainer(lControl, aContainer) Then
        Call EnableControl(lControl, aEnabled)
      End If
      Set lControl = Nothing
  Next
  Exit Sub
ErrHandler:
  Call errorHandler("EnableFrame aContainer=" & aContainer.Name)
End Sub

Public Sub EnableControl(ByVal ao_Control As Control, ByVal ab_Enabled As Boolean)
On Error GoTo ErrHandler

    Select Case UCase(TypeName(ao_Control))
        Case "FRAME", "LABEL", "MSFLEXGRID", "SHAPE", "ARMGRID", "ARMCHECKVIEW", "TABSTRIP"
            ' Do nothing !
        Case "LISTVIEW"
            ' Do nothing !
        Case "TEXTBOX"
            ao_Control.Locked = Not ab_Enabled
            ao_Control.BackColor = IIf(ab_Enabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
            ao_Control.TabStop = ab_Enabled
        Case "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "CHECKBOX", "COMMANDBUTTON", "TOOLBARCONTROL"
            ao_Control.Enabled = ab_Enabled
            ao_Control.TabStop = ab_Enabled
        Case Else
          Debug.Print ao_Control.Name
    End Select
  Exit Sub
ErrHandler:
  Call errorHandler("EnableControl")
End Sub

Public Function WhichOptionIsTrue(ByVal ao_OptionButtons As Object) As Long
On Error GoTo ErrHandler

Dim ll_Idx As Long

  For ll_Idx = 0 To ao_OptionButtons.Count - 1
    If ao_OptionButtons(ll_Idx).Value = True Then
      WhichOptionIsTrue = ao_OptionButtons(ll_Idx).Index
      Exit Function
    End If
  Next
  WhichOptionIsTrue = -1
  Exit Function
ErrHandler:
  Call errorHandler("WhichOptionIsTrue")
End Function

Public Sub ResetOptionButton(ByVal ao_OptionButtons As Object)
On Error GoTo ErrHandler

  Dim lo_OptionButton As VB.OptionButton
  For Each lo_OptionButton In ao_OptionButtons
    lo_OptionButton.Value = False
  Next
  Exit Sub
ErrHandler:
  Call errorHandler("ResetOptionButton")
End Sub


Public Function GetComboKey(ByVal ao_Combobox As ArmCombobox) As Variant
On Error GoTo ErrHandler

  If ao_Combobox.SelectedItem Is Nothing Then
    GetComboKey = Empty
  Else
    GetComboKey = ao_Combobox.SelectedItem.Key
  End If
  Exit Function
ErrHandler:
  Call errorHandler("GetComboKey")
End Function

Public Sub SetCalendarDate(ByVal ao_Cal As A_calocx, ByVal ad_Date As Date)
On Error GoTo ErrHandler

  If ad_Date = 0 Then
    Call ao_Cal.reinit_cal
  Else
    ao_Cal.date_courte = Format(ad_Date, "dd\/mm\/yyyy")
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetCalendarDate")
End Sub

Public Function GetComboData(ByVal ao_Combobox As ArmCombobox, ByVal av_Column As Variant) As Variant
On Error GoTo ErrHandler

  If ao_Combobox.SelectedItem Is Nothing Then
    GetComboData = Empty
  Else
    GetComboData = ao_Combobox.GetItemData(ao_Combobox.SelectedItem.Key, av_Column)
  End If
  Exit Function
ErrHandler:
  Call errorHandler("GetComboData")
End Function

Public Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    ReplacePlaceHolder = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)
    Exit Function
ErrHandler:
    Call errorHandler("ReplacePlaceholder")
End Function

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Public Sub ExecuteSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#Else
Public Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#End If
On Error GoTo ErrHandler

Dim lv_ErrorCodes As Variant
Dim lv_ErrorMessages As Variant

    If mb_InBatchTransaction Then
      Call mo_BatchRequest.Add(as_Request)
      Exit Sub
    End If

    ' First execute the request
    If Not ao_Db.ExecuteSQL(as_Request) Then
      lv_ErrorCodes = ao_Db.SQLErrorCodes
      lv_ErrorMessages = ao_Db.SQLErrorMessages
      If Not IsArray(lv_ErrorCodes) Then
        lv_ErrorCodes = Array(ao_Db.LastErrorCode)
        lv_ErrorMessages = Array(ao_Db.LastErrorMessage)
      End If
      If lv_ErrorCodes(0) = 547 Then
          Err.Raise ArmErr.SQLTableReferenceConstraint, "SQL : " & as_Request, Join(lv_ErrorCodes, SEP2) & SEP1 & Join(lv_ErrorMessages, SEP2)
      End If
      Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(lv_ErrorCodes, SEP2) & SEP1 & Join(lv_ErrorMessages, SEP2)
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise ArmErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            End If
        End If
    End If
    
    Exit Sub

ErrHandler:
    Call errorHandler("ExecuteSQLSafe")
End Sub

#If LIVE = 1 Then
Public Function OpenSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Public Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If
On Error GoTo ErrHandler
    Dim lc_Data As Long
    Dim lv_ErrorCodes As Variant
    Dim lv_ErrorMessages As Variant
    
    lc_Data = ao_Db.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
      lv_ErrorCodes = ao_Db.SQLErrorCodes
      lv_ErrorMessages = ao_Db.SQLErrorMessages
      If Not IsArray(lv_ErrorCodes) Then
        lv_ErrorCodes = Array(ao_Db.LastErrorCode)
        lv_ErrorMessages = Array(ao_Db.LastErrorMessage)
      End If
      Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(lv_ErrorCodes, SEP2) & SEP1 & Join(lv_ErrorMessages, SEP2)
    End If
'    Debug.Print 1 / 0
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data
    Exit Function
ErrHandler:
    Call errorHandler("OpenSQLSafe")
End Function

#If LIVE = 1 Then
Public Function GetDbError(ByVal lo_Db As Object) As String
#Else
Public Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call errorHandler("GetDbError()")
End Function

' procedure save/restore err object
Public Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errnum As Long
    
  If ab_saveError Then
    ls_ErrDesc = Err.Description
    ls_ErrSource = Err.Source
    ll_errnum = Err.Number
  Else
    Err.Description = ls_ErrDesc
    Err.Source = ls_ErrSource
    Err.Number = ll_errnum
  End If
End Sub

#If LIVE = 1 Then
Public Sub BeginBatchTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#Else
Public Sub BeginBatchTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
On Error GoTo ErrHandler

  If mb_InBatchTransaction Then
    Err.Raise ArmErr.InvalidArgument, "ab_BatchMode", "Application already in batch mode: " & ms_BatchTransaction
  End If
  mb_InBatchTransaction = True
  ms_BatchTransaction = as_Tran
  Call ClearCollection(mo_BatchRequest)
  Call mo_BatchRequest.Add("BEGIN TRANSACTION " & as_Tran)
  Exit Sub
ErrHandler:
End Sub

#If LIVE = 1 Then
Public Sub CommitBatchTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#Else
Public Sub CommitBatchTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
On Error GoTo ErrHandler
    
Dim ls_ErrSource As String
Dim ls_errDescription As String
Dim ls_LogMessage As String
Dim ls_Req As String
Dim ll_Idx As Long
Dim lb_InTran As Boolean
  
  If Not mb_InBatchTransaction Then
    Err.Raise ArmErr.InvalidArgument, "as_Tran", "Application NOT in batch mode: " & as_Tran
  End If
  If ms_BatchTransaction <> as_Tran Then
    Err.Raise ArmErr.InvalidArgument, as_Tran, "Application in batch mode with different transaction name: " & ms_BatchTransaction
  End If
  
  ls_Req = ""
  For ll_Idx = 1 To mo_BatchRequest.Count
    ls_Req = ls_Req & mo_BatchRequest(ll_Idx) & ";" & vbCrLf
  Next
  
  lb_InTran = True
  mb_InBatchTransaction = False
  Call ExecuteSQLSafe(ao_Db, ls_Req)
  Call ExecuteSQLSafe(ao_Db, "COMMIT TRANSACTION " & as_Tran)
  lb_InTran = False
  ms_BatchTransaction = ""
  Call ClearCollection(mo_BatchRequest)
  Exit Sub
ErrHandler:
  If lb_InTran Then
    Call mo_Db.ExecuteSQL("ROLLBACK TRANSACTION " & as_Tran)
  End If
  ls_ErrSource = as_ScreenName & ".COMMITTRAN(" & as_Tran & ") & SEP1 & Err.Source"
  ls_errDescription = Err.Description
  ls_LogMessage = as_ScreenName & " exception. Nr:" & Err.Number & ",Src:" & ls_ErrSource & ",Desc: " & ls_errDescription & "@"
  Call LogMessage(ao_Db, al_U_Code, as_ScreenName, ls_LogMessage)
  MsgBox "A Fatal error occured in " & as_ScreenName & ".CommitTran, your application will be closed. Please contact your IT support." & vbCrLf & _
    ls_LogMessage, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  End
End Sub

#If LIVE = 1 Then
Public Sub RollbackBatchTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#Else
Public Sub RollbackBatchTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
    
Dim ll_errNumber As Long
Dim ls_ErrSource As String
Dim ls_errDescription As String
Dim ls_LogMessage As String

  ll_errNumber = Err.Number
  ls_ErrSource = Err.Source
  ls_errDescription = Err.Description

On Error GoTo ErrHandler
    
  If Not mb_InBatchTransaction Then
    Err.Raise ArmErr.InvalidArgument, "ab_BatchMode", "Application NOT in batch mode: " & as_Tran
  End If
  Call ExecuteSQLSafe(ao_Db, "ROLLBACK TRANSACTION " & as_Tran)
  mb_InBatchTransaction = False
  ms_BatchTransaction = ""
  
  Err.Number = ll_errNumber
  Err.Source = ls_ErrSource
  Err.Description = ls_errDescription
  Exit Sub
ErrHandler:
  'try to log error
  ls_LogMessage = as_ScreenName & ".ROLLBACK(" & as_Tran & ") exception. Nr:" & Err.Number & "+" & ll_errNumber & ",Src:" & ls_ErrSource & ",Desc: " & ls_errDescription & "@"
  Call LogMessage(ao_Db, al_U_Code, as_ScreenName, ls_LogMessage)
  MsgBox "A Fatal error occured in " & as_ScreenName & ".RollbackTran, your application will be closed. Please contact your IT support." & vbCrLf & _
    ls_LogMessage, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  End
End Sub

#If LIVE = 1 Then
Public Sub BeginTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)

#Else
Public Sub BeginTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
On Error GoTo ErrHandler

Dim ls_ErrSource As String
Dim ls_errDescription As String
Dim ls_LogMessage As String
  
  If mb_InBatchTransaction Then
    Err.Raise ArmErr.InvalidArgument, "ab_BatchMode", "Application in batch mode: " & ms_BatchTransaction
  End If
  Call ExecuteSQLSafe(ao_Db, "BEGIN TRANSACTION " & as_Tran)
  Exit Sub
ErrHandler:
  'try to log error
  ls_ErrSource = as_ScreenName & ".BEGINTRAN(" & as_Tran & ") & SEP1 & Err.Source"
  ls_errDescription = Err.Description
  ls_LogMessage = as_ScreenName & " exception. Nr:" & Err.Number & ",Src:" & ls_ErrSource & ",Desc: " & ls_errDescription & "@"
  Call LogMessage(ao_Db, al_U_Code, as_ScreenName, ls_LogMessage)
  MsgBox "A Fatal error occured in " & as_ScreenName & ".BeginTran, your application will be closed. Please contact your IT support." & vbCrLf & _
    ls_LogMessage, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  End
End Sub

#If LIVE = 1 Then
Public Sub CommitTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#Else
Public Sub CommitTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
On Error GoTo ErrHandler
    
Dim ls_ErrSource As String
Dim ls_errDescription As String
Dim ls_LogMessage As String
  
  If mb_InBatchTransaction Then
    Err.Raise ArmErr.InvalidArgument, "ab_BatchMode", "Application in batch mode: " & ms_BatchTransaction
  End If
  Call ExecuteSQLSafe(ao_Db, "COMMIT TRANSACTION " & as_Tran)
  Exit Sub
ErrHandler:
  Call mo_Db.ExecuteSQL("ROLLBACK TRANSACTION " & as_Tran)
  ls_ErrSource = as_ScreenName & ".COMMITTRAN(" & as_Tran & ") & SEP1 & Err.Source"
  ls_errDescription = Err.Description
  ls_LogMessage = as_ScreenName & " exception. Nr:" & Err.Number & ",Src:" & ls_ErrSource & ",Desc: " & ls_errDescription & "@"
  Call LogMessage(ao_Db, al_U_Code, as_ScreenName, ls_LogMessage)
  MsgBox "A Fatal error occured in " & as_ScreenName & ".CommitTran, your application will be closed. Please contact your IT support." & vbCrLf & _
    ls_LogMessage, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  End
End Sub

#If LIVE = 1 Then
Public Sub RollbackTran(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#Else
Public Sub RollbackTran(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, as_Tran As String)
#End If
    
Dim ll_errNumber As Long
Dim ls_ErrSource As String
Dim ls_errDescription As String
Dim ls_LogMessage As String

  ll_errNumber = Err.Number
  ls_ErrSource = Err.Source
  ls_errDescription = Err.Description

On Error GoTo ErrHandler
    
  Call ExecuteSQLSafe(ao_Db, "ROLLBACK TRANSACTION " & as_Tran)
  
  Err.Number = ll_errNumber
  Err.Source = ls_ErrSource
  Err.Description = ls_errDescription
  Exit Sub
ErrHandler:
  'try to log error
  ls_LogMessage = as_ScreenName & ".ROLLBACK(" & as_Tran & ") exception. Nr:" & Err.Number & "+" & ll_errNumber & ",Src:" & ls_ErrSource & ",Desc: " & ls_errDescription & "@"
  Call LogMessage(ao_Db, al_U_Code, as_ScreenName, ls_LogMessage)
  MsgBox "A Fatal error occured in " & as_ScreenName & ".RollbackTran, your application will be closed. Please contact your IT support." & vbCrLf & _
    ls_LogMessage, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  End
End Sub

' logs message to database
#If LIVE = 1 Then
Public Sub LogMessage(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, ByVal as_logMsg As String, Optional ByVal as_logType As String = "E", Optional ByVal ab_ExitOnException As Boolean = True)
#Else
Public Sub LogMessage(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, ByVal as_logMsg As String, Optional ByVal as_logType As String = "E", Optional ByVal ab_ExitOnException As Boolean = True)
#End If
On Error GoTo ErrHandler
    
Const LOG_REQUEST As String = "EXEC A_log_ins $UCODE$,$LOGTYPE$,$MSG$,$APP$"
    
Dim ls_Req As String
Dim ll_Cursor As Long
Dim ls_Source As String, ls_Msg As String
  
  ls_Source = as_ScreenName & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  
  ls_Req = ReplacePlaceHolder(LOG_REQUEST, "$UCODE$", SqlInt(al_U_Code))
  ls_Req = ReplacePlaceHolder(ls_Req, "$LOGTYPE$", SQLStr(as_logType))
  ls_Req = ReplacePlaceHolder(ls_Req, "$MSG$", SQLStr(Trim(as_logMsg), 4000))
  ls_Req = ReplacePlaceHolder(ls_Req, "$APP$", SQLStr(Trim(ls_Source), 50))
  
  Call ExecuteSQLSafe(ao_Db, ls_Req)
  Exit Sub
ErrHandler:
  If ab_ExitOnException Then
    Call MsgBox("A fatal error occured. Unable to log error into database, the application will be closed. Please report the following message to your IT support: " & vbCrLf & _
      as_logMsg & " - " & ls_Source & "LogMessage exception " & Err.Number & "-" & Err.Description, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
  Else
    Call ao_Db.Disconnect
  End If
End Sub

' ************************************************************************************
' *************************** INTERNATIONAL FUNCTIONS ********************************
' ************************************************************************************

Public Function GetAReferenceData(ByVal ae_GR_Code As eDPCReferenceML, al_RF_Code As Long, ByVal as_Language_Code As String) As String
On Error GoTo ErrHandler
    
  Dim ls_Req As String
  Dim lc_Cursor As Long
  Dim ls_Key As String
  
  ls_Key = ae_GR_Code & SEP & al_RF_Code & SEP & as_Language_Code
  If mo_References.Exists(ls_Key) Then
    GetAReferenceData = mo_References.Item(ls_Key)
    Exit Function
  Else
    ls_Req = "exec A_References_ML_Lst $GR_Code$, $Language_Code$"
    ls_Req = Replace(ls_Req, "$GR_Code$", SqlInt(ae_GR_Code), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$Language_Code$", SQLStr(as_Language_Code), , , vbTextCompare)
    lc_Cursor = OpenSQLSafe(mo_Db, ls_Req)
    While Not mo_Db.EOF(lc_Cursor)
      ls_Key = ae_GR_Code & SEP & mo_Db.GetFields(lc_Cursor, "RF_Code") & SEP & as_Language_Code
      Call mo_References.Add(ls_Key, mo_Db.GetFields(lc_Cursor, "RF_Desc"))
      Call mo_Db.Next(lc_Cursor)
    Wend
    Call mo_Db.Close(lc_Cursor)
    
    ls_Key = ae_GR_Code & SEP & 0 & SEP & as_Language_Code
    If Not mo_References.Exists(ls_Key) Then
      Call mo_References.Add(ls_Key, "")
    End If
  End If
  
  ls_Key = ae_GR_Code & SEP & al_RF_Code & SEP & as_Language_Code
  If mo_References.Exists(ls_Key) Then
    GetAReferenceData = mo_References.Item(ls_Key)
  Else
    GetAReferenceData = ""
  End If
  Exit Function
ErrHandler:
  Call errorHandler("GetAReferenceData")
End Function

Public Function GetAConfigData(ByVal as_CFG_Key As String) As String
On Error GoTo ErrHandler
    
  Dim ls_Req As String
  
  If mc_A_Config = 0 Then
    ls_Req = "exec A_Config_lst $KEY$"
    ls_Req = Replace(ls_Req, "$KEY$", SQLStr("DPC_%"), , , vbTextCompare)
    mc_A_Config = OpenSQLSafe(mo_Db, ls_Req)
  End If
  If mo_Db.Find(mc_A_Config, "CFG_key", as_CFG_Key, 0, 1) < 0 Then
    Err.Raise ArmErr.InvalidValue, "as_CFG_Key", "A_Config record not found for CFG_Key=" & as_CFG_Key
  End If
  GetAConfigData = mo_Db.GetFields(mc_A_Config, "CFG_Value")
  'do not close this cursor, it is cached in class and will be closed when Unload_A_COM
  Exit Function
ErrHandler:
  Call errorHandler("GetAConfigData")
End Function

Public Function GetUM_Name(ByVal as_UM_Code As String, ByVal as_Language_Code As String) As String
On Error GoTo ErrHandler
    
  Dim ls_Req As String
  
  ls_Req = "SELECT UM_Name FROM unit_of_measure WHERE UM_Code=$UM_Code$ AND Language_Code=$Language_Code$"
  ls_Req = Replace(ls_Req, "$UM_Code$", SQLStr(as_UM_Code), , , vbTextCompare)
  ls_Req = Replace(ls_Req, "$Language_Code$", SQLStr(as_Language_Code), , , vbTextCompare)
  GetUM_Name = SelectValue(mo_Db, ls_Req)
  Exit Function
ErrHandler:
  Call errorHandler("GetUM_Name")
End Function

Public Function HasSecurityAlias(ByVal as_LoginName As String, ByVal as_Alias As String) As Boolean
On Error GoTo ErrHandler
  Dim ls_Req As String
  
  HasSecurityAlias = False
  If mc_Security_Alias = 0 Then
    ls_Req = "SELECT alias FROM security_alias WHERE login_name=$Login_Name$"
    ls_Req = ReplacePlaceHolder(ls_Req, "$Login_Name$", SQLStr(as_LoginName))
    mc_Security_Alias = OpenSQLSafe(mo_Db, ls_Req)
  End If
  If mo_Db.Find(mc_Security_Alias, "alias", as_Alias, 0, 1) >= 0 Then
    HasSecurityAlias = True
  End If
  'do not close this cursor, it is cached in class and will be closed when Unload_A_COM
  Exit Function
ErrHandler:
  Call errorHandler("HasSecurityAlias")
End Function

#If LIVE = 1 Then
Public Function GetCodePageFromLanguage(ByRef ao_Db As Object, ByVal as_Language As String) As Long
#Else
Public Function GetCodePageFromLanguage(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Language As String) As Long
#End If
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT Code_Page FROM Language WHERE Language_Code = '$Language_Code$'"
    Dim ls_Req As String
    
    ls_Req = ReplacePlaceHolder(C_REQ, "$Language_Code$", as_Language)
    GetCodePageFromLanguage = CLng(SelectValue(ao_Db, ls_Req))
    Exit Function
ErrHandler:
    Call errorHandler("GetCodePageFromLanguage")
End Function

'convert code page into charset integer
Public Function GetCharSetFromCodePage(ByVal al_CodePage As Long) As Long

On Error GoTo ErrHandler

    Select Case CStr(al_CodePage)
        Case 932 ' Japanese
            GetCharSetFromCodePage = 128
        Case 936 ' Simplified Chinese
            GetCharSetFromCodePage = 134
        Case 949 ' Korean
            GetCharSetFromCodePage = 129
        Case 950 ' Traditional Chinese
            GetCharSetFromCodePage = 136
        Case 1250 ' Eastern Europe
            GetCharSetFromCodePage = 238
        Case 1251 ' Russian
            GetCharSetFromCodePage = 204
        Case 1252 ' Western European Languages
            GetCharSetFromCodePage = 0
        Case 1253 ' Greek
            GetCharSetFromCodePage = 161
        Case 1254 ' Turkish
            GetCharSetFromCodePage = 162
        Case 1255 ' Hebrew
            GetCharSetFromCodePage = 177
        Case 1256 ' Arabic
            GetCharSetFromCodePage = 178
        Case 1257 ' Baltic
            GetCharSetFromCodePage = 186
        Case Else
            GetCharSetFromCodePage = 0
    End Select
    
    Exit Function
    
ErrHandler:
    Call errorHandler("GetCharSetFromCodePage()")
End Function

Public Sub ChangeCharset(ByRef ao_Container As Object, ByVal al_CodePageStatic As Long, Optional al_CodePageDynamic As Long = 0)
On Error GoTo ErrHandler
   
  Dim lc_Control As Control
  Dim ll_CharsetStatic As Long, ll_CharsetDynamic As Long
  
  If al_CodePageDynamic = 0 Then
    al_CodePageDynamic = al_CodePageStatic
  End If
  ll_CharsetStatic = GetCharSetFromCodePage(al_CodePageStatic)
  ll_CharsetDynamic = GetCharSetFromCodePage(al_CodePageDynamic)
  
  For Each lc_Control In ao_Container
    Select Case UCase(TypeName(lc_Control))
    Case "TABSTRIP", "LABEL", "FRAME", "COMMANDBUTTON", _
         "CHECKBOX", "OPTIONBUTTON"
        lc_Control.Font.Name = "Arial"
        lc_Control.Font.Charset = ll_CharsetStatic
    Case "TEXTBOX", "LISTVIEW", "ARMCHECKVIEW", "ARMTREEVIEW", _
         "ARMGRID", "ARMCOMBOBOX", "ARMCHECKVIEW0", "ARMPICKER"
        lc_Control.Font.Name = "Arial"
        lc_Control.Font.Charset = ll_CharsetDynamic
    Case "A_SEEK", "A_SRCHTXT"
        lc_Control.Charset = ll_CharsetDynamic
    End Select
  Next
  Exit Sub
ErrHandler:
  Call errorHandler("ChangeCharset al_CodePageStatic=" & al_CodePageStatic & " al_CodePageDynamic=" & al_CodePageDynamic)
End Sub

#If LIVE = 1 Then
Public Sub LoadToolbars(ByVal ao_Db As Object, ByVal ao_Controls As Object, ByVal as_ModuleName As String, Optional ByVal as_ScreenName As String = "")
#Else
Public Sub LoadToolbars(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_Controls As Object, ByVal as_ModuleName As String, Optional ByVal as_ScreenName As String = "")
#End If
On Error GoTo ErrHandler

Dim ls_Request As String
Dim lc_Toolbars As Long
Dim ls_ToolbarInfo As String
Dim lo_Control As Object
Dim ll_ID As Long

  ls_Request = "exec Toolbars_Definitions_sel $App$, $Module$, $Screen$"
  ls_Request = ReplacePlaceHolder(ls_Request, "$App$", SQLStr("Sifyb2"))
  ls_Request = ReplacePlaceHolder(ls_Request, "$Module$", SqlStrKey(as_ModuleName))
  ls_Request = ReplacePlaceHolder(ls_Request, "$Screen$", SqlStrKey(as_ScreenName))
  lc_Toolbars = OpenSQLSafe(ao_Db, ls_Request)
  
  For Each lo_Control In ao_Controls
    ll_ID = Val(lo_Control.Tag)
    If StrComp(TypeName(lo_Control), "ToolbarControl", vbTextCompare) = 0 Then
      If ao_Db.Find(lc_Toolbars, "Id", ll_ID) < 0 Then
          Err.Raise ArmErr.InvalidValue, lo_Control.Name, "Toolbar not found in toolbars_definitions ID:" & ll_ID
      End If
      
      ls_ToolbarInfo = ao_Db.GetFields(lc_Toolbars, "info")
      If Not lo_Control.SetToolbarInfoStringParameters(ls_ToolbarInfo, Left(ls_ToolbarInfo, 3)) Then
          Err.Raise ArmErr.InvalidValue, lo_Control.Name, "SetToolbarInfoStringParameters failed for toolbar ID:" & ll_ID
      End If
      Call lo_Control.DisplayFace("0")
    End If
  Next
  Call ao_Db.Close(lc_Toolbars)
  Exit Sub
ErrHandler:
  Call errorHandler("LoadToolbars")
End Sub

#If LIVE = 1 Then
Public Function LoadTreeViewInfo(ByVal ao_Db As Object, ByVal as_ScreenName As String, ByVal as_TVCode As String) As Variant
#Else
Public Function LoadTreeViewInfo(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_ScreenName As String, ByVal as_TVCode As String) As Variant
#End If
On Error GoTo ErrHandler

Dim ls_Request As String
Dim lc_Cursor As Long, ll_Idx As Long, ll_Count As Long
Dim lv_NodeReq As Variant
Dim lv_GridReq As Variant
Dim lv_Image As Variant
Dim lv_SelImage As Variant
    
  ' Get the data from the DB
  ls_Request = "EXEC Treeview_Parameters_lst " & SQLStr(as_ScreenName) & ", " & SQLStr(as_TVCode)
  lc_Cursor = OpenSQLSafe(ao_Db, ls_Request)
  
  ll_Count = ao_Db.RowCount(lc_Cursor) - 1
  
  If ll_Count < 0 Then
      Call Err.Raise(ArmErr.InvalidValue, ls_Request, "as_ScreenName=" & as_ScreenName & " as_TVCode=" & as_TVCode)
  End If
  
  ReDim lv_NodeReq(ll_Count)
  ReDim lv_GridReq(ll_Count)
  ReDim lv_Image(ll_Count)
  ReDim lv_SelImage(ll_Count)
  
  Dim ll_Level As Long
  For ll_Idx = 0 To ll_Count
    ll_Level = ao_Db.GetFields(lc_Cursor, "TV_Level")
    lv_NodeReq(ll_Level) = ao_Db.GetFields(lc_Cursor, "TV_NodeRequest")
    lv_GridReq(ll_Level) = ao_Db.GetFields(lc_Cursor, "TV_GridRequest")
    lv_Image(ll_Level) = ao_Db.GetFields(lc_Cursor, "TV_Images")
    lv_SelImage(ll_Level) = ao_Db.GetFields(lc_Cursor, "TV_SelectedImages")
    Call ao_Db.Next(lc_Cursor)
  Next
  
  LoadTreeViewInfo = Array(lv_NodeReq, lv_GridReq, lv_Image, lv_SelImage)
  
  Call ao_Db.Close(lc_Cursor)
  Exit Function
ErrHandler:
  Call ao_Db.Close(lc_Cursor)
  Call errorHandler("LoadTreeViewInfo")
End Function

#If LIVE = 1 Then
Public Sub LoadComboView(ByVal ao_Db As Object, ByVal ao_Combo As ArmCombobox, ByVal as_Screen_Name As String, ByVal as_Language_Code As String)
#Else
Public Sub LoadComboView(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_Combo As ArmCombobox, ByVal as_Screen_Name As String, ByVal as_Language_Code As String)
#End If
On Error GoTo ErrHandler
  
Dim ls_Request As String
   
  ls_Request = ReplacePlaceHolder("exec TreeView_View_t_lst $ViewCode$,$Language_Code$", "$ViewCode$", SQLStr(as_Screen_Name))
  ls_Request = ReplacePlaceHolder(ls_Request, "$Language_Code$", SQLStr(as_Language_Code))
  
  ao_Combo.Request = ls_Request
  Call ao_Combo.Load
  
  Call ao_Combo.SearchItem("X", "TV_Default", 0)
  Exit Sub
ErrHandler:
  Call errorHandler("LoadComboView")
End Sub

Public Function ReplaceLanguagePlaceholderFromToolbar(ByVal as_Request As String, ByRef ao_Toolbar As ToolbarControl) As String
On Error GoTo ErrHandler

  ReplaceLanguagePlaceholderFromToolbar = ReplacePlaceHolder(as_Request, "$toolbar_language_code$", SQLStr(ao_Toolbar.Language))
  Exit Function
ErrHandler:
  Call errorHandler("ReplaceLanguagePlaceholderFromToolbar")
End Function

Public Function ReplacePlaceholderByControlValue(ByVal as_Request As String, ByRef ao_Control As Object) As String
On Error GoTo ErrHandler

Dim lsa_Columns() As String

  If Trim(ao_Control.Tag) = "" Then
    ReplacePlaceholderByControlValue = as_Request
    Exit Function
  End If
  
  Select Case UCase(TypeName(ao_Control))
  Case "ARMCOMBOBOX"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    
    If UBound(lsa_Columns) >= 0 Then
      If GetComboKey(ao_Control) = "" Then
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
      Else
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(GetComboKey(ao_Control)))
      End If
    End If
    If UBound(lsa_Columns) >= 1 Then
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SQLStr(ao_Control.Text))
    End If
  Case "ARMPICKER"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    
    If UBound(lsa_Columns) >= 0 Then
      If (Trim(CStr(ao_Control.ItemCode)) = "") Or (CStr(ao_Control.ItemCode) = "0") Then
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
      Else
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(Trim(CStr(ao_Control.ItemCode))))
      End If
    End If
    If UBound(lsa_Columns) >= 1 Then
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SQLStr(Trim(ao_Control.ItemDescription)))
    End If
  Case "OPTIONBUTTON"
    If ao_Control.Value = True Then
      lsa_Columns = Split(ao_Control.Tag, SEP)
      If UBound(lsa_Columns) > 1 Then
        Select Case UCase(lsa_Columns(2))
        Case "N"
          as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", ao_Control.Index)
        Case Else
          as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(lsa_Columns(1)))
        End Select
      ElseIf UBound(lsa_Columns) = 1 Then
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(lsa_Columns(1)))
      Else
        as_Request = ReplacePlaceHolder(as_Request, "$" & ao_Control.Name & "$", SQLStr(lsa_Columns(0)))
      End If
    End If
  Case "CHECKBOX"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    If ao_Control.Value = vbChecked Then
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr("X"))
    Else
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(""))
    End If
  Case "TEXTBOX"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    If UBound(lsa_Columns) > 0 Then
      Select Case UCase(lsa_Columns(1))
      Case "N", "F"
        If ao_Control.Text = "" Then
          as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
        Else
          as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDbl(CDbl(ao_Control.Text)))
        End If
      Case Else
        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.Text))
      End Select
    Else
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.Text))
    End If
  Case "A_CALOCX"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDate(ao_Control.date_dt))
  Case "TABSTRIP"
    lsa_Columns = Split(ao_Control.Tag, SEP)
    If StrComp(ao_Control.SelectedItem.Key, "ALL", vbTextCompare) = 0 Then
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
    Else
      as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.SelectedItem.Key))
    End If
  End Select
  ReplacePlaceholderByControlValue = as_Request
  Exit Function
ErrHandler:
  Call errorHandler("ReplacePlaceholderByControlValue")
End Function

Public Function ReplaceRequestByFrameData(ByVal as_Request As String, ByVal ao_Controls As Object, ByVal ao_Frame As VB.Frame)
On Error GoTo ErrHandler

Dim lo_Control As Control
   
  For Each lo_Control In ao_Controls
    If HasContainer(lo_Control, ao_Frame) Then
      as_Request = ReplacePlaceholderByControlValue(as_Request, lo_Control)
    End If
  Next
  ReplaceRequestByFrameData = as_Request
  Exit Function
ErrHandler:
  Call errorHandler("ReplaceRequestByFrameData")
End Function

Private Sub SaveScreenConst(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Control_Name As String, ByVal as_Screen_Name As String, ByVal as_Field_Name As String, ByVal as_Local_Text As String)
On Error GoTo ErrHandler
Dim ls_Req As String
Dim ll_Cursor As Long

  ' this is test or temporary control, which will be removed in final version
  If Trim(as_Field_Name) = "#tmp#" Then Exit Sub
  
  If Trim(as_Field_Name) = "" Then
    Debug.Print as_Control_Name & ".Text(" & as_Local_Text & ") : Undefined tag"
    Exit Sub
  End If
  
  ' this is selection button
  If as_Local_Text = "..." Then Exit Sub
  ' this has not defined translatable content
  If Trim(as_Local_Text) = "" Then Exit Sub
  ' dynamic control, content of this control is independent of screen constants
  If Left(as_Field_Name, 1) = "_" Then Exit Sub
  
  If Left(as_Local_Text, 1) <> "#" Then
    If as_Local_Text <> "" Then
      Debug.Print as_Control_Name & ".Text(" & as_Local_Text & ").Tag(" & as_Field_Name & ") : Prefix # missing"
    End If
  Else
    as_Local_Text = right(as_Local_Text, Len(as_Local_Text) - 1)
  End If
  
  If Len(as_Field_Name) > 30 Then
    Debug.Print "Length of field name overflow: " & as_Field_Name
    Debug.Assert False
    Exit Sub
  End If
  
  ''check if exists
  ls_Req = "SELECT * from screen_constants WHERE screen_name=$screen_name$ and field_name=$field_name$"
  
  ls_Req = Replace(ls_Req, "$screen_name$", SQLStr(as_Screen_Name), , , vbTextCompare)
  ls_Req = Replace(ls_Req, "$field_name$", SQLStr(as_Field_Name), , , vbTextCompare)
  ll_Cursor = OpenSQLSafe(ao_Db, ls_Req)
  
  If ao_Db.RowCount(ll_Cursor) > 0 Then
    ao_Db.Close (ll_Cursor)
    Exit Sub
  End If
  ao_Db.Close (ll_Cursor)
  
  ls_Req = "INSERT INTO screen_constants (screen_name,field_name,language_code,language_order,authorized_length,local_text,th_code,z_last_upd)"
  ls_Req = ls_Req & " VALUES "
  ls_Req = ls_Req & "($screen_name$,$field_name$,'E','Z',30,$local_text$,NULL,NULL)"
  
  ls_Req = Replace(ls_Req, "$screen_name$", SQLStr(as_Screen_Name), , , vbTextCompare)
  ls_Req = Replace(ls_Req, "$field_name$", SQLStr(as_Field_Name), , , vbTextCompare)
  ls_Req = Replace(ls_Req, "$local_text$", SQLStr(as_Local_Text), , , vbTextCompare)
  Call ExecuteSQLSafe(ao_Db, ls_Req)
  Exit Sub
ErrHandler:
  If InStr(1, Err.Description, "Violation of PRIMARY KEY constraint", vbTextCompare) > 0 Then
    Debug.Print as_Control_Name & ".Text(" & as_Local_Text & ").Tag(" & as_Field_Name & ") : Label duplicity"
  Else
    Call errorHandler("SaveScreenConst")
  End If
End Sub

Public Sub SaveLabels(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_Controls As Object, ByVal ao_Container As Object, ByVal as_ScreenName As String)
Dim lo_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim ls_Req As String
  
  If (GetAsyncKeyState(vbKeyShift) >= 0) And (GetAsyncKeyState(vbKeyControl) >= 0) Then Exit Sub
  If MsgBox("Are you sure to regenerate screen constants for screen: " & as_ScreenName & " ? ", vbYesNo) = vbNo Then Exit Sub
  Debug.Print "Begin saving labels: " & as_ScreenName
On Error GoTo WithoutTag
    Call SaveScreenConst(ao_Db, as_ScreenName, ao_Container.Name, ao_Container.Tag, ao_Container.Caption)
WithoutTag:

On Error GoTo ErrHandler
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lo_Control In ao_Controls
        
        If HasContainer(lo_Control, ao_Container) Or (UCase(TypeName(lo_Control)) = "MENU") Then
            Select Case UCase(TypeName(lo_Control))
                Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                    Dim lo_Tbs
                    Set lo_Tbs = lo_Control ' Cast for use of intellisense
                    
                    If Trim(lo_Control.Tag) = "" Then
                      Debug.Print "TabStrip " & lo_Control.Name & " has no tag"
                      Exit Sub
                    End If
                    
                    li_Count = lo_Tbs.Tabs.Count
                    For li_Idx = 1 To li_Count
                      If Trim(lo_Tbs.Tabs(li_Idx).Key) = "" Then
                        Debug.Print "TabStrip tab " & lo_Control.Name & "." & lo_Tbs.Tabs(li_Idx).Index & " has no Key"
                      Else
                        Call SaveScreenConst(ao_Db, lo_Tbs.Tabs(li_Idx).Key, as_ScreenName, lo_Control.Tag & "." & lo_Tbs.Tabs(li_Idx).Key, lo_Tbs.Tabs(li_Idx).Caption)
                      End If
                    Next
                
                Case UCase("ListView") ' Component is a listview, we load the caption of each columns
                    Dim lo_ListView As ListView
                    Set lo_ListView = lo_Control
                    
                    If Trim(lo_Control.Tag) = "" Then
                      Debug.Print "ListView " & lo_Control.Name & " has no tag"
                      Exit Sub
                    End If
                    
                    li_Count = lo_ListView.ColumnHeaders.Count
                    If (li_Count = 0) And (lo_ListView.View = lvwReport) Then
                      Debug.Print "Listview " & lo_ListView.Name & " has 0 columns !"
                    Else
                      For li_Idx = 1 To li_Count
                        If Trim(lo_ListView.ColumnHeaders(li_Idx).Tag) = "" Then
                          Debug.Print "ListView column " & lo_Control.Name & "." & lo_ListView.ColumnHeaders(li_Idx).Key & " has no tag"
                        Else
                          Call SaveScreenConst(ao_Db, lo_ListView.Name & "." & lo_ListView.ColumnHeaders(li_Idx).Key, as_ScreenName, lo_Control.Tag & "." & lo_ListView.ColumnHeaders(li_Idx).Tag, lo_ListView.ColumnHeaders(li_Idx).Text)
                        End If
                      Next
                    End If
                Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
                    Call SaveScreenConst(ao_Db, lo_Control.Name, as_ScreenName, lo_Control.Tag, lo_Control.Caption)
                
                Case UCase("ArmGrid")
                    Dim lo_Grid As ArmGrid
                    Dim lo_Column As ArmColumn
                    
                    Set lo_Grid = lo_Control
                    
                    If Trim(lo_Control.Tag) = "" Then
                      Debug.Print "Armgrid " & lo_Control.Name & " has no tag"
                      Exit Sub
                    End If
                    
                    If StrComp(lo_Grid.Title, "Title", vbTextCompare) <> 0 Then
                      Call SaveScreenConst(ao_Db, lo_Control.Name, as_ScreenName, lo_Control.Tag & "_Title", lo_Grid.Title)
                    End If
                    
                    li_Count = lo_Grid.Cols
                    If li_Count = 0 Then
                      Debug.Print "Armgrid " & lo_Control.Name & " has 0 columns"
                    Else
                      For li_Idx = 0 To li_Count - 1
                        Set lo_Column = lo_Grid.Columns(li_Idx)
                        If Trim(lo_Column.Name) = "" Then
                          Debug.Print "Armgrid column " & lo_Control.Name & "." & li_Idx & " has no name"
                        Else
                          Call SaveScreenConst(ao_Db, lo_Control.Name & "." & lo_Column.Name, as_ScreenName, lo_Control.Tag & "." & lo_Column.Name, lo_Column.Title)
                        End If
                      Next
                    End If
                Case UCase("Menu")
                    Call SaveScreenConst(ao_Db, lo_Control.Name, as_ScreenName, lo_Control.Tag, lo_Control.Caption)
            End Select
        End If
    Next
    Debug.Print "End saving labels: " & as_ScreenName
    Exit Sub
ErrHandler:
  Call errorHandler("SaveLabels")
End Sub

#If LIVE = 1 Then
Public Sub LoadTabStripLabels(ByRef ao_Db As Object, ByVal ac_Labels As Long, ByVal ao_TabStrip As MSComctlLib.TabStrip)
#Else
Public Sub LoadTabStripLabels(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal ac_Labels As Long, ByVal ao_TabStrip As MSComctlLib.TabStrip)
#End If
On Error GoTo ErrHandler

Dim ll_Count As Long
Dim ll_Idx As Long

    ll_Count = ao_TabStrip.Tabs.Count
    For ll_Idx = 1 To ll_Count
      If ao_TabStrip.Tabs(ll_Idx).Key <> "" Then
        If ao_Db.Find(ac_Labels, "FIELD_NAME", ao_TabStrip.Tag & "." & ao_TabStrip.Tabs(ll_Idx).Key, , 1) >= 0 Then
            ao_TabStrip.Tabs(ll_Idx).Caption = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
        End If
      End If
    Next
    Exit Sub
ErrHandler:
  Call errorHandler("LoadTabStripLabels")
End Sub

' Load the labels of a containers
#If LIVE = 1 Then
Public Function LoadLabelsCursor(ByRef ao_Db As Object, ByVal ac_Labels As Long, ByVal ao_Controls As Object, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String, Optional al_hWnd = 0) As Long
#Else
Public Function LoadLabelsCursor(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal ac_Labels As Long, ByVal ao_Controls As Object, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String, Optional al_hWnd = 0) As Long
#End If
On Error GoTo ErrHandler
    
Dim lo_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim lsa_ControlTag() As String
    
On Error GoTo WithoutTag
    If ao_Container.Tag <> "" Then
        li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", ao_Container.Tag, , 1)
        If li_Label >= 0 Then
            ao_Container.Caption = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
        End If
    End If
WithoutTag:
    
On Error GoTo ErrHandler
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lo_Control In ao_Controls
        
      If HasContainer(lo_Control, ao_Container) Or (UCase(TypeName(lo_Control)) = "MENU") Then
        Select Case UCase(TypeName(lo_Control))
        Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
          'Dim lo_Tbs
          'Set lo_Tbs = lo_Control ' Cast for use of intellisense
          'li_Count = lo_Tbs.Tabs.Count
          'For li_Idx = 1 To li_Count
            'If lo_Tbs.Tabs(li_Idx).Key <> "" Then
            '  li_Label = ao_Db.Find(lc_Labels, "FIELD_NAME", lo_Control.Tag & "." & lo_Tbs.Tabs(li_Idx).Key, , 1)
            '  If li_Label >= 0 Then
            '      lo_Tbs.Tabs(li_Idx).Caption = ao_Db.GetFields(lc_Labels, "LOCAL_TEXT")
            '  End If
            'End If
          'Next
          'Set lo_Tbs = Nothing
          Call LoadTabStripLabels(ao_Db, ac_Labels, lo_Control)
        Case UCase("ListView") ' Component is a listview, we load the caption of each columns
          Dim lo_ListView As ListView
          Set lo_ListView = lo_Control
          li_Count = lo_ListView.ColumnHeaders.Count
          For li_Idx = 1 To li_Count
            'If lo_ListView.ColumnHeaders(li_Idx).Text = "#" Then lo_ListView.ColumnHeaders(li_Idx).Text = ""
            If lo_ListView.ColumnHeaders(li_Idx).Tag <> "" Then
                li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", lo_Control.Tag & "." & lo_ListView.ColumnHeaders(li_Idx).Tag, , 1)
                If li_Label >= 0 Then
                    lo_ListView.ColumnHeaders(li_Idx).Text = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
                End If
            End If
          Next
          Set lo_ListView = Nothing
    
        Case UCase("TextBox")  ' Component is a textbox
          Dim lo_TextBox As TextBox
          Set lo_TextBox = lo_Control
          If lo_TextBox.Tag <> "" Then
              lsa_ControlTag = Split(lo_Control.Tag, SEP)
              If ao_Db.Find(ac_Labels, "FIELD_NAME", lsa_ControlTag(0), , 1) >= 0 Then
                  lo_TextBox.Text = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
              End If
              If ao_Db.Find(ac_Labels, "FIELD_NAME", lsa_ControlTag(0) & ".Tooltip", , 1) >= 0 Then
                  Call AddTooltip(al_hWnd, lo_Control, ao_Db.GetFields(ac_Labels, "LOCAL_TEXT"))
              End If
          End If
          Set lo_TextBox = Nothing
        
        Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
          If lo_Control.Tag <> "" Then
            lsa_ControlTag = Split(lo_Control.Tag, SEP)
            If ao_Db.Find(ac_Labels, "FIELD_NAME", lsa_ControlTag(0), , 1) >= 0 Then
                lo_Control.Caption = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
            End If
            If ao_Db.Find(ac_Labels, "FIELD_NAME", lsa_ControlTag(0) & ".Tooltip", , 1) >= 0 Then
                  Call AddTooltip(al_hWnd, lo_Control, ao_Db.GetFields(ac_Labels, "LOCAL_TEXT"))
            End If
          End If
        
        Case UCase("ArmCombobox")
          If lo_Control.Tag <> "" Then
            lsa_ControlTag = Split(lo_Control.Tag, SEP)
            If ao_Db.Find(ac_Labels, "FIELD_NAME", lsa_ControlTag(0) & ".Tooltip", , 1) >= 0 Then
                  Call AddTooltip(al_hWnd, lo_Control, ao_Db.GetFields(ac_Labels, "LOCAL_TEXT"))
            End If
          End If
        
        Case UCase("ArmGrid")
          Dim lo_Grid As ArmGrid
          Dim lo_Column As ArmColumn
          
          Set lo_Grid = lo_Control
          li_Count = lo_Grid.Cols
          
          li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", lo_Control.Tag, , 1)
          If li_Label >= 0 Then
            Call lo_Grid.LoadConstants(ptStatic, ao_Db.GetFields(ac_Labels, "LOCAL_TEXT"), ctColumns)
          End If
          li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", lo_Control.Tag & "_Title", , 1)
          If li_Label >= 0 Then
            lo_Grid.Title = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
          End If
          For li_Idx = 0 To li_Count - 1
            Set lo_Column = lo_Grid.Columns(li_Idx)
            'If lo_Column.Title = "#" Then lo_Column.Title = ""
            If lo_Column.Name <> "" Then
              li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", lo_Control.Tag & "." & lo_Column.Name, , 1)
              If li_Label >= 0 Then
                lo_Column.Title = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
              End If
            End If
          Next
          Set lo_Grid = Nothing
          Set lo_Column = Nothing
        Case UCase("Menu")
          'If lo_Control.Caption = "#" Then lo_Control.Caption = ""
          If lo_Control.Tag <> "" Then
            li_Label = ao_Db.Find(ac_Labels, "FIELD_NAME", lo_Control.Tag, , 1)
            If li_Label >= 0 Then
              lo_Control.Caption = ao_Db.GetFields(ac_Labels, "LOCAL_TEXT")
            End If
          End If
        End Select
      End If
    Next
        
    Exit Function
ErrHandler:
  Call errorHandler("LoadLabelsCursor")
End Function

' Load the labels of a containers

Public Function AddTooltip(ByVal al_hWnd As Long, ByVal ao_Control As Object, ByVal as_Text As String) As Boolean
On Error GoTo ErrHandler

Dim ll_Idx As Long
Dim lo_ToolTip As Object

    AddTooltip = False
    
    If mo_ToolTipsCollection.Count > 0 And al_hWnd <> 0 Then
    
        For Each lo_ToolTip In mo_ToolTipsCollection
            If lo_ToolTip.FormhWnd = al_hWnd Then
            
                Call lo_ToolTip.AddTool(ao_Control, as_Text)
                
                If UCase(TypeName(ao_Control)) = UCase("ArmCombobox") Then
                    Call lo_ToolTip.AddToolImageCombo(ao_Control.GetInactiveHwnd(), as_Text)
                    Call lo_ToolTip.AddToolImageCombo(ao_Control.GetButtonHwnd(), as_Text)
                End If
                
                AddTooltip = True
                Exit Function
            End If
        Next
    End If
    
    Exit Function
ErrHandler:
  Call errorHandler("AddTooltip")
End Function

' Load the labels of a containers
#If LIVE = 1 Then
Public Function LoadLabels(ByRef ao_Db As Object, ByVal ao_Controls As Object, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String, Optional al_hWnd = 0) As Long
#Else
Public Function LoadLabels(ByRef ao_Db As ARMSYSCOMLib.ArmDb, ByVal ao_Controls As Object, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String, Optional al_hWnd = 0) As Long
#End If
On Error GoTo ErrHandler

Dim ls_Request As String
Dim lc_Labels As Long
    
#If LIVE = 0 Then
  Call SaveLabels(ao_Db, ao_Controls, ao_Container, as_ScreenName)
#End If
    
    ls_Request = "exec screen_csts '" & as_ScreenName & "','" & as_Language & "'"
    lc_Labels = OpenSQLSafe(ao_Db, ls_Request)
    
    Call LoadLabelsCursor(ao_Db, lc_Labels, ao_Controls, ao_Container, as_ScreenName, as_Language, al_hWnd)
    
    LoadLabels = lc_Labels
    Exit Function
ErrHandler:
  Call errorHandler("LoadLabels")
End Function

#If LIVE = 1 Then
Public Function MsgText(ByVal ao_Db As Object, ByVal as_Language As String, ByVal al_Id As Long, ByVal as_Default As String, Optional ByVal av_Info As Variant) As String
#Else
Public Function MsgText(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Language As String, ByVal al_Id As Long, ByVal as_Default As String, Optional ByVal av_Info As Variant) As String
#End If
On Error GoTo ErrHandler

Const DB_REQ As String = "SELECT message_text FROM error_message WHERE msgid = $id$ AND Language_code = '$lang$'"

    MsgText = ""
    
    Dim ls_Req As String
    ls_Req = ReplacePlaceHolder(DB_REQ, "$id$", al_Id)
    ls_Req = ReplacePlaceHolder(ls_Req, "$lang$", as_Language)
    
    Dim lBuffer As String
    lBuffer = SelectValue(ao_Db, ls_Req)
    If lBuffer = "" Then lBuffer = as_Default
    
    Dim li_Idx As Integer
    If Not IsMissing(av_Info) Then
        For li_Idx = 0 To UBound(av_Info) Step 2
            lBuffer = Replace(lBuffer, av_Info(li_Idx), av_Info(li_Idx + 1), , , vbTextCompare)
        Next li_Idx
    End If
    
    MsgText = lBuffer
    Exit Function
ErrHandler:
    MsgText = Err.Description & vbCrLf & as_Default
End Function

#If LIVE = 1 Then
Public Function ShowMsg(ByVal ao_Db As Object, ByVal as_Language As String, ByVal al_Id As Long, ByVal as_Default As String, Optional ByVal av_Info As Variant, Optional ae_MsgBoxStyle As VbMsgBoxStyle) As VbMsgBoxResult
#Else
Public Function ShowMsg(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Language As String, ByVal al_Id As Long, ByVal as_Default As String, Optional ByVal av_Info As Variant, Optional ae_MsgBoxStyle As VbMsgBoxStyle) As VbMsgBoxResult
#End If
On Error GoTo ErrHandler

Dim ls_Text As String
  
  ls_Text = MsgText(ao_Db, as_Language, al_Id, as_Default, av_Info)
  Call UpdateMouse(True)
  'ShowMsg = MsgBox(ls_Text, ae_MsgBoxStyle, , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
  ShowMsg = MsgBox(ls_Text, ae_MsgBoxStyle, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
  Call UpdateMouse(False)
  Exit Function
ErrHandler:
  Call MsgBox(ls_Text)
End Function

Public Function BoolToScreen(ByVal ab_Value As Boolean) As String
On Error GoTo ErrHandler

  BoolToScreen = IIf(ab_Value, "X", "")
  Exit Function
ErrHandler:
    Call errorHandler("BoolToScreen")
End Function

Public Function DblToScreen(ByVal ad_Value As Double, Optional ByVal al_Decimal As Long = 2) As String
On Error GoTo ErrHandler

    If al_Decimal = 0 Then
      DblToScreen = Format(Round(ad_Value, al_Decimal), "0")
    Else
      DblToScreen = Format(Round(ad_Value, al_Decimal), "0." & String(al_Decimal, "0"))
    End If
    Exit Function
ErrHandler:
    Call errorHandler("DblToScreen")
End Function

Public Function DateToScreen(ByVal ad_Value As Date) As String
On Error GoTo ErrHandler

    If ad_Value = 0 Then
      DateToScreen = ""
    Else
      DateToScreen = Format(ad_Value, "dd\/mm\/yyyy")
    End If
    Exit Function
ErrHandler:
    Call errorHandler("DateToScreen")
End Function

Public Function DateTimeToScreen(ByVal ad_Value As Date) As String
On Error GoTo ErrHandler

    If ad_Value = 0 Then
      DateTimeToScreen = ""
    Else
      DateTimeToScreen = Format(ad_Value, "dd\/mm\/yyyy hh:mm:ss")
    End If
    Exit Function
ErrHandler:
    Call errorHandler("DateTimeToScreen")
End Function

Public Function ScreenToDbl(ByVal as_Value As String, Optional ByVal al_Decimal As Long = 2) As Double
On Error GoTo ErrHandler

  as_Value = Replace(as_Value, ",", ".")
  ScreenToDbl = Round(Val(as_Value), al_Decimal)
  Exit Function
ErrHandler:
  Call errorHandler("ScreenToDbl")
End Function

Public Function LongToScreen(ByVal al_Value As Long) As String
On Error GoTo ErrHandler

  LongToScreen = al_Value
  Exit Function
ErrHandler:
  Call errorHandler("LongToScreen")
End Function

Public Function ScreenToLong(ByVal as_Value As String) As Long
On Error GoTo ErrHandler

  ScreenToLong = Val(as_Value)
  Exit Function
ErrHandler:
  Call errorHandler("ScreenToLong")
End Function

Public Function GetControl(ByVal ao_Controls As Object, ByVal as_Tag As String, Optional ByVal ao_Frame As Frame = Nothing) As Control
On Error GoTo ErrHandler

Dim lo_Control As Control
  
  Set GetControl = Nothing
  For Each lo_Control In ao_Controls
    If (ao_Frame Is Nothing) Or HasContainer(lo_Control, ao_Frame) Then
      If StrComp(Trim(lo_Control.Tag), as_Tag, vbTextCompare) = 0 Then
        Set GetControl = lo_Control
        Exit Function
      End If
    End If
  Next
  Exit Function
ErrHandler:
  Call errorHandler("GetControl")
End Function

Public Sub SetTextBox(ByVal ao_TextBox As Variant, ByVal as_Tag As String, ByVal as_Value As String, Optional ByVal ab_Enabled As Boolean = True, Optional ByVal ab_Visible As Boolean = True)
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    lo_TextBox.Text = as_Value
    Call EnableControl(lo_TextBox, ab_Enabled)
    lo_TextBox.Visible = ab_Visible
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetTextBox")
End Sub

Public Function GetTextValue(ByVal ao_TextBox As Variant, ByVal as_Tag As String) As String
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  GetTextValue = ""
  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    GetTextValue = lo_TextBox.Text
  End If
  Exit Function
ErrHandler:
  Call errorHandler("GetTextValue")
End Function

Public Sub SetTextVisible(ByVal ao_TextBox As Variant, ByVal as_Tag As String, ByVal ab_Visible As Boolean)
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    lo_TextBox.Visible = ab_Visible
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetTextVisible")
End Sub

Public Sub SetTextValue(ByVal ao_TextBox As Variant, ByVal as_Tag As String, ByVal as_Value As String)
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    lo_TextBox.Text = as_Value
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetTextValue")
End Sub

Public Sub SetTextEnabled(ByVal ao_TextBox As Variant, ByVal as_Tag As String, ByVal ab_Enabled As Boolean)
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    Call EnableControl(lo_TextBox, ab_Enabled)
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetTextEnabled")
End Sub

Public Sub SetTextFocus(ByVal ao_TextBox As Variant, ByVal as_Tag As String)
On Error GoTo ErrHandler

Dim lo_TextBox As TextBox

  Set lo_TextBox = GetControl(ao_TextBox, as_Tag)
  If lo_TextBox Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_TextBox(0).Name, "TextBox not found: " & as_Tag
  Else
    If lo_TextBox.Enabled And lo_TextBox.Visible Then
      Call lo_TextBox.SetFocus
    End If
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetTextFocus")
End Sub

Public Sub SetLabelVisible(ByVal ao_Labels As Variant, ByVal as_Tag As String, ByVal ab_Visible As Boolean)
On Error GoTo ErrHandler

Dim lo_Label As Label

  Set lo_Label = GetControl(ao_Labels, as_Tag)
  If lo_Label Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_Labels(0).Name, "Label not found: " & as_Tag
  Else
    lo_Label.Visible = ab_Visible
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetLabelVisible")
End Sub

Public Sub SetLabelText(ByVal ao_Labels As Variant, ByVal as_Tag As String, ByVal as_Text As String)
On Error GoTo ErrHandler

Dim lo_Label As Label

  Set lo_Label = GetControl(ao_Labels, as_Tag)
  If lo_Label Is Nothing Then
    Err.Raise ArmErr.CompFncFailed, ao_Labels(0).Name, "Label not found: " & as_Tag
  Else
    lo_Label.Caption = as_Text
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("SetLabelText")
End Sub

Public Sub UpdateMouse(ByVal ab_Store As Boolean)
On Error GoTo ErrHandler

Static ll_Mousepointer As Long

  If ab_Store Then
    ll_Mousepointer = Screen.MousePointer
    Screen.MousePointer = vbDefault
  Else
    Screen.MousePointer = ll_Mousepointer
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("UpdateMouse")
End Sub

Public Sub LockScreen(ByVal ao_Screen As Object, ByVal ab_lock As Boolean)

  Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
  ll_errNumber = Err.Number
  ls_ErrSrc = Err.Source
  ls_ErrDesc = Err.Description

On Error GoTo ErrHandler
  Static ll_Count As Long
  Static ll_Mousepointer As Long
  Static lb_Locked As Boolean
  
    
  ll_Count = ll_Count + IIf(ab_lock, 1, -1)
  Debug.Assert (ll_Count >= 0)
  
  ' First lock
  If Not lb_Locked And ab_lock Then
    ll_Mousepointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
    ao_Screen.Enabled = False
    Call LockWindowUpdate(ao_Screen.hwnd)
    lb_Locked = True
  End If
  
  ' Unlock
  If ll_Count = 0 Then
    DoEvents ' Flush events
    LockWindowUpdate 0
    ao_Screen.Enabled = True
    Call ao_Screen.Refresh ' Repaint immediately
    Screen.MousePointer = ll_Mousepointer
    lb_Locked = False
  End If
  
  Err.Number = ll_errNumber
  Err.Source = ls_ErrSrc
  Err.Description = ls_ErrDesc
  Exit Sub
ErrHandler:
  Call errorHandler("LockScreen")
End Sub


#If LIVE = 1 Then
Public Function GetApplicationLock(ByVal ao_Db As Object, ByVal as_Resource As String, Optional ByVal al_TimeOut As Long = 0) As Boolean
#Else
Public Function GetApplicationLock(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Resource As String, Optional ByVal al_TimeOut As Long = 0) As Boolean
#End If
On Error GoTo ErrHandler

Dim ls_Req As String

  ls_Req = "declare @Result int;" & vbCrLf
  ls_Req = ls_Req & "exec @Result = sp_getapplock $Resource$, $LockMode$, $LockOwner$, $LockTimeout$;" & vbCrLf
  ls_Req = ls_Req & "select @Result;"
  ls_Req = ReplacePlaceHolder(ls_Req, "$Resource$", SQLStr(as_Resource))
  ls_Req = ReplacePlaceHolder(ls_Req, "$LockMode$", SQLStr("Exclusive"))
  ls_Req = ReplacePlaceHolder(ls_Req, "$LockOwner$", SQLStr("Session"))
  ls_Req = ReplacePlaceHolder(ls_Req, "$LockTimeout$", SqlInt(0))
  GetApplicationLock = SelectValue(ao_Db, ls_Req) >= 0
  Exit Function
ErrHandler:
  Call errorHandler("GetApplicationLock")
End Function

#If LIVE = 1 Then
Public Sub ReleaseApplicationLock(ByVal ao_Db As Object, ByVal as_Resource As String)
#Else
Public Sub ReleaseApplicationLock(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Resource As String)
#End If
On Error GoTo ErrHandler

Dim ls_Req As String

  ls_Req = "EXEC sp_releaseapplock $Resource$, $LockOwner$"
  ls_Req = ReplacePlaceHolder(ls_Req, "$Resource$", SQLStr(as_Resource))
  ls_Req = ReplacePlaceHolder(ls_Req, "$LockOwner$", SQLStr("Session"))
  Call ExecuteSQLSafe(ao_Db, ls_Req)
  Exit Sub
ErrHandler:
  Call errorHandler("ReleaseApplicationLock")
End Sub

Public Function GetMACAddress() As String
On Error GoTo ErrHandler

Dim ls_Query As String
Dim lo_WMIService As Object
Dim lo_Items As Object
Dim lo_item As Object
' We're interested in MAC addresses of physical adapters only
  ls_Query = "SELECT * " & _
              "FROM Win32_NetworkAdapter " & _
              "WHERE ConfigManagerErrorCode=0 AND " & _
              "NetConnectionID > '' AND " & _
              "(NetConnectionStatus=2 OR NetConnectionStatus=9)"

  Set lo_WMIService = GetObject("winmgmts://./root/CIMV2")
  Set lo_Items = lo_WMIService.ExecQuery(ls_Query, "WQL", 48)

  For Each lo_item In lo_Items
    If lo_item.MACAddress <> "" Then
      GetMACAddress = Replace(lo_item.MACAddress, ":", "", , , vbTextCompare)
      Exit Function
    End If
  Next
  GetMACAddress = ""
  Exit Function
ErrHandler:
  Call errorHandler("GetMACAddress")
End Function

Public Function GetLocaleInfo(ByVal al_Locale_User As Long, ByVal al_Locale_Type As Long) As String
On Error GoTo ErrHandler

    GetLocaleInfo = ""
    Dim ls_Buffer As String
    Dim ll_BufferLen As Long
    ll_BufferLen = 255
    ls_Buffer = String$(ll_BufferLen, vbNullChar)
    ll_BufferLen = GetLocaleInfoA(al_Locale_User, al_Locale_Type, ls_Buffer, ll_BufferLen)
    If ll_BufferLen > 0 Then
      GetLocaleInfo = Left$(ls_Buffer, ll_BufferLen - 1)
    End If
    Exit Function
ErrHandler:
    Call errorHandler("GetLocaleInfo")
End Function

Public Function LoadIconFromA_Icons(ai_IconIndex As Integer) As Picture
On Error GoTo ErrHandler

Dim hIcon As Long
Dim hInst As Long
Dim oNewPic As Picture
Dim tPicConv As PictDesc
Dim IGuid As Guid

  
    hInst = LoadLibrary("c:\arm_apps\dll\A_icons.dll")
    If hInst = 0 Then
      Set LoadIconFromA_Icons = Nothing
      Exit Function
    End If
    
    hIcon = LoadIconFromDLL(hInst, ai_IconIndex)
    If hIcon = 0 Then
      Set LoadIconFromA_Icons = Nothing
      Exit Function
    End If
      
    With tPicConv
      .cbSizeofStruct = Len(tPicConv)
      .picType = vbPicTypeIcon
      .hImage = hIcon
    End With
     
    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
      
    Set LoadIconFromA_Icons = oNewPic
    Call FreeLibrary(hInst)
    Exit Function
ErrHandler:
    Call FreeLibrary(hInst)
    Call errorHandler("LoadIconFromFile")
End Function

#If LIVE = 1 Then
Public Function GetAndCreateTempDir(ByVal ao_FSO As Object, ByVal as_ScreenName As String, Optional ByVal ab_Create As Boolean = True) As String
#Else
Public Function GetAndCreateTempDir(ByVal ao_FSO As FileSystemObject, ByVal as_ScreenName As String, Optional ByVal ab_Create As Boolean = True) As String
#End If
On Error GoTo ErrHandler

Dim ls_TempDir As String, ll_Count As Long

  ls_TempDir = Space(4096)
  ll_Count = GetTempPath(4096, ls_TempDir)
  
  ls_TempDir = Left(ls_TempDir, ll_Count)
  'this function can return path with trailing "\" character - strip it
  If ll_Count > 0 Then
    If right(ls_TempDir, 1) = "\" Then
     ls_TempDir = Left(ls_TempDir, ll_Count - 1)
    End If
  End If
  ls_TempDir = ls_TempDir & "\$" & as_ScreenName & "$"
  If ab_Create Then
    If Not ao_FSO.FolderExists(ls_TempDir) Then
      Call ao_FSO.CreateFolder(ls_TempDir)
    End If
  End If
  GetAndCreateTempDir = ls_TempDir
  Exit Function
ErrHandler:
  Call errorHandler("GetAndCreateTempDir")
End Function

Public Sub Pause(ByVal Seconds As Single, Optional ByVal PreventVBEvents As Boolean = False)
On Error GoTo ErrHandler

' Pauses for the number of seconds specified. Seconds can be specified down to
' 1/100 of a second. The Windows Sleep routine is called during each cycle to
' give other applications time because, while DoEvents does the same, it does
' not wait and hence the VB loop code consumes more CPU cycles.

  Const MaxSystemSleepInterval = 25 ' milliseconds
  Const MinSystemSleepInterval = 1 ' milliseconds
  
  Dim ResumeTime As Double
  Dim Factor As Long
  Dim SleepDuration As Double
  
  Factor = CLng(24) * 60 * 60
  
  ResumeTime = Int(Now) + (timer + Seconds) / Factor
  
  Do
     SleepDuration = (ResumeTime - (Int(Now) + timer / Factor)) * Factor * 1000
     If SleepDuration > MaxSystemSleepInterval Then SleepDuration = MaxSystemSleepInterval
     If SleepDuration < MinSystemSleepInterval Then SleepDuration = MinSystemSleepInterval
     Call Sleep(SleepDuration)
     If Not PreventVBEvents Then DoEvents
  Loop Until Int(Now) + timer / Factor >= ResumeTime
  Exit Sub
ErrHandler:
  Call errorHandler("Pause")
End Sub

#If LIVE = 1 Then
Public Function DeleteFile(ByVal ao_FSO As Object, ByVal as_FileName As String) As Boolean
#Else
Public Function DeleteFile(ByVal ao_FSO As FileSystemObject, ByVal as_FileName As String) As Boolean
#End If
On Error GoTo ErrHandler

  ' delete all subfolders and files in one go
  Call ao_FSO.DeleteFile(as_FileName, True)
  DeleteFile = True
  Exit Function
ErrHandler:
    DeleteFile = False
End Function

#If LIVE = 1 Then
Public Sub DeleteTemporaryFolder(ByVal ao_FSO As Object, ByVal as_ScreenName As String)
#Else
Public Sub DeleteTemporaryFolder(ByVal ao_FSO As FileSystemObject, ByVal as_ScreenName As String)
#End If
On Error GoTo ErrHandler

  ' delete all subfolders and files in one go
  Call ao_FSO.DeleteFolder(GetAndCreateTempDir(ao_FSO, as_ScreenName, False), True)
  Exit Sub
ErrHandler:
  'do nothing this is not critical error, because some of the temp files can be still open
  'by user, it will be delete next time app start
End Sub

Private Sub LoadError(ByVal as_Language_Code As String)
On Error GoTo ErrHandler

Dim ls_Req As String

  If mc_Error = 0 Then
  
    ls_Req = "exec DPC_Error_lst $Language_Code$"
    
    ls_Req = ReplacePlaceHolder(ls_Req, "$Language_Code$", as_Language_Code)
    mc_Error = OpenSQLSafe(mo_Db, ls_Req)
  End If
  Exit Sub
ErrHandler:
  Call errorHandler("LoadError")
End Sub

Public Function AddCheckError(ByVal ae_DPCError As eDPCError, ByVal as_Language_Code As String, ByVal ao_ErrCol As Collection, Optional ByVal ao_Product As DPC_Product = Nothing, Optional ByVal ao_DPC_Object As Object = Nothing, Optional av_PlaceHolder As Variant, Optional av_Value As Variant) As DPC_Error
On Error GoTo ErrHandler

Dim lo_Error As DPC_Error
Dim lo_SavedError As DPC_Error
Dim ll_Idx As Long

  Set AddCheckError = Nothing
  
  If mc_Error = 0 Then
    Call LoadError(as_Language_Code)
  End If
  If mo_Db.Find(mc_Error, "ERR_Id", ae_DPCError) >= 0 Then
    Set lo_Error = New DPC_Error
    Set lo_Error.Tools = Me
    lo_Error.ERR_ID = ae_DPCError
    lo_Error.LEV_Id = mo_Db.GetFields(mc_Error, "LEV_Id")
    lo_Error.ERR_Type = mo_Db.GetFields(mc_Error, "ERR_Type")
    lo_Error.MsgId = mo_Db.GetFields(mc_Error, "MsgId")
    lo_Error.ERR_Ctrl = mo_Db.GetFields(mc_Error, "ERR_Ctrl")
    lo_Error.ERR_Offer = StrComp(mo_Db.GetFields(mc_Error, "ERR_Offer"), "X", vbTextCompare) = 0
    
    lo_Error.Message_Text = mo_Db.GetFields(mc_Error, "Message_Text")
    If Not ao_Product Is Nothing Then
      lo_Error.Message_Text = ao_Product.ReplaceValuePlaceholder(lo_Error.Message_Text)
    End If
    If Not ao_DPC_Object Is Nothing Then
      lo_Error.Message_Text = ao_DPC_Object.ReplaceValuePlaceholder(lo_Error.Message_Text)
    End If
    If IsArray(av_PlaceHolder) Then
      For ll_Idx = 0 To UBound(av_PlaceHolder)
        lo_Error.Message_Text = Replace(lo_Error.Message_Text, CStr(av_PlaceHolder(ll_Idx)), CStr(av_Value(ll_Idx)))
      Next
    Else
      lo_Error.Message_Text = Replace(lo_Error.Message_Text, CStr(av_PlaceHolder), CStr(av_Value))
    End If
    Call ao_ErrCol.Add(lo_Error)
    Set AddCheckError = lo_Error
  Else
    Err.Raise ArmErr.InvalidArgument, "ae_DPCError", "Error not found in cursor: " & ae_DPCError
  End If
  Exit Function
ErrHandler:
  Call errorHandler("AddCheckError")
End Function

Public Sub ClearCollection(ByVal ao_Collection As Collection)
On Error GoTo ErrHandler

  While ao_Collection.Count > 0
      Call ao_Collection.Remove(1)
  Wend
  Exit Sub
ErrHandler:
  Call errorHandler("ClearCollection")
End Sub

Public Sub CopyCollection(ByVal ao_Src As Collection, ByVal ao_Dst As Collection)
On Error GoTo ErrHandler

Dim lo_Object As Object

  For Each lo_Object In ao_Src
    Call ao_Dst.Add(lo_Object)
  Next
  Exit Sub
ErrHandler:
  Call errorHandler("CopyCollection")
End Sub

' Standard error handler
Private Sub errorHandler(ByVal as_Fct As String)
  
    Call Err.Raise(Err.Number, "DPC_Tools." & as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

Public Function RoundTo(ByVal ad_Value As Double, Optional ByVal al_DecimalDigits As Long = -2) As Double
On Error GoTo errorHandler

Dim ld_Factor As Double
  
  ld_Factor = 10 ^ al_DecimalDigits
  RoundTo = Int((ad_Value / ld_Factor) + 0.5) * ld_Factor
  Exit Function
errorHandler:
  Call errorHandler("RoundTo")
End Function

Public Function RoundUp(ByVal ad_Value As Double) As Long
On Error GoTo errorHandler

  If ad_Value - Int(ad_Value) = 0 Then
    RoundUp = Int(ad_Value)
  Else
    RoundUp = Int(ad_Value) + 1
  End If
  Exit Function
errorHandler:
  Call errorHandler("RoundUp")
End Function

Public Function RoundDown(ByVal ad_Value As Double) As Long
On Error GoTo errorHandler

  RoundDown = Int(ad_Value)
  Exit Function
errorHandler:
  Call errorHandler("RoundDown")
End Function

Public Function IsInCollection(ByVal ao_Object As Object, ByRef ao_Collection As Collection) As Boolean
On Error GoTo errorHandler
Dim lo_Object As Object

  IsInCollection = False
  For Each lo_Object In ao_Collection
    If ao_Object Is lo_Object Then
      IsInCollection = True
      Exit Function
    End If
  Next
  Exit Function
errorHandler:
  Call errorHandler("IsInCollection")
End Function


Public Function IsIntValue(ByVal as_Value As String) As Boolean
On Error GoTo errorHandler

    Dim ll_Value As Long
    
    IsIntValue = False
    
    If IsNumeric(as_Value) = False Then
        Exit Function
    End If
    
    ll_Value = as_Value
    
    If ll_Value <> as_Value Then
        Exit Function
    End If
    
    IsIntValue = True

    Exit Function
errorHandler:
    Call errorHandler("IsIntValue")
End Function

Public Function GetLabelCaption(ByRef ao_Controls As Object, ByRef ao_Frame As Frame, ByVal as_Tag As String) As String
On Error GoTo errorHandler

    Dim ll_Index As Long
    Dim lo_Control As Object
    
    GetLabelCaption = ""
        
    For Each lo_Control In ao_Controls
    
        If (ao_Frame Is Nothing) Or HasContainer(lo_Control, ao_Frame) Then
            Select Case UCase(TypeName(lo_Control))
                Case "LABEL"
                    If Trim(lo_Control.Tag) = as_Tag Then
                        GetLabelCaption = lo_Control.Caption
                        Exit Function
                    End If
            End Select
        End If
    Next
    
    Exit Function
errorHandler:
    Call errorHandler("GetLabelCaption")
End Function

