VERSION 5.00
Begin VB.UserControl DC_Sample_lst 
   ClientHeight    =   7755
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   16440
   ScaleHeight     =   7755
   ScaleWidth      =   16440
   Begin VB.Frame frm_DC_Samples_lst 
      Height          =   6930
      Left            =   15
      TabIndex        =   0
      Top             =   0
      Width           =   14070
      Begin DSWMGR.ArmCombobox cbo_tt_code 
         Height          =   345
         Left            =   2070
         TabIndex        =   8
         Top             =   5715
         Width           =   2460
         _extentx        =   4339
         _extenty        =   609
      End
      Begin DSWMGR.DC_Customer mo_DC_Customer 
         Height          =   1770
         Left            =   4875
         TabIndex        =   7
         Top             =   4890
         Width           =   2565
         _extentx        =   4524
         _extenty        =   3122
      End
      Begin DSWMGR.DC_Sample mo_DC_Sample 
         Height          =   1650
         Left            =   8100
         TabIndex        =   6
         Top             =   1500
         Width           =   4845
         _extentx        =   8546
         _extenty        =   2910
      End
      Begin DSWMGR.ToolbarControl tlb_main 
         Height          =   690
         Left            =   615
         TabIndex        =   5
         Top             =   345
         Width           =   13305
         _extentx        =   23469
         _extenty        =   1217
      End
      Begin DSWMGR.ArmGrid grd_UOM 
         Height          =   1770
         Left            =   8670
         TabIndex        =   4
         Tag             =   "grd_UOM"
         Top             =   4860
         Width           =   4575
         _extentx        =   8070
         _extenty        =   3122
      End
      Begin DSWMGR.ArmGrid grd_main 
         Height          =   3300
         Left            =   660
         TabIndex        =   3
         Tag             =   "grd_main"
         Top             =   1305
         Width           =   6855
         _extentx        =   12091
         _extenty        =   5821
      End
      Begin DSWMGR.A_calocx cal_shippingDay 
         Height          =   375
         Left            =   2130
         TabIndex        =   2
         Top             =   5220
         Width           =   1845
         _extentx        =   3254
         _extenty        =   661
      End
      Begin VB.Label lbl_tranType 
         Caption         =   "#Tran. type"
         Height          =   270
         Left            =   435
         TabIndex        =   9
         Tag             =   "lbl_tranType"
         Top             =   5700
         Width           =   1290
      End
      Begin VB.Label lbl_shippingDay 
         Caption         =   "#Shipping day"
         Height          =   270
         Left            =   435
         TabIndex        =   1
         Tag             =   "lbl_shippingDay"
         Top             =   5280
         Width           =   1290
      End
   End
End
Attribute VB_Name = "DC_Sample_lst"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
'3.0.1 : introduced
'3.0.2 : email for carriers

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMiliseconds As Long)

Private Const SCREEN_NAME As String = "DC_Sample_list"
Private Const SEP = "®©"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Const COLOR_PARENT As Long = ColorConstants.vbWhite
Private Const COLOR_CHILD As Long = ColorConstants.vbCyan

Private Const C_TOOLBAR_ID As Long = 3002   '2996

#If LIVE = 1 Then
    Dim mo_Db As Object
'    Dim mo_FSO As Object
    'excel sheet object
    Private mo_Sheet As Object
    'excel application object
    Private mo_ExcelApp As Object
    Private Const xlDown = -4121 '(&HFFFFEFE7)
    Private Const xlFormatFromLeftOrAbove = 0
    Private Const xlEdgeBottom = 9
    Private Const xlContinuous = 1
    Private Const xlThick = 4
    
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
'    Dim mo_FSO As Scripting.FileSystemObject
    'excel sheet object
    Private mo_Sheet As Excel.Worksheet
    'excel application object
    Private mo_ExcelApp As Excel.Application
#End If

Dim ms_MsgInfo As Variant
Dim ms_TempPrintFile As String
Dim msa_PDFDevice() As String                   ' list of supported PDF devices separated with SEP
Private mo_MailClient As MailClient ' Interface to send Email


Private ml_U_Code As Long
Private ms_LoginName As String
Private mb_Initialized As Boolean
Private ms_Language_Code As String

Private ms_reconnectServer As String
Private ms_reconnectDB As String
Private ms_reconnectUser As String
Private ms_reconnectPassword As String
Private ms_reconnectApp As String


Private ms_TableName As String
Private ms_DC_Code As String
Private ms_DC_Name As String
Private ms_CARRIER_Code As String
Private md_shippingDay As Date

Private ms_gridRequest As String
Private ms_detailRequest As String
Private ms_summaryRequest As String
Private ms_screenConstantsRequest As String
Private ms_securityRequest As String
Private mb_eventRunning As Boolean

Private mv_gridColumns As Variant

Private mb_needRefresh As Boolean

Dim mb_AllowAdd As Boolean ' flag if the user can add new information
Dim mb_AllowUpd As Boolean ' flag if the user can update new information
Dim mb_AllowDel As Boolean ' flag if the user can delete new information
Dim mb_AllowUpdI As Boolean ' flag if the user can update new information but only if the internet flag is not checked
Dim mb_AllowDelI As Boolean ' flag if the user can delete new information but only if the internet flag is not checked
Dim mb_AllowMemo As Boolean ' flag if the user can use the Memo
Dim ms_LanguagePermission As String

Const C_ERRORRAISE = 1
Public Event quit()

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

End Enum

Public Sub SetReconnectParams(ByVal as_Server As String, ByVal as_Db As String, ByVal as_User As String, ByVal as_Password As String, ByVal as_App As String)
On Error GoTo errhandler
    ms_reconnectServer = as_Server
    ms_reconnectDB = as_Db
    ms_reconnectUser = as_User
    ms_reconnectPassword = as_Password
    ms_reconnectApp = as_App
    Exit Sub
errhandler:
    Call ErrorMessage("SetReconnectParams")
End Sub

Public Property Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property

Property Let Language_Code(AString As String)
On Error GoTo errhandler

  ms_Language_Code = AString
  Exit Property
errhandler:
  Call ErrorMessage("Language_Code.Let")
End Property

Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo errhandler

  ml_U_Code = al_U_Code
  Exit Property
errhandler:
  Call ErrorMessage("U_Code.Let")
End Property

Public Property Let LoginName(ByVal as_loginName As String)
On Error GoTo errhandler
    
    ms_LoginName = as_loginName
    Exit Property
errhandler:
    Call ErrorMessage(UserControl.Name & ".LoginName(Let)")
End Property

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

Public Property Let DC_Code(ByVal as_DC_Code As String)
    ms_DC_Code = as_DC_Code
End Property

Public Property Let DC_name(ByVal as_DC_Name As String)
    ms_DC_Name = as_DC_Name
End Property

Public Property Let ShippingDay(ByVal ad_shippingDay As Date)
    md_shippingDay = ad_shippingDay
End Property

Public Property Let DC_Carrier(ByVal as_CARRIER_Code As String)
    ms_CARRIER_Code = as_CARRIER_Code
End Property

Public Sub GridRequests(ByVal as_gridRequest As String, as_detailRequest As String, as_summaryRequest As String)
    ms_gridRequest = as_gridRequest
    ms_detailRequest = as_detailRequest
    ms_summaryRequest = as_summaryRequest
End Sub

Public Property Let ScreenConstantRequest(ByVal as_Request As String)
    ms_screenConstantsRequest = as_Request
End Property

Public Property Let SecurityRequest(ByVal as_Request As String)
    ms_securityRequest = as_Request
End Property

Public Property Let GridColumns(ByVal av_gridColumns As Variant)
    mv_gridColumns = av_gridColumns
End Property

Public Property Let TableName(ByVal as_tableName As String)
    ms_TableName = as_tableName
End Property


Public Sub Load_A_Com()
    
On Error GoTo errhandler

    If mb_Initialized Then Exit Sub
    
    mb_Initialized = True
    mb_eventRunning = True
    
    Dim lo_Control As Object
    Dim lo_ToolTip As Object
    
      For Each lo_Control In Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        Case "ARMPICKER"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        Case "TOOLBARCONTROL"
          lo_Control.Language = ms_Language_Code
'          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        Case "ARMGRID"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        Case "ARMTREEVIEW"
          Set lo_Control.ArmDb = mo_Db
          lo_Control.Language = ms_Language_Code
          Call lo_Control.Load_A_Com
        Case "ARMCHECKVIEW"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        Case "A_CALOCX"
          lo_Control.Language = ms_Language_Code
          Call lo_Control.reinit_cal
        Case "TOOLBR"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_Com
        End Select
      Next
    
    ' init toolbar
    Dim ll_Cursor As Long
    
    ll_Cursor = OpenSQLSafe(mo_Db, "exec Toolbar_sel 'DC Load Plan'")
    
    If mo_Db.Find(ll_Cursor, "Id", C_TOOLBAR_ID) < 0 Then
        Err.Raise ArmErr.InvalidValue, tlb_main.Name, "Toolbar not found in toolbars_definitions ID:" & C_TOOLBAR_ID
    End If

    Dim ls_ToolbarInfo  As String
    ls_ToolbarInfo = mo_Db.GetFields(ll_Cursor, "info")
    Call tlb_main.SetToolbarInfoStringParameters(ls_ToolbarInfo, Left(ls_ToolbarInfo, 3))
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    ' init PDF printing files
    
