Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг: Рейтинг темы: голосов - 9, средняя оценка - 4.89
JoraVoenyjHaker
Заблокирован
#1

Файловые операции - VB

17.10.2013, 07:53. Просмотров 1279. Ответов 17
Метки нет (Все метки)

Вот мой готовый модуль для удовлетворения почти всех потребностей в работе с файлами
работает в обычном модуле .Bas
но вы можете установить в своём классе, или объекте


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
Option Explicit
DefLng F, H-I, L, N, U: DefDbl D, M: DefStr J, S: DefBool B: DefObj O: DefVar V
'
'                   Модуль для работы с файлами и сохранением списков
'                   ©JoraVoenyjHaker
'
'--------------------------[Константы]
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
2
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
17.10.2013, 07:53
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Файловые операции (VB):

Файловые проблемы при работе с базами данных
При попытке скопировать рабочий файл mdb из temp-директории на постоянное место...

Математические операции
Извините))Можно у вас спросить...а почему у меня не получается если я...

матричные операции
Помогите,пожалуйста, дана матрица ,нужно вычислить сумму X1*X3+X3*X5+X5*X7.....

Матричные операции
Помогите пожалуйста написать программу к третьему заданию. Утром сдавать отчёт,...

Операции со временем
Помогите с созданием программы Разработать программу для решения следующей...

Текстовые операции
Написать программу для выполнения следующей последовательности действий: 1)...

17
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 08:55 #2
А чем не устраивают стандартные средства VB/VBA (open, line input, print, get/put, seek)?
0
JoraVoenyjHaker
Заблокирован
21.10.2013, 09:45  [ТС] #3
Мне не нравится их текстовое вмешательство
неудобно для работы с mp3 файлом например

Добавлено через 4 минуты
Стоило прокоментировать этот момент получше...
это универсальный способ (побайтовое чтение-запись)

Добавлено через 6 минут
Для себя то я знаю, что там не один бит информации не потеряется

Добавлено через 9 минут
Единственно это функцию ReCod надо обдумать получше
там где убираються лишние нули
алгоритм "убрать слева" я обдумал
тоесть сначало пропускаем 256 нулей... 128... 64... пока не встретится символ
а правую сторону чтоб не заморачиваться сделал реверс

Добавлено через 11 минут
в моём чемоданчике есть ещё способы работы с гигобайтами данных
хоть с тиробайтами, там я использую фрагментарное чтение-запись
0
The trick
Модератор
7342 / 2563 / 752
Регистрация: 22.02.2013
Сообщений: 3,782
Записей в блоге: 76
21.10.2013, 09:49 #4
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
есть ещё способы работы с гигобайтами данных
хоть с тиробайтами, там я использую фрагментарное чтение-запись
Для этого проще использовать ReadFile и SetFilePointerEx, также можно открывать файлы с юникодными именами.
1
JoraVoenyjHaker
Заблокирован
21.10.2013, 09:53  [ТС] #5
Спасибо, не знал
а скорость чтения-записи ?
0
The trick
Модератор
7342 / 2563 / 752
Регистрация: 22.02.2013
Сообщений: 3,782
Записей в блоге: 76
21.10.2013, 10:19 #6
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
а скорость чтения-записи ?
Скорость зависит от комбинации флагов при открытии файла, а также от порядка чтения, но не медленней стандартных, даже быстрей, т.к. по сути стандартные функции являются оберткой над этими API. К тому же поддерживаются асинхронные операции
1
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 10:29 #7
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
Мне не нравится их текстовое вмешательство
неудобно для работы с mp3 файлом например
- опс... Да кто же открывает mp3 как текстовый файл?

