В файле данных хранятся сведения о товарах продовольственной базы. Организовать работу с файлом - VB
Формулировка задачи:
В файле данных хранятся сведения о товарах продовольственной базы в формате: <наименование товара >, <цена за единицу>, <количество товара>,<номер магазина получающего>. Разработать программу, которая позволяет:
а)Создавать или пополнять файл данных;
b)Отображать содержимое файла данных;
c)Получать упорядоченный список товаров, с указанием магазинов получающих товар;
Решение задачи: «В файле данных хранятся сведения о товарах продовольственной базы. Организовать работу с файлом»
textual
Листинг программы
Option Explicit DefLng F, H-I, L, N, U: DefDbl D, M: DefStr J, S: DefBool B: DefObj O: DefVar V ' ' Модуль для работы с файлами и сохранением списков ' '--------------------------[Константы] Private Const MaxSpace = 256 Public Enum F_ReCod [Без изменений] = 0 [Windows To DOS] = 1 [DOS To Windows] = 2 [Binary To Unicode] = 4 [Unicode To Binary] = 8 [Без нулей справа] = 16 [Без нулей слева] = 32 End Enum '--------------------------[Переменные модуля] Dim FxSpace As String * MaxSpace, Byt() As Byte Dim f, n, n1, Dln, AnyString$, i, Dln1& '--------------------------[Api Функции] Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long Public Function LoadList(Path$) As String() 'Загрузка списка Dim f, f1, ul, n, n1, i, j(), text$ text = ReadBytes(Path, [Binary To Unicode]) For f = 1 To 3 n = n * 256 + Asc(Mid$(text, f, 1)) Next ul = Fix(n) / 3: n = n Mod 3 ReDim j(ul) On Error GoTo 10 For f = 4 To ul * (n + 1) + 4 Step n + 1 n1 = 0 For f1 = f To f + n n1 = n1 * 256 + Asc(Mid$(text, f1, 1)) Next j(i) = n1: i = i + 1 Next For f1 = 0 To ul n = j(f1) j(f1) = Mid$(text, f, n) f = f + n Next 10 LoadList = j End Function Public Sub SaveList(Path$, List$()) 'Сохранение списка Dim f, f1, ul, n, j() ul = UBound(List) '------------- ReDim Preserve j(ul + 1) For f = 1 To ul + 1 n = Len(List(f - 1)) j(f) = Space(3) For f1 = 3 To 1 Step -1 Mid$(j(f), f1, 1) = Chr(n Mod 256) n = Fix(n / 256) Next Next '----------------------- Сжать индексы For f = 2 To 0 Step -1 For f1 = 1 To ul + 1 If Mid$(j(f1), 1, 1) <> vbNullChar Then GoTo 10 Next For f1 = 1 To ul + 1 j(f1) = Mid$(j(f1), 2) Next Next 10 '------------------ Первая ячейка n = ul * 3 + Abs(f) j(0) = Space(3) For f = 3 To 1 Step -1 Mid$(j(0), f, 1) = Chr(n Mod 256) n = Fix(n / 256) Next Call WriteBytes(Path, Join(j, "") & Join(List, ""), [Unicode To Binary], 1, True) End Sub Public Function WriteBytes&(Path$, Bytes As Variant, Optional ByVal Flag As F_ReCod, Optional ByVal Start& = 1, Optional Overwrite As Boolean) 'Запись байт в файл 'Арг: Путь // Массив байт (Или текст) // Флаг кодировки // Старт // Флаг перезаписи 'Возврат: Следующая позиция записи (при успешном выполнении) On Error GoTo 1 If Overwrite Then Call Kill(Path) 1 Open Path For Binary As #1 Byt = Bytes If Start Then Else Start = 1 Put #1, Start, ReCod(Byt, Flag) WriteBytes = Start + UBound(Byt) + 1 Close #1 End Function Public Function ReadBytes(Path$, Optional ByVal Flag As F_ReCod, Optional ByVal Start&, Optional ByVal Dln&) As Byte() 'Чтение байт из файла 'Арг: Путь // Флаг кодировки // Старт // Длина 'Возврат: Массив байт Open Path For Binary As #1 On Error Resume Next If Start Then Else Start = 1 Dln1 = LOF(1) - Start + 1 If Dln = 0 Or Dln > Dln1 Then Dln = Dln1 ReDim Preserve ReadBytes(Dln - 1) Get #1, Start, ReadBytes ReadBytes = ReCod(ReadBytes, Flag) Close #1 End Function Public Function ReCod(Bytes As Variant, Optional ByVal Flag As F_ReCod) As Byte() 'Перекодирование текста стандартами Windows 'Bytes: Массив байт (Или текст) 'Flag: Комбинируемые команды: [DOS to Windows] + [Binary to Unicode] ... ReCod = Bytes While Flag > 0 Select Case Flag Case Is >= [Без нулей слева] Flag = Flag - [Без нулей слева] n = MaxSpace f = 1 Do While n > 0 For f = f To UBound(ReCod) + 1 Step n If Mid$(ReCod, f, n) <> Mid$(FxSpace, 1, n) Then Exit For Next n = n / 2 Loop ReCod = Mid$(ReCod, f) Case Is >= [Без нулей справа] '------------------------- ReCod = StrReverse(ReCod) Flag = Flag - [Без нулей справа] n = MaxSpace f = 1 Do While n > 0 For f = f To UBound(ReCod) + 1 Step n If Mid$(ReCod, f, n) <> Mid$(FxSpace, 1, n) Then Exit For Next n = n / 2 Loop ReCod = StrReverse(Mid$(ReCod, f)) '----------------------------------------------- Case Is >= [Unicode To Binary] Flag = Flag - [Unicode To Binary] ReCod = StrConv(ReCod, vbFromUnicode) Case Is >= [Binary To Unicode] Flag = Flag - [Binary To Unicode] ReCod = StrConv(ReCod, vbUnicode) Case Is >= [DOS To Windows] Flag = Flag - [DOS To Windows] AnyString = ReCod Call OemToChar(ReCod, AnyString) ReCod = AnyString Case Is >= [Windows To DOS] Flag = Flag - [Windows To DOS] AnyString = ReCod Call CharToOem(ReCod, AnyString) ReCod = AnyString End Select Wend End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д