'********************************************** *
' Описание: Класс человека
' Автор: gwd 06.11.2002 г.
' Ссылка: pub/constpub.asp
'********************************************** * Класс Cls_Person Private m_intId 'Id, соответствующий положению узла Person в коллекции Persons.
Частное m_strName 'Имя
Private m_strNick 'английское имя
Private m_strMobile 'Мобильный телефон
Частный m_strTel 'Телефон
Частный m_strEmail ' Электронная почта
Частный m_strQQ 'Номер QQ
Частная компания m_strCompany
Инициализация частного класса m_strError 'сообщение об ошибке '
Частный подкласс_Initialize()
m_strError = ""
m_intId = -1
Завершить выпуск подкласса
Частный подкласс_Terminate()
m_strError = ""
End Sub '-----Чтение и запись каждого свойства--------------------------- Public Property Get Id
Идентификатор = m_intId
Публичное свойство конечного свойства Let Id(intId)
m_intId = intId
Конечная собственность Публичная собственность Получить имя
Имя = m_strName
Публичное свойство конечного свойства Let Name(strName)
m_strName = имя_строки
Конечная собственность. Публичная собственность. Получить ник
Ник = m_strNick
Конечная собственность Открытая собственность Let Nick(strNick)
m_strNick = strNick
Конечная собственность Государственная собственность Станьте мобильным
Мобильный = m_strMobile
Конечная собственность Публичная собственность Let Mobile(strMobile)
m_strMobile = strMobile
Конечная собственность Государственная собственность Получить тел.
Тел = m_strTel
Конечное свойство Открытое свойство Let Tel(strTel)
m_strTel = стрТел
Конечная собственность Публичная собственность Получить электронную почту
Электронная почта = m_strEmail
Общее свойство End Property Let Email(strEmail)
m_strEmail = strEmail
Конечная собственность Публичная собственность Получить QQ
QQ = m_strQQ
Конечное свойство Открытое свойство Let QQ(strQQ)
m_strQQ = strQQ
Конечная собственность Государственная собственность Получить компанию
Компания = m_strCompany
Конечная собственность Public Property Let Company(strCompany)
m_strCompany = стрКомпани
Конечное свойство '----------------------------------------------- -- 'Получить информацию об ошибке
Открытая функция GetLastError()
GetLastError = m_strError
Завершить функцию 'частный метод, добавить сообщение об ошибке
Частная подписка AddErr(strEcho)
m_strError = m_strError + "＜Div CLASS=""alert""＞" & strEcho & "＜/Div＞"
End Sub 'Удалить сообщение об ошибке
Открытая функция ClearError()
m_strError = ""
Конечная функция 'Прочитайте данные указанного узла из Xml и заполните каждый атрибут.
'Сначала вам нужно установить идентификатор
Открытая функция GetInfoFromXml(objXmlDoc)
Тусклый список объектов objNodeList
Dim I ClearError Если objXmlDoc ничего не значит, тогда
GetInfoFromXml = Ложь
AddErr «Объект DOM имеет значение null»
Выход из функции
Конец Если Если CStr(m_intId) = "-1" Тогда
GetInfoFromXml = Ложь
AddErr «Атрибут ID объекта контакта установлен неправильно»
Выход из функции
Еще
I = m_intId - 1 'Чтобы прочитать позицию узла. End If 'Выберите и прочитайте информацию об узле, назначьте каждый атрибут. Set objNodeList = objXmlDoc.getElementsByTagName("Person")
Если objNodeList.length - m_intId >= 0 Тогда
При ошибке Возобновить Далее
m_strName = objNodeList(I).selectSingleNode("Имя").Text
m_strNick = objNodeList(I).selectSingleNode("Ник").Text
m_strMobile = objNodeList(I).selectSingleNode("Mobile").Text
m_strTel = objNodeList(I).selectSingleNode("Tel").Text
m_strEmail = objNodeList(I).selectSingleNode("Электронная почта").Text
m_strQQ = objNodeList(I).selectSingleNode("QQ").Text
m_strCompany = objNodeList(I).selectSingleNode("Компания").Text
GetInfoFromXml = Истина
Еще
GetInfoFromXml = Ложь
AddErr «Произошла ошибка при получении контактной информации»
Установить objNodeList = Ничего
Выход из функции
Конец, если
Установить objNodeList = Ничего
Конечная функция 'Добавить информацию в XML-файл
'Сначала вам необходимо установить атрибуты для заполнения
Открытая функция AddToXml(objXmlDoc)
Dim objPerson, objNode ClearError Если objXmlDoc ничего не значит, тогда
Аддтоксмл = ложь
AddErr «Объект DOM имеет значение null»
Выход из функции
End If ' Создать узел Person Set objPerson = objXmlDoc.createElement("Person")
objXmlDoc.documentElement.appendChild objPerson 'Создать каждый дочерний узел'-------------------------------------- --- ---------------
Установите objNode = objXmlDoc.createElement("Имя")
objNode.Text = m_strName
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Ник")
objNode.Text = m_strNick
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Mobile")
objNode.Text = m_strMobile
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Тел")
objNode.Text = m_strTel
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Электронная почта")
objNode.Text = m_strEmail
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("QQ")
objNode.Text = m_strQQ
objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Компания")
objNode.Text = m_strCompany
objPerson.appendChild objNode
'------------------------------------------------ - --- Установить objNode = Ничего
Установить objPerson = Ничего при ошибке. Возобновить дальше.
objXmlDoc.save Server.MapPath(C_XMLFILE) 'Сохранить файл XMLIf Err.Number = 0 Тогда
Аддтоксмл = Истина
Еще
Аддтоксмл = ложь
AddErr Err.Description
Конец, если
Конечная функция «Удалить данные из XML-файла»
'Сначала вам нужно установить идентификатор
Открытая функция DeleteFromXml(objXmlDoc)
Dim objNodeList, objNode ClearError Если objXmlDoc ничего не значит, тогда
УдалитьФромXml = Ложь
AddErr «Объект DOM имеет значение null»
Выход из функции
Конец Если Если CStr(m_intId) = "-1" Тогда
УдалитьФромXml = Ложь
AddErr «Атрибут ID объекта контакта установлен неправильно»
Выход из функции
End If Set objNodeList = objXmlDoc.getElementsByTagName("Person")
Если objNodeList.length - m_intId < 0 Тогда
УдалитьФромXml = Ложь
AddErr "Соответствующий контакт не найден"
Установить objNodeList = Ничего
Выход из функции
Конец При ошибке Возобновить Далее
Установить objNode = objXmlDoc.documentElement.removeChild(objNodeList(intId-1))
Если objNode — это ничего, тогда
УдалитьФромXml = Ложь
AddErr «Не удалось удалить контакт»
Установить objNodeList = Ничего
Выход из функции
Еще
objXmlDoc.save Server.MapPath(C_XMLFILE)
Конец, если
Установить objNode = Ничего
Установить objNodeList = Ничего Если Err.Number = 0 Тогда
УдалитьИзXml = Истина
Еще
УдалитьФромXml = Ложь
AddErr Err.Description
Конец, если
Конечная функция «Изменить данные в XML-файле»
'Сначала вам нужно установить идентификатор
Открытая функция EditToXml(objXmlDoc)
Dim objPersonList, objOldPerson, objNewPerson, objNode ClearError Если objXmlDoc ничего не значит, тогда
EditToXml = Ложь
AddErr «Объект DOM имеет значение null»
Выход из функции
Конец Если Если CStr(m_intId) = "-1" Тогда
EditToXml = Ложь
AddErr «Атрибут ID объекта контакта установлен неправильно»
Выход из функции
End If Set objPersonList = objXmlDoc.getElementsByTagName("Person")
Если objPersonList.length - m_intId < 0 Тогда
УдалитьФромXml = Ложь
AddErr "Соответствующий контакт не найден"
Установить objPersonList = Ничего
Выход из функции
End If Set objOldPerson = objPersonList(m_intId-1) ' Старый узел, который необходимо изменить Set objNewPerson = objXmlDoc.createElement("Person") ' Новый узел, используемый для замены старого узла Set objNode = objXmlDoc.createElement("Name")
objNode.Text = m_strName
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Ник")
objNode.Text = m_strNick
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Mobile")
objNode.Text = m_strMobile
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Тел")
objNode.Text = m_strTel
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Электронная почта")
objNode.Text = m_strEmail
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("QQ")
objNode.Text = m_strQQ
objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Компания")
objNode.Text = m_strCompany
objNewPerson.appendChild objNode При ошибке Возобновить Далее
'Заменить набор objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson)
Если objNode — это ничего, тогда
EditToXml = Ложь
AddErr «Не удалось изменить контакт»
Установить objOldPerosn = Ничего
Установить objNewPerson = Ничего
Установить objPersonList = Ничего
Выход из функции
Еще
objXmlDoc.save Server.MapPath(C_XMLFILE)
Конец, если Set objOldPerson = Ничего
Установить objNewPerson = Ничего
Установить objPersonList = Ничего Если Err.Number = 0 Тогда
EditToXml = Истина
Еще
EditToXml = Ложь
AddErr Err.Description
Конец, если
Конечная функция Конечный класс | 