В файле данных хранятся сведения о товарах продовольственной базы. Организовать работу с файлом - VB

Узнай цену своей работы

Формулировка задачи:

В файле данных хранятся сведения о товарах продовольственной базы в формате: <наименование товара >, <цена за единицу>, <количество товара>,<номер магазина получающего>. Разработать программу, которая позволяет: а)Создавать или пополнять файл данных; b)Отображать содержимое файла данных; c)Получать упорядоченный список товаров, с указанием магазинов получающих товар;
Листинг программы 
  1. Dim List() As String
  2.  
  3. Private Sub Command1_Click()
  4. Open Text1 For Random As #1 Len = Len(sved)
  5. i = LOF(1) / Len(sved) + 1    
  6. Form2.Show
  7. End Sub
  8.  
  9. Private Sub Command3_Click()
  10. Dim kol_zap As Integer
  11. Open Text1 For Random Access Read As #1 Len = Len(sved)
  12. Form3.Show
  13. kol_zap = LOF(1) / Len(sved)
  14. Form3.Print "Name", "St", "Kol", "Nom"
  15. For i = 1 To kol_zap
  16. Get #1, i, sved
  17. Form3.Print sved.Name, sved.St, sved.Kol, sved.Nom
  18. Next i
  19. Close #1
  20. End Sub
  21.  
  22. Private Sub Command2_Click()
  23. F = FreeFile 
  24. Open Form1.Text1 For Random Access Read As #F
  25. i = 1
  26. Get #1, i, sved
  27. Do Until EOF(F)
  28. i = i + 1
  29. ReDim Preserve List(1 To i) 
  30.  Line Input #F, List(i)
  31. Loop
  32. Close #F
  33. Call Selectionsort 
  34. Form4.Show
  35. For j = 1 To i
  36. Form4.Print List(j) 
  37. Form4.Print Tab(3), "имя" Tab(33); sved.Name
  38. Form4.Print Tab(3), "номер"; Tab(33); sved.Nom
  39. Next j
  40. Close #F
  41.  
  42. End Sub
  43. Public Sub Selectionsort()
  44. Dim i As Long
  45. Dim j As Long
  46. Dim min As Long, max As Long
  47. Dim best_value As String
  48. Dim best_j As Long
  49. min = LBound(List)
  50. max = UBound(List) 
  51. For i = min To max - 1
  52. best_value = List(i)
  53. best_j = i
  54. For j = i + 1 To max
  55. If List(j) < best_value Then
  56. best_value = List(j)
  57. best_j = j
  58. End If
  59. Next j
  60. List(best_j) = List(i)
  61. List(i) = best_value
  62. Next i
  63. End Sub

Решение задачи: «В файле данных хранятся сведения о товарах продовольственной базы. Организовать работу с файлом»