'    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    ms_TempPrintFile = Get_A_Config("DC_PDFPrintFilePath")
    msa_PDFDevice = Split(Get_A_Config("DC_PDFDevice"), SEP)
    
    Set mo_MailClient = New MailClient
    Set mo_MailClient.ArmDb = mo_Db
    mo_MailClient.U_Code = ml_U_Code
    mo_MailClient.Load_A_Com
    
    Call mo_MailClient.SetActiveMailBox(Trim(Get_A_Config("DC_MailBox")))
    
    grd_UOM.MultiSelect = False
    grd_UOM.AllowExcelExport = True
    grd_UOM.ExportTitles = True
    grd_UOM.FreeSelect = False
    grd_UOM.AllowSort = False
    grd_UOM.AllowPrint = True
    
    If Not grd_UOM.SetColumns(Array( _
                          Join(Array("uom_code", 900, 1, "uom_code", "#uom_code", "String"), SEP) _
                        , Join(Array("quantity", 1400, 0, "quantity", "#quantity", "INT"), SEP) _
                        )) Then
                        
        MsgBox ("Grid not initialized!")
    End If
    
    ' init grig
    grd_main.ResetGrid
    grd_main.Title = "#Transactions rows"
    grd_main.MultiSelect = False
    grd_main.AllowSort = False
    grd_main.FreeSelect = True
    grd_main.AllowExcelExport = True
'    grd_main.AllowPrint = True
    grd_main.ExportOnlyVisibleColumns = False
    grd_main.ExportTitles = True
    grd_main.WordWrap = True
    
    cbo_tt_code.FirstBlankItem = True
    cbo_tt_code.Request = "SELECT TT_code, TT_Desc FROM DC_Transaction_Type WHERE TT_Code NOT IN ('R') ORDER BY TT_Desc"
    
    mo_DC_Sample.Visible = False
    mo_DC_Customer.Visible = False
    
    Set mo_DC_Sample.ArmDb = mo_Db
    mo_DC_Sample.Language_Code = ms_Language_Code
    mo_DC_Sample.U_Code = ml_U_Code
    mo_DC_Sample.LoginName = ms_LoginName
    
    Call mo_DC_Sample.SetReconnectParams(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp)
    mo_DC_Sample.DC_Code = ms_DC_Code
    mo_DC_Sample.DC_name = ms_DC_Name
    mo_DC_Sample.DC_Carrier = ms_CARRIER_Code
    Call mo_DC_Sample.Load_A_Com
    
    Set mo_DC_Customer.ArmDb = mo_Db
    mo_DC_Customer.Language_Code = ms_Language_Code
    mo_DC_Customer.U_Code = ml_U_Code
    mo_DC_Customer.LoginName = ms_LoginName
    
    Call mo_DC_Customer.SetReconnectParams(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp)
    mo_DC_Customer.DC_Code = ms_DC_Code
    mo_DC_Customer.DC_name = ms_DC_Name
'    mo_DC_Customer.DC_Carrier = ms_CARRIER_Code
    Call mo_DC_Customer.Load_A_Com
    
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    
    mb_eventRunning = False
    Exit Sub
    
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    mb_eventRunning = False
    Call errorHandler("Load_A_COM")
    
End Sub

Private Sub RefreshMainGrid(ad_shippingDay As Date)
On Error GoTo errhandler

    Dim ls_req As String
    
    ls_req = Replace(ms_gridRequest, "$TT_CODE$", SqlStr(GetCodeFromCombo(cbo_tt_code), , True), , , vbTextCompare)
    ls_req = Replace(ls_req, "$DATE$", SqlDate(ad_shippingDay), , , vbTextCompare)
    
    If Not grd_main.Load(ls_req, False, , , False) Then
        MsgBox ("Grid not loaded!")
    End If
    
    ReDim ms_MsgInfo(1, 1)
    ms_MsgInfo(0, 0) = "$DC_NAME$"
    ms_MsgInfo(0, 1) = ms_DC_Name
    ms_MsgInfo(1, 0) = "$SHIPPING_DATE$"
    ms_MsgInfo(1, 1) = ad_shippingDay
    
    grd_main.Title = MsgText(5291, ms_Language_Code, "#Ship from $DC_NAME$ - Shipping date : $SHIPPING_DATE$", ms_MsgInfo)
    
    If ms_summaryRequest <> "" Then
        
        ls_req = Replace(ms_summaryRequest, "$TT_CODE$", SqlStr(GetCodeFromCombo(cbo_tt_code), , True), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DATE$", SqlDate(ad_shippingDay), , , vbTextCompare)
        
        If Not grd_UOM.Load(ls_req, True) Then
            MsgBox ("Grid not loaded!")
        End If
        grd_UOM.Visible = True
    Else
        grd_UOM.Visible = False
    End If

    Exit Sub
errhandler:
    Call errorHandler("RefreshMainGrid")
End Sub

Public Sub InitControl()
On Error GoTo errhandler
    
    Call grd_main.ClearGrid
    Call grd_main.ResetGrid
    
    If Not grd_main.SetColumns(mv_gridColumns) Then
        MsgBox ("Grid not initialized!")
    End If
    
    If ms_detailRequest <> "" Then
        grd_main.MasterDetailSetting = "IsMaster®©MasterDetail®©SubCount®©1®©0®©" & COLOR_PARENT & SEP & COLOR_CHILD & "®©MINUS®©PLUS®©"
    
        grd_main.MasterDetailRequest = ms_detailRequest
        grd_main.RequestLoadDetails = True
    End If
    
    Call LoadLabels(UserControl.Controls, SCREEN_NAME, ms_Language_Code)
    
    cal_shippingDay.opening_toward_top = 1
    cal_shippingDay.date_courte = Format(md_shippingDay, "dd\/mm\/yyyy")
    
    Call RefreshMainGrid(md_shippingDay)
    
    Call Permission
    
    Call tlb_main.DisplayFace("0")
    
    ' add/help button are not visible when customer_end ....
    tlb_main.ButtonVisible("A") = mb_AllowAdd
    tlb_main.ButtonVisible("B") = mb_AllowUpd Or mb_AllowUpdI
    tlb_main.ButtonVisible("C") = mb_AllowDel Or mb_AllowDelI
    tlb_main.ButtonVisible("E") = mb_AllowMemo
    
    Exit Sub
errhandler:
    Call errorHandler("InitControl")
End Sub

Public Sub Unload_A_Com()
    
On Error GoTo errhandler
    mb_Initialized = False
    
    Dim lo_Control As Object

    For Each lo_Control In Controls
      Select Case UCase(TypeName(lo_Control))
      Case "ARMCOMBOBOX"
        Call lo_Control.Unload_A_Com
      Case "ARMPICKER"
        Call lo_Control.Unload_A_Com
      Case "TOOLBARCONTROL"
        Call lo_Control.Unload_A_Com
      Case "ARMGRID"
        Call lo_Control.Unload_A_Com
      Case "ARMTREEVIEW"
        Call lo_Control.Unload_A_Com
      Case "ARMCHECKVIEW"
        Call lo_Control.Unload_A_Com
      Case "TOOLBR"
        Call lo_Control.Unload_A_Com
      End Select
    Next
    
    Call mo_DC_Sample.Unload_A_Com
    
    Call mo_DC_Customer.Unload_A_Com
    
'    Set mo_FSO = Nothing
    Call mo_MailClient.Unload_A_Com
    Set mo_MailClient = Nothing

    
    Exit Sub
    
errhandler:
    
    Call errorHandler("UnLoad_A_Com")
    
End Sub

' Load the labels of a containers
Private Sub LoadLabels(ByRef aControls As Variant, ByVal as_ScreenName As String, ByVal as_Language As String)

On Error GoTo errhandler

    Dim lIdx As Long, lCount As Long, lLabels As Long
    Dim lControl As Control

    lLabels = OpenSQLSafe(mo_Db, ms_screenConstantsRequest)
    Debug.Assert (lLabels <> 0)
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON", "OPTIONBUTTON", "MENU", "CHECKBOX"
                    If lControl.Tag <> "" Then
                        If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                        ' once translation is done and control is not in array CLEAR tag
                        If Not TypeOf lControl Is frame And Not TypeOf lControl Is Label Then
                            lControl.Tag = ""
                        End If
                    End If
                Case "ARMGRID"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                      Call lControl.LoadConstants(ptStatic, mo_Db.GetFields(lLabels, "LOCAL_TEXT"), ctColumns)
                        End If
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag & "_Title", , 1) >= 0 Then
                      lControl.Title = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                    End If
                Case "TABSTRIP"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                        Dim lsa_TextArr() As String
                        Dim ll_Index As Long
                        
                        lsa_TextArr = Split(mo_Db.GetFields(lLabels, "LOCAL_TEXT"), SEP)
                        
                        For ll_Index = LBound(lsa_TextArr, 1) To UBound(lsa_TextArr, 1)
                            lControl.Tabs(ll_Index + 1).Caption = lsa_TextArr(ll_Index)
                        Next
                    End If
                    ' once translation is done and control is not in array CLEAR tag
                    lControl.Tag = ""
                Case "MSFLEXGRID", "TOOLBARCONTROL", "TEXTBOX", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TOOLBR", "SPINBUTTON"
                    ' Do nothing !
                Case Else
                    'debug.print "LoadLabels " & UCase(TypeName(lControl))
            End Select
        Set lControl = Nothing
    Next
    
    ' SPECIAL INITIALIZATION
    ' Title
    If mo_Db.Find(lLabels, "FIELD_NAME", "title", , 1) >= 0 Then
'        Me.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
    End If

    Call mo_Db.Close(lLabels)
    lLabels = 0

    Exit Sub

errhandler:
    If lLabels > 0 Then
        Call mo_Db.Close(lLabels)
    End If
    Call errorHandler(UserControl.Name & ".LoadLabels")
End Sub



' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    Dim ls_Message As String
    
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
'    Call mo_Tools.LogMessage(mo_Db, ml_U_Code, SCREEN_NAME, ls_Message, "E")
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
'    End
End Sub


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

Private Function GetArrayValue(ByRef ao_variantArray As Variant, ByVal al_Index As Long) As Variant
    If IsArray(ao_variantArray) Then
        If UBound(ao_variantArray) <= al_Index Then
            GetArrayValue = ao_variantArray(al_Index)
        Else
            GetArrayValue = 0
        End If
    Else
        GetArrayValue = 0
    End If
End Function
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
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

Private Sub cal_shippingDay_changeposition(y As Integer)
On Error GoTo errhandler
    cal_shippingDay.ZOrder
    cal_shippingDay.Top = cal_shippingDay.Top + y
    Exit Sub
errhandler:
    Call ErrorMessage("cal_shippingDay_changeposition")
End Sub

Private Sub cal_shippingDay_datechangee()
On Error GoTo errhandler
Static ld_oldDdate As Date
    
    If ld_oldDdate = cal_shippingDay.date_dt Then Exit Sub
    
    If mb_eventRunning Then Exit Sub

    md_shippingDay = cal_shippingDay.date_dt
    
    ld_oldDdate = cal_shippingDay.date_dt
    
    Call RefreshMainGrid(md_shippingDay)
    Exit Sub
errhandler:
    Call ErrorMessage("cal_shippingDay_datechangee")
End Sub


Public Sub MoveX(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
    Call InitCtrlSize
End Sub

Private Sub InitCtrlSize()
On Error GoTo errhandler
    If UserControl.Width < 11910 Then
        Exit Sub
    End If
    
    If UserControl.Height < 5500 Then
        Exit Sub
    End If
    
    Const SPACE As Long = 60
    
    Call frm_DC_Samples_lst.Move(UserControl.ScaleLeft, UserControl.ScaleTop, UserControl.ScaleWidth, UserControl.ScaleHeight)
    
    Call tlb_main.Move(SPACE, SPACE + 70, frm_DC_Samples_lst.Width - 2 * SPACE)
    
    If ms_summaryRequest = "" Then
        Call grd_main.Move(tlb_main.Left, tlb_main.Top + tlb_main.Height, tlb_main.Width, frm_DC_Samples_lst.Height - tlb_main.Top - tlb_main.Height - cal_shippingDay.Height - SPACE)
        grd_UOM.Visible = False
    Else
        Call grd_main.Move(tlb_main.Left, tlb_main.Top + tlb_main.Height, tlb_main.Width, frm_DC_Samples_lst.Height - tlb_main.Top - tlb_main.Height - grd_UOM.Height - SPACE)
        Call grd_UOM.Move(grd_main.Left + grd_main.Width - grd_UOM.Width, grd_main.Top + grd_main.Height)
    End If
        
    cal_shippingDay.Top = grd_main.Top + grd_main.Height + SPACE
    lbl_shippingDay.Top = grd_main.Top + grd_main.Height + SPACE + cal_shippingDay.Height - lbl_shippingDay.Height
    lbl_shippingDay.Left = grd_main.Left
    cal_shippingDay.Left = lbl_shippingDay.Left + lbl_shippingDay.Width
    
    lbl_tranType.Top = lbl_shippingDay.Top + lbl_shippingDay.Height + 2 * SPACE
    lbl_tranType.Left = lbl_shippingDay.Left
    cbo_tt_code.Top = lbl_tranType.Top - SPACE
    cbo_tt_code.Left = cal_shippingDay.Left
    
    Call mo_DC_Sample.Move(UserControl.ScaleLeft, UserControl.ScaleTop, UserControl.ScaleWidth, UserControl.ScaleHeight)
    Call mo_DC_Customer.Move(UserControl.ScaleLeft, UserControl.ScaleTop, UserControl.ScaleWidth, UserControl.ScaleHeight)
    

    Exit Sub
errhandler:
    Call ErrorMessage("Form_Resize")
End Sub

Private Sub Permission()
On Error GoTo errhandler

    Dim ls_Perm As String
    Dim ll_Cursor As Long
    
    mb_AllowAdd = KO
    mb_AllowDel = KO
    mb_AllowUpd = KO
    mb_AllowDelI = KO
    mb_AllowUpdI = KO
    mb_AllowMemo = KO
    ms_LanguagePermission = ""
    
    ll_Cursor = OpenSQLSafe(mo_Db, ms_securityRequest)
    
    Do While Not mo_Db.EOF(ll_Cursor)
        ls_Perm = mo_Db.GetFields(ll_Cursor, "Action")
        If ls_Perm = "Insert" Then
            mb_AllowAdd = OK
        End If
        If ls_Perm = "Delete" Then
            mb_AllowDel = OK
        End If
        If ls_Perm = "Update" Then
            mb_AllowUpd = OK
        End If

        If ls_Perm = "UpdateI" Then
            mb_AllowUpdI = OK
        End If
        If ls_Perm = "DeleteI" Then
            mb_AllowDelI = OK
        End If
        If ls_Perm = "Memo" Then
            mb_AllowMemo = OK
        End If
        If Left(ls_Perm, 3) = "99_" Then
            ms_LanguagePermission = ms_LanguagePermission & right(ls_Perm, Len(ls_Perm) - 3)
        End If
        Call mo_Db.Next(ll_Cursor)
    Loop
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    Exit Sub
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call errorHandler("Permission()")
End Sub

Private Sub cbo_tt_code_ComboItemSelected()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub

    Call RefreshMainGrid(md_shippingDay)
    
    Exit Sub
errhandler:
    Call ErrorMessage("cbo_tt_code_ComboItemSelected")
End Sub

Private Sub grd_main_AfterExcelExport(ByVal ao_ExcelApp As Object, ByVal ao_ExcelWorkbook As Object, ByVal ao_ExcelSheet As Object)

On Error GoTo errorHandler
    If Not (ao_ExcelSheet Is Nothing) Then
    Select Case ms_TableName
    Case "DC_Sample"
        ' remove hidden fields
        If grd_main.ExportOnlyVisibleColumns = False Then
            Call GridRemoveHiddenFields(ao_ExcelSheet, Array("TRANS_Code", "MasterDetail", "IsMaster", "SubCount", "iConcurrency", "Shipment_Number", "CARRIER_Code", "Cost_Comment", "PrefLanguage", "TT_Code", "TT_Desc", "Master_TRANS_Code"))
        End If
        Call ExcelAddFormating(ao_ExcelSheet, ms_DC_Name & " - Shipping date : " & md_shippingDay, Array("L:L", "I:I"))
    End Select
    End If
    Exit Sub
errorHandler:
    Call ErrorMessage("grd_main_AfterExcelExport")
End Sub

Private Sub GridRemoveHiddenFields(ByVal ao_ExcelSheet As Object, ByVal asa_colsToDelete As Variant)
On Error GoTo errhandler

    Dim ll_i As Long
    
    For ll_i = UBound(asa_colsToDelete) To LBound(asa_colsToDelete) Step -1
        ' remove from excell colums
        ao_ExcelSheet.Columns(grd_main.Columns(asa_colsToDelete(ll_i)).ColumnIndex + 1).EntireColumn.Delete
    Next

    Exit Sub
errhandler:
    Call errorHandler("GridRemoveHiddenFields")
End Sub


Private Sub grd_main_DblClick()
On Error GoTo errhandler
    If grd_main.Col = 2 Then Exit Sub
    If mb_eventRunning Then Exit Sub
    mb_eventRunning = True
    
    LockScreen (True)

    If grd_main.SelectedLine(0, "TT_Code") = "S" Or grd_main.SelectedLine(0, "IsSampleCarrier") = 1 Then
        Call Item_ViewInit(grd_main.SelectedKey(0), grd_main.SelectedLine(0, "TT_Code"))
    Else
        Call Item_ViewInit(grd_main.SelectedKey(0), "S")            ' view as a sample shipment
    End If

    LockScreen (False)
    
    mb_eventRunning = False
    Exit Sub
errhandler:
    LockScreen (False)
    mb_eventRunning = False
    Call ErrorMessage("grd_main_DblClick")
End Sub

Private Sub grd_Main_RowLoaded(ByVal al_row As Long)
On Error GoTo errhandler

    Static ll_MasterRow As Long
    
    If al_row = 0 Then
        ll_MasterRow = 0
    End If
    
    If grd_main.Data(al_row, "IsMaster") = 1 Then
        ll_MasterRow = ll_MasterRow + 1
        If ll_MasterRow Mod 2 = 1 Then
            If grd_main.Data(al_row, "IsSampleCarrier") = 2 Then
                grd_main.LineColor(al_row) = RGB(255, 200, 200)
            Else
                grd_main.LineColor(al_row) = RGB(220, 220, 220)
            End If
        Else
            If grd_main.Data(al_row, "IsSampleCarrier") = 2 Then
                grd_main.LineColor(al_row) = RGB(255, 235, 235)
            Else
                grd_main.LineColor(al_row) = vbWhite
            End If
        End If
    Else
        If al_row > 0 Then
            grd_main.LineColor(al_row) = grd_main.LineColor(al_row - 1)
        End If
    End If
    
    Exit Sub
errhandler:
    Call ErrorMessage("grd_main_RowLoaded")
End Sub

Private Sub mo_DC_Customer_quit()
    Call mo_DC_Sample_quit
End Sub

Private Sub mo_DC_Customer_RowAdded(ByVal av_Data As Variant)
    Call mo_DC_Sample_RowAdded(av_Data)
End Sub

Private Sub mo_DC_Customer_RowDeleted(ByVal av_Key As Variant)
    Call mo_DC_Sample_RowDeleted(av_Key)
End Sub

Private Sub mo_DC_Customer_RowUpdated(ByVal av_Data As Variant)
    Call mo_DC_Sample_RowUpdated(av_Data)
End Sub

Private Sub mo_DC_Sample_quit()
    ' keep selection of possible
    Dim lv_Key As Variant
    Dim ll_col As Long
    
    If grd_main.SelectedCount > 0 Then
        lv_Key = grd_main.SelectedKey(0)
        ll_col = grd_main.Col
    End If
    
    If mb_needRefresh Then
        Call grd_main.Refresh
        mb_needRefresh = False
        
        If Not IsEmpty(lv_Key) Then
            If grd_main.SearchKey(True, lv_Key) Then
                grd_main.Col = ll_col
            End If
        End If
    End If
    
    Call Item_ListInit

End Sub

Private Sub mo_DC_Sample_RowAdded(ByVal av_Data As Variant)
On Error GoTo errhandler
    
    Call grd_main.AddLine(av_Data)
    
    If ms_summaryRequest <> "" Then
        ' refresh summary
        Call grd_UOM.Refresh
    End If
    
    mb_needRefresh = True
    
    Exit Sub
errhandler:
    Call ErrorMessage("mo_DC_Sample_RowAdded")
End Sub

Private Sub mo_DC_Sample_RowDeleted(ByVal av_Key As Variant)
On Error GoTo errhandler
    
    If grd_main.SelectedCount = 0 Then
        Call grd_main.SearchKey(True, av_Key)
    Else
        If grd_main.SelectedKey(0)(0) <> av_Key(0) Then
            Call grd_main.SearchKey(True, av_Key)
        End If
    End If
    
    Call grd_main.DeleteSelectedLines
    
    If ms_summaryRequest <> "" Then
        ' refresh summary
        Call grd_UOM.Refresh
    End If

    Exit Sub
errhandler:
    Call ErrorMessage("mo_DC_Sample_RowDeleted")
End Sub

Private Sub mo_DC_Sample_RowUpdated(ByVal av_Data As Variant)
On Error GoTo errhandler
    
    Dim ll_i As Long
    For ll_i = LBound(av_Data) To UBound(av_Data)
        grd_main.Data(grd_main.Row, ll_i) = av_Data(ll_i)
    Next
    
    If ms_summaryRequest <> "" Then
        ' refresh summary
        Call grd_UOM.Refresh
    End If
    
    mb_needRefresh = True

    Exit Sub
errhandler:
    Call ErrorMessage("mo_DC_Sample_RowUpdated")
End Sub

Private Sub tlb_main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    mb_eventRunning = True
    
    Dim lo_result As VbMsgBoxResult

    LockScreen (True)
    
    Select Case as_Role
    Case "A"
        Call Item_AddInit(0)
    Case "s"
        If grd_main.SelectedCount > 0 Then
            If grd_main.SelectedLine(0, "TT_Code") = "S" And _
               grd_main.SelectedKey(0)(0) = Val(grd_main.SelectedLine(0, "Master_TRANS_Code")) Then
                ' cannot create ssample shipment from sample shipment without customer shipment master transaction
                Call SendMessage(5301, "#Cannot add sample shipment to single sample shipment.", ms_Language_Code, vbOKOnly)
            Else
'#If LIVE = 1 Then
'                Call SendMessage(666, "#Adding sample shipment is not allowed.", ms_Language_Code, vbOKOnly)
'#Else
                If grd_main.SelectedLine(0, "IsSampleCarrier") = 2 Then
                    Call SendMessage(5302, "#Carrier for this shipment do not allow sample shipments.", ms_Language_Code, vbOKOnly)
                Else
                    Call Item_AddInit(Val(grd_main.SelectedLine(0, "Master_TRANS_Code")))
                End If
'#End If
            End If
        Else
            Call SendMessage(2404, "#Please select a row.", ms_Language_Code, vbOKOnly)
        End If
    Case "B"    ' Update, refresh detail
        If grd_main.SelectedCount > 0 Then
            If grd_main.SelectedLine(0, "TT_Code") = "S" Or grd_main.SelectedLine(0, "IsSampleCarrier") = 1 Then
                Call Item_UpdateInit(grd_main.SelectedKey(0), grd_main.SelectedLine(0, "TT_Code"))
            Else
                Call Item_ViewInit(grd_main.SelectedKey(0), "S")            ' view as a sample shipment
            End If
        Else
            Call SendMessage(2404, "#Please select a row.", ms_Language_Code, vbOKOnly)
        End If
    
    Case "C"
        If grd_main.SelectedCount > 0 Then
            Call Item_DeleteInit(grd_main.SelectedKey(0), grd_main.SelectedLine(0, "TT_Code"))
        Else
            Call SendMessage(2404, "#Please select a row.", ms_Language_Code, vbOKOnly)
        End If
    Case "D"        ' print
        
'        If grd_main.SelectedCount > 0 Then
'            ReDim ms_MsgInfo(0, 1)
'            ms_MsgInfo(0, 0) = "$CARRIER$"
'            ms_MsgInfo(0, 1) = ""   'grd_main.SelectedLine(0, "CARRIER_Name")
'            lo_result = MsgBox(MsgText(5290, ms_Language_Code, "#Press NO to print Complete list" & vbCrLf & "Press YES to print Selected Carrier ($CARRIER$) only.", ms_MsgInfo), vbQuestion Or vbYesNoCancel)
'            If lo_result = vbNo Then
'                Call DCLoadPrint("")
'            ElseIf lo_result = vbYes Then
                ' partial
                Call DCLoadPrint(ms_CARRIER_Code)   'grd_main.SelectedLine(0, "CARRIER_Code"))
'            End If
'        Else
'            Call DCLoadPrint("")
'        End If
        
    Case "F"        ' refresh grid
        Call grd_main.Refresh
        mb_needRefresh = False
        
    Case "G"        ' excell export
        If grd_main.SelectedCount > 0 Then
            ReDim ms_MsgInfo(0, 1)
            ms_MsgInfo(0, 0) = "$CARRIER$"
            ms_MsgInfo(0, 1) = ""   'grd_main.SelectedLine(0, "CARRIER_Name")
            lo_result = MsgBox(MsgText(5300, ms_Language_Code, "#Press NO to export Complete list" & vbCrLf & "Press YES to export Selected Carrier ($CARRIER$) only.", ms_MsgInfo), vbQuestion Or vbYesNoCancel)
            If lo_result = vbNo Then
                Call grd_main.ExportToExcel(True)
            ElseIf lo_result = vbYes Then
                ' partial
                Call ExportToExcel(grd_main, grd_main.ExportTitles, "CARRIER_Code", grd_main.SelectedLine(0, "CARRIER_Code"))
            End If
            
        Else
            Call grd_main.ExportToExcel(True)
        End If
        
    Case "T"
        RaiseEvent quit
    End Select

'    Call FlushMouseMessages
    LockScreen (False)
    mb_eventRunning = False
    Exit Sub
errhandler:
    LockScreen (False)
    mb_eventRunning = False
    Call ErrorMessage("tlb_main_action")
End Sub

Private Function GetEmailForCarrier(ByVal as_CARRIER_Code As String) As String
On Error GoTo errhandler
Const C_REQ As String = "SELECT CARRIER_Email FROM DC_Carrier WHERE CARRIER_Code=$CARRIER_Code$"

    GetEmailForCarrier = ""
    
    Dim ls_req As String
    Dim ll_Cursor As Long
    
    ls_req = Replace(C_REQ, "$CARRIER_Code$", SqlStr(as_CARRIER_Code, 10), , , vbTextCompare)
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If Not mo_Db.EOF(ll_Cursor) Then
        GetEmailForCarrier = mo_Db.GetFields(ll_Cursor, "CARRIER_Email")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0

    Exit Function
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call errorHandler("GetEmailForCarrier")
End Function

Private Sub Item_AddInit(ByVal al_masterTran As Long)
On Error GoTo errhandler
    gs_Action = "Add"
    
    Select Case ms_TableName
    Case "DC_Sample"
        If al_masterTran = 0 Then
            Call Launch_DC_Customer(al_masterTran)
        Else
            Call Launch_DC_Sample(al_masterTran)
        End If
    Case Else
        Debug.Assert (False)
    End Select

    Exit Sub
errhandler:
    Call errorHandler("Item_AddInit")
End Sub

Private Sub Item_UpdateInit(ByVal av_Key As Variant, ByVal as_TT_Code As String)
On Error GoTo errhandler
    
    gs_Action = "Update"

    Select Case as_TT_Code
    Case "S"        '"DC_Sample"
        Call Launch_DC_Sample(av_Key(0))
    Case "C"        '"DC_Customer"
        Call Launch_DC_Customer(av_Key(0))
    Case Else
        Debug.Assert (False)
    End Select
    
    Exit Sub
errhandler:
    Call errorHandler("Item_UpdateInit")
End Sub

Private Sub Item_DeleteInit(ByVal av_Key As Variant, ByVal as_TT_Code As String)
On Error GoTo errhandler
    gs_Action = "Delete"
    
    Select Case as_TT_Code
    Case "S"        '"DC_Sample"
        Call Launch_DC_Sample(av_Key(0))
    Case "C"        '"DC_Customer"
        Call Launch_DC_Customer(av_Key(0))
    Case Else
        Debug.Assert (False)
    End Select

    Exit Sub
errhandler:
    Call errorHandler("Item_DeleteInit")
End Sub

Private Sub Item_ViewInit(ByVal av_Key As Variant, ByVal as_TT_Code As String)
On Error GoTo errhandler
    gs_Action = "MoreInfo"
    
    Select Case as_TT_Code
    Case "S"            '"DC_Sample"
        Call Launch_DC_Sample(av_Key(0))
    Case "C"        '"DC_Customer"
        Call Launch_DC_Customer(av_Key(0))
    Case Default
        Debug.Assert (False)
    End Select

    Exit Sub
errhandler:
    Call errorHandler("Item_ViewInit")
End Sub

Private Sub Item_ListInit()
On Error GoTo errhandler
    gs_Action = "List"
    
    mo_DC_Sample.Visible = False
    mo_DC_Customer.Visible = False
    
    grd_main.Visible = True
    grd_UOM.Visible = ms_summaryRequest <> ""
    
    lbl_shippingDay.Visible = True
    cal_shippingDay.Visible = True
    
    lbl_tranType.Visible = True
    cbo_tt_code.Visible = True

    Exit Sub
errhandler:
    Call errorHandler("Item_ListInit")
End Sub



Private Function Launch_DC_Sample(ByVal al_TRANS_Code As Long) As Boolean
    On Error GoTo onError
    
    Launch_DC_Sample = False
    
    DoEvents
    
    mo_DC_Sample.ShippingDay = md_shippingDay
    mo_DC_Sample.TRANS_Code = al_TRANS_Code
    
    If gs_Action = "Add" And al_TRANS_Code <> 0 Then
        Debug.Assert (grd_main.SelectedCount > 0)
        mo_DC_Sample.CUSTN1 = grd_main.SelectedLine(0, "CUSTN1")
        mo_DC_Sample.Ship_To_Address = grd_main.SelectedLine(0, "Ship_To_Address")
        mo_DC_Sample.Ship_To_CT_Code = grd_main.SelectedLine(0, "Ship_To_CT_Code")
        mo_DC_Sample.Ship_To_Zip_Code = grd_main.SelectedLine(0, "Ship_To_Zip_Code")
    Else
        mo_DC_Sample.CUSTN1 = ""
        mo_DC_Sample.Ship_To_Address = ""
        mo_DC_Sample.Ship_To_CT_Code = ""
        mo_DC_Sample.Ship_To_Zip_Code = ""
    End If
    
    mo_DC_Sample.Visible = True    '.Show(1)
    
    grd_main.Visible = False
    grd_UOM.Visible = False
    
    lbl_shippingDay.Visible = False
    cal_shippingDay.Visible = False

    lbl_tranType.Visible = False
    cbo_tt_code.Visible = False

    Call mo_DC_Sample.InitControl
    
    Launch_DC_Sample = True
    Exit Function
onError:
    Launch_DC_Sample = False
    Call ErrorMessage("Launch_DC_Sample")
End Function


Private Function Launch_DC_Customer(ByVal al_TRANS_Code As Long) As Boolean
    On Error GoTo onError
    
    Launch_DC_Customer = False
    
    DoEvents
    
    mo_DC_Customer.ShippingDay = md_shippingDay
    mo_DC_Customer.TRANS_Code = al_TRANS_Code
    
    If gs_Action = "Add" And al_TRANS_Code <> 0 Then
        Debug.Assert (grd_main.SelectedCount > 0)
        Debug.Assert (False)
'        mo_DC_Customer.CUSTN1 = grd_main.SelectedLine(0, "CUSTN1")
'        mo_DC_Customer.Ship_To_Address = grd_main.SelectedLine(0, "Ship_To_Address")
'        mo_DC_Customer.Ship_To_CT_Code = grd_main.SelectedLine(0, "Ship_To_CT_Code")
'        mo_DC_Customer.Ship_To_Zip_Code = grd_main.SelectedLine(0, "Ship_To_Zip_Code")
    Else
'        mo_DC_Customer.CUSTN1 = ""
'        mo_DC_Customer.Ship_To_Address = ""
'        mo_DC_Customer.Ship_To_CT_Code = ""
'        mo_DC_Customer.Ship_To_Zip_Code = ""
    End If
    
    mo_DC_Customer.Visible = True    '.Show(1)
    
    grd_main.Visible = False
    grd_UOM.Visible = False
    
    lbl_shippingDay.Visible = False
    cal_shippingDay.Visible = False
    
    lbl_tranType.Visible = False
    cbo_tt_code.Visible = False
    
    Call mo_DC_Customer.InitControl
    
    Launch_DC_Customer = True
    Exit Function
onError:
    Launch_DC_Customer = False
    Call ErrorMessage("Launch_DC_Customer")
End Function



Private Sub DCLoadPrint(ByVal as_CARRIER_Code As String)

On Error GoTo errhandler

    Dim ls_req As String
    Dim llp_pos() As TCell
    
    Select Case ms_TableName
    Case "DC_Sample"
        
        Call InitPrinter2(PrinterObjectConstants.vbPRORLandscape)
        Printer.ScaleMode = ScaleModeConstants.vbCharacters
        Call RecalcMargins(vbCharacters)
        
        ls_req = "EXEC DC_ShipPrint4_SAMPLE " & SqlStr(ms_DC_Code, 4) & ", " & SqlDate(md_shippingDay) & ", " & SqlStr(as_CARRIER_Code, 10, True)
        
        Call DCCustomerLayout(llp_pos)
    
    Case Else
        MsgBox ("Print not supported")
        Exit Sub
    End Select
    
    If ls_req <> "" Then
        Dim ll_Cursor As Long
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)

        Call DCShipPrint2(mo_Db, ll_Cursor, llp_pos, "SHIPMENT LIST OF " & UCase(ms_DC_Name) & " PLANT", "Shipping date : " & md_shippingDay)
        
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    
    End If

    Exit Sub

errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call errorHandler("DCLoadPrint")
End Sub

Function RTrimInvisibleChars(ByVal as_str As String) As String
    Dim ll_char As Integer
    
    RTrimInvisibleChars = ""
    
    as_str = RTrim(as_str)
    
    If Len(as_str) = 0 Then
        Exit Function
    End If
    
    ll_char = Asc(Mid(as_str, Len(as_str), 1))
    
    While Len(as_str) > 0 And (ll_char = 10 Or ll_char = 13)
        as_str = Left(as_str, Len(as_str) - 1)
        If Len(as_str) > 0 Then
            ll_char = Asc(Mid(as_str, Len(as_str), 1))
        End If
    Wend
    
    RTrimInvisibleChars = as_str

End Function

Private Sub LockScreen(ByVal ab_lock As Boolean)

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

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

Private Function MsgText(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String
On Error GoTo errhandler

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

    MsgText = ""
    
    Dim lRequest As String
    lRequest = Replace(DB_REQ, "$id$", aID, , , vbTextCompare)
    lRequest = Replace(lRequest, "$lang$", aLang, , , vbTextCompare)
    Dim lData As Long
    
    lData = OpenSQLSafe(mo_Db, lRequest)
    
    Dim lBuffer As String
    lBuffer = mo_Db.GetFields(lData, "message_text")
    mo_Db.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault
    
    Dim li_idx As Integer
    If Not IsMissing(aInfo) Then
        For li_idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_idx, 0), aInfo(li_idx, 1), , , vbTextCompare)
        Next li_idx
    End If
    
    
    MsgText = lBuffer
    Exit Function
errhandler:
    mo_Db.Close (lData)
    Call MsgBox("Connection failure accessing message information.")
    MsgText = aDefault
End Function

' *********************************** copy of grid export functionality *******************************************
'export grid content into MS Excel application
Private Function ExportToExcel(ByRef ao_grid As ArmGrid, ab_ExportTitles As Boolean, ByVal as_filterField As String, ByVal as_filterValue As String)
Dim lv_Columns As Variant
Dim ll_RowIndex As Long
Dim lb_Result As Boolean

On Error GoTo errorHandler
  
    lb_Result = False
    If ao_grid.Cols > 0 Then
      
        lv_Columns = GetColumnIndexes(ao_grid, ao_grid.ExportOnlyVisibleColumns)
            
        Dim ll_exportRow As Long
        If ExportOpen(ao_grid, lv_Columns, ab_ExportTitles, ll_exportRow) Then
         
          lb_Result = True
          For ll_RowIndex = 0 To ao_grid.Rows - 1
            If ao_grid.Data(ll_RowIndex, as_filterField) = as_filterValue Then
                If Not ExportRow(ao_grid, lv_Columns, ll_RowIndex, ll_exportRow) Then
                  lb_Result = False
                  Exit For
                End If
            End If
          Next
        Else
          lb_Result = False
        End If
        
        Call grd_main_AfterExcelExport(mo_ExcelApp, Nothing, mo_Sheet)
        
'        Call ExcelAddFormating(mo_Sheet, ms_DC_Name & " - Shipping date : " & md_shippingDay)
        
        Call ExportClose
    End If
    
    ExportToExcel = lb_Result

    Exit Function
errorHandler:
    Call ExportClose
    ExportToExcel = False
    Call errorHandler("ExportToExcel")
End Function

Private Function ExportRow(ByRef ao_grid As ArmGrid, ByVal av_columns As Variant, ByVal al_RowIndex As Long, ByRef al_exportRow As Long) As Boolean
Dim ll_col As Long, ll_ColCount As Long
Dim lv_Data As Variant, lv_Value As Variant
Dim lo_Column As ArmColumn

On Error GoTo errorHandler
  If Not IsArray(av_columns) Then Exit Function
  
  If UBound(av_columns) > 0 Then
    ll_ColCount = UBound(av_columns) + 1
    
    ReDim lv_Data(ll_ColCount - 1)
    
    For ll_col = 0 To ll_ColCount - 1
      Set lo_Column = ao_grid.Columns(av_columns(ll_col))
      
      lv_Value = lo_Column.GetData(al_RowIndex)
      Select Case lo_Column.FieldType
      Case DBTYPE_STR, DBTYPE_BSTR
            lv_Data(ll_col) = "'" & Left(lv_Value, 910)
      Case DBTYPE_DATE
          If lv_Value = 0 Then lv_Value = Empty
          lv_Data(ll_col) = lv_Value
      Case Else
          lv_Data(ll_col) = lv_Value
      End Select
    Next
    ExportRow = ExportArray(al_exportRow, lv_Data)
  End If
  Exit Function
errorHandler:
    ExportRow = False
    Call errorHandler("ExportRow")
End Function

Private Function ExportArray(ByRef al_currentRow As Long, av_Data As Variant) As Boolean
Dim ll_col As Long


On Error GoTo errorHandler
  mo_Sheet.Range(mo_Sheet.Cells(al_currentRow + 1, 1), _
                 mo_Sheet.Cells(al_currentRow + 1, UBound(av_Data) + 1)) = av_Data
  
  al_currentRow = al_currentRow + 1
  ExportArray = True
  Exit Function
errorHandler:
    ExportArray = False
    Call errorHandler("ExportArray")
End Function

Private Function ExportOpen(ByRef ao_grid As ArmGrid, av_columns As Variant, ByVal ab_ExportTitles As Boolean, ByRef al_currentRow As Long) As Boolean
Dim lb_Result As Boolean
Dim ll_Idx As Long

On Error GoTo errorHandler
  
  lb_Result = False
  
  If NewExcelDocument Then
    mo_ExcelApp.ScreenUpdating = False
    mo_ExcelApp.Cursor = 2
    Set mo_Sheet = mo_ExcelApp.ActiveSheet
    If Not (mo_Sheet Is Nothing) Then
      If ab_ExportTitles Then
        If IsArray(av_columns) Then
            For ll_Idx = 0 To UBound(av_columns)
              mo_Sheet.Cells(1, ll_Idx + 1) = "'" & ao_grid.Columns(av_columns(ll_Idx)).Title
            Next
          al_currentRow = 1
          lb_Result = True
        End If
      Else
        al_currentRow = 0
        lb_Result = True
      End If
    End If
  End If
  
  ExportOpen = lb_Result

  Exit Function
errorHandler:
    ExportOpen = False
    Call errorHandler("ExportOpen")
End Function

Private Function ExportClose() As Boolean

On Error GoTo errorHandler
#If CompDebugGR Then
  Call mo_Trace.WriteTraceProc(True, "ArmGrid:ExportClose")
#End If
  
  ExportClose = False
  If Not (mo_ExcelApp Is Nothing) Then
    mo_ExcelApp.ScreenUpdating = True
    mo_ExcelApp.Cursor = -4143
    Set mo_Sheet = Nothing
    Set mo_ExcelApp = Nothing
    ExportClose = True
  End If

#If CompDebugGR Then
  Call mo_Trace.WriteTraceProc(False, "ArmGrid:ExportClose")
#End If
  Exit Function
errorHandler:
    ExportClose = False
    Call errorHandler("ExportClose")
End Function

Private Function NewExcelDocument() As Boolean
Dim lo_WorkBook As Object
Dim lo_WorkSheet As Object

    NewExcelDocument = False
    
    On Error GoTo Err_NotLoaded
    
    Set mo_ExcelApp = GetObject(, "Excel.Application")
    
    If mo_ExcelApp Is Nothing Then
        Set mo_ExcelApp = CreateObject("Excel.Application")
    End If
    
    If mo_ExcelApp Is Nothing Then GoTo errorHandler
    
    On Error GoTo errorHandler
    
    Set lo_WorkBook = mo_ExcelApp.Workbooks.add
    Set lo_WorkSheet = lo_WorkBook.Worksheets(1)
    mo_ExcelApp.Application.Visible = True
    lo_WorkSheet.Application.Visible = True

    NewExcelDocument = True

    Exit Function
    
Err_NotLoaded:
    If Err.Number = 429 Then
        Resume Next
    End If
    
errorHandler:
    Set mo_ExcelApp = Nothing
    Call errorHandler("NewExcelDocument")
End Function

Private Sub ExcelAddFormating(ByVal ao_ExcelSheet As Object, ByVal as_title As String, ByVal asa_invisibleCols As Variant)
Dim lv_Criteria As Variant
Dim ll_Index As Long

