VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl BLOBEdit 
   ClientHeight    =   10500
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15000
   ScaleHeight     =   10500
   ScaleWidth      =   15000
   Begin VB.Frame frm_frames 
      Caption         =   "#ZIP info detail"
      Height          =   6165
      Index           =   3
      Left            =   1575
      TabIndex        =   7
      Top             =   885
      Width           =   12075
      Begin VB.CheckBox chk_InternetFlag 
         Caption         =   "#Internet flag"
         Height          =   300
         Left            =   7050
         TabIndex        =   42
         Tag             =   "chk_InternetFlag"
         Top             =   300
         Width           =   1845
      End
      Begin VB.CommandButton btn_AllCountries 
         Caption         =   "All countries"
         Height          =   315
         Left            =   10440
         TabIndex        =   41
         Top             =   4750
         Width           =   1395
      End
      Begin VB.Frame frm_frames 
         Caption         =   "#Select file"
         Height          =   2865
         Index           =   4
         Left            =   150
         TabIndex        =   35
         Top             =   2250
         Width           =   8805
         Begin VB.TextBox txt_file 
            Height          =   315
            Left            =   5370
            TabIndex        =   39
            TabStop         =   0   'False
            Text            =   "Text1"
            Top             =   2400
            Width           =   3285
         End
         Begin VB.DriveListBox drv_Full 
            Height          =   315
            Left            =   120
            TabIndex        =   38
            Top             =   240
            Width           =   3615
         End
         Begin VB.DirListBox dir_Full 
            Height          =   2115
            Left            =   120
            TabIndex        =   37
            Top             =   600
            Width           =   3615
         End
         Begin VB.FileListBox fil_Full 
            Height          =   2040
            Left            =   3870
            TabIndex        =   36
            Top             =   240
            Width           =   4815
         End
         Begin VB.Label lbl_labels 
            Alignment       =   1  'Right Justify
            Caption         =   "#Attached file"
            Height          =   255
            Index           =   9
            Left            =   3870
            TabIndex        =   40
            Top             =   2460
            Width           =   1425
         End
      End
      Begin VB.CommandButton btn_clearCountries 
         Caption         =   "Clear countries"
         Height          =   315
         Left            =   9000
         TabIndex        =   16
         Top             =   4740
         Width           =   1395
      End
      Begin Project1.ArmCombobox cbo_groups 
         Height          =   345
         Left            =   9000
         TabIndex        =   14
         Top             =   240
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   609
      End
      Begin Project1.ArmCheckView cvw_countries 
         Height          =   4005
         Left            =   9000
         TabIndex        =   15
         Top             =   600
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   7064
      End
      Begin VB.TextBox txt_spare3 
         Height          =   315
         Left            =   10140
         TabIndex        =   27
         Text            =   "Text1"
         Top             =   5730
         Visible         =   0   'False
         Width           =   1455
      End
      Begin VB.TextBox txt_spare1 
         Height          =   315
         Left            =   10140
         TabIndex        =   24
         Text            =   "Text1"
         Top             =   5130
         Visible         =   0   'False
         Width           =   1455
      End
      Begin VB.TextBox txt_spare2 
         Height          =   315
         Left            =   10140
         TabIndex        =   23
         Text            =   "Text1"
         Top             =   5430
         Visible         =   0   'False
         Width           =   1455
      End
      Begin Project1.ArmCombobox cbo_language 
         Height          =   345
         Left            =   3480
         TabIndex        =   9
         Top             =   300
         Width           =   1395
         _ExtentX        =   7223
         _ExtentY        =   609
      End
      Begin VB.TextBox txt_memo 
         Height          =   945
         Left            =   2040
         MaxLength       =   2000
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   13
         Text            =   "BLOBEdit.ctx":0000
         Top             =   1320
         Width           =   6915
      End
      Begin VB.TextBox txt_desc 
         Height          =   285
         Left            =   2040
         MaxLength       =   150
         TabIndex        =   12
         Text            =   "Text1"
         Top             =   1020
         Width           =   6915
      End
      Begin VB.TextBox txt_internetDesc 
         Height          =   315
         Left            =   4950
         MaxLength       =   80
         TabIndex        =   11
         Text            =   "Text1"
         Top             =   660
         Width           =   4005
      End
      Begin VB.TextBox txt_title 
         Height          =   315
         Left            =   1020
         MaxLength       =   50
         TabIndex        =   10
         Text            =   "Text1"
         Top             =   660
         Width           =   3855
      End
      Begin Project1.ArmCombobox cbo_type 
         Height          =   345
         Left            =   1020
         TabIndex        =   8
         Top             =   300
         Width           =   1275
         _ExtentX        =   7752
         _ExtentY        =   609
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Spare3"
         Height          =   255
         Index           =   8
         Left            =   9510
         TabIndex        =   28
         Tag             =   "lb_spare2"
         Top             =   5760
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Spare1"
         Height          =   255
         Index           =   6
         Left            =   9510
         TabIndex        =   26
         Tag             =   "lb_spare1"
         Top             =   5160
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Spare2"
         Height          =   255
         Index           =   7
         Left            =   9510
         TabIndex        =   25
         Tag             =   "lb_spare2"
         Top             =   5460
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Language"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   5
         Left            =   2400
         TabIndex        =   22
         Top             =   360
         Width           =   1275
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Memo"
         Height          =   255
         Index           =   4
         Left            =   60
         TabIndex        =   21
         Top             =   1320
         Width           =   1935
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Description"
         Height          =   255
         Index           =   3
         Left            =   60
         TabIndex        =   20
         Top             =   1020
         Width           =   1935
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Internet description"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   2
         Left            =   4950
         TabIndex        =   19
         Top             =   360
         Width           =   1935
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Title"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   1
         Left            =   60
         TabIndex        =   18
         Top             =   720
         Width           =   915
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Type"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   0
         Left            =   60
         TabIndex        =   17
         Top             =   360
         Width           =   915
      End
   End
   Begin MSComDlg.CommonDialog dlg_dlg 
      Left            =   720
      Top             =   9180
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   3180
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   3870
      _ExtentX        =   6826
      _ExtentY        =   1217
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Tables"
      Height          =   8715
      Index           =   0
      Left            =   60
      TabIndex        =   0
      Top             =   240
      Width           =   3075
      Begin Project1.ArmGrid grd_tables 
         Height          =   5175
         Left            =   720
         TabIndex        =   6
         TabStop         =   0   'False
         Top             =   780
         Width           =   2115
         _ExtentX        =   3731
         _ExtentY        =   9128
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Table content"
      Height          =   4275
      Index           =   1
      Left            =   3180
      TabIndex        =   2
      Top             =   720
      Width           =   10335
      Begin Project1.ArmCombobox cbo_categories 
         Height          =   345
         Left            =   6360
         TabIndex        =   33
         Top             =   210
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   609
      End
      Begin VB.TextBox txt_from 
         Height          =   285
         Left            =   1140
         TabIndex        =   29
         Text            =   "Text1"
         Top             =   240
         Width           =   1575
      End
      Begin VB.TextBox txt_to 
         Height          =   285
         Left            =   2880
         TabIndex        =   30
         Text            =   "Text1"
         Top             =   240
         Width           =   1575
      End
      Begin Project1.ArmGrid grd_tableContent 
         Height          =   3555
         Left            =   240
         TabIndex        =   3
         TabStop         =   0   'False
         Top             =   780
         Width           =   7215
         _ExtentX        =   12726
         _ExtentY        =   6271
      End
      Begin VB.Label lbl_labels 
         Alignment       =   1  'Right Justify
         Caption         =   "#Category"
         Height          =   255
         Index           =   12
         Left            =   4830
         TabIndex        =   34
         Top             =   270
         Width           =   1425
      End
      Begin VB.Label lbl_labels 
         Caption         =   "-"
         Height          =   255
         Index           =   11
         Left            =   2760
         TabIndex        =   32
         Top             =   240
         Width           =   135
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Range"
         Height          =   255
         Index           =   10
         Left            =   180
         TabIndex        =   31
         Top             =   270
         Width           =   975
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Linked BLOBs"
      Height          =   5175
      Index           =   2
      Left            =   3900
      TabIndex        =   4
      Top             =   4410
      Width           =   8115
      Begin Project1.ArmGrid grd_zipInfo 
         Height          =   3735
         Left            =   180
         TabIndex        =   5
         Top             =   240
         Width           =   7275
         _ExtentX        =   12832
         _ExtentY        =   6588
      End
   End
End
Attribute VB_Name = "BLOBEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' **************************************************************************************************
' **************************************** TOOL CONSTANTS ******************************************
' **************************************************************************************************
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const C_SCREENNAME As String = "BLOB_Editor"    ' for loading screen constants
Private Const C_TOOLBARFACE_ITEM_LST As String = "0"
Private Const C_TOOLBARFACE_ITEM_MTNC As String = "1"
Private Const CI_CTRLID As Long = 0             ' index of control ID inside Tag property
Private Const CI_DATAFIELD As Long = 1          ' datafield name
Private Const CI_DATASRC As Long = 2            ' data source
Private Const CI_CTRLLABEL As Long = 3          ' label control ID
Private Const C_TEMPDIR As String = "\Download\" ' temporary directory relative to executable
Private Const C_MASTER_LANG As String = "E"     ' master language
Private Const C_A_References_ML_Types As Long = 2
Private Const C_A_References_ML_Languages As Long = 3

' ****************************************** TOOL CONSTANTS ***************************************


' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
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
    CompFncFailed = vbObjectError + 6          ' when component function fail
    loginfailed = vbObjectError + 7          ' when Login fail
    UserCopyAbort = vbObjectError + 8               ' when user click abort copy
    InvalidValue = vbObjectError + 9               ' invalid version, invalid
    QuietException = vbObjectError + 10              ' do not display error message
End Enum
' *************************************** USER DEFINED ERRORS **************************************

' **************************************************************************************************
' *************************************** CONTROL MEMBERS ******************************************
' **************************************************************************************************
Dim ms_activeFace As String         ' active face
Dim ml_U_Code As Long               ' if this is user loging app, needed to log errors into A_Log
Dim ms_Languace_codeUI As String    ' Language of user interface
Dim ml_DetailCursor As Long         ' cursor opened when entering detail
Dim mb_AdminUser As Boolean         ' indicate this user to be admin / can add new blob
Dim mb_AllowInternetFlag As Boolean

Public Event quit()
#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If

Dim mo_FSO As Object            ' global filesystem object
' *************************************** CONTROL MEMBERS ******************************************

Public Property Let U_Code(ByVal al_U_Code As Long)
    ml_U_Code = al_U_Code
End Property

Public Property Let Language_Code(as_Language_Code As String)
    ms_Languace_codeUI = as_Language_Code
End Property

Private Property Get Language_codeToolBar() As String
On Error GoTo ErrHandler
    Language_codeToolBar = tlb_main.Language
    Exit Property
    
ErrHandler:
    Call ErrorHandler("Language_code(Get)")
End Property

Private Property Get BLOB_ID() As Long
On Error GoTo ErrHandler
    If grd_zipInfo.Row = -1 Then
        BLOB_ID = 0
    Else
        BLOB_ID = CLng(grd_zipInfo.SelectedLine(0, "ZIPID"))
    End If
    Exit Property
    
ErrHandler:
    Call ErrorHandler("BLOB_ID(Get)")
End Property

Private Property Get BLOB_FILE() As String
On Error GoTo ErrHandler
    If grd_zipInfo.Row = -1 Then
        BLOB_FILE = ""
    Else
        BLOB_FILE = grd_zipInfo.SelectedLine(0, "FILENAME")
    End If
    Exit Property
    
ErrHandler:
    Call ErrorHandler("BLOB_FILE(Get)")
End Property


Public Function Load_A_COM()
On Error GoTo ErrHandler
Load_A_COM = False
    ' init member variables
    ml_DetailCursor = 0
    mb_AdminUser = GetRight("REF_BLOB_ADMIN")
    mb_AllowInternetFlag = GetRight("REF_BLOB_INTERNET")
    ' Set Db
    Debug.Assert (Not mo_Db Is Nothing)
    
    Set grd_tableContent.ArmDb = mo_Db
    Set grd_zipInfo.ArmDb = mo_Db
    Set grd_tables.ArmDb = mo_Db
    Set cbo_language.ArmDb = mo_Db
    Set cbo_type.ArmDb = mo_Db
    Set cbo_groups.ArmDb = mo_Db
    Set cbo_categories.ArmDb = mo_Db
    Set cvw_countries.ArmDb = mo_Db
    Set tlb_main.ArmDb = mo_Db
    
    ' call Load_A_Com
    Call grd_tableContent.Load_A_COM
    Call grd_zipInfo.Load_A_COM
    Call grd_tables.Load_A_COM
    Call cbo_language.Load_A_COM
    Call cbo_type.Load_A_COM
    Call cbo_groups.Load_A_COM
    Call cbo_categories.Load_A_COM
    Call tlb_main.Load_A_COM
    Call cvw_countries.Load_A_COM
    
    ' init controls
    Call InitControls
    Call SetLanguage(ms_Languace_codeUI)
    Call FillTablesGrid(grd_tables, ms_Languace_codeUI, -1)
    Call ResetMain
    
    ' set layout
    Call SetUI
    
    ' display starting face
    Call UpdateUI("BLOBEdit.Main")