Единственная серьезная проблема файловых операций в VB - это работа с очень большими файлами. Да, для этого нужно использовать WinAPI (о чем писал выше The trick).
1
The trick
Модератор
7342 / 2563 / 752
Регистрация: 22.02.2013
Сообщений: 3,782
Записей в блоге: 76
21.10.2013, 10:42 #8
Цитата Сообщение от Catstail Посмотреть сообщение
Единственная серьезная проблема файловых операций в VB - это работа с очень большими файлами
Добавлю что еще проблема стандартных файловых функций, то что они не работает с юникодными именами.
1
JoraVoenyjHaker
Заблокирован
21.10.2013, 11:22  [ТС] #9
Цитата Сообщение от The trick Посмотреть сообщение
ReadFile и SetFilePointerEx
Постараюсь, прикрутить, сейчас в моих DLL пока старые
методы, при первой же возможности сделаю изменения
тщательно протестирую и сделаю )))

Добавлено через 1 минуту
Цитата Сообщение от Catstail Посмотреть сообщение
опс... Да кто же открывает mp3 как текстовый файл?
я всё открываю )))

Добавлено через 3 минуты
Кстате кто-нибудь знает как считывать данные
из файла .Lnk (ярлык то есть), я там так и не понял
по каким правилам размещаются данные
0
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 11:39 #10
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
Кстате кто-нибудь знает как считывать данные
из файла .Lnk (ярлык то есть), я там так и не понял
по каким правилам размещаются данные
- Загляни
0
JoraVoenyjHaker
Заблокирован
21.10.2013, 11:39  [ТС] #11
Пользуюсь токенами в беспорядочном потоке данных например
Find="C:\"
0
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 11:41 #12
Для изучения двоичной структуры может быть полезной моя поделка
0
JoraVoenyjHaker
Заблокирован
21.10.2013, 11:45  [ТС] #13
Цитата Сообщение от Catstail Посмотреть сообщение
- Загляни
Как всегда Страница на английском....
0
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 11:49 #14
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
Как всегда Страница на английском....
- и что? Так уж сложно разобраться? Ведь нужен не литературный перевод, а понимание.
0
JoraVoenyjHaker
Заблокирован
21.10.2013, 12:14  [ТС] #15
Некоторые даже по русски с трудом понимают о чём мы с вами говорим )))

Добавлено через 15 минут
Я как понял там чтото спрятанно, что позволяет Windows-у
делать картинку, понимать ссылку, и восстанавливать при его нарушении
для меня это и есть беспорядочный поток данных

Добавлено через 4 минуты
Хотя и могу изменить его ссылку програмно
0
Catstail
Модератор
23540 / 11650 / 2036
Регистрация: 12.02.2012
Сообщений: 18,992
21.10.2013, 12:26 #16
Цитата Сообщение от JoraVoenyjHaker Посмотреть сообщение
чтото спрятанно, что позволяет Windows-у
делать картинку
- иконка там (кажется) хранится как битовый образ
0
JoraVoenyjHaker
Заблокирован
21.10.2013, 15:57  [ТС] #17
Скорей всего данные такие
1 указание на образ и его параметры
2 сам образ
3 ссылка
4 и чтото - там ещё...
я когда ссылку изменяю то надеюсь что Windows простит это вмешательство )))
0
Dragokas
Эксперт WindowsАвтор FAQ
16927 / 7012 / 852
Регистрация: 25.12.2011
Сообщений: 10,808
Записей в блоге: 16
21.10.2013, 18:29 #18
Лучший ответ Сообщение было отмечено The trick как решение

Решение

Цитата Сообщение от Catstail Посмотреть сообщение
- иконка там (кажется) хранится как битовый образ
нет. Ссылка на номер ресурса в DLL.

JoraVoenyjHaker,
ShellLinkObject
http://www.cyberforum.ru/cmd-bat/thread660199.html#post3514439
2
21.10.2013, 18:29
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.10.2013, 18:29
Привет! Вот еще темы с решениями:

Операции со строками
1.Дана строка текста, в которой есть хотя бы один пробел. Подсчитать...

Операции с массивами
Задача. Просуммировать элементы матрицы A(n, n) по каждой из линий,...

Операции с числами
помогите переделать код на VB procedure TForm1.Button1Click(Sender:...

Операции с двоичными числами
Помогите пожалуйста написать программу перевод числа(двоичного) в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
18
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru