VPF::Вырезание символа из файла - Форум программистов

XPurple

Дата 6.6.2006, 09:56 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Написал программу, на скорую руку, для вырезания символа из файла. Пока много недочетов: плохая логика, сумбурный код и т.д. Мне бы хотелось получить ответ на вопрос по функционалу. Другими словами, потестите, кому интересно, на предмет ошибок.

Вот код программы

Код



Option Explicit

Dim lnFrom%, lnTo%
Dim i As Integer
Dim FileSource, FileDest As String
Dim Retval, msg
Dim Symbol As String
Dim AsciiCodeSymbol As Integer
Dim MessageInfo As String
Dim SymbolIsValid As Boolean
Dim fso As Object

Private Sub Command1_Click()

FileDest = "file_out.bin"
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(FileDest) Then
fso.DeleteFile (FileDest)

Else
End If

On Error GoTo russian

Select Case Len(Symbol)

Case 1
AsciiCodeSymbol = Asc(Symbol)
SymbolIsValid = True

Case 2 To 3

   If Right(Symbol, 1) = "H" Or Right(Symbol, 1) = "h" Then
   AsciiCodeSymbol = Val("&H" & Symbol)

        If AsciiCodeSymbol Then
        SymbolIsValid = True

        Else
        SymbolIsValid = False
        msg = MsgBox("Ошибка:" & Chr(32) & "Указано неверное значение вырезаемого символа" & vbCrLf & _
        "Указано значение > 255 или 0", _
        vbExclamation, "Окно состояния")
        End If
        
   Else
        If Symbol <= 255 Then
        AsciiCodeSymbol = Int(Symbol)
        SymbolIsValid = True

        Else
        msg = MsgBox("Ошибка:" & Chr(32) & "Указано неверное значение вырезаемого символа" & vbCrLf & _
        "Указано значение > 255", _
        vbExclamation, "Окно состояния")
        SymbolIsValid = False
        End If
        
   End If

Case Else
msg = MsgBox("Ошибка:" & Chr(32) & "Указано неверное значение вырезаемого символа" & vbCrLf & _
"Указано больше знаков", _
vbExclamation, "Окно состояния")
SymbolIsValid = False

End Select

If SymbolIsValid Then
Retval = Cut_Symbols(FileSource, FileDest, AsciiCodeSymbol)

Else
End If

russian:

If Err.Number <> 0 Then
msg = MsgBox("Введенный символ вне диапазона ", vbExclamation, "Окно состояния")

Else
End If

End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Dir1_Click()
Dir1.Path = Dir1.List(Dir1.ListIndex)
File1.Path = Dir1.Path
End Sub

Private Sub File1_Click()
FileSource = File1.Path + "\" + File1.FileName
End Sub

Public Function Cut_Symbols(ByVal FileFrom As String, ByVal FileTo As String, ByVal SymbolCut As Integer)

lnFrom = FreeFile
On Error GoTo label

Open FileFrom For Binary As #lnFrom
lnTo = FreeFile
Open FileTo For Binary As #lnTo

    'копирование содержимого
ReDim Buffer(1 To LOF(lnFrom)) As Byte

For i = 1 To LOF(lnFrom)
Get #lnFrom, , Buffer(i)

       If Buffer(i) <> CByte(SymbolCut) Then
       Put #lnTo, , Buffer(i)

       Else
       End If

Next
  
Close #lnFrom
Close #lnTo

label:
If Err.Number <> 0 Then
msg = MsgBox("Не выбран файл или файл не доступен ", vbExclamation, "Окно состояния")

Else
        If SymbolCut > 32 Then
        MessageInfo = Chr(SymbolCut)

        Else
        MessageInfo = Hex(SymbolCut) + "H"
        End If
    
        msg = MsgBox("Символ" & Chr(32) & "[" & MessageInfo & "]" & Chr(32) & "вырезан по всему файлу" & Chr(32) & _
        FileFrom & Chr(32) & "успешно." & vbCrLf & "Результат сохранен в файле" & Chr(32) & FileTo, _
        vbInformation, "Окно состояния")