On Error GoTo errorHandler
 If Not (ao_ExcelSheet Is Nothing) Then
 
    ' insert one line at the top
    Call ao_ExcelSheet.Range("1:1").Insert(xlDown, xlFormatFromLeftOrAbove)
    
    ' columns to be autofit
    ao_ExcelSheet.UsedRange.Columns.EntireColumn.AutoFit

    Dim ll_visible_col As Long
    
    ll_visible_col = 1
    
    Dim ll_i As Long
    For ll_i = LBound(asa_invisibleCols) To UBound(asa_invisibleCols)
        ' column A to be zero width
        ao_ExcelSheet.Columns(asa_invisibleCols(ll_i)).ColumnWidth = 0
    Next
    
    ' row 1 header into
    ao_ExcelSheet.Cells(1, ll_visible_col).value = as_title
    ao_ExcelSheet.Cells(1, ll_visible_col).Font.Size = 14
    ao_ExcelSheet.Cells(1, ll_visible_col).Font.Bold = True
    
    With ao_ExcelSheet.UsedRange.Rows(2)
        .Font.Italic = True
        .Font.Bold = True
        .Interior.Color = 15395562
    End With
    
    Dim ls_oldCell As String
    ls_oldCell = "z"
    
    Dim ll_Color As Long
    ll_Color = 16777215
    
    For ll_i = 3 To ao_ExcelSheet.UsedRange.Rows.Count
        If ls_oldCell <> Mid(ao_ExcelSheet.UsedRange.Cells(ll_i, 1).Text, 1, Len(ls_oldCell)) Then
            ls_oldCell = Split(ao_ExcelSheet.UsedRange.Cells(ll_i, 1).Text, "/")(0)
            If ll_Color = 16777215 Then
                ll_Color = 13431551
            Else
                ll_Color = 16777215
            End If
        End If
        
        With ao_ExcelSheet.UsedRange.Rows(ll_i)
            .Interior.Color = ll_Color
        End With
        
    Next
    
'    Dim a As Excel.Worksheet
    With ao_ExcelSheet.UsedRange.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    
    
    
  End If
  Exit Sub
errorHandler:
    Call errorHandler("ExcelAddFormating")

End Sub

Private Function GetColumnIndexes(ByRef ao_grid As ArmGrid, ByVal ab_VisibleOnly As Boolean) As Variant
Dim lv_Columns As Variant
Dim ll_Index As Long
Dim ll_Pos As Long

On Error GoTo errorHandler
  
  If ao_grid.Cols > 0 Then
    ReDim lv_Columns(ao_grid.Cols - 1)
    ll_Pos = 0
    For ll_Index = 0 To UBound(lv_Columns)
        If ab_VisibleOnly Then
            If ao_grid.Columns(ll_Index).Width > 0 Then
                lv_Columns(ll_Pos) = ll_Index
                ll_Pos = ll_Pos + 1
            End If
        Else
            lv_Columns(ll_Pos) = ll_Index
            ll_Pos = ll_Pos + 1
        End If
    Next
    If ll_Pos > 0 Then
        ReDim Preserve lv_Columns(ll_Pos - 1)
        GetColumnIndexes = lv_Columns
        Exit Function
    End If
  End If
  GetColumnIndexes = Empty
  Exit Function
errorHandler:
    GetColumnIndexes = Empty
    Call errorHandler("GetColumnIndexes")
End Function

' *********************************** copy of grid export functionality *******************************************

Private Function SqlStr(ByVal av_Data As Variant, Optional ByVal al_MaxLength As Long = 0, Optional ByVal ab_emptyAsNULL As Boolean = False) As String

    If IsNull(av_Data) Then av_Data = ""
    If ab_emptyAsNULL And av_Data = "" Then
        SqlStr = "NULL"
        Exit Function
    End If
    If al_MaxLength = 0 Then
        SqlStr = "'" & Replace(CStr(av_Data), "'", "''") & "'"
    Else
        SqlStr = "'" & Replace(Left(CStr(av_Data), al_MaxLength), "'", "''") & "'"
    End If
End Function

Private Function SqlDate(ByVal av_Data As Variant) As String
On Error GoTo errhandler

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

'Private Sub EmailDCPrint(ByVal as_CARRIER_Code As String, ByVal as_CARRIER_Name As String, ByVal as_EMail As String, ByVal as_emlLanguage As String)
'Dim lb_EmailOK As Boolean
'On Error GoTo errhandler
    
    ' check existance of PDF printer
'    Dim ll_Idx As Long
'    Dim lo_printer As Printer
'    Set lo_printer = Nothing
'    For ll_Idx = 0 To Printers.Count - 1
'        If IsSupportedPDFPrinter(Printers(ll_Idx).DeviceName) Then
'            Set lo_printer = Printers(ll_Idx)
'            Exit For
'        End If
'    Next ll_Idx
    
    
'    If lo_printer Is Nothing Then
'        Call LockScreen(False)
'        Call MsgBox(MsgText(5330, ms_Language_Code, "#PDF printer not found. Printing canceled!"))
'        Call LockScreen(True)
'        Exit Sub
'    End If
    
'    Do
'        Call LockScreen(False)
'        as_EMail = InputBox(MsgText(5320, ms_Language_Code, "#Do you want to send printing with Mail to"), , as_EMail)
'        Call LockScreen(True)
'        If as_EMail = "" Then
'            Exit Sub
'        End If
'        ' check validity of e_mail address entered
'        lb_EmailOK = IsEmailValid(as_EMail)
'        If Not lb_EmailOK Then
'            ' M150
'            Call LockScreen(False)
'            Call MsgBox(MsgText(8150, ms_Language_Code, "#M150 - This email address does not appear to be the correct format (User@domain)."))
'            Call LockScreen(True)
'            lb_EmailOK = False
'        Else
'            ' check the length of e-mail address entered
'            lb_EmailOK = (Len(as_EMail) <= 80)
'            If Not lb_EmailOK Then
'                ' M730
'                Call LockScreen(False)
'                Call MsgBox(MsgText(8730, ms_Language_Code, "#M730 - Length of address cannot be more than 80 characters."))
'                Call LockScreen(True)
'            End If
'        End If
'
'    Loop Until lb_EmailOK
    
    ' generate attachement
'    Dim ls_oldDeviceName  As String
'    ls_oldDeviceName = Printer.DeviceName
    
'    Set Printer = lo_printer
'    If mo_FSO.FileExists(ms_TempPrintFile) Then
'        Call mo_FSO.DeleteFile(ms_TempPrintFile, True)
'    End If
'
'    Call DCLoadPrint(as_CARRIER_Code)
    
    ' check existance of printed file
'    Dim ld_StartTime As Date
'    ld_StartTime = Now
'    Do While Not mo_FSO.FileExists(ms_TempPrintFile)
'        DoEvents
'        Call Sleep(100)
'        ' let's give 2 minutes to give up waiting.
'        If DateDiff("n", ld_StartTime, Now) > 2 Then
'            Exit Do
'        End If
'    Loop
    
'    If Not mo_FSO.FileExists(ms_TempPrintFile) Then
'        Call SetPrinterByName(ls_oldDeviceName)
        
'        ReDim ms_MsgInfo(1, 1)
'        ms_MsgInfo(0, 0) = "$printer$"
'        ms_MsgInfo(0, 1) = lo_printer.DeviceName
'        ms_MsgInfo(1, 0) = "$file$"
'        ms_MsgInfo(1, 1) = ms_TempPrintFile
'        Call MsgBox(MsgText(5340, ms_Language_Code, "#PDF printer ($printer$) is probably not setup to print into $file$! Please change the settings to print into this file.", ms_MsgInfo), vbCritical)
'        Exit Sub
'    End If

    ' copy the file
    
'    Call mo_FSO.CopyFile(ms_TempPrintFile, "Cache\DC_Temp\DC_Print.pdf", True)
    
    ' recover the printer
'    Call SetPrinterByName(ls_oldDeviceName)
    
    ' send email
'    Dim ll_IdxEmail As Long
    
'    ReDim ms_MsgInfo(2, 1)
'    ms_MsgInfo(0, 0) = "$TITLE$"
'    ms_MsgInfo(0, 1) = grd_main.Title
'    ms_MsgInfo(1, 0) = "$CARRIER$"
'    ms_MsgInfo(1, 1) = as_CARRIER_Name
'    ms_MsgInfo(2, 0) = "$SENDER$"
'    ms_MsgInfo(2, 1) = ms_LoginName
    
'    Dim ls_Subject As String
'    ls_Subject = MsgText(Get_A_Config("DC_PRINT_EML_SUBJECT"), as_emlLanguage, "Subject '$TITLE$' of email", ms_MsgInfo)
    
'    Dim ls_Body As String
'    ls_Body = MsgText(Get_A_Config("DC_PRINT_EML_BODY"), as_emlLanguage, "Body of '$TITLE$' for $CARRIER$ email from $SENDER$", ms_MsgInfo)
    
    
'    ll_IdxEmail = mo_MailClient.AddEmail(ls_Subject, ls_Body, False, Now, "")
'    Call mo_MailClient.AddEmailAddress(ll_IdxEmail, as_EMail, etEmailTo)
    
'    Dim ls_currentUserEmail As String
'    ls_currentUserEmail = mo_MailClient.GetAddressForUCode(ml_U_code)
'    If ls_currentUserEmail <> "" Then
'        Call mo_MailClient.AddEmailAddress(ll_IdxEmail, ls_currentUserEmail, etEmailCopyTo)
'    End If
    
'    Call mo_MailClient.AddAttachment(ll_IdxEmail, "Cache\DC_Temp", "DC_Print.pdf")
'    Call mo_MailClient.SendEmail(ll_IdxEmail)
    
'    Call mo_MailClient.ClearData

    
'    Call LockScreen(False)
'    Call MsgBox(MsgText(5350, ms_Language_Code, "#Email was sent succesfully."), vbInformation)
'    Call LockScreen(True)

'    Exit Sub
'errhandler:
'    Call ErrorHandler("EmailDCPrint")
'End Sub

Private Sub SetPrinterByName(ByVal as_deviceName As String)
On Error GoTo errhandler
    Dim ll_Idx As Long
    For ll_Idx = 0 To Printers.Count - 1
        If Printers(ll_Idx).DeviceName = as_deviceName Then
            Set Printer = Printers(ll_Idx)
            Exit For
        End If
    Next ll_Idx
    Exit Sub
errhandler:
    Call errorHandler("SetPrinterByName")
End Sub

Private Function IsSupportedPDFPrinter(ByVal as_printerName As String) As Boolean
On Error GoTo errhandler

    IsSupportedPDFPrinter = False
    
    Dim ll_i As Long
    For ll_i = LBound(msa_PDFDevice) To UBound(msa_PDFDevice)
        If msa_PDFDevice(ll_i) = as_printerName Then
            IsSupportedPDFPrinter = True
            Exit Function
        End If
    Next

    Exit Function
errhandler:
    Call errorHandler("IsSupportedPDFPrinter")
End Function

Private Function IsEmailValid(ByVal as_EmailText As String) As Boolean
On Error GoTo errhandler

Dim ls_Email
Dim las_Email() As String
Dim ll_Index As Long

IsEmailValid = True

  If Trim(as_EmailText) <> "" Then
    las_Email = Split(Replace(Trim(as_EmailText), ";", ","), ",")
    For ll_Index = 0 To UBound(las_Email)
      ls_Email = Trim(las_Email(ll_Index))
      If InStr(1, ls_Email, "/") Then
        If CheckLotusEmailFormat(ls_Email) = False Then
            IsEmailValid = False
            Exit Function
        End If
      Else
        If CheckNormalEmailFormat(ls_Email) = False Then
            IsEmailValid = False
            Exit Function
        End If
      End If
    Next
  End If
  Exit Function

errhandler:
    Call errorHandler("IsEmailValid")
End Function

Private Function CheckLotusEmailFormat(ByVal as_EmailCheck As String) As Boolean
On Error GoTo errhandler

Dim lb_CK As Boolean
Dim ll_Index As Long
Dim ll_Index2 As Long
Dim las_EmailParts() As String
Dim ls_EmailPart As String
Const sInvalidChars As String = "@"

    lb_CK = True
    
    las_EmailParts = Split(Trim(as_EmailCheck), "/")
    
    If UBound(las_EmailParts) < 2 Then
        lb_CK = False
        GoTo ExitFunction
    End If
    
    For ll_Index = 0 To UBound(las_EmailParts)
        ls_EmailPart = Trim(las_EmailParts(ll_Index))
        If Trim(ls_EmailPart) = "" Then
            lb_CK = False
            GoTo ExitFunction
        End If
        
        ' Check for invalid characters.
        If Len(as_EmailCheck) > Len(sInvalidChars) Then
            For ll_Index2 = 1 To Len(sInvalidChars)
                If InStr(as_EmailCheck, Mid(sInvalidChars, ll_Index2, 1)) > 0 Then
                    lb_CK = False
                    GoTo ExitFunction
                End If
            Next
        Else
            For ll_Index2 = 1 To Len(as_EmailCheck)
                If InStr(sInvalidChars, Mid(as_EmailCheck, ll_Index2, 1)) > 0 Then
                    lb_CK = False
                    GoTo ExitFunction
                End If
            Next
        End If
    
    Next
    
ExitFunction:
    CheckLotusEmailFormat = lb_CK
    Exit Function

errhandler:
    CheckLotusEmailFormat = False
    Call errorHandler("CheckLotusEmailFormat")

End Function

Private Function CheckNormalEmailFormat(ByVal as_EmailCheck As String) As Boolean
On Error GoTo errhandler

Dim lb_CK As Boolean
Dim ls_DomainType As String
Const sInvalidChars As String = "!#$%^&*()=+{}[]|\;:'/?>,< "
Dim ll_Index As Long

    lb_CK = Not InStr(1, as_EmailCheck, Chr(34)) > 0 'Check to see if there is a double quote
    If Not lb_CK Then GoTo ExitFunction
    
    lb_CK = Not InStr(1, as_EmailCheck, "..") > 0 'Check to see if there are consecutive dots
    If Not lb_CK Then GoTo ExitFunction
    
    ' Check for invalid characters.
    If Len(as_EmailCheck) > Len(sInvalidChars) Then
        For ll_Index = 1 To Len(sInvalidChars)
            If InStr(as_EmailCheck, Mid(sInvalidChars, ll_Index, 1)) > 0 Then
                lb_CK = False
                GoTo ExitFunction
            End If
        Next
    Else
        For ll_Index = 1 To Len(as_EmailCheck)
            If InStr(sInvalidChars, Mid(as_EmailCheck, ll_Index, 1)) > 0 Then
                lb_CK = False
                GoTo ExitFunction
            End If
        Next
    End If
    
    If InStr(1, as_EmailCheck, "@") > 1 Then 'Check for an @ symbol
        lb_CK = Len(Left(as_EmailCheck, InStr(1, as_EmailCheck, "@") - 1)) > 0
        Else
        lb_CK = False
        End If
    If Not lb_CK Then GoTo ExitFunction
    
    as_EmailCheck = right(as_EmailCheck, Len(as_EmailCheck) - InStr(1, as_EmailCheck, "@"))
    lb_CK = Not InStr(1, as_EmailCheck, "@") > 0 'Check to see if there are too many @'s
    If Not lb_CK Then GoTo ExitFunction
    
    If InStr(1, as_EmailCheck, ".") = 0 Then
        lb_CK = False
        GoTo ExitFunction
    End If

    ls_DomainType = right(as_EmailCheck, Len(as_EmailCheck) - InStr(1, as_EmailCheck, "."))
    lb_CK = Len(ls_DomainType) > 0 And InStr(1, as_EmailCheck, ".") < Len(as_EmailCheck)
    If Not lb_CK Then GoTo ExitFunction
    
    as_EmailCheck = Left(as_EmailCheck, Len(as_EmailCheck) - Len(ls_DomainType) - 1)
    Do Until InStr(1, as_EmailCheck, ".") <= 1
        If Len(as_EmailCheck) >= InStr(1, as_EmailCheck, ".") Then
            as_EmailCheck = Left(as_EmailCheck, Len(as_EmailCheck) - (InStr(1, as_EmailCheck, ".") - 1))
        Else
            lb_CK = False
            GoTo ExitFunction
        End If
    Loop
    If as_EmailCheck = "." Or Len(as_EmailCheck) = 0 Then lb_CK = False
    
ExitFunction:
    CheckNormalEmailFormat = lb_CK
    Exit Function
    
errhandler:
    CheckNormalEmailFormat = False
    Call errorHandler("CheckNormalEmailFormat")
End Function

Private Function Get_A_Config(ByVal TheKey As String) As String
On Error GoTo Get_A_Config_er
Dim curs As Long
Dim ls_req As String

    Get_A_Config = ""
    ls_req = "select cfg_value from A_config where cfg_Key ='" & UCase(TheKey) & "'"
    curs = OpenSQLSafe(mo_Db, ls_req, 1)
    
    Get_A_Config = mo_Db.GetFields(curs, 0)
    Call mo_Db.Close(curs)
    curs = 0
    
Exit Function
Get_A_Config_er:
    If curs > 0 Then
        Call mo_Db.Close(curs)
        curs = 0
    End If
    Call errorHandler("Get_A_Config()")
End Function

Private Function HaveRight(ByVal as_RightKey As String) As Boolean

    Dim mb_Ok As Boolean
    
    mb_Ok = False
    Dim lc_Data As Long
    lc_Data = mo_Db.OpenSQL("SELECT CFG_Value FROM A_Config WHERE CFG_Key = '" & as_RightKey & "'")
    Dim lv_ArrUpd As Variant
    lv_ArrUpd = Split(mo_Db.GetFields(lc_Data, 0), SEP, , vbTextCompare)
    Call mo_Db.Close(lc_Data)
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(lv_ArrUpd)
    For ll_Idx = 0 To ll_Count
        If lv_ArrUpd(ll_Idx) = ml_U_Code Then
            mb_Ok = True
            Exit For
        End If
    Next
    HaveRight = mb_Ok

End Function