textual
Листинг программы 
  1. Option Explicit
  2. DefLng F, H-I, L, N, U: DefDbl D, M: DefStr J, S: DefBool B: DefObj O: DefVar V
  3. '
  4. '                   Модуль для работы с файлами и сохранением списков
  5. '
  6. '--------------------------[Константы]
  7. Private Const MaxSpace = 256
  8. Public Enum F_ReCod
  9.     [Без изменений] = 0
  10.     [Windows To DOS] = 1
  11.     [DOS To Windows] = 2
  12.     [Binary To Unicode] = 4
  13.     [Unicode To Binary] = 8
  14.     [Без нулей справа] = 16
  15.     [Без нулей слева] = 32
  16. End Enum
  17. '--------------------------[Переменные модуля]
  18. Dim FxSpace As String * MaxSpace, Byt() As Byte
  19. Dim f, n, n1, Dln, AnyString$, i, Dln1&
  20. '--------------------------[Api Функции]
  21. Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
  22. Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
  23.  
  24. Public Function LoadList(Path$) As String()
  25.     'Загрузка списка
  26.     Dim f, f1, ul, n, n1, i, j(), text$
  27.     text = ReadBytes(Path, [Binary To Unicode])
  28.  
  29.     For f = 1 To 3
  30.         n = n * 256 + Asc(Mid$(text, f, 1))
  31.     Next
  32.     ul = Fix(n) / 3: n = n Mod 3
  33.     ReDim j(ul)
  34.     On Error GoTo 10
  35.  
  36.     For f = 4 To ul * (n + 1) + 4 Step n + 1
  37.         n1 = 0
  38.  
  39.         For f1 = f To f + n
  40.             n1 = n1 * 256 + Asc(Mid$(text, f1, 1))
  41.         Next
  42.         j(i) = n1: i = i + 1
  43.     Next
  44.  
  45.     For f1 = 0 To ul
  46.         n = j(f1)
  47.         j(f1) = Mid$(text, f, n)
  48.         f = f + n
  49.     Next
  50. 10
  51.     LoadList = j
  52. End Function
  53.  
  54. Public Sub SaveList(Path$, List$())
  55.     'Сохранение списка
  56.     Dim f, f1, ul, n, j()
  57.     ul = UBound(List)
  58.     '-------------
  59.     ReDim Preserve j(ul + 1)
  60.  
  61.     For f = 1 To ul + 1
  62.         n = Len(List(f - 1))
  63.         j(f) = Space(3)
  64.  
  65.         For f1 = 3 To 1 Step -1
  66.             Mid$(j(f), f1, 1) = Chr(n Mod 256)
  67.             n = Fix(n / 256)
  68.         Next
  69.     Next
  70.     '----------------------- Сжать индексы
  71.     For f = 2 To 0 Step -1
  72.  
  73.         For f1 = 1 To ul + 1
  74.             If Mid$(j(f1), 1, 1) <> vbNullChar Then GoTo 10
  75.         Next
  76.  
  77.         For f1 = 1 To ul + 1
  78.             j(f1) = Mid$(j(f1), 2)
  79.         Next
  80.     Next
  81. 10
  82.     '------------------ Первая ячейка
  83.     n = ul * 3 + Abs(f)
  84.     j(0) = Space(3)
  85.  
  86.     For f = 3 To 1 Step -1
  87.         Mid$(j(0), f, 1) = Chr(n Mod 256)
  88.         n = Fix(n / 256)
  89.     Next
  90.     Call WriteBytes(Path, Join(j, "") & Join(List, ""), [Unicode To Binary], 1, True)
  91. End Sub
  92.  
  93. Public Function WriteBytes&(Path$, Bytes As Variant, Optional ByVal Flag As F_ReCod, Optional ByVal Start& = 1, Optional Overwrite As Boolean)
  94.     'Запись байт в файл
  95.     'Арг: Путь // Массив байт (Или текст) // Флаг кодировки // Старт // Флаг перезаписи
  96.     'Возврат: Следующая позиция записи (при успешном выполнении)
  97.     On Error GoTo 1
  98.     If Overwrite Then Call Kill(Path)
  99. 1
  100.     Open Path For Binary As #1
  101.     Byt = Bytes
  102.     If Start Then Else Start = 1
  103.     Put #1, Start, ReCod(Byt, Flag)
  104.     WriteBytes = Start + UBound(Byt) + 1
  105.     Close #1
  106. End Function
  107.  
  108. Public Function ReadBytes(Path$, Optional ByVal Flag As F_ReCod, Optional ByVal Start&, Optional ByVal Dln&) As Byte()
  109.     'Чтение байт из файла
  110.     'Арг: Путь // Флаг кодировки // Старт // Длина
  111.     'Возврат: Массив байт
  112.     Open Path For Binary As #1
  113.     On Error Resume Next
  114.     If Start Then Else Start = 1
  115.     Dln1 = LOF(1) - Start + 1
  116.     If Dln = 0 Or Dln > Dln1 Then Dln = Dln1
  117.     ReDim Preserve ReadBytes(Dln - 1)
  118.     Get #1, Start, ReadBytes
  119.     ReadBytes = ReCod(ReadBytes, Flag)
  120.     Close #1
  121. End Function
  122.  
  123. Public Function ReCod(Bytes As Variant, Optional ByVal Flag As F_ReCod) As Byte()
  124.     'Перекодирование текста стандартами Windows
  125.     'Bytes: Массив байт (Или текст)
  126.     'Flag: Комбинируемые команды: [DOS to Windows] + [Binary to Unicode] ...
  127.     ReCod = Bytes
  128.  
  129.     While Flag > 0
  130.  
  131.         Select Case Flag
  132.         Case Is >= [Без нулей слева]
  133.             Flag = Flag - [Без нулей слева]
  134.             n = MaxSpace
  135.             f = 1
  136.  
  137.             Do While n > 0
  138.  
  139.                 For f = f To UBound(ReCod) + 1 Step n
  140.                     If Mid$(ReCod, f, n) <> Mid$(FxSpace, 1, n) Then Exit For
  141.                 Next
  142.                 n = n / 2
  143.             Loop
  144.             ReCod = Mid$(ReCod, f)
  145.         Case Is >= [Без нулей справа]
  146.             '-------------------------
  147.             ReCod = StrReverse(ReCod)
  148.             Flag = Flag - [Без нулей справа]
  149.             n = MaxSpace
  150.             f = 1
  151.  
  152.             Do While n > 0
  153.  
  154.                 For f = f To UBound(ReCod) + 1 Step n
  155.                     If Mid$(ReCod, f, n) <> Mid$(FxSpace, 1, n) Then Exit For
  156.                 Next
  157.                 n = n / 2
  158.             Loop
  159.             ReCod = StrReverse(Mid$(ReCod, f))
  160.             '-----------------------------------------------
  161.         Case Is >= [Unicode To Binary]
  162.             Flag = Flag - [Unicode To Binary]
  163.             ReCod = StrConv(ReCod, vbFromUnicode)
  164.         Case Is >= [Binary To Unicode]
  165.             Flag = Flag - [Binary To Unicode]
  166.             ReCod = StrConv(ReCod, vbUnicode)
  167.         Case Is >= [DOS To Windows]
  168.             Flag = Flag - [DOS To Windows]
  169.             AnyString = ReCod
  170.             Call OemToChar(ReCod, AnyString)
  171.             ReCod = AnyString
  172.         Case Is >= [Windows To DOS]
  173.             Flag = Flag - [Windows To DOS]
  174.             AnyString = ReCod
  175.             Call CharToOem(ReCod, AnyString)
  176.             ReCod = AnyString
  177.         End Select
  178.     Wend
  179. End Function

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 3.5 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут