VERSION 5.00
Begin VB.UserControl Cap_RptView 
   ClientHeight    =   11295
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   18105
   ScaleHeight     =   11295
   ScaleWidth      =   18105
   Begin VB.Frame fra_Main 
      Height          =   4620
      Left            =   4200
      TabIndex        =   4
      Top             =   3240
      Visible         =   0   'False
      Width           =   6375
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Left            =   135
         TabIndex        =   10
         Top             =   195
         Width           =   6135
         _ExtentX        =   10821
         _ExtentY        =   1217
      End
      Begin Project1.ArmGrid grd_Main 
         Height          =   6945
         Left            =   165
         TabIndex        =   5
         Tag             =   "grd_Main_Columns"
         Top             =   1020
         Width           =   14415
         _ExtentX        =   25426
         _ExtentY        =   12250
      End
   End
   Begin VB.Frame fra_Filter 
      Height          =   8415
      Left            =   30
      TabIndex        =   0
      Top             =   345
      Visible         =   0   'False
      Width           =   3975
      Begin VB.OptionButton opt_date 
         Caption         =   "#All"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   8
         Tag             =   "opt_all"
         Top             =   675
         Value           =   -1  'True
         Width           =   1800
      End
      Begin VB.OptionButton opt_date 
         Caption         =   "#Between"
         Height          =   255
         Index           =   1
         Left            =   1980
         TabIndex        =   7
         Tag             =   "opt_between"
         Top             =   675
         Width           =   1815
      End
      Begin Project1.A_calocx cal1 
         Height          =   375
         Left            =   105
         TabIndex        =   2
         Top             =   1305
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin Project1.A_calocx cal2 
         Height          =   375
         Left            =   2040
         TabIndex        =   3
         Top             =   1305
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin Project1.ArmCombobox cb_trw 
         Height          =   345
         Left            =   120
         TabIndex        =   6
         Top             =   2400
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   609
      End
      Begin Project1.ArmTreeView tv_Filter 
         Height          =   5490
         Left            =   120
         TabIndex        =   1
         Top             =   2760
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   9684
      End
      Begin VB.Label lbl_DateRange 
         Caption         =   "#Date range"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Tag             =   "lbl_DateRange"
         Top             =   315
         Width           =   1215
      End
   End
End
Attribute VB_Name = "Cap_RptView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const SCREEN_NAME As String = "Cap_RptView"

#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If

Private mo_FSO As Object
Private ms_Language_Code                As String
Private ml_U_Code                       As Long
Private ms_LoginName                    As String

Private mTreeViewInfo As TTreeViewInfo

Private old_cal1                        As String
Private old_cal2                        As String
Private current_cal1                    As String
Private current_cal2                    As String

Private mb_Initialized As Boolean
Private m_ConnectString                 As String
Private use_framework_connection        As Integer

Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

' **************************************************************************************************
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
End Enum
' *************************************** USER DEFINED ERRORS **************************************

Private Type TTreeViewInfo
    Levels As Long
    NodeRequest() As String
    GridRequest() As String
    ExcelRequest() As String
    CountRequest() As String
    FindRequest() As String
    Images() As Integer
    SelectedImages() As Integer
    TreeViewCode As String
    Loaded As Boolean
End Type

Public Event quit()


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

Public Property Let Top(ByVal aTop As Single)
    UserControl.Extender.Top = aTop
End Property
Public Property Get Top() As Single
    Top = UserControl.Extender.Top
End Property

Public Property Let Height(ByVal aHeight As Single)
    UserControl.Extender.Height = aHeight
End Property
Public Property Get Height() As Single
    Height = UserControl.Extender.Height
End Property

Public Property Let Left(ByVal aLeft As Single)
    UserControl.Extender.Left = aLeft
End Property
Public Property Get Left() As Single
    Left = UserControl.Extender.Left
End Property

Public Property Let Width(ByVal aWidth As Single)
    UserControl.Extender.Width = aWidth
End Property
Public Property Get Width() As Single
    Width = UserControl.Extender.Width
End Property

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 Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property

Property Get ConnectString() As String
    ConnectString = m_ConnectString