Load_A_COM = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Load_A_Com()")
End Function

Public Sub Unload_A_COM()
On Error GoTo ErrHandler
    
    ' call Unload_A_Com
    Call grd_tableContent.Unload_A_COM
    Call grd_zipInfo.Unload_A_COM
    Call grd_tables.Unload_A_COM
    Call cbo_language.Unload_A_COM
    Call cbo_type.Unload_A_COM
    Call cbo_groups.Unload_A_COM
    Call cbo_categories.Unload_A_COM
    Call tlb_main.Unload_A_COM
    Call cvw_countries.Unload_A_COM
    
    ' free ArmDB
    Set grd_tables.ArmDb = Nothing
    Set grd_tableContent.ArmDb = Nothing
    Set grd_zipInfo.ArmDb = Nothing
    Set cbo_language.ArmDb = Nothing
    Set cbo_type.ArmDb = Nothing
    Set cbo_groups.ArmDb = Nothing
    Set cbo_categories.ArmDb = Nothing
    Set tlb_main.ArmDb = Nothing
    Set cvw_countries.ArmDb = Nothing
    
    If ml_DetailCursor <> 0 Then Call mo_Db.Close(ml_DetailCursor)
    
    Set mo_Db = Nothing
    Exit Sub
ErrHandler:
    If ml_DetailCursor <> 0 Then Call mo_Db.Close(ml_DetailCursor)
    Set mo_Db = Nothing
    Call ErrorHandler("Unload_A_Com()")
End Sub

#If LIVE = 1 Then
Public Property Set DB(ByRef ao_DB As Object)
#Else
Public Property Set DB(ByRef ao_DB As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo ErrHandler

    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_DB Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_DB
    
    Exit Property
    
ErrHandler:
    Call ErrorHandler("Db(Set)")
End Property

Public Property Set fso(ByRef ao_FSO As Object)
On Error GoTo ErrHandler
    If Not mo_FSO Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_FSO Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_FSO = ao_FSO
    Exit Property
ErrHandler:
    Call ErrorHandler("FSO(Set)")
End Property

'******************** REDIM FUNCTION **********************************
'Sub SafeRedimString(ByRef as_Array() As String, al_NumElements As Long)
'
'On Error GoTo ErrHandler
'
'  If al_NumElements = 0 Then
'          ReDim as_Array(-1 To -1)
'  Else
'          ReDim Preserve as_Array(al_NumElements - 1)
'  End If
'  Exit Sub
'ErrHandler:
'    Call ErrorHandler("SafeRedimString()")
'End Sub
'
'Sub SafeRedim(ByRef av_Array() As Variant, al_NumElements As Long)
'
'On Error GoTo ErrHandler
'
'  If al_NumElements = 0 Then
'          ReDim av_Array(-1 To -1)
'  Else
'          ReDim Preserve av_Array(al_NumElements - 1)
'  End If
'  Exit Sub
'ErrHandler:
'    Call ErrorHandler("SafeRedim()")
'End Sub
' ************************************************************************************


' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_req As String)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String)
#End If

    If Not ao_DB.ExecuteSQL(as_req) Then
        Call Err.Raise(CompFncFailed, "ExecuteSQLSafe", "SQL Error: " & GetDbError(ao_DB))
    End If

End Sub

#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_req As String) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String) As Long
#End If

    OpenSQLSafe = ao_DB.OpenSQL(as_req)
    
    If OpenSQLSafe = 0 Then Call Err.Raise(CompFncFailed, "OpenSQLSafe", "SQL Error: " & GetDbError(ao_DB))

End Function

Private Function SQLStr(ByVal as_str As String) As String
    SQLStr = Replace(as_str, "'", "''")
End Function
' ************************************************************************************


' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private 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

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

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    If Err.Number = QuietException Then Exit Sub
    Dim ll_oldMP As MousePointerConstants
    
    'save mouse pointer
    ll_oldMP = Screen.MousePointer
    Screen.MousePointer = vbDefault
    
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    
    Call LogMessage(App.ProductName & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_errDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT" & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, , "Error message: " & as_Fct)
    
    'restore mouse pointer
    Screen.MousePointer = ll_oldMP
End Sub

Private Sub FieldErrorMsg(ByVal al_msgID As Long, ByVal as_caption As String, ByVal ao_Field As Object)

    Dim ls_Buffer As String
    Dim ll_oldMP As MousePointerConstants
    
    'save mouse pointer
    ll_oldMP = Screen.MousePointer
    Screen.MousePointer = vbDefault
    
    ls_Buffer = MsgText(al_msgID, Language_codeToolBar)
    ls_Buffer = Replace(ls_Buffer, "$field$", as_caption)
    
    ao_Field.SetFocus
    Call MsgBox(ls_Buffer, vbOKOnly + vbCritical)
    
    'restore mouse pointer
    Screen.MousePointer = ll_oldMP
End Sub

Public Function MsgText(ByVal ai_MsgID As Integer, ByVal as_LanguageCode As String) As String
'------------------------------------------------------------------
' Name : MsgText
'
' Purpose : Read the message in the database with the login
'           language
'
' Parameters :
'       ai_MsgId            Code of the message to find in the
'                               database
'       as_LanguageCode     Language Code to use to find the text
'
' Return :
'       The message in the good language
'
' review : Mar/20/2000 by AD
'------------------------------------------------------------------
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT message_text FROM error_message WHERE msgid=$MSGID$ AND Language_code='$LANG_CODE$'"
    Dim ls_req As String, ls_ret As String
    Dim ll_cursor As Long
    
    ls_req = Replace(C_REQ, "$MSGID$", ai_MsgID)
    ls_req = Replace(ls_req, "$LANG_CODE$", as_LanguageCode)
    
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    Call mo_Db.First(ll_cursor)
    While Not mo_Db.EOF(ll_cursor)
        ls_ret = IIf(ls_ret = "", "", ls_ret & vbCrLf) & mo_Db.GetFields(ll_cursor, "message_text")
        Call mo_Db.Next(ll_cursor)
    Wend
    Call mo_Db.Close(ll_cursor)
    MsgText = ls_ret
    Exit Function
ErrHandler:
    If ll_cursor <> 0 Then Call mo_Db.Close(ll_cursor)
    Call ErrorHandler("MsgText()")
End Function


Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "INSERT INTO A_Log (U_code, Z_creation_date, Source , Log_type, Log_Msg ) VALUES ($UCODE$, GETDATE(), '$APP$', '$LOGTYPE$', '$MSG$')"
    Dim ls_req As String
    Dim ll_cursor As Long
    
    ls_req = Replace(InsertReq, "$UCODE$", CStr(ml_U_Code))
    ls_req = Replace(ls_req, "$APP$", SQLStr(App.ProductName & " " & App.Major & "." & App.Minor & "." & App.Revision))
    ls_req = Replace(ls_req, "$MSG$", SQLStr(as_logMsg))
    ls_req = Replace(ls_req, "$LOGTYPE$", SQLStr(as_logType))
    
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    Exit Sub
ErrHandler:
    If ab_throwException Then Call ErrorHandler("LogMessage()")
End Sub

' procedure save/restore err object
Private 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
' ************************************************************************************

' *******************************************************************************
' ************************ DISK IO FUNCTIONS ************************************
' *******************************************************************************
' create directory if not exist
Private Function CreateDirStruct(ByVal strPath As String, ByVal ao_FSO As Object) As Boolean

On Error GoTo Create_Dir_Struct_Errors
    Dim intIndex    As Integer
    Dim strTmpPath  As String
    
    If Len(Trim$(strPath)) = 0 Then
        ' if we specify wrong path it is error
        CreateDirStruct = False
        Exit Function
    End If
    
    If right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    intIndex = 0
    
    Do
        ' get the next path chunk
        intIndex = InStr(intIndex + 1, strPath, "\")
        
        If intIndex > 0 Then
            strTmpPath = Left$(strPath, intIndex - 1)
        Else
            Exit Do
        End If
        
        ' see if this folder exists
        If Not ao_FSO.FolderExists(strTmpPath) Then
            ' Create this folder.
            ' If there is an error, it will be trapped bellow
            ao_FSO.CreateFolder strTmpPath
            intIndex = 1
        End If
    Loop
    CreateDirStruct = True
    Exit Function

Create_Dir_Struct_Errors:
    CreateDirStruct = False
    Call ErrorHandler("CreateDirStruct()")
End Function



' ************************************************************************************
' ************************* DOCUMENT DISPLAY FUNCTIONS *******************************
' ************************************************************************************

#If LIVE Then
Private Sub DisplayZip(ByVal ao_Armdb As Object, ByVal as_extractFile As String, ByVal al_RZ_ID As Long)
#Else
Private Sub DisplayZip(ByVal ao_Armdb As ARMSYSCOMLib.ArmDb, ByVal as_extractFile As String, ByVal al_RZ_ID As Long)
#End If

Dim ls_Filename As String
Dim ls_Command As String


On Error GoTo ErrorHandler

    ' create shell object to access Registry and Runtime
    Dim lo_shell As Object
    Set lo_shell = CreateObject("WSCript.Shell")
    If lo_shell Is Nothing Then
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create WSCript.Shell.")
    End If
    
    ' get command defined for extension
    Dim ls_DDEExec As String, ls_Application As String, ls_topic As String
    ls_Command = GetCommand(GetString(as_extractFile, -1, "."), ls_DDEExec, ls_Application, ls_topic, lo_shell)
    
    If ls_Command = "" Then
        ' TODO: Manage status: no associate application found
        ' TODO: here we can try explorer.exe to display media
        Call Err.Raise(CompFncFailed, "", "No Application associated with file.")
    End If
    
    ' now when we know how to run, we can download file and run
    ls_Filename = DownloadZipFile(ao_Armdb, al_RZ_ID, as_extractFile)
    
    ' anyway, to execute document we don't need ls_command
    Call lo_shell.Run("""" & ls_Filename & """")
    
    Set lo_shell = Nothing
    
Exit Sub

ErrorHandler:
    If Not lo_shell Is Nothing Then Set lo_shell = Nothing
    Call Err.Raise(Err.Number, "DisplayZip" & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub

#If LIVE Then
Private Function DownloadZipFile(ByVal ao_Armdb As Object, ByVal al_RZ_ID As Long, ByVal as_FileName As String) As String
#Else
Private Function DownloadZipFile(ByVal ao_Armdb As ARMSYSCOMLib.ArmDb, ByVal al_RZ_ID As Long, ByVal as_FileName As String) As String
#End If
On Error GoTo ErrHandler
    
    Dim ls_path As String
    
    ls_path = App.Path & C_TEMPDIR & al_RZ_ID & "\"
    
    ' check if file exists in local temporary directory
    If mo_FSO.FileExists(ls_path & as_FileName) Then
        DownloadZipFile = ls_path & as_FileName
        Exit Function
    End If
    
    If Not mo_FSO.FolderExists(ls_path) Then
        Call CreateDirStruct(ls_path, mo_FSO)
        Debug.Assert (mo_FSO.FolderExists(ls_path))     ' folder Download must exists
    End If
    
    ' download media from SQL server and decompress
    Call DownloadBlob(al_RZ_ID, ls_path & as_FileName)
    
    Debug.Assert (mo_FSO.FileExists(ls_path & as_FileName))
    DownloadZipFile = ls_path & as_FileName
    
Exit Function
ErrHandler:
    Call Err.Raise(Err.Number, "DownloadZipFile" & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

' return command to be executed to open file with specific extension
Private Function GetCommand(ByVal as_ext As String, ByRef as_DDEExec As String, ByRef as_Application As String, ByRef as_Topic As String, ByVal ao_shell As Object) As String

Dim ls_defValue As String

    GetCommand = ""

    On Error GoTo exitFnc
    ls_defValue = ao_shell.RegRead("HKCR\." & as_ext & "\")
    If ls_defValue = "" Then
        Call Err.Raise(CompFncFailed, "", "File extension is not supported.")
    End If
    
    Dim ls_cmd As String
    
    ls_cmd = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\command\")
    If ls_cmd = "" Then
        Call Err.Raise(CompFncFailed, "", "Open command not defined.")
    End If
    GetCommand = ls_cmd
    
    ' try to locate DDEExec, if not exception is rised
    as_DDEExec = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\")
    as_Application = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\application\")
    as_Topic = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\topic\")

    Exit Function
exitFnc:
End Function


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

Private Function GetCodePageFromLanguage(ByRef ao_Armdb As Object, ByVal as_Language As String) As Long
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT Code_Page FROM Language WHERE Language_Code = '$LANG_CODE$'"
    Dim ls_req As String
    Dim ll_cursor As Long
    Dim ll_codePage As Long
    
    ls_req = Replace(C_REQ, "$LANG_CODE$", as_Language)

    ll_cursor = OpenSQLSafe(ao_Armdb, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    ll_codePage = CLng(ao_Armdb.GetFields(ll_cursor, "Code_Page"))
    Call ao_Armdb.Close(ll_cursor)
    GetCodePageFromLanguage = ll_codePage
    Exit Function
    
ErrHandler:
    If ll_cursor <> 0 Then Call ao_Armdb.Close(ll_cursor)
    Call ErrorHandler("GetCodePageFromLanguage()")
End Function

'convert code page into charset integer
Private 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

Private Sub ChangeCharset(ByRef ao_Container As Object, ByVal al_CodePage As Long)
On Error GoTo ErrHandler
    Dim lc_Control As Object   ' A control of the container
    Dim ll_Charset As Long
    
    Screen.MousePointer = vbHourglass

    Debug.Assert (al_CodePage <> 0)

    ll_Charset = GetCharSetFromCodePage(al_CodePage)
    
    For Each lc_Control In ao_Container
        If Not TypeOf lc_Control Is CommonDialog And Not TypeOf lc_Control Is ToolbarControl Then
            lc_Control.Font.Name = "Arial"
            lc_Control.Font.Charset = ll_Charset
        End If
    Next
    
    Screen.MousePointer = vbDefault
    Exit Sub

ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorHandler("ChangeCharset()")
End Sub


' ************************************************************************************

' ************************************************************************************
' **************************** FRAMEWORK FUNCTIONS ***********************************
' ************************************************************************************

' function does not support cursor data sources, at the moment
Private Function ReplacePlaceholders(ByVal as_src As String) As String
On Error GoTo ErrHandler
    ' language
    as_src = Replace(as_src, "$LANG_CODE$", Language_codeToolBar)
    ' u_code
    as_src = Replace(as_src, "$U_code$", ml_U_Code)
    
    
    as_src = Replace(as_src, "$" & GetString(txt_desc.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_desc.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_internetDesc.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_internetDesc.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_memo.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_memo.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_title.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_title.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_file.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_file.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_spare1.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_spare1.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_spare2.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_spare2.Text), , , vbTextCompare)
    as_src = Replace(as_src, "$" & GetString(txt_spare3.Tag, CI_CTRLID, SEP1 + SEP2) & "$", SQLStr(txt_spare3.Text), , , vbTextCompare)
    
    as_src = Replace(as_src, "$" & GetString(chk_InternetFlag.Tag, CI_CTRLID, SEP1 + SEP2) & "$", IIf(chk_InternetFlag.Value = vbChecked, "X", ""), , , vbTextCompare)
    
    If Not cbo_type.SelectedItem Is Nothing Then as_src = Replace(as_src, "$" & GetString(cbo_type.Tag, CI_CTRLID, SEP1 + SEP2) & "$", cbo_type.SelectedItem.Key, , , vbTextCompare)
    If Not cbo_language.SelectedItem Is Nothing Then as_src = Replace(as_src, "$" & GetString(cbo_language.Tag, CI_CTRLID, SEP1 + SEP2) & "$", cbo_language.SelectedItem.Key, , , vbTextCompare)
    
    ' replace grids
    If grd_tables.Row <> -1 Then as_src = ReplaceGridPlaceholders(grd_tables, grd_tables.Row, as_src)
    If grd_zipInfo.Row <> -1 Then as_src = ReplaceGridPlaceholders(grd_zipInfo, grd_zipInfo.Row, as_src)
    
    ' replace key form selected row
    Dim lv_Key As Variant
    lv_Key = grd_tableContent.SelectedKey(0)
    If Not IsEmpty(lv_Key) Then as_src = Replace(as_src, "$CONTENT_TABLE_KEY$", SQLStr(CStr(lv_Key(0))), , , vbTextCompare)

    ReplacePlaceholders = as_src
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplacePlaceholders()")
End Function

' Exact copy of ArmGrid.ReplacePlaceholders(..), but we use Column.Name property
Private Function ReplaceGridPlaceholders(ByVal ao_grid As ArmGrid, ByVal al_Row As Long, ByVal as_String As String) As String
On Error GoTo ErrHandler
    Dim ls_retVal As String
    Dim lo_Column As ArmColumn
    Dim ll_Index As Long
    
    ls_retVal = as_String
    For ll_Index = 0 To ao_grid.Cols - 1
      Set lo_Column = ao_grid.Columns(ll_Index)
      ls_retVal = Replace(ls_retVal, "$" & lo_Column.Name & "$", SQLStr(lo_Column.GetData(al_Row)), , , vbTextCompare)
    Next
    ReplaceGridPlaceholders = ls_retVal
    Exit Function
ErrHandler:
     Call ErrorHandler("ReplaceGridPlaceholders()")
End Function

Private Sub UpdateGridAfterAction(ByVal ao_grid As ArmGrid, ByVal ao_srcCtrl As Collection, ByVal as_Action As String, ByVal av_Key As Variant)
On Error GoTo ErrHandler
    Dim ll_Index As Long
    Dim lo_Column As ArmColumn
    
    Select Case as_Action
    Case "Add"
        ' insert row at the end of grid
        Debug.Assert (ao_grid.Cols > 0)
        Dim lsa_newRow() As String
        'MS REDIMM
        Call SafeRedimPreserve(lsa_newRow, ao_grid.Cols - 1)
        Dim ll_KeyIndex As Long
        ll_KeyIndex = 0
        
        For ll_Index = 0 To ao_grid.Cols - 1
            Set lo_Column = ao_grid.Columns(ll_Index)
            If lo_Column.Key Then
                Debug.Assert (UBound(av_Key) >= ll_KeyIndex)
                lsa_newRow(ll_Index) = av_Key(ll_KeyIndex)
                ll_KeyIndex = ll_KeyIndex + 1
            Else
                lsa_newRow(ll_Index) = GetDataSrc(ao_srcCtrl, lo_Column.FieldName)
            End If
        Next
        Call ao_grid.AddLine(lsa_newRow)
    Case "Upd"
        ' search and update row in the grid
        Debug.Assert (ao_grid.Cols > 0)
        
        If Not ao_grid.SearchKey(True, av_Key) Then
            Call Err.Raise(CompFncFailed, "ao_grid.SearchKey", "Cannot update grid.")
        End If
        
        For ll_Index = 0 To ao_grid.Cols - 1
            Set lo_Column = ao_grid.Columns(ll_Index)
            If Not lo_Column.Key Then
                If Not lo_Column.SetData(ao_grid.Row, GetDataSrc(ao_srcCtrl, lo_Column.FieldName)) Then
                    Call Err.Raise(CompFncFailed, "lo_Column.SetData", "Cannot update grid.")
                End If
            End If
        Next

    Case "Del"
        ' remove row from grid
        If Not ao_grid.DeleteLine(av_Key) Then
            Call Err.Raise(CompFncFailed, "DeleteLine", "Cannot delete line.")
        End If
    End Select
    Exit Sub
ErrHandler:
     Call ErrorHandler("UpdateGridAfterAction()")
End Sub

' function return value from one of ao_srcCtrl, that is linked to the as_fieldName
' when updating datastore from diferent source than standard
Private Function GetDataSrc(ByVal ao_srcCtrl As Collection, ByVal as_FieldName As String) As String
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    Dim li_Index As Integer
    For Each lo_ctrl In ao_srcCtrl
        Dim lsa_DataFields() As String
        lsa_DataFields = Split(GetString(lo_ctrl.Tag, CI_DATAFIELD, SEP1 + SEP2), SEP1)
        For li_Index = LBound(lsa_DataFields) To UBound(lsa_DataFields)
            If UCase(lsa_DataFields(li_Index)) Like "DB_*" Then lsa_DataFields(li_Index) = right(lsa_DataFields(li_Index), Len(lsa_DataFields(li_Index)) - 3)
            If StrComp(lsa_DataFields(li_Index), as_FieldName, vbTextCompare) = 0 Then
                Select Case UCase(TypeName(lo_ctrl))
                Case "TEXTBOX"
                    GetDataSrc = lo_ctrl.Text
                Case "ARMCOMBOBOX"
                    GetDataSrc = lo_ctrl.SelectedItem.GetData(li_Index)
                Case "CHECKBOX"
                    GetDataSrc = IIf(lo_ctrl.Value = vbChecked, "X", "")
                End Select
                Exit Function
            End If
        Next
    Next

    Exit Function
ErrHandler:
     Call ErrorHandler("GetDataSrc()")
End Function

' there are two possible datastores grd_zipInfo and ml_DetailCursor
' prefix DB_ .... means source is ml_DetailCursor
Private Function GetData(ByVal as_FieldName As String) As String
On Error GoTo ErrHandler
    If UCase(as_FieldName) Like "DB_*" Then
        GetData = mo_Db.GetFields(ml_DetailCursor, right(as_FieldName, Len(as_FieldName) - 3))
    Else
        GetData = grd_zipInfo.SelectedLine(0, as_FieldName)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetData()")
End Function

Private Sub SetEnabled(ByVal ao_srcCtrl As Collection, ByVal ab_Value As Boolean)
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_srcCtrl
        Select Case UCase(TypeName(lo_ctrl))
        Case "TEXTBOX"
            lo_ctrl.Locked = Not ab_Value
        Case "ARMCOMBOBOX", "FRAME", "DIRLISTBOX", "DRIVELISTBOX", "FILELISTBOX", "CHECKBOX"
            lo_ctrl.Enabled = ab_Value
        End Select
    Next

    Exit Sub
ErrHandler:
     Call ErrorHandler("SetEnabled()")
End Sub

Private Sub SetUI()
On Error GoTo ErrHandler
    Const LEFT_MARGIN As Long = 60
    Const RIGHT_MARGIN As Long = 60
    Const TOP_MARGIN As Long = 60
    Const BOTTOM_MARGIN As Long = 60
    
    Dim lo_ctrl As Object, lo_auxCtrl As Object
    
    Dim ll_Left As Long, ll_top As Long, ll_Width As Long, ll_height As Long
        
    Set lo_auxCtrl = GetControl(frm_frames, "frm_tableFilter")
    ll_height = UserControl.Height
    Call lo_auxCtrl.Move(0, 0, lo_auxCtrl.Width, ll_height)
    
    Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
    ll_Left = lo_auxCtrl.Width + lo_auxCtrl.Left + LEFT_MARGIN + RIGHT_MARGIN
    ll_height = UserControl.Height - tlb_main.Height - frm_frames(2).Height - 2 * TOP_MARGIN - BOTTOM_MARGIN
'    Call lo_ctrl.Move(ll_left, tlb_main.Height + TOP_MARGIN, UserControl.Width - ll_left, ll_height)
    Call lo_ctrl.Move(ll_Left, TOP_MARGIN, UserControl.Width - ll_Left, ll_height)
    Call tlb_main.Move(ll_Left, lo_ctrl.Top + lo_ctrl.Height + TOP_MARGIN)

    Set lo_auxCtrl = lo_ctrl
    Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkLst")
    ll_top = lo_auxCtrl.Top + lo_auxCtrl.Height + TOP_MARGIN + BOTTOM_MARGIN + tlb_main.Height
    Call lo_ctrl.Move(lo_auxCtrl.Left, ll_top, lo_auxCtrl.Width)
    ll_height = lo_ctrl.Height
    
    Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkMtnc")
    ll_top = lo_auxCtrl.Top + lo_auxCtrl.Height + TOP_MARGIN + BOTTOM_MARGIN + tlb_main.Height
    Call lo_ctrl.Move(lo_auxCtrl.Left, ll_top, lo_auxCtrl.Width, ll_height)
    
    ' table content grid
    Set lo_ctrl = grd_tableContent.Container
    ll_top = lo_ctrl.FontSize * 20 + TOP_MARGIN * 2 + txt_from.Height    ' *20 = points to twips conversion
    Call grd_tableContent.Move(LEFT_MARGIN, ll_top, lo_ctrl.Width - LEFT_MARGIN - RIGHT_MARGIN, lo_ctrl.Height - ll_top - BOTTOM_MARGIN)
    
    ' table blob link grid
    Set lo_ctrl = grd_zipInfo.Container
    ll_top = lo_ctrl.FontSize * 20 + TOP_MARGIN     ' *20 = points to twips conversion
    Call grd_zipInfo.Move(LEFT_MARGIN, ll_top, lo_ctrl.Width - LEFT_MARGIN - RIGHT_MARGIN, lo_ctrl.Height - ll_top - BOTTOM_MARGIN)
    
    ' table listbox
    Set lo_ctrl = grd_tables.Container
    ll_top = lo_ctrl.FontSize * 20 + TOP_MARGIN     ' *20 = points to twips conversion
    Call grd_tables.Move(LEFT_MARGIN, ll_top, lo_ctrl.Width - LEFT_MARGIN - RIGHT_MARGIN, lo_ctrl.Height - ll_top - BOTTOM_MARGIN)

    Exit Sub
ErrHandler:
    Call ErrorHandler("SetUI()")
End Sub

Private Function GetContainedControls(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control Is CommonDialog Then
            If Not TypeOf lo_Control.Container Is BLOBEdit Then
                If ao_parent.hwnd = lo_Control.Container.hwnd Then
                    Call lo_retCollection.Add(lo_Control)
                End If
            End If
        End If
    Next
    Set GetContainedControls = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler("GetContainedControls()")
End Function

Private Function GetContainedControlsChain(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control Is CommonDialog Then
            If Not TypeOf lo_Control.Container Is BLOBEdit Then
                If ao_parent.hwnd = lo_Control.Container.hwnd Then
                    If TypeOf lo_Control Is Frame Then
                        Dim lo_aux_collection As New Collection
                        Dim ll_i As Long
                        Set lo_aux_collection = GetContainedControlsChain(lo_Control)
                        For ll_i = 1 To lo_aux_collection.Count
                            lo_retCollection.Add (lo_aux_collection.Item(ll_i))
                        Next
                    Else
                        Call lo_retCollection.Add(lo_Control)
                    End If
                End If
            End If
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler("GetContainedControlsChain()")
End Function

' as_Name is first part of Tag definition string
Private Function GetControl(ByVal ao_array As Object, ByVal as_Name As String) As Object
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_array
        If StrComp(GetString(lo_ctrl.Tag, CI_CTRLID, SEP1 + SEP2), as_Name, vbTextCompare) = 0 Then
            Set GetControl = lo_ctrl
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler("GetControl()")
End Function

' if ll_index is negative value string is indexed backward
Private Function GetString(ByVal as_String As String, ByVal ll_Index As Long, Optional ByVal as_delimiter As String = SEP1 + SEP2) As String
On Error GoTo ErrHandler
    Dim lsa_tmpArray() As String
    lsa_tmpArray = Split(as_String, as_delimiter)
    
    If ll_Index < 0 Then ll_Index = ll_Index + UBound(lsa_tmpArray) + 1    ' backward index
    
    If UBound(lsa_tmpArray) >= ll_Index And LBound(lsa_tmpArray) <= ll_Index Then GetString = lsa_tmpArray(ll_Index)
    
    Exit Function
ErrHandler:
    Call ErrorHandler("GetString()")
End Function

' function will return new string array contaning value at specified index
Private Function SetString(ByVal as_String As String, ByVal ll_Index As Long, ByVal as_newValue As String, Optional ByVal as_delimiter As String = SEP1 + SEP2) As String
On Error GoTo ErrHandler
    Dim lsa_tmpArray() As String
    lsa_tmpArray = Split(as_String, as_delimiter)
    
    If ll_Index < 0 Then ll_Index = ll_Index + UBound(lsa_tmpArray) + 1    ' backward index
    
    If UBound(lsa_tmpArray) >= ll_Index And LBound(lsa_tmpArray) <= ll_Index Then lsa_tmpArray(ll_Index) = as_newValue
    
    SetString = Join(lsa_tmpArray, as_delimiter)
    
    Exit Function
ErrHandler:
    Call ErrorHandler("SetString()")
End Function

Private Function LoadToolbars()
On Error GoTo ErrHandler
    
    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$ AND App_Id=$App_Id$"
    Dim lc_Toolbar As Long
    Dim ls_ToolbarRequest As String

    ls_ToolbarRequest = Replace(CL_REQUEST_TB, "$user_id$", 0)
    ls_ToolbarRequest = Replace(ls_ToolbarRequest, "$App_Id$", 1)
    lc_Toolbar = OpenSQLSafe(mo_Db, ls_ToolbarRequest)
    
    ' init toolbar
    tlb_main.Language = ms_Languace_codeUI
    Call tlb_main.SetToolbarInfoStringParameters(mo_Db.GetFields(lc_Toolbar, "Toolbar_info"), "070")
    Call tlb_main.DisplayFace(0)
    
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = True
    Exit Function
ErrHandler:
    LoadToolbars = False
    Call mo_Db.Close(lc_Toolbar)
    Call ErrorHandler("LoadToolbars()")
End Function


Private Sub InitControls()
On Error GoTo ErrHandler
    
    Dim lo_ctrl As Object
    
    Call LoadToolbars
    
    ' init tags for all controls
    frm_frames(0).Tag = CreateTag("frm_tableFilter", "", "", "")
    frm_frames(1).Tag = CreateTag("frm_tableContent", "", "", "")
    frm_frames(2).Tag = CreateTag("frm_blobLinkLst", "", "", "")
    frm_frames(3).Tag = CreateTag("frm_blobLinkMtnc", "", "", "")
    frm_frames(4).Tag = CreateTag("frm_fileSelect", "", "", "")
    
    cbo_language.Tag = CreateTag("cbo_language", "DB_RZ_Language" & SEP1 & "DB_Language_desc", "EXEC A_References_ML_LstSafe " & C_A_References_ML_Languages & ",'$LANG_CODE$'", "lbl_language")
    cbo_type.Tag = CreateTag("cbo_type", "DB_RZ_Type" & SEP1 & "DB_RF_desc", "EXEC A_References_ML_LstSafe " & C_A_References_ML_Types & ",'$LANG_CODE$'", "lbl_type")
    cbo_groups.Tag = CreateTag("cbo_groups", "", "EXEC Ref_Logistic_Markets_cbo '$LANG_CODE$'", "")
    cbo_categories.Tag = CreateTag("cbo_categories", "CATEGORY", "EXEC categories_cbo '$LANG_CODE$'", "lbl_category")
    
    grd_tableContent.Tag = CreateTag("grd_tableContent", "", "", "")
    grd_zipInfo.Tag = CreateTag("grd_zipInfo", "", "", "")
    grd_tables.Tag = CreateTag("grd_tables", "", "", "")
    
    txt_desc.Tag = CreateTag("txt_desc", "DB_RZ_Desc", "", "lbl_description")
    txt_internetDesc.Tag = CreateTag("txt_internetDesc", "DB_Internet_desc", "", "lbl_internetDesc")
    chk_InternetFlag.Tag = CreateTag("chk_InternetFlag", "DB_Internet_flag", "", "")
    txt_memo.Tag = CreateTag("txt_memo", "DB_RZ_Memo", "", "lbl_memo")
    txt_title.Tag = CreateTag("txt_title", "DB_RZ_Title", "", "lbl_title")
    txt_file.Tag = CreateTag("txt_file", "DB_RZ_FileName", "", "lbl_fileName")
    txt_spare1.Tag = CreateTag("txt_spare1", "DB_Spare1", "", "lbl_spare1")
    txt_spare2.Tag = CreateTag("txt_spare2", "DB_Spare2", "", "lbl_spare2")
    txt_spare3.Tag = CreateTag("txt_spare3", "DB_Spare3", "", "lbl_spare3")
    txt_from.Tag = CreateTag("txt_from", "RANGEFROM", "", "lbl_range")
    txt_to.Tag = CreateTag("txt_to", "RANGETO", "", "lbl_range")
    
    lbl_labels(0).Tag = CreateTag("lbl_type", "", "", "")
    lbl_labels(1).Tag = CreateTag("lbl_title", "", "", "")
    lbl_labels(2).Tag = CreateTag("lbl_internetDesc", "", "", "")
    lbl_labels(3).Tag = CreateTag("lbl_description", "", "", "")
    lbl_labels(4).Tag = CreateTag("lbl_memo", "", "", "")
    lbl_labels(5).Tag = CreateTag("lbl_language", "", "", "")
    lbl_labels(6).Tag = CreateTag("lbl_spare1", "", "", "")
    lbl_labels(7).Tag = CreateTag("lbl_spare2", "", "", "")
    lbl_labels(8).Tag = CreateTag("lbl_spare3", "", "", "")
    lbl_labels(9).Tag = CreateTag("lbl_fileName", "", "", "")
    lbl_labels(10).Tag = CreateTag("lbl_range", "", "", "")
    lbl_labels(11).Tag = CreateTag("", "", "", "")       ' minus
    lbl_labels(12).Tag = CreateTag("lbl_category", "", "", "")
    
    cvw_countries.Tag = CreateTag("cvw_countries", "", "", "")
        
    btn_clearCountries.Tag = CreateTag("btn_clearCountries", "", "", "")
    btn_AllCountries.Tag = CreateTag("btn_AllCountries", "", "", "")
    
    dir_Full.Tag = CreateTag("", "", "", "")
    drv_Full.Tag = CreateTag("", "", "", "")
    fil_Full.Tag = CreateTag("", "", "", "")

    ' set maxLength
    txt_desc.MaxLength = 150
    txt_internetDesc.MaxLength = 80
    txt_memo.MaxLength = 2000
    txt_title.MaxLength = 50
    txt_file.MaxLength = 150
    txt_spare1.MaxLength = 1
    txt_spare2.MaxLength = 1
    txt_spare3.MaxLength = 1
    txt_from.MaxLength = 255
    txt_to.MaxLength = 255
    
    ' init grd_copyList
    grd_tableContent.UnBound = False
    grd_tableContent.FreeSelect = False
    'grd_tableContent.AllowSort = False
    grd_tableContent.MultiSelect = False
    grd_tableContent.Title = "#Table content"
    
    ' number of columns and labels are not defined, depends on selected table..
    
    grd_zipInfo.UnBound = False
    grd_zipInfo.FreeSelect = False
    'grd_zipInfo.AllowSort = False
    grd_zipInfo.MultiSelect = False
    grd_zipInfo.Title = "#BLOBS"

    If Not grd_zipInfo.SetColumns(Array( _
      "ZIPID®©0®©1®©RZ_ID®©#ID", _
      "TYPEDESC®©580®©0®©RF_desc®©#Type", _
      "LANGUAGEDESC®©1000®©0®©Language_desc®©#Language", _
      "TITLE®©2000®©0®©RZ_Title®©#Title", _
      "DESC®©3600®©0®©RZ_Desc®©#Description", _
      "MEMO®©1500®©0®©RZ_Memo®©#Memo", _
      "IDESC®©2000®©0®©Internet_desc®©#Internet description", _
      "FILENAME®©1000®©0®©RZ_FileName®©#fileName" _
      )) Then
        Call Err.Raise(CompFncFailed, "grd_zipInfo.SetColumns")
    End If
    
    grd_tables.UnBound = False
    grd_tables.FreeSelect = False
    'grd_tables.AllowSort = False
    grd_tables.MultiSelect = False
    If Not grd_tables.SetColumns(Array( _
      "ID®©0®©1®©Ref_ID®©", _
      "GRIDREQUEST®©0®©0®©Ref_GridRequest®©", _
      "GRIDCOLUMNDEF®©0®©0®©Ref_GridColumnDef®©", _
      "TABLEDESC®©2400®©0®©Ref_Desc®©#Description", _
      "RANGEFROM®©0®©0®©®©", _
      "RANGETO®©0®©0®©®©" _
      )) Then
        Call Err.Raise(CompFncFailed, "grd_tables.SetColumns", "Set columns failed.")
    End If
    
    cbo_type.Request = ReplacePlaceholders(GetString(cbo_type.Tag, CI_DATASRC, SEP1 + SEP2))
    cbo_language.Request = ReplacePlaceholders(GetString(cbo_language.Tag, CI_DATASRC, SEP1 + SEP2))
    cbo_groups.Request = ReplacePlaceholders(GetString(cbo_groups.Tag, CI_DATASRC, SEP1 + SEP2))
    cbo_categories.Request = ReplacePlaceholders(GetString(cbo_categories.Tag, CI_DATASRC, SEP1 + SEP2))
    
    cvw_countries.RoleCount = 2
    cvw_countries.Driven_By = "Project"
    cvw_countries.Common_List_Load = True
    cvw_countries.Type_Of_Key = tkDependant
    cvw_countries.Calling_Key_Fields = "RZ_ID®©LANG_CODE"
    cvw_countries.Calling_Key_Values = "0®©" & Language_codeToolBar
    cvw_countries.HideColumnHeaders = False
    
    cvw_countries.Link_Key_Fields = "CT_Code"
    If Not cvw_countries.SetRoleList(Array( _
    Array("Main", "VIEW", "", "", "View", "CT_Code®©CT_desc", "CT_desc", "2540", "CT_Code", "exec Ref_Zip_Countries_lst2 $RZ_ID$,'$LANG_CODE$'", "exec Ref_Zip_Countries_Ins $RZ_ID$,'$CT_Code$'", "exec Ref_Zip_Countries_Del $RZ_ID$,'$CT_Code'", True, 2, False, True, 0, 1), _
    Array("Edit", "EDIT", "", "", "Edit", "CT_Code®©CT_desc", "CT_desc", "2540", "CT_Code", "exec Ref_Zip_Countries_lst '$LANG_CODE$'", "exec Ref_Zip_Countries_Ins $RZ_ID$,'$CT_Code$'", "exec Ref_Zip_Countries_Del $RZ_ID$,'$CT_Code$'", False, 2, False, True, 1, 0) _
    )) Then
        Call Err.Raise(CompFncFailed, "cvw_countries.SetRoleList", "Setting CheckView parameters failed.")
    End If
    Call cvw_countries.LoadConstants(CVptStatic, "CT_desc®©Country", CVctColumns)
    cvw_countries.Synchronize_View = True
    cvw_countries.ComboVisible = False

    ' SET FILEPICKER FRAME CONTROLS PROPERTIES
    drv_Full.Drive = "C:\"
    dir_Full.Path = "C:\"
    fil_Full.Path = "C:\"
    fil_Full.Refresh
    
    ' SET DIALOG PROPERTIES
    dlg_dlg.flags = cdlOFNPathMustExist Or cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNOverwritePrompt ' Or &H20000

    Exit Sub
ErrHandler:
    Call ErrorHandler("InitControls()")
End Sub

Private Function GetRight(ByVal as_A_ConfigKey As String) As Boolean
Const C_REQ As String = "EXEC A_Config_sel '$A_ConfigKey$'"
On Error GoTo ErrorHandler
    Dim ll_cursor As Long
    Dim lsa_users() As String
    Dim ll_Index As Long
    
    GetRight = False
    ll_cursor = OpenSQLSafe(mo_Db, Replace(C_REQ, "$A_ConfigKey$", as_A_ConfigKey, , , vbTextCompare))
    Debug.Assert (ll_cursor <> 0)
    
    If mo_Db.RowCount(ll_cursor) > 0 Then
        lsa_users = Split(mo_Db.GetFields(ll_cursor, 0), SEP1 + SEP2)
        For ll_Index = LBound(lsa_users) To UBound(lsa_users)
            If Val(lsa_users(ll_Index)) = ml_U_Code Then
                GetRight = True
                Exit For
            End If
        Next
    Else
        Call Err.Raise(CompFncFailed, "mo_db.RowCount", "Rights were not defined. Check definition of " & as_A_ConfigKey & " in A_Config.")
    End If
    Call mo_Db.Close(ll_cursor)
    Exit Function
ErrorHandler:
    If ll_cursor <> 0 Then Call mo_Db.Close(ll_cursor)
    Call ErrorHandler("GetRight()")
End Function


Private Sub FillTablesGrid(ByVal ao_grid As ArmGrid, ByVal as_Language As String, ByVal al_CodePage As Long)
On Error GoTo ErrHandler
Const REQ = "EXEC Ref_List_lst '$LANG_CODE$'"
    ' save ranges
    Dim lsa_rangeFrom() As String, lsa_rangeTo() As String
    Dim lva_Keys() As Variant
    Dim ll_i As Long
    'MS REDIMM
    Call SafeRedimPreserve(lsa_rangeFrom, ao_grid.Rows - 1)
    Call SafeRedimPreserve(lsa_rangeTo, ao_grid.Rows - 1)
    Call SafeRedimPreserve(lva_Keys, ao_grid.Rows - 1)
    Dim lo_rangeFromCol As ArmColumn, lo_rangeToCol As ArmColumn, lo_keyCol As ArmColumn
    
    Set lo_rangeFromCol = ao_grid.Columns("RANGEFROM")
    Set lo_rangeToCol = ao_grid.Columns("RANGETO")
    Set lo_keyCol = ao_grid.Columns("ID")
    Debug.Assert (lo_keyCol.Key)
    
    For ll_i = 0 To ao_grid.Rows - 1
        lva_Keys(ll_i) = lo_keyCol.GetData(ll_i)
        lsa_rangeFrom(ll_i) = lo_rangeFromCol.GetData(ll_i)
        lsa_rangeTo(ll_i) = lo_rangeToCol.GetData(ll_i)
    Next
    
    ' clear grid and change codepage if needed
    Call ClearGrid(ao_grid, al_CodePage)

    ' INIT GRID
    If Not ao_grid.Load(Replace(REQ, "$LANG_CODE$", as_Language), True) Then
        Call Err.Raise(CompFncFailed, "ao_grid.Load")
    End If
    
    ' RESTORE RANGES
    For ll_i = 0 To UBound(lva_Keys)
        If lsa_rangeFrom(ll_i) <> "" Or lsa_rangeTo(ll_i) <> "" Then
            If ao_grid.SearchKey(True, lva_Keys(ll_i)) Then
                Call lo_rangeFromCol.SetData(ao_grid.Row, lsa_rangeFrom(ll_i))
                Call lo_rangeToCol.SetData(ao_grid.Row, lsa_rangeTo(ll_i))
            End If
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillTablesGrid()")
End Sub

Private Sub FillTableContentGrid(ByVal ao_grid As ArmGrid, ByVal as_gridRequest As String, ByVal as_gridColumnDef As String, ByVal al_CodePage As Long)
On Error GoTo ErrHandler
    Dim indx As Integer
    ' reset grid
    Dim ls_oldLabel As String
    ls_oldLabel = ao_grid.Title
    Call ClearGrid(ao_grid, al_CodePage)
    Call ao_grid.ResetGrid
    
    ' restore label
    ao_grid.Title = ls_oldLabel
    
    ' init columns
    Dim lv_Columns As Variant
    
    lv_Columns = Split(as_gridColumnDef, "%" + SEP1 + SEP2 + "%")

    If Not ao_grid.SetColumns(lv_Columns) Then
        Call Err.Raise(CompFncFailed, "ao_grid.SetColumns")
    End If
    
    ' replace range placeholders
    as_gridRequest = Replace(as_gridRequest, "$" & GetString(txt_from.Tag, CI_DATAFIELD) & "$", SQLStr(txt_from.Text), , , vbTextCompare)
    as_gridRequest = Replace(as_gridRequest, "$" & GetString(txt_to.Tag, CI_DATAFIELD) & "$", SQLStr(txt_to.Text), , , vbTextCompare)
   
    
    If Not cbo_categories.SelectedItem Is Nothing Then
        as_gridRequest = Replace(as_gridRequest, "$" & GetString(cbo_categories.Tag, CI_DATAFIELD) & "$", SQLStr(cbo_categories.SelectedItem.Key), , , vbTextCompare)
    Else
        as_gridRequest = Replace(as_gridRequest, "$" & GetString(cbo_categories.Tag, CI_DATAFIELD) & "$", "", , , vbTextCompare)
    End If
    
    If Not ao_grid.Load(as_gridRequest, False) Then
        Call Err.Raise(CompFncFailed, "ao_grid.Load(" & as_gridRequest & ")")
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillTableContentGrid()")
End Sub

Private Sub FillZipInfoGrid(ByVal ao_grid As ArmGrid, ByVal as_refID As String, ByVal as_refCode As Variant, ByVal as_lang_code As String, ByVal al_CodePage As Long)
On Error GoTo ErrHandler
Const REQ = "EXEC Ref_Zip_Info_load $REF_ID$, '$REF_CODE$', '$LANG_CODE$'"
    
    Dim ls_req As String
    Call ClearGrid(ao_grid, al_CodePage)
    
    ls_req = Replace(REQ, "$REF_ID$", as_refID)
    ls_req = Replace(ls_req, "$REF_CODE$", as_refCode(0))
    ls_req = Replace(ls_req, "$LANG_CODE$", as_lang_code)
    
    If Not ao_grid.Load(ls_req, True) Then
        Call Err.Raise(CompFncFailed, "ao_grid.Load")
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillZipInfoGrid()")
End Sub

' open/reopen detail cursor
Private Sub OpenDetailCursor(ByRef al_DetailCursor As Long, ByVal al_RZID As Long, ByVal as_lang_code As String)
On Error GoTo ErrHandler
Const REQ = "EXEC Ref_Zip_Info_sel $ZIPID$, '$LANG_CODE$'"
    
    If al_DetailCursor <> 0 Then Call mo_Db.Close(al_DetailCursor)
    al_DetailCursor = 0
    
    Dim ls_req As String
    
    ls_req = Replace(REQ, "$LANG_CODE$", as_lang_code)
    ls_req = Replace(ls_req, "$ZIPID$", CStr(al_RZID))
    
    al_DetailCursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (al_DetailCursor <> 0)
    
    If mo_Db.RowCount(al_DetailCursor) = 0 Then
        ' record was probably deleted
        Call mo_Db.Close(al_DetailCursor)
        al_DetailCursor = 0
        Exit Sub
    End If
    
    Call mo_Db.First(al_DetailCursor)
    
    Exit Sub
ErrHandler:
    If al_DetailCursor <> 0 Then Call mo_Db.Close(al_DetailCursor)
    al_DetailCursor = 0
    Call ErrorHandler("OpenDetailCursor()")
End Sub

' RESTORE DETAIL AND MAIN SCREEN FROM DB AND REFRESH DETAIL CURSOR
Private Function RefreshZipInfoData(ByVal al_RZID As Long, ByVal as_lang_code As String, ByRef al_DetailCursor As Long) As Boolean
On Error GoTo ErrHandler
    Debug.Assert (BLOB_ID = al_RZID)
    
    Dim lo_Column As ArmColumn
    Dim ll_Index As Long, ll_FieldIndex As Long
    
    Call OpenDetailCursor(al_DetailCursor, al_RZID, as_lang_code)
    If al_DetailCursor = 0 Then
        RefreshZipInfoData = False
        Exit Function
    End If
    
    Debug.Assert (grd_zipInfo.Row <> -1)
    For ll_Index = 0 To grd_zipInfo.Cols - 1
        Set lo_Column = grd_zipInfo.Columns(ll_Index)
        ll_FieldIndex = mo_Db.GetFieldIndex(al_DetailCursor, lo_Column.FieldName)
        If ll_FieldIndex <> -1 Then Call lo_Column.SetData(grd_zipInfo.Row, mo_Db.GetFields(al_DetailCursor, ll_FieldIndex))
    Next

    RefreshZipInfoData = True
    Exit Function
ErrHandler:
    Call ErrorHandler("RefreshZipInfoData()")
End Function


'************************************************************************************************
' Function CreateTag
'as_ctrlID      : unique string used to access the data contained in control. e.g. value Text in TextBox. This is also used when loading screen_constants.
'as_dataField   : serialized string containing ID of controls containing data for control separated with SEP1(®) separator. This can also be the column name in grid.
'as_dataSrc     : contain source definition of data for the controls. This value depends on type of control. For combobox it is a request to load a combobox. For txt_file textbox it is a path to file selected by user.
'as_labelCtrl   : Label that describe control to the user. This must be one of lbl_labels controls.
Private Function CreateTag(ByVal as_ctrlID As String, ByVal as_dataField As String, ByVal as_dataSrc As String, ByVal as_labelCtrl As String) As String
On Error GoTo ErrHandler
    
    CreateTag = Join(Array(as_ctrlID, as_dataField, as_dataSrc, as_labelCtrl), SEP1 + SEP2)
    Exit Function
ErrHandler:
    Call ErrorHandler("CreateTag()")
End Function
'************************************************************************************************

Public Sub SetDataSrc(ByVal ao_ctrl As Object, ByVal as_dataSrc As String)
On Error GoTo ErrHandler
    ao_ctrl.Tag = SetString(ao_ctrl.Tag, CI_DATASRC, as_dataSrc, SEP1 + SEP2)
    Exit Sub
ErrHandler:
    Call ErrorHandler("SetDataSrc()")
End Sub

Private Sub UpdateUI(ByVal as_face As String)
On Error GoTo ErrHandler
    
    ' set active face
    ms_activeFace = as_face
    
    ' apply face
    Dim lo_ctrl As Object
    Dim las_faces() As String, ls_face As Variant, ls_aktFace As String
    las_faces = Split(ms_activeFace, ".")
    
    For Each ls_face In las_faces
        ls_aktFace = IIf(ls_aktFace = "", ls_face, ls_aktFace & "." & ls_face)
        
        Select Case ls_aktFace
            Case "BLOBEdit"
                ' hide all frames
                For Each lo_ctrl In frm_frames
                    lo_ctrl.Visible = False
                Next
                Set lo_ctrl = GetControl(frm_frames, "frm_tableFilter")
                lo_ctrl.Visible = True
                Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
                lo_ctrl.Visible = True
                
                tlb_main.Enabled = True
            
            Case "BLOBEdit.Main"
                ' we are in List section
                Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkLst")
                lo_ctrl.Visible = True
                Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
                lo_ctrl.Enabled = True
                Set lo_ctrl = GetControl(frm_frames, "frm_tableFilter")
                lo_ctrl.Enabled = True
                
                txt_from.Locked = False
                txt_to.Locked = False
                
                Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_LST)
               
            Case "BLOBEdit.Upd"
                ' we are in Update section
                Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkMtnc")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), True)
                Set lo_ctrl = GetControl(frm_frames, "frm_fileSelect")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), False)
                btn_clearCountries.Visible = True
                cbo_groups.Visible = True
                Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
                lo_ctrl.Enabled = False
                Set lo_ctrl = GetControl(frm_frames, "frm_tableFilter")
                lo_ctrl.Enabled = False
                
                txt_from.Locked = True
                txt_to.Locked = True
                chk_InternetFlag.Enabled = mb_AllowInternetFlag And (Language_codeToolBar = C_MASTER_LANG)
                                
                Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC)
                Call cvw_countries.SetVisibleList("Edit")

            Case "BLOBEdit.Add"
                ' we are in Add section
                Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkMtnc")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), True)
                Set lo_ctrl = GetControl(frm_frames, "frm_fileSelect")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), True)
                txt_file.Locked = True
                btn_clearCountries.Visible = True
                cbo_groups.Visible = True
                Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
                lo_ctrl.Enabled = False
                Set lo_ctrl = GetControl(frm_frames, "frm_tableFilter")
                lo_ctrl.Enabled = False
            
                txt_from.Locked = True
                txt_to.Locked = True
                chk_InternetFlag.Enabled = mb_AllowInternetFlag And (Language_codeToolBar = C_MASTER_LANG)
                
                Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC)
                Call cvw_countries.SetVisibleList("Edit")
            
            Case "BLOBEdit.Del"
                ' we are in Delete section
                Set lo_ctrl = GetControl(frm_frames, "frm_blobLinkMtnc")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), False)
                Set lo_ctrl = GetControl(frm_frames, "frm_fileSelect")
                lo_ctrl.Visible = True
                Call SetEnabled(GetContainedControls(lo_ctrl), False)
                cbo_groups.Visible = False
                Set lo_ctrl = GetControl(frm_frames, "frm_tableContent")
                lo_ctrl.Enabled = False
                Set lo_ctrl = GetControl(frm_frames, "frm_tableFilter")
                lo_ctrl.Enabled = False
        
                btn_clearCountries.Visible = False
                txt_from.Locked = True
                txt_to.Locked = True
                
                Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC)
                Call cvw_countries.SetVisibleList("Main")
        End Select
    Next
    
    Call ManageAdminRights(mb_AdminUser, Language_codeToolBar)

    ' to display face immidiatelly
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateUI()")
End Sub

Private Sub LanguageChanged(as_Language As String)
On Error GoTo ErrHandler
    
    ' change charset
    
    Dim lo_array As Collection
    Set lo_array = New Collection
    
    ' controls that are language dependent of selected language, except grids - grids are set in fill functions
    Call lo_array.Add(cbo_groups)
    Call lo_array.Add(cbo_language)
    Call lo_array.Add(cbo_type)
    Call lo_array.Add(cbo_categories)
    Call lo_array.Add(cvw_countries)
    Call lo_array.Add(txt_desc)
    Call lo_array.Add(txt_file)
    Call lo_array.Add(txt_memo)
    Call lo_array.Add(txt_spare1)
    Call lo_array.Add(txt_spare2)
    Call lo_array.Add(txt_spare3)
    Call lo_array.Add(txt_title)
    Call lo_array.Add(txt_internetDesc)
    
    Dim ll_codePage As Long
    ll_codePage = GetCodePageFromLanguage(mo_Db, as_Language)
    Call ChangeCharset(lo_array, ll_codePage)
    Set lo_array = Nothing

    ' init content of grids
    Dim lv_keyVal As Variant
    lv_keyVal = grd_tables.SelectedKey(0)
    Call FillTablesGrid(grd_tables, Language_codeToolBar, ll_codePage)
    If Not IsEmpty(lv_keyVal) Then
        Call grd_tables.SearchKey(True, lv_keyVal)
    End If

    ' reinit content of grids egd_tebleContent and grd_zipInfo
    Call ResetMain(ll_codePage)

    ' reinit combos
    Call cbo_groups.Clear
    cbo_groups.Request = ReplacePlaceholders(GetString(cbo_groups.Tag, CI_DATASRC, SEP1 + SEP2))
    Call cbo_language.Clear
    cbo_language.Request = ReplacePlaceholders(GetString(cbo_language.Tag, CI_DATASRC, SEP1 + SEP2))
    Call cbo_type.Clear
    cbo_type.Request = ReplacePlaceholders(GetString(cbo_type.Tag, CI_DATASRC, SEP1 + SEP2))
    ' categories must keep selection
    Dim lv_Key As Variant
    If Not cbo_categories.SelectedItem Is Nothing Then
        lv_Key = cbo_categories.SelectedItem.Key
    Else
        lv_Key = Empty
    End If
    Call cbo_categories.Clear
    cbo_categories.Request = ReplacePlaceholders(GetString(cbo_categories.Tag, CI_DATASRC, SEP1 + SEP2))
    ' reload afret changing language
    Call cbo_categories.Load
    cbo_categories.Enabled = False
    Call cbo_categories.SearchItem(lv_Key)
    cbo_categories.Enabled = True
    
    Call ManageAdminRights(mb_AdminUser, as_Language)
    Exit Sub
