VERSION 5.00
Begin VB.UserControl ArmBusCard 
   ClientHeight    =   9630
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8700
   ScaleHeight     =   9630
   ScaleWidth      =   8700
   Begin VB.TextBox txt_ID 
      Height          =   375
      Left            =   5040
      Locked          =   -1  'True
      TabIndex        =   16
      Top             =   1800
      Width           =   855
   End
   Begin VB.TextBox txt_Slogan 
      Height          =   375
      Left            =   1680
      MaxLength       =   80
      MultiLine       =   -1  'True
      TabIndex        =   13
      Top             =   840
      Width           =   6855
   End
   Begin Project1.ArmHTMLEdit HTML 
      Height          =   1575
      Index           =   0
      Left            =   120
      TabIndex        =   9
      Top             =   2880
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   2778
   End
   Begin VB.CheckBox chkPictureName 
      Caption         =   "#Show picture name"
      Height          =   255
      Left            =   3600
      TabIndex        =   0
      Top             =   1440
      Width           =   3735
   End
   Begin VB.CheckBox chkInternet 
      Caption         =   "#Internet"
      Height          =   375
      Left            =   3600
      TabIndex        =   8
      Top             =   2400
      Width           =   3735
   End
   Begin Project1.ArmPict pic 
      Height          =   1455
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   1320
      Width           =   3375
      _ExtentX        =   5953
      _ExtentY        =   2566
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   1
      Left            =   6840
      TabIndex        =   2
      Top             =   2880
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   2
      Left            =   120
      TabIndex        =   3
      Top             =   4560
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   3
      Left            =   6840
      TabIndex        =   4
      Top             =   6240
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   4
      Left            =   1463
      TabIndex        =   5
      Top             =   7920
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   5
      Left            =   3503
      TabIndex        =   6
      Top             =   7920
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmPict pic 
      Height          =   1575
      Index           =   6
      Left            =   5543
      TabIndex        =   7
      Top             =   7920
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   2778
   End
   Begin Project1.ArmHTMLEdit HTML 
      Height          =   1575
      Index           =   1
      Left            =   1920
      TabIndex        =   10
      Top             =   4560
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   2778
   End
   Begin Project1.ArmHTMLEdit HTML 
      Height          =   1575
      Index           =   2
      Left            =   120
      TabIndex        =   11
      Top             =   6240
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   2778
   End
   Begin Project1.ToolBr pbitem 
      Height          =   615
      Left            =   120
      TabIndex        =   12
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   1085
   End
   Begin VB.Label lbl_BusinessCard 
      Caption         =   "#Business Card ID"
      Height          =   375
      Left            =   3600
      TabIndex        =   15
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label lbl_Slogan 
      Caption         =   "#Slogan :"
      Height          =   375
      Left            =   120
      TabIndex        =   14
      Top             =   840
      Width           =   1455
   End
End
Attribute VB_Name = "ArmBusCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

' _____ GENERAL

' Give the two status of a database flag
Private Const C_DB_FLAG_ON As String = "X"
Private Const C_DB_FLAG_OFF As String = ""

' Standard separator of serialized string
Private Const C_SEP As String = "®©"

Private Const C_ANCHOR = "pic"


' _____ ABOUT BUSINESS CARD DATA

' Reference to the template defined in the table CM_Templates
Private Const C_TEMPLATE_BUSINESS_CARD_CONTRACTOR As Byte = 1
                                                             
' Indicates the type of external link of a customer, defined in the constraint of CM_ArticlesLinks
Private Const C_LINK_CUSTOMER As String = "U"


' Shape of pictures
Private Const C_PCT_SHAPE_VERTICAL = "V"        ' Height > Width
Private Const C_PCT_SHAPE_HORIZONTAL = "H"      ' Height < Width
Private Const C_PCT_SHAPE_SQUARE = "S"          ' Height = Width
Private Const C_PCT_SHAPE_RECT = "R"            ' Height <> Width
Private Const C_PCT_SHAPE_UNKNOWN = "A"         ' Height ? Width, assumes no constraints

' Indicates the type of objets included in an article, defined in the constraint of CM_Objects
Private Const C_OBJECT_PICTURE As String = "P"
Private Const C_OBJECT_LTEXT As String = "L"

' Indicates which HTML text is filled automatically from capture
Private Const C_HTML_CUSTOMERINFO As Byte = 1

Private Const C_HTML_DEFAULTSTYLE As String = "<div class=""textecourantnoir""></div>"

Private Const C_FILENAME_PREF As String = "BCC_"

' Tables names
Private Const C_DB_TABLE_CM_ARTICLES As String = "CM_Articles"
Private Const C_DB_TABLE_CM_OBJECTS As String = "CM_Objects"
Private Const C_DB_TABLE_CM_PCT As String = "CM_RessourcesFiles"
Private Const C_DB_TABLE_CM_LTEXT As String = "CM_LongText"
Private Const C_DDB_TABLE_CM_ARTICLESLINKS As String = "CM_ArticlesLinks"

' _____ ABOUT LABELS
Private Const C_LBL_DEFAULT As String = "#Internet Flag®©#Picture®©#Tel®©#Fax®©#Web site®©#Email®©#Show picture name®©#Slogan®©#Business card ID®©#Hyperlink®©#Ok®©#Cancel"

' Labels index
Private Const C_LBL_IDX_INTERNET_FLAG As Long = 0
Private Const C_LBL_IDX_PICTURE As Long = 1
Private Const C_LBL_IDX_FAX As Long = 2
Private Const C_LBL_IDX_TEL As Long = 3
Private Const C_LBL_IDX_WEB As Long = 4
Private Const C_LBL_IDX_EMAIL As Long = 5
Private Const C_LBL_IDX_SHOWPCTNAME As Long = 6
Private Const C_LBL_IDX_SLOGAN As Long = 7
Private Const C_LBL_IDX_ID As Long = 8
Private Const C_LBL_IDX_HYPERLINK As Long = 9
Private Const C_LBL_IDX_OK As Long = 10
Private Const C_LBL_IDX_CANCEL As Long = 11


' _____ ABOUT ERRORS

' The following error message is not translated because happenned generally when connection
' to db is or will be broken.
' Notice : A fatal error always terminate the application
Private Const C_ERR_MSG_FATAL_ERROR As String = "#A fatal error occured. The application will be terminated. Please report error to IT."


Private Const C_ERR_OFFSET = 5000   ' This constant is used into errors handler
                                    ' to determines if an error is a process error or
                                    ' a runtime error


' Occured when the application failed to get a new id
Private Const C_ERR_SERVEURBUSY As Long = 944
Private Const C_ERR_SERVEURBUSY_MSG As String = "#Database serveur is busy. Please, wait a moment and try again"

' Occured when a SQL request failed
Private Const C_ERR_DB_FAULT As Long = 924
Private Const C_ERR_DB_FAULT_MSG As String = "#The following database access error occurred : "

' Occured when we don't really know what's happenned
Private Const C_ERR_UNKNOWN As Long = 910
Private Const C_ERR_UNKNOWN_MSG As String = "#Unexpected error. Please contact IT and report error message"

' Occured when the cleaning operation are not complete
Private Const C_ERR_DB_DELETEUNCOMPLETE As Long = 943
Private Const C_ERR_DB_DELETEUNCOMPLETE_MSG As String = "#Some data are not properly deleted. Please, contact IT support"

' Occured when it's a ressources file download failed
Private Const C_ERR_DOWNLOADFILE  As Long = 945
Private Const C_ERR_DOWNLOADFILE_MSG As String = "#Unable to download file from server"

' Confirmation of user action
Private Const C_ERR_CHECKDELETE As Long = 939
Private Const C_ERR_CHECKDELETE_MSG As String = "#Do you really want to delete this record ?"""

' Occured when a concurrency access prevent to delete an item
Private Const C_ERR_DELETECONCURRENCY As Long = 7
Private Const C_ERR_DELETECONCURRENCY_MSG As String = "#Delete failed : concurrency problem.  Somebody else is using this information.  Please try again."

' Occured when a concurrency access prevent to update an item
Private Const C_ERR_UPDATECONCURRENCY As Long = 946
Private Const C_ERR_UPDATECONCURRENCY_MSG As String = "#Update failed : concurrency problem.  Somebody else is using this information.  Please try again"

' Occured when any error happened after a transaction of an update
Private Const C_ERR_LOCALCORRUPTED As Long = 947
Private Const C_ERR_LOCALCORRUPTED_MSG As String = "#Local identifiers corrupted, data reloaded from server"


Private Const C_ERR_MISSINGREQUIRED As Long = 266
Private Const C_ERR_MISSINGREQUIRED_MSG As String = "#Missing Data in compulsory field"

Private Const C_ERR_TEXTTOOSHORT As Long = 951
Private Const C_ERR_TEXTTOOSHORT_MSG = "#Text too long"

Private Const C_ERR_TEXTTOOLONG As Long = 268
Private Const C_ERR_TEXTTOOLONG_MSG As String = "#Text too long"

Private Const C_ERR_PICTOOLARGE As Long = 952
Private Const C_ERR_PICTOOLARGE_MSG As String = "#Picture is too large !"

Private Const C_ERR_SHAPE_H As Long = 953
Private Const C_ERR_SHAPE_H_MSG As String = "#Width must be greater than height"

Private Const C_ERR_SHAPE_R As Long = 954
Private Const C_ERR_SHAPE_R_MSG As String = "#Width mustn't be equal to height"

Private Const C_ERR_SHAPE_S As Long = 955
Private Const C_ERR_SHAPE_S_MSG As String = "#Width must be equal to height"

Private Const C_ERR_SHAPE_V As Long = 956
Private Const C_ERR_SHAPE_V_MSG As String = "#Width must be greater than height"

Private Const C_ERR_HEIGHT_SMALL As Long = 957
Private Const C_ERR_HEIGHT_SMALL_MSG = "#Picture height is too small"

Private Const C_ERR_HEIGHT_LARGE As Long = 958
Private Const C_ERR_HEIGHT_LARGE_MSG = "#Picture height is too large"

Private Const C_ERR_WIDTH_SMALL As Long = 959
Private Const C_ERR_WIDTH_SMALL_MSG = "#Picture width is too small"

Private Const C_ERR_WIDTH_LARGE As Long = 960
Private Const C_ERR_WIDTH_LARGE_MSG = "#Picture width is too large"


' ______ EVENTS
Public Event evQuit()                                   ' Fired when the user ask to quit the business card editor
Public Event evItemAdded(ByVal al_Art_ID As Long)       ' Fired when an item is successfully created
Public Event evItemDeleted(ByVal al_Art_ID As Long)     ' Fired when an item is successfully delete
Public Event evItemUpdated(ByVal al_Art_ID As Long)     ' Fired when an item is successfully updated


' Functionning mode
Private Enum eMode
    ebccAdd = 1          ' Adding an item
    ebccUpdate = 2       ' Updating an item
    ebccDelete = 3       ' Deleting an item
    ebccView = 4         ' Read-only view of an item
End Enum

' Object constraints
Private Type TObjConstraint
    i_MaxSizeInKB As Integer
    i_MinHeight As Integer
    i_MaxHeight As Integer
    i_MinWidth As Integer
    i_MaxWidth As Integer
    s_Shape As String
    i_MinChar As Integer
    i_MaxChar As Integer
    b_Required As Boolean
End Type


' Basic representation of an objet included into an article
Private Type TObject
    l_Obj_ID As Long                ' Reference to CM_Objects
    b_Translated As Boolean         ' Indicates if the Objects is a translation or a mirror of a master
    l_Blob_ID As Long               ' Reference to CM_RessourcesFiles or CM_LongText, depends of Objects type
    t_Constraint As TObjConstraint
End Type


' An article
Private Type TArticle
    l_Art_ID As Long            ' Reference to CM_Articles
    s_Art_Desc As String        ' The description of the article, equal normally to customer name
    t_Pct_ID() As TObject       ' List of Pictures linked to the articles
    t_LText_ID() As TObject     ' List of the long text linked to the articles
    s_CCU_Capkey As String      ' The customer linked to an article
    b_iConcurrency As Byte      ' Used for check concurrency access
    s_MasterLanguage As String  ' Give the master of the language, change the behavior during update
End Type



Private mt_Article As TArticle      ' Current item information
Private me_Mode As eMode            ' Functionning mode
Private ms_Labels As Variant        ' Labels


Private mo_Db As Object                  ' Data provider
Private ms_Language_Code As String      ' Language of the article
Private ml_CodePage As Integer          ' Code page of the language
Private ms_Username As String           ' Login of the user
Private ms_StyleSheet As String         ' The stylesheet to apply to the HTML contents
Private ms_DownloadFolder As String     ' Where to download the temp picture files
Private mb_BCCWriter As Boolean         ' True if the user can modify the bcc


' _____ INTERFACES

Public Property Let Labels(ByVal as_Labels As String)
    ms_Labels = Split(as_Labels, C_SEP)
End Property


' Manage the database provider
Public Property Set ArmDb(ByRef ao_Armdb As Object)
    Set mo_Db = ao_Armdb
    Set pbItem.ArmDb = ao_Armdb
End Property
Public Property Get ArmDb() As Object
    Set ArmDb = mo_Db
End Property

' Manage the user name
Public Property Let Username(ByVal as_Username As String)
    ms_Username = as_Username
End Property
Public Property Get Username() As String
    Username = ms_Username
End Property


' Manage the language
Public Property Let Language_Code(ByVal as_Language_code As String)
    ms_Language_Code = as_Language_code
    pbItem.Language = as_Language_code
End Property
Public Property Get Language_Code() As String
    Language_Code = ms_Language_Code
End Property

' And the codepage
Public Property Let codepage(ByVal al_CodePage As Long)
    ml_CodePage = al_CodePage
End Property
Public Property Get codepage() As Long
    codepage = ml_CodePage
End Property

' Manage the stylesheet
Public Property Let StyleSheet(ByVal as_fileName As String)
    ms_StyleSheet = as_fileName
End Property
Public Property Get StyleSheet() As String
    StyleSheet = ms_StyleSheet
End Property


' Manage the temp folder
Public Property Let DownloadFolder(ByVal as_DownloadFolder As String)
    ms_DownloadFolder = as_DownloadFolder
End Property
Public Property Get DownloadFolder() As String
    DownloadFolder = ms_DownloadFolder
End Property


' Constructor
Public Function Load_A_Com() As Boolean

    On Error GoTo onError

    ' In case of error during last running
    ClearDownloadFolder

    Dim lb_Index As Byte, lb_count As Byte

    Dim ms_DefaultLabels() As String
    ms_DefaultLabels = Split(C_LBL_DEFAULT, C_SEP)

    If IsArray(ms_Labels) Then
        If UBound(ms_Labels) < UBound(ms_DefaultLabels) Then
            ms_Labels = ms_DefaultLabels
        End If
    Else
        ms_Labels = ms_DefaultLabels
    End If

    ReDim mt_Article.t_LText_ID(HTML.Count - 1)
    ReDim mt_Article.t_Pct_ID(pic.Count - 1)

    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Index = 0 To lb_count
      pic(lb_Index).Load_A_Com
      pic(lb_Index).ReadOnly = False
      pic(lb_Index).PicIndex = lb_Index + 1
      pic(lb_Index).ShowName = False
      pic(lb_Index).PicName = ""
      pic(lb_Index).Charset = GetCharSetFromCodePage(ml_CodePage)
    Next

    txt_Slogan.Font.Charset = GetCharSetFromCodePage(ml_CodePage)

    lb_count = UBound(mt_Article.t_LText_ID)
    For lb_Index = 0 To lb_count
      HTML(lb_Index).Load_A_Com
      Call SetHTMLStatus(HTML(lb_Index), lb_Index <> C_HTML_CUSTOMERINFO)
      HTML(lb_Index).Charset = GetCharSetFromCodePage(ml_CodePage)
      HTML(lb_Index).SetLabels (ms_Labels(C_LBL_IDX_HYPERLINK) & C_SEP & ms_Labels(C_LBL_IDX_OK) & C_SEP & ms_Labels(C_LBL_IDX_CANCEL))
    Next

    chkInternet.Caption = ms_Labels(C_LBL_IDX_INTERNET_FLAG)
    chkPictureName.Caption = ms_Labels(C_LBL_IDX_SHOWPCTNAME)
    lbl_Slogan.Caption = ms_Labels(C_LBL_IDX_SLOGAN)
    lbl_BusinessCard.Caption = ms_Labels(C_LBL_IDX_ID)
    

    If ms_DownloadFolder = "" Then
        ms_DownloadFolder = App.Path
    End If

    me_Mode = eMode.ebccAdd

    Call GetUserRights
    
    If Not Load_Constraints Then GoTo onError
    
    pbItem.Height = 650
    pbItem.Load_A_Com

    Load_A_Com = True
    
    
    Exit Function

onError:
    Call Unload_A_Com
    Load_A_Com = False

End Function



' Destructor
Public Function Unload_A_Com() As Boolean
    
    On Error GoTo onError
    
    Dim ll_Index As Long

    For ll_Index = 0 To pic.Count - 1
      pic(ll_Index).Unload_A_Com
    Next

    For ll_Index = 0 To HTML.Count - 1
      HTML(ll_Index).Unload_A_Com
    Next

    Set ArmDb = Nothing

    ClearDownloadFolder
    pbItem.Unload_A_Com

    Unload_A_Com = True
    
    Exit Function
    
onError:
    Unload_A_Com = False

End Function


' Switch into view mode
' The ID ius mandatory
Public Function View(Optional ByVal al_Art_ID As Long = -1) As Boolean

    On Error GoTo onError

    SetMousePointer (False)

    me_Mode = eMode.ebccView
    Call InitIHM
    
    If al_Art_ID <> -1 Then
        If Not Process_Reset Then GoTo onError
        Call Item_ResetData
        mt_Article.l_Art_ID = al_Art_ID
        If Not Item_Load Then GoTo onError
    End If
    
    View = True
        
    SetMousePointer (True)
    Exit Function

onError:
    SetMousePointer (True)
    View = False

End Function


' Switch into delete  mode
' If the ID is indicated, the current item will used
Public Function Delete(Optional ByVal al_Art_ID As Long = -1) As Boolean

    On Error GoTo onError

    SetMousePointer (False)
    
    If Not mb_BCCWriter Then GoTo onError
    
    ' If id is not indicates, we try delete the current one
    If al_Art_ID = -1 Then
        If mt_Article.l_Art_ID = -1 Then
            Err.Raise C_ERR_OFFSET + C_ERR_UNKNOWN, "Delete, Invalid art_id", C_ERR_UNKNOWN_MSG
            GoTo onError
        End If
    Else
        If Not View(al_Art_ID) Then
            Delete = False
            SetMousePointer (True)
            Exit Function
        End If
    End If
    me_Mode = eMode.ebccDelete

    Call InitIHM

    SetMousePointer (True)
    Delete = True
    Exit Function
onError:
    SetMousePointer (True)
    Delete = False
End Function


' Switch into update mode
' If the ID is indicated, the current item will used
Public Function UPDATE(Optional ByVal al_Art_ID As Long = -1) As Boolean

    On Error GoTo onError
    
    SetMousePointer (False)

    If Not mb_BCCWriter Then GoTo onError
    
    
    ' If id is not indicates, we want to update the current one
    If al_Art_ID = -1 Then
        If mt_Article.l_Art_ID = -1 Then
            Err.Raise C_ERR_OFFSET + C_ERR_UNKNOWN, "Update, Invalid art_id", C_ERR_UNKNOWN_MSG
            GoTo onError
        End If
    Else
        If Not View(al_Art_ID) Then
            UPDATE = False
            SetMousePointer (True)
            Exit Function
        End If
    End If
    me_Mode = eMode.ebccUpdate

    Call InitIHM

    SetMousePointer (True)
    UPDATE = True
    Exit Function
onError:
    SetMousePointer (True)
    UPDATE = False
End Function


' Switch to ADD mode, CCU_Capkey is the ID of the customer to be attached to the card
Public Function Add(ByVal as_CCU_CapKey As String) As Boolean

    On Error GoTo onError

    SetMousePointer (False)


    me_Mode = IIf(mb_BCCWriter, eMode.ebccAdd, eMode.ebccView)

    Call InitIHM
    If Not Process_Reset Then
        GoTo onError
    End If

    mt_Article.s_CCU_Capkey = as_CCU_CapKey
    Add = Item_LoadCustomerInfo

    SetMousePointer (True)
    
    
    Exit Function

onError:
        SetMousePointer (True)
        Add = False

End Function


' ____ SYSTEM FUNCTIONS
' Display an error message
Public Function SendMessage(ByVal ai_MsgCode As Integer, ByVal as_MsgDefault As String, Optional ByVal as_MsgCxt As String = "", Optional Buttons As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult

    Dim ls_Message As String, ls_Request As String, lc_Cursor As Long

    On Error GoTo onError

    ls_Request = "SELECT Message_Text FROM Error_Message WHERE Language_Code = '" & ms_Language_Code & "' AND MsgID = " & ai_MsgCode
    If mo_Db.IsConnected Then
        lc_Cursor = mo_Db.OpenSQL(ls_Request)
        ls_Message = mo_Db.GetFields(lc_Cursor, "Message_Text")
    Else
        ls_Message = ""
    End If
    Call mo_Db.Close(lc_Cursor)
    ls_Message = IIf(ls_Message <> "", ls_Message, as_MsgDefault) & vbCrLf & Trim(as_MsgCxt)
    SendMessage = MsgBox(ls_Message, Buttons)
    
    Exit Function

onError:
    Call mo_Db.Close(lc_Cursor)
    SendMessage = vbAbort
    Call MsgBox(C_ERR_MSG_FATAL_ERROR)
    End
End Function


' Manage the mouse pointer
Private Static Sub SetMousePointer(lb_Enable As Boolean)
Dim ll_Count As Integer
Dim li_OldPointer As Integer

  If lb_Enable Then
    If ll_Count > 0 Then ll_Count = ll_Count - 1
    If ll_Count <= 0 Then
      'set back old state
      Screen.MousePointer = li_OldPointer
    End If
  Else
    ll_Count = ll_Count + 1
    'remember state of pointer before first change
    If ll_Count = 1 Then li_OldPointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
  End If
End Sub


' Give the nextkey of an DB table
' NOTICE : MUSTN'T BE CALLED INTO A ACID TRANSACTION BECAUSE DISPLAY ERROR MESSAGE !
Private Function GetNextKey(ByVal as_TableName, ByRef al_Key As Long, Optional ByVal al_TryCount As Integer = 5) As Boolean

    On Error GoTo onError
    
    Call SetMousePointer(False)

    Dim ls_Request As String

    ls_Request = "SELECT Table_Key" & vbCrLf & _
                 "FROM SYS_TablesKeys" & vbCrLf & _
                 "WHERE Table_Name = '" & as_TableName & "'"

    ' STEP 1 - Read the current key
    Dim lc_Cursor As Long, ll_CurrentKey As Long, ll_NewKey As Long
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If mo_Db.RowCount(lc_Cursor) = 0 Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in GetNextKey, #1", C_ERR_DB_FAULT_MSG
    End If

    ' STEP 2 - Calculate the new
    ll_CurrentKey = mo_Db.GetFields(lc_Cursor, 0)
    mo_Db.Close (lc_Cursor)
    ll_NewKey = ll_CurrentKey + 1
    
    
    ' STEP 3 - Try to register the new key
    ls_Request = "UPDATE SYS_TablesKeys" & vbCrLf & _
                 "SET Table_Key = " & ll_NewKey & vbCrLf & _
                 "WHERE Table_Name = '" & as_TableName & "' " & _
                 "AND Table_Key = " & ll_CurrentKey & vbCrLf

    If Not mo_Db.ExecuteSQL(ls_Request) Then
      Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in GetNextKey, #2", C_ERR_DB_FAULT_MSG
    End If

    If mo_Db.SQLRowsAffected = 1 Then
        ' That's all folks !
        al_Key = ll_NewKey
        GetNextKey = True
    Else
        ' No luck, try again !
        If al_TryCount = 0 Then ' Too much tries, server should busy...
            GetNextKey = False
        Else
            GetNextKey = GetNextKey(as_TableName, al_Key, al_TryCount - 1)
        End If
    End If

    Call SetMousePointer(True)
    Exit Function

onError:
    mo_Db.Close (lc_Cursor)
    GetNextKey = False
    Call SetMousePointer(True)
    If Err.Number > C_ERR_OFFSET Then
        Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    Else
        Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    End If

End Function


' _____ IHM

' ArmHTMLEdit lost contains when status changed, this function restore it
Private Sub SetHTMLStatus(ByRef ao_HTML As ArmHTMLEdit, ByVal as_Status As Boolean, Optional ByVal as_StyleSheet = "")
    
    Dim ls_Buffer As String, ls_StyleSheet
    
    ls_StyleSheet = IIf(as_StyleSheet <> "", as_StyleSheet, ms_StyleSheet)
    ls_Buffer = ao_HTML.HTMLTextInner
    ao_HTML.ReadOnly = as_Status
    If ls_StyleSheet <> "" Then ao_HTML.CreateStyleSheet (ls_StyleSheet)
    ao_HTML.HTMLTextInner = ls_Buffer

End Sub


' Display/Hide the picture name
Private Sub chkPictureName_Click()

    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mt_Article.t_Pct_ID)
    For ll_Idx = 0 To ll_Count
        pic(ll_Idx).ShowName = chkPictureName.value
    Next

End Sub

Private Sub pbItem_action(ByVal as_ActionType As String)

    Select Case UCase$(as_ActionType)
        
        Case UCase$("Valid")
            Call Process_Validate
        
        Case UCase$("UnDo")
            Call Process_Reset
            
        Case UCase$("Update")
            Call UPDATE
        
        Case UCase$("Delete")
            Call Delete
            
        Case UCase$("Quit")
            RaiseEvent evQuit
    
    End Select

End Sub


' Give to HTML component the enumeration of images name for hyperlink choose
Private Sub HTML_Edited(Index As Integer)
Dim lv_Data As Variant
Dim ll_Index As Long, ll_Count As Long, ll_idx2 As Long

  ll_Count = -1
  For ll_Index = 0 To pic.Count - 1
    If pic(ll_Index).FileName <> "" Then
        ll_Count = ll_Count + 1
    End If
  Next

  If ll_Count > -1 Then
    ReDim lv_Data(ll_Count, 1)
    ll_idx2 = 0
    For ll_Index = 0 To pic.Count - 1
      ' If there is a picture linked by the user
      If pic(ll_Index).FileName <> "" Then
          lv_Data(ll_idx2, 0) = C_ANCHOR & ll_Index
          
          If Len(Trim(pic(ll_Index).PicName)) = 0 Then
                lv_Data(ll_idx2, 1) = ms_Labels(C_LBL_IDX_PICTURE) & " " & (ll_Index + 1)
          Else
          lv_Data(ll_idx2, 1) = pic(ll_Index).PicName
           End If
          ll_idx2 = ll_idx2 + 1
      End If
    Next
    End If
  HTML(Index).HyperLinks = lv_Data
End Sub



' Determine if a new name of a picture is valid
Private Sub pic_ValidatePicName(Index As Integer, as_Name As String, ab_Valid As Boolean)
Dim ll_Index As Long

  ' The name cannot contains a '
    '  If as_Name = "" Then
    '    Call SendMessage(C_ERR_MISSINGREQUIRED, C_ERR_MISSINGREQUIRED_MSG)
    '    ab_Valid = False
    '    Exit Sub
    '  End If
    
    If Len(Trim(as_Name)) = 0 Then
        ab_Valid = True
    Exit Sub
  End If

  ' The name must be unique
  For ll_Index = 0 To pic.Count - 1
    If (Index <> ll_Index) And (StrComp(pic(ll_Index).PicName, as_Name, vbTextCompare) = 0) Then
      ab_Valid = False
      Exit For
    End If
  Next
  
End Sub

Private Sub InitIHM()

    Dim lb_Idx As Byte, lb_count As Byte

    pbItem.ClearAllIcons
    pbItem.Width = Width
    
    Select Case me_Mode

        Case eMode.ebccAdd
            pbItem.PictureDisplayed = "P_Valid=1 P_UnDo=2  P_Quit=-1 "
            chkInternet.Enabled = True
            txt_Slogan.Enabled = True
            
        Case eMode.ebccDelete
            pbItem.PictureDisplayed = "P_Valid=1 P_Quit=-1"
            chkInternet.Enabled = False
            txt_Slogan.Enabled = False

        Case eMode.ebccUpdate
            pbItem.PictureDisplayed = "P_Valid=1 P_UnDo=2 P_Quit=-1"
            chkInternet.Enabled = True
            txt_Slogan.Enabled = True

        Case eMode.ebccView
            If mb_BCCWriter Then
                pbItem.PictureDisplayed = "P_Update=3 P_Delete=4 P_Quit=-1"
            Else
                pbItem.PictureDisplayed = "P_Quit=-1"
            End If
            chkInternet.Enabled = False
            txt_Slogan.Enabled = False
    End Select
    pbItem.Refresh

    

    lb_count = HTML.Count - 1
    For lb_Idx = 0 To lb_count
        Call SetHTMLStatus(HTML(lb_Idx), (me_Mode = eMode.ebccDelete) Or (me_Mode = eMode.ebccView) Or (lb_Idx = C_HTML_CUSTOMERINFO))
    Next

    lb_count = pic.Count - 1
    For lb_Idx = 0 To lb_count
        pic(lb_Idx).ReadOnly = (me_Mode = eMode.ebccDelete) Or (me_Mode = eMode.ebccView)
    Next

End Sub


' Clear the control
Private Sub IHM_Clear()

    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mt_Article.t_LText_ID)
    For ll_Idx = 0 To ll_Count
        If ll_Idx <> C_HTML_CUSTOMERINFO Then
            HTML(ll_Idx).HTMLTextInner = C_HTML_DEFAULTSTYLE
        End If
    Next

    ll_Count = UBound(mt_Article.t_Pct_ID)
    For ll_Idx = 0 To ll_Count
        pic(ll_Idx).Clear
        pic(ll_Idx).PicName = "" ' ms_Labels(C_LBL_IDX_PICTURE) & " " & ll_Idx + 1
    Next
    
    txt_Slogan.Text = ""
    txt_ID.Text = ""

    Internet_Flag = ""

End Sub




' ____ COMMAND PROCESSING


' This function don't really manage error
' If an error occured, it only disable write right.
Private Sub GetUserRights()

    Const C_L_DB_GETBCCALIAS As String = "SELECT Alias" & vbCrLf & _
                                         "FROM Security_Alias" & vbCrLf & _
                                         "WHERE Login_Name = '$login_name$'" & vbCrLf & _
                                         "AND Alias LIKE 'BCC_%'"

    On Error GoTo onError

    Dim ls_Request As String, lc_Alias As Long
    ls_Request = Replace(C_L_DB_GETBCCALIAS, "$login_name$", ms_Username)
    lc_Alias = mo_Db.OpenSQL(ls_Request)
    If mo_Db.Find(lc_Alias, "Alias", "BCC_WRITER") > -1 Then
        mb_BCCWriter = True
    Else
        mb_BCCWriter = False
    End If
    
    Call mo_Db.Close(lc_Alias)
    
    Exit Sub
    
onError:
    Call mo_Db.Close(lc_Alias)
    mb_BCCWriter = False
    
End Sub

' Delete in the download folder all file that can have been downloaded by BCC
Private Sub ClearDownloadFolder()
    
    On Error GoTo onError
    
    Dim lo_Fso As Object
    Set lo_Fso = CreateObject("Scripting.FileSystemObject")
    lo_Fso.DeleteFile (ms_DownloadFolder & "\" & C_FILENAME_PREF & "*.*")
    Set lo_Fso = Nothing
    
    Exit Sub
onError:
    Set lo_Fso = Nothing
        
End Sub



' Choose the action to perform when user validate in function of the functionning mode
' By the event system, the container can choose the next mode
Private Sub Process_Validate()

    On Error GoTo onError

    Select Case me_Mode
        Case eMode.ebccAdd
            If Process_Add Then
                RaiseEvent evItemAdded(mt_Article.l_Art_ID)
            End If
        Case eMode.ebccDelete
            If Process_Delete Then
                RaiseEvent evItemDeleted(mt_Article.l_Art_ID)
            End If
        Case eMode.ebccUpdate
            If Process_Update Then
                RaiseEvent evItemUpdated(mt_Article.l_Art_ID)
            End If
    End Select

    Exit Sub

onError:
    SetMousePointer (True)
    If Err.Number > C_ERR_OFFSET Then
        Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    Else
        Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    End If

End Sub

' Try to perform a creation of the current item
Private Function Process_Add() As Boolean

    On Error GoTo onError

    SetMousePointer (False)

    If Not Item_Check Then
        Process_Add = False
        SetMousePointer (True)
        Exit Function
    End If

    If Item_Add Then
        txt_ID.Text = mt_Article.l_Art_ID
        Process_Add = True
    Else
        Process_Add = False
    End If
    SetMousePointer (True)

    Exit Function

onError:
    SetMousePointer (True)
    Process_Add = False

End Function

' Try to perform a delete on the current item
Private Function Process_Delete() As Boolean

    On Error GoTo onError

    If SendMessage(C_ERR_CHECKDELETE, C_ERR_CHECKDELETE_MSG, , vbOKCancel) = vbCancel Then
        Process_Delete = False
        Exit Function
    End If

    SetMousePointer (False)

    Process_Delete = Item_Delete

    SetMousePointer (True)

    Exit Function

onError:
    SetMousePointer (True)
    Process_Delete = False

End Function


' Try to perform an update of the current item
Private Function Process_Update() As Boolean

    On Error GoTo onError


    SetMousePointer (False)

    If Not Item_Check Then
        Process_Update = False
        SetMousePointer (True)
        Exit Function
    End If

    Process_Update = Item_Update

    SetMousePointer (True)

    Exit Function

onError:
    SetMousePointer (True)
    Process_Update = False

End Function


' Reset the data to the initial value
Private Function Process_Reset() As Boolean

    On Error GoTo onError

    Dim ls_Art_ID As String

    SetMousePointer (False)

    Select Case me_Mode
        Case eMode.ebccAdd, eMode.ebccView
            Call IHM_Clear
            
        Case eMode.ebccUpdate
            Call IHM_Clear
            ls_Art_ID = mt_Article.l_Art_ID
            Call Item_ResetData
            mt_Article.l_Art_ID = ls_Art_ID
            Call Item_Load
    End Select

    Process_Reset = True
    SetMousePointer (True)
    Exit Function

onError:
    SetMousePointer (True)
    Process_Reset = False

End Function


' ____ ITEM PROCESSING

' Manage the internet flag
Private Property Let Internet_Flag(ByVal as_Status As String)
    chkInternet.value = IIf(as_Status = "X", 1, 0)
End Property
Private Property Get Internet_Flag() As String
    Internet_Flag = IIf(chkInternet.value = 1, "X", "")
End Property

Private Property Get Master() As Boolean
    Master = (mt_Article.s_MasterLanguage = ms_Language_Code)
End Property

' Reset all item informations concerning the content management,
' but not the customer linked
Private Sub Item_ResetData()

    mt_Article.l_Art_ID = -1
    mt_Article.b_iConcurrency = 1
    mt_Article.s_MasterLanguage = ms_Language_Code
    
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mt_Article.t_LText_ID)
    For ll_Idx = 0 To ll_Count
        mt_Article.t_LText_ID(ll_Idx).l_Blob_ID = -1
        mt_Article.t_LText_ID(ll_Idx).l_Obj_ID = -1
        mt_Article.t_LText_ID(ll_Idx).b_Translated = False
    Next

    ll_Count = UBound(mt_Article.t_Pct_ID)
    For ll_Idx = 0 To ll_Count
        mt_Article.t_Pct_ID(ll_Idx).l_Blob_ID = -1
        mt_Article.t_Pct_ID(ll_Idx).l_Obj_ID = -1
        mt_Article.t_Pct_ID(ll_Idx).b_Translated = False
    Next

End Sub


' Check if the displayed item can be validated for a creation or an update
' This function used the constraints defined in the database to determines if something is wrong
Private Function Item_Check() As Boolean

    On Error GoTo onError

    Call SetMousePointer(False)
    
    Dim lb_Idx As Byte, lb_count As Byte, ll_Buffer As Long

    ' STEP 0 _____ CHECK THE SLOGAN
    ' Disabled, ask by marketing
    'If txt_Slogan.Text = "" Then
    '    Call SendMessage(C_ERR_MISSINGREQUIRED, C_ERR_MISSINGREQUIRED_MSG)
    '    txt_Slogan.SetFocus
    '    GoTo onTerminate
    'End If


    ' STEP 1 _____ CHECK THE LONGTEXT
    lb_count = UBound(mt_Article.t_LText_ID)
    
    For lb_Idx = 0 To lb_count
    
        If lb_Idx <> C_HTML_CUSTOMERINFO Then
    
            ll_Buffer = Len(Trim(HTML(lb_Idx).HTMLTextInner))
        
            ' STEP 1.1 - Check required
            If mt_Article.t_LText_ID(lb_Idx).t_Constraint.b_Required And ll_Buffer = 0 Then
                Call SendMessage(C_ERR_MISSINGREQUIRED, C_ERR_MISSINGREQUIRED_MSG)
                HTML(lb_Idx).SetFocus
                GoTo onTerminate
            End If
            
            ' STEP 1.2 - Check size
            If (mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MinChar > 0) And _
               (mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MinChar > ll_Buffer) Then
                Call SendMessage(C_ERR_TEXTTOOSHORT, C_ERR_TEXTTOOSHORT_MSG)
                HTML(lb_Idx).SetFocus
                GoTo onTerminate
            End If
            
            If (mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MaxChar > 0) And _
               (mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MaxChar < ll_Buffer) Then
                Call SendMessage(C_ERR_TEXTTOOLONG, C_ERR_TEXTTOOLONG_MSG)
                HTML(lb_Idx).SetFocus
                GoTo onTerminate
            End If
            
        End If
    
    Next
    
    
    ' STEP 2 _____ Check the picture
    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Idx = 0 To lb_count
    
        ' STEP 2.1 - Check required
        If mt_Article.t_Pct_ID(lb_Idx).t_Constraint.b_Required And (pic(lb_Idx).FileName = "") Then
            Call SendMessage(C_ERR_MISSINGREQUIRED, C_ERR_MISSINGREQUIRED_MSG, "(" & pic(lb_Idx).PicName & ")")
            GoTo onTerminate
        End If
        
        
        ' STEP 2.2 - Check size
        If (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxSizeInKB > 0) And _
           (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxSizeInKB < GetSizeInKB(pic(lb_Idx).PicSize)) Then
            Call SendMessage(C_ERR_PICTOOLARGE, C_ERR_PICTOOLARGE_MSG, "(" & pic(lb_Idx).PicName & ")")
            GoTo onTerminate
        End If
        
        
        ' STEP 2.3 - Check Shape
        Select Case mt_Article.t_Pct_ID(lb_Idx).t_Constraint.s_Shape
            Case C_PCT_SHAPE_HORIZONTAL
                If pic(lb_Idx).PicWidth <= pic(lb_Idx).PicHeight Then
                    Call SendMessage(C_ERR_SHAPE_H, C_ERR_SHAPE_H_MSG, "(" & pic(lb_Idx).PicName & ")")
                    GoTo onTerminate
                End If
            
            Case C_PCT_SHAPE_RECT
                If pic(lb_Idx).PicHeight = pic(lb_Idx).PicWidth Then
                    Call SendMessage(C_ERR_SHAPE_R, C_ERR_SHAPE_R_MSG, "(" & pic(lb_Idx).PicName & ")")
                    GoTo onTerminate
                End If
            
            Case C_PCT_SHAPE_SQUARE
                If pic(lb_Idx).Height <> pic(lb_Idx).PicWidth Then
                    Call SendMessage(C_ERR_SHAPE_R, C_ERR_SHAPE_R_MSG, "(" & pic(lb_Idx).PicName & ")")
                    GoTo onTerminate
                End If
            
            
            Case C_PCT_SHAPE_VERTICAL
                If pic(lb_Idx).PicHeight <= pic(lb_Idx).PicWidth Then
                    Call SendMessage(C_ERR_SHAPE_V, C_ERR_SHAPE_V_MSG, "(" & pic(lb_Idx).PicName & ")")
                    GoTo onTerminate
                End If
                
                
            Case C_PCT_SHAPE_UNKNOWN
                ' Nothing to do
            Case Else
                ' Nothing to do
        End Select
        
        
        ' STEP 2.4 - Check minHeight
        If (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinHeight > 0) And _
           (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinHeight > pic(lb_Idx).PicHeight) Then
           Call SendMessage(C_ERR_HEIGHT_SMALL, C_ERR_HEIGHT_SMALL, "(" & pic(lb_Idx).PicName & ")")
           GoTo onTerminate
        End If
        
        
        ' STEP 2.5 - Check MaxHeight
        If (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxHeight > 0) And _
           (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxHeight < pic(lb_Idx).PicHeight) Then
           Call SendMessage(C_ERR_HEIGHT_LARGE, C_ERR_HEIGHT_LARGE, "(" & pic(lb_Idx).PicName & ")")
           pic(lb_Idx).SetFocus
           GoTo onTerminate
        End If
        
        
        ' Step 2.6 - Check minWidth
        If (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinWidth > 0) And _
           (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinWidth > pic(lb_Idx).PicWidth) Then
           Call SendMessage(C_ERR_WIDTH_SMALL, C_ERR_WIDTH_SMALL, "(" & pic(lb_Idx).PicName & ")")
           GoTo onTerminate
        End If
        
        ' STEP 2.7 - Check MaxWidth
        If (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxWidth > 0) And _
           (mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxWidth < pic(lb_Idx).PicWidth) Then
               Call SendMessage(C_ERR_WIDTH_LARGE, C_ERR_WIDTH_LARGE_MSG, "(" & pic(lb_Idx).PicName & ")")
            GoTo onTerminate
        End If
    Next

    Item_Check = True

onTerminate:
    Call SetMousePointer(True)

    Exit Function

onError:
    Call SetMousePointer(True)
    Item_Check = False

End Function



' Load the customer informations into the dedicated HTML editor
Private Function Item_LoadCustomerInfo() As Boolean

    Const C_L_DB_REQ_CUSTOMERINFO As String = "SELECT TOP 1 CCU_Desc, CCU_Addr1, CCU_Addr2, CCU_Town, CCU_Zip, " & vbCrLf & _
                                              "             CT.CT_Desc, CCU_Tel, CCU_Fax, WebURL " & vbCrLf & _
                                              "FROM Claim_Customer CCU" & vbCrLf & _
                                              "INNER JOIN Countries CT ON CT.CT_Code = CCU.CT_Code AND CT.Language_Code = '$language_code$'" & vbCrLf & _
                                              "INNER JOIN Cap_County CTY ON CTY.CTY_Code = CCU.CTY_Code AND CTY.Language_Code ='$language_code$'" & vbCrLf & _
                                              "WHERE CCU_Capkey = '$ccu_capkey$'" & vbCrLf
    
    Const C_L_HTML_BEGIN As String = "<table border=0 cellspacing=2 cellpadding=>"
    Const C_L_HTML_DATA As String = "<tr><td class=textecourantnoir>$data$</td></tr>"
    Const C_L_HTML_BLANK As String = ""
    Const C_L_HTML_LINK As String = "<a href=""$href$"" target=_new>$href$</a>"
    Const C_L_HTML_EMAIL As String = "$email$"
    Const C_L_HTML_END As String = "</table>"

    On Error GoTo onError

    Dim ls_Request As String, lc_Cursor As Long
    ls_Request = Replace(C_L_DB_REQ_CUSTOMERINFO, "$ccu_capkey$", mt_Article.s_CCU_Capkey)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If (mo_Db.LastErrorCode <> 0) Then
        Call SendMessage(C_ERR_DB_FAULT, C_ERR_DB_FAULT_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in Item_LoadCustomerInfo, #1")
        GoTo onError
    End If

    If (mo_Db.RowCount(lc_Cursor) = 0) Then
        GoTo onError
    End If


    mt_Article.s_Art_Desc = left(mo_Db.GetFields(lc_Cursor, "CCU_Desc"), 80)

    Dim ls_Text As String, ls_Buffer As String
    ls_Text = C_L_HTML_BEGIN

    ls_Buffer = Replace(C_L_HTML_DATA, "$data$", "<strong>" & mo_Db.GetFields(lc_Cursor, "CCU_Desc") & "<strong>")
    ls_Text = ls_Text & ls_Buffer & C_L_HTML_BLANK

    ls_Buffer = Replace(C_L_HTML_DATA, "$data$", mo_Db.GetFields(lc_Cursor, "CCU_Addr1") & "<br>" & _
                                                 mo_Db.GetFields(lc_Cursor, "CCU_Addr2") & "<br>" & _
                                                 mo_Db.GetFields(lc_Cursor, "CCU_Zip") & " " & _
                                                 mo_Db.GetFields(lc_Cursor, "CCU_Town") & "<br>" & _
                                                 mo_Db.GetFields(lc_Cursor, "CT_Desc") & "<br>")
    ls_Text = ls_Text & ls_Buffer & C_L_HTML_BLANK


    If mo_Db.GetFields(lc_Cursor, "CCU_Tel") <> "" Then
        ls_Buffer = Replace(C_L_HTML_DATA, "$data$", ms_Labels(C_LBL_IDX_TEL) & " " & mo_Db.GetFields(lc_Cursor, "CCU_Tel"))
        ls_Text = ls_Text & ls_Buffer
    End If

    If mo_Db.GetFields(lc_Cursor, "CCU_Fax") <> "" Then
        ls_Buffer = Replace(C_L_HTML_DATA, "$data$", ms_Labels(C_LBL_IDX_FAX) & " " & mo_Db.GetFields(lc_Cursor, "CCU_Fax"))
        ls_Text = ls_Text & ls_Buffer
    End If

    Dim la_ArrBuff() As String
    If mo_Db.GetFields(lc_Cursor, "WebURL") <> "" Then
        la_ArrBuff = Split(mo_Db.GetFields(lc_Cursor, "WebURL"), C_SEP)
        If UBound(la_ArrBuff) >= 0 Then
            If la_ArrBuff(0) <> "" Then
                ls_Buffer = Replace(C_L_HTML_DATA, "$data$", ms_Labels(C_LBL_IDX_WEB) & " " & Replace(C_L_HTML_LINK, "$href$", la_ArrBuff(0)))
                ls_Text = ls_Text & ls_Buffer
            End If
        End If
        If UBound(la_ArrBuff) >= 1 Then
            If la_ArrBuff(1) <> "" Then
                ls_Buffer = Replace(C_L_HTML_DATA, "$data$", ms_Labels(C_LBL_IDX_EMAIL) & " " & Replace(C_L_HTML_EMAIL, "$email$", la_ArrBuff(1)))
                ls_Text = ls_Text & ls_Buffer
            End If
        End If
    End If

    ls_Text = ls_Text & C_L_HTML_END
    HTML(C_HTML_CUSTOMERINFO).HTMLTextInner = ConvertCodePageFromAnsi(ls_Text, ml_CodePage)

    mo_Db.Close (lc_Cursor)

    Item_LoadCustomerInfo = True
    Exit Function

onError:
    mo_Db.Close (lc_Cursor)
    Item_LoadCustomerInfo = False

End Function



' Load an item (defined in mt_Article)
Private Function Item_Load() As Boolean

    On Error GoTo onError

    
    ' Get information about the article
    Const C_L_DB_REQ_INFO_ARTICLE As String = "SELECT CA.Art_ID, Art_Desc, MasterLanguage, Internet_Flag, iConcurrency, CCU_Capkey" & vbCrLf & _
                                              "FROM CM_Articles CA" & vbCrLf & _
                                              "INNER JOIN CM_ArticlesLinks CAL ON CAL.Art_ID = CA.Art_ID AND CAL.DataType = '$datatype$' AND CAL.Language_Code = CA.Language_Code" & vbCrLf & _
                                              "WHERE CA.Art_ID = $art_id$ AND CA.Language_Code = '$language_code$' AND Drop_Flag = ''" & vbCrLf
    
    ' Get the informations about the object Long Text
    Const C_L_DB_REQ_INFO_OBJ_LTEXT As String = "SELECT CO.Obj_ID, LText_ID, BlobTranslated, Z_Order" & vbCrLf & _
                                                "FROM CM_Objects CO" & vbCrLf & _
                                                "INNER JOIN CM_ArticlesObjects CAO ON CAO.Obj_ID = CO.Obj_ID" & vbCrLf & _
                                                "    AND CAO.Language_Code = CO.Language_Code" & vbCrLf & _
                                                "    AND CAO.Art_ID = $art_id$" & vbCrLf & _
                                                "WHERE CO.Language_Code = '$language_code$' AND CO.Obj_Type = '$obj_type$'" & vbCrLf
    ' Get the informations about the object ressources
    Const C_L_DB_REQ_INFO_OBJ_RES As String = "SELECT CO.Obj_ID, Res_ID, BlobTranslated, Z_Order, Legend, Obj_Filename" & vbCrLf & _
                                              "FROM CM_Objects CO" & vbCrLf & _
                                              "INNER JOIN CM_ArticlesObjects CAO ON CAO.Obj_ID = CO.Obj_ID" & vbCrLf & _
                                              "    AND CAO.Language_Code = CO.Language_Code" & vbCrLf & _
                                              "    AND CAO.Art_ID = $art_id$" & vbCrLf & _
                                              "WHERE CO.Language_Code = '$language_code$' AND CO.Obj_Type = '$obj_type$'" & vbCrLf

    ' Get a long text
    Const C_L_DB_REQ_INFO_LTEXT As String = "SELECT LText FROM CM_LongText WHERE LText_ID = $ltext_id$"
    ' Get a ressource
    Const C_L_DB_REQ_INFO_PCT As String = "SELECT Ressource FROM CM_RessourcesFiles WHERE Res_ID = $res_id$"

    Dim ls_Request As String, lc_Cursor As Long
    Dim ll_Idx As Long, ll_Count As Long
    Dim ll_Index As Long
    Dim lo_Fso As Object

    ' STEP 1 _____ Get informations about the article
    ls_Request = Replace(C_L_DB_REQ_INFO_ARTICLE, "$datatype$", C_LINK_CUSTOMER)
    ls_Request = Replace(ls_Request, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If (mo_Db.LastErrorCode <> 0) Then
        Call SendMessage(C_ERR_DB_FAULT, C_ERR_DB_FAULT_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in Item_Load, #1")
        GoTo onError
    End If
    If (mo_Db.RowCount(lc_Cursor) = 0) Then
        GoTo onError
    End If
    mt_Article.s_Art_Desc = mo_Db.GetFields(lc_Cursor, "Art_Desc")
    txt_Slogan.Text = mo_Db.GetFields(lc_Cursor, "Art_Desc")
    mt_Article.b_iConcurrency = mo_Db.GetFields(lc_Cursor, "iConcurrency")
    mt_Article.s_CCU_Capkey = mo_Db.GetFields(lc_Cursor, "CCU_Capkey")
    mt_Article.s_MasterLanguage = mo_Db.GetFields(lc_Cursor, "MasterLanguage")
    Internet_Flag = mo_Db.GetFields(lc_Cursor, "Internet_Flag")
    txt_ID.Text = mt_Article.l_Art_ID


    mo_Db.Close (lc_Cursor)

    ' STEP 2 _____ Get the long text

        ' STEP 2.1 - Get the objects informations
    ls_Request = Replace(C_L_DB_REQ_INFO_OBJ_LTEXT, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_LTEXT)
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If (mo_Db.LastErrorCode <> 0) Then
        Call SendMessage(C_ERR_DB_FAULT, C_ERR_DB_FAULT_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in Item_Load, #2")
        GoTo onError
    End If
    If (mo_Db.RowCount(lc_Cursor) = 0) Then
        GoTo onError
    End If

    ll_Count = mo_Db.RowCount(lc_Cursor) - 1
    For ll_Idx = 0 To ll_Count
        ll_Index = mo_Db.GetFields(lc_Cursor, "Z_Order")
        If ll_Index <= UBound(mt_Article.t_LText_ID) Then
            mt_Article.t_LText_ID(ll_Index).l_Obj_ID = mo_Db.GetFields(lc_Cursor, "Obj_ID")
            mt_Article.t_LText_ID(ll_Index).l_Blob_ID = mo_Db.GetFields(lc_Cursor, "LText_ID")
            mt_Article.t_LText_ID(ll_Index).b_Translated = (mo_Db.GetFields(lc_Cursor, "BlobTranslated") = "X")
        End If
        mo_Db.Next (lc_Cursor)
    Next
    mo_Db.Close (lc_Cursor)

        ' STEP 2.2 - Load the long text
    ll_Count = UBound(mt_Article.t_LText_ID)
    For ll_Idx = 0 To ll_Count
        If mt_Article.t_LText_ID(ll_Idx).l_Blob_ID <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_INFO_LTEXT, "$ltext_id$", mt_Article.t_LText_ID(ll_Idx).l_Blob_ID)
            lc_Cursor = mo_Db.OpenSQL(ls_Request)
            If (mo_Db.LastErrorCode <> 0) Then
                Call SendMessage(C_ERR_DB_FAULT, C_ERR_DB_FAULT_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in Item_Load, #3")
                GoTo onError
            End If
            If (mo_Db.RowCount(lc_Cursor) = 0) Then
                GoTo onError
            End If
            HTML(ll_Idx).HTMLTextInner = ConvertCodePageFromAnsi(mo_Db.GetFields(lc_Cursor, "LText"), ml_CodePage)
            Call mo_Db.Close(lc_Cursor)
        End If
    Next


    ' STEP 3 _____ Get the pictures

    Dim ls_fileName() As String
    Dim ls_Legend() As String

    ReDim ls_fileName(UBound(mt_Article.t_Pct_ID))
    ReDim ls_Legend(UBound(mt_Article.t_Pct_ID))

        ' STEP 2.2 - Get the pictures informations
    ls_Request = Replace(C_L_DB_REQ_INFO_OBJ_RES, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_PICTURE)
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If (mo_Db.LastErrorCode <> 0) Then
        Call SendMessage(C_ERR_DB_FAULT, C_ERR_DB_FAULT_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in Item_Load, #4")
        GoTo onError
    End If
    'If (mo_Db.RowCount(lc_Cursor) = 0) Then
    '    GoTo onError
    'End If

    ll_Count = mo_Db.RowCount(lc_Cursor) - 1

    ' Load the picture
    For ll_Idx = 0 To ll_Count
        ll_Index = mo_Db.GetFields(lc_Cursor, "Z_Order")
        If ll_Index <= UBound(mt_Article.t_Pct_ID) Then
            mt_Article.t_Pct_ID(ll_Index).l_Obj_ID = mo_Db.GetFields(lc_Cursor, "Obj_ID")
            mt_Article.t_Pct_ID(ll_Index).l_Blob_ID = mo_Db.GetFields(lc_Cursor, "Res_ID")
            mt_Article.t_Pct_ID(ll_Index).b_Translated = (mo_Db.GetFields(lc_Cursor, "BlobTranslated") = "X")
            ls_fileName(ll_Index) = mo_Db.GetFields(lc_Cursor, "Obj_Filename")
            ls_Legend(ll_Index) = mo_Db.GetFields(lc_Cursor, "legend")
        End If
        mo_Db.Next (lc_Cursor)
    Next
    mo_Db.Close (lc_Cursor)

        ' STEP 2.3 - Get the pictures
    Dim ls_TempName As String
    Set lo_Fso = CreateObject("Scripting.FileSystemObject")
    ll_Count = UBound(mt_Article.t_Pct_ID)
    For ll_Idx = 0 To ll_Count
        If mt_Article.t_Pct_ID(ll_Idx).l_Blob_ID <> -1 Then
            ls_TempName = ms_DownloadFolder & "\" & C_FILENAME_PREF & mt_Article.t_Pct_ID(ll_Idx).l_Blob_ID & "_" & ls_fileName(ll_Idx)
            If Not lo_Fso.FileExists(ls_TempName) Then
                ls_Request = Replace(C_L_DB_REQ_INFO_PCT, "$res_id$", mt_Article.t_Pct_ID(ll_Idx).l_Blob_ID)
                If Not mo_Db.BlobToFileSQL(ls_Request, ls_TempName) Then
                    Call SendMessage(C_ERR_DOWNLOADFILE, C_ERR_DOWNLOADFILE_MSG, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & ", " & vbCrLf & "Error in file " & ll_Idx)
                    GoTo onError
                End If
            End If
            pic(ll_Idx).Load (ls_TempName)
            pic(ll_Idx).PicName = ls_Legend(ll_Idx)
        End If
    Next
    Set lo_Fso = Nothing

    ' STEP 4 _____ Load customer info
    Item_Load = Item_LoadCustomerInfo

    Exit Function

onError:
    Set lo_Fso = Nothing
    mo_Db.Close (lc_Cursor)
    Item_Load = False
End Function



' Create an item
Private Function Item_Add() As Boolean

    
    ' Create the article
    Const C_L_DB_REQ_ART_ADD As String = "INSERT INTO CM_Articles (Art_ID, Language_Code, Tplt_ID, Art_Desc, MasterLanguage, Z_Creation, Z_Creator, Z_Last_upd, Z_Last_upd_user, internet_flag)" & vbCrLf & _
                                         "                  VALUES($art_id$, '$language_code$', $tplt_id$, N'$art_desc$', '$language_code$', GetDate(), '$login_name$', GetDate(), '$login_name$', '$internet_flag$' )" & vbCrLf

    ' Translate the article
    Const C_L_DB_REQ_ARTT_ADD As String = "INSERT INTO CM_Articles (Art_ID, Language_Code, Tplt_ID, Art_Desc, MasterLanguage, Z_Creation, Z_Creator, Z_Last_upd, Z_Last_upd_user, internet_flag)" & vbCrLf & _
                                          "                 SELECT $art_id$, Language_Code, $tplt_id$, N'$art_desc$', '$language_code$', GetDate(), '$login_name$', GetDate(), '$login_name$', '$internet_flag$' " & vbCrLf & _
                                          "                 FROM language" & vbCrLf & _
                                          "                 WHERE Language_Code <> '$language_code$'" & vbCrLf
    ' Link an article, in all language
    Const C_L_DB_REQ_ARTL_ADD As String = " INSERT INTO CM_ArticlesLinks (Art_ID, Language_Code, DataType, CCU_Capkey) " & vbCrLf & _
                                          "                       SELECT $art_id$, Language_Code, '$datatype$', '$ccu_capkey$'" & vbCrLf & _
                                          "                       FROM language" & vbCrLf

    ' Create a blob Long Text
    Const C_L_DB_REQ_BLOB_LTEXT_ADD As String = "INSERT INTO CM_LongText (LText_ID, LText)" & vbCrLf & _
                                                "                  VALUES($ltext_id$, N'$ltext$')" & vbCrLf


    ' Create an object long text
    Const C_L_DB_REQ_OBJ_LTEXT_ADD As String = "INSERT INTO CM_Objects (Obj_ID, Language_Code, Obj_Type, LText_ID, BlobTranslated)" & vbCrLf & _
                                               "                VALUES ($obj_id$, '$language_code$', '$obj_type$', $ltext_id$, '$blobtranslated$')"
    ' Create Translation of an object long text
    Const C_L_DB_REQ_OBJ_LTEXTT_ADD As String = "INSERT INTO CM_Objects(Obj_ID, Language_Code, Obj_Type, LText_ID)" & vbCrLf & _
                                                " SELECT $obj_id$, Language_Code, '$obj_type$', $ltext_id$" & vbCrLf & _
                                                "  From language" & vbCrLf & _
                                                "  WHERE Language_Code <> '$language_code$'" & vbCrLf
    ' Create link of an object, in all language
    Const C_L_DB_REQ_OBJ_LTEXTL_ADD As String = "INSERT INTO CM_ArticlesObjects (Art_ID, Obj_ID, Language_Code, Z_Order)" & vbCrLf & _
                                                "SELECT $art_id$, $obj_id$, Language_Code, $z_order$" & vbCrLf & _
                                                "FROM language" & vbCrLf

    ' Create a blob picture
    Const C_L_DB_REQ_BLOB_RES_ADD As String = "INSERT INTO CM_RessourcesFiles (Res_ID, Ressource)" & vbCrLf & _
                                              "                         VALUES($res_id$, ?)" & vbCrLf
                                              
    Const C_L_DB_REQ_OBJ_PCT_ADD As String = "INSERT INTO CM_Objects (Obj_ID, Language_Code, Obj_Type, Res_ID, BlobTranslated, Obj_Filename, Height, Width, SizeInKb)" & vbCrLf & _
                                             "                VALUES ($obj_id$, '$language_code$', '$obj_type$', $res_id$, '$blobtranslated$', '$filename$', $height$ , $width$, $sizeinkb$)"
    
    Const C_L_DB_REQ_OBJ_PCTT_ADD As String = "INSERT INTO CM_Objects(Obj_ID, Language_Code, Obj_Type, Res_ID, Obj_Filename, Height, Width, SizeInKb)" & vbCrLf & _
                                              "                SELECT $obj_id$, Language_Code, '$obj_type$', $res_id$, '$filename$', $height$, $width$, $sizeinkb$" & vbCrLf & _
                                              " FROM Language " & vbCrLf & _
                                              " WHERE Language_Code <> '$language_code$'" & vbCrLf
                                                
    Const C_L_DB_REQ_OBJ_PCTL_ADD As String = "INSERT INTO CM_ArticlesObjects (Art_ID, Obj_ID, Language_Code, Z_Order, AnchorName, Legend)" & vbCrLf & _
                                              "                         SELECT $art_id$, $obj_id$, Language_Code, $z_order$, '$anchorname$', N'$legend$'" & vbCrLf & _
                                              "                         FROM Language" & vbCrLf

    Const C_L_DB_REQ_BLOB_RES_DEL As String = "DELETE FROM CM_RessourcesFiles WHERE Res_ID = $res_id$"

    Const C_L_DB_REQ_BLOB_LTEXT_DEL As String = "DELETE FROM CM_LongText WHERE LText_ID = $ltext_id$"


    
    
    ' Array of requests concerning the article
    Const C_L_IDX_ART_ADD As Byte = 0      ' Creation request
    Const C_L_IDX_ARTT_ADD As Byte = 1     ' Translation request
    Const C_L_IDX_ARTL_ADD As Byte = 2     ' Link request

    
    ' Array of requests concerning the long text objects
    Const C_L_IDX_LTEXT_ADD As Byte = 0      ' Creation request
    Const C_L_IDX_LTEXTT_ADD As Byte = 1     ' Translation request
    Const C_L_IDX_LTEXTL_ADD As Byte = 2     ' Link request

    ' Array of request concerning the ressources objects
    Const C_L_IDX_RES_ADD As Byte = 0      ' Creation request
    Const C_L_IDX_REST_ADD As Byte = 1     ' Translation request
    Const C_L_IDX_RESL_ADD As Byte = 2     ' Link request

    On Error GoTo onError

    Dim lb_Idx As Byte, lb_count As Byte
    Dim ls_Request As String
    Dim lb_TransactionOpenned As Boolean    ' True if an acid transaction is oppenned
    Dim ls_Request_Art() As String          ' The request concerning the articles
    Dim ls_Request_ObjLText() As String       ' The Request concerning the objects LText
    Dim ls_Request_ObjRes() As String         ' The request concerning the objects Ressources

    ' STEP 0 _____ INITIALIZE THE DATA
    lb_TransactionOpenned = False
    Call Item_ResetData ' To be sure there is no residual information in case of rollback


    ' STEP 1 _____ SAVE THE BLOBS

    ' STEP 1.1 - text (remember that second paragraph is dynamic, be a part of mt_Article.t_LText_ID but readonly)
    ' Notice : All texts are required, see Item_Check
    lb_count = UBound(mt_Article.t_LText_ID)
    For lb_Idx = 0 To lb_count
        If lb_Idx <> C_HTML_CUSTOMERINFO Then
            If Not GetNextKey(C_DB_TABLE_CM_LTEXT, mt_Article.t_LText_ID(lb_Idx).l_Blob_ID) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for Long Text " & lb_Idx, C_ERR_SERVEURBUSY_MSG
            End If
            ' We can save the blob
            ls_Request = Replace(C_L_DB_REQ_BLOB_LTEXT_ADD, "$ltext_id$", mt_Article.t_LText_ID(lb_Idx).l_Blob_ID)
            ' HTML component provide unicode contents
            ls_Request = Replace(ls_Request, "$ltext$", ConvertCodePageFromUnicode(Replace(Trim(HTML(lb_Idx).HTMLTextInner), "'", "''"), ml_CodePage))
            If (Not mo_Db.ExecuteSQL(ls_Request)) Or (mo_Db.SQLRowsAffected = 0) Then
                Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in Item_Add, #1." & lb_Idx, C_ERR_DB_FAULT_MSG
            End If
        Else
            ' Nothing to save
            mt_Article.t_LText_ID(lb_Idx).l_Blob_ID = -1
        End If
    Next

    ' STEP 1.2 - Pictures
    ' Notice : Only the first picture(company logo) is mandatory
    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Idx = 0 To lb_count
        If pic(lb_Idx).FileName <> "" Then
            If Not GetNextKey(C_DB_TABLE_CM_PCT, mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for picture " & lb_Idx, "#Database serveur is busy. Please, wait a moment and try again"
            End If
            ls_Request = Replace(C_L_DB_REQ_BLOB_RES_ADD, "$res_id$", mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID)
            If Not mo_Db.FileToBlobSQL(ls_Request, pic(lb_Idx).FullFileName) Then
                Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in Item_Add, #2." & lb_Idx, C_ERR_DB_FAULT_MSG
            End If

        Else
            mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID = -1
        End If
    Next

    ' STEP 2 _____ GET ALL OTHER KEY !
    ' Get the key of the article
    If Not GetNextKey(C_DB_TABLE_CM_ARTICLES, mt_Article.l_Art_ID) Then
        Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for Articles", "#Database serveur is busy. Please, wait a moment and try again"
    End If

    ' STEP 2.2 - Object long text (remember that second paragraph is dynamic)
    ' Notice : All texts are required, see Item_Check
    lb_count = UBound(mt_Article.t_LText_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_LText_ID(lb_Idx).l_Blob_ID <> -1 Then
            If Not GetNextKey(C_DB_TABLE_CM_OBJECTS, mt_Article.t_LText_ID(lb_Idx).l_Obj_ID) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for long text object " & lb_Idx, "#Database serveur is busy. Please, wait a moment and try again"
            End If
        Else
            mt_Article.t_LText_ID(lb_Idx).l_Obj_ID = -1
        End If
    Next


    ' STEP 2.3 - Object Pictures
    ' Notice : Only the first picture is mandatory
    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID <> -1 Then
            If Not GetNextKey(C_DB_TABLE_CM_OBJECTS, mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for picture object " & lb_Idx, "#Database serveur is busy. Please, wait a moment and try again"
            End If
        Else
            mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID = -1
        End If
    Next


    'STEP 3 _____ CREATE REQUESTS
       
       ' STEP 3.1 - Articles
    
    ReDim ls_Request_Art(C_L_IDX_ARTL_ADD)
        
    ' Create the article
    ls_Request = Replace(C_L_DB_REQ_ART_ADD, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$tplt_id$", C_TEMPLATE_BUSINESS_CARD_CONTRACTOR)
    'ls_Request = Replace(ls_Request, "$art_desc$", mt_Article.s_Art_Desc)
    ls_Request = Replace(ls_Request, "$art_desc$", Replace(txt_Slogan.Text, "'", "''"))
    ls_Request = Replace(ls_Request, "$login_name$", ms_Username)
    ls_Request = Replace(ls_Request, "$internet_flag$", Internet_Flag)
    ls_Request_Art(C_L_IDX_ART_ADD) = ls_Request
    

    ' Translate it
    ls_Request = Replace(C_L_DB_REQ_ARTT_ADD, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$tplt_id$", C_TEMPLATE_BUSINESS_CARD_CONTRACTOR)
    'ls_Request = Replace(ls_Request, "$art_desc$", mt_Article.s_Art_Desc)
    ls_Request = Replace(ls_Request, "$art_desc$", Replace(txt_Slogan.Text, "'", "''"))
    ls_Request = Replace(ls_Request, "$login_name$", ms_Username)
    ls_Request = Replace(ls_Request, "$internet_flag$", Internet_Flag)
    ls_Request_Art(C_L_IDX_ARTT_ADD) = ls_Request

    ' Link it to the customer
    ls_Request = Replace(C_L_DB_REQ_ARTL_ADD, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace$(ls_Request, "$datatype$", C_LINK_CUSTOMER)
    ls_Request = Replace(ls_Request, "$ccu_capkey$", mt_Article.s_CCU_Capkey)
    ls_Request_Art(C_L_IDX_ARTL_ADD) = ls_Request

    
        ' STEP 3.2 - The Long Text objects requests
    ReDim ls_Request_ObjLText(UBound(mt_Article.t_LText_ID), C_L_IDX_LTEXTL_ADD)
    lb_count = UBound(mt_Article.t_LText_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_LText_ID(lb_Idx).l_Obj_ID <> -1 Then
            
            ls_Request = Replace(C_L_DB_REQ_OBJ_LTEXT_ADD, "$obj_id$", mt_Article.t_LText_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_LTEXT)
            ls_Request = Replace(ls_Request, "$ltext_id$", mt_Article.t_LText_ID(lb_Idx).l_Blob_ID)
            ls_Request = Replace(ls_Request, "$blobtranslated$", C_DB_FLAG_ON)
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXT_ADD) = ls_Request

            ls_Request = Replace(C_L_DB_REQ_OBJ_LTEXTT_ADD, "$obj_id$", mt_Article.t_LText_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_LTEXT)
            ls_Request = Replace(ls_Request, "$ltext_id$", mt_Article.t_LText_ID(lb_Idx).l_Blob_ID)
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXTT_ADD) = ls_Request

            ls_Request = Replace(C_L_DB_REQ_OBJ_LTEXTL_ADD, "$art_id$", mt_Article.l_Art_ID)
            ls_Request = Replace(ls_Request, "$obj_id$", mt_Article.t_LText_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$z_order$", lb_Idx)
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXTL_ADD) = ls_Request
        Else
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXT_ADD) = ""
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXTT_ADD) = ""
            ls_Request_ObjLText(lb_Idx, C_L_IDX_LTEXTL_ADD) = ""
        End If
    Next


    ' STEP 3.3 - The pictures objects requests
    ReDim ls_Request_ObjRes(UBound(mt_Article.t_Pct_ID), C_L_IDX_RESL_ADD)
    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_OBJ_PCT_ADD, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_PICTURE)
            ls_Request = Replace(ls_Request, "$res_id$", mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID)
            ls_Request = Replace(ls_Request, "$blobtranslated$", C_DB_FLAG_ON)
            ls_Request = Replace(ls_Request, "$filename$", pic(lb_Idx).FileName)
            ls_Request = Replace(ls_Request, "$height$", pic(lb_Idx).PicHeight)
            ls_Request = Replace(ls_Request, "$width$", pic(lb_Idx).PicWidth)
            ls_Request = Replace(ls_Request, "$sizeinkb$", GetSizeInKB(pic(lb_Idx).PicSize))
            ls_Request_ObjRes(lb_Idx, C_L_IDX_RES_ADD) = ls_Request
            

            ls_Request = Replace(C_L_DB_REQ_OBJ_PCTT_ADD, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_PICTURE)
            ls_Request = Replace(ls_Request, "$res_id$", mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID)
            ls_Request = Replace(ls_Request, "$filename$", pic(lb_Idx).FileName)
            ls_Request = Replace(ls_Request, "$height$", pic(lb_Idx).PicHeight)
            ls_Request = Replace(ls_Request, "$width$", pic(lb_Idx).PicWidth)
            ls_Request = Replace(ls_Request, "$sizeinkb$", GetSizeInKB(pic(lb_Idx).PicSize))
            ls_Request_ObjRes(lb_Idx, C_L_IDX_REST_ADD) = ls_Request

            ls_Request = Replace(C_L_DB_REQ_OBJ_PCTL_ADD, "$art_id$", mt_Article.l_Art_ID)
            ls_Request = Replace(ls_Request, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$z_order$", lb_Idx)
            ls_Request = Replace(ls_Request, "$anchorname$", C_ANCHOR & lb_Idx)
            ls_Request = Replace(ls_Request, "$legend$", Replace(pic(lb_Idx).PicName, "'", "''"))
            ls_Request_ObjRes(lb_Idx, C_L_IDX_RESL_ADD) = ls_Request
            
        Else
            ls_Request_ObjRes(lb_Idx, C_L_IDX_RES_ADD) = ""
            ls_Request_ObjRes(lb_Idx, C_L_IDX_REST_ADD) = ""
            ls_Request_ObjRes(lb_Idx, C_L_IDX_RESL_ADD) = ""
        End If
    Next


    ' STEP 4 _____ EXECUTE REQUESTS
    Dim lb_Idx2 As Byte, lb_Count2 As Byte

        ' STEP 4.1 - Open the acid transaction
    If Not mo_Db.ExecuteSQL("BEGIN TRAN") Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Add, #50", C_ERR_DB_FAULT_MSG
    End If
    lb_TransactionOpenned = True

        ' STEP 4.2 - Create the article, translate it and link it to external data
    lb_count = UBound(ls_Request_Art, 1)
    For lb_Idx = 0 To lb_count
        If (Not mo_Db.ExecuteSQL(ls_Request_Art(lb_Idx))) Or (mo_Db.SQLRowsAffected = 0) Then
            Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Add, #3", C_ERR_DB_FAULT_MSG
        End If
    Next


        ' STEP 4.3 - Create the objects Text, translate them and link them to the article
    lb_count = UBound(ls_Request_ObjLText, 1)
    lb_Count2 = UBound(ls_Request_ObjLText, 2)
    For lb_Idx = 0 To lb_count
        For lb_Idx2 = 0 To lb_Count2
            If ls_Request_ObjLText(lb_Idx, lb_Idx2) <> "" Then
                If (Not mo_Db.ExecuteSQL(ls_Request_ObjLText(lb_Idx, lb_Idx2))) Or (mo_Db.SQLRowsAffected = 0) Then
                    Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Add, #6." & lb_Idx & "." & lb_Idx2, C_ERR_DB_FAULT_MSG
               End If
            End If
        Next
    Next
    

        ' STEP 4.4 - Create the objects pictures, translate them and link them to the article
    lb_count = UBound(ls_Request_ObjRes, 1)
    lb_Count2 = UBound(ls_Request_ObjRes, 2)
    For lb_Idx = 0 To lb_count
        For lb_Idx2 = 0 To lb_Count2
            If ls_Request_ObjRes(lb_Idx, lb_Idx2) <> "" Then
                If (Not mo_Db.ExecuteSQL(ls_Request_ObjRes(lb_Idx, lb_Idx2))) Or (mo_Db.SQLRowsAffected = 0) Then
                    Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Add, #7." & lb_Idx & "." & lb_Idx2, C_ERR_DB_FAULT_MSG
               End If
            End If
        Next
    Next

        ' STEP 4.5 - Validate the transaction
    If Not mo_Db.ExecuteSQL("COMMIT TRAN") Then
            Call mo_Db.Disconnect
            Call MsgBox(C_ERR_MSG_FATAL_ERROR)
            End
    End If
    
    lb_TransactionOpenned = False
    
    
    Item_Add = True
    
    Exit Function

onError:
    
    If lb_TransactionOpenned Then
        If Not mo_Db.ExecuteSQL("ROLLBACK") Then
            Call mo_Db.Disconnect
            Call MsgBox(C_ERR_MSG_FATAL_ERROR)
            End
        End If
    End If

    If Err.Number > C_ERR_OFFSET Then
        Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    Else
        Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    End If

    ' DELETING THE BLOB
    ' Delete the LongText
    lb_count = UBound(mt_Article.t_LText_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_LText_ID(lb_Idx).l_Blob_ID <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_BLOB_LTEXT_DEL, "$ltext_id$", mt_Article.t_LText_ID(lb_Idx).l_Blob_ID)
            If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                Call SendMessage(C_ERR_DB_DELETEUNCOMPLETE, C_ERR_DB_DELETEUNCOMPLETE_MSG, "Error in deleting Long Text #" & lb_Idx)
            End If
        End If
    Next
    lb_count = UBound(mt_Article.t_Pct_ID)
    For lb_Idx = 0 To lb_count
        If mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_BLOB_RES_DEL, "$res_id$", mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID)
            If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                Call SendMessage(C_ERR_DB_DELETEUNCOMPLETE, C_ERR_DB_DELETEUNCOMPLETE_MSG, "Error in deleting picture #" & lb_Idx)
            End If
        End If
    Next

    SetMousePointer (True)

    Item_Add = False

End Function


' Delete an item
' BE CAREFUL : delete will drop all translation of the article if the item is the master
' Notice : Delete is only set drop information to the article
Private Function Item_Delete() As Boolean


    Const C_L_DB_REQ_ART_DEL As String = "UPDATE CM_Articles" & vbCrLf & _
                                         "SET Drop_Flag = 'X'," & vbCrLf & _
                                         "Drop_Date = GetDate()," & vbCrLf & _
                                         "Z_Last_Upd = GetDate()," & vbCrLf & _
                                         "Z_Last_Upd_User = '$login_name$'," & vbCrLf & _
                                         "iConcurrency = iConcurrency + 1" & vbCrLf & _
                                         "WHERE Art_ID = $art_id$" & vbCrLf
    Const C_L_DB_REQ_ART_DEL_FILTER  As String = " AND iConcurrency = $iconcurrency$ AND Language_code = '$language_code$'" & vbCrLf
    Const C_L_DB_REQ_ART_DEL_TR  As String = "AND Language_code <> '$language_code$'" & vbCrLf

    Dim lb_TransactionOpenned As Boolean
    
    On Error GoTo onError

    Item_Delete = False

    Dim ls_Request As String, ls_RequestTr As String

    ls_Request = C_L_DB_REQ_ART_DEL
    
    
    ls_Request = Replace(C_L_DB_REQ_ART_DEL, "$login_name$", ms_Username)
    ls_Request = Replace(ls_Request, "$art_id$", mt_Article.l_Art_ID)
    ' If the item is not the master we must drop only the translation
    If Master Then
        ls_RequestTr = ls_Request & Replace(C_L_DB_REQ_ART_DEL_TR, "$language_code$", ms_Language_Code)
    End If
    ls_Request = ls_Request & Replace(C_L_DB_REQ_ART_DEL_FILTER, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$iconcurrency$", mt_Article.b_iConcurrency)
    
     If Not mo_Db.ExecuteSQL("BEGIN TRAN Item_Delete") Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Delete, #50", C_ERR_DB_FAULT_MSG
    End If
    
    If Not mo_Db.ExecuteSQL(ls_Request) Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage, C_ERR_DB_FAULT_MSG
    End If
    ' Check concurrency issue
    If mo_Db.SQLRowsAffected = 0 Then
        Call SendMessage(C_ERR_DELETECONCURRENCY, C_ERR_DELETECONCURRENCY, "Art_ID = " & mt_Article.l_Art_ID)
        Exit Function
    End If

    If ls_RequestTr <> "" Then
        If Not mo_Db.ExecuteSQL(ls_RequestTr) Then
            Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage, C_ERR_DB_FAULT_MSG
        End If
        ' Check concurrency issue
        If mo_Db.SQLRowsAffected = 0 Then
            Call SendMessage(C_ERR_DELETECONCURRENCY, C_ERR_DELETECONCURRENCY, "Art_ID = " & mt_Article.l_Art_ID)
            Exit Function
        End If
    End If
    If Not mo_Db.ExecuteSQL("COMMIT TRAN Item_Delete") Then
        Call mo_Db.Disconnect
        Call MsgBox(C_ERR_MSG_FATAL_ERROR)
        End
    End If
    lb_TransactionOpenned = False
    Item_Delete = True
    Exit Function

onError:
    ' Close the openned transaction
    If lb_TransactionOpenned Then
        If Not mo_Db.ExecuteSQL("ROLLBACK Item_Delete") Then
            Call mo_Db.Disconnect
            Call MsgBox(C_ERR_MSG_FATAL_ERROR)
            End
        End If
    End If
    
    If Err.Number > C_ERR_OFFSET Then
        Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    Else
        Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    End If
    Item_Delete = False

End Function


Public Function Item_Update() As Boolean

    ' Create a blob Long Text
    Const C_L_DB_REQ_BLOB_LTEXT_ADD As String = "INSERT INTO CM_LongText (LText_ID, LText)" & vbCrLf & _
                                                "                  VALUES($ltext_id$, N'$ltext$')" & vbCrLf

    ' Update a long text object
    Const C_L_DB_REQ_OBJ_LTEXT_UPD As String = "UPDATE CM_Objects" & vbCrLf & _
                                               "SET LText_ID = $ltext_id$," & vbCrLf & _
                                               "BlobTranslated = 'X'" & vbCrLf & _
                                               "WHERE Obj_ID = $obj_id$ AND Language_Code = '$language_code$'" & vbCrLf


    ' Create a blob picture
    Const C_L_DB_REQ_BLOB_RES_ADD As String = "INSERT INTO CM_RessourcesFiles (Res_ID, Ressource)" & vbCrLf & _
                                              "                         VALUES($res_id$, ?)" & vbCrLf


    Const C_L_DB_REQ_OBJ_PCT_ADD As String = "INSERT INTO CM_Objects (Obj_ID, Language_Code, Obj_Type, Res_ID, BlobTranslated, Obj_Filename, Height, Width, SizeInKb)" & vbCrLf & _
                                             "                VALUES ($obj_id$, '$language_code$', '$obj_type$', $res_id$, '$blobtranslated$', '$filename$', $height$ , $width$, $sizeinkb$)"
    
    Const C_L_DB_REQ_OBJ_PCTL_ADD As String = "INSERT INTO CM_ArticlesObjects (Art_ID, Obj_ID, Language_Code, Z_Order, AnchorName, Legend)" & vbCrLf & _
                                              "                         VALUES($art_id$, $obj_id$, '$language_code$', $z_order$, '$anchorname$', N'$legend$')"



                    
    
    Const C_L_DB_REQ_OBJ_RESL_DEL As String = "DELETE FROM CM_ArticlesObjects WHERE Obj_ID = $obj_id$ AND Language_Code = '$language_code$'"
    Const C_L_DB_REQ_OBJ_RES_DEL As String = "DELETE FROM CM_Objects WHERE Obj_ID = $obj_id$ AND Language_Code = '$language_code$'"


    Const C_L_DB_REQ_OBJ_PCTL_UPD As String = "UPDATE CM_ArticlesObjects" & vbCrLf & _
                                              "SET legend = N'$legend$'" & vbCrLf & _
                                              "WHERE Obj_ID = $obj_id$ AND Language_Code = '$language_code$'" & vbCrLf
    

    Const C_L_DB_REQ_ART_UPD As String = "UPDATE CM_Articles" & vbCrLf & _
                                         "SET Z_Last_Upd = GetDate()," & vbCrLf & _
                                         "Z_Last_Upd_User = '$login_name$', " & vbCrLf & _
                                         "Art_Desc = N'$art_desc$'," & vbCrLf & _
                                         "iConcurrency = iConcurrency + 1," & vbCrLf & _
                                         "Internet_Flag = '$internet_flag$'" & vbCrLf & _
                                         "WHERE Art_ID = $art_id$ AND Language_Code = '$language_code$'" & vbCrLf & _
                                         "AND iConcurrency = $iconcurrency$" & vbCrLf

    Const C_L_DB_REQ_BLOB_LTEXT_DEL As String = "DELETE CM_LongText" & vbCrLf & _
                                                "WHERE LText_ID = $ltext_id$" & vbCrLf & _
                                                "AND NOT EXISTS (SELECT LText_ID FROM CM_Objects WHERE LText_ID = $ltext_id$)" & vbCrLf

    Const C_L_DB_REQ_BLOB_RES_DEL As String = "DELETE CM_RessourcesFiles" & vbCrLf & _
                                              "WHERE Res_ID = $res_id$" & vbCrLf & _
                                              "AND NOT EXISTS (SELECT LText_ID FROM CM_Objects WHERE Res_ID = $res_id$)" & vbCrLf


    Const C_L_IDX_OBJ_LTEXT_UPD As Byte = 0

    Const C_L_IDX_LTEXT_BLOB_ID = 0
    Const C_L_IDX_LTEXT_BLOB_OLD_ID = 1
    Const C_L_IDX_LTEXT_OBJ_ID = 2

    Const C_L_IDX_RES_BLOB_ID = 0
    Const C_L_IDX_RES_BLOB_OLD_ID = 1
    Const C_L_IDX_RES_OBJ_ID = 2

    Const C_L_IDX_OBJ_RES_ADD As Byte = 0
    Const C_L_IDX_OBJ_RESL_ADD As Byte = 1
    Const C_L_IDX_OBJ_RESL_DEL As Byte = 2
    Const C_L_IDX_OBJ_RES_DEL As Byte = 3
    Const C_L_IDX_OBJ_RES_UPD As Byte = 4

    On Error GoTo onError

    Dim lb_Idx As Long, lb_count As Long
    Dim ls_Request As String
    Dim ll_ID_LongText() As Long
    Dim ll_ID_Ressource() As Long
    Dim ls_Request_Obj_LText() As String
    Dim ls_Request_Obj_Res() As String
    Dim ls_Request_Art As String
    
    Dim lb_TransactionOpenned As Boolean    ' True during the acid transaction
    Dim lb_TransactionExecuted As Boolean   ' True after the acide transaction
'
    SetMousePointer (False)
    lb_TransactionOpenned = False
    lb_TransactionExecuted = False
'
    ' STEP 1 _____Save the blob if they have changed

        ' STEP 1.1 - Save long texts have changed
    lb_count = HTML.Count - 1
    ReDim ll_ID_LongText(lb_count, C_L_IDX_LTEXT_OBJ_ID)
    For lb_Idx = 0 To lb_count
        If lb_Idx <> C_HTML_CUSTOMERINFO Then
            ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_OLD_ID) = mt_Article.t_LText_ID(lb_Idx).l_Blob_ID
            If Not GetNextKey(C_DB_TABLE_CM_LTEXT, ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID)) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for Long Text " & lb_Idx, C_ERR_SERVEURBUSY_MSG
            End If
            ' We can save the blob
             ls_Request = Replace(C_L_DB_REQ_BLOB_LTEXT_ADD, "$ltext_id$", ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID))
            ' HTML component provide unicode contents but there is an issue with armsyscom
            ls_Request = Replace(ls_Request, "$ltext$", Replace(ConvertCodePageFromUnicode(Trim(HTML(lb_Idx).HTMLTextInner), ml_CodePage), "'", "''"))
            If (Not mo_Db.ExecuteSQL(ls_Request)) Or (mo_Db.SQLRowsAffected = 0) Then
                Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in Item_Update, #1." & lb_Idx, C_ERR_DB_FAULT_MSG
            End If
        Else
            ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID) = -1
            ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_OLD_ID) = -1
        End If
    Next

        ' STEP 1.2 - Check if pictures have changed
    lb_count = pic.Count - 1
    ReDim ll_ID_Ressource(lb_count, C_L_IDX_RES_OBJ_ID)
    For lb_Idx = 0 To lb_count
        If pic(lb_Idx).PicChanged Then
            ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_OLD_ID) = mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID
            If pic(lb_Idx).FileName <> "" Then
                If Not GetNextKey(C_DB_TABLE_CM_PCT, ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID)) Then
                    ' Server is too busy !
                    Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for picture " & lb_Idx, "#Database serveur is busy. Please, wait a moment and try again"
                Else
                    ls_Request = Replace(C_L_DB_REQ_BLOB_RES_ADD, "$res_id$", ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID))
                    If Not mo_Db.FileToBlobSQL(ls_Request, pic(lb_Idx).FullFileName) Then
                        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in Item_Update, #2." & lb_Idx, C_ERR_DB_FAULT_MSG
                    End If
                End If
            Else
                ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID) = -1
            End If
        Else
            ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID) = -1
            ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_OLD_ID) = -1
        End If
    Next


    ' STEP 2 _____ Preparing the request

        ' STEP 2.1 - Request for update LText objects
    ReDim ls_Request_Obj_LText(UBound(ll_ID_LongText, 1), C_L_IDX_OBJ_LTEXT_UPD)
    lb_count = UBound(ls_Request_Obj_LText)
    For lb_Idx = 0 To lb_count
        If ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID) <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_OBJ_LTEXT_UPD, "$ltext_id$", ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID))
            ls_Request = Replace(ls_Request, "$obj_id$", mt_Article.t_LText_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request_Obj_LText(lb_Idx, C_L_IDX_OBJ_LTEXT_UPD) = ls_Request

        Else
            ls_Request_Obj_LText(lb_Idx, C_L_IDX_OBJ_LTEXT_UPD) = ""
        End If
    Next

        ' STEP 2.2 - Request for create new Pct objects
    ReDim ls_Request_Obj_Res(UBound(ll_ID_Ressource), C_L_IDX_OBJ_RES_UPD)
    lb_count = UBound(ll_ID_Ressource, 1)
    For lb_Idx = 0 To lb_count
        If (ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID) <> -1) Then
            ' Create the key
            If Not GetNextKey(C_DB_TABLE_CM_OBJECTS, ll_ID_Ressource(lb_Idx, C_L_IDX_RES_OBJ_ID)) Then
                Err.Raise C_ERR_OFFSET + C_ERR_SERVEURBUSY, "Unable to get free key for picture object " & lb_Idx, "#Database serveur is busy. Please, wait a moment and try again"
            End If

            ' Create the requests
            ls_Request = Replace(C_L_DB_REQ_OBJ_PCT_ADD, "$obj_id$", ll_ID_Ressource(lb_Idx, C_L_IDX_RES_OBJ_ID))
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$obj_type$", C_OBJECT_PICTURE)
            ls_Request = Replace(ls_Request, "$res_id$", ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID))
            ls_Request = Replace(ls_Request, "$blobtranslated$", C_DB_FLAG_ON)
            ls_Request = Replace(ls_Request, "$filename$", pic(lb_Idx).FileName)
            ls_Request = Replace(ls_Request, "$height$", pic(lb_Idx).PicHeight)
            ls_Request = Replace(ls_Request, "$width$", pic(lb_Idx).PicWidth)
            ls_Request = Replace(ls_Request, "$sizeinkb$", GetSizeInKB(pic(lb_Idx).PicSize))
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_ADD) = ls_Request

            ls_Request = Replace(C_L_DB_REQ_OBJ_PCTL_ADD, "$art_id$", mt_Article.l_Art_ID)
            ls_Request = Replace(ls_Request, "$obj_id$", ll_ID_Ressource(lb_Idx, C_L_IDX_RES_OBJ_ID))
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request = Replace(ls_Request, "$z_order$", lb_Idx)
            ls_Request = Replace(ls_Request, "$anchorname$", C_ANCHOR & lb_Idx)
            ls_Request = Replace(ls_Request, "$legend$", Replace(pic(lb_Idx).PicName, "'", "''"))
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RESL_ADD) = ls_Request
        Else
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_ADD) = ""
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RESL_ADD) = ""
            ll_ID_Ressource(lb_Idx, C_L_IDX_RES_OBJ_ID) = -1
        End If
    Next

        ' STEP 2.3 - Request for delete old objects
    lb_count = UBound(ll_ID_Ressource, 1)
    For lb_Idx = 0 To lb_count
        If (ll_ID_Ressource(lb_Idx, C_L_IDX_LTEXT_BLOB_OLD_ID) <> -1) Then
            ls_Request = Replace(C_L_DB_REQ_OBJ_RESL_DEL, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RESL_DEL) = ls_Request
            
            ls_Request = Replace(C_L_DB_REQ_OBJ_RES_DEL, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_DEL) = ls_Request
        Else
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RESL_DEL) = ""
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_DEL) = ""
        End If
    Next

        ' STEP 2.4 - Reqyest for update legend of unchanged picture
    lb_count = UBound(ll_ID_Ressource, 1)
    For lb_Idx = 0 To lb_count
        If (Not pic(lb_Idx).PicChanged) And (pic(lb_Idx).FileName <> "") Then
            ls_Request = Replace(C_L_DB_REQ_OBJ_PCTL_UPD, "$legend$", Replace(pic(lb_Idx).PicName, "'", "''"))
            ls_Request = Replace(ls_Request, "$obj_id$", mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID)
            ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_UPD) = ls_Request
        Else
            ls_Request_Obj_Res(lb_Idx, C_L_IDX_OBJ_RES_UPD) = ""
        End If
    Next


        ' STEP 2.5 - Request for the article
        
    ls_Request = Replace(C_L_DB_REQ_ART_UPD, "$login_name$", ms_Username)
    ls_Request = Replace(ls_Request, "$internet_flag$", Internet_Flag)
    ls_Request = Replace(ls_Request, "$art_id$", mt_Article.l_Art_ID)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    ls_Request = Replace(ls_Request, "$art_desc$", Replace(txt_Slogan.Text, "'", "''"))
    ls_Request = Replace(ls_Request, "$iconcurrency$", mt_Article.b_iConcurrency)
    ls_Request_Art = ls_Request


    ' STEP 3 - EXECUTION OF THE REQUEST
        
        ' STEP 3.1 - Open the transaction
    If Not mo_Db.ExecuteSQL("BEGIN TRAN") Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Update, #50", C_ERR_DB_FAULT_MSG
    End If

    lb_TransactionOpenned = True

        ' STEP 3.1 - Execute article request
    If Not mo_Db.ExecuteSQL(ls_Request_Art) Then
        Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Update, #3", C_ERR_DB_FAULT_MSG
    End If

    If mo_Db.SQLRowsAffected = 0 Then
        Err.Raise C_ERR_OFFSET + C_ERR_UPDATECONCURRENCY, "Error in Item_Update", C_ERR_UPDATECONCURRENCY_MSG
    End If

        ' STEP 3.2 - Execute long text request
    Dim lb_Idx2 As Long, lb_Count2 As Long
    lb_count = UBound(ls_Request_Obj_LText, 1)
    lb_Count2 = UBound(ls_Request_Obj_LText, 2)
    For lb_Idx = 0 To lb_count
        For lb_Idx2 = 0 To lb_Count2
            If ls_Request_Obj_LText(lb_Idx, lb_Idx2) <> "" Then
                If (Not mo_Db.ExecuteSQL(ls_Request_Obj_LText(lb_Idx, lb_Idx2))) Or (mo_Db.SQLRowsAffected = 0) Then
                    Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Update, #5." & lb_Idx & "." & lb_Idx2, C_ERR_DB_FAULT_MSG
                End If
            End If
        Next
    Next


        ' STEP 3.3 - Execute picture request
    lb_count = UBound(ls_Request_Obj_Res, 1)
    lb_Count2 = UBound(ls_Request_Obj_Res, 2)
    For lb_Idx = 0 To lb_count
        For lb_Idx2 = 0 To lb_Count2
            If ls_Request_Obj_Res(lb_Idx, lb_Idx2) <> "" Then
                If (Not mo_Db.ExecuteSQL(ls_Request_Obj_Res(lb_Idx, lb_Idx2))) Or (mo_Db.SQLRowsAffected = 0) Then
                    Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mo_Db.LastErrorCode & " : " & mo_Db.LastErrorMessage & "Error in ArmbusCard::Item_Update, #14." & lb_Idx & "." & lb_Idx2, C_ERR_DB_FAULT_MSG
                End If
            End If
        Next
    Next

        ' STEP 3.4 - Close the transaction
    If Not mo_Db.ExecuteSQL("COMMIT TRAN") Then
            Call mo_Db.Disconnect
            Call MsgBox(C_ERR_MSG_FATAL_ERROR)
            End
    End If
    lb_TransactionOpenned = False
    lb_TransactionExecuted = True


    ' STEP 4 _____ DELETE THE UNUSED DATA
        ' STEP 4.1 - Delete the LTEXT replaced
    lb_count = UBound(ll_ID_LongText, 1)
    For lb_Idx = 0 To lb_count
        If ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_OLD_ID) <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_BLOB_LTEXT_DEL, "$ltext_id$", mt_Article.t_LText_ID(lb_Idx).l_Blob_ID)
            If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                Err.Raise C_ERR_OFFSET + C_ERR_DB_DELETEUNCOMPLETE, "Error in deleting Long Text #" & lb_Idx, C_ERR_DB_DELETEUNCOMPLETE_MSG
            End If
        End If
    Next

        ' STEP 4.2 - Delete the Picture replaced
    lb_count = UBound(ll_ID_Ressource, 1)
    For lb_Idx = 0 To lb_count
        If ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_OLD_ID) <> -1 Then
            ls_Request = Replace(C_L_DB_REQ_BLOB_RES_DEL, "$res_id$", mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID)
            If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                Err.Raise C_ERR_OFFSET + C_ERR_DB_DELETEUNCOMPLETE, "Error in deleting picture#" & lb_Idx, C_ERR_DB_DELETEUNCOMPLETE_MSG
            End If
        End If
    Next

    ' STEP 5 _____ UPDATING THE LOCAL ID

        ' STEP 5.1 - Register the LText ID
    lb_count = UBound(ll_ID_LongText, 1)
    For lb_Idx = 0 To lb_count
        If ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID) <> -1 Then
            mt_Article.t_LText_ID(lb_Idx).l_Blob_ID = ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID)
            mt_Article.t_LText_ID(lb_Idx).b_Translated = True
        End If
    Next

        ' STEP 5.2 - Register the new Picture, update and delete
    lb_count = UBound(ll_ID_Ressource, 1)
    For lb_Idx = 0 To lb_count
        If ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID) <> -1 Then
            mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID = ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID)
            mt_Article.t_Pct_ID(lb_Idx).b_Translated = True
            mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID = ll_ID_Ressource(lb_Idx, C_L_IDX_RES_OBJ_ID)
        Else
            If pic(lb_Idx).FileName = "" Then
                mt_Article.t_Pct_ID(lb_Idx).l_Blob_ID = -1
                mt_Article.t_Pct_ID(lb_Idx).l_Obj_ID = -1
                mt_Article.t_Pct_ID(lb_Idx).b_Translated = False
            End If
        End If
    Next

    mt_Article.b_iConcurrency = mt_Article.b_iConcurrency + 1

    SetMousePointer (True)
    Item_Update = True
    Exit Function

onError:

    Item_Update = False

    ' Close the openned transaction
    If lb_TransactionOpenned Then
        If Not mo_Db.ExecuteSQL("ROLLBACK") Then
            Call mo_Db.Disconnect
            Call MsgBox(C_ERR_MSG_FATAL_ERROR)
            End
        End If
    End If

    SetMousePointer (True)

    If Err.Number > C_ERR_OFFSET Then
        Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    Else
        Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    End If

    ' If error occured before the end of the transaction, we have to delete the new blob
    If Not lb_TransactionExecuted Then
        lb_count = UBound(ll_ID_LongText, 1)
        For lb_Idx = 0 To lb_count
            If ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID) <> -1 Then
                ls_Request = Replace(C_L_DB_REQ_BLOB_LTEXT_DEL, "$ltext_id$", ll_ID_LongText(lb_Idx, C_L_IDX_LTEXT_BLOB_ID))
                If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                    Call SendMessage(C_ERR_DB_DELETEUNCOMPLETE, C_ERR_DB_DELETEUNCOMPLETE_MSG, "Error in deleting Long Text #" & lb_Idx)
                End If
            End If
        Next

        lb_count = UBound(ll_ID_Ressource, 1)
        For lb_Idx = 0 To lb_count
            If ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID) <> -1 Then
                ls_Request = Replace(C_L_DB_REQ_BLOB_RES_DEL, "$res_id$", ll_ID_Ressource(lb_Idx, C_L_IDX_RES_BLOB_ID))
                If (Not mo_Db.ExecuteSQL(ls_Request)) Then
                    Call SendMessage(C_ERR_DB_DELETEUNCOMPLETE, C_ERR_DB_DELETEUNCOMPLETE_MSG, "Error in deleting Long Text #" & lb_Idx)
                End If
            End If
        Next

         'If the error occured after the transaction, it not really important
         ' but the local id may be corrupted and should be reloaded
         'from the server
         Call SendMessage(C_ERR_LOCALCORRUPTED, C_ERR_LOCALCORRUPTED_MSG)
         Dim ll_Buffer As Long
         ll_Buffer = mt_Article.l_Art_ID
         Call Item_ResetData
         mt_Article.l_Art_ID = ll_Buffer
         Item_Update = Item_Load
    End If

End Function



Public Function Load_Constraints() As Boolean


    On Error GoTo onError

    Const C_L_DB_LTEXT_CONSTRAINTS As String = "SELECT Z_Order_Min, Z_Order_Max, Required, MaxChar, MinChar" & vbCrLf & _
                                               "FROM CM_TpltConstraints CTC" & vbCrLf & _
                                               "INNER JOIN CM_ObjTypeConstraints COC ON COC.OTCrt_ID = CTC.OTCrt_ID" & vbCrLf & _
                                               "      AND COC.Language_Code = CTC.Language_Code" & vbCrLf & _
                                               "      AND COC.Obj_Type = '$obj_type$'" & vbCrLf & _
                                               "WHERE CTC.Tplt_ID = $tplt_id$ AND CTC.Language_Code = '$language_code$'" & vbCrLf
    
    Const C_L_DB_PICTURE_CONSTRAINTS As String = "SELECT Z_Order_Min, Z_Order_Max, Required, MaxSizeInKB, MinHeight, MaxHeight, MinWidth, MaxWidth, Shape" & vbCrLf & _
                                                 "FROM CM_TpltConstraints CTC" & vbCrLf & _
                                                 "INNER JOIN CM_ObjTypeConstraints COC ON COC.OTCrt_ID = CTC.OTCrt_ID" & vbCrLf & _
                                                 "      AND COC.Language_Code = CTC.Language_Code" & vbCrLf & _
                                                 "      AND COC.Obj_Type = '$obj_type$'" & vbCrLf & _
                                                 "WHERE CTC.Tplt_ID = $tplt_id$ AND CTC.Language_Code = '$language_code$'" & vbCrLf
    
    
    Dim lb_Idx As Byte, lc_Cursor As Long, ls_Request As String
    Dim lb_MinIdx As Byte, lb_MaxIdx As Byte

    ' STEP 1 - Load constraints for LongText
    ls_Request = Replace(C_L_DB_LTEXT_CONSTRAINTS, "$obj_type$", C_OBJECT_LTEXT)
    ls_Request = Replace(ls_Request, "$tplt_id$", C_TEMPLATE_BUSINESS_CARD_CONTRACTOR)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If mo_Db.LastErrorCode <> 0 Then GoTo onError
    
    Do Until mo_Db.EOF(lc_Cursor)
        
        ' Determines the set of data
        lb_MinIdx = IIf(mo_Db.GetFields(lc_Cursor, "Z_Order_Min") <= UBound(mt_Article.t_LText_ID), mo_Db.GetFields(lc_Cursor, "Z_Order_Min"), UBound(mt_Article.t_LText_ID))
        lb_MaxIdx = IIf(mo_Db.GetFields(lc_Cursor, "Z_Order_Max") <= UBound(mt_Article.t_LText_ID), mo_Db.GetFields(lc_Cursor, "Z_Order_Max"), UBound(mt_Article.t_LText_ID))
            
        ' Apply the rule
        For lb_Idx = lb_MinIdx To lb_MaxIdx
            mt_Article.t_LText_ID(lb_Idx).t_Constraint.b_Required = (mo_Db.GetFields(lc_Cursor, "Required") = C_DB_FLAG_ON)
            mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MaxChar = mo_Db.GetFields(lc_Cursor, "MaxChar")
            mt_Article.t_LText_ID(lb_Idx).t_Constraint.i_MinChar = mo_Db.GetFields(lc_Cursor, "MinChar")
        Next
        mo_Db.Next (lc_Cursor)
    Loop
        
    mo_Db.Close (lc_Cursor)
        
    ' STEP 2 - Load constraints for pictures
    ls_Request = Replace(C_L_DB_PICTURE_CONSTRAINTS, "$obj_type$", C_OBJECT_PICTURE)
    ls_Request = Replace(ls_Request, "$tplt_id$", C_TEMPLATE_BUSINESS_CARD_CONTRACTOR)
    ls_Request = Replace(ls_Request, "$language_code$", ms_Language_Code)
    
    lc_Cursor = mo_Db.OpenSQL(ls_Request)
    If mo_Db.LastErrorCode <> 0 Then GoTo onError
    
    Do Until mo_Db.EOF(lc_Cursor)
        ' Determines the set of data
        lb_MinIdx = IIf(mo_Db.GetFields(lc_Cursor, "Z_Order_Min") <= UBound(mt_Article.t_Pct_ID), mo_Db.GetFields(lc_Cursor, "Z_Order_Min"), UBound(mt_Article.t_Pct_ID))
        lb_MaxIdx = IIf(mo_Db.GetFields(lc_Cursor, "Z_Order_Max") <= UBound(mt_Article.t_Pct_ID), mo_Db.GetFields(lc_Cursor, "Z_Order_Max"), UBound(mt_Article.t_Pct_ID))
            
        ' Apply the rule
        For lb_Idx = lb_MinIdx To lb_MaxIdx
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.b_Required = (mo_Db.GetFields(lc_Cursor, "Required") = C_DB_FLAG_ON)
            
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxSizeInKB = mo_Db.GetFields(lc_Cursor, "MaxSizeInKB")
            
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinHeight = mo_Db.GetFields(lc_Cursor, "MinHeight")
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxHeight = mo_Db.GetFields(lc_Cursor, "MaxHeight")
            
            
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MinWidth = mo_Db.GetFields(lc_Cursor, "MinWidth")
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.i_MaxWidth = mo_Db.GetFields(lc_Cursor, "MaxWidth")
            
            mt_Article.t_Pct_ID(lb_Idx).t_Constraint.s_Shape = mo_Db.GetFields(lc_Cursor, "Shape")
            
        Next
        mo_Db.Next (lc_Cursor)
    Loop
        
    mo_Db.Close (lc_Cursor)
    Load_Constraints = True
    Exit Function

onError:
    mo_Db.Close (lc_Cursor)
    Load_Constraints = False

End Function


Private Function GetSizeInKB(ByVal al_Size As Long)
    GetSizeInKB = IIf(al_Size > 1024, Round(al_Size / 1024, 0), 1)
End Function