End If

End Function

Private Sub Form_Load()
Text1.Text = "A"
End Sub

Private Sub Text1_Change()
Symbol = Text1.Text

End Sub

--------------------

Кто никогда ни о чем не спрашивает: тот либо знает все, либо не знает ничего. Не помню, кто сказал, может быть, я (с)

Akina

Дата 6.6.2006, 10:10 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Ты в своем уме - читать-писАть файлы ПОБАЙТОВО??? да еще побайтово же сравнивать??? на файле размером в гигабайт твоя программа задумается до Нового года... это при том что в начале распрекрасно пользуешь FSO... организуй нормальное потоковое чтение, используй буфер чтения размером не менее 4 кб (оптимум - 32 или 64 кб), символы вырезай тривиальным Replace.

И потом - с какой целью размещен тут код? какова нужность и полезность этой программы? где она востребована?

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

XPurple

Дата 6.6.2006, 10:14 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Цитата(Akina @ 6.6.2006, 10:10

)

Ты в своем уме - читать-писАть файлы ПОБАЙТОВО???

Я честно говоря во всех примерах только и видел побайтовое считывание в режиме Binary, думал по-другому в VB и нельзя. Вот как, оказывается.

Цитата(Akina @ 6.6.2006, 10:10

)

И потом - с какой целью размещен тут код? какова нужность и полезность этой программы? где она востребована?

В какой раздел подобного рода вещи размещают ? Я просто не знал, честно говоря, куда обратиться: рискнул сюда. Переместите в нужный раздел ,куда сочтете правильным.
p.s. Писалось для себя, для вырезания перевода строки из текста для импорта в shell-скрипты
p.p.s Программа -сырая, я сам вижу и мне она самому не нравится ; но лучше сейчас по(л)учить от знающих людей, чем потом исправлять себе руки.

Добавлено.
Я тут подумал над вашими словами. У меня культуры программирования, похоже, еще нет. Выкладывать свои исходники, причем не самого высокого качества -это плохой тон, сродни вывешиванию во дворе дырявых носков ? Я угадал ?

Это сообщение отредактировал(а) XPurple - 6.6.2006, 10:43

--------------------

Voldemar2004

Дата 6.6.2006, 15:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23

XPurple, налепи на форму 3 TextBox'a, Dirlistbox, filelistbox, drivelistbox, Command1 - "Открыть", Command2 - "Сохранить", CommonDialog1 - вставь код:

Код

Option Explicit
' From DOS to WIN:
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
' From Win to DOS:
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Private Sub Command1_Click()
Dim OemStr As String
Dim CharStr As String

If File1.FileName <> "" Then

