Разработка программного кода

Добавляем библиотеку для работы с файлами ХМЛ.

Imports System.Xml.

Задаем переменные, имена баз и их местонахождение.

Public Class Form1.

'переменные.

'баз общая.

Public fileName As String = «basefull.ank» .

Public fileNameBU As String.

' для удаления записей.

Dim fileName2 As String = «tmp2.ank» .

Dim fileName3 As String = «tmp3.ank» .

Dim D As Date = Now 'date Переменная для времени.

'При загрузке — высчитывается количество записей в начальной базе.

'загрузка формы.

Private Sub Form1_Load (sender As Object, e As EventArgs) Handles MyBase.Load.

maxIDxml (fileName).

End Sub.

' (1) Процедура записи позиции.

Private Sub addProduct (ByVal pID As String, ByVal pName As String, ByVal pPrice As String, _.

ByVal writer As Xml. XmlTextWriter).

writer.WriteStartElement («anek»).

' Запись открывающего тега.

writer.WriteStartElement («id»).

' Запись обычных тексовых данных в качестве содержимого тега.

writer.WriteString (pID).

' Запись закрывающего тега.

writer.WriteEndElement ().

writer.WriteStartElement («text»).

writer.WriteString (pName).

writer.WriteEndElement ().

writer.WriteStartElement («rang»).

writer.WriteString (pPrice).

writer.WriteEndElement ().

writer.WriteEndElement ().

End Sub.

' (2) новый хмл.

Sub newFile ().

' проверям наличие файла.

If IO.File.Exists (fileName) Then.

fileNameBU = Format (D, «BU yyyy_MM_dd_HHmmssfff.bu»).

IO.File.Copy (fileName, fileNameBU).

End If.

' Создаем объект для записи XML-данных.

Dim Writer As New Xml. XmlTextWriter («basefull.ank», System.Text.Encoding.UTF8).

' Записываем объявление версии XML.

Writer.WriteStartDocument (True).

' Указываем, что XML-документ должен быть отформатирован.

Writer.Formatting = Xml.Formatting.Indented.

' Задаем 2 пробела для выделения вложенных данных.

Writer.Indentation = 2.

' Записываем открывающий тег.

Writer.WriteStartElement («Table»).

' Вызываем процедуру записи позиции.

addProduct (1, «», 0, Writer).

addProduct (2, «», 0, Writer).

addProduct (3, «», 0, Writer).

' Закрываем тег.

Writer.WriteEndElement ().

' Заканчиваем запись (закрываем все не закрытые элементы).

Writer.WriteEndDocument ().

' Закрываем файл.

Writer.Close ().

End Sub.

' (3) получение последнего (наибольшего) номерa ID.

Sub maxIDxml (files As String).

If IO.File.Exists (fileName) Then.

' «Файл уже существует» .

Else.

newFile ().

End If.

Dim xdoc As XDocument = XDocument. Load (files).

Dim maxId = 0.

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value > maxId Then.

maxId += 1.

End If.

Next.

Me.Text = Str (maxId).

ToolStripStatusLabel1.Text = fileName.

ToolStripStatusLabel2.Text = maxId.

End Sub.

' (4) показывает текст по номеру ID (из нумератора).

Sub element1().

Dim nnn = NumericUpDown1.Value.

maxIDxml (fileName).

Dim maxId_ = Val (Me.Text).

NumericUpDown1.Maximum = maxId_.

Dim xdoc As XDocument = XDocument. Load (fileName).

rtxOtvet.Text = «» .

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value = nnn Then.

rtxOtvet.Text += xe. Elements («id»).Value + ") «.

rtxOtvet.Text += xe. Elements («text»).Value + «ранг «.

rtxOtvet.Text += xe. Elements («rang»).Value + vbCrLf.

ComboBox1.Text = xe. Elements («rang»).Value.

End If.

Next.

End Sub.

' (5−1) удаление (1).

Sub del1().

'———1.

'значение из последнего записываем в удаленный.

'загрузка документа.

Dim xdoc As XDocument = XDocument. Load (fileName).

'из последней сохраняем в переменные.

Dim maxiZap = Val (Me.Text).

Dim nameMax = «» .

Dim priceMax = «» .

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value = maxiZap Then.

nameMax = xe. Elements («text»).Value.