End Property

Property Let LoginName(as_Login As String)
ms_LoginName = as_Login
End Property

Property Let U_Code(al_Code As Long)
ml_U_Code = al_Code
End Property

Property Let Language_Code(AString As String)
ms_Language_Code = AString
End Property

Public Property Set ArmDb(ByRef local_connection As Object)
    If Not (local_connection Is Nothing) Then
        Set mo_Db = local_connection
    End If
End Property

Public Function Load_A_Com() As Boolean

On Error GoTo ErrorHandler
    
    Load_A_Com = False
    Call cb_trw.Load_A_Com
    Set cb_trw.ArmDb = mo_Db
    cal1.Language = ms_Language_Code
    cal2.Language = ms_Language_Code
    Set grd_main.ArmDb = mo_Db
    Call grd_main.Load_A_Com
    tlb_main.Language = ms_Language_Code
    Call tlb_main.Load_A_Com
    Set tv_Filter.ArmDb = mo_Db
    tv_Filter.Language = ms_Language_Code
    Call tv_Filter.Load_A_Com
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    Call DeleteTemporaryReports
    mb_Initialized = True
    Load_A_Com = True
    Exit Function
ErrorHandler:
    Load_A_Com = False
    Call ErrorMessage("Load_A_COM")
End Function

Public Function Unload_A_Com() As Boolean
    
On Error GoTo ErrorHandler
    
    grd_main.Unload_A_Com
    cb_trw.Unload_A_Com
    tv_Filter.Unload_A_Com
    tlb_main.Unload_A_Com
    Call DeleteTemporaryReports
    
    Set mo_Db = Nothing
    Set mo_FSO = Nothing
    mb_Initialized = False
    Unload_A_Com = True
    Exit Function
ErrorHandler:
    Unload_A_Com = False
    Call ErrorMessage("Unload_A_Com")
End Function

Private Function LoadToolbars() As Boolean
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_ToolbarInfo 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)
    ls_ToolbarInfo = mo_Db.GetFields(lc_Toolbar, "Toolbar_info")
    
    ' init toolbar
    tlb_main.Language = ms_Language_Code
    Call tlb_main.SetToolbarInfoStringParameters(ls_ToolbarInfo, "089")
    Call tlb_main.DisplayFace(0)
    
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = True
    Exit Function
ErrHandler:
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = False
    Call ErrorHandler("LoadToolbars()")
End Function

Public Function Init_control()
On Error GoTo ErrorHandler

    fra_Filter.Visible = True
    fra_main.Visible = True
    
    Call fra_Filter.Move(120, 120, 4000, Height - 240)
    Call fra_main.Move(4120, 120, Width - fra_Filter.Width - 360, Height - 240)
    tv_Filter.Height = fra_Filter.Height - tv_Filter.Top - 120
    Call tlb_main.Move(120, 200)
    Call grd_main.Move(120, tlb_main.Height + 240, fra_main.Width - 240, fra_main.Height - tlb_main.Height - 360)
    
    Call LoadToolbars
    
    opt_date(0).value = True
    
    cal1.date_courte = "01/01/" & Year(Now)
    cal1.Visible = False
    cal2.date_courte = Format(Now, "dd\/mm\/yyyy")
    cal2.Visible = False
    
    Call grd_main.SetColumns(Array( _
        Join(Array("ID_Blob", 0, 1, "ID_Blob", ""), SEP), _
        Join(Array("RPT_Generated_Against", 2000, 0, "RPT_Generated_Against", "#User"), SEP), _
        Join(Array("Description", 8000, 0, "Description", "#Report Title"), SEP), _
        Join(Array("Date_of_Creation", 2000, 0, "Date_of_Creation", "#Creation Date"), SEP)))
        
    If check_authorization Then
        cb_trw.Request = "exec TreeView_View_t_lst '" & SCREEN_NAME & "'," & "'" & ms_Language_Code & "'"
        If Not cb_trw.Load Then
          Call Err.Raise(ArmErr.CompFncFailed, cb_trw.Load, "Request=" & cb_trw.Request)
        End If
        If cb_trw.Count > 0 Then
          Call cb_trw.SearchItem("X", "TV_Default", 0, True)
        End If

       old_cal1 = cal1.date_courte
       old_cal2 = cal2.date_courte
    End If
    Call reinit_display(False)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    Call LoadLabels(mo_Db, UserControl.Controls, SCREEN_NAME, ms_Language_Code)
    Init_control = True
    Exit Function