' здесь начинается преобразование:

    If Len(Dir1.Path) > 3 Then ' если файл находится не в корне диска (длина имени пути > 3 [с:\..\]), то:
        Text2.Text = ReadFileEntirely(Dir1 & "\" & File1.FileName)
        OemStr = ReadFileEntirely(Dir1 & "\" & File1.FileName)
        CharStr = Space(Len(OemStr))
    Else ' иначе, если файл находится в корне диска,
        ' то уберем слэш \
        Text2.Text = ReadFileEntirely(Dir1 & File1.FileName)
        OemStr = ReadFileEntirely(Dir1 & File1.FileName)
        CharStr = Space(Len(OemStr))
    End If

OemToChar OemStr, CharStr ' конвертирование
Text1.Text = CharStr ' вывод

' удаление служебного символа ДОС: ""
Text1.Text = Cut_Symbol(Text1.Text)

Else: MsgBox "Нет выбранных файлов", vbInformation, "Предупреждение"

End If

End Sub

' функция быстрого чтения текстового файла
Private Function ReadFileEntirely(File As String) As String
Dim MyFile As Integer
MyFile = FreeFile
    
    Open File For Input As #MyFile
        File = Input(LOF(1), 1)
    Close #MyFile
    
    ReadFileEntirely = File

End Function

Private Sub Command2_Click()
Dim MyFile As String

If File1.FileName <> "" And Text1.Text <> "" Then

CommonDialog1.Filter = "Текстовые файлы (*.txt)|*.|"
CommonDialog1.ShowSave

MyFile = FreeFile
    
    Open CommonDialog1.FileName & "_WIN" & ".txt" For Append As #MyFile
        Print #MyFile, Text1.Text
    Close #MyFile

Else: MsgBox "Нет выбранных файлов", vbCritical
End If

If Dir(CommonDialog1.FileName & "_WIN" & ".txt") <> "" Then

MsgBox "Файл успешно сохранен", vbInformation

End If

End Sub

Private Sub Dir1_Change()
File1.FileName = Dir1.Path
End Sub

Private Sub Drive1_Change()
On Error GoTo DeviceError
Dir1.Path = Drive1
DeviceError:  If Err.Number = 68 Then MsgBox "Устройство не готово для чтения", vbCritical, "Ошибка"
End Sub

Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If File1.FileName = "" Then MsgBox "Не выбраны файлы"
End Sub

' По умолчанию расширение - текстового файла
Private Sub Form_Load()
File1.Pattern = "*.txt"
End Sub

' Это надо для отслеживания изменений фильтра юзером
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
File1.Pattern = Text3.Text
End Sub

Private Sub Text3_Change()
File1.Pattern = Text3.Text
End Sub

Private Function Cut_Symbol(Str As String)

    Str = Replace(Str, "H", "")
    Str = Replace(Str, "G", "")
    Str = Replace(Str, "- ", "-")
    Str = Replace(Str, " ", "")
    
Cut_Symbol = Str
'

End Function

В общем-то похоже на твою. Только то, что я написал - преобразует ДОС-кодировку в Windows. XPurple, используй функцию

Код

Replace()

--------------------

i_i
(';')
(V)

user posted image

Akina

Дата 6.6.2006, 16:25 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

XPurple, дурной тон - вывалить весь исходник целиком, да еще без комментариев. Достаточно было дать существенный участок кода (Function Cut_Symbols), указав что именно она принимает и что именно отдает и откомментировав код.

Да, еще одно - никогда (слышишь, НИКОГДА!) не делай так чтобы исполняемый код процедуры/функции заходил в обработчик ошибки той же процедуры/функции.

--------------------

XPurple

Дата 7.6.2006, 12:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Voldemar2004,
Что то есть, действительно общее. Интересные вы ребята, каждый раз узнаешь что-то новое.
Как я без программирования раньше жил ?
Akina
Ладно, спасибо, я все понял.
p.s. Я стараюсь в меру сил следовать вашим советам. Я это ценю, поверьте мне.

Цитата(Akina @ 6.6.2006, 16:25

)

не делай так чтобы исполняемый код процедуры/функции заходил в обработчик ошибки той же процедуры/функции.

Не понял (только догадываюсь), про какое место вы говорите, про это ?

Код


If SymbolIsValid Then
Retval = Cut_Symbols(FileSource, FileDest, AsciiCodeSymbol)

Else
End If

russian:

If Err.Number <> 0 Then
msg = MsgBox("Введенный символ вне диапазона ", vbExclamation, "Окно состояния")

Else
End If

End Sub

Вы же сами меня учили, что область действия обработчика ошибок до конца процедуры.

Добавлено.
Пока писал, понял, что вы имели ввиду. А так нельзя делать ? К чему это может привести ?

Это сообщение отредактировал(а) XPurple - 7.6.2006, 12:53

--------------------

Тутанхамец

Дата 7.6.2006, 13:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 612
Регистрация: 10.10.2005
Где: в пирамидЕ!

Репутация: 4
Всего: 6

Разбираться во всем исходнике я не стал, тем более, что без комментариев не слишком уверен, что правильно въехал, как оно работает.

По мелочи типа придирки:
1)

Код


If Right(Symbol, 1) = "H" Or Right(Symbol, 1) = "h" Then

имхо, лучше так:

Код


if ucase$(right$(symbol,1)="H" then...

UCASE и LCASE - приводят текст к верхнему регистру и нижнему. Для всех текстовых функций есть двойники с "$" на конце - эти функции возвращают результат типа string. Без доллара - возвращают типа variant, который работает медленее. Чаще всего на скорость это влияет незаметно, но всё-таки полезно знать.

2)

Код


If fso.FileExists(FileDest) Then
fso.DeleteFile (FileDest)

Else
End If

Мог бы написать просто: 

If fso.FileExists(FileDest) Then fso.DeleteFile (FileDest)

Код



Private Sub Text1_Change()
Symbol = Text1.Text

End Sub

Опять же, заметно это не повлияет на скорость. Но ты понимай, что у тебя при каждом изменении текста будет выполняться одна и та же работа. Хотя операции с текстом у тебя выполняются по нажатии какой-то кнопки. Именно в процедуре этого нажатия ты мог бы запихивать в Symbol содержимое text1 - один раз, а не невесть сколько...

Ну, про файл тебе уже сказали... Глобальных переменных что-то многовато. Те, которые используются только в одной процедуре, лучше в этой процедуре и объявлять. И используй один стиль объявления. Зачем тебе где-то интегер объявлять через "%", а где-то через as integer...

Добавлено @ 13:05
Да, и FSO as object - плохо. Либо уж variant (что тоже плохо), либо подключаешь Microsoft Scripting Run-Time в Project-References и объявляешь, как Scripting.FileSystemObject.

--------------------

Мой блог / Мои фотки / Моё Skolkobudet.ru

XPurple

Дата 15.6.2006, 10:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Цитата(Akina @ 6.6.2006, 10:10

)

символы вырезай тривиальным Replace.

Не получается с помощью Replace вырезать специальные символы (видимые символы вырезаются без проблем), подскажите: как это сделать ?

--------------------

Akina

Дата 15.6.2006, 11:18 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Код


strTemp = Replace(strTemp,chr(0),chr(32))

--------------------

XPurple

Дата 15.6.2006, 13:05 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

А как сосчитать из файла спецсимволы и вырезать с помощью Replace ?

--------------------

BUGOR

Дата 15.6.2006, 13:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 325
Регистрация: 12.3.2006

Репутация: 3
Всего: 16

Что значит сосчитать? Это всмысле посчитать? Тогда не понимаю зачем это в данной задаче. Если же это считать, то переменную считываешь файл и применяешь к ней Replace. Постарайся задать вопрос иначе, в этом виде он непонятен, чтобы попробовать помочь тебе.

--------------------

Живу недоумевая, всё время хочу понять...
http://hunger.ru

Voldemar2004

Дата 15.6.2006, 16:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23

Ну так например:

Код

Private Function NumberLine(FileName As String) As Long
' довольно медленный способ подсчета строк, т.к. файл считывается по строкам

Dim buffer As String         ' буфер, где хранится весь считанный файл
Dim current_string As String ' буфер для хранения текущей считанной строки
' NumberLine служит одновременно и счетчиком строк в цикле do while ... loop

If Dir(FileName) <> "" Then ' если файл существует/имя указано верно, то:
   
    Open FileName For Input As #1  ' открытие файла
        
        Do While Not EOF(1)  ' EOF(1) - конец файла 1 (FileNumber),
                             ' т.е. будет происходить чтение
                             ' всего файла
        Line Input #1, current_string     ' считывание строки
        buffer = buffer + current_string + vbCrLf
        ' vbCrLf - константа, которая осуществляет переход
        ' к новой строке
        NumberLine = NumberLine + 1
       Loop
    
    Close #1   ' закрытие файла

Else: MsgBox "Файл не существует" & vbNewLine & "или имя файла указано неверно", vbCritical, "Ошибка"
End If

End Function

Не сочтите за оффтопик, но XPurple, посмотри, как просто это выглядит на Си:

Код

unsigned long StrCount (char *fname)
{
   FILE *stream;
   char ch;

   stream = fopen (fname, "r");

    fseek(stream, 0, SEEK_SET);

    unsigned long i=0;

do
{
ch = fgetc(stream);
if( ch == 0x0A ) i++;
}
while (ch != EOF);

   fclose (stream);

return i+1;
}

Идея проста: открыть файл, подсчитать количество спецсимволов, закрыть файл. Вырезать эти символы.

--------------------

i_i
(';')
(V)

user posted image

Voldemar2004

Дата 15.6.2006, 16:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23

Вот например, как вырезать все символы переноса строки:

Код

Private Function NumberLine(FileName As String) As Long
' довольно медленный способ подсчета строк, т.к. файл считывается по строкам

Dim buffer As String         ' буфер, где хранится весь считанный файл
Dim current_string As String ' буфер для хранения текущей считанной строки
' NumberLine служит одновременно и счетчиком строк в цикле do while ... loop

If Dir(FileName) <> "" Then ' если файл существует/имя указано верно, то:
   
    Open FileName For Input As #1  ' открытие файла
        
        Do While Not EOF(1)  ' EOF(1) - конец файла 1 (FileNumber),
                             ' т.е. будет происходить чтение
                             ' всего файла
        Line Input #1, current_string     ' считывание строки
        buffer = buffer + current_string + vbCrLf
        ' vbCrLf - константа, которая осуществляет переход
        ' к новой строке
             
       Loop
            
    Close #1   ' закрытие файла

' Удалим все символы переноса строк:
Open FileName For Output As #1
    buffer = Replace(buffer, vbCrLf, "")
    Print #1, buffer
Close #1
    
Else: MsgBox "Файл не существует" & vbNewLine & "или имя файла указано неверно", vbCritical, "Ошибка"
End If

End Function

--------------------

i_i
(';')
(V)

user posted image

XPurple

Дата 16.6.2006, 10:30 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Я изначально эту задачу реализовал через побайтовое чтение в режиме Binary. Мне сказали, что это якобы долгий процесс, был предложен вариант с Replace. Но во всех встреченных мне примерах приводятся описания либо для чтения данных из файла, либо отдельно для replace.
Я подумал, раз мне нужно найти в файле спецсимвол и удалить его, то следует открывать файл в режиме Binary. Но для нахождения его и примения к нему функции Replace - возникла сложность, т.к. в этом режиме я не понял, как находить в строке символ "0Dh" с помощью Line Input.

Если кратко, требуется следующее:
1. Открыть файл.
2. Найти в файле все спецсимволы 0dH
3. Записать данные (уже без спецсимволов) в другой файл.

Код


lnFrom = FreeFile
Open FileFrom Input As #lnFrom
InTo = FreeFile
Open FileTo For Output As #lnTo

'Код английского А
SymbolCut="65"   
    Do Until EOF(lnFrom)
            Line Input #lnFrom, InputString
'Сравнимаем, если ли в строке символ Chr(65) или "A" и если да, то удаляем его из InputString
                    If InStr(1, InputString, Chr(SymbolCut), vbTextCompare) > 0 Then
                         InputString = Replace(InputString, Chr(SymbolCut), "")
'Записываем результат в файл #Into
                         Print #lnTo, InputString
                    Else
                    End If

Это для видимого символа, а как сделать для спецсимвола ?

Это сообщение отредактировал(а) XPurple - 16.6.2006, 11:08

--------------------

Akina

Дата 16.6.2006, 11:07 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Код


Dim fso As Scripting.FileSystemObject
Dim F As TextStream
Dim S As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile("\filename.ext", ForReading)
S = F.ReadAll
F.Close
S = Replace(S, vbNewLine, "")
Set F = fso.OpenTextFile("\filename2.ext", ForWriting, True)
F.Write S
F.Close

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »