Program HTML2HLP implicit integer (a-z) parameter (mbitmaps=20,mconfigs=100) character*(100) SourceFile character*127 DestFile character*20000 buffer character*100 lastag,tag,URL,tURL,title,upcase character*200 cline character*12 HelpFile /'WWHelp.HTM'/ character*12 HelpProj /'WWHelp.HPJ'/ character*12 HelpRTF /'WWHelp.RTF'/ character*100 bitmaps(mbitmaps) logical title_out,fexists external upcase,htmlp c SourceFile = 'c:n3000.cnv'//char(0) inquire(file=HelpRTF,exist=fexists) if(fexists) then open(2,file=HelpRTF,status='unknown',err=900) close(2,status='delete') endif inquire(file=HelpProj,exist=fexists) if(fexists) then open(2,file=HelpProj,status='unknown',err=900) close(2,status='delete') endif open(2,file=HelpRTF,status='unknown',err=900) open(3,file=HelpProj,status='unknown',err=920) call initRTF call initProj title = 'Automagically Generated from HTML2HLP' title_out = .false. lastag = '
' llast = 6 c nconfigs = 0 nbitmaps = 0 call = 0 1 status = htmlp(SourceFile,lbuffer,buffer,ltag,tag, & ltURL,tURL,call) if(status.lt.0) goto 910 if(status.gt.0) goto 2 call = call + 1 if(ltURL.ne.0) then URL = tURL lURL = ltURL endif c c convert tags ... c tag = upcase(tag,ltag) if(tag(:4).eq.'') then write(2,'(a)') '{\\strike '//buffer(:lbuffer)//'}' write(2,'(a)') '{\\v '// & '!MakeDocument("'//URL(:lURL)//'",0);'// & 'GetCacheNameCopy(0," ");'// & 'EP("HTML2HLP.EXE",1);'// & 'EP("HC31.EXE WWHELP",1)}' else call putRTF(buffer,lbuffer,lastag,llast,title_out) endif if(tag(:3).ne.'') then write(3,'(a)') 'title = '//buffer(:lbuffer) title_out = .true. return else if(tag(:4).eq.'
') then write(2,'(a)') '\\pard\\plain' else if(tag(:3).eq.'') then write(2,'(a)')
'\\b{' else if(tag(:4).eq.'') then write(2,'(a)') '}' else if(tag(:6).eq.''.or. &
tag(:6).eq.'
'.or.
& tag(:7).eq.'
') then
write(2,'(a)') '\\par \\tx360 \\li720 \\fi-360 \\ql'
else if(tag(:7).eq.'
') then write(2,'(a)') '\\line\\pard\\plain' else if(tag(:4).eq.'') then write(2,'(a)') '\\line' write(2,'(a)') '{\\f0\\''B7} \\tab' endif if(lbuffer.ne.0) write(2,'(a)') buffer(:lbuffer) end character*(*) function upcase(char,lc) character*(*) char character*26 up /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ character*26 lo /'abcdefghijklmnopqrstuvwxyz'/ upcase = char do i=1,lc ipos = index(lo,char(i:i)) if (ipos.ne.0) upcase(i:i) = up(ipos:ipos) end do end Subroutine initProj write(3,'(a)') '; Automagically generated from HTML2HLP' write(3,'(a)') '[OPTIONS]' write(3,'(a)') 'copyright= (c) J.J.Bunn 1994 ' write(3,'(a)') 'oldkeyphrase=off' write(3,'(a)') 'compress=high' write(3,'(a)') 'warning=3' end Subroutine endProj close(3) end integer function htmlp(SourceFile,lbuffer,buffer, & ltag,tag,lURL,URL,call) implicit integer (a-z) integer ipos character*(*) SourceFile character*20000 buffer character*100 context,tag,URL character*200 cline character*100 null save ipos,cline,lline,ilevel,ntags c lbuffer = 0 ltag = 0 lURL = 0 if(call.eq.0) then lsf = index(SourceFile,char(0))-1 write(3,'(a)') '; Source file '//sourcefile(:lsf) if(lsf.le.0) goto 900 open(1,file=SourceFile(:lsf),status='old',err=902) write(3,*) '; Source file opened' ntags = 0 null = ' ' context = null goto 1 else goto 3 end if 1 read(1,'(a)',end=2,err=2) cline lline = lenocc(cline) if(lline.le.0) goto 1 cline = cline(:lline)//' ' lline = lline + 1 c ipos = 0 ilevel = 0 3 ipos = ipos+1 if(ipos.gt.lline) goto 1 if(cline(ipos:ipos).eq.'<'.and.ilevel.eq.0) then ntags="ntags" + 1 iend="index(cline(ipos:lline),'">') if(iend.ne.0) then tag = cline(ipos:ipos+iend-1) ltag = iend ipos = ipos + iend - 1 ihref=max(index(tag,'href='),index(tag,'HREF=')) URL = ' ' lURL = 0 if(ihref.ne.0) then URL = tag(ihref+5:ltag-1) if(URL(1:1).eq.'"') then URL = URL(2:) endif l1 = 999 l2 = 999 l3 = 999 if(index(URL,'"').gt.0) then l1 = index(URL,'"')-1 else if(index(URL,' ').gt.0) then l2 = index(URL,' ')-1 else l3 = index(URL,'>')-1 endif lURL = min(l1,l2,l3) endif htmlp = 0 goto 1000 else goto 901 endif else lbuffer = lbuffer + 1 buffer(lbuffer:lbuffer) = cline(ipos:ipos) endif goto 3 2 close(1) htmlp = ntags write(3,'(a,i6,a)') '; Source file : ',ntags,' tags' goto 1000 900 htmlp = -5000 goto 1000 901 htmlp = -5001 goto 1000 902 htmlp = -5002 1000 continue end integer function lenocc(c) character*(*) c lenocc = 0 do lenocc=len(c),1,-1 if(c(lenocc:lenocc).ne.' ') return end do end subroutine initRTF write(2,'(a)') '{\\rtf1\\ansi \\deff3\\deflang1024' write(2,'(a)') '{\\fonttbl' write(2,'(a)') '{\\f0\\froman Times New Roman;}' write(2,'(a)') '{\\f1\\froman Symbol;}' write(2,'(a)') '{\\f2\\fswiss Arial;}' write(2,'(a)') '{\\f3\\froman Tms Rmn;}' write(2,'(a)') '{\\f4\\fswiss Helv;}' write(2,'(a)') '{\\f5\\fdecor ZapfDingbats;}' write(2,'(a)') '{\\f6\\fmodern Courier;}}' write(2,'(a)') '{\\stylesheet' write(2,'(a)') '{\\fs10\\lang1033 \\snext0 Normal;}' write(2,'(a)') '}' end subroutine endRTF write(2,'(a)') '}' end