ErrorHandler:
    Init_control = False
    Call ErrorMessage("Init_control")
End Function

Public Sub reinit_display(ByVal ab_DisplayData As Boolean)
    
On Error GoTo ErrorHandler
    
    If ab_DisplayData Then
      grd_main.Visible = True
    Else
      Call grd_main.ClearGrid
      grd_main.Visible = False
    End If
    Exit Sub
ErrorHandler:
    Call ErrorHandler("reinit_display")
End Sub

Private Sub cb_trw_ComboItemSelected()

On Error GoTo ErrorHandler
    
    Screen.MousePointer = vbHourglass
    If Not cb_trw.SelectedItem Is Nothing Then
      mTreeViewInfo = GetTreeViewInfoFromDB(SCREEN_NAME, cb_trw.SelectedItem.Key)
      Call LoadTreeView(tv_Filter, mTreeViewInfo)
    End If
    Call reinit_display(False)
    Screen.MousePointer = vbDefault
    Exit Sub
ErrorHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("cb_trw_ComboItemSelected")
End Sub

Private Function CheckDataAuthorization(ByVal ao_Node As MSComctlLib.Node) As Boolean
Dim ll_Cursor   As Long
Dim ls_req      As String

On Error GoTo ErrorHandler
    
    CheckDataAuthorization = False
    If ao_Node Is Nothing Then Exit Function
    If cb_trw.SelectedItem Is Nothing Then Exit Function
    
    Select Case ao_Node.Tag.ml_Level
    Case 0
        ls_req = "SELECT 1 FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Markets' AND Autho_Values IS NULL"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            CheckDataAuthorization = True
        End If
        mo_Db.Close (ll_Cursor)
        Exit Function
    Case 1
        Select Case UCase(cb_trw.SelectedItem.Key)
            Case "TV1", "TV3"
                ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Markets'"
            Case "TV2"
                ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Area'"
        End Select
        
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If mo_Db.GetFields(ll_Cursor, 0) = "" Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
            If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem).GetData(0))) > 0 Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
        End If
        mo_Db.Close (ll_Cursor)
    Case 2
        ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Markets'"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If mo_Db.GetFields(ll_Cursor, 0) = "" Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
            If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem.Parent).GetData(0))) > 0 Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
        End If
        mo_Db.Close (ll_Cursor)
        
        ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Countries'"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem).GetData(0))) > 0 Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
        End If
    Case 3
        Select Case UCase(cb_trw.SelectedItem.Key)
            Case "TV1", "TV3"
                ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Markets'"
            Case "TV2"
                ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Area'"
        End Select
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If mo_Db.GetFields(ll_Cursor, 0) = "" Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
            ' Here was the bug
            If UCase(cb_trw.SelectedItem.Key) = "TV1" Then
                If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem.Parent.Parent).GetData(0))) > 0 Then
                    CheckDataAuthorization = True
                    mo_Db.Close (ll_Cursor)
                    Exit Function
                End If
            Else
                If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem.Parent).GetData(0))) > 0 Then
                    CheckDataAuthorization = True
                    mo_Db.Close (ll_Cursor)
                    Exit Function
                End If
            End If
        End If
        mo_Db.Close (ll_Cursor)
        
        If UCase(cb_trw.SelectedItem.Key) = "TV1" Then
            ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Countries'"
            ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
            If mo_Db.RowCount(ll_Cursor) > 0 Then
                If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem.Parent).GetData(0))) > 0 Then
                    CheckDataAuthorization = True
                    mo_Db.Close (ll_Cursor)
                    Exit Function
                End If
            End If
            mo_Db.Close (ll_Cursor)
        End If
            
        ls_req = "SELECT Autho_Values FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "' AND Autho_Level = 'Users'"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If InStr(1, mo_Db.GetFields(ll_Cursor, 0), Trim(tv_Filter.NodeInfo(tv_Filter.SelectedItem).GetData(0))) > 0 Then
                CheckDataAuthorization = True
                mo_Db.Close (ll_Cursor)
                Exit Function
            End If
        End If
    End Select
    Exit Function
