;=============================================================================== ; WBT2HTML 1.01 (c) Detlev Dalitz 2001:07:29:00:00:00 ;=============================================================================== ; user information is placed at end of file ; ------------------------------------------------------------------------------ ParamResult=@FALSE If (param0>0) GoSub GetParams Else Goto AskParams EndIf If !ParamResult GoSub DefineUDFs GoSub UserConfigurableInit GoSub ProgInit GoSub CollectColors GoSub CollectKeywords GoSub OpenReadSourceFile If UseAutoDelimiter Then GoSub CalculateDelimiters GoSub TagQuote GoSub TagComment GoSub TagBracket GoSub TagOperator GoSub TagOthers GoSub TagWordNumber GoSub ColorizeWord GoSub ColorizeNumber GoSub ColorizeOthers GoSub ColorizeOperator GoSub ColorizeBracket GoSub ColorizeComment GoSub ColorizeQuote GoSub WriteCloseTargetFile EndIf If (IntControl(77,80,0,0,0)>0) Then Return (ParamResult) Exit ;=============================================================================== :DefineUDFs ;------------------------------------------------------------------------------- DefinedUDFList = IntControl(77, 103, 0, 0, 0) ;------------------------------------------------------------------------------- If !ItemLocate("udfbytetohex",DefinedUDFList,@TAB) #DefineFunction udfByteToHex(Byte) HexChars="0123456789abcdef" h1=StrSub(HexChars,1+(Byte>>4),1) h2=StrSub(HexChars,1+(Byte&15),1) Return (StrCat(h1,h2)) ;HexChars="0123456789ABCDEF" #EndFunction EndIf ;------------------------------------------------------------------------------- If !ItemLocate("udffilecrc",DefinedUDFList,@TAB) #DefineFunction udfFileCRC(filename,type) ; returns integer chk=0 If ((type==32)||(type==16)) fsize=FileSize(filename) If (fsize>0) ; AddExtender("wwser34i.dll") ; Load the serial extender ; 26. Dezember 2002, 21:04:08 ; 76,0 KB (77.893 Bytes) AddExtender("wwser44i.dll") ; Load the serial extender ; 27. Juli 2004, 22:33:08 ; 88,0 KB (90.181 Bytes). bb=BinaryAlloc(fsize) BinaryRead(bb,filename) chk=pCheckBinary(IntControl(42,bb,0,0,0),BinaryEodGet(bb)-1,type) BinaryFree(bb) EndIf EndIf Return (chk) ;calculates checksum for type=16 or type=32 ;DD.20010731 #EndFunction EndIf ;------------------------------------------------------------------------------- If !ItemLocate("udfdisplaymsg",DefinedUDFList,@TAB) #DefineFunction udfDisplayMsg(str) If (RtStatus()==10) Then wStatusMsg(str) Else BoxText(str) #EndFunction EndIf ;------------------------------------------------------------------------------- Drop(DefinedUDFList) Return ; from DefineUDFs ;=============================================================================== ;Procedures ;------------------------------------------------------------------------------- :CollectColors ; collect names and rgb color values udfDisplayMsg(StrCat(logo,"Collecting colors ...")) colorvaluelist="" colornamelist = StrCat("Keyword",@TAB,"Quote",@TAB,"Comment",@TAB,"Default Text",@TAB,"Background") ;--- read colors for WIL files from WinBatch Studio Registry --- colorcount = ItemCount(colornamelist,@TAB) regkey = RegOpenKey(@REGCURRENT,"Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files") For i=1 To colorcount colorvalueitem = RegQueryValue(regkey,StrCat("[",ItemExtract(i,colornamelist,@TAB),"]")) colorvaluelist = ItemInsert(colorvalueitem,-1,colorvaluelist,@TAB) Next RegCloseKey(regkey) Drop(regkey,colorcount,i,colorvalueitem) ;--- additional colors from my own inspiration ----------------- ; create new hashtable if colors were changed colornamelist = ItemInsert("Operator",-1,colornamelist,@TAB) colorvaluelist = ItemInsert("000,048,128",-1,colorvaluelist,@TAB) colornamelist = ItemInsert("Bracket",-1,colornamelist,@TAB) colorvaluelist = ItemInsert("032,032,032",-1,colorvaluelist,@TAB) colornamelist = ItemInsert("Number",-1,colornamelist,@TAB) colorvaluelist = ItemInsert("096,000,000",-1,colorvaluelist,@TAB) colornamelist = ItemInsert("Other",-1,colornamelist,@TAB) colorvaluelist = ItemInsert("000,32,128",-1,colorvaluelist,@TAB) ;--- additional colors from WIL.CLR inifile -------------------- colorfile = StrCat(DirHome(),"WIL.CLR") colorlist = IniItemizePvt ("COLORS",colorfile) colorcount = ItemCount(colorlist,@TAB) For i=1 To colorcount colornameitem = ItemExtract(i,colorlist,@TAB) colorvalueitem = IniReadPvt("COLORS",colornameitem,"000,000,000",colorfile) colorvaluelist = ItemInsert(colorvalueitem,-1,colorvaluelist,@TAB) colornamelist = ItemInsert(colornameitem,-1,colornamelist,@TAB) Next Drop(colorfile,colorlist,colorvalueitem,colornameitem,colorcount) ;--------------------------------------------------------------- colornamelist = StrLower(colornamelist) ; set all items to lower case, no check if duplicates exist (todo?) ;--------------------------------------------------------------- If UseRGB ; delete all leading zeroes colorvaluelist = ItemInsert("",0,colorvaluelist,@TAB) colorvaluelist = StrReplace(colorvaluelist,@TAB,StrCat(",",@TAB,",")) colorvaluelist = StrReplace(colorvaluelist,",0",",") colorvaluelist = StrReplace(colorvaluelist,",0",",") colorvaluelist = StrReplace(colorvaluelist,",,",",0,") colorvaluelist = StrReplace(colorvaluelist,",,",",0,") colorvaluelist = StrReplace(colorvaluelist,StrCat(",",@TAB,","),@TAB) colorvaluelist = ItemRemove(1,colorvaluelist,@TAB) Else ; convert rgb to hex colorcount= ItemCount(colorvaluelist,@TAB) For i=1 To colorcount rgbitem = ItemExtract(i,colorvaluelist,@TAB) colorvalueitem = StrCat("#",udfByteToHex(ItemExtract(1,rgbitem,",")),udfByteToHex(ItemExtract(2,rgbitem,",")),udfByteToHex(ItemExtract(3,rgbitem,","))) colorvaluelist = ItemReplace(colorvalueitem,i,colorvaluelist,@TAB) Next EndIf Return ;------------------------------------------------------------------------------- :CollectKeywords udfDisplayMsg(StrCat(logo,"Collecting keywords ...")) ; read our inifile in WinBatch system folder wbt2htmlini=StrCat(DirHome(),"wbt2html.ini") hashok=FileExist(wbt2htmlini) If hashok colorFilename=IniReadPvt("WIL","ColorName","",wbt2htmlini) hashok=(colorFilename<>"") If hashok hashok=FileExist(colorFilename) If hashok hashok=(IniReadPvt("WIL","ColorCRC","",wbt2htmlini)==udfFileCRC(colorFilename,32)) If hashok hashok=FileExist(IniReadPvt("WIL","HashName","",wbt2htmlini)) EndIf EndIf EndIf EndIf If hashok udfDisplayMsg(StrCat(logo,"Reading hashtable ...")) GoSub ReadIni hbbsize=FileSizeEx(hfilename) Terminate((hbbsize==0), "Error", "Hashfile exists but has Filesize=0") hbb=BinaryAlloc(hbbsize) BinaryRead(hbb,hfilename) Else udfDisplayMsg(StrCat(logo,"Creating hashtable ... be patient ...")) hfilename = Environment("temp") If (StrSub(hfilename,StrLen(hfilename),1)<>"\") Then hfilename = StrCat(hfilename,"\") hfilename = StrCat(hfilename,"WIL.HSH") colorfilename = StrCat(DirHome(),"WIL.CLR") Terminate(!FileExist(colorfilename),"Error","WBT2HTML.WBT needs a good WIL.CLR file with some keywords in it ...") GoSub InitIni GoSub ReadIni ; read keywords from WIL.CLR inifile and create hashtable keywordlist = IniItemizePvt ("KEYWORDS",colorfilename) keywordcount = ItemCount(keywordlist,@TAB) hbbsize = 1.5 * keywordcount * hrecsize ; hashfactor*keycount*(length of identifier + length of colorname) hbb = BinaryAlloc(hbbsize) For i=1 To keywordcount keyworditem = ItemExtract(i,keywordlist,@TAB) colornameitem = StrTrim(IniReadPvt("KEYWORDS",keyworditem,"",colorfilename)) If (colornameitem=="1") Then colornameitem="Keyword" ; set standard WIL color=1 to "Keyword" as set in Registry hoffset = BinaryHashRec(hbb,hrecsize,hkeyoffset,hkeysize,StrLower(keyworditem)) BinaryPokeStr(hbb,hoffset+hcolornameoffset,StrLower(colornameitem)) BinaryPokeStr(hbb,hoffset+hmixcaseoffset,keyworditem) BinaryWrite(hbb,hfilename) Next BinaryWrite(hbb,hfilename) GoSub WriteIni EndIf Return ;------------------------------------------------------------------------------- :InitIni IniWritePvt("WBT2HTML","InternalName","wbt2html.wbt",wbt2htmlini) IniWritePvt("WBT2HTML","FileVersion","1.01",wbt2htmlini) IniWritePvt("WBT2HTML","FileDescription","wbt to coloured html script converter",wbt2htmlini) IniWritePvt("WBT2HTML","OriginalFilename","WBT2HTML.WBT",wbt2htmlini) IniWritePvt("WBT2HTML","ProductName","WBT2HTML",wbt2htmlini) IniWritePvt("WBT2HTML","ProductVersion","1",wbt2htmlini) IniWritePvt("WBT2HTML","CompanyName","Detlev Dalitz",wbt2htmlini) IniWritePvt("WBT2HTML","LegalCopyright","(c)20010729 Detlev Dalitz",wbt2htmlini) IniWritePvt("WBT2HTML","Comments","emailto:dd@dalitz-im-netz.de",wbt2htmlini) IniWritePvt("WBT2HTML","IniYmdHms",TimeYmdHms(),wbt2htmlini) IniWritePvt("WIL","ColorName",colorFilename,wbt2htmlini) IniWritePvt("WIL","ColorYmdHms","0",wbt2htmlini) IniWritePvt("WIL","ColorCRC","0",wbt2htmlini) IniWritePvt("WIL","HashName",hFilename,wbt2htmlini) IniWritePvt("WIL","HashYmdHms","0",wbt2htmlini) IniWritePvt("WIL","HashCRC","0",wbt2htmlini) ;IniWritePvt("WIL","HashCol","3",wbt2htmlini) ;IniWritePvt("WIL","HashCol1","0,30",wbt2htmlini) ;IniWritePvt("WIL","HashCol2","30,30",wbt2htmlini) ;IniWritePvt("WIL","HashCol3","60,30",wbt2htmlini) ;IniWritePvt("WIL","HashKey","1,HashCol1",wbt2htmlini) Return ;------------------------------------------------------------------------------- :WriteIni IniWritePvt("WIL","ColorName",colorFilename,wbt2htmlini) IniWritePvt("WIL","ColorYmdHms",FileTimeGetEx(colorfilename,2),wbt2htmlini) IniWritePvt("WIL","ColorCRC",udfFileCRC(colorFilename,32),wbt2htmlini) IniWritePvt("WIL","HashName",hFilename,wbt2htmlini) IniWritePvt("WIL","HashYmdHms",FileTimeGetEx(hfilename,2),wbt2htmlini) IniWritePvt("WIL","HashCRC",udfFileCRC(hFilename,32),wbt2htmlini) Return ;------------------------------------------------------------------------------- :ReadIni ;col1=IniReadPvt("WIL","HashCol1","",wbt2htmlini) ;col2=IniReadPvt("WIL","HashCol2","",wbt2htmlini) ;col3=IniReadPvt("WIL","HashCol3","",wbt2htmlini) ;hkeyoffset = ItemExtract(1,col1,",") ; key lowercase ;hkeysize = ItemExtract(2,col1,",") ; key lowercase ;hcolornameoffset= ItemExtract(1,col2,",") ; color name ;hcolornamesize = ItemExtract(2,col2,",") ; color name ;hmixcaseoffset = ItemExtract(1,col3,",") ; doubled key field in mixed case as stored in WIL.CLR ;hmixcasesize = ItemExtract(2,col3,",") ; doubled key field in mixed case as stored in WIL.CLR ;drop(col1,col2,col3) hkeyoffset = 0 ; key lowercase hkeysize = 30 ; key lowercase hcolornameoffset= 30 ; color name hcolornamesize = 30 ; color name hmixcaseoffset = 60 ; doubled key field in mixed case as stored in WIL.CLR hmixcasesize = 30 ; doubled key field in mixed case as stored in WIL.CLR hrecsize = hkeysize + hcolornamesize + hmixcasesize hFilename=IniReadPvt("WIL","HashName","",wbt2htmlini) Return ;------------------------------------------------------------------------------- :TagQuote defmsgstr=StrCat(logo,"Tagging quotes ...") udfDisplayMsg(defmsgstr) qlist = """.'.`" qstrlist=TagOn structlfcr = BinaryTagInit(bb,@LF,@CR) While @TRUE structlfcr = BinaryTagFind(structlfcr) If (structlfcr=="") Then Break line = BinaryTagExtr(structlfcr,1) qstr = StrClean(line,";""'`","",@FALSE,2) qstrlen = StrLen(qstr) If (qstrlen>0) If (StrSub(qstr,1,1)<>";") qstr = StrClean(qstr,";","",@FALSE,1) qstrlen = StrLen(qstr) qlist="" For i=1 To qstrlen qchar = StrSub(qstr,i,1) If (ItemLocate(qchar,qlist,".")==0) Then qlist=ItemInsert(qchar,-1,qlist,".") Next BinaryEodSet(bbline,0) BinaryPokeStr(bbline,0,line) GoSub TagQuoteLine qtagstr = StrCat(@LF,BinaryPeekStr(bbline,0,BinaryEodGet(bbline)),@CR) structlfcr=BinaryTagRepl(structlfcr,qtagstr) EndIf EndIf EndWhile Drop(structlfcr,line,qtagstr,qstr,qstrlen,qlist) Return ;------------------------------------------------------------------------------- :TagQuoteLine qcount = ItemCount(qlist,".") For q=1 To qcount qitem = ItemExtract(q,qlist,".") structqq = BinaryTagInit(bbline,qitem,qitem) While @TRUE structqq = BinaryTagFind(structqq) If (structqq=="") Then Break qstr = BinaryTagExtr(structqq,1) If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,qstr) udfDisplayMsg(msgstr) EndIf locpos = ItemLocate(qstr,qstrlist,@TAB) If (locpos==0) qstrlist = ItemInsert(qstr,-1,qstrlist,@TAB) qtagstr = StrCat(TagOn,"q",ItemCount(qstrlist,@TAB),TagOff) Else qtagstr = StrCat(TagOn,"q",locpos,TagOff) EndIf qtagstr = StrCat(qitem,qtagstr,qitem) structqq = BinaryTagRepl(structqq,qtagstr) EndWhile Next Drop(qcount,q,qitem,structqq,qstr,qtagstr) Return ;------------------------------------------------------------------------------- :TagComment defmsgstr=StrCat(logo,"Tagging comments ...") udfDisplayMsg(defmsgstr) clist = ";" cstrlist=TagOn ccount = ItemCount(clist,"/") For c=1 To ccount citem = ItemExtract(c,clist,"/") structccr = BinaryTagInit(bb,citem,@CR) While @TRUE structccr = BinaryTagFind(structccr) If (structccr=="") Then Break cstr = BinaryTagExtr(structccr,1) cstr = StrCat(citem,cstr) ; keep semicolon If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,cstr) udfDisplayMsg(msgstr) EndIf locpos = ItemLocate(cstr,cstrlist,@TAB) If (locpos==0) cstrlist = ItemInsert(cstr,-1,cstrlist,@TAB) ctagstr = StrCat(TagOn,"c",ItemCount(cstrlist,@TAB),TagOff) Else ctagstr = StrCat(TagOn,"c",locpos,TagOff) EndIf ctagstr = StrCat(ctagstr,@CR) structccr = BinaryTagRepl(structccr,ctagstr) EndWhile Next Drop(ccount,c,citem,structccr,cstr,ctagstr,clist) Return ;------------------------------------------------------------------------------- :TagOperator defmsgstr=StrCat(logo,"Tagging operators ...") udfDisplayMsg(defmsgstr) olist = "==.<=.>=.<>.!=.<.>.**.*./.+.-.&&.||.<<.>>.&.|.^.~.!.+.-.=" ; plus ".mod" ; binary(relational,arithmetic,logical),unary(integer logical,integer & float),assignment ostrlist=TagOn ocount = ItemCount(olist,".") For o=1 To ocount ostr = ItemExtract(o,olist,".") If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,ostr) udfDisplayMsg(msgstr) EndIf otagstr = StrCat(TagOn,"o",o,TagOff) BinaryReplace(bb,ostr,otagstr,@FALSE) Next ostrlist = olist ostrlist = StrReplace(ostrlist,".",@TAB) Drop(ocount,o,ostr,otagstr,olist) Return ; special handling for mod operator!? ; the operator "mod" cannot be treated well in all cases by this part of my progam ; at this time I will treat the "mod" operator as a normal keyword ; workaround: ; WIL.CLR has an entry "[KEYWORDS]mod=1", ; change it to "[KEYWORDS]mod=Operator" and "[COLORS]Operator=rrr,ggg,bbb" ;------------------------------------------------------------------------------- :TagBracket defmsgstr=StrCat(logo,"Tagging brackets ...") udfDisplayMsg(defmsgstr) blist = "(.).[.].{.}" ; brackets bstrlist=TagOn bcount = ItemCount(blist,".") For b=1 To bcount bstr = ItemExtract(b,blist,".") If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,bstr) udfDisplayMsg(msgstr) EndIf btagstr = StrCat(TagOn,"b",b,TagOff) BinaryReplace(bb,bstr,btagstr,@FALSE) Next bstrlist = blist bstrlist = StrReplace(bstrlist,".",@TAB) Drop(bcount,b,bstr,btagstr,blist) Return ;------------------------------------------------------------------------------- :TagOthers defmsgstr=StrCat(logo,"Tagging others ...") udfDisplayMsg(defmsgstr) mlist = " .,.@.#.::.:" ; blank,comma,ASCII-64,colon,ASCII-35 (percent sign too?) mstrlist=TagOn mcount = ItemCount(mlist,".") For m=1 To mcount mstr = ItemExtract(m,mlist,".") If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,mstr) udfDisplayMsg(msgstr) EndIf mtagstr = StrCat(TagOn,"m",m,TagOff) BinaryReplace(bb,mstr,mtagstr,@FALSE) Next mstrlist = mlist mstrlist = StrReplace(mstrlist,".",@TAB) Drop(mcount,m,mstr,mtagstr,mlist) Return ;------------------------------------------------------------------------------- :TagWordNumber defmsgstr=StrCat(logo,"Tagging words and numbers ...") udfDisplayMsg(defmsgstr) nstrlist="" wstrlist="" BinaryReplace(bb,@CRLF,StrCat(TagOn,@CRLF,TagOff),@FALSE) structwn=BinaryTagInit(bb,TagOff,TagOn) While @TRUE structwn = BinaryTagFind(structwn) If (structwn=="") Then Break wnstr = BinaryTagExtr(structwn,1) If (wnstr<>"") If UseVerbose msgstr=StrCat(defmsgstr,@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%",@CRLF,wnstr) udfDisplayMsg(msgstr) EndIf If IsNumber(wnstr) locpos = ItemLocate(wnstr,nstrlist,@TAB) If (locpos==0) nstrlist = ItemInsert(wnstr,-1,nstrlist,@TAB) wntagstr = StrCat(TagOff,TagOn,"n",ItemCount(nstrlist,@TAB),TagOff,TagOn) Else wntagstr = StrCat(TagOff,TagOn,"n",locpos,TagOff,TagOn) EndIf Else locpos = ItemLocate(wnstr,wstrlist,@TAB) If (locpos==0) wstrlist = ItemInsert(wnstr,-1,wstrlist,@TAB) wntagstr = StrCat(TagOff,TagOn,"w",ItemCount(wstrlist,@TAB),TagOff,TagOn) Else wntagstr = StrCat(TagOff,TagOn,"w",locpos,TagOff,TagOn) EndIf EndIf structwn = BinaryTagRepl(structwn,wntagstr) EndIf EndWhile BinaryReplace(bb,StrCat(TagOn,@CRLF,TagOff),@CRLF,@FALSE) Drop(structwn,wnstr,wntagstr) Return ;------------------------------------------------------------------------------- :ColorizeWord colcount=ItemCount(colornamelist,@TAB) wcount=ItemCount(wstrlist,@TAB) For c=1 To colcount cwstrlist%c%="" For w=1 To wcount cwstrlist%c% = ItemInsert(TagOn,-1,cwstrlist%c%,@TAB) Next Next cdefault=ItemLocate("default text",colornamelist,@TAB) For w=1 To wcount wstr=ItemExtract(w,wstrlist,@TAB) hoffset=BinaryHashRec(hbb,hrecsize,hkeyoffset,hkeysize,StrLower(wstr)) hcolorname=BinaryPeekStr(hbb,hoffset+hcolornameoffset,hcolornamesize) If (hcolorname=="") BinaryPoke(hbb,hoffset,0) ; housekeeping the hashtable c=cdefault Else c=ItemLocate(hcolorname,colornamelist,@TAB) Select UseCase Case 4 wstr=BinaryPeekStr(hbb,hoffset+hmixcaseoffset,hmixcasesize) Case 3 wstr=StrUpper(wstr) Break Case 2 wstr=StrLower(wstr) Break Case 1 ; wstr = wstr ; freestyle, no change Break EndSelect EndIf cwstrlist%c%=ItemReplace(wstr,w,cwstrlist%c%,@TAB) Next For c=1 To colcount If (StrClean(cwstrlist%c%,StrCat(@TAB,TagOn),"",@FALSE,1)<>"") colorname = ItemExtract(c,colornamelist,@TAB) colormsgstr = StrCat(logo,"Colorizing words (",colorname,") ...") colortagid = "w" colortaglist = cwstrlist%c% GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) EndIf Drop(cwstrlist%c%) Next Drop(c,w,colcount,wcount,cdefault,wstr,hoffset,hcolorname) Return ;------------------------------------------------------------------------------- :ColorizeNumber colormsgstr = StrCat(logo,"Colorizing numbers ...") colorname = "Number" colortagid = "n" colortaglist = nstrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ColorizeOthers colormsgstr = StrCat(logo,"Colorizing others ...") colorname = "" ; "" or "Other" colortagid = "m" colortaglist = mstrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ColorizeBracket colormsgstr = StrCat(logo,"Colorizing brackets ...") colorname = "" ; "" or "Bracket" colortagid = "b" colortaglist = bstrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ColorizeOperator colormsgstr = StrCat(logo,"Colorizing operators ...") colorname = "Operator" colortagid = "o" colortaglist = ostrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ColorizeComment colormsgstr = StrCat(logo,"Colorizing comments ...") colorname = "Comment" colortagid = "c" colortaglist = cstrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ColorizeQuote colormsgstr = StrCat(logo,"Colorizing quotes ...") colorname = "Quote" colortagid = "q" colortaglist = qstrlist GoSub ReplaceColorTag Drop(colormsgstr,colorname,colortagid,colortaglist) Return ;------------------------------------------------------------------------------- :ReplaceColorTag udfDisplayMsg(colormsgstr) cbo="{" tagcount=ItemCount(colortaglist,@TAB) For itag=tagcount To 1 By -1 If UseVerbose percent=100*itag/tagcount If ((percent mod 10)==0) udfDisplayMsg(StrCat(colormsgstr," ",percent,"%%",@CRLF,"BufferUse ",100*BinaryEodGet(bb)/bbsize,"%%")) EndIf EndIf If UseAnimation percent=100*itag/tagcount eod=BinaryEodGet(bb)-1 eodfactor=eod/tagcount bbbot=eodfactor*(itag-1) bbtop=Min(eod-bbbot,bbbot+eodfactor) BoxText(StrCat(colormsgstr," ",percent,"%%",@CRLF,BinaryPeekStr(bb,bbbot,bbtop))) EndIf htmtag = ItemExtract(itag,colortaglist,@TAB) If (htmtag<>TagOn) colorvalue=ItemExtract(ItemLocate(StrLower(colorname),colornamelist,@TAB),colorvaluelist,@TAB) If (colorvalue<>"") htmtag = StrReplace(htmdef,"%cbo%{txt}}",htmtag) htmtag = StrReplace(htmtag,"%cbo%{color}}",colorvalue) EndIf BinaryReplace(bb,StrCat(TagOn,colortagid,itag,TagOff),htmtag,@FALSE) EndIf Next Drop(percent,bbbot,bbtop,eod,eodfactor) Drop(colormsgstr,colorname,colortagid,colortaglist,itag,tagcount,cbo,colorvalue,htmtag) Return ;------------------------------------------------------------------------------- :OpenReadSourceFile udfDisplayMsg(StrCat(logo,"Reading source file ",sourcefilename)) fsize=FileSizeEx(sourcefilename) Terminate((fsize==0), "Error", "Sourcefile has Filesize=0") bbsize = fsize * 16 ; or more ? (changing plain text to html lets grow the file sometimes enormously) bbsize=Max(8192,bbsize) ; minimum 8KB Buffer bb=BinaryAlloc(bbsize) bbline=BinaryAlloc(2048) ; or more ? BinaryReadEx(bb,1,sourcefilename,0,fsize) BinaryPokeStr(bb,0,@LF) ; a little helper BinaryPokeStr(bb,BinaryEodGet(bb),@CRLF) ; a little helper BinaryPokeStr(bb,BinaryEodGet(bb),@CR) ; a little helper BinaryReplace(bb,@TAB,StrFill(" ",UseTabReplaceSize),@FALSE) ; CleanTabs Return ;------------------------------------------------------------------------------- :CalculateDelimiters udfDisplayMsg(StrCat(logo,"Calculating delimiters ... be patient ... on file",@CRLF,sourcefilename)) teststr="" ; create a chartable ... For i=1 To 31 teststr = StrCat(teststr,Num2Char(i)) Next For i=129 To 255 teststr = StrCat(teststr,Num2Char(i)) Next teststr=StrClean(teststr,StrCat(@TAB,@CR,@LF),"",@FALSE,1) teststr=StrClean(teststr,BinaryPeekStr(bb,0,BinaryEodGet(bb)-1),"",@FALSE,1) ; ... and delete used chars Terminate((StrLen(teststr)<2),StrCat(logo,"Error"),"This special WBT sourcefile cannot be converted into HTML ('tag chars not available').") TagOn =StrSub(teststr,1,1) TagOff=StrSub(teststr,2,1) Drop(teststr) Return ;------------------------------------------------------------------------------- :WriteCloseTargetFile udfDisplayMsg(StrCat(logo,"Writing target file ",targetfilename)) ; create small html header and footer lt ="<" ; html tag helper ;--- read font attributes for WIL files from WinBatch Studio Registry --- regkey=RegOpenKey(@REGCURRENT,"Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files") stylefont="" stylefont=StrCat(stylefont,'font-style:' ,ItemExtract(RegQueryValue(regkey,"[Font Italic]")+1,"normal/italic","/"),'; ') stylefont=StrCat(stylefont,'font-family:''',RegQueryValue(regkey,"[Font name]"),'''; ') stylefont=StrCat(stylefont,'font-size:' ,RegQueryValue(regkey,"[Font size]"),'pt; ') stylefont=StrCat(stylefont,'font-weight:' ,RegQueryValue(regkey,"[Font weight]"),'; ') RegCloseKey(regkey) Drop(regkey) bgcolor=ItemExtract(ItemLocate(StrLower("Background"),colornamelist,@TAB),colorvaluelist,@TAB) If UseRGB Then bgcolor=StrCat('rgb(',bgcolor,')') stylebgcolor=StrCat('background-color:',bgcolor,'; ') styleborder='border:1pt solid #dddddd; padding:3pt; width:100%%; ' tagpre='%lt%pre' tagpre=StrCat(tagpre,' style="',stylebgcolor,styleborder,stylefont,'"') tagpre=StrCat(tagpre,' title="colorized by WBT2HTML"','>') tagcomment=StrCat('%lt%!%lt%!-- [',TimeYmdHms(),'] colorized html by WBT2HTML.WBT Version 1.01 (c)20010729 Detlev Dalitz //-->') header =StrCat('%lt%html>',@CRLF,'%lt%body>',@CRLF,tagcomment,@CRLF,tagpre,@CRLF) footer =StrCat('%lt%/pre>',@CRLF,'%lt%/body>',@CRLF,'%lt%/html>',@CRLF) ; write the html file BinaryEodSet(bb,BinaryEodGet(bb)-1) ; cut little helper @cr BinaryEodSet(bb,BinaryEodGet(bb)-2) ; cut little helper @crlf If (BinaryPeekStr(bb,BinaryEodGet(bb)-2,2)<>@CRLF) Then BinaryPokeStr(bb,BinaryEodGet(bb),@CRLF); add @crlf for sure bbhelp=BinaryAlloc(1024) BinaryWriteEx(bbhelp,0,targetfilename,0,-1) ; set new eof marker BinaryPokeStr(bbhelp,0,header) BinaryWriteEx(bbhelp,0,targetfilename,0,BinaryEodGet(bbhelp)) ; write header BinaryWriteEx(bb,1,targetfilename,FileSize(targetfilename),BinaryEodGet(bb)-1) ; write the main buffer BinaryEodSet(bbhelp,0) BinaryPokeStr(bbhelp,0,footer) BinaryWriteEx(bbhelp,0,targetfilename,FileSize(targetfilename),BinaryEodGet(bbhelp)); write footer ; close all files BinaryFree(bbhelp) BinaryFree(bbline) BinaryFree(hbb) BinaryFree(bb) udfDisplayMsg(StrCat(logo,"Ready.")) TimeDelay(1) BoxShut() Drop(footer,header,lt,stylefont,stylebgcolor,styleborder,tagpre) Drop(tagon,tagoff,useanimation,usergb,htmdef,targetfilename,UseCase) Drop(qstrlist,cstrlist,ostrlist,bstrlist,mstrlist,wstrlist,nstrlist) Drop(colorvaluelist,colornamelist,i,rgbitem,colornameitem,colorfile,colorvalueitem) Drop(hfilename,hkeysize,hcolornamesize,hmixcasesize,hrecsize,keywordlist,keywordcount) Drop(hbbsize,hbb,keyworditem,colorcount,fsize,bbsize,bb,bbline,sourcefilename,bbb,qchar) Drop(percent,num,bbhelp,msgstr,locpos,color) Drop(param1,param2) Return ;------------------------------------------------------------------------------- :ProgInit logo="WBT2HTML: " logolong="WBT2HTML 1.01 (c)20010729 Detlev Dalitz" If (RtStatus()<>10) Then BoxOpen(logolong,"Be patient") udfDisplayMsg(StrCat(logo,"Initiating ...")) lt ="<" ; helper cbo="{" ; helper If UseRGB ; be aware if your wbt source has embedded html tags !!! htmdef = '%lt%font color="rgb(%cbo%{color}})">%cbo%{txt}}%lt%/font>' Else ; I use this tricky html tagging because I do not know other method to prevent embedded html tags from interpreting by the browser! htmdef = '%lt%font color="%cbo%{color}}">%cbo%{txt}}%lt%/font>' EndIf ; maybe a preprocessor job can do the html tag blending automagically (todo?) If (UseAnimation && (RtStatus()==10)) Then BoxOpen(StrCat(logolong," // animated run //","Be patient") Drop(lt,cbo) ; drop helpers Return ;=============================================================================== :GetParams Drop(SourceFilename,TargetFilename) If IsDefined(param1) Then SourceFilename = param1 ParamResult=(StrLower(FileExtension(SourceFilename))<>"wbt") ;ParamResult=(StrLower(Fileextension(SourceFilename))<>"kex") If ParamResult Message("Error","WBT2HTM.WBT needs a good *.WBT file as input.") Drop(SourceFilename,TargetFilename) Else If IsDefined(param2) Then TargetFilename = param2 If IsDefined(TargetFilename) Then TargetFilename = StrCat(FileRoot(TargetFilename),".htm") ; needs LFN long name file system If !IsDefined(TargetFilename) Then TargetFilename = StrCat(SourceFilename,".htm") EndIf Return ;=============================================================================== :AskParams MyTitle = "WBT2HTML: Select File to convert from WBT to HTM" MyFolder = "?" ; define your standard folder here MyFiletypes = "WBT Files|*.wbt|HTML Files|*.htm;*.html|All Files|*.*|" MyDefault = "*.wbt" MyTool = IntControl(1004,0,0,0,0) While @TRUE fname = AskFilename(MyTitle,MyFolder,MyFiletypes,MyDefault,1) MyFolder = FilePath(fname) result = Call(MyTool,'"%fname%"') If (result==0) newfile = StrCat(fname,".htm") If (FileExist(newfile)) Then Run("iexplore.exe",newfile) EndIf EndWhile Exit ;=============================================================================== :UserConfigurableInit ;############ user configurable area begin ############### UseCase=1 ; 1=freestyle ;UseCase=2 ; 2=lowercase ;UseCase=3 ; 3=uppercase ;UseCase=4 ; 4=standardcase as defined in WIL.CLR resp. as stored in hashtable ;UseRGB=@true ; activate this line for 'font color="rgb(rrr,ggg,bbb)"' UseRGB=@FALSE ; activate this line for 'font color="#rrggbb"' ;UseVerbose=@true ; more screen messages UseVerbose=@FALSE ; less screen messages ;UseAnimation=@true ; if you have time to waste and need some animation ... UseAnimation=@FALSE ;UseAutoDelimiter=@true UseAutoDelimiter=@FALSE ;if you set UseAutoDelimiter=@false then TagOn and TagOff must be defined manually!!! ;Otherwise unpredictable results will occur! TagOn = Num2Char(215) TagOff= Num2Char(208) UseTabReplaceSize=3 ; if there exist tabs in the source file then replace it with blanks Return ;########################### user configurable area end ################# ;=============================================================================== ;=============================================================================== ;=============================================================================== ; syntax 1 (call by another program or start on the commandline without parameters): ; WBT2HTML.WBT ; opens an AskFilename dialog ; ; syntax2 (call or start with parameters): ; WBT2HTML.WBT sourcefilename [targetfilename] ; ; if targetfilename is omitted then sourcefilename will be used ; with added extension ".htm" ; ; example1: ; WBT2HTML.WBT mybest.wbt ; will create mybest.wbt.htm ; ; example2: ; WBT2HTML.WBT mybest.wbt mybad.htm ; will create mybad.htm ; ; Good luck! Viel Spass! And happy converting ... ;=============================================================================== ;=============================================================================== ;=============================================================================== ; This was the initial idea and starting point of this program: ; <_!-- mit Quotes, KEDIT change r §((("{[~"]@}")|('{[~']@}')|(`{[~`]@}`)))\c§<_font color="#aaaaaa">&1&2&3<_/font>§ * * --> ; <_!-- ohne Quotes, KEDIT change r §((({"}{[~"]@}{"})|({'}{[~']@}{'})|({`}{[~`]@}{`})))\c§<_font color="#aaaaaa">&2&5&8<_/font>§ * * --> ;=============================================================================== ;=============================================================================== ;note: ;- wbt2html creates an ini file "wbt2html.ini" in winbatch system folder ;- creates a hash file "WIL.HSH" in temp folder ;- needs WIL's serial extender "wwser34i.dll" ;- html output is placed in source folder. ;===============================================================================