priceMax = xe. Elements («rang»).Value.

End If.

Next.

'из переменных во 2.

Dim etot = NumericUpDown1.Value.

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value = etot Then.

xe.Elements («text»).Value = nameMax.

xe.Elements («rang»).Value = priceMax.

xdoc.Save (fileName2).

End If.

Next.

'————;

'удаление записи последней.

'загрузка документа.

Dim xdoc2 As XDocument = XDocument. Load (fileName2).

Dim id = maxiZap.

On Error Resume Next.

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value = id Then.

xe.RemoveAll ().

xdoc.Descendants («anek»).Where (Function (el) el. Attribute («id»).Value.Equals (Str (id))).Remove ().

xdoc.Save (fileName2).

Exit Sub.

End If.

Next.

End Sub.

' (5−2) удаление (2) — подчищаем файл от записи ««.

Sub delOstatok ().

'—————-2.

Dim mass () = IO.File.ReadAllLines (fileName2, System.Text.Encoding.Default).

Dim max = mass.Length.

Dim massTMP (max).

Dim File As IO.StreamWriter.

File = IO.File.CreateText (fileName3).

For i = 0 To max — 1.

If mass (i) «» Then.

massTMP (i) = mass (i).

File.WriteLine (massTMP (i)).

End If.

Next.

File.Close ().

End Sub.

' (5−3) удаление (3) — удаляем все временные файлы и заменяем основной файл на измененный.

Sub delTempFile ().

'————————-3.

IO.File.Delete (fileName).

IO.File.Delete (fileName2).

IO.File.Copy (fileName3, fileName).

IO.File.Delete (fileName3).

End Sub.

' (6) смена ранга.

Sub RANG (rx As Integer).

Dim nnn = NumericUpDown1.Value.

Dim xdoc As XDocument = XDocument. Load (fileName).

For Each xe As XElement In xdoc. Element («Table»).Elements («anek»).

If xe. Element («id»).Value = nnn Then.

xe.Elements («rang»).Value = rx.

xdoc.Save (fileName).

End If.

Next.

element1().

End Sub.

(8) импорт — конвертер тхт, а анк.

Sub importFromTXT (filestxt As String, fileAnk As String).

' Dim r As New Random.

Dim bk.

Dim masStrFull ().

Dim mString () = IO.File.ReadAllLines (filestxt, System.Text.Encoding.Default) 'Загоняем текст построчно в массив.

Dim miniStr ().

Dim x = 0.

Dim xz = 0.

Dim numbers = 1.

'из тхт в хмл.

' Создаем объект для записи XML-данных.

Dim Writer As New Xml. XmlTextWriter (fileAnk, System.Text.Encoding.UTF8).

' Записываем объявление версии XML.

Writer.WriteStartDocument (True).

' Указываем, что XML-документ должен быть отформатирован.

Writer.Formatting = Xml.Formatting.Indented.

' Задаем 2 пробела для выделения вложенных данных.

Writer.Indentation = 2.

' Записываем открывающий тег.

Writer.WriteStartElement («Table»).

' Вызываем процедуру записи позиции.

'—————;

'-создание файла хмл из тхт.

bk = mString.Length.

ReDim masStrFull (bk).

ReDim miniStr (bk).

'-весь массив строк проходит проверку.

'-между *** это отдельный элемент нового массива.

For i = 0 To (bk — 1).

If mString (i) = «*** «Then.

miniStr (xz) = mString (i).

xz += 1.

End If.

masStrFull (xz) += mString (i) + vbNewLine.

Next i.

'- теперь каждый новый элемент записываем в файл.

'-(если он не равен пустой строке).

For j = 0 To (masStrFull.Length — 1).

If masStrFull (j) «» Then.

addProduct (j, masStrFull (j), «0», Writer).

End If.

Next.

' Закрываем тег.

Writer.WriteEndElement ().

' Заканчиваем запись (закрываем все не закрытые элементы).

Writer.WriteEndDocument ().

' Закрываем файл.

Writer.Close ().

End Sub.

'-меню-Случайный———————-;

Private Sub СлучайныйToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles СлучайныйToolStripMenuItem.Click.

maxIDxml (fileName).

Dim r As New Random.

Dim max = Val (Me.Text).

Randomize ().

Dim randoms.

randoms = r. Next (1, max).

NumericUpDown1.Value = randoms.

element1().

End Sub.

'-меню-+1 (—>).

Private Sub ToolStripMenuItem3_Click (sender As Object, e As EventArgs) Handles ToolStripMenuItem3.Click.

If NumericUpDown1. Value < Val (Me.Text) Then.

NumericUpDown1.Value += 1.

End If.

End Sub.

'-меню—1 (<—).

Private Sub ToolStripMenuItem2_Click (sender As Object, e As EventArgs) Handles ToolStripMenuItem2.Click.

If NumericUpDown1. Value > 1 Then.

NumericUpDown1.Value -= 1.

End If.

End Sub.

'-меню-из ТХТ в ANK (***) Конвертирование из ТХТ в АНК.

Private Sub Txt2AnkToolStripMenuItem1_Click (sender As Object, e As EventArgs) Handles Txt2AnkToolStripMenuItem1.Click.

' Указываем начальную папку.

OFD1.InitialDirectory = Application.StartupPath.

' Указываем заголовок.

OFD1.Title = «Откр файл ТХТ «.

' При помощи фильтра можно отбросить ненужные типы файлов.

OFD1.Filter = «TXT|*.txt» .

If OFD1. ShowDialog = DialogResult. OK Then.

Dim filestxt = OFD1.FileName.

Dim fileAnk = FileIO.FileSystem.GetFileInfo (filestxt).Name + «.ank» .

importFromTXT (filestxt, fileAnk).

End If.

End Sub.

'-меню-ФАЙЛ-Новая база—————————-;

Private Sub НоваяБазаToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles НоваяБазаToolStripMenuItem.Click.

newFile ().

element1().

End Sub.

'-меню-ФАЙЛ-загрузка базы.

Private Sub ЗагрузитьToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles ЗагрузитьToolStripMenuItem.Click.

' Указываем начальную папку.

OFD1.InitialDirectory = Application.StartupPath.

' Указываем заголовок.

OFD1.Title = «Откр Базу «.

' При помощи фильтра можно отбросить ненужные типы файлов.

OFD1.Filter = «Анекдоты|*.ank|РезКоп|*.bu|Все|*.*» .

' Если есть список выбора типов, то можно указать какой тип будет выбран при загрузке диалога.

OFD1.FilterIndex = 1.

If OFD1. ShowDialog = DialogResult. OK Then.

fileName = OFD1.FileName.

NumericUpDown1.Value = 1.

element1().

End If.

End Sub.

'-меню-ФАЙЛ-сохранить копию базы.

Private Sub СохранитьКопиюToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles СохранитьКопиюToolStripMenuItem.Click.

' Указываем начальную папку.

SFD1.InitialDirectory = Application.StartupPath.

' Указываем заголовок.

SFD1.Title = «Сохранить Базу «.

' При помощи фильтра можно отбросить ненужные типы файлов.

SFD1.Filter = «Анекдоты|*.ank|РезКоп|*.bu» .

' Если есть список выбора типов, то можно указать какой тип будет выбран при загрузке диалога.

SFD1.FilterIndex = 1.

If SFD1. ShowDialog = DialogResult. OK Then.

Dim fileSave = SFD1.FileName.

IO.File.Copy (fileName, fileSave).

End If.

End Sub.

'-меню-ФАЙЛ-Выход—————————-;

Private Sub ВыходToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles ВыходToolStripMenuItem.Click.

Close ().

End Sub.

'-меню-НАСТРОЙКА-Удалить запись———————;

Private Sub УдалитьЗаписьToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles УдалитьЗаписьToolStripMenuItem.Click.

maxIDxml (fileName).

If Me. Text > 1 Then.

del1().

delOstatok ().

delTempFile ().

element1().

maxIDxml (fileName).

End If.

End Sub.

Для добавления новой записи открывается новое окно (2 форма) — ее код ниже.

'-меню-НАСТРОЙКА-Добавить запись———————;

Private Sub ДобавитьЗаписьToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles ДобавитьЗаписьToolStripMenuItem.Click.

frmDobavka.Show ().

Me.Enabled = False.

End Sub.

'-меню-НАСТРОЙКА-Поверх всех окон.

Private Sub ПоверхВсехToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles ПоверхВсехToolStripMenuItem.Click.