ErrorHandler:
    CheckDataAuthorization = True
    Call ErrorHandler("CheckDataAuthorization")
End Function

Private Function LoadTreeView(ByRef aTV As ArmTreeView, ByRef aTreeViewInfo As TTreeViewInfo, Optional ByRef aGrid As ArmGrid = Nothing) As Boolean
    
On Error GoTo ErrorHandler
    Call aTV.Clear
    
    If aTreeViewInfo.Levels > 0 Then
      aTV.Levels = aTreeViewInfo.Levels
      aTV.StartDemandLevel = 1
      aTV.SelectedImages = aTreeViewInfo.SelectedImages
      aTV.Images = aTreeViewInfo.Images
      aTV.NodeRequests = aTreeViewInfo.NodeRequest
      
      If Not aTV.LoadTree(LoadTypeChildsDemand) Then
          Call Err.Raise(ArmErr.CompFncFailed, "aTV.LoadTree", "")
      End If
    End If
    Exit Function
ErrorHandler:
    Call ErrorHandler("LoadTreeView")
End Function

Private Function GetTreeViewInfoFromDB(ByVal AScreenName As String, ByVal aTVCode As String) As TTreeViewInfo

    Dim lTreeView As TTreeViewInfo
    Dim lRequest As String
    Dim lCurs As Long, lIdx As Long, lCount As Long
    
On Error GoTo ErrorHandler
    ' Get the data from the DB
    lRequest = "EXEC Treeview_Parameters_lst '" & AScreenName & "', '" & aTVCode & "'"
    lCurs = OpenSQLSafe(mo_Db, lRequest)
    
    lCount = mo_Db.RowCount(lCurs) - 1
    
    If lCount < 0 Then
        Call Err.Raise(ArmErr.InvalidValue, lRequest, "lCount=" & lCount)
    End If
    
    ReDim lTreeView.NodeRequest(lCount)
    ReDim lTreeView.GridRequest(lCount)
    ReDim lTreeView.ExcelRequest(lCount)
    ReDim lTreeView.FindRequest(lCount)
    ReDim lTreeView.CountRequest(lCount)
    ReDim lTreeView.Images(lCount)
    ReDim lTreeView.SelectedImages(lCount)
    
    Dim lLevel As Long
    For lIdx = 0 To lCount
        lLevel = mo_Db.GetFields(lCurs, "TV_Level")
        lTreeView.NodeRequest(lLevel) = mo_Db.GetFields(lCurs, "TV_NodeRequest")
        lTreeView.GridRequest(lLevel) = mo_Db.GetFields(lCurs, "TV_GridRequest")
        lTreeView.Images(lLevel) = mo_Db.GetFields(lCurs, "TV_Images")
        lTreeView.SelectedImages(lLevel) = mo_Db.GetFields(lCurs, "TV_SelectedImages")
        mo_Db.Next (lCurs)
    Next
    
    lTreeView.TreeViewCode = aTVCode
    lTreeView.Levels = lCount + 1
    lTreeView.Loaded = True
    GetTreeViewInfoFromDB = lTreeView
    
    Call mo_Db.Close(lCurs)
    Exit Function
ErrorHandler:
    Call ErrorHandler("GetTreeViewInfoFromDB")
    Call mo_Db.Close(lCurs)
End Function

Private Sub cal1_datechangee()
On Error GoTo ErrorHandler
    If current_cal1 <> cal1.date_courte Then Call reinit_display(False)
    Exit Sub
ErrorHandler:
    Call ErrorMessage("cal1_datechangee")
End Sub

Private Sub cal1_LostFocus()
On Error GoTo ErrorHandler

    If old_cal1 <> cal1.date_courte Then Call reinit_display(False)
    old_cal1 = cal1.date_courte
    Exit Sub
ErrorHandler:
    Call ErrorMessage("cal1_LostFocus")
End Sub

Private Sub cal2_datechangee()
On Error GoTo ErrorHandler

    If current_cal2 <> cal2.date_courte Then Call reinit_display(False)
    Exit Sub
ErrorHandler:
    Call ErrorMessage("cal2_datechangee")
End Sub

Private Sub cal2_LostFocus()
On Error GoTo ErrorHandler

    If old_cal2 <> cal2.date_courte Then Call reinit_display(False)
    old_cal2 = cal2.date_courte
    Exit Sub
ErrorHandler:
    Call ErrorMessage("cal2_LostFocus")
End Sub


Public Function check_authorization()
Dim ll_Cursor   As Long
Dim ls_req      As String

On Error GoTo ErrorHandler
    check_authorization = False
    ls_req = "SELECT 1 FROM Cap_Rep_Login WHERE Login_Name = '" & ms_LoginName & "'"
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        check_authorization = True
    End If
    mo_Db.Close (ll_Cursor)
    Exit Function
ErrorHandler:
    Call ErrorHandler("check_authorization")
    check_authorization = False
    Call mo_Db.Close(ll_Cursor)
End Function


Private Function ReplaceHolders(ByVal as_req As String, ByVal ao_Node As MSComctlLib.Node) As String

    Dim ls_req As String
    Dim ls_Rar_Code As String, ls_BMK_Code As String, ls_SMK_Code As String, ls_CT_Code As String
    Dim ls_Login_Name As String, ls_Date1 As String, ls_Date2 As String
  
On Error GoTo ErrorHandler
    If cb_trw.SelectedItem Is Nothing Then Exit Function
    ' Treeview level
    ls_Rar_Code = "NULL"
    ls_BMK_Code = "NULL"
    ls_SMK_Code = "NULL"
    ls_CT_Code = "NULL"
    ls_Date1 = "NULL"
    ls_Date2 = "NULL"
    ls_Login_Name = "NULL"
    ls_req = as_req
    Select Case UCase(cb_trw.SelectedItem.Key)
        Case "TV1"  ' Market
            Select Case ao_Node.Tag.ml_Level
                Case 0  ' All markets
                    ' Nothing to do
                Case 1  ' Market
                    ls_SMK_Code = SqlStr(tv_Filter.NodeInfo(ao_Node).IDValue)
                Case 2  ' Country
                    ls_SMK_Code = SqlStr(tv_Filter.NodeInfo(ao_Node.Parent).IDValue)
                    ls_CT_Code = SqlStr(tv_Filter.NodeInfo(ao_Node).IDValue)
                Case 3  ' User
                    ls_SMK_Code = SqlStr(tv_Filter.NodeInfo(ao_Node.Parent.Parent).IDValue)
                    ls_CT_Code = SqlStr(tv_Filter.NodeInfo(ao_Node.Parent).IDValue)
                    ls_Login_Name = SqlStr(Trim(tv_Filter.NodeInfo(ao_Node).TextValue))
                    
            End Select
            
        Case "TV2"  ' Area
            Select Case ao_Node.Tag.ml_Level
                Case 0  ' Area
                    ls_Rar_Code = tv_Filter.NodeInfo(ao_Node).IDValue
                Case 1  ' z_creator
                    ls_Rar_Code = tv_Filter.NodeInfo(ao_Node.Parent).IDValue
                    ls_Login_Name = SqlStr(Trim(tv_Filter.NodeInfo(ao_Node).TextValue))
            End Select
            
        Case "TV3"
            Select Case ao_Node.Tag.ml_Level
                Case 0  ' All markets
                    ' Nothing to do
                Case 1  ' Market
                    ls_SMK_Code = SqlStr(tv_Filter.NodeInfo(ao_Node).IDValue)
                Case 2  ' Country
                    ls_SMK_Code = SqlStr(tv_Filter.NodeInfo(ao_Node.Parent).IDValue)
                    ls_Login_Name = SqlStr(Trim(tv_Filter.NodeInfo(ao_Node).TextValue))
            End Select
        
    End Select
    
    If opt_date(1).value Then
      If cal1.date_courte <> "" Then ls_Date1 = SqlStr(cal1.date_sql)
      If cal2.date_courte <> "" Then ls_Date2 = SqlStr(cal2.date_sql)
    End If
    
    ls_req = Replace(ls_req, "$date1$", ls_Date1, , , vbTextCompare)
    ls_req = Replace(ls_req, "$date2$", ls_Date2, , , vbTextCompare)
    ls_req = Replace(ls_req, "$rar_code$", ls_Rar_Code, , , vbTextCompare)
    ls_req = Replace(ls_req, "$smk_code$", ls_SMK_Code, , , vbTextCompare)
    ls_req = Replace(ls_req, "$bmk_code$", ls_BMK_Code, , , vbTextCompare)
    ls_req = Replace(ls_req, "$ct_code$", ls_CT_Code, , , vbTextCompare)
    ls_req = Replace(ls_req, "$Login_Name$", ls_Login_Name, , , vbTextCompare)
    ls_req = Replace(ls_req, "$LoginName$", ms_LoginName, , , vbTextCompare)
    ls_req = Replace(ls_req, "$U_Code$", CStr(ml_U_Code), , vbTextCompare)
    
    ls_req = Replace(ls_req, "$language_code$", SqlStr(ms_Language_Code), , , vbTextCompare)
    
    ReplaceHolders = ls_req
    Exit Function
ErrorHandler:
    Call ErrorHandler("ReplaceHolders")
End Function

Private Function SqlStr(ByVal as_Data As String) As String

  SqlStr = "'" & Replace(as_Data, "'", "''") & "'"
End Function


Private Sub grd_Main_ItemSelected()
Dim ls_Key As String
On Error GoTo ErrorHandler
  
  Screen.MousePointer = vbHourglass
  ls_Key = grd_main.SelectedKey(0)(0)
  Call Download_Report_File(ls_Key)
  Call Launch_Report_File(ls_Key)
  Screen.MousePointer = vbDefault
  Exit Sub
ErrorHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("grd_Main_ItemSelected")
End Sub

Private Sub opt_date_Click(Index As Integer)
On Error GoTo ErrorHandler

  cal1.Visible = (Index = 1)
  cal2.Visible = cal1.Visible
  Call reinit_display(False)
  Exit Sub
ErrorHandler:
    Call ErrorMessage("grd_Main_ItemSelected")
End Sub

Private Sub tlb_main_action(ByVal as_Role As String, as_Language As String)

On Error GoTo ErrorHandler
  
  Screen.MousePointer = vbHourglass
  Select Case as_Role
  Case "F"
    Call Refresh_Main_Grid
  Case "L"
    Call Refresh_Main_Grid
  Case "T"
    RaiseEvent quit
  End Select
  Screen.MousePointer = vbDefault
  Exit Sub
ErrorHandler:
  Screen.MousePointer = vbDefault
  Call ErrorMessage("tlb_main_action")
End Sub

Private Sub tv_filter_NodeClick(ByVal Node As MSComctlLib.Node)
Dim ls_Request As String

On Error GoTo ErrorHandler
    
  Screen.MousePointer = vbHourglass
  If Not (Node Is Nothing) Then
    If Node.Tag.ml_Level = tv_Filter.Levels - 1 Then
      Call Refresh_Main_Grid
    Else
      Call reinit_display(False)
    End If
  End If
  Screen.MousePointer = vbDefault
  Exit Sub
ErrorHandler:
  Screen.MousePointer = vbDefault
  Call ErrorMessage("tv_filter_NodeClick")
End Sub

Private Sub Refresh_Main_Grid()
Dim ls_Request As String

