1 CHAN
 2 DATE 11 DEC 2010
 2 TIME 18:36

 
 'Verwijder willekeurige tags uit gedcom
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim infile, filein, outfile, fileout, buffer
Set infile = CreateObject("Scripting.FileSystemObject")
vraag = "Wat is de naam van het invoerbestand?"
titel = "Verwijder willekeurige tags uit gedcom"
naamin = inputbox(vraag,titel)
set filein = infile.opentextfile(naamin,forreading)
set outfile = createobject("scripting.filesystemobject")
vraag = "Wat is de naam van het uitvoerbestand?"
naamuit = inputbox(vraag,titel)
vraag = "Welke Gedcom code (tag) wilt u verwijderen?"
deltag = inputbox(vraag,titel)
set fileout = outfile.opentextfile(naamuit+"temp",forwriting, true)
buffer= filein.readall
buffer = replace(buffer,vbcrlf, vbcr)
buffer = replace(buffer,vbcr, vblf)
fileout.write(buffer)
buffer = replace(buffer,vblf+vblf, vblf)

fileout.write(buffer)
fileout.close()
set filein = infile.opentextfile(naamuit+"temp",forreading)
set fileout = outfile.opentextfile(naamuit,forwriting, true)
regel = trim(filein.readline)
do 
   if mid(regel,3,len(deltag))= deltag then
      level = left(regel, 1)
      do
        regel = filein.readline
        thisLevel =left(regel,1)
      loop until thisLevel = "0" or thisLevel<=level or filein.atendofstream
   else
      if mid(regel,3,1)="@" and right(regel,len	(deltag))= deltag then
         do
            regel = filein.readline
         loop until left(regel,1)="0" or filein.atendofstream
      else
         fileout.writeline(regel)            
         regel = filein.readline
      end if
   end if   
loop until filein.atendofstream
fileout.writeline(regel)
fileout.close()
aa = msgbox("Klaar",,titel)