I have been trying to find a way to locate specific sections in the header
of a file which contains multi-frame medical image data but is wrapped in an
XML header and replace this with some different XML.
MY problem is that when I run the example below it just chugs away for ever
and nothing happens. I chose to use the common dialog to allow the doctor to
select the files easily to convert.
If the problem is with the size of the file and the content after the XML
header, maybe there is a way to limit the search to just the header.
I'm not an expert in VB6 - I mostly work with Flash but I tried to do this
one as a special favour. My code is shown below...
Thanks for any help...
Option Explicit
Private m_QuitEarly As Boolean
Public File_Name As String
Private Sub GetFiles_Click()
CDLViewer.Filter = "XIF|*.xif|Text|*.txt|All|*.*"
CDLViewer.ShowOpen
File_Name = CDLViewer.FileName
End Sub
' In the file file_name, replace occurrances of from_text
' with to_text. Return True if the string appeared and
' was replaced, False if the string was not in this file.
Private Function ReplaceInFile(ByVal File_Name As String, ByVal from_text As
String, ByVal to_text As String) As Boolean
Dim fnum As Integer
Dim file_text As String
On Error GoTo ReplaceError
' Read the file.
fnum = FreeFile
Open File_Name For Binary As fnum
file_text = Input$(LOF(fnum), #fnum)
Close #fnum
' See if the text appears.
If InStr(file_text, from_text) > 0 Then
' Replace the text.
file_text = Replace(file_text, from_text, to_text)
' Rewrite the file.
fnum = FreeFile
Open File_Name For Binary As fnum
Print #fnum, file_text;
Close #fnum
ReplaceInFile = True
End If
Exit Function
ReplaceError:
Select Case MsgBox("Error " & Err.Number & _
" processing file " & File_Name & _
vbCrLf & Err.Description & _
"Try again?", vbYesNoCancel)
Case vbYes
Resume
Case vbNo
Exit Function
Case Else
m_QuitEarly = True
Exit Function
End Select
End Function
Private Sub cmdReplace_Click()
Dim from_text As String
Dim to_text As String
Dim results As String
' Get the text to find and replace.
from_text = "TDI"
to_text = "TDI Flag"
If ReplaceInFile(File_Name, from_text, to_text) Then
results = results & " " & File_Name
End If
MsgBox results
End Sub