If ПоверхВсехToolStripMenuItem. Checked = True Then.

ПоверхВсехToolStripMenuItem.Checked = False.

Me.TopMost = False.

Else.

ПоверхВсехToolStripMenuItem.Checked = True.

Me.TopMost = True.

End If.

End Sub.

Включение-отключение часов происходит по такому алгоритму, если галочка в меню есть — часы ходят и их видно, иначе их нет.

'-меню-НАСТРОЙКА-часы.

Private Sub ЧасыToolStripMenuItem_Click (sender As Object, e As EventArgs) Handles ЧасыToolStripMenuItem.Click.

If ЧасыToolStripMenuItem. Checked = True Then.

ЧасыToolStripMenuItem.Checked = False.

lblChas.Visible = False.

Shape1.Visible = False.

Timer1.Enabled = False.

Else.

ЧасыToolStripMenuItem.Checked = True.

lblChas.Visible = True.

Shape1.Visible = True.

Timer1.Enabled = True.

End If.

End Sub.

'в зависимости от числа в нумераторе открывается запись с выбранным номером.

'переключение нумератора (переключение между зап).

Private Sub NumericUpDown1_ValueChanged (sender As Object, e As EventArgs) Handles NumericUpDown1.ValueChanged.

element1().

End Sub.

'изменение ранга по выбору в комбобоксе изменение ранга на вариант из комбобокса.

Private Sub ComboBox1_SelectedIndexChanged (sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged.

RANG (Val (ComboBox1.Text)).

End Sub.

'Таймер для времени.

Private Sub Timer1_Tick (sender As Object, e As EventArgs) Handles Timer1.Tick.

lblChas.Text = TimeOfDay.

End Sub.

'скопировать в буф обм.

Private Sub ToolStripMenuItem6_Click (sender As Object, e As EventArgs) Handles ToolStripMenuItem6.Click.

My.Computer.Clipboard.SetText (rtxOtvet.Text).

End Sub.

End Class.

Вторая форма — добавление записи.

Imports System.Xml.

Public Class frmDobavka.

'закрытие формы.

Private Sub frmDobavka_FormClosed (sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed.

Form1.Enabled = True.

End Sub.

'добавляем текст.

Private Sub cmdOk_Click (sender As Object, e As EventArgs) Handles cmdOk.Click.

'добавление в конец файла.

'загружаем xml файл.

Dim reader = New XmlTextReader (Form1.fileName).

Dim readElement = XElement. Load (reader).

reader.Close ().

Form1.maxIDxml (Form1.fileName).

Dim maxi = Val (Form1.Text).

Dim nextID = Str (maxi + 1).

Dim newText = «*** «+ vbCrLf + vbCrLf + rtx1. Text + vbCrLf + vbCrLf.

Dim xml_value =.

readElement.Add (xml_value).

'сохраняем.

readElement.Save (Form1.fileName).

Form1.maxIDxml (Form1.fileName).

Me.Close ().

End Sub.

End Class.

Отладка

Сначала я не знал как сделать в меню открытие и сохранение файла, но потом нашел инструменты OpenFileDialog и SaveFileDialog и использовал их. Написал для них вот этот код:

OFD1.InitialDirectory = Application.StartupPath.

OFD1.Title = «Откр Базу «.

OFD1.Filter = «Анекдоты|*.ank|РезКоп|*.bu|Все|*.*» .

OFD1.FilterIndex = 1.

If OFD1. ShowDialog = DialogResult. OK Then.

fileName = OFD1.FileName.

NumericUpDown1.Value = 1.

element1().

End If.

SFD1.InitialDirectory = Application.StartupPath.

SFD1.Title = «Сохранить Базу «.

SFD1.Filter = «Анекдоты|*.ank|РезКоп|*.bu» .

SFD1.FilterIndex = 1.

If SFD1. ShowDialog = DialogResult. OK Then.

Dim fileSave = SFD1.FileName.

IO.File.Copy (fileName, fileSave).

End If.

Так же была проблема выбрать случайную запись, но я нашел код в интернете и все получилось:

maxIDxml (fileName).

Dim r As New Random.

Dim max = Val (Me.Text).

Randomize ().

Dim randoms.

randoms = r. Next (1, max).

NumericUpDown1.Value = randoms.

element1().