On Error GoTo ErrorHandler
  If tv_Filter.SelectedItem Is Nothing Then Exit Sub
  If CheckDataAuthorization(tv_Filter.SelectedItem) Then
    ls_Request = ReplaceHolders(mTreeViewInfo.GridRequest(tv_Filter.SelectedItem.Tag.ml_Level), tv_Filter.SelectedItem)
    If Not grd_main.Load(ls_Request, False) Then
      Call Err.Raise(ArmErr.CompFncFailed, "grd_Main.Load", "Request=" & ls_Request)
    End If
    Call reinit_display(True)
  Else
    MsgBox "You are not authorized to see these data"
    Call reinit_display(False)
  End If
  Exit Sub
ErrorHandler:
  Call ErrorHandler("Refresh_Main_Grid")
End Sub

Private Function delete_file(ByVal d_name As String, ByVal f_name As String) As Boolean
Dim ls_files   As Object

On Error GoTo delete_file_err
    delete_file = False
    
    If mo_FSO.FileExists(d_name & "\" & f_name) Then
        Set ls_files = mo_FSO.GetFile(d_name & "\" & f_name)
    
        If Not (ls_files Is Nothing) Then
            mo_FSO.DeleteFile d_name & "\" & f_name, True
        End If
        Set ls_files = Nothing
        delete_file = True
    Else
        delete_file = True
    End If

    Exit Function

delete_file_err:
    Set ls_files = Nothing
    Call ErrorHandler("delete_file:" & d_name & "\" & f_name)
End Function

Private Sub Download_Report_File(ByVal as_key As String)
Dim ls_ZipDir As String
Dim ls_Request As String
Dim ls_dir As String

On Error GoTo ErrorHandler
    
    ls_dir = GetTempDir & "\$CaptureReports$"
    If Not mo_FSO.FolderExists(ls_dir) Then
      Call mo_FSO.CreateFolder(ls_dir)
    End If
    ls_ZipDir = ls_dir & "\" & as_key
    If Not mo_FSO.FolderExists(ls_ZipDir) Then
      Call mo_FSO.CreateFolder(ls_ZipDir)
    End If
    ls_Request = "exec Cap_Offline_ReportsFiles_Sel " & as_key
    If Not mo_Db.BlobToFileSQL(ls_Request, ls_ZipDir, True, True) Then
      Call Err.Raise(ArmErr.CompFncFailed, "BlobToFileSQL", "ls_Request=" & ls_Request & ",ls_ZipDir=" & ls_ZipDir)
    End If
  Exit Sub
ErrorHandler:
  Call ErrorHandler("Download_Report_File:" & as_key)
End Sub

Private Sub Launch_Report_File(ByVal as_key As String)
Dim ls_TempDir As String
Dim lo_Fld As Object
Dim lo_File As Object
Dim lo_shell As Object

On Error GoTo ErrorHandler
  If as_key = "" Then Exit Sub
  ls_TempDir = GetTempDir & "\$CaptureReports$\" & as_key
  Set lo_shell = CreateObject("Shell.Application")

  Set lo_Fld = mo_FSO.GetFolder(ls_TempDir)
  For Each lo_File In lo_Fld.Files
    Call lo_shell.ShellExecute(lo_File.Path, "", "", "open", 1)
  Next
  Set lo_shell = Nothing
  Exit Sub
ErrorHandler:
  Set lo_shell = Nothing
  Call ErrorHandler("Launch_Report_File:" & as_key)
End Sub

Public Function GetTempDir() As String
Dim ls_Buff As String, ll_count As Long

On Error GoTo ErrorHandler
    ls_Buff = Space(1024)
    ll_count = GetTempPath(1024, ls_Buff)
    
    ls_Buff = Left(ls_Buff, ll_count)
    'this function can return path with trailing "\" character - strip it
    If ll_count > 0 Then
      If right(ls_Buff, 1) = "\" Then
       ls_Buff = Left(ls_Buff, ll_count - 1)
      End If
    End If
    GetTempDir = ls_Buff
  Exit Function
ErrorHandler:
  Call ErrorHandler("GetTempDir")
End Function

Private Sub DeleteTemporaryReports()
On Error GoTo ErrorHandler

  ' delete all subfolders and files in one go
  Call mo_FSO.DeleteFolder(GetTempDir & "\$CaptureReports$", True)
  Exit Sub
ErrorHandler:
  'do nothing this is not critical error, because some of the temp files can be still open
  'by user, it will be delete next time capture exist
End Sub


' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
Private Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_req As String)

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

End Sub

Private Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_req As String) As Long

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

End Function

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(mo_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)
    Dim ls_ErrSource As String
    Dim ls_ErrDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_ErrDescription = Err.Description
    
    Call LogMessage("Cap_RptView 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)
End Sub

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$", ml_U_Code)
    ls_req = Replace(ls_req, "$APP$", SCREEN_NAME)
    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

' ************************************************************************************
' *************************** 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, Optional ByVal aCodePage As Long)

On Error GoTo ErrHandler
   
    Dim lc_Control As Control
    Dim ll_Charset As Long
    
    On Error Resume Next
    ll_Charset = GetCharSetFromCodePage(aCodePage)
    
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
        Case "TABSTRIP", "TEXTBOX", "LABEL", "FRAME", "COMMANDBUTTON", _
              "LISTVIEW", "CHECKBOX", "OPTIONBUTTON", _
              "ARMCHECKVIEW", "ARMTREEVIEW", "ARMGRID", "ARMCOMBOBOX", "ARMCHECKVIEW0"
            lc_Control.Font.Name = "Arial"
            lc_Control.Font.Charset = ll_Charset
        Case "A_SEEK", "A_SRCHTXT"
            lc_Control.Charset = ll_Charset
        End Select
    Next
    
    Exit Sub

ErrHandler:
    Call ErrorHandler("ChangeCharset")
End Sub

' Load the labels of a containers
Private Sub LoadLabels(ByRef ao_Armdb As ArmDb, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String)
Dim lc_Labels As Long       ' The cursor of the labels
Dim lc_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim ls_Request As String
    
    On Error GoTo Trace_Err

    ls_Request = "exec Screen_csts_secure '" & as_ScreenName & "','" & as_Language & "'"
    lc_Labels = OpenSQLSafe(ao_Armdb, ls_Request)
    
    If lc_Labels = 0 Then
        Exit Sub
    End If
    
    On Error GoTo WithoutTag
    If ao_Container.Tag <> "" Then
        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", ao_Container.Tag, , 1)
        If li_Label >= 0 Then
            ao_Container.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
        End If
    End If
WithoutTag:
    
    On Error GoTo Trace_Err
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
            Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                Dim lo_Tbs
                Set lo_Tbs = lc_Control ' Cast for use of intellisense
                li_Count = lo_Tbs.Tabs.Count
                For li_Idx = 1 To li_Count
                    If lo_Tbs.Tabs(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Tbs.Tabs(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_Tbs.Tabs(li_Idx).Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_Tbs = Nothing
            
            Case UCase("ListView") ' Component is a listview, we load the caption of each columns
                Dim lo_ListView As ListView
                Set lo_ListView = lc_Control
                li_Count = lo_ListView.ColumnHeaders.Count
                For li_Idx = 1 To li_Count
                    If lo_ListView.ColumnHeaders(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_ListView.ColumnHeaders(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_ListView.ColumnHeaders(li_Idx).Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_ListView = Nothing
        
            Case UCase("TextBox")  ' Component is a textbox
                Dim lo_TextBox As TextBox
                Set lo_TextBox = lc_Control
                If lo_TextBox.Tag <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_TextBox.Tag, , 1)
                    If li_Label >= 0 Then
                        lo_TextBox.Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
                Set lo_TextBox = Nothing
            
            Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
                If lc_Control.Tag <> "" Then
                    'Print #1, lc_Control.Tag & "," & lc_Control.Caption
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
            Case UCase("ArmGrid")
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                If li_Label >= 0 Then
                  Call lc_Control.LoadConstants(ptStatic, ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT"), ctColumns)
                End If
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                If li_Label >= 0 Then
                  lc_Control.Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                End If
            Case UCase("Menu")
                If lc_Control.Name <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
        End Select
    Next
        
Trace_End:
    Call ao_Armdb.Close(lc_Labels)
    Exit Sub
    
Trace_Err:
    Call ao_Armdb.Close(lc_Labels)
      
End Sub

