|
Последнее обновление 11/24/02.
| |
| Пример изъятия из
текстового файла DOS нужных фрагментов и
преобразования их в таблицу базы данных
MS Access. Задачка часто встречается при
использовании текстовых отчетов,
созданных в DOS в качестве входных
документов для приложения на VB. В этом
примере кода входной файл, считываемый с
дисковода A, представляет собой набор
столбцов немного плавающих по ширине и
содержащих цифровые значения. В
отдельных строках располагаются
названия объектов, которым
соответствуют считываемые значения. |
Private Sub mnuDriveABaza_Click()
'---------------------------------------------------
'Пример преобразования
текстового файла DOS в базу
'данных формата *.mdb (Access).Таблица
в базе
'создана заранее и связана с
Form4.DBGrid1 по Data1
'в дочерней форме Form4.
'В DBGrid1 и виден результат.
Недостаток - невысокое
'быстродействие (у меня был
файл ~ 5000 строк).
'---------------------------------------------------
'Эти строки - в General основной формы
Private Declare Function GetOEMCP Lib "kernel32" () As Long
Private Declare Function GetACP Lib "kernel32" () As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA"
(ByVal lpszSrc As String, ByVal lpszDst As String) As Long
'-------------------------------------------------------
Dim sFile, sLine As String
Dim str, str0, str1, str2 As String
With dlgCommonDialog
'To Do
'set the flags and attributes
of the
'common dialog control
.Filter = "All Files (*.*)|*.*"
.ShowOpen
If Len(.filename) = 0 Then
Exit
Sub
End If
sFile = .filename
End With
'To Do
'process the opened file
FilePath$ = dlgCommonDialog.filename
Open FilePath$ For Input As 1
InputStr$ = Input$(LOF(1), 1)
OutputStr$ = Space$(Len(InputStr$))
Code& = OemToChar(InputStr$, OutputStr$)
Close 1
Open "c:/Program Files/Fuel/fueltemp.doc" For
Output As 2
Print #2, OutputStr$
Close 2
Open "c:/Program Files/Fuel/fueltemp.doc" For
Input As 2
Do While Not EOF(2)
Line Input #2, sLine$
If sLine = "" Then
GoTo 20
'Отфильровываю
ненужные строки
If InStr(1, sLine$,
"----------", vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "иятие",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "смена",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "Город",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "топлива",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "Табельный",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "ОПЕРАТОР",
vbTextCompare) > 0 Then GoTo 20
If InStr(1, sLine$, "БУХГАЛТЕР",
vbTextCompare) > 0 Then GoTo 20
'Проверка на
подзаголовок (oн в первых позициях
'текста) и его
нужно вставлять в каждую строку
'таблицы
If Left(sLine$, 10) = "
" Then GoTo 10
str3 =
Mid(sLine$, 8, 7)
'Считывание
данных с конкретных позиций
10 If InStr(1, sLine$, ":",
vbTextCompare) = 0 Then
str =
Mid(sLine$, 1, 130)
str0 =
Mid(sLine$, 78, 12)
str1 =
Mid(sLine$, 106, 6)
'Убираю
ненужные мне апострофы в значениях
If
InStr(2, str1, "'", vbTextCompare) > 0 Then str1 = Left(str1,
InStr(2, str1, "'", vbTextCompare) - 1) + Mid(str1, InStr(2,
str1, "'", vbTextCompare) + 1, 6)
str2
= Mid(sLine$, 118, 12)
'Убираю
ненужные мне апострофы в значениях
If
InStr(2, str2, "'", vbTextCompare) > 0 Then str2 = Left(str2,
InStr(2, str2, "'", vbTextCompare) - 1) + Mid(str2, InStr(2,
str2, "'", vbTextCompare) + 1, 6)
'Запись
в поля таблицы
Form4.Data1.Recordset.AddNew
Form4.Data1.Recordset.Fields("НомерКарточки").Value
= str3
Form4.Data1.Recordset.Fields("НазваниеГСМ").Value =
str0
Form4.Data1.Recordset.Fields("КоличествоЛ").Value =
str1
Form4.Data1.Recordset.Fields("КоличествоР").Value =
str2
Form4.Data1.Recordset.Update
End If
20 Loop
Close 2
Form4.Data1.Refresh
Form4.Show
InputError:
Exit Sub
End Sub |
| |
|
