;==================================================================================================================================================== ; WinBatch code COLORIZED into HTML ; ; WBT2HTML.WBT Version 1.23 2002:08:17 ; ; - converts WBT script to HTML tagged script by special colorizing keywords, comments, literals and so on ... ; - uses the same color setup as configured in WinBatch Studio Editor and in WIL.CLR color setup file ; ; Version history see at end of file. ;==================================================================================================================================================== ;==================================================================================================================================================== ; WBT2HTML v1.23 20020817 (c) Detlev Dalitz 2001:07:29:00:00:00 ;==================================================================================================================================================== ; user information is placed at end of file ;---------------------------------------------------------------------------------------------------------------------------------------------------- IntControl (73, 1, 0, 0, 0) ; install the errorhandler iParamError = 0 If Param0 GoSub GetParams Else Goto AskParams EndIf If !iParamError GoSub DefineUDFs GoSub UserConfigurableInit GoSub ProgInit GoSub CollectColors GoSub CollectKeywords GoSub OpenReadSourceFile If UseAutoDelimiter Then GoSub CalculateDelimiters GoSub TagQuote GoSub sCommentLogo GoSub TagOperatorMod GoSub TagOperator GoSub TagBracket GoSub TagSpecial GoSub TagWordNumber GoSub EncodeNamedEntities GoSub ColorizeWord GoSub ColorizeNumber GoSub ColorizeSpecial GoSub ColorizeOperator GoSub ColorizeOperatorMod GoSub ColorizeBracket GoSub ColorizeComment GoSub ColorizeQuote GoSub WriteCloseTargetFile EndIf If IntControl (77, 80, 0, 0, 0) Then Return (iParamError) :CANCEL Exit ;==================================================================================================================================================== :DefineUDFs ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udfbytetohex", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfbytetohex #DefineFunction udfByteToHex (Byte) Return (StrCat (Num2Char (48 + (Byte >> 4) + (39 * ((Byte >> 4) > 9))), Num2Char (48 + (Byte & 15) + (39 * ((Byte & 15) > 9))))) ; lowercase ; Return (StrCat(Num2Char(48+(Byte>>4)+(7*((Byte>>4)>9))),Num2Char(48+(Byte&15)+(7*((Byte&15)>9))))) ; uppercase #EndFunction :skip_udfbytetohex ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udffilecrc32", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udffilecrc32 #DefineFunction udfFileCrc32 (Filename) chk = 0 iFileSize = FileSize (Filename) If (iFileSize > 0) ; AddExtender ("wwser34i.dll") ; Load the serial extender ; 2002-12-26, 21:04:08, 77.893 Bytes. AddExtender ("wwser44i.dll") ; Load the serial extender ; 2004-07-27, 22:33:08, 90.181 Bytes. hBB = BinaryAlloc (iFileSize) BinaryRead (hBB, Filename) chk = pCheckBinary (IntControl (42, hBB, 0, 0, 0), BinaryEodGet (hBB) - 1, 32) BinaryFree (hBB) EndIf Return (chk) #EndFunction :skip_udffilecrc32 ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udfgettemppath", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfgettemppath #DefineFunction udfGetTempPath () ftemp = FileCreateTemp ("TMP") FileDelete (ftemp) TempPath = FilePath (ftemp) Terminate (!DirMake (TempPath), "udfGetTempPath", StrCat ("Cannot access temporary folder:", @CRLF, TempPath)) Return (TempPath) #EndFunction :skip_udfgettemppath ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udfdirgetlong", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfdirgetlong #DefineFunction udfDirGetLong () Return (StrCat (FileNameLong (StrCat (DirGet (), ".")), "\")) #EndFunction :skip_udfdirgetlong ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udsdisplaymsg", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udsdisplaymsg #DefineSubRoutine udsDisplayMsg (sMsgText) If (RtStatus () == 10) Then wStatusMsg (StrCat (sLogo, sMsgText)) Else BoxText (StrCat (sLogo, sMsgText)) #EndSubRoutine :skip_udsdisplaymsg ;---------------------------------------------------------------------------------------------------------------------------------------------------- If ItemLocate ("udfitemlisttofile", IntControl (77, 103, 0, 0, 0), @TAB) Then Goto skip_udfitemlisttofile #DefineFunction udfItemListToFile (list, delimiter, filename) If (list == "") Then Return (0) list = StrReplace (list, delimiter, @CRLF) hBB = BinaryAlloc (StrLen (list)) BinaryPokeStr (hBB, 0, list) num = BinaryWrite (hBB, filename) BinaryFree (hBB) Return (num) #EndFunction :skip_udfitemlisttofile ;---------------------------------------------------------------------------------------------------------------------------------------------------- Return ; from DefineUDFs ;==================================================================================================================================================== ;==================================================================================================================================================== ;Procedures ;==================================================================================================================================================== :wberrorhandler wberror = LastError () wberrmsg = "" wberrmsg = StrCat (wberrmsg, "LastError Value = ", wberror, @CRLF) If !wberror Then wberror = -1 wberrmsg = StrCat (wberrmsg, "LastError String = ", IntControl (34, wberror, 0, 0, 0), @CRLF) ; line in script that caused Error) wberrmsg = StrCat (wberrmsg, "wberrorhandlerline = ", wberrorhandlerline, @CRLF) ; offset into script of error line, in bytes wberrmsg = StrCat (wberrmsg, "wberrorhandleroffset = ", wberrorhandleroffset, @CRLF) ; variable being assigned on error line, or "" If none wberrmsg = StrCat (wberrmsg, "wberrorhandlerassignment = ", wberrorhandlerassignment, @CRLF) If (wberrorhandlerassignment > "") Then %wberrorhandlerassignment% = "eeek" Message ("WBERRORHANDLER", wberrmsg) Exit ;==================================================================================================================================================== ;==================================================================================================================================================== :CollectColors ; collect names and rgb color values sMsg = "Collecting colors ..." udsDisplayMsg (sMsg) ; We use the default rgb color values as defined in WSINIT.DLL and try to update them from the Current User Registry. sColorNameList = StrCat ("Keyword", @TAB, "Quote", @TAB, "Comment", @TAB, "Default Text", @TAB, "Background") sColorValueList = StrCat ("0,0,255", @TAB, "255,0,0", @TAB, "0,128,0", @TAB, "0,0,0", @TAB, "255,255,255") ;--- Read colors for WIL files from WinBatch Studio Registry. --------------------------------------------------------------------------------------- iLastErrorMode = ErrorMode (@OFF) LastError () hRegKey = RegOpenKeyEx (@REGCURRENT, "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files", 1, "", "") ; Mode=1=KEY_QUERY_VALUE=Permission to query subkey data ; We only need read access. iLastError = LastError () ErrorMode (iLastErrorMode) If !iLastError iColorCount = ItemCount (sColorNameList, @TAB) For iColor = 1 To iColorCount sColorNameItem = ItemExtract (iColor, sColorNameList, @TAB) sRegKeySub = StrCat ("[", sColorNameItem, "]") If RegExistValue (hRegKey, sRegKeySub) sColorValueItem = RegQueryValue (hRegKey, sRegKeySub) sColorValueList = ItemReplace (sColorValueItem, iColor, sColorValueList, @TAB) EndIf Next RegCloseKey (hRegKey) EndIf Drop (iLastErrorMode, iLastError, iColorCount, sColorValueItem, iColor, hRegKey, sRegKeySub) ;--- Additional colors from my own inspiration. ----------------------------------------------------------------------------------------------------- ; Note: Force creating new hashtable if colors have changed. sColorNameList = ItemInsert ("Operator", -1, sColorNameList, @TAB) sColorValueList = ItemInsert ("000,048,128", -1, sColorValueList, @TAB) sColorNameList = ItemInsert ("Bracket", -1, sColorNameList, @TAB) sColorValueList = ItemInsert ("032,032,032", -1, sColorValueList, @TAB) sColorNameList = ItemInsert ("Number", -1, sColorNameList, @TAB) sColorValueList = ItemInsert ("096,000,000", -1, sColorValueList, @TAB) sColorNameList = ItemInsert ("Special", -1, sColorNameList, @TAB) sColorValueList = ItemInsert ("000,032,128", -1, sColorValueList, @TAB) ;--- Additional colors from WIL.CLR inifile. -------------------------------------------------------------------------------------------------------- ; for example: CON=128,0,128; EXT=255,0,255; CONSTANT=0,128,255; WED=0,128,0; UDF=128,096,048; OPERATOR=0,48,128 sFilenameWilClr = StrCat (DirHome (), "WIL.CLR") sColorList = IniItemizePvt ("COLORS", sFilenameWilClr) iColorCount = ItemCount (sColorList, @TAB) For iColor = 1 To iColorCount sColorNameItem = ItemExtract (iColor, sColorList, @TAB) sColorValueItem = IniReadPvt ("COLORS", sColorNameItem, "000,000,000", sFilenameWilClr) sColorValueList = ItemInsert (sColorValueItem, -1, sColorValueList, @TAB) sColorNameList = ItemInsert (sColorNameItem, -1, sColorNameList, @TAB) Next Drop (iColorCount, sFilenameWilClr, sColorList, sColorNameItem, sColorValueItem, iColor) ;---------------------------------------------------------------------------------------------------------------------------------------------------- ; Set all items to lower case. ; That is used later when comparing with lowercase keywords in hashbuffer. sColorNameList = StrLower (sColorNameList) ; Delete duplicate names. sNameTrimList = "" sValueTrimList = "" iCount = ItemCount (sColorNameList, @TAB) For iColor = 1 To iCount sNameItem = ItemExtract (iColor, sColorNameList, @TAB) If (sNameItem > "") If !ItemLocate (sNameItem, sNameTrimList, @TAB) sNameTrimList = ItemInsert (sNameItem, -1, sNameTrimList, @TAB) sValueItem = ItemExtract (iColor, sColorValueList, @TAB) sValueTrimList = ItemInsert (sValueItem, -1, sValueTrimList, @TAB) EndIf EndIf Next sColorNameList = sNameTrimList sColorValueList = sValueTrimList Drop (iColor, iCount, sNameItem, sNameTrimList, sValueItem, sValueTrimList) ;---------------------------------------------------------------------------------------------------------------------------------------------------- If UseRGB ; delete all leading zeroes sColorValueList = ItemInsert ("", 0, sColorValueList, @TAB) sColorValueList = StrReplace (sColorValueList, @TAB, StrCat (",", @TAB, ",")) sColorValueList = StrReplace (sColorValueList, ",0", ",") sColorValueList = StrReplace (sColorValueList, ",0", ",") sColorValueList = StrReplace (sColorValueList, ",,", ",0,") sColorValueList = StrReplace (sColorValueList, ",,", ",0,") sColorValueList = StrReplace (sColorValueList, StrCat (",", @TAB, ","), @TAB) sColorValueList = ItemRemove (1, sColorValueList, @TAB) Else ; convert rgb to hex iColorCount = ItemCount (sColorValueList, @TAB) For iColor = 1 To iColorCount sRgbItem = ItemExtract (iColor, sColorValueList, @TAB) sColorValueItem = StrCat ("#", udfByteToHex (ItemExtract (1, sRgbItem, ","))) sColorValueItem = StrCat (sColorValueItem, udfByteToHex (ItemExtract (2, sRgbItem, ","))) sColorValueItem = StrCat (sColorValueItem, udfByteToHex (ItemExtract (3, sRgbItem, ","))) sColorValueList = ItemReplace (sColorValueItem, iColor, sColorValueList, @TAB) Next EndIf Drop (iColorCount, sColorValueItem, iColor, sRgbItem) Return ;==================================================================================================================================================== :CollectKeywords sMsg = "Collecting keywords ..." udsDisplayMsg (sMsg) ; read my inifile in WinBatch system folder sFilenameW2HIni = StrCat (DirHome (), "wbt2html.ini") If !FileExist (sFilenameW2HIni) Then Goto LabelCreate sFilenameWilClr = IniReadPvt ("WIL", "ColorName", "", sFilenameW2HIni) If (sFilenameWilClr == "") Then Goto LabelCreate If !FileExist (sFilenameWilClr) Then Goto LabelCreate If (IniReadPvt ("WIL", "ColorCRC", "", sFilenameW2HIni) <> udfFileCrc32 (sFilenameWilClr)) Then Goto LabelCreate If !FileExist (IniReadPvt ("WIL", "HashName", "", sFilenameW2HIni)) Then Goto LabelCreate sMsg = "Reading Keyword HashTable ..." udsDisplayMsg (sMsg) GoSub ReadIni ; get the hash buffer definition values iBBHashSize = FileSizeEx (sFilenameBBHash) If !iBBHashSize Then Goto LabelCreate hBBHash = BinaryAlloc (iBBHashSize) BinaryRead (hBBHash, sFilenameBBHash) Drop (sFilenameWilClr, iBBHashSize, sFilenameW2HIni) Return :LabelCreate sMsg = "Creating Keyword HashTable ... be patient ..." udsDisplayMsg (sMsg) CurrentDir = DirGet () DirChange (udfGetTempPath ()) sFilenameBBHash = StrCat (udfDirGetLong (), "wil.hsh") DirChange (DirHome ()) sFilenameWilClr = StrCat (udfDirGetLong (), "wil.clr") DirChange (CurrentDir) Drop (CurrentDir) Terminate (!FileExist (sFilenameWilClr), "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. sKeywordList = IniItemizePvt ("KEYWORDS", sFilenameWilClr) iKeyiWordCount = ItemCount (sKeywordList, @TAB) iBBHashSize = 2 * iKeyiWordCount * iBBHashRecSize ; hashfactor*keycount*(length of key + length of data) hBBHash = BinaryAlloc (iBBHashSize) For i = 1 To iKeyiWordCount sKeywordItem = ItemExtract (i, sKeywordList, @TAB) sColorNameItem = StrTrim (IniReadPvt ("KEYWORDS", sKeywordItem, "", sFilenameWilClr)) If (sColorNameItem == "1") Then sColorNameItem = "Keyword" ; set standard WIL color=1 to "Keyword" as set in Registry iBBHashOffset = BinaryHashRec (hBBHash, iBBHashRecSize, iBBHashKeyOffset, iBBHashKeySize, StrLower (sKeywordItem)) BinaryPokeStr (hBBHash, iBBHashOffset + iBBHashColorNameOffset, StrLower (sColorNameItem)) BinaryPokeStr (hBBHash, iBBHashOffset + iBBHashMixCaseOffset, sKeywordItem) Next BinaryWrite (hBBHash, sFilenameBBHash) GoSub WriteIni Drop (sFilenameWilClr, sColorNameItem, iBBHashSize, iBBHashOffset, i) Drop (iKeyiWordCount, sKeywordItem, sKeywordList, CurrentDir, sFilenameW2HIni) Return ;---------------------------------------------------------------------------------------------------------------------------------------------------- :InitIni IniWritePvt ("WBT2HTML", "InternalName", "wbt2html.wbt", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "FileVersion", "1.23", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "FileDescription", "WBT to coloured HTML Script Converter", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "OriginalFilename", "WBT2HTML.WBT", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "ProductName", "WBT2HTML", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "ProductVersion", "1", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "CompanyName", "Detlev Dalitz", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "LegalCopyright", "(c)20010729 Detlev Dalitz", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "Comments", "emailto:dd@dalitz-im-netz.de", sFilenameW2HIni) IniWritePvt ("WBT2HTML", "IniYmdHms", TimeYmdHms (), sFilenameW2HIni) IniWritePvt ("WIL", "ColorName", sFilenameWilClr, sFilenameW2HIni) IniWritePvt ("WIL", "ColorYmdHms", "0", sFilenameW2HIni) IniWritePvt ("WIL", "ColorCRC", "0", sFilenameW2HIni) IniWritePvt ("WIL", "HashName", sFilenameBBHash, sFilenameW2HIni) IniWritePvt ("WIL", "HashYmdHms", "0", sFilenameW2HIni) IniWritePvt ("WIL", "HashCRC", "0", sFilenameW2HIni) Return ;---------------------------------------------------------------------------------------------------------------------------------------------------- :WriteIni IniWritePvt ("WIL", "ColorName", sFilenameWilClr, sFilenameW2HIni) IniWritePvt ("WIL", "ColorYmdHms", FileTimeGetEx (sFilenameWilClr, 2), sFilenameW2HIni) IniWritePvt ("WIL", "ColorCRC", udfFileCrc32 (sFilenameWilClr), sFilenameW2HIni) IniWritePvt ("WIL", "HashName", sFilenameBBHash, sFilenameW2HIni) IniWritePvt ("WIL", "HashYmdHms", FileTimeGetEx (sFilenameBBHash, 2), sFilenameW2HIni) IniWritePvt ("WIL", "HashCRC", udfFileCrc32 (sFilenameBBHash), sFilenameW2HIni) Return ;---------------------------------------------------------------------------------------------------------------------------------------------------- :ReadIni iBBHashKeyOffset = 0 ; key lowercase iBBHashKeySize = 60 ; key lowercase iBBHashColorNameOffset = 60 ; color name iBBHashColorNameSize = 30 ; color name iBBHashMixCaseOffset = 90 ; doubled key field in mixed case as stored in WIL.CLR iBBHashMixCaseSize = 30 ; doubled key field in mixed case as stored in WIL.CLR iBBHashRecSize = iBBHashKeySize + iBBHashColorNameSize + iBBHashMixCaseSize sFilenameBBHash = IniReadPvt ("WIL", "HashName", "", sFilenameW2HIni) Return ; iBBHashKeySize upsized from 30 to 60 chars, regardless of WinBatch's limited var size. ; This is done for runtime security reasons and because of OLE-object names, which are 'oversized' sometimes. ;==================================================================================================================================================== :TagQuote sMsg = "Tagging quotes ..." udsDisplayMsg (sMsg) qlist = """|'|`" ; Three items: doublequote, singlequote, backquote. iQuoteCount = ItemCount (qlist, "|") sCommentChar = ";" sScanChars = """'`;" ; Four characters: doublequote, singlequote, backquote, semicolon. sTagIdent = "q" sTagList%sTagIdent% = sTagOn ; start list with a well known item sBBTag = BinaryTagInit (hBB, @LF, @CR) While 1 sBBTag = BinaryTagFind (sBBTag) If (sBBTag == "") Then Break sLine = BinaryTagExtr (sBBTag, 1) If (sLine == "") Then Continue sScanLine = StrClean (sLine, sScanChars, "", @FALSE, 2) If (StrLen (sScanLine) < 2) Then Continue ; Skip line, no complete quoted literal to replace. If (StrSub (sScanLine, 1, 1) == sCommentChar) Then Continue ; Skip line, contains comment only. For iQuote = 1 To iQuoteCount sQuote = ItemExtract (iQuote, qlist, "|") sBBLineTag%iQuote% = BinaryTagInit (hBBLine, sQuote, sQuote) Next ; Find literals. BinaryEodSet (hBBLine, 0) BinaryPokeStr (hBBLine, 0, sLine) iScan = 1 While 1 sScanLine = BinaryPeekStr (hBBLine, 0, BinaryEodGet (hBBLine)) iScan = StrScan (sScanLine, sScanChars, iScan, @FWDSCAN) If !iScan Then Break sChar = StrSub (sScanLine, iScan, 1) If (sChar == sCommentChar) Then Break iQuote = ItemLocate (sChar, qlist, "|") sBBLineTag = sBBLineTag%iQuote% sBBLineTag = BinaryTagFind (sBBLineTag) If (sBBLineTag == "") Then Break ; If it breaks here, then there must be a syntax error in original code. sLiteral = BinaryTagExtr (sBBLineTag, 1) ; Exclude current Quote Char from colorizing. ;;; sLiteral = StrCat(sChar,sLiteral,sChar) ; do not (!) include quote chars for later colorizing !!! If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage BB ", 100 * BinaryEodGet (hBB) / iBBSize, "%%") sMsgUse = StrCat (sMsgUse, @CRLF, "BufferUsage BBLine ", 100 * BinaryEodGet (hBBLine) / iBBLineSize, "%%") sMsgUse = StrCat (sMsgUse, @CRLF, sLiteral) udsDisplayMsg (sMsgUse) EndIf iItemLocate = ItemLocate (sLiteral, sTagList%sTagIdent%, @TAB) If !iItemLocate sTagList%sTagIdent% = ItemInsert (sLiteral, -1, sTagList%sTagIdent%, @TAB) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) Else sTag = StrCat (sTagOn, sTagIdent, iItemLocate, sTagOff) EndIf sTag = StrCat (sChar, sTag, sChar) ; Exclude current Quote Char from colorizing. sBBLineTag = BinaryTagRepl (sBBLineTag, sTag) sBBLineTag%iQuote% = sBBLineTag iScan = iScan + StrLen (sTag) EndWhile ; Replace the line. sLine = BinaryPeekStr (hBBLine, 0, BinaryEodGet (hBBLine)) sTag = StrCat (@LF, sLine, @CR) sBBTag = BinaryTagRepl (sBBTag, sTag) EndWhile ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop (iItemLocate, iQuote, iQuoteCount, iScan, qlist, sLiteral) Drop (sBBTag, sChar, sCommentChar, sLine, sMsg) Drop (sMsgUse, sQuote, sScanChars, sScanLine, sTag, sTagIdent) DropWild ("sBBLineTag*") Return ;==================================================================================================================================================== :sCommentLogo sMsg = "Tagging comments ..." udsDisplayMsg (sMsg) clist = ";" sTagIdent = "c" sTagList%sTagIdent% = sTagOn ; start list with a well known item ccount = ItemCount (clist, ".") For c = 1 To ccount citem = ItemExtract (c, clist, ".") sBBTag = BinaryTagInit (hBB, citem, @CR) While 1 sBBTag = BinaryTagFind (sBBTag) If (sBBTag == "") Then Break cstr = BinaryTagExtr (sBBTag, 1) cstr = StrCat (citem, cstr) ; include leading comment char for later colorizing If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, cstr) udsDisplayMsg (sMsgUse) EndIf iItemLocate = ItemLocate (cstr, sTagList%sTagIdent%, @TAB) If !iItemLocate sTagList%sTagIdent% = ItemInsert (cstr, -1, sTagList%sTagIdent%, @TAB) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) Else sTag = StrCat (sTagOn, sTagIdent, iItemLocate, sTagOff) EndIf sTag = StrCat (sTag, @CR) ; exclude trailing comment char (@cr) from colorizing sBBTag = BinaryTagRepl (sBBTag, sTag) EndWhile Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop (c, ccount, citem, clist, cstr, sTag, iItemLocate, sMsgUse) Drop (sBBTag, sTagIdent) Return ;==================================================================================================================================================== :TagOperatorMod ; This routine needs the round brackets untouched. sMsg = "Tagging operator mod ..." udsDisplayMsg (sMsg) ; Workaround for the Regular Expression '[ 0-9\)](mod)[ 0-9\(\+\-]' ; KEDIT: change r '[ 0-9\)](mod)[ 0-9\(\+\-]'<font color="#rrggbb">&1</font>' * * ; Build a list of all combinations. mList = "" iList = " 0123456789)" kList = " 0123456789(+-" iMax = StrLen (iList) kMax = StrLen (kList) For i = 1 To iMax For k = 1 To kMax mList = ItemInsert (StrCat (StrSub (iList, i, 1), StrSub (kList, k, 1)), -1, mList, @TAB) Next Next Drop (i, iList, iMax, k, kList, kMax) sTagIdent = "m" sTagList%sTagIdent% = sTagOn ; start list with a well known item sTagList%sTagIdent% = ItemInsert ("mod", -1, sTagList%sTagIdent%, @TAB) ; the one and only keyword mcount = ItemCount (mlist, @TAB) For m = 1 To mcount mstr = ItemExtract (m, mlist, @TAB) If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, mstr) udsDisplayMsg (sMsgUse) EndIf sBBTag = BinaryTagInit (hBB, StrCat (StrSub (mstr, 1, 1), "mod"), StrSub (mstr, 2, 1)) While 1 sBBTag = BinaryTagFind (sBBTag) If (sBBTag == "") Then Break If BinaryTagLen (sBBTag, 0) Then Continue ; not a pure "mod", e.g. " (mod)ified " mstr = BinaryPeekStr (hBB, BinaryTagIndex (sBBTag, 1), BinaryTagLen (sBBTag, 1)) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) sTag = StrReplace (StrLower (mstr), "mod", sTag) sBBTag = BinaryTagRepl (sBBTag, sTag) EndWhile Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) ; num = BinaryWrite(hBB,StrCat(udfGetTempPath(),"wbt2html.hBB.",sTagIdent,".bin")) Drop (m, mcount, mList, sMsgUse, mstr, sTag, sBBTag, sTagIdent) Return ;==================================================================================================================================================== :TagOperator sMsg = "Tagging operators ..." udsDisplayMsg (sMsg) olist = "==.<=.>=.<>.!=.<.>.**.*./.+.-.&&.||.<<.>>.&.|.^.~.!.+.-.=" ; plus ".mod" ; binary(relational,arithmetic,logical),unary(integer logical,integer & float),assignment sTagIdent = "o" sTagList%sTagIdent% = sTagOn ; start list with a well known item ocount = ItemCount (olist, ".") For o = 1 To ocount ostr = ItemExtract (o, olist, ".") If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, ostr) udsDisplayMsg (sMsgUse) EndIf sTagList%sTagIdent% = ItemInsert (ostr, -1, sTagList%sTagIdent%, @TAB) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) BinaryReplace (hBB, ostr, sTag, @FALSE) Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop (sMsgUse, o, ocount, olist, ostr, sTag, sTagIdent) Return ;==================================================================================================================================================== :TagBracket sMsg = "Tagging brackets ..." udsDisplayMsg (sMsg) blist = "(.).[.].{.}" ; brackets sTagIdent = "b" sTagList%sTagIdent% = sTagOn ; start list with a well known item bcount = ItemCount (blist, ".") For b = 1 To bcount bstr = ItemExtract (b, blist, ".") If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, bstr) udsDisplayMsg (sMsgUse) EndIf sTagList%sTagIdent% = ItemInsert (bstr, -1, sTagList%sTagIdent%, @TAB) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) BinaryReplace (hBB, bstr, sTag, @FALSE) Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop (b, bcount, blist, bstr, sTag, sMsgUse, sTagIdent) Return ;==================================================================================================================================================== :TagSpecial sMsg = "Tagging special ..." udsDisplayMsg (sMsg) slist = " |,|@|#|::|:" ; blank,comma,ASCII-64,colon,ASCII-35 (iPercent sign too?) sTagIdent = "s" sTagList%sTagIdent% = sTagOn ; start list with a well known item scount = ItemCount (slist, "|") For s = 1 To scount sstr = ItemExtract (s, slist, "|") If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, sstr) udsDisplayMsg (sMsgUse) EndIf sTagList%sTagIdent% = ItemInsert (sstr, -1, sTagList%sTagIdent%, @TAB) sTag = StrCat (sTagOn, sTagIdent, ItemCount (sTagList%sTagIdent%, @TAB), sTagOff) BinaryReplace (hBB, sstr, sTag, @FALSE) Next ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdent%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdent,".txt")) Drop (sMsgUse, s, scount, slist, sstr, sTag, sTagIdent) Return ;==================================================================================================================================================== :TagWordNumber sMsg = "Tagging words and numbers ..." udsDisplayMsg (sMsg) sTagIdentWord = "w" sTagList%sTagIdentWord% = sTagOn ; start list with a well known item sTagIdentNumber = "n" sTagList%sTagIdentNumber% = sTagOn ; start list with a well known item ; "hide" all @crlf BinaryReplace (hBB, @CRLF, StrCat (sTagOn, @CRLF, sTagOff), @FALSE) sBBTag = BinaryTagInit (hBB, sTagOff, sTagOn) While 1 sBBTag = BinaryTagFind (sBBTag) If (sBBTag == "") Then Break sWordNumber = BinaryTagExtr (sBBTag, 1) If (sWordNumber == "") Then Continue If UseVerbose sMsgUse = StrCat (sMsg, @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%", @CRLF, sWordNumber) udsDisplayMsg (sMsgUse) EndIf If IsNumber (sWordNumber) iItemLocate = ItemLocate (sWordNumber, sTagList%sTagIdentNumber%, @TAB) If !iItemLocate sTagList%sTagIdentNumber% = ItemInsert (sWordNumber, -1, sTagList%sTagIdentNumber%, @TAB) iItemLocate = ItemCount (sTagList%sTagIdentNumber%, @TAB) EndIf sTag = StrCat (sTagOff, sTagOn, sTagIdentNumber, iItemLocate, sTagOff, sTagOn) Else iItemLocate = ItemLocate (sWordNumber, sTagList%sTagIdentWord%, @TAB) If !iItemLocate sTagList%sTagIdentWord% = ItemInsert (sWordNumber, -1, sTagList%sTagIdentWord%, @TAB) iItemLocate = ItemCount (sTagList%sTagIdentWord%, @TAB) EndIf sTag = StrCat (sTagOff, sTagOn, sTagIdentWord, iItemLocate, sTagOff, sTagOn) EndIf sBBTag = BinaryTagRepl (sBBTag, sTag) EndWhile ; "unhide" all @crlf BinaryReplace (hBB, StrCat (sTagOn, @CRLF, sTagOff), @CRLF, @FALSE) ; --- debug --- ; num = udfItemListToFile (sTagList%sTagIdentNumber%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdentNumber,".txt")) ; num = udfItemListToFile (sTagList%sTagIdentWord%, @tab, StrCat(udfGetTempPath(),"wbt2html.sTagList.",sTagIdentWord,".txt")) ; num = BinaryWrite(hBB,StrCat(udfGetTempPath(),"wbt2html.hBB.",sTagIdentWord,".bin")) Drop (iItemLocate, sMsgUse, sBBTag, sTagIdentNumber, sTagIdentWord, sWordNumber, sTag) Return ;==================================================================================================================================================== :EncodeNamedEntities sMsg = "Encoding HTML Named Entities ..." udsDisplayMsg (sMsg) sTagListo = StrReplace (sTagListo, "&", "&") sTagListo = StrReplace (sTagListo, "<", "<") sTagListo = StrReplace (sTagListo, ">", ">") sTagListc = StrReplace (sTagListc, "&", "&") sTagListc = StrReplace (sTagListc, "<", "<") sTagListc = StrReplace (sTagListc, ">", ">") sTagListq = StrReplace (sTagListq, "&", "&") sTagListq = StrReplace (sTagListq, '"', """) sTagListq = StrReplace (sTagListq, "<", "<") sTagListq = StrReplace (sTagListq, ">", ">") sTagListq = StrReplace (sTagListq, "{", "{") sTagListq = StrReplace (sTagListq, "}", "}") sTagListc = StrReplace (sTagListc, "ä", "ä") sTagListc = StrReplace (sTagListc, "ö", "ö") sTagListc = StrReplace (sTagListc, "ü", "ü") sTagListc = StrReplace (sTagListc, "Ä", "Ä") sTagListc = StrReplace (sTagListc, "Ö", "Ö") sTagListc = StrReplace (sTagListc, "Ü", "Ü") sTagListc = StrReplace (sTagListc, "ß", "ß") sTagListq = StrReplace (sTagListq, "ä", "ä") sTagListq = StrReplace (sTagListq, "ö", "ö") sTagListq = StrReplace (sTagListq, "ü", "ü") sTagListq = StrReplace (sTagListq, "Ä", "Ä") sTagListq = StrReplace (sTagListq, "Ö", "Ö") sTagListq = StrReplace (sTagListq, "Ü", "Ü") sTagListq = StrReplace (sTagListq, "ß", "ß") ; For details see Unicode "ISO 10646" Return ;==================================================================================================================================================== :ColorizeWord sTagIdent = "w" iWordCount = ItemCount (sTagList%sTagIdent%, @TAB) iColorCount = ItemCount (sColorNameList, @TAB) ; fill the lists with well known items fillitem = StrCat (sTagOn, @TAB) fillcount = (2 * iWordCount) - 1 For iColor = 1 To iColorCount sTagList%sTagIdent%%iColor% = StrFill (fillitem, fillcount) Next Drop (fillitem, fillcount) iColorDefault = ItemLocate ("default text", sColorNameList, @TAB) For iWord = 1 To iWordCount sWord = ItemExtract (iWord, sTagList%sTagIdent%, @TAB) iBBHashOffset = BinaryHashRec (hBBHash, iBBHashRecSize, iBBHashKeyOffset, iBBHashKeySize, StrLower (sWord)) sColorName = BinaryPeekStr (hBBHash, iBBHashOffset + iBBHashColorNameOffset, iBBHashColorNameSize) If (sColorName == "") BinaryPoke (hBBHash, iBBHashOffset, 0) ; housekeeping the hashtable iColor = iColorDefault Else iColor = ItemLocate (sColorName, sColorNameList, @TAB) If iColor == 0 FileAttrSet (sFilenameBBHash, "rash") FileDelete (sFilenameBBHash) Message ("Error", StrCat ("Color name not found.", @LF, "Maybe hash file is corrupt.", @LF, "Run script again.")) Exit EndIf Select UseCase Case 4 sWord = BinaryPeekStr (hBBHash, iBBHashOffset + iBBHashMixCaseOffset, iBBHashMixCaseSize) Break Case 3 sWord = StrUpper (sWord) Break Case 2 sWord = StrLower (sWord) Break Case 1 ; sWord = sWord ; freestyle, no change Break EndSelect EndIf sTagList%sTagIdent%%iColor% = ItemReplace (sWord, iWord, sTagList%sTagIdent%%iColor%, @TAB) Next Drop (sTagList%sTagIdent%, iWordCount, sWord, iWord, sColorName, iBBHashOffset, iColorDefault) For iColor = 1 To iColorCount If (StrClean (sTagList%sTagIdent%%iColor%, StrCat (@TAB, sTagOn), "", @FALSE, 1) > "") sColorName = ItemExtract (iColor, sColorNameList, @TAB) sMsg = StrCat ("Colorizing words (", sColorName, ") ...") udsDisplayMsg (sMsg) GoSub ReplaceColorTag EndIf Drop (sTagList%sTagIdent%%iColor%) Next Drop (iColorCount, sColorName, iColor) BinaryFree (hBBHash) ; hashbuffer has done his job Drop (hBBHash) Drop (sTagIdent) Return ;==================================================================================================================================================== :ColorizeNumber sTagIdent = "n" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing numbers ..." udsDisplayMsg (sMsg) sColorName = "Number" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeSpecial sTagIdent = "s" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing special ..." udsDisplayMsg (sMsg) sColorName = "" ; "" or "Special" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeBracket sTagIdent = "b" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing brackets ..." udsDisplayMsg (sMsg) sColorName = "" ; "" or "Bracket" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeOperator sTagIdent = "o" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing operators ..." udsDisplayMsg (sMsg) sColorName = "Operator" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeOperatorMod sTagIdent = "m" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing operator mod ..." udsDisplayMsg (sMsg) sColorName = "Operator" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeComment sTagIdent = "c" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing comments ..." udsDisplayMsg (sMsg) sColorName = "Comment" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ColorizeQuote sTagIdent = "q" If (sTagList%sTagIdent% == sTagOn) Then Return sMsg = "Colorizing quotes ..." udsDisplayMsg (sMsg) sColorName = "Quote" GoSub ReplaceColorTag Drop (sColorName, sTagIdent) Return ;==================================================================================================================================================== :ReplaceColorTag ; needs a sTagListx If (sTagIdent <> "w") Then iColor = "" iTagCount = ItemCount (sTagList%sTagIdent%%iColor%, @TAB) For iTag = iTagCount To 1 By -1 If UseVerbose iPercent = 100 * iTag / iTagCount If !(iPercent mod 10) udsDisplayMsg (StrCat (sMsg, " ", iPercent, "%%", @CRLF, "BufferUsage ", 100 * BinaryEodGet (hBB) / iBBSize, "%%")) EndIf EndIf If UseAnimation iPercent = 100 * iTag / iTagCount iBBEod = BinaryEodGet (hBB) - 1 iBBEodFactor = iBBEod / iTagCount iBBBottom = iBBEodFactor * (iTag - 1) iBBTop = Min (iBBEod - iBBBottom, iBBBottom + iBBEodFactor) ; Important Note: BoxText causes an error 12000 abort if this script has been called via WSPOPUP.MNU ! BoxText (StrCat (sMsg, " ", iPercent, "%%", @CRLF, BinaryPeekStr (hBB, iBBBottom, iiBBTop))) EndIf sTag = ItemExtract (iTag, sTagList%sTagIdent%%iColor%, @TAB) If (sTag == "") BinaryReplace (hBB, StrCat (sTagOn, sTagIdent, iTag, sTagOff), sTag, @FALSE) ; empty sTag requires no colorizing Continue EndIf If (sTag == sTagOn) Then Continue sColorValue = ItemExtract (ItemLocate (StrLower (sColorName), sColorNameList, @TAB), sColorValueList, @TAB) If (sColorValue > "") sTag = StrReplace (sFontTagDefault, "{{txt}}", sTag) sTag = StrReplace (sTag, "{{col}}", sColorValue) EndIf BinaryReplace (hBB, StrCat (sTagOn, sTagIdent, iTag, sTagOff), sTag, @FALSE) Next Drop (iBBBottom, iBBTop, iBBEod, iBBEodFactor, sTag, iTag, iPercent) Drop (sColorValue, iTagCount) Drop (sTagList%sTagIdent%%iColor%) Return ;==================================================================================================================================================== :OpenReadSourceFile sMsg = "Reading source file " sMsg = StrCat (sMsg, @CRLF, sSourceFilename) udsDisplayMsg (sMsg) iFileSize = FileSizeEx (sSourceFilename) Terminate (!iFileSize, "Error", "Sourcefile has FileSize=0") If (iFileSize > 32768) Then Exclusive (@ON) ; speed up performance on large files iBBSize = iFileSize * 16 ; or more ? (changing plain text to html lets grow the file sometimes enormously) iBBSize = Max (16384, iBBSize) ; minimum 16KB Buffer hBB = BinaryAlloc (iBBSize) iBBLineSize = 4096 ; or more ? hBBLine = BinaryAlloc (iBBLineSize) BinaryPokeStr (hBB, 0, @LF) ; a little helper BinaryPokeStr (hBB, 1, @CRLF) ; a little helper BinaryReadEx (hBB, 3, sSourceFilename, 0, iFileSize) BinaryPokeStr (hBB, BinaryEodGet (hBB), @CRLF) ; a little helper BinaryPokeStr (hBB, BinaryEodGet (hBB), @CR) ; a little helper BinaryReplace (hBB, @TAB, StrFill (" ", UseTabReplaceSize), @FALSE) ; CleanTabs Drop (iFileSize) Return ;==================================================================================================================================================== :CalculateDelimiters sMsg = "Calculating delimiters ... be patient ... on file" sMsg = StrCat (sMsg, @CRLF, sSourceFilename) udsDisplayMsg (sMsg) ; Create a chartable ... sTag = "" For iTag = 1 To 31 sTag = StrCat (sTag, Num2Char (iTag)) Next For iTag = 129 To 255 sTag = StrCat (sTag, Num2Char (iTag)) Next sTag = StrReplace (sTag, @TAB, "") sTag = StrReplace (sTag, @CR, "") sTag = StrReplace (sTag, @LF, "") sTag = StrClean (sTag, BinaryPeekStr (hBB, 0, BinaryEodGet (hBB) - 1), "", @FALSE, 1) ; ... and have used chars deleted. Terminate ((StrLen (sTag) < 2), StrCat (sLogo, "Error"), "This special WBT sourcefile cannot be converted into HTML ('tag chars not available').") sTagOn = StrSub (sTag, 1, 1) sTagOff = StrSub (sTag, 2, 1) Drop (iTag, sTag) Return ;==================================================================================================================================================== :WriteCloseTargetFile sMsg = "Writing target file " sMsg = StrCat (sMsg, @CRLF, sTargetFilename) udsDisplayMsg (sMsg) ; Create a basic HTML page structure with Header and Footer. ; Create comments. sCommentLogo = StrCat ('<! [', TimeYmdHms (), '] colorized HTML by WBT2HTML.WBT v1.23 (c)20010729-20020817.Detlev Dalitz -->') sCommentColorList = "" iCount = ItemCount (sColorNameList, @TAB) For i = 1 To iCount sColorNameItem = ItemExtract (i, sColorNameList, @TAB) sColorValueItem = ItemExtract (i, sColorValueList, @TAB) sCommentColorList = ItemInsert (StrCat ('"', sColorNameItem, '"="', sColorValueItem, '"'), -1, sCommentColorList, ";") Next sCommentColorList = StrCat ('<! ', sCommentColorList, ' -->') ; Read font attributes for WIL files from WinBatch Studio Registry. hRegKey = RegOpenKey (@REGCURRENT, "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files") sStyleFont = "" sStyleFont = StrCat (sStyleFont, "font-style:", ItemExtract (RegQueryValue (hRegKey, "[Font Italic]") + 1, "normal/italic", "/"), "; ") sStyleFont = StrCat (sStyleFont, "font-family:'", RegQueryValue (hRegKey, "[Font name]"), "'; ") sStyleFont = StrCat (sStyleFont, "font-size:", RegQueryValue (hRegKey, "[Font size]"), "pt; ") sStyleFont = StrCat (sStyleFont, "font-weight:", RegQueryValue (hRegKey, "[Font weight]"), "; ") RegCloseKey (hRegKey) Drop (hRegKey) sFgColor = StrLower (ItemExtract (ItemLocate (StrLower ("Default Text"), sColorNameList, @TAB), sColorValueList, @TAB)) sBgColor = StrLower (ItemExtract (ItemLocate (StrLower ("Background"), sColorNameList, @TAB), sColorValueList, @TAB)) If UseRGB sFgColor = StrCat ('rgb(', sFgColor, ')') sBgColor = StrCat ('rgb(', sBgColor, ')') EndIf sStyleBgImage = "background-image:url(../images/gif/grid.gif); " ; My background image. ; sStyleBgImage = "" ; Activate this line if no background image to use. sStyleBgColor = StrCat ("background-color:", sBgColor, "; ") sStyleBorder = "border:1pt solid #dddddd; padding:3pt; width:100%%; " sStyleFgColor = StrCat ('color:', sFgColor, '; ') TagPre = '<pre' TagPre = StrCat (TagPre, ' style="', sStyleBgImage, sStyleBgColor, sStyleBorder, sStyleFont, sStyleFgColor, '"') TagPre = StrCat (TagPre, ' title="colorized by WBT2HTML"', '>') sHtmHeader = StrCat ('<html>', @CRLF, '<body>', @CRLF, sCommentLogo, @CRLF, sCommentColorList, @CRLF, TagPre, @CRLF) sHtmFooter = StrCat ('</pre>', @CRLF, '</body>', @CRLF, '</html>', @CRLF) ; Write the html file. BinaryEodSet (hBB, BinaryEodGet (hBB) - 1) ; Cut little helper @cr. BinaryEodSet (hBB, BinaryEodGet (hBB) - 2) ; Cut little helper @crlf. If (BinaryPeekStr (hBB, BinaryEodGet (hBB) - 2, 2) <> @CRLF) Then BinaryPokeStr (hBB, BinaryEodGet (hBB), @CRLF); Add @crlf for sure. hBBHelp = BinaryAlloc (1024) BinaryWriteEx (hBBHelp, 0, sTargetFilename, 0, -1) ; Set new eof marker. BinaryPokeStr (hBBHelp, 0, sHtmHeader) BinaryWriteEx (hBBHelp, 0, sTargetFilename, 0, BinaryEodGet (hBBHelp)) ; Write Header. BinaryWriteEx (hBB, 3, sTargetFilename, FileSize (sTargetFilename), BinaryEodGet (hBB) - 3) ; Write the main buffer (minus helper length) BinaryEodSet (hBBHelp, 0) BinaryPokeStr (hBBHelp, 0, sHtmFooter) BinaryWriteEx (hBBHelp, 0, sTargetFilename, FileSize (sTargetFilename), BinaryEodGet (hBBHelp)); Write Footer ; Close all buffers. BinaryFree (hBBHelp) BinaryFree (hBBLine) BinaryFree (hBB) sMsg = "Ready." udsDisplayMsg (sMsg) TimeDelay (1) If (RtStatus () <> 10) Then BoxShut () Drop (sBgColor, sColorNameItem, sColorValueItem, sCommentColorList, sFgColor, sHtmFooter, sHtmHeader) Drop (i, iCount, hRegKey, sStyleBgColor, sStyleBorder, sStyleFgColor, sStyleFont, sCommentLogo) Drop (TagPre) Drop (hBB, hBBLine, hBBHelp) Return ;==================================================================================================================================================== :ProgInit sLogo = "WBT2HTML: " sLogoLong = "WBT2HTML v1.23 20020817 (c)20010729 Detlev Dalitz" If (RtStatus () <> 10) Then BoxOpen (sLogoLong, "Be patient") sMsg = "Initiating ..." udsDisplayMsg (sMsg) If UseRGB sFontTagDefault = '<font color="rgb({{col}})">{{txt}}</font>' Else sFontTagDefault = '<font color="{{col}}">{{txt}}</font>' EndIf If (UseAnimation && (RtStatus () == 10)) Then BoxOpen (sLogoLong, "Be patient, 'animated run' will follow after tagging ...") Return ;==================================================================================================================================================== :GetParams Drop (sSourceFilename, sTargetFilename) If !ItemLocate (StrLower (FileExtension (Param1)), "wbt|web", "|") Message ("Error", "WBT2HTM.WBT needs a *.WBT or *.WEB file as input.") iParamError = 1 Else If IsDefined (Param1) Then sSourceFilename = Param1 If IsDefined (Param2) sTargetFilename = StrCat (FilePath (Param2), FileRoot (Param2), ".htm") ; force extension Else sTargetFilename = StrCat (FilePath (Param1), FileRoot (Param1), ".", FileExtension (Param1), ".htm") ; add extension EndIf iParamError = 0 EndIf Return ;==================================================================================================================================================== :AskParams AFN_title = "WBT2HTML: Select WBT/WEB File to convert to HTM" AFN_folder = "W:\WINBATCH\2001\" ; define your standard folder here AFN_filetypes = "WIL Files|*.wbt;*.web|HTML Files|*.htm;*.html|All Files|*.*|" AFN_default = "*.wbt;*.web" AFN_flag = 1 ; open single file While 1 sFilenameSource = AskFilename (AFN_title, AFN_folder, AFN_filetypes, AFN_default, AFN_flag) AFN_folder = FilePath (sFilenameSource) If !Call (IntControl (1004, 0, 0, 0, 0), '"%sFilenameSource%"') ; Call this script again with quoted filename. sFilenameHtm = StrCat (sFilenameSource, ".htm") If (FileExist (sFilenameHtm)) Then RunZoom ("iexplore.exe", sFilenameHtm) EndIf EndWhile Exit ; todo notes: ; Starting AFN_folder should be added to section UserConfigurableInit, may add to INI file. ; May remember the last working folder in INI file. ; sHtmFile should be identical to sTargetFilename (may make the same variable) ;==================================================================================================================================================== ;==================================================================================================================================================== :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)"></font>' UseRGB = @FALSE ; activate this line for '<font color="#rrggbb"></font>' ;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 sTagOn and sTagOff must be defined manually!!! ;Otherwise unpredictable results will occur! sTagOn = Num2Char (215) sTagOff = 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 sSourceFilename [sTargetFilename] ; ; If sTargetFilename is omitted then sSourceFilename 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. ;==================================================================================================================================================== ;==================================================================================================================================================== ; Note: ; Although it is possible to call the WBT2HTML.wbt script via WSPOPUP.MNU entry, ; the script would not run successfully if UseAnimation is set @TRUE. ; The 'Animation' uses the normal BoxText statement, but this is ; NOT allowed to be used from within the WSPOPUP.MNU environment. ; The script will abort with error number 12000. ; ; Workaround: ; Choice 1. Always do set 'UseAnimation=@FALSE' if calling the script via WSPOPUP.MNU. ; Choice 2. 'Run' the WBT2HTML.WBT via WSPOPUP.MNU entry. ; Choice 3. 'Run' or 'Runwait' the WBT2HTML.WBT via a helper wbt script which is called from WSPOPUP.MNU entry. ; Choice 3 allows to select text passages from current edit text and send it via ClipGet to WBT2HMTL.WBT. ; Those caller script can be something like the following script 'WBStudioToWBT2HTML.wbt'. ;==================================================================================================================================================== ;==================================================================================================================================================== ; Known Issues: ; None. ;==================================================================================================================================================== ;==================================================================================================================================================== ; WBStudioToWBT2HTML.wbt ;==================================================================================================================================================== ; Caller utility for WBT2HTML.WBT. ; This script should only be called from a WSPOPUP.MNU menu entry from within WinBatch Studio. ; It directs the selected edit text via Clipboard and external tempfile to the WBT2HTML.WBT. ; After returning from WBT2HTML transformation it puts the html output data to Clipboard for following pasting elsewhere. ;------------------------------------------------------------------------------------------------------------------------------------------ -------- ; Call this cript from WSPOPUP.MNU, for example: ; ; WBT2HTML via ClipBoard ; call("W:\WINBATCH\Scripts\WBStudioToWBT2HTML.wbt","") ; ;------------------------------------------------------------------------------------------------------------------------------------------ -------- ; Detlev Dalitz.20011113.20020808 ;------------------------------------------------------------------------------------------------------------------------------------------ -------- InStudio = (RtStatus () == 10) If !InStudio Then Exit If InStudio If !wGetSelState () Then wSelectAll () wCopy () EndIf wClearSel () iBBSize = BinaryClipGet (0, 1) If !iBBSize Then Return ; nothing to do hBB = BinaryAlloc (iBBSize) num = BinaryClipGet (hBB, 1) Display (2, "WBT2HTML", "Selected Text copied to ClipBoard, %num% Byte to format ...") tempfile = FileCreateTemp ("TMP") tempfile = FileLocate (tempfile) wbtfile = StrCat (tempfile, ".wbt") htmfile = StrCat (tempfile, ".htm") FileRename (tempfile, wbtfile) num = BinaryWrite (hBB, wbtfile) BinaryFree (hBB) WILBatchfile = '"W:\WINBATCH\Scripts\WBT2HTML.WBT"' ; Change the path to your needs. RunWait (StrCat (DirHome (), "WinBatch.exe"), StrCat (WILBatchfile, " ", wbtfile, " ", htmfile)) If FileExist (htmfile) iBBSize = FileSize (htmfile) hBB = BinaryAlloc (iBBSize) num = BinaryRead (hBB, htmfile) num = BinaryClipPut (hBB, 1) num = BinaryClipGet (0, 1) BinaryFree (hBB) Display (2, "WBT2HTML", "HTML copied to ClipBoard, %num% Byte to paste ...") EndIf :CANCEL FileDelete (htmfile) FileDelete (wbtfile) Drop (hBB, iBBSize, htmfile, InStudio, num, tempfile, wbtfile, WILBatchfile) Exit ;==================================================================================================================================================== ;==================================================================================================================================================== ; ; WBT2HTML.WBT Version History ; ;==================================================================================================================================================== ; 2002:08:17 v1.23 ; - Changes in the 'TagQuote' procedure. ; Issue with more than one literal per line using different quotes should be resolved. ; - If the WIL.CLR file has been changed, then the reuse of a remaining old hash buffer file can cause an error. ; For example: Some new function name has been added to WIL.CLR file, but has not been stored in the hash buffer. ; This will cause a "color not found" error (iColor=0). ; In this case the script deletes the existing buffer file, and alarms the user to run the script again. ; Then a new hash buffer file will be created automatically. ; -------------------------------------------------------------------------------- ; 2002:08:16 v1.22 ; - Changes in the 'CollectColors' procedure. ; It occurs right after a new installation of WinBatch that the standard 'WIL Files' rgb color values ; are not yet defined in the Registry resp. WinBatch Studio does not know how to deal with it properly. ; Now I have hardcoded the default values for 'WIL Files' from WSINIT.DLL into the procedure as default values. ; Afterwards I try to replace them with the current users settings from Registry, if the values are readable. ; (Bug report by email from: Date: Fri, 16 Aug 2002 10:26:33 -0400, Don Tuttle <wdon@triad.rr.com>) ; -------------------------------------------------------------------------------- ; 2002:08:15 v1.21 ; - Mostly name changes for better datatype consistency and code readability (not finished yet). ; -------------------------------------------------------------------------------- ; 2002:08:11 v1.20 ; - Mostly name changes for better datatype consistency and code readability (not finished yet). ; - Added support for WebBatch *.web files in AskFileName dialog. ; (By email request from: Date: Sat, 10 Aug 2002 22:57:15 -0500, From: Bill Meek <winbatch@tfic.com>) ; -------------------------------------------------------------------------------- ; 2002:08:08 v1.19 ; There was an issue with embedded semicolon in quotes. ; I believed that those problems were gone since v1.17 ... fixed. ; -------------------------------------------------------------------------------- ; 2002:08:07 v1.18 ; Version v1.17 (and maybe some versions prior) did not run successful in animated mode. ; There was some code lost ... yes, I know ... never change a running system ... ; 'UseAnimation=@TRUE' should work again now (... did someone ever run it ?). ; ; I added a caller routine for use from within WinBatch Studio, to be called by menu item from WSPOPUP.MNU. ; This allows to copy and paste selected text easily from within Studio editor. ; ; Please read the added notes about the 'BoxText' statement, WSPOPUP.MNU, ; and 'WIL Extender Error: 12000: This command is not available as a WinBatch Studio menu command.' ; -------------------------------------------------------------------------------- ;====================================================================================================================================================