ErrHandler:
    Call ErrorHandler("LanguageChanged()")
End Sub

' ************************************************************************************
Private Sub ClearGrid(ByVal ao_grid As ArmGrid, ByVal al_CodePage As Long)
On Error GoTo ErrHandler
    ao_grid.ClearGrid
    If ao_grid.Codepage <> al_CodePage And al_CodePage <> -1 Then
        ao_grid.Codepage = al_CodePage
        
        Dim lo_array As Collection
        Set lo_array = New Collection
        
        Call lo_array.Add(ao_grid)
        Call ChangeCharset(lo_array, al_CodePage)
        Set lo_array = Nothing
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("ClearGrid()")
End Sub

' this will also fill grids grd_tableContent, grd_zipInfo
Private Sub ResetMain(Optional ByVal al_CodePage As Long = -1)
On Error GoTo ErrHandler
    Dim ls_oldLabel As String
    
    If grd_tables.Row = -1 Then
        txt_from.Text = ""
        txt_to.Text = ""
        ls_oldLabel = grd_tableContent.Title
        Call ClearGrid(grd_tableContent, al_CodePage)
        Call grd_tableContent.ResetGrid
        grd_tableContent.Title = ls_oldLabel
        Call ClearGrid(grd_zipInfo, al_CodePage)
    Else
        txt_from.Text = grd_tables.SelectedLine(0, GetString(txt_from.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_to.Text = grd_tables.SelectedLine(0, GetString(txt_to.Tag, CI_DATAFIELD, SEP1 + SEP2))
        
        ' init content of grids
        Dim lv_keyVal As Variant
                
        lv_keyVal = grd_tableContent.SelectedKey(0)
        Call FillTableContentGrid(grd_tableContent, grd_tables.SelectedLine(0, "GRIDREQUEST"), grd_tables.SelectedLine(0, "GRIDCOLUMNDEF"), al_CodePage)
        If Not IsEmpty(lv_keyVal) Then
            If grd_tableContent.SearchKey(True, lv_keyVal) Then
                lv_keyVal = grd_zipInfo.SelectedKey(0)
                Call FillZipInfoGrid(grd_zipInfo, grd_tables.SelectedLine(0, "ID"), grd_tableContent.SelectedKey(0), Language_codeToolBar, al_CodePage)
                If Not IsEmpty(lv_keyVal) Then
                    Call grd_zipInfo.SearchKey(True, lv_keyVal)
                End If
            Else
                Call ClearGrid(grd_zipInfo, al_CodePage)
            End If
        Else
            Call ClearGrid(grd_zipInfo, al_CodePage)
        End If
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("ResetMain()")
End Sub

Private Sub ResetDetail(ByVal al_DetailCursor As Long)
On Error GoTo ErrHandler
    If al_DetailCursor = 0 Then
        txt_desc.Text = ""
        txt_internetDesc.Text = ""
        txt_memo.Text = ""
        txt_title.Text = ""
        txt_file.Text = ""
        txt_spare1.Text = ""
        txt_spare2.Text = ""
        txt_spare3.Text = ""
        chk_InternetFlag.Value = vbUnchecked
        ' reset dataSrc
        Call SetDataSrc(txt_file, "")
        
        Set cbo_language.SelectedItem = Nothing
        Set cbo_type.SelectedItem = Nothing
        Set cbo_groups.SelectedItem = Nothing
        
        ' reset edit list
        cvw_countries.Calling_Key_Values = "0®©" & Language_codeToolBar
        Call cvw_countries.LoadEditLists
        ' load selected items
        Call cvw_countries.LoadList
        
    Else

        txt_desc.Text = GetData(GetString(txt_desc.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_internetDesc.Text = GetData(GetString(txt_internetDesc.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_memo.Text = GetData(GetString(txt_memo.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_title.Text = GetData(GetString(txt_title.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_file.Text = GetData(GetString(txt_file.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_spare1.Text = GetData(GetString(txt_spare1.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_spare2.Text = GetData(GetString(txt_spare2.Tag, CI_DATAFIELD, SEP1 + SEP2))
        txt_spare3.Text = GetData(GetString(txt_spare3.Tag, CI_DATAFIELD, SEP1 + SEP2))
        chk_InternetFlag.Value = IIf(StrComp(GetData(GetString(chk_InternetFlag.Tag, CI_DATAFIELD, SEP1 + SEP2)), "X", vbTextCompare) = 0, vbChecked, vbUnchecked)

        ' reset dataSrc
        Call SetDataSrc(txt_file, "")

        Dim ls_dataField As String
        
        ls_dataField = GetString(cbo_language.Tag, CI_DATAFIELD, SEP1 + SEP2)
        If Not cbo_language.SearchItem(GetData(GetString(ls_dataField, 0, SEP1)), 0) Then Call cbo_language.AddItem(Array(GetData(GetString(ls_dataField, 0, SEP1)), GetData(GetString(ls_dataField, 1, SEP1))), True)
        
        ls_dataField = GetString(cbo_type.Tag, CI_DATAFIELD, SEP1 + SEP2)
        If Not cbo_type.SearchItem(GetData(GetString(ls_dataField, 0, SEP1)), 0) Then Call cbo_type.AddItem(Array(GetData(GetString(ls_dataField, 0, SEP1)), GetData(GetString(ls_dataField, 1, SEP1))), True)

        Set cbo_groups.SelectedItem = Nothing
        
        Dim lv_Key As Variant
        lv_Key = grd_zipInfo.SelectedKey(0)

        cvw_countries.Calling_Key_Values = CStr(lv_Key(0)) & "®©" & Language_codeToolBar
        ' reset edit list
        Call cvw_countries.LoadEditLists
        ' load selected items
        Call cvw_countries.LoadList
    End If
    
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ResetDetail()")
End Sub

Private Sub ManageAdminRights(ByVal ab_AdminUser As Boolean, ByVal as_Lang As String)
On Error GoTo ErrHandler

    If (as_Lang = C_MASTER_LANG) And ab_AdminUser Then
    
        tlb_main.ButtonVisible("A") = True
        tlb_main.ButtonVisible("D") = True
    Else
    
        tlb_main.ButtonVisible("A") = False
        tlb_main.ButtonVisible("D") = False
        If cvw_countries.GetVisibleList() = "Edit" Then
            Call cvw_countries.SetVisibleList("Main")
        End If
        cbo_type.Enabled = False
        cbo_language.Enabled = False
        cbo_groups.Visible = False
        btn_clearCountries.Visible = False
        
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ManageAdminRights()")
End Sub

'******************************************************************************************************
'*********************************** ITEM DB DATA MANIPULATION ****************************************
'******************************************************************************************************
Private Function DeleteZipInfo(ByVal al_RZID As Long, ByVal al_iConcurrency As Long) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC Ref_Zip_Info_Del $RZID$,$ICONCURRENCY$"
    Dim ls_req As String
    
    ' change Z_status Ref_zip_Info
    ls_req = Replace(C_REQ, "$RZID$", CStr(al_RZID))
    ls_req = Replace(ls_req, "$ICONCURRENCY$", CStr(al_iConcurrency))
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    If mo_Db.SQLRowsAffected <> 1 Then
        DeleteZipInfo = False
        Exit Function
    End If
    DeleteZipInfo = True
    Exit Function
ErrHandler:
    Call ErrorHandler("DeleteZipInfo()")
End Function

Private Function UpdateZipInfo(ByVal al_RZID As Long, ByVal al_iConcurrency As Long) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC Ref_Zip_Info_Upd $RZID$, $cbo_type$, $cbo_language$, '$txt_spare1$', '$txt_spare2$', '$txt_spare3$', $ICONCURRENCY$,$U_code$,'$chk_InternetFlag$'"
Const C_REQ_LANG As String = "EXEC Ref_Zip_Info_Lang_Upd $RZID$, '$txt_title$','$txt_desc$','$txt_memo$','$txt_internetDesc$','$LANG_CODE$'"
Const C_TRAN_BEGIN As String = "BEGIN TRAN UpdateZI"
Const C_TRAN_COMMIT As String = "COMMIT TRAN UpdateZI"
Const C_TRAN_ROLLBACK As String = "ROLLBACK TRAN UpdateZI"
    Dim lb_InTrans As Boolean
    lb_InTrans = False
    If CheckFields() Then
        Dim ls_req As String
        
        Call ExecuteSQLSafe(mo_Db, C_TRAN_BEGIN)
        lb_InTrans = True
        
        '1. UPDATE Ref_Zip_Info
        ls_req = Replace(C_REQ, "$RZID$", CStr(al_RZID))
        ls_req = Replace(ls_req, "$ICONCURRENCY$", CStr(al_iConcurrency))
        ls_req = ReplacePlaceholders(ls_req)
        
        Call ExecuteSQLSafe(mo_Db, ls_req)
        If mo_Db.SQLRowsAffected <> 1 Then
            Call ExecuteSQLSafe(mo_Db, C_TRAN_ROLLBACK)
            lb_InTrans = False
            UpdateZipInfo = False
            Exit Function
        End If
        
        '2. UPDATE Ref_Zip_Info_Lang
        ls_req = Replace(C_REQ_LANG, "$RZID$", CStr(al_RZID))
        ls_req = ReplacePlaceholders(ls_req)
        
        Call ExecuteSQLSafe(mo_Db, ls_req)
        If mo_Db.SQLRowsAffected = 0 Then
            Call Err.Raise(CompFncFailed, "", "Cannot update record in Ref_Zip_Info_Lang.")
        End If

        '3. SAVE countries
        If Not cvw_countries.SaveList Then
            Call Err.Raise(CompFncFailed, "SaveList", "List of countries cannot be saved.")
        End If
        
        Call ExecuteSQLSafe(mo_Db, C_TRAN_COMMIT)
        lb_InTrans = False

    Else
        Call Err.Raise(QuietException)
    End If
    UpdateZipInfo = True
    Exit Function
ErrHandler:
    If lb_InTrans Then
        Call UpdateError(True)
        Call ExecuteSQLSafe(mo_Db, C_TRAN_ROLLBACK)
        lb_InTrans = False
        Call UpdateError(False)
    End If
    Call ErrorHandler("UpdateZipInfo()")
End Function

Private Sub InsertZipInfo(ByVal al_RZID As Long)
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC Ref_Zip_Info_Ins $RZID$,$cbo_type$,$cbo_language$,'$txt_file$','$txt_spare1$','$txt_spare2$','$txt_spare3$',$ID$,'$CONTENT_TABLE_KEY$',$U_code$,'$chk_InternetFlag$'"
Const C_REQ_LANG As String = "EXEC Ref_Zip_Info_Lang_Ins $RZID$, '$txt_title$','$txt_desc$','$txt_memo$','$txt_internetDesc$'"
Const C_TRAN_BEGIN As String = "BEGIN TRAN InsertZI"
Const C_TRAN_COMMIT As String = "COMMIT TRAN InsertZI"
Const C_TRAN_ROLLBACK As String = "ROLLBACK TRAN InsertZI"
    Dim lb_InTrans As Boolean
    lb_InTrans = False
    If CheckFields() Then
        Dim ls_req As String

        'INSERT BLOB FIRST
        Dim ls_newFile As String
        ls_newFile = GetString(txt_file.Tag, CI_DATASRC, SEP1 + SEP2)
        Debug.Assert (ls_newFile <> "")
        Call UploadBlob(al_RZID, ls_newFile)
        
        If mo_Db.SQLRowsAffected <> 1 Then
            Call Err.Raise(CompFncFailed, "UploadBlob", "Cannot upload blob.")
        End If
        
        Call ExecuteSQLSafe(mo_Db, C_TRAN_BEGIN)
        lb_InTrans = True
        
        ' INSERT Ref_Zip_Info
        ls_req = Replace(C_REQ, "$RZID$", CStr(al_RZID))
        ls_req = ReplacePlaceholders(ls_req)

        Call ExecuteSQLSafe(mo_Db, ls_req)
        
        If mo_Db.SQLRowsAffected <> 1 Then
            Call Err.Raise(CompFncFailed, "", "Cannot insert values into Ref_Zip_Info.")
        End If
        
        ' INSERT Ref_Zip_Info_Lang
        ls_req = Replace(C_REQ_LANG, "$RZID$", CStr(al_RZID))
        ls_req = ReplacePlaceholders(ls_req)
        
        Call ExecuteSQLSafe(mo_Db, ls_req)
        
        If mo_Db.SQLRowsAffected = 0 Then
            Call Err.Raise(CompFncFailed, "", "Cannot insert values into Ref_Zip_Info_Lang.")
        End If
        
        ' SAVE countries
        cvw_countries.Calling_Key_Values = CStr(al_RZID) & "®©" & Language_codeToolBar
        If Not cvw_countries.SaveList Then
            Call Err.Raise(CompFncFailed, "SaveList", "List of countries cannot be saved.")
        End If

        Call ExecuteSQLSafe(mo_Db, C_TRAN_COMMIT)
        lb_InTrans = False
        
    Else
        Call Err.Raise(QuietException)
    End If

    Exit Sub
ErrHandler:
    If lb_InTrans Then
        Call UpdateError(True)
        Call ExecuteSQLSafe(mo_Db, C_TRAN_ROLLBACK)
        lb_InTrans = False
        Call UpdateError(False)
    End If
    Call ErrorHandler("InsertZipInfo()")
End Sub

Private Sub UploadBlob(ByVal al_Id As Long, ByVal as_srcFilePath As String)
On Error GoTo ErrHandler
Const C_BLOBREQ As String = "INSERT INTO Ref_Zip (RZ_ID,RZ_Zip) VALUES ($RZID$,?)"
    Dim ls_req As String
    
    Debug.Assert (mo_FSO.FileExists(as_srcFilePath))
    
    ls_req = Replace(C_BLOBREQ, "$RZID$", CStr(al_Id))
    If Not mo_Db.FileToBlobSQL(ls_req, as_srcFilePath, 9) Then
        Call Err.Raise(CompFncFailed, "FileToBlobSQL", GetDbError(mo_Db))
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("UploadBlob()")
End Sub

Private Sub DownloadBlob(ByVal as_ID As String, ByVal as_filePath As String)
On Error GoTo ErrHandler
    
Const C_BLOBREQ = "SELECT RZ.RZ_Zip FROM Ref_Zip RZ WHERE RZ.RZ_ID=$RZID$"

    Dim ls_req As String
    
    ls_req = Replace(C_BLOBREQ, "$RZID$", as_ID)

    If Not mo_Db.BlobToFileSQL(ls_req, as_filePath, True, False) Then
        Call Err.Raise(CompFncFailed, "BlobToFileSQL", GetDbError(mo_Db))
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("DownloadBlob()")
End Sub

Private Function CheckFields() As Boolean
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    CheckFields = False
    If cbo_type.SelectedItem Is Nothing Then
        Set lo_ctrl = GetControl(lbl_labels, GetString(cbo_type.Tag, CI_CTRLLABEL))
        Debug.Assert (Not lo_ctrl Is Nothing)
        
        Call FieldErrorMsg(966, lo_ctrl.Caption, cbo_type)
        Exit Function
    End If
    
    If cbo_language.SelectedItem Is Nothing Then
        Set lo_ctrl = GetControl(lbl_labels, GetString(cbo_language.Tag, CI_CTRLLABEL))
        Debug.Assert (Not lo_ctrl Is Nothing)
        
        Call FieldErrorMsg(966, lo_ctrl.Caption, cbo_language)
        Exit Function
    End If
    
    If txt_title.Text = "" Then
        Set lo_ctrl = GetControl(lbl_labels, GetString(txt_title.Tag, CI_CTRLLABEL))
        Debug.Assert (Not lo_ctrl Is Nothing)
        
        Call FieldErrorMsg(966, lo_ctrl.Caption, txt_title)
        Exit Function
    End If
    
    If txt_file.Text = "" Then
        Set lo_ctrl = GetControl(lbl_labels, GetString(txt_file.Tag, CI_CTRLLABEL))
        Debug.Assert (Not lo_ctrl Is Nothing)
        
        Call FieldErrorMsg(966, lo_ctrl.Caption, fil_Full)
        Exit Function
    End If
    
    
    If txt_internetDesc.Text = "" Then
        Set lo_ctrl = GetControl(lbl_labels, GetString(txt_internetDesc.Tag, CI_CTRLLABEL))
        Debug.Assert (Not lo_ctrl Is Nothing)
        
        Call FieldErrorMsg(966, lo_ctrl.Caption, txt_internetDesc)
        Exit Function
    End If
    
    CheckFields = True
    Exit Function
ErrHandler:
    Call ErrorHandler("CheckFields()")
End Function

Private Sub SetLanguage(ByVal as_Lang As String)
On Error GoTo ErrHandler
'Const C_REQ = "SELECT Field_Name, Local_Text FROM Screen_Constants WHERE Screen_Name='" & C_SCREENNAME & "' AND Language_code='$LANG_CODE$'"
Const C_REQ = "EXEC screen_csts '" & C_SCREENNAME & "','$LANG_CODE$'"

    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, as_Lang))

    Dim ll_cursor As Long
    Dim lo_ctrl As Object
    Dim ls_req As String
    Dim ls_Text As String
    
    ls_req = Replace(C_REQ, "$LANG_CODE$", as_Lang)

    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    Call mo_Db.First(ll_cursor)
    While Not mo_Db.EOF(ll_cursor)
        Set lo_ctrl = GetControl(UserControl.Controls, mo_Db.GetFields(ll_cursor, "Field_Name"))
        ls_Text = mo_Db.GetFields(ll_cursor, "Local_Text")
        Select Case UCase(TypeName(lo_ctrl))
        Case "LABEL", "FRAME", "COMMANDBUTTON", "CHECKBOX"
            lo_ctrl.Caption = ls_Text
        Case "ARMCOMBOBOX"
        Case "ARMGRID"
            If Not lo_ctrl.LoadConstants(ptStatic, ls_Text, ctColumns) Then
                Call Err.Raise(CompFncFailed, "ArmComboBox.LoadConstants", "Screen constant error.")
            End If
        Case "ARMCHECKVIEW"
            If Not lo_ctrl.LoadConstants(ptStatic, ls_Text, CVctColumns) Then
                Call Err.Raise(CompFncFailed, "ArmCheckView.LoadConstants", "Screen constant error.")
            End If
        End Select
        
        Call mo_Db.Next(ll_cursor)
    Wend
    Call mo_Db.Close(ll_cursor)
    
    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then Call mo_Db.Close(ll_cursor)
    Call ErrorHandler("SetLanguage()")
End Sub

Private Sub btn_Allcountries_Click()
On Error GoTo ErrHandler
Dim Idx As Long
If cbo_groups.Count = 0 Then cbo_groups.Load
For Idx = 1 To cbo_groups.Count
Set cbo_groups.SelectedItem = cbo_groups.ComboItems(Idx)
Debug.Print cbo_groups.Text
cbo_groups_ComboItemSelected
Next Idx
    Exit Sub
ErrHandler:
End Sub

'*********************************************************************************************************
'*********************************************** EVENT HANDLERS ******************************************
'*********************************************************************************************************
Private Sub btn_clearCountries_Click()
On Error GoTo ErrHandler
    Call cvw_countries.UnCheckAll("Edit")
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_clearCountries_Click()")
End Sub

Private Sub cbo_groups_ComboItemSelected()
Const C_REQ As String = "SELECT CLOM.CT_Code FROM Countries_Logist_Markets CLOM WHERE CLOM.LMK_code='$LMKCODE$'"
On Error GoTo ErrHandler
    If cbo_groups.SelectedItem Is Nothing Then Exit Sub
    ' select all countries according to selected group

    Dim ls_req As String
    Dim ll_cursor As Long
    Dim lb_oldVisible As Boolean
    
    lb_oldVisible = cvw_countries.Visible
    
    cvw_countries.Visible = False
    
    ' GET CT_Codes
    ls_req = Replace(C_REQ, "$LMKCODE$", cbo_groups.SelectedItem.Key)
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    Call mo_Db.First(ll_cursor)
    While Not mo_Db.EOF(ll_cursor)
        ' check field in checklistView
        If Not cvw_countries.SetItemState("Edit", mo_Db.GetFields(ll_cursor, "CT_Code"), True) Then
            Call Err.Raise(CompFncFailed, "SetItemState", "Cannot set state.")
        End If
        Call mo_Db.Next(ll_cursor)
    Wend
    Call mo_Db.Close(ll_cursor)
    
    cvw_countries.Visible = lb_oldVisible

    Exit Sub
ErrHandler:
    cvw_countries.Visible = lb_oldVisible
    Call ErrorMessage("cbo_groups_ComboItemSelected()")
End Sub


Private Sub cbo_type_ComboItemSelected()
On Error GoTo ErrHandler
    If Not cbo_type.SelectedItem Is Nothing Then
    fil_Full.Pattern = "*." & cbo_type.SelectedItem.GetData(1)
    'txt_File = ""
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("cbo_type_ComboItemSelected()")
End Sub

Private Sub cvw_countries_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo ErrHandler
    ' deselect combo
    Set cbo_groups.SelectedItem = Nothing
    Exit Sub
ErrHandler:
    Call ErrorMessage("cvw_countries_ItemCheck()")
End Sub


Private Sub dir_Full_Change()
On Error GoTo ErrHandler
    fil_Full.Path = dir_Full.Path
    If cbo_type.SelectedItem Is Nothing Then
    fil_Full.Pattern = "*.99X"
    End If
   
    ' restore file text
'    txt_file.Text = GetString(GetString(txt_file.Tag, CI_DATASRC, SEP1 + SEP2), -1, "\")


    Exit Sub
ErrHandler:
    Call ErrorMessage("dir_Full_Change()")
End Sub

Private Sub drv_Full_Change()
On Error GoTo ErrHandler
    
    dir_Full.Path = drv_Full.Drive
    
    ' restore file text
'    txt_file.Text = GetString(GetString(txt_file.Tag, CI_DATASRC, SEP1 + SEP2), -1, "\")

    Exit Sub
ErrHandler:
    Call ErrorMessage("drv_Full_Change()")
End Sub

Private Sub fil_Full_Click()
On Error GoTo ErrHandler
    Dim ls_FilePath As String
    
    ls_FilePath = mo_FSO.BuildPath(fil_Full.Path, fil_Full.FileName)
    
    If Not mo_FSO.FileExists(ls_FilePath) Then
        Call Err.Raise(CompFncFailed, "", "File does not exists!")
    End If
    
    Call SetDataSrc(txt_file, ls_FilePath)
    
    txt_file.Text = fil_Full.FileName
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("fil_Full_Click()")
End Sub

Private Sub grd_tableContent_SelChange()
On Error GoTo ErrHandler
    If grd_tables.Row = -1 Then Exit Sub
    If grd_tableContent.Row = -1 Then Exit Sub
    
    Call FillZipInfoGrid(grd_zipInfo, grd_tables.SelectedLine(0, "ID"), grd_tableContent.SelectedKey(0), Language_codeToolBar, -1)

    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_tableContent_SelChange()")
End Sub

Private Sub grd_tables_SelChange()
On Error GoTo ErrHandler
    
    Call ResetMain

    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_tables_SelChange()")
End Sub


Private Sub grd_zipInfo_ItemSelected()
On Error GoTo ErrHandler
    Debug.Assert (grd_zipInfo.Row <> -1)
    Call DisplayZip(mo_Db, BLOB_FILE, BLOB_ID)
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_zipInfo_ItemSelected()")
End Sub

Private Sub tlb_main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Screen.MousePointer = vbHourglass
    Select Case as_Role
    Case "A"              ' ADD
    cbo_type.Enabled = True
        If grd_tables.Row <> -1 And grd_tableContent.Row <> -1 Then
            Debug.Assert (ml_DetailCursor = 0)
            Call ResetDetail(0)
            Call UpdateUI("BLOBEdit.Add")
            ' set focus to type combo
            Debug.Assert (cbo_type.Visible = True)
            Call cbo_type.SetFocus
        End If
    Case "E"              ' EDIT
    
        If grd_tables.Row <> -1 And grd_tableContent.Row <> -1 And grd_zipInfo.Row <> -1 Then
            Call OpenDetailCursor(ml_DetailCursor, BLOB_ID, Language_codeToolBar)
            If ml_DetailCursor = 0 Then
                Call Err.Raise(CompFncFailed, "", "Record was deleted or translation for language is missing." & vbCrLf & "Refresh grid, please.")
            End If
            Debug.Assert (ml_DetailCursor <> 0)
            Call ResetDetail(ml_DetailCursor)
            Call UpdateUI("BLOBEdit.Upd")
            ' set focus to type combo
            Debug.Assert (cbo_type.Visible = True)
            cbo_type.Enabled = False
            Call cbo_language.SetFocus
        End If
    Case "D"              ' DELETE
        If grd_tables.Row <> -1 And grd_tableContent.Row <> -1 And grd_zipInfo.Row <> -1 Then
            Call OpenDetailCursor(ml_DetailCursor, BLOB_ID, Language_codeToolBar)
            If ml_DetailCursor = 0 Then
                Call Err.Raise(CompFncFailed, "", "Record was deleted or translation for language is missing." & vbCrLf & "Refresh grid, please.")
            End If
            Debug.Assert (ml_DetailCursor <> 0)
            Call ResetDetail(ml_DetailCursor)
            Call UpdateUI("BLOBEdit.Del")
        End If
    Case "L"              ' LANGUAGE SELECTED FROM COMBO
            Call LanguageChanged(as_Language)
    Case "H"              ' ACCEPT CHANGES
        Select Case GetString(ms_activeFace, -1, ".")
        Dim ls_rzID As String
        Case "Add"
            ls_rzID = mo_Db.SQLNextID("REF_RZ_ID")
            If ls_rzID = "" Then
                Call Err.Raise(CompFncFailed, "SQLNextID", "REF_RZ_ID must exist in A_ID.")
            End If
            Debug.Assert (isNumeric(ls_rzID))
            
            Call InsertZipInfo(CLng(ls_rzID))
        Case "Upd"
            Debug.Assert (grd_zipInfo.Row <> -1)
            ls_rzID = CStr(BLOB_ID)
            If Not UpdateZipInfo(CLng(ls_rzID), mo_Db.GetFields(ml_DetailCursor, "iConcurrency")) Then
                ' iConcurrency error/ detail needs to be updated
                If RefreshZipInfoData(CLng(ls_rzID), Language_codeToolBar, ml_DetailCursor) Then
                    ls_rzID = ""        ' repeat update screen
                    MsgBox ("Record was updated by another user. Try again, please.")
                    ' redisplay data
                    Call ResetDetail(ml_DetailCursor)
                Else
                    ' record was deleted by another user
                    ' change face to 'Del' to let tool delete row from grid
                    ms_activeFace = "BLOBEdit.Del"
                    MsgBox ("Record was deleted by another user. Click Add to create new record.")
                End If
            End If
        Case "Del"
            Debug.Assert (ml_DetailCursor <> 0)
            ls_rzID = CStr(BLOB_ID)
            Debug.Assert (isNumeric(ls_rzID))
            If MsgBox("Delete record?", vbYesNo) = vbYes Then
                If Not DeleteZipInfo(CLng(ls_rzID), mo_Db.GetFields(ml_DetailCursor, "iConcurrency")) Then
                    ' iConcurrency error/ detail needs to be updated
                    If RefreshZipInfoData(CLng(ls_rzID), Language_codeToolBar, ml_DetailCursor) Then
                        ls_rzID = ""        ' repeat delete screen
                        MsgBox ("Record was updated by another user. Try again, please.")
                        ' redisplay data
                        Call ResetDetail(ml_DetailCursor)
                    End If
                End If
            Else
                ls_rzID = ""        ' repeat delete screen
            End If
        Case Else
            Debug.Assert (False)
        End Select
        If ls_rzID <> "" Then
            Debug.Assert (isNumeric(ls_rzID))
            Call UpdateGridAfterAction(grd_zipInfo, GetContainedControlsChain(GetControl(frm_frames, "frm_blobLinkMtnc")), GetString(ms_activeFace, -1, "."), CVar(Array(ls_rzID)))
            ' close detailCursor
            Call mo_Db.Close(ml_DetailCursor)
            ml_DetailCursor = 0
            Call UpdateUI("BLOBEdit.Main")
        End If
    Case "I"              ' CLEAR CHANGES
        Call ResetDetail(ml_DetailCursor)
    Case "S"              ' SAVE CONTENT OF BLOB INTO LOCATION SELECTED BY USER
        If grd_zipInfo.Row <> -1 Then
            Dim ls_ext As String
            ls_ext = grd_zipInfo.SelectedLine(0, "TYPEDESC")
            Debug.Assert (ls_ext <> "")
            dlg_dlg.Filter = "All files (*.*)|*.*|Document type (*." & ls_ext & ")|*." & ls_ext
            dlg_dlg.FileName = grd_zipInfo.SelectedLine(0, "FILENAME")
            dlg_dlg.FilterIndex = IIf(UCase(dlg_dlg.FileName) Like "*." & UCase(ls_ext), 2, 1)
            
            Call dlg_dlg.ShowSave
        
            If dlg_dlg.FileName <> "" Then
                Call DownloadBlob(BLOB_ID, dlg_dlg.FileName)
            End If
        End If
    Case "R"              ' REFRESH TABLE GRID
        If grd_tables.Row <> -1 Then
            Call grd_zipInfo.ClearGrid
            Call FillTableContentGrid(grd_tableContent, grd_tables.SelectedLine(0, "GRIDREQUEST"), grd_tables.SelectedLine(0, "GRIDCOLUMNDEF"), -1)
        End If
    Case "T"              ' CLOSE SCREEN/CANCEL
        ' close detailCursor
        Call mo_Db.Close(ml_DetailCursor)
        ml_DetailCursor = 0
        Call UpdateUI("BLOBEdit.Main")
    Case "Q"              ' QUIT
      RaiseEvent quit
    End Select

    Screen.MousePointer = vbDefault
    Exit Sub
ErrHandler:
Screen.MousePointer = vbDefault
    Call ErrorMessage("tlb_main_Action()")
End Sub


Private Sub txt_from_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
    If KeyAscii = 13 Then
        ' refresh grd_tableContent
        Dim lb_cancel As Boolean
        Call txt_from_Validate(lb_cancel)
        If Not lb_cancel Then
            Dim lv_keyVal As Variant
                    
            lv_keyVal = grd_tableContent.SelectedKey(0)
            Call FillTableContentGrid(grd_tableContent, grd_tables.SelectedLine(0, "GRIDREQUEST"), grd_tables.SelectedLine(0, "GRIDCOLUMNDEF"), -1)
            If Not IsEmpty(lv_keyVal) Then
                If Not grd_tableContent.SearchKey(True, lv_keyVal) Then
                    Call grd_zipInfo.ClearGrid
                End If
            Else
                Call grd_zipInfo.ClearGrid
            End If
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("txt_from_KeyPress()")
End Sub

Private Sub txt_from_Validate(Cancel As Boolean)
On Error GoTo ErrHandler
    Cancel = False
    If grd_tables.Row = -1 Then Exit Sub
    
    grd_tables.SelectedLine(0, "RANGEFROM") = txt_from.Text
    Exit Sub
ErrHandler:
    Cancel = True
    Call ErrorMessage("txt_from_Validate()")
End Sub

Private Sub txt_Title_LostFocus()
On Error GoTo ErrHandler
    If txt_internetDesc.Text = "" Then txt_internetDesc.Text = txt_title.Text
    Exit Sub
ErrHandler:
    Call ErrorMessage("txt_title_LostFocus()")
End Sub

Private Sub txt_to_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
    If KeyAscii = 13 Then
        ' refresh grd_tableContent
        Dim lb_cancel As Boolean
        Call txt_to_Validate(lb_cancel)
        If Not lb_cancel Then
            Dim lv_keyVal As Variant
                    
            lv_keyVal = grd_tableContent.SelectedKey(0)
            Call FillTableContentGrid(grd_tableContent, grd_tables.SelectedLine(0, "GRIDREQUEST"), grd_tables.SelectedLine(0, "GRIDCOLUMNDEF"), -1)
            If Not IsEmpty(lv_keyVal) Then
                If Not grd_tableContent.SearchKey(True, lv_keyVal) Then
                    Call grd_zipInfo.ClearGrid
                End If
            Else
                Call grd_zipInfo.ClearGrid
            End If
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("txt_to_KeyPress()")
End Sub

Private Sub txt_to_Validate(Cancel As Boolean)
On Error GoTo ErrHandler
    Cancel = False
    If grd_tables.Row = -1 Then Exit Sub
    
    grd_tables.SelectedLine(0, "RANGETO") = txt_to.Text
    Exit Sub
ErrHandler:
    Cancel = True
    Call ErrorMessage("txt_to_Validate()")
End Sub

Private Sub cbo_categories_ComboItemSelected()
On Error GoTo ErrHandler
    If cbo_categories.SelectedItem Is Nothing Or Not cbo_categories.Enabled Then Exit Sub
    ' refresh grd_tableContent
    Dim lv_keyVal As Variant
            
    lv_keyVal = grd_tableContent.SelectedKey(0)
    Call FillTableContentGrid(grd_tableContent, grd_tables.SelectedLine(0, "GRIDREQUEST"), grd_tables.SelectedLine(0, "GRIDCOLUMNDEF"), -1)
    If Not IsEmpty(lv_keyVal) Then
        If Not grd_tableContent.SearchKey(True, lv_keyVal) Then
            Call grd_zipInfo.ClearGrid
        End If
    Else
        Call grd_zipInfo.ClearGrid
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("cbo_categories_ComboItemSelected()")
End Sub

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub
Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property

