 links |
 rechts |
 zurück |
 vor |
 oben |
 unten |
DD-Software.WBT2HTML
Add this page to your favorites
Save this document
|
|
|
DD383400.HTM DD-Software.WBT2HTML Add this page to your favorites Save this document |
|
WinBatch code COLORIZED into HTML
WBT2HTML.WBT Version 2.03 2003:08:19 - Converts a WBT script to a HTML tagged script by colorizing keywords, comments, literals and other lexical text fragments. - Uses the same color setup as configured in WinBatch Studio Editor and in WIL.CLR color setup file. - Works as a file related, two pass, "text to token" - "token to mark up" converter. This utility needs the 'xCAM Array Extender' to run. Download xCAM Extender xcam34i.v34032.zip |
|
Version History
|
If you have questions about WinBatch, you are encouraged to use online WebBoard BBS at http://webboard.windowware.com |
;==========================================================================================================================================
; WBT2HTML v2.03 20030819 (c)20010729.Detlev Dalitz
;==========================================================================================================================================
:Main
;------------------------------------------------------------------------------------------------------------------------------------------
; On Error Goto Label :WBERRORHANDLER
IntControl(73,1,0,0,0)
sFolderStart = DirGet()
GoSub DefineUDF
GoSub SetMyInitsFirst
GoSub CheckWBVersion
GoSub CheckTempFolder
GoSub CheckIni
GoSub GetParams
If !iResult
GoSub AskParams
GoSub GetParams
EndIf
If UseVerbose
BoxOpen("","")
BoxTitle(sProgLogoLong)
Else
WinPlaceSet(@NORMAL,"","0 0 600 0")
WinActivate("")
EndIf
sFileInCrc = udfFileChecksum(sFileIn,2)
sFileInName = StrCat('"',ItemExtract(-1,ItemExtract(-1,sFileIn,":"),"\"),'"')
GoSub WriteLog
GoSub CreateTempFilenames
GoSub DefineTokRelatedThings
GoSub DefineMasks1
GoSub LoadCAMOpMod
GoSub EncodeSourceFile
GoSub UnDefineTokRelatedThings
GoSub EncodeNamedEntity
;camArrayToFile(aTagList,sFileCAMTagList) ; Debug.
GoSub CreateCAMColor
GoSub CreateListColorUsed
GoSub LoadCAMKeyword
GoSub DecodeTokenFile
If UseLineNumberLen Then GoSub AddLineNumber
GoSub CreateListColorUsed
GoSub DefineMasks2
GoSub CreateWriteTargetFile
GoSub WriteLog
If UseVerbose
sMsgText = StrCat(sFileOut,@LF,"Ready.")
BoxText(sMsgText)
EndIf
; Run standard browser application.
If UseRunOutput Then If FileSizeEx(sFileOut) Then Run(sFileOut,"")
:CANCEL
GoSub DeleteTempFilenames
If UseVerbose Then BoxShut()
DirChange(sFolderStart)
Exit
;==========================================================================================================================================
;==========================================================================================================================================
:SetMyInitsFirst
;------------------------------------------------------------------------------------------------------------------------------------------
; Current script version.
sProgProduct = "WBT2HTML"
sProgVersion = "2.03"
sProgVersionDate = "20030819"
; Needed WinBatch version.
sVersionDLLWB = "4.0gda"
sVersionDateWB = "WB 2003G 30 Jun 2003"
; Needed xCAM extender version.
sFileExtCAM = "xCAM34i.dll"
sVersionDLLExtCAM = "34023"
; Associated inifile.
sFileMyIni = StrCat(sProgProduct,".ini")
Return
;==========================================================================================================================================
;==========================================================================================================================================
:SetMyInits
;------------------------------------------------------------------------------------------------------------------------------------------
; Create section WBT2HTML
sProgCreationDate = "20010729"
sProgCompanyName = "Detlev Dalitz"
sProgCopyright = "(c){1} {2}"
sProgCopyright = StrReplace(sProgCopyright,"{1}",sProgCreationDate)
sProgCopyright = StrReplace(sProgCopyright,"{2}",sProgCompanyName)
IniWritePvt(sProgProduct,"InternalName" ,"wbt2html.wbt" ,sFileMyIni)
IniWritePvt(sProgProduct,"FileVersion" ,sProgVersion ,sFileMyIni)
IniWritePvt(sProgProduct,"FileVersionDate" ,sProgVersionDate ,sFileMyIni)
IniWritePvt(sProgProduct,"FileDescription" ,"WBT to coloured HTML Script Converter",sFileMyIni)
IniWritePvt(sProgProduct,"OriginalFilename","WBT2HTML.WBT" ,sFileMyIni)
IniWritePvt(sProgProduct,"ProductName" ,sProgProduct ,sFileMyIni)
IniWritePvt(sProgProduct,"ProductVersion" ,"2" ,sFileMyIni)
IniWritePvt(sProgProduct,"CompanyName" ,sProgCompanyName ,sFileMyIni)
IniWritePvt(sProgProduct,"LegalCopyright" ,sProgCopyright ,sFileMyIni)
IniWritePvt(sProgProduct,"CreationDate" ,sProgCreationDate ,sFileMyIni)
IniWritePvt(sProgProduct,"Comments" ,"emailto:dd@dalitz-im-netz.de" ,sFileMyIni)
IniWritePvt(sProgProduct,"YmdHms" ,TimeYmdHms() ,sFileMyIni)
;..........................................................................................................................................
; Create section User.
IniWritePvt("USER","UseAllowOverwrite" ,"0",sFileMyIni)
IniWritePvt("USER","UseAskFilename" ,"" ,sFileMyIni)
IniWritePvt("USER","UseCase" ,"4",sFileMyIni)
IniWritePvt("USER","UseImageBg" ,"" ,sFileMyIni)
IniWritePvt("USER","UseMakeHtmlTag" ,"0",sFileMyIni)
IniWritePvt("USER","UseNoIndentation" ,"0",sFileMyIni)
IniWritePvt("USER","UseRGB" ,"0",sFileMyIni)
IniWritePvt("USER","UseRunOutput" ,"1",sFileMyIni)
IniWritePvt("USER","UseTabReplaceSize" ,"3",sFileMyIni)
IniWritePvt("USER","UseVerbose" ,"1",sFileMyIni)
IniWritePvt("USER","UseWriteLogfile" ,"1",sFileMyIni)
IniWritePvt("USER","UseLineNumberLen" ,"0",sFileMyIni)
IniWritePvt("USER","UseLineNumberFiller"," ",sFileMyIni)
IniWritePvt("USER","UseLineNumberLink" ,"2",sFileMyIni)
IniWritePvt("USER",";UseAllowOverwrite..=","> Suppress dialog when overwriting existing target html file may occur.",sFileMyIni)
IniWritePvt("USER",";UseAskFilename.....=","> Local URL of recently used folder from AskFilename dialog.",sFileMyIni)
IniWritePvt("USER",";UseCase............=","> 4=Case as defined in WIL.CLR, 3=Uppercase, 2=Lowercase, 1=Leave as is.",sFileMyIni)
IniWritePvt("USER",";UseImageBg.........=","> Web related URL to the background image." ,sFileMyIni)
IniWritePvt("USER",";UseMakeHtmlTag.....=","> 0=PRE tag only, 1=PRE tag embedded in HTML tag.",sFileMyIni)
IniWritePvt("USER",";UseNoIndentation...=","> 0=Leave indentation as is, 1=Shift all lines to the left margin.",sFileMyIni)
IniWritePvt("USER",";UseRGB.............=","> Font mode: 0='#000000', 1='rgb(0,0,0)'",sFileMyIni)
IniWritePvt("USER",";UseRunOutput.......=","> Run standard browser application after converting.",sFileMyIni)
IniWritePvt("USER",";UseTabReplaceSize..=","> Replace each @TAB with n spaces.",sFileMyIni)
IniWritePvt("USER",";UseVerbose.........=","> Info: 0=none, 1=normal, 2=more, 3=more detailed.",sFileMyIni)
IniWritePvt("USER",";UseWriteLogfile....=","> 0=No logfile, 1=Inistyle logfile will be created in the tempfolder.",sFileMyIni)
IniWritePvt("USER",";UseLineNumberLen...=","> The width of the line number. 0=no number, -1=current max width, n=fix width of n chars.",sFileMyIni)
IniWritePvt("USER",";UseLineNumberFiller=","> The padchar of the line number.",sFileMyIni)
IniWritePvt("USER",";UseLineNumberLink..=","> 0=None, 1=A_NAME, 2=A_NAME and A_HREF.",sFileMyIni)
;..........................................................................................................................................
; Create section COLORS.
IniWritePvt("COLORS","CON" ,"128,000,128",sFileMyIni)
IniWritePvt("COLORS","EXT" ,"255,000,255",sFileMyIni)
IniWritePvt("COLORS","CONSTANT" ,"000,128,255",sFileMyIni)
IniWritePvt("COLORS","WED" ,"000,128,000",sFileMyIni)
IniWritePvt("COLORS","Operator" ,"032,032,032",sFileMyIni)
IniWritePvt("COLORS","Number" ,"096,000,000",sFileMyIni)
IniWritePvt("COLORS",";Bracket" ,"000,128,000",sFileMyIni)
IniWritePvt("COLORS",";Special" ,"000,032,128",sFileMyIni)
IniWritePvt("COLORS","LineNumber","160,160,160",sFileMyIni)
;..........................................................................................................................................
; Create section CAMColor.
IniWritePvt("CAMColor","URL" ,"",sFileMyIni)
IniWritePvt("CAMColor","YmdHms","",sFileMyIni)
IniWritePvt("CAMColor","MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section CAMOpMod.
IniWritePvt("CAMOpMod","URL" ,"",sFileMyIni)
IniWritePvt("CAMOpMod","YmdHms","",sFileMyIni)
IniWritePvt("CAMOpMod","MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section CAMKeyword.
IniWritePvt("CAMKeyword","URL" ,"",sFileMyIni)
IniWritePvt("CAMKeyword","YmdHms","",sFileMyIni)
IniWritePvt("CAMKeyword","MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section xCAM.
IniWritePvt("xCAM","URL" ,"",sFileMyIni)
IniWritePvt("xCAM","YmdHms","",sFileMyIni)
IniWritePvt("xCAM","MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section WIL.CLR.
sFileWilClr = "WIL.CLR"
IniWritePvt("WIL.CLR","URL" ,sFileWilClr,sFileMyIni)
IniWritePvt("WIL.CLR","YmdHms","",sFileMyIni)
IniWritePvt("WIL.CLR","MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section MyClr.
sFileMyClr = StrCat(sProgProduct,".clr")
sSection = StrUpper(sFileMyClr)
IniWritePvt(sSection,"URL" ,sFileMyClr,sFileMyIni)
IniWritePvt(sSection,"YmdHms","",sFileMyIni)
IniWritePvt(sSection,"MD5" ,"",sFileMyIni)
;..........................................................................................................................................
; Create section WBT.
sSection = "WBT"
IniWritePvt(sSection,"Quote" ,"."".'.`" ,sFileMyIni)
IniWritePvt(sSection,"Comment" ,".;." ,sFileMyIni)
IniWritePvt(sSection,"Operator" ,".==.<=.>=.<>.!=.<.>.**.*./.&&.||.<<.>>.&.|.^.~.!.+.-.=",sFileMyIni)
IniWritePvt(sSection,"Bracket" ,".(.).[.].{.}" ,sFileMyIni)
IniWritePvt(sSection,"Special" ,". .,.@.#.::.:",sFileMyIni)
;..........................................................................................................................................
IniWritePvt("","","",sFileMyIni)
;..........................................................................................................................................
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CheckWBVersion
;------------------------------------------------------------------------------------------------------------------------------------------
; Make sure to have a proper WinBatch version.
iTermBool = VersionDLL() < sVersionDLLWB
If iTermBool
sTermTitle = "Error"
sTermText = "This WinBatch script needs a WinBatch version of '{1} ({2})' or newer."
sTermText = StrReplace (sTermText,"{1}",sVersionDLLWB)
sTermText = StrReplace (sTermText,"{2}",sVersionDateWB)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CheckTempFolder
;------------------------------------------------------------------------------------------------------------------------------------------
sFolderTemp = udfGetTempPath ()
iTermBool = !DirMake(sFolderTemp)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access system temporary folder:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFolderTemp)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CheckIni
;------------------------------------------------------------------------------------------------------------------------------------------
; The inifile must reside in the same folder as the script.
sFolderProgHome = FilePath(IntControl(1004,0,0,0,0))
sFolderProgHome = udfGetLongPathNameA(sFolderProgHome)
If (sFolderProgHome>"") Then sFileMyIni = FileMapName(sFileMyIni,sFolderProgHome)
sIniYmdHms = IniReadPvt(sProgProduct,"YmdHms","",sFileMyIni)
If (sIniYmdHms=="")
GoSub SetMyInits
EndIf
GoSub ReadIni
Switch @TRUE
Case @TRUE
sSection = "WIL.CLR"
sURL = IniReadPvt(sSection,"URL","",sFileMyIni)
Switch @TRUE
Case (sURL=="")
GoSub ForceUpdate
Break
Case (!FileSizeEx(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"YmdHms","",sFileMyIni)!=FileYmdHms(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"MD5","",sFileMyIni)!=udfFileChecksum(sURL,0))
GoSub ForceUpdate
Break
EndSwitch
Continue
Case @TRUE
sSection = sProgProduct
Switch @TRUE
Case (IniReadPvt(sSection,"FileVersion","",sFileMyIni)!=sProgVersion)
GoSub SetMyInits
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"FileVersionDate","",sFileMyIni)!=sProgVersionDate)
GoSub SetMyInits
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"ProductName","",sFileMyIni)!=sProgProduct)
GoSub SetMyInits
GoSub ForceUpdate
Break
EndSwitch
Continue
Case @TRUE
sSection = "xCAM"
sURL = IniReadPvt(sSection,"URL","",sFileMyIni)
Switch @TRUE
Case (sURL=="")
GoSub ForceUpdate
Break
Case (!FileSizeEx(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"YmdHms","",sFileMyIni)!=FileYmdHms(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"MD5","",sFileMyIni)!=udfFileChecksum(sURL,0))
Case 0
GoSub ForceUpdate
Break
EndSwitch
Continue
Case @TRUE
sSection = "CAMKeyword"
sURL = IniReadPvt(sSection,"URL","",sFileMyIni)
Switch @TRUE
Case (sURL=="")
GoSub ForceUpdate
Break
Case (!FileSizeEx(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"YmdHms","",sFileMyIni)!=FileYmdHms(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"MD5","",sFileMyIni)!=udfFileChecksum(sURL,0))
GoSub ForceUpdate
Break
EndSwitch
Continue
Case @TRUE
sSection = "CAMOpMod"
sURL = IniReadPvt(sSection,"URL","",sFileMyIni)
Switch @TRUE
Case (sURL=="")
GoSub ForceUpdate
Break
Case (!FileSizeEx(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"YmdHms","",sFileMyIni)!=FileYmdHms(sURL))
GoSub ForceUpdate
Break
Case (IniReadPvt(sSection,"MD5","",sFileMyIni)!=udfFileChecksum(sURL,0))
GoSub ForceUpdate
Break
EndSwitch
Continue
; Following Case block is deactivated because we want to read the current colors on each run.
; Case @TRUE
; sSection = "CAMColor"
; sURL = IniReadPvt(sSection,"URL","",sFileMyIni)
; Switch @TRUE
; Case (!FileSizeEx(sURL))
; GoSub ForceUpdate
; Break
; Case (IniReadPvt(sSection,"YmdHms","",sFileMyIni)!=FileYmdHms(sURL))
; GoSub ForceUpdate
; Break
; Case (IniReadPvt(sSection,"MD5","",sFileMyIni)!=udfFileCheckSum(sURL,0))
; GoSub ForceUpdate
; Break
; EndSwitch
; Continue
EndSwitch
Return
;==========================================================================================================================================
;==========================================================================================================================================
:ForceUpdate
;------------------------------------------------------------------------------------------------------------------------------------------
sMsgText = "Installation is going to be refreshed now ..."
Pause(sProgLogoLong,sMsgText)
; Check WIL.CLR
GoSub FindFileMyClr
; Check Extender xCAM.
GoSub FindFileExtCAM
; Check Keyword CAM table.
GoSub CreateCAMKeyword
; Check OpMod CAM table.
GoSub CreateCAMOpMod
; Check Color CAM table.
GoSub CreateCAMColor
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:ReadIni
;------------------------------------------------------------------------------------------------------------------------------------------
UseWriteLogfile = IniReadPvt("User","UseWriteLogfile" ,1 ,sFileMyIni)
UseMakeHtmlTag = IniReadPvt("User","UseMakeHtmlTag" ,0 ,sFileMyIni)
UseNoIndentation = IniReadPvt("User","UseNoIndentation" ,0 ,sFileMyIni)
UseTabReplaceSize = IniReadPvt("User","UseTabReplaceSize" ,3 ,sFileMyIni)
UseVerbose = IniReadPvt("User","UseVerbose" ,0 ,sFileMyIni)
UseCase = IniReadPvt("User","UseCase" ,4 ,sFileMyIni)
UseRGB = IniReadPvt("User","UseRGB" ,0 ,sFileMyIni)
UseRunOutput = IniReadPvt("User","UseRunOutput" ,1 ,sFileMyIni)
UseImageBg = IniReadPvt("User","UseImageBg" ,"" ,sFileMyIni)
UseProgHome = IniReadPvt("User","UseProgHome" ,"" ,sFileMyIni)
UseAskFilename = IniReadPvt("User","UseAskFilename" ,"" ,sFileMyIni)
UseAllowOverwrite = IniReadPvt("USER","UseAllowOverwrite" ,0 ,sFileMyIni)
UseLineNumberLen = IniReadPvt("USER","UseLineNumberLen" ,0 ,sFileMyIni)
UseLineNumberFiller = IniReadPvt("USER","UseLineNumberFiller"," ",sFileMyIni)
UseLineNumberLink = IniReadPvt("USER","UseLineNumberLink" ,2 ,sFileMyIni)
sFileWilClr = IniReadPvt("WIL.CLR","URL","",sFileMyIni)
sFileMyClr = IniReadPvt(StrCat(sProgProduct,".CLR"),"URL","",sFileMyIni)
sProgCopyright = IniReadPvt(sProgProduct,"LegalCopyright" ,"",sFileMyIni)
sProgLogoLong = "{1} v{2} {3} {4}"
sProgLogoLong = StrReplace(sProgLogoLong,"{1}",sProgProduct)
sProgLogoLong = StrReplace(sProgLogoLong,"{2}",sProgVersion)
sProgLogoLong = StrReplace(sProgLogoLong,"{3}",sProgVersionDate)
sProgLogoLong = StrReplace(sProgLogoLong,"{4}",sProgCopyright)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:FindFileMyClr
;------------------------------------------------------------------------------------------------------------------------------------------
; Note: For compiled scripts: DirHome() returns the path to the compiled EXE file.
Switch RtStatus()
Case 0 ; "WinBatch Interpreted Script"
Case 10 ; "WinBatch Studio Debug"
sDirHome = udfGetLongPathNameA(DirHome())
Break
Case 1 ; "Compiled WinBatch EXE file"
Case 5 ; "Compiled WinBatch Service (EXS file)"
Case 14 ; "WebBatch"
Case 13 ; "PopMenu"
Case 12 ; "FileMenu"
; Find out if there exist a WinBatch interpreter environment with a WIL.CLR file.
sRegSubKey = "SOFTWARE\Wilson WindowWare\WinBatch\CurrentVersion"
If RegExistKey(@REGMACHINE,sRegSubKey)
hRegKey = RegOpenKey(@REGMACHINE,sRegSubKey)
sDirHome = RegQueryStr(hRegKey,"")
EndIf
sDirHome = udfGetLongPathNameA(sDirHome)
sDirHome = StrCat(sDirHome,"System\")
Break
EndSwitch
If (sDirHome>"")
sFileWilClr = ItemExtract(-1,ItemExtract(-1,sFileWilClr,":"),"\") ; FileRootExt.
sFileWilClr = StrCat(sDirHome,sFileWilClr)
EndIf
iTermBool = !FileSizeEx(sFileWilClr)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access file 'WIL.CLR':",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileWilClr)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
sFolderProgHome = udfGetLongPathNameA(sFolderProgHome)
sFileMyClr = ItemExtract(-1,ItemExtract(-1,sFileMyClr,":"),"\") ; FileRootExt.
sFileMyClr = StrCat(sFolderProgHome,sFileMyClr)
iTermBool = !FileCopy(sFileWilClr,sFileMyClr,@TRUE)
WinActivate("") ; Get back to the main window.
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot copy 'WIL.CLR' to 'WBT2HTML.CLR':",@LF,"{1}",@LF,"{2}")
sTermText = StrReplace (sTermText,"{1}",sFileWilClr)
sTermText = StrReplace (sTermText,"{2}",sFileMyClr)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
sSection = ItemExtract(-1,ItemExtract(-1,sFileWilClr,":"),"\") ; FileRootExt.
sSection = StrUpper(sSection)
IniWritePvt(sSection,"URL" ,sFileWilClr ,sFileMyIni)
IniWritePvt(sSection,"YmdHms",FileYmdHms(sFileWilClr) ,sFileMyIni)
IniWritePvt(sSection,"MD5" ,udfFileChecksum(sFileWilClr,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
sSection = ItemExtract(-1,ItemExtract(-1,sFileMyClr,":"),"\") ; FileRootExt.
sSection = StrUpper(sSection)
IniWritePvt(sSection,"URL" ,sFileMyClr ,sFileMyIni)
IniWritePvt(sSection,"YmdHms",FileYmdHms(sFileMyClr) ,sFileMyIni)
IniWritePvt(sSection,"MD5" ,udfFileChecksum(sFileMyClr,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
Drop(iTermBool,sTermText,sTermTitle)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:FindFileExtCAM
;------------------------------------------------------------------------------------------------------------------------------------------
; Note: For compiled scripts: DirHome() returns the path to the compiled EXE file.
sDirHome = udfGetLongPathNameA(DirHome())
sFileExtCAM = ItemExtract(-1,ItemExtract(-1,sFileExtCAM,":"),"\") ; FileRootExt.
sFileExtCAM = FileMapName(sFileExtCAM,sDirHome)
iTermBool = !FileSizeEx(sFileExtCAM)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access file 'xCAM34i.dll':",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileWilClr)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
iTermBool = !AddExtender(sFileExtCAM,sVersionDLLExtCAM)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot load extender file 'xCAM34i.dll':",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileExtCAM)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
IniWritePvt("xCAM","URL" ,sFileExtCAM ,sFileMyIni)
IniWritePvt("xCAM","YmdHms" ,FileYmdHms(sFileExtCAM) ,sFileMyIni)
IniWritePvt("xCAM","MD5" ,udfFileChecksum(sFileExtCAM,0),sFileMyIni)
IniWritePvt("xCAM","VersionDLL",camExtenderInfo(0) ,sFileMyIni)
IniWritePvt("","","",sFileMyIni)
Drop(iTermBool,sTermText,sTermTitle)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CollectColors
;------------------------------------------------------------------------------------------------------------------------------------------
; Collect names and rgb color values.
; We use the default rgb color values as defined in WSINIT.DLL
; and try to update them from the Current User Registry.
sListColorName = "Keyword|Quote|Comment|Default Text|Background"
sListColorValue = "0,0,255|255,0,0|0,128,0|0,0,0|255,255,255"
sListColorName = StrReplace(sListColorName,"|",@TAB)
sListColorValue = StrReplace(sListColorValue,"|",@TAB)
;--- Read colors for WIL files from WinBatch Studio Registry. -----------------------------------------------------------------------------
sRegKeySub = "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files"
If RegExistKey(@REGCURRENT,sRegKeySub)
hRegKey = RegOpenKeyEx(@REGCURRENT,sRegKeySub,1,"","")
; Mode=1=KEY_QUERY_VALUE=Permission to query subkey data ; We only need read access.
iCount = ItemCount(sListColorName,@TAB)
For i=1 To iCount
sItemColorName = ItemExtract(i,sListColorName,@TAB)
sRegKeySub = StrCat("[",sItemColorName,"]")
If RegExistValue(hRegKey,sRegKeySub)
sItemColorValue = RegQueryValue(hRegKey,sRegKeySub)
sListColorValue = ItemReplace(sItemColorValue,i,sListColorValue,@TAB)
EndIf
Next
Drop(i,iCount)
RegCloseKey(hRegKey)
Drop(hRegKey,sItemColorName,sItemColorValue)
EndIf
Drop(sRegKeySub)
;--- Additional colors from WIL.CLR -------------------------------------------------------------------------------------------------------
; Resp. from WBT2HTML.CLR (just a copy of WIL.CLR)
; 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
sColorList = IniItemizePvt ("COLORS",sFileMyClr)
iCount = ItemCount(sColorList,@TAB)
For i=1 To iCount
sItemColorName = ItemExtract(i,sColorList,@TAB)
sItemColorValue = IniReadPvt("COLORS",sItemColorName,"000,000,000",sFileMyClr)
sListColorValue = ItemInsert(sItemColorValue,-1,sListColorValue,@TAB)
sListColorName = ItemInsert(sItemColorName,-1,sListColorName,@TAB)
Next
Drop(i,iCount)
Drop(sItemColorName,sItemColorValue)
;--- Additional colors from my own inspiration. -------------------------------------------------------------------------------------------
; Note: The color settings in the WBT2HTML.ini file have at least
; the highest priority against all other previous color settings.
sIniSection = "COLORS"
sIniList = IniItemizePvt(sIniSection,sFileMyIni)
iCount = ItemCount(sIniList,@TAB)
For i=1 To iCount
sIniKey = ItemExtract(i,sIniList,@TAB)
sIniValue = IniReadPvt(sIniSection,sIniKey,"0,0,0",sFileMyIni)
sListColorName = ItemInsert(sIniKey ,-1,sListColorName ,@TAB)
sListColorValue = ItemInsert(sIniValue,-1,sListColorValue,@TAB)
Next
Drop(i,iCount,sIniKey,sIniList,sIniSection,sIniValue)
;------------------------------------------------------------------------------------------------------------------------------------------
; Set all color name items to lower case.
; Delete duplicates, last item in list will win.
; This is implicitely done by putting items into CAM array.
iCount = ItemCount(sListColorName,@TAB)
aCAMTemp = camInit(iCount)
For i=1 To iCount
If (camPut(aCAMTemp,ItemExtract(i,sListColorName,@TAB),ItemExtract(i,sListColorValue,@TAB))!=1)
sTermTitle = "Error"
sTermText = StrCat("CAMTemp",@LF,"This array access has an error.",@LF,"Execution halted.")
Terminate(@TRUE,sTermTitle,sTermText)
EndIf
Next
Drop(i,iCount)
aColorName = camArrayFromList(camKeyList(aCAMTemp,@TAB,0),@TAB,0)
aColorValue = camArrayFromList(camDataList(aCAMTemp,@TAB,0),@TAB,0)
; Delete all leading zeroes. Format as rgb.
; Convert rgb to hex. Format as hex.
; Convert string to number by WinBatch negative typing: "n=+s" is the same as "n=Int(s)".
iHigh = ArrInfo(aColorValue,1)-1
If UseRGB
For i=0 To iHigh
aRgb = camArrayFromList(aColorValue[i],",",0)
aColorValue[i] = StrCat(+aRgb[0],",",+aRgb[1],",",+aRgb[2])
Next
Else
For i=0 To iHigh
aRgb = camArrayFromList(aColorValue[i],",",0)
; If !aRgb[2] Then If !aRgb[1] Then If !aRgb[0] Then aColorValue[i] = "0"
; Else aColorValue[i] = StrCat(udfByteToHex(+aRgb[0]),udfByteToHex(+aRgb[1]),udfByteToHex(+aRgb[2]))
aColorValue[i] = "0"
If (aRgb[2]||aRgb[1]||aRgb[0]) Then aColorValue[i] = StrCat(udfByteToHex(+aRgb[0]),udfByteToHex(+aRgb[1]),udfByteToHex(+aRgb[2]))
aColorValue[i] = StrCat("#",aColorValue[i])
Next
EndIf
Drop(aRgb,i,High)
Drop(aCAMTemp)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CreateListColorUsed
;------------------------------------------------------------------------------------------------------------------------------------------
; First Call.
If !IsDefined(aCAMColorUsed)
aCAMColorUsed = camInit(ItemCount(camKeyList(aCAMColor,@TAB,0),@TAB))
Return
EndIf
;..........................................................................................................................................
;Second Call.
; Create a list of used colors to embed in htm output file, for information purpose only.
sListColorNameUsed = camKeyList(aCAMColorUsed,@TAB,0)
sListHtmColor = ""
iCount = ItemCount(sListColorNameUsed,@TAB)
For i=1 To iCount
sColorName = ItemExtract(i,sListColorNameUsed,@TAB)
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sListHtmColor = ItemInsert(StrCat('"',sColorName,'"="',sColorValue,'"'),-1,sListHtmColor,";")
Next
Drop(i,iCount)
Drop(sListUsedColorName,sColorName,sColorValue)
Drop(aCAMColorUsed)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:CreateCAMKeyword
;------------------------------------------------------------------------------------------------------------------------------------------
sMsgText = "Creating CAM Keyword ... be patient ..."
If (UseVerbose>=1)
BoxText(sMsgText)
EndIf
; Write CAM data to my inifile.
sFileCAMKeyword = StrCat(sFolderProgHome,sProgProduct,".cam.keyword.txt")
IniWritePvt("CAMKeyword","URL",sFileCAMKeyword,sFileMyIni)
If !IsDefined(aCAMKeyword)
AddExtender(sFileExtCAM)
; This implements a fast read routine for reading large section from an inifile.
; All lines of inifile must be terminated by @CRLF sequence.
; Read my .CLR file completely into a string.
; Insert one helper @LF at the beginning of the stream, and one helper @CR at end of stream.
sIni = StrCat(@LF,FileGet(sFileMyClr),@CR)
; Remove empty lines.
sSearch = StrCat(@LF,@CR)
sReplace = ""
While (StrIndex(sIni,sSearch,1,@FWDSCAN))
sIni = StrReplace(sIni,sSearch,sReplace)
EndWhile
; For sure, remove leading blanks.
sSearch = StrCat(@LF," ")
sReplace = @LF
While (StrIndex(sIni,sSearch,1,@FWDSCAN))
sIni = StrReplace(sIni,sSearch,sReplace)
EndWhile
; Find the proper section and skip over section header line.
iScan = StrIndexNC(sIni,"[keywords]",1,@FWDSCAN)
If !iScan
sTermTitle = "Error"
sTermText = StrCat("Inifile is corrupt:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileWilClr)
Terminate(1,sTermTitle,sTermText)
EndIf
iScan = StrIndex(sIni,@LF,iScan,@FWDSCAN)
If !iScan
sTermTitle = "Error"
sTermText = StrCat("Inifile is corrupt:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileWilClr)
Terminate(1,sTermTitle,sTermText)
EndIf
iSection = iScan
; Find end of section.
iScan = StrIndex(sIni,StrCat(@LF,"["),iScan,@FWDSCAN)
If iScan
sIni = StrSub(sIni,iSection,iScan-iSection+1)
Else
sIni = StrSub(sIni,iSection,-1)
EndIf
; Delete comment lines.
sSearch = StrCat(@LF,";")
sSearchWild = StrCat(@LF,";*",@CR)
iScan = 0
While @TRUE
iScan = StrIndex(sIni,sSearch,iScan,@FWDSCAN)
If !iScan Then Break
sWild = StrSubWild(sIni,sSearchWild,iScan)
sIni = StrReplace(sIni,sWild,"")
EndWhile
; Remove all @CR.
sIni = StrReplace(sIni,@CR,"")
; Remove leading blanks.
sSearch = "= "
sReplace = "="
While (StrIndex(sIni,sSearch,1,@FWDSCAN))
sIni = StrReplace(sIni,sSearch,sReplace)
EndWhile
; Change color=1 to color=Keyword, as defined in Registry..
sIni = StrReplace(sIni,"=1","=Keyword")
; Read into dim-2 array. Skip helper @LF.
aTemp = camArrayFromList(StrSub(sIni,2,-1),StrCat(@LF,"="),0)
iCount = ArrInfo(aTemp,1)
If UseVerbose Then sMaskMsgText = StrCat(sMsgText," # ",iCount,"/{1}")
;Create CAM array.
aCAMKeyword = camInit(iCount)
iHigh = iCount-1
For i=0 To iHigh
If UseVerbose
If (UseVerbose>2)
sMsgText = StrReplace(sMaskMsgText,"{1}",StrCat(i,@LF,aTemp[i,0],@LF,aTemp[i,1]))
BoxText(sMsgText)
EndIf
If (UseVerbose>1)
If !((100*i/iCount) mod 10)
sMsgText = StrReplace(sMaskMsgText,"{1}",i)
BoxText(sMsgText)
EndIf
EndIf
EndIf
If (camPut(aCAMKeyword,aTemp[i,0],StrCat(aTemp[i,1],@TAB,aTemp[i,0]))!=1)
sTermTitle = "Error"
sTermText = StrCat(sFileCAMKeyword,@LF,"This array access has an error.",@LF,"Execution halted.")
Terminate(@TRUE,sTermTitle,sTermText)
EndIf
Next
EndIf
If (UseVerbose>1)
sMsgText = "Saving CAM Keyword ..."
BoxText(sMsgText)
EndIf
iTermBool = !camArrayToFile(aCAMKeyword,sFileCAMKeyword)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot write CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMKeyword)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
; Write CAM data to my inifile.
IniWritePvt("CAMKeyword","YmdHms",FileYmdHms(sFileCAMKeyword),sFileMyIni)
IniWritePvt("CAMKeyword","MD5" ,udfFileChecksum(sFileCAMKeyword,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
; Write CLR data to my inifile.
sSection = ItemExtract(-1,ItemExtract(-1,sFileMyClr,":"),"\") ; FileRootExt.
sSection = StrUpper(sSection)
IniWritePvt(sSection,"URL" ,sFileMyClr,sFileMyIni)
IniWritePvt(sSection,"YmdHms",FileYmdHms(sFileMyClr),sFileMyIni)
IniWritePvt(sSection,"MD5" ,udfFileChecksum(sFileMyClr,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
If (UseVerbose>1)
If FileSizeEx(sFileCAMKeyword)
sMsgText = "Saving CAM Keyword ... OK"
BoxText(sMsgText)
EndIf
EndIf
Drop(aTemp,i,iCount,iHigh,iScan,iTermBool,sIni)
Drop(sMaskMsgText,sMsgText,sReplace,sSearch,sTerminateText,sTerminateTitle, sTermText,sTermTitle,sWild)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CreateCAMColor
;------------------------------------------------------------------------------------------------------------------------------------------
sMsgText = "Creating CAM Color ... be patient ..."
If (UseVerbose>=1)
BoxText(sMsgText)
EndIf
GoSub CollectColors
If !IsDefined(aCAMColor)
AddExtender(sFileExtCAM)
iCount = ArrInfo(aColorName,1)
aCAMColor = camInit(iCount)
If UseVerbose Then sMaskMsgText = StrCat(sMsgText," # ",iCount,"/{1}")
For i=1 To iCount
If (UseVerbose>1)
If !((100*i/iCount) mod 10)
sMsgText = StrReplace(sMaskMsgText,"{1}",i)
BoxText(sMsgText)
EndIf
EndIf
ii=i-1
If (camPut(aCAMColor,aColorName[ii],aColorValue[ii])!=1)
sTermTitle = "Error"
sTermText = StrCat(sFileCAMColor,@LF,"This array access has an error.",@LF,"Execution halted.")
Terminate(@TRUE,sTermTitle,sTermText)
EndIf
Next
Drop(ii,i,iCount)
EndIf
Drop(aColorName,aColorValue) ; We do not need the color lists any longer.
; May activate or deactivate following Goto to enable or disable creating disk file.
Goto skip
If (UseVerbose>1)
sMsgText = "Saving CAM Color ..."
BoxText(sMsgText)
EndIf
; Write filename of my keyword CAM table into my inifile.
sFileCAMColor = StrCat(sFolderProgHome,sProgProduct,".cam.color.txt" )
IniWritePvt("CAMColor","URL" ,sFileCAMColor,sFileMyIni)
iTermBool = !camArrayToFile(aCAMColor,sFileCAMColor)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot write CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMColor)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
IniWritePvt("CAMColor","YmdHms",FileYmdHms(sFileCAMColor),sFileMyIni)
IniWritePvt("CAMColor","MD5" ,udfFileChecksum(sFileCAMColor,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
If (UseVerbose>1)
If FileSizeEx(sFileCAMColor)
sMsgText = "Saving CAM Color ... OK"
BoxText(sMsgText)
EndIf
EndIf
:skip
Drop(i,iCount,iTermBool,sMaskMsgText,sMsgText,sTerminateText,sTerminateTitle,sTermText,sTermTitle)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:CreateCAMOpMod
;------------------------------------------------------------------------------------------------------------------------------------------
; Workaround for the Regular Expression '[ 0-9\)\.](mod)[ 0-9\(\+\-]'
; KEDIT: change r '[ 0-9\)\.](mod)[ 0-9\(\+\-]'<font color="#rrggbb">&1</font>' * *
sMsgText = "Creating CAM OpMod ... be patient ..."
If (UseVerbose>=1)
BoxText(sMsgText)
EndIf
If !IsDefined(aCAMOpMod)
AddExtender(sFileExtCAM)
; This implements a fast routine for creating a n*m search table.
; Build a list of all combinations "nmodm".
sListL = " 0123456789)."
sListR = " 0123456789(+-"
iCountL = StrLen(sListL)
iCountR = StrLen(sListR)
iCount = iCountL*iCountR
; Array tricks.
; 1. Create a dim-1 array and initialize it with the string "mod", giving one column "|mod|".
; 2. Merge the "|mod|" column on the fly with new column of the "m" factors list, giving two columns "|mod|m|".
; 3. Create a "n" factors list.
; 4. Merge the "|mod|m|" columns on the fly with new column of "n" factors list, giving three columns "|n|mod|m|".
; 5. Convert the three column array "|n|mod|m|" into one column array "|nmodm|".
; 1.
aTemp = ArrDimension(iCount)
ArrInitialize(aTemp,"mod")
; 2.
aTemp = camArrayMerge(camArrayFromList(StrFill(sListR,iCount),"",0),0,aTemp,0,1)
; 3.
sTempL = ""
For i=1 To iCountL
sTempL = StrCat(sTempL,StrFill(StrSub(sListL,i,1),iCountR))
Next
; 4.
aTemp = camArrayMerge(aTemp,0,camArrayFromList(sTempL,"",0),0,1)
; 5.
aTemp = camArrayFromList(camArrayToList(aTemp,@TAB,0),@TAB,0)
If UseVerbose Then sMaskMsgText = StrCat(sMsgText," # ",iCount,"/{1}")
aCAMOpMod = camInit(iCount)
iLow=0
iHigh=iCount-1
For i=iLow To iHigh
If (UseVerbose>1)
If !((100*i/iCount) mod 10)
sMsgText = StrReplace(sMaskMsgText,"{1}",i)
BoxText(sMsgText)
EndIf
EndIf
If (camPut(aCAMOpMod,aTemp[i],1)!=1)
sTermTitle = "Error"
sTermText = StrCat(sFileCAMOpMod,@LF,"This array access has an error.",@LF,"Execution halted.")
Terminate(@TRUE,sTermTitle,sTermText)
EndIf
Next
Drop(i,iCount,iHigh,iLow,sMsgText,sTermText,sTermTitle)
EndIf
If (UseVerbose>1)
sMsgText = "Saving CAM OpMod ..."
BoxText(sMsgText)
EndIf
; Write filename of my keyword CAM table into my inifile.
sFileCAMOpMod = StrCat(sFolderProgHome,sProgProduct,".cam.opmod.txt" )
IniWritePvt("CAMOpMod","URL",sFileCAMOpMod,sFileMyIni)
iTermBool = !camArrayToFile(aCAMOpMod,sFileCAMOpMod)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot write CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMOpMod)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
IniWritePvt("CAMOpMod","YmdHms",FileYmdHms(sFileCAMOpMod),sFileMyIni)
IniWritePvt("CAMOpMod","MD5" ,udfFileChecksum(sFileCAMOpMod,0),sFileMyIni)
IniWritePvt("","","",sFileMyIni)
If (UseVerbose>1)
If FileSizeEx(sFileCAMOpMod)
sMsgText = "Saving CAM OpMod ... OK"
BoxText(sMsgText)
EndIf
EndIf
Drop(aTemp,i,iCount,iCountL,iCountR,iHigh,iLow)
Drop(iTermBool,sListL,sListR,sMaskMsgText,sMsgText,sTempL,sTermText,sTermTitle)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:DefineUDF
;==========================================================================================================================================
#DefineFunction udfGetTempPath ()
sFileTemp = FileCreateTemp("")
FileDelete(sFileTemp)
sFolderTemp = FilePath(sFileTemp)
Terminate(!DirMake(sFolderTemp),"udfGetTempPath",StrCat("Cannot access temporary folder:",@LF,sFolderTemp))
Return (sFolderTemp)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGetLongPathNameA (sPath)
iMAX_PATH = 260
hBB = BinaryAlloc(iMAX_PATH)
BinaryEodSet(hBB,iMAX_PATH)
iLength = DllCall(StrCat(DirWindows(1),"kernel32.dll"),long:"GetLongPathNameA",lpstr:sPath,lpbinary:hBB,long:iMAX_PATH)
sLongPathName = BinaryPeekStr(hBB,0,iLength)
BinaryFree(hBB)
Return (sLongPathName)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#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
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfFileChecksum (sFilename, iRequest)
;If (VersionDLL()<"3.8hch") Then Return ("")
iBBSize = FileSizeEx(sFilename)
If !iBBSize Then Return ("")
hBB = BinaryAlloc(iBBSize)
BinaryRead(hBB,sFilename)
sChecksum = BinaryChecksum(hBB,Min(2,Max(0,iRequest)))
BinaryFree(hBB)
Return (sChecksum)
; Request Meaning Return String Format (x=hex character)
; 0 MD5 digest "xxxxxxxx-xxxxxxxx-xxxxxxxx-xxxxxxxx"
; 1 16-bit CRC "xxxx"
; 2 32-bit CRC "xxxxxxxx"
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrGetDelimiter (sString)
sTable = ""
For i=31 To 27 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
For i=25 To 14 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
For i=08 To 1 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
For i=255 To 130 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
For i=129 To 32 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
For i=13 To 9 By -1
sTable = StrCat(sTable,Num2Char(i))
Next
sTable = StrClean(sTable,sString,"",@TRUE,1)
If (StrLen(sTable)>1) Then Return (StrSub(sTable,1,2))
; No delimiters available.
Return ("")
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
Return ; from "GoSub DefineUDF"
;==========================================================================================================================================
;==========================================================================================================================================
:DefineTokRelatedThings
;==========================================================================================================================================
:DefineTok
;------------------------------------------------------------------------------------------------------------------------------------------
sTokOnOff = udfStrGetDelimiter(FileGet(sFileIn))
iTermBool = (sTokOnOff=="")
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("The current WinBatch script cannot be converted.",@LF,"Token delimiter chars are not available."
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
sTokOn = StrSub(sTokOnOff,1,1)
sTokOff = StrSub(sTokOnOff,2,1)
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineTagList
; Array of lists.
aTagList = ArrDimension(20)
ArrInitialize(aTagList,"")
iTagListLow = 0
iTagListHigh = ArrInfo(aTagList,1)-1
; To make life easier we initiate the lists with the start token, ...
For i=1 To 11
aTagList[i] = sTokOn
Next
; ... that simulates two imaginary items.
iTagLow = 2
For i=12 To 19
aTagList[i] = iTagLow
Next
aTagList[9] = StrCat(sTokOn,sTokOff) ; Store the token delimiters for later use, maybe, somewhere somehow in the galaxy ...
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineTokId
; --> ; 0 ------ ; <--- Storage for special TokId collection list.
; "q" ; iTokId=1 ; sIdQuotes
; "c" ; iTokId=2 ; sIdComment
; "m" ; iTokId=3 ; sIdMod
; "o" ; iTokId=4 ; sIdOperators
; "b" ; iTokId=5 ; sIdBrackets
; "s" ; iTokId=6 ; sIdSpecials
; "w" ; iTokId=7 ; sIdWords
; "n" ; iTokId=8 ; sIdNumbers
; --> ; 9 ------ ; <--- Storage for the current token delimiters.
; --> ; 10------ ; <--- Storage for List of Checksum(quote)
; --> ; 11------ ; <--- Storage for List of Checksum(comment)
; --> ; 12------ ; <--- Storage for ItemCount(quote)
; --> ; 13------ ; <--- Storage for ItemCount(comment)
; --> ; 14------ ; <--- Storage for ItemCount(mod)
; --> ; 15------ ; <--- Storage for ItemCount(operator)
; --> ; 16------ ; <--- Storage for ItemCount(bracket)
; --> ; 17------ ; <--- Storage for ItemCount(special)
; --> ; 18------ ; <--- Storage for ItemCount(word)
; --> ; 19------ ; <--- Storage for ItemCount(number)
;..........................................................................................................................................
sListTokIdSep = "."
sListTokId = ".q.c.m.o.b.s.w.n"
iCountTokId = ItemCount(sListTokId,".")
aTokId = Arrayize(sListTokId,sListTokIdSep)
iTokIdLow = 1
iTokIdHigh = iCountTokId-1
sTokId = StrReplace(sListTokId,sListTokIdSep,"")
aTokName = Arrayize(".quote.comment.operator mod.operator.bracket.special.word.number",".")
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineQuote
sListQuoteSep = "."
sListQuote = """.'.`"
iCountQuote = ItemCount(sListQuote,sListQuoteSep)
aQuote = Arrayize(sListQuote,sListQuoteSep)
iQuoteLow = 0
iQuoteHigh = iCountQuote-1
sQuote = StrReplace(sListQuote,sListQuoteSep,"")
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineComment
sListCommentSep = "."
sListComment = ";"
iCountComment = ItemCount(sListComment,sListCommentSep)
aComment = Arrayize(sListComment,sListCommentSep)
iCommentLow = 0
iCommentHigh = iCountComment-1
sComment = StrReplace(sListComment,sListCommentSep,"")
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineOperator
; binary(relational,arithmetic,logical),unary(integer logical,integer & float),assignment
sListOperatorSep = "."
sListOperator = "==.<=.>=.<>.!=.<.>.**.*./.+.-.&&.||.<<.>>.&.|.^.~.!.+.-.=" ; plus ".mod" ; Operators.
iCountOperator = ItemCount(sListOperator,sListOperatorSep)
aOperator = Arrayize(sListOperator,sListOperatorSep)
iOperatorLow = 0
iOperatorHigh = iCountOperator-1
sOperator = StrReplace(sListOperator,sListOperatorSep,"")
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineBracket
sListBracketSep = "."
sListBracket = "(.).[.].{.}"
iCountBracket = ItemCount(sListBracket,sListBracketSep)
aBracket = Arrayize(sListBracket,sListBracketSep)
iBracketLow = 0
iBracketHigh = iCountBracket-1
sBracket = StrReplace(sListBracket,sListBracketSep,"")
;------------------------------------------------------------------------------------------------------------------------------------------
:DefineSpecial
sListSpecialSep = "."
sListSpecial = " .,.@.#.::.:" ; Special chars: Blank,Comma,ASCII-64,ASCII-35,DoubleColon,Colon. (Percent sign too?) Blank is a must.
iCountSpecial = ItemCount(sListSpecial,sListSpecialSep)
aSpecial = Arrayize(sListSpecial,sListBracketSep)
iSpecialLow = 0
iSpecialHigh = iCountSpecial-1
sSpecial = StrReplace(sListSpecial,sListSpecialSep,"")
;------------------------------------------------------------------------------------------------------------------------------------------
sQuoteComment = StrCat(sQuote,sComment)
;------------------------------------------------------------------------------------------------------------------------------------------
Return
;==========================================================================================================================================
;==========================================================================================================================================
:UnDefineTokRelatedThings
;==========================================================================================================================================
Drop(aCAMOpMod)
Drop(aQuotePattern)
;..........................................................................................................................................
Drop(aQuote,iCountQuote,iQuoteHigh,iQuoteLow,sListQuote,sListQuoteSep,sQuote)
Drop(aComment,iCommentHigh,iCommentLow,iCountComment,sComment,sListComment,sListCommentSep)
Drop(aOperator,iCountOperator,iOperatorHigh,iOperatorLow,sListOperator,sListOperatorSep,sOperator)
Drop(aBracket,iBracketHigh,iBracketLow,iCountBracket,sBracket,sListBracket,sListBracketSep)
Drop(aSpecial,iCountSpecial,iSpecialHigh,iSpecialLow,sListSpecial,sListSpecialSep,sSpecial)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:DefineMasks1
;------------------------------------------------------------------------------------------------------------------------------------------
sMaskMsg1 = StrCat(sFileIn,@LF,"Tokenizing ... Line # {1}/{2}")
sMaskMsg2 = StrCat(sFileIn,@LF,"Colorizing ... Token # {1}/{2}")
sMaskMsg3 = StrCat(sFileIn,@LF,"Colorizing Word ({1}) ...",@LF,"{2}")
sMaskMsg6 = StrCat(sFileIn,@LF,"Colorizing ... Token # {1}/{2}",@LF,"{3}")
sMaskMsg7 = StrCat(sProgProduct," ",sFileInName," Tokenizing ... Line # {1}/{2}")
sMaskMsg8 = StrCat(sProgProduct," ",sFileInName," Colorizing ... Token # {1}/{2}")
;..........................................................................................................................................
sMaskTokOnOff = StrCat(sTokOn,"{1}",sTokOff)
sMaskTokOffOn = StrCat(sTokOff,"{1}",sTokOn)
sMaskTokOnOffId = StrCat(sTokOn,"{1}{2}",sTokOff)
;..........................................................................................................................................
sMaskMod = "?mod?"
sOpMod = "mod"
sTokMod = StrReplace(StrReplace(sMaskTokOnOffId,"{1}",aTokId[3]),"{2}",3)
; Note: The first real item in a TagList starts with position number "iTag=3". See "DefineTokRelatedThings".
;..........................................................................................................................................
sPattTokOffOn = StrCat(sTokOff,"*",sTokOn)
;..........................................................................................................................................
sTokSkip = StrCat(sTokOff,sTokOn)
;..........................................................................................................................................
If UseRGB
sMaskFont = '<font color="rgb({1})">{2}</font>'
Else
sMaskFont = '<font color="{1}">{2}</font>'
EndIf
;..........................................................................................................................................
; Note: QuotePattern array is shifted one element to the right, start indexing with 1 instead of 0.
aQuotePattern = ArrDimension(1+iCountQuote)
For i=1 To iCountQuote
aQuotePattern[i] = StrCat(aQuote[i-1],"*",aQuote[i-1])
Next
Drop(i,iCount)
;..........................................................................................................................................
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:DefineMasks2
;------------------------------------------------------------------------------------------------------------------------------------------
sMaskHtmPre = StrCat('<! [{1}] Colorized HTML by {2} v{3} {4} -->',@CRLF)
sMaskHtmPre = StrCat(sMaskHtmPre,'<! {5} -->',@CRLF)
sMaskHtmPre = StrCat(sMaskHtmPre,'<pre id="id.{16}" style="{6}{7}{8}{9}{10}{11}{12}{13}{14}{15}" title="Colorized by {2} v{3}">',@CRLF)
sMaskHtmPre = StrCat(sMaskHtmPre,'{17}')
sMaskHtmPre = StrCat(sMaskHtmPre,'</pre>',@CRLF)
If UseMakeHtmlTag Then sMaskHtmPre = StrCat('<html>',@CRLF,'<body>',@CRLF,sMaskHtmPre,'</body>',@CRLF,'</html>',@CRLF)
; {1} TimeYmdHms()
; {2} sProgProduct
; {3} sProgVersion
; {4} sProgCopyright
; {5} sListHtmColor
; {6} sStyleImageBg
; {7} sStyleColorBg
; {8} sStyleBorder
; {9} sStylePadding
; {10} sStyleWidth
; {11} sStyleFontFamily
; {12} sStyleFontSize
; {13} sStyleFontWeight
; {14} sStyleFontStyle
; {15} sStyleColorFg
; {16} CRC32 number of the sFileIn, used as id number.
; {17} Content of sFileOut2
;..........................................................................................................................................
sStyleBorder = 'border:1pt solid #dddddd; '
sStylePadding = 'padding:3pt; '
sStyleWidth = 'width:100%%; '
;..........................................................................................................................................
sMaskStyleFontFamily = "font-family:'{1}'; "
sMaskStyleFontSize = "font-size:{1}pt; "
sMaskStyleFontWeight = "font-weight:{1}; "
sMaskStyleFontStyle = "font-style:{1}; "
sMaskStyleColorBg = "background-color:{1}; "
sMaskStyleColorFg = "color:{1}; "
sMaskStyleImageBg = "background-image:url({1}); "
;..........................................................................................................................................
; Set background image from inifile entry, eg. "UseImageBg=../images/gif/grid.gif".
sStyleImageBg = ""
sImageBg = IniReadPvt("User","UseImageBg","",sFileMyIni)
If (sImageBg>"") Then sStyleImageBg = StrReplace(sMaskStyleImageBg,"{1}",sImageBg)
Drop(sImageBg)
;..........................................................................................................................................
; Get font attributes for WIL files.
; Set default font style attributes.
sFontFamily = "Courier New"
sFontSize = "9"
sFontWeight = "400"
sFontStyle = "0"
; Read font attributes for WIL files from WinBatch Studio Registry.
sRegKeySub = "Software\Wilson WindowWare\WinBatch Studio\Settings\File types\WIL Files"
If RegExistKey(@REGCURRENT,sRegKeySub)
hRegKey = RegOpenKeyEx(@REGCURRENT,sRegKeySub,1,"","")
; Mode=1=KEY_QUERY_VALUE=Permission to query subkey data ; We only need read access.
sRegKeySub = "[Font name]"
If RegExistValue(hRegKey,sRegKeySub) Then sFontFamily = RegQueryValue(hRegKey,sRegKeySub)
sRegKeySub = "[Font size]"
If RegExistValue(hRegKey,sRegKeySub) Then sFontSize = RegQueryValue(hRegKey,sRegKeySub)
sRegKeySub = "[Font weight]"
If RegExistValue(hRegKey,sRegKeySub) Then sFontWeight = RegQueryValue(hRegKey,sRegKeySub)
sRegKeySub = "[Font Italic]"
If RegExistValue(hRegKey,sRegKeySub) Then sFontStyle = RegQueryValue(hRegKey,sRegKeySub)
RegCloseKey(hRegKey)
Drop(hRegKey,sRegKeySub)
EndIf
sFontStyle = ItemExtract(1+sFontStyle,"normal,italic",",") ; Translate number to string.
;..........................................................................................................................................
sStyleFontStyle = StrReplace(sMaskStyleFontStyle ,"{1}",sFontStyle)
sStyleFontFamily = StrReplace(sMaskStyleFontFamily,"{1}",sFontFamily)
sStyleFontSize = StrReplace(sMaskStyleFontSize ,"{1}",sFontSize)
sStyleFontWeight = StrReplace(sMaskStyleFontWeight,"{1}",sFontWeight)
;..........................................................................................................................................
sColorValueBg = camGet(aCAMColor,"Background")
sColorValueFg = camGet(aCAMColor,"Default Text")
If UseRGB
sColorValueBg = StrReplace("rgb({1})","{1}",sColorValueBg)
sColorValueFg = StrReplace("rgb({1})","{1}",sColorValueFg)
EndIf
sStyleColorBg = StrReplace(sMaskStyleColorBg,"{1}",sColorValueBg)
sStyleColorFg = StrReplace(sMaskStyleColorFg,"{1}",sColorValueFg)
;..........................................................................................................................................
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:LoadCAMKeyword
;------------------------------------------------------------------------------------------------------------------------------------------
If (UseVerbose>1)
sMsgText = StrCat("Loading CAM Keyword ...")
BoxText(sMsgText)
EndIf
sFileCAMKeyword = IniReadPvt("CAMKeyword","URL","",sFileMyIni)
iTermBool = !FileSizeEx(sFileCAMKeyword)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMkeyword)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
If !IsDefined(aCAMKeyword)
AddExtender(sFileExtCAM)
aCAMKeyword = camArrayFromFile(sFileCAMKeyword)
iTermBool = !camCheck(aCAMKeyword)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Execution halted.",@LF,"This array dumpfile seems not to be a valid CAM array:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMKeyword)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
EndIf
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:LoadCAMColor
;------------------------------------------------------------------------------------------------------------------------------------------
If (UseVerbose>1)
sMsgText = "Loading CAM Color ..."
BoxText(sMsgText)
EndIf
sFileCAMColor = IniReadPvt("CAMColor","URL","",sFileMyIni)
iTermBool = !FileSizeEx(sFileCAMOpMod)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMColor)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
If !IsDefined(aCAMColor)
AddExtender(sFileExtCAM)
aCAMColor = camArrayFromFile(sFileCAMColor)
iTermBool = !camCheck(aCAMColor)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Execution halted.",@LF,"This array dumpfile seems not to be a valid CAM array:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMColor)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
EndIf
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:LoadCAMOpMod
;------------------------------------------------------------------------------------------------------------------------------------------
If (UseVerbose>1)
sMsgText = "Loading CAM OpMod ..."
BoxText(sMsgText)
EndIf
sFileCAMOpMod = IniReadPvt("CAMOpMod","URL","",sFileMyIni)
iTermBool = !FileSizeEx(sFileCAMOpMod)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Cannot access CAM file:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMOpMod)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
If !IsDefined(aCAMOpMod)
AddExtender(sFileExtCAM)
aCAMOpMod = camArrayFromFile(sFileCAMOpMod)
iTermBool = !camCheck(aCAMOpMod)
If iTermBool
sTermTitle = "Error"
sTermText = StrCat("Execution halted.",@LF,"This array dumpfile seems not to be a valid CAM array:",@LF,"{1}")
sTermText = StrReplace (sTermText,"{1}",sFileCAMOpMod)
Terminate(iTermBool,sTermTitle,sTermText)
EndIf
EndIf
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokQuote
;------------------------------------------------------------------------------------------------------------------------------------------
iTokId = 1
sScanLine = StrClean(sCurrentLine,sQuoteComment,"",@TRUE,2)
If (StrLen(StrReplace(sScanLine,sComment,""))<2) Then Return ; Skip line, no complete quoted literal to replace.
If (StrSub(sScanLine,1,1)==sComment) Then Return ; Skip line, contains comment only.
sScanLine = sCurrentLine
sCommentLine = ""
; Get current QuoteChars.
sScanChars = StrClean(sQuoteComment,sScanLine,"",@TRUE,2)
; Search the line and truncate if inline comment exists.
; This prevents quoted literals in inline comments to be tokenized.
If StrIndex(sScanChars,sComment,1,@FWDSCAN)
iScan=0
While @TRUE
iScan = StrScan(sScanLine,sScanChars,iScan,@FWDSCAN)
If !iScan Then Break
sChar = StrSub(sScanLine,iScan,1)
If (sChar==sComment)
; Sorry, Cannot handle inline comment in this procedure.
sCommentLine = StrSub(sScanLine,iScan,-1)
sScanLine = StrSub(sScanLine,1,iScan-1)
Break
EndIf
iPos = StrIndex(sQuote,sChar,1,@FWDSCAN)
If iPos Then iScan = iScan + StrLenWild(sScanLine,aQuotePattern[iPos],iScan)
EndWhile
EndIf
; Find literals.
iScan = 0
While @TRUE
iScan = StrScan(sScanLine,sScanChars,iScan,@FWDSCAN)
If !iScan Then Break
sChar = StrSub(sScanLine,iScan,1)
sWild = StrSubWild(sScanLine,aQuotePattern[StrIndex(sQuote,sChar,1,@FWDSCAN)],iScan)
; Exclude current Quote Char from colorizing.
sLiteral = StrSub(sWild,2,StrLen(sWild)-2)
; Do not include quote chars for later colorizing !
If (StrSub(sLiteral,1,1)==sTokOn)
iScan = iScan + StrLen(sWild)
Continue
EndIf
BinaryEodSet(hBBSum,0)
BinaryPokeStr(hBBSum,0,sScanLine)
sSum = BinaryChecksum(hBBSum,2)
iItemLocate = ItemLocate(sSum,aTagList[10],sTokOn)
If !iItemLocate
aTagList[10] = ItemInsert(sSum,-1,aTagList[10],sTokOn)
aTagList[iTokId] = ItemInsert(sLiteral,-1,aTagList[iTokId],sTokOn)
aTagList[12] = aTagList[12] + 1
iItemLocate = aTagList[12]
EndIf
sTok = StrCat(sTokOn,aTokId[iTokId],iItemLocate,sTokOff)
; Exclude current Quote Char from colorizing.
sTok = StrCat(sChar,sTok,sChar)
sScanLine = StrCat(StrSub(sScanLine,1,iScan-1),StrReplace(StrSub(sScanLine,iScan,-1),sWild,sTok))
iScan = iScan + StrLen(sTok)
EndWhile
sCurrentLine = StrCat(sScanLine,sCommentLine)
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokComment
;------------------------------------------------------------------------------------------------------------------------------------------
iTokId = 2
sScanLine = StrTrim(sCurrentLine)
iScan = StrIndex(sScanLine,sComment,1,@FWDSCAN)
If !iScan Then Return ; Nothing to do.
sScanLine = StrSub(sScanLine,iScan,-1)
BinaryEodSet(hBBSum,0)
BinaryPokeStr(hBBSum,0,sScanLine)
sSum = BinaryChecksum(hBBSum,2)
iItemLocate = ItemLocate(sSum,aTagList[11],sTokOn)
If !iItemLocate
aTagList[11] = ItemInsert(sSum,-1,aTagList[11],sTokOn)
aTagList[iTokId] = ItemInsert(sScanLine,-1,aTagList[iTokId],sTokOn)
aTagList[13] = aTagList[13] + 1
iItemLocate = aTagList[13]
EndIf
sTok = StrCat(sTokOn,aTokId[iTokId],iItemLocate,sTokOff)
sCurrentLine = StrReplace(sCurrentLine,sScanLine,sTok)
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
iResult = 1+(iScan==1)
Return
;..........................................................................................................................................
; This Function returns
; iResult=
; 0 ... Line has no comment.
; 1 ... Line has appended comment.
; 2 ... Line has comment only.
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokOpMod
;------------------------------------------------------------------------------------------------------------------------------------------
iTokId = 3
iModReplaced = 0
iScan = 0
While @TRUE
iScan = StrIndexWild(sCurrentLine,sMaskMod,iScan+1)
If !iScan Then Break
sWild = StrSubWild(sCurrentLine,sMaskMod,iScan)
sWildLower = StrLower(sWild)
If (camGet(aCAMOpMod,sWildLower)==1)
sTok = StrReplace(sWildLower,sOpMod,sTokMod)
sCurrentLine = StrReplace(sCurrentLine,sWild,sTok)
iModReplaced = 1
EndIf
EndWhile
If iModReplaced
iItemLocate = ItemLocate(sOpmod,aTagList[iTokId],sTokOn)
If !iItemLocate
aTagList[iTokId] = ItemInsert(sOpMod,-1,aTagList[iTokId],sTokOn)
aTagList[14] = aTagList[14] + 1
EndIf
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
EndIf
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokOperator
;------------------------------------------------------------------------------------------------------------------------------------------
If !StrScan(sCurrentLine,sOperator,1,@FWDSCAN) Then Return ; Nothing to do.
iTokId = 4
sScanLine = sCurrentLine
sScanLine = StrClean(StrClean(sScanLine,sBracket," ",@TRUE,1),sOperator," ",@TRUE,2)
sScanLine = StrTrim(sScanLine)
If (StrLen(sScanLine)>1)
sScanLine = StrReplace(sScanLine,"+"," +")
sScanLine = StrReplace(sScanLine,"-"," -")
sScanLine = StrReplace(sScanLine,"!"," !")
sScanLine = StrReplace(sScanLine,"~"," ~")
sScanLine = StrTrim(sScanLine)
While StrIndex(sScanLine," ",1,@FWDSCAN)
sScanLine = StrReplace(sScanLine," "," ")
EndWhile
EndIf
; We use a CAM array to remove duplicates.
; We sort the operator items descending, depending on their length (two char items before one char items).
iCount = ItemCount(sScanLine," ")
If (StrLen(sScanLine)>=(2*iCount))
aTemp = camInit(iCount)
For i=1 To iCount
camPut(aTemp,StrFixLeft(ItemExtract(i,sScanLine," ")," ",2),1)
Next
aTemp = camArrayFromList(camKeyList(aTemp,@TAB,0),@TAB,0)
iResult = camArraySort(aTemp,@INSERTSORT,@DESCENDING,@TRUE)
iTempHigh = ArrInfo(aTemp,1)-1
For i=0 To iTempHigh
aTemp[i] = StrTrim(aTemp[i])
Next
Else
aTemp = camArrayFromList(sScanLine," ",0)
iTempHigh = ArrInfo(aTemp,1)-1
EndIf
For i=0 To iTempHigh
iItemLocate = ItemLocate(aTemp[i],aTagList[iTokId],sTokOn)
If !iItemLocate
aTagList[iTokId] = ItemInsert(aTemp[i],-1,aTagList[iTokId],sTokOn)
aTagList[15] = aTagList[15] + 1
iItemLocate = aTagList[15]
EndIf
sTok = StrCat(sTokOn,aTokId[iTokId],iItemLocate,sTokOff)
sCurrentLine = StrReplace(sCurrentLine,aTemp[i],sTok)
Next
Drop(i)
Drop(aTemp)
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokBracket
;------------------------------------------------------------------------------------------------------------------------------------------
If !StrScan(sCurrentLine,sBracket,1,@FWDSCAN) Then Return ; Nothing to do.
iTokId = 5
For i=iBracketLow To iBracketHigh
If StrIndex(sCurrentLine,aBracket[i],1,@FWDSCAN)
iItemLocate = ItemLocate(aBracket[i],aTagList[iTokId],sTokOn)
If !iItemLocate
aTagList[iTokId] = ItemInsert(aBracket[i],-1,aTagList[iTokId],sTokOn)
aTagList[16] = aTagList[16] + 1
iItemLocate = aTagList[16]
EndIf
sTok = StrCat(sTokOn,aTokId[iTokId],iItemLocate,sTokOff)
sCurrentLine = StrReplace(sCurrentLine,aBracket[i],sTok)
EndIf
Next
Drop(i)
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokSpecial
;------------------------------------------------------------------------------------------------------------------------------------------
If !StrScan(sCurrentLine,sSpecial,1,@FWDSCAN) Then Return ; Nothing to do.
iTokId = 6
For i=iSpecialLow To iSpecialHigh
If StrIndex(sCurrentLine,aSpecial[i],1,@FWDSCAN)
iItemLocate = ItemLocate(aSpecial[i],aTagList[iTokId],sTokOn)
If !iItemLocate
aTagList[iTokId] = ItemInsert(aSpecial[i],-1,aTagList[iTokId],sTokOn)
aTagList[17] = aTagList[17] + 1
iItemLocate = aTagList[17]
EndIf
sTok = StrCat(sTokOn,aTokId[iTokId],iItemLocate,sTokOff)
sCurrentLine = StrReplace(sCurrentLine,aSpecial[i],sTok)
EndIf
Next
Drop(i)
aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokId],""),aTokId[iTokId])
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:TokWordNumber
;------------------------------------------------------------------------------------------------------------------------------------------
iTokIdW = 7
iTokIdN = 8
sScanLine = StrReplace(sMaskTokOffOn,"{1}",sCurrentLine) ; Tokenize the line with reverse token.
iScan = 0
While @TRUE
iScan = StrIndex(sScanLine,sTokOff,iScan+1,@FWDSCAN)
If !iScan Then Break
sWild = StrSubWild(sScanLine,sPattTokOffOn,iScan)
If (sWild==sTokSkip) Then Continue
sNumWord = StrSub(sWild,2,StrLen(sWild)-2)
If IsNumber(sNumWord)
iItemLocate = ItemLocate(sNumWord,aTagList[iTokIdN],sTokOn)
If !iItemLocate
aTagList[iTokIdN] = ItemInsert(sNumWord,-1,aTagList[iTokIdN],sTokOn)
aTagList[19] = aTagList[19] + 1
iItemLocate = aTagList[19]
EndIf
sTok = StrReplace(sMaskTokOffOn,"{1}",StrReplace(sMaskTokOnOff,"{1}",StrCat(aTokId[iTokIdN],iItemLocate)))
Else
iItemLocate = ItemLocate(sNumWord,aTagList[iTokIdW],sTokOn)
If !iItemLocate
aTagList[iTokIdW] = ItemInsert(sNumWord,-1,aTagList[iTokIdW],sTokOn)
aTagList[18] = aTagList[18] + 1
iItemLocate = aTagList[18]
EndIf
sTok = StrReplace(sMaskTokOffOn,"{1}",StrReplace(sMaskTokOnOff,"{1}",StrCat(aTokId[iTokIdW],iItemLocate)))
EndIf
sScanLine = StrReplace(sScanLine,sWild,sTok)
iScan = iScan + StrLen(sTok)
EndWhile
iW = (aTagList[iTokIdW]>"")
iN = (aTagList[iTokIdN]>"")
If iW Then aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokIdW],""),aTokId[iTokIdW])
If iN Then aTagList[0] = StrCat(StrReplace(aTagList[0],aTokId[iTokIdN],""),aTokId[iTokIdN])
If (iW||iN) Then sCurrentLine = StrSub(sScanLine,2,StrLen(sScanLine)-2) ; Remove reverse token.
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:EncodeNamedEntity
;------------------------------------------------------------------------------------------------------------------------------------------
sMsgText = "Encoding named entities ..."
If UseVerbose
BoxText(sMsgText)
Else
WinTitle("",StrCat(sProgProduct," ",sFileInName," ",sMsgText))
EndIf
sSafeChars = "0123456789@$_/\!?,.;:=-+*'()[]# abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ&" ; included ampersand.
sEncChars = ""
For i=1 To 255
sEncChars = StrCat(sEncChars,Num2Char(i))
Next
sEncChars = StrClean(sEncChars,sSafeChars,"",@TRUE,1)
sEncChars = StrClean(sEncChars,sTokOnOff,"",@TRUE,1)
iTokId = 1 ; Quote.
sClean = StrClean(sEncChars,aTagList[iTokId],"",@TRUE,2)
iCount = StrLen(sClean)
For i=1 To iCount
sChar = StrSub(sClean,i,1)
aTagList[iTokId] = StrReplace(aTagList[iTokId],sChar,StrReplace("&#n;","n",Char2Num(sChar)))
Next
iTokId = 2 ; Comment.
sClean = StrClean(sEncChars,aTagList[iTokId],"",@TRUE,2)
iCount = StrLen(sClean)
For i=1 To iCount
sChar = StrSub(sClean,i,1)
aTagList[iTokId] = StrReplace(aTagList[iTokId],sChar,StrReplace("&#n;","n",Char2Num(sChar)))
Next
iTokId = 4 ; Operator.
sClean = StrClean('&<>',aTagList[iTokId],"",@TRUE,2)
iCount = StrLen(sClean)
For i=1 To iCount
sChar = StrSub(sClean,i,1)
aTagList[iTokId] = StrReplace(aTagList[iTokId],sChar,StrReplace("&#n;","n",Char2Num(sChar)))
Next
Drop(i,iCount,iTokId,sChar,sClean,sMsgText,sSafeChars,sEncChars)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:EncodeSourceFile
;------------------------------------------------------------------------------------------------------------------------------------------
iInputLines = ItemCount(FileGet(sFileIn),@LF)-(StrSub(FileGet(sFileIn),FileSize(sFileIn),1)==@LF)
;.......................................................................................................................................
If (UseVerbose>1)
sMsgText = StrCat(sFileIn,@LF,"Reading ...")
BoxText(sMsgText)
EndIf
iLastIC65 = IntControl(65,4096*Min(64,1+(FileSize(sFileIn)/4096)),0,0,0) ; Set size of internal FileRead buffer.
hFR = FileOpen(sFileIn,"READ")
;..........................................................................................................................................
If (UseVerbose>1)
sMsgText = StrCat(sFileOut1,@LF,"Writing ...")
BoxText(sMsgText)
EndIf
IntControl(53,1,0,0,0) ; Set line terminator for FileWrite. p1: 0=None, 1=@CRLF, 2=@LF, 3=@CR, 4=@TAB.
hFW = FileOpen(sFileOut1,"WRITE")
;..........................................................................................................................................
; Allocate a buffer for checksumming. 2048 byte is more than enough for a wbt script line.
hBBSum = BinaryAlloc(2048)
iLastExclusive = Exclusive(@ON)
sCurrentLine = "" ; Current line to scan.
iCountLine = 0 ; Linecounter.
While @TRUE
sCurrentLine = FileRead(hFR)
If (sCurrentLine=="*EOF*") Then Break
; Note: If a line in the input file begins with the text "*EOF*",
; then the loop ends at this text line.
; That can cause the input file not read entirely up to the eof file marker.
iCountLine = iCountLine + 1
If (sCurrentLine=="")
FileWrite(hFW,"")
Continue
EndIf
; Replace tabs with white space.
sCurrentLine = StrReplace(sCurrentLine,@TAB,StrFill(" ",UseTabReplaceSize))
; Always trim right and optional trim left.
sCurrentLine = ItemExtract(2,StrTrim(StrCat(@LF,sCurrentLine)),@LF)
If UseNoIndentation Then sCurrentLine = StrTrim(sCurrentLine)
If (sCurrentLine=="")
FileWrite(hFW,"")
Continue
EndIf
Switch UseVerbose
Case 0
sMsgText = StrReplace(StrReplace(sMaskMsg7,"{1}",iInputLines),"{2}",iCountLine)
WinTitle("",sMsgText)
Break
Case UseVerbose
sMsgText = StrReplace(StrReplace(sMaskMsg1,"{1}",iInputLines),"{2}",iCountLine)
BoxText(sMsgText)
Break
EndSwitch
GoSub TokQuote
iResult=0
GoSub TokComment
GoSub TokSpecial
If (iResult<2)
GoSub TokOpMod
GoSub TokOperator
GoSub TokBracket
GoSub TokWordNumber
EndIf
FileWrite(hFW,sCurrentLine)
EndWhile
Exclusive(iLastExclusive)
BinaryFree(hBBSum)
Drop(hBBSum)
;..........................................................................................................................................
If (UseVerbose>1)
sMsgText = StrCat(sFileOut1,@LF,"Closing ...")
BoxText(sMsgText)
EndIf
FileClose(hFW)
;..........................................................................................................................................
If (UseVerbose>1)
sMsgText = StrCat(sFileIn,@LF,"Closing ...")
BoxText(sMsgText)
EndIf
FileClose(hFR)
;..........................................................................................................................................
Drop(iLastExclusive,iResult,sCurrentLine,sMsgText)
Drop(hFR,hFW,iLastIC65)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:DecodeTokenFile
;------------------------------------------------------------------------------------------------------------------------------------------
; We do not need the checksum lists any longer.
aTagList[10] = ""
aTagList[11] = ""
If UseVerbose
sMsgText = StrCat(sFileOut2,@LF,"Reading ...")
BoxText(sMsgText)
EndIf
sCurrentLine = FileGet(sFileOut1) ; Read complete text file into one string.
If (sCurrentLine=="") Then Return ; Nothing to do.
; Define Masks.
sColorName = "Operator"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontOperator = StrCat('<font color="',sColorValue,'">{1}</font>')
sColorName = "Comment"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontComment = StrCat('<font color="',sColorValue,'">{1}</font>')
sColorName = "Special"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontSpecial = StrCat('<font color="',sColorValue,'">{1}</font>')
sColorName = "Bracket"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontBracket = StrCat('<font color="',sColorValue,'">{1}</font>')
sColorName = "Number"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontNumber = StrCat('<font color="',sColorValue,'">{1}</font>')
sColorName = "Quote"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sMaskFontQuote = StrCat('<font color="',sColorValue,'">{1}</font>')
; Serialize Tokenlist.
sCurrentLine = StrReplace(sCurrentLine,sTokOn,"")
sCurrentLine = StrReplace(sCurrentLine,@CRLF,sTokOff)
aCurrentLine = camArrayFromList(sCurrentLine,sTokOff,0)
aTagList[0] = StrClean(sTokId,aTagList[0],"",@TRUE,2) ; Make aTagList[0] ordered by sTokID chars.
iCount = StrLen(aTagList[0])
For i=1 To iCount
iTokId = StrIndex(sTokId,StrSub(aTagList[0],i,1),1,@FWDSCAN)
If (aTagList[iTokId]=="") Then Continue
aTemp%iTokId% = camArrayFromList(StrCat(sTokOn,aTagList[iTokId]),sTokOn,1)
aTagList[iTokId] = "" ; We do not need the list any longer.
Next
IntControl(53,0,0,0,0) ; Set line terminator for FileWrite. p1: 0=None, 1=@CRLF, 2=@LF, 3=@CR, 4=@TAB.
hFW = FileOpen(sFileOut2,"WRITE")
iLastExclusive = Exclusive(@ON)
iTokCount = ArrInfo(aCurrentLine,1)
iPctDisplay = 1+(iTokCount/100)
iHigh=iTokCount-1
For iTok=0 To iHigh
If (aCurrentLine[iTok]=="")
FileWrite(hFW,@CRLF)
Continue
EndIf
; Special handling for empty and blank strings. No need to be colorized.
If (StrTrim(aCurrentLine[iTok])=="")
FileWrite(hFW,aCurrentLine[iTok])
Continue
EndIf
iTokId = StrIndex(sTokId,StrSub(aCurrentLine[iTok],1,1),1,@FWDSCAN)
iTag = StrSub(aCurrentLine[iTok],2,-1)
Switch UseVerbose
Case 0
If !(iTok mod iPctDisplay)
sMsgText = StrReplace(StrReplace(sMaskMsg8,"{1}",iTokCount),"{2}",iTok)
WinTitle("",sMsgText)
EndIf
Break
Case 1
If !(iTok mod iPctDisplay)
sMsgText = StrReplace(StrReplace(sMaskMsg2,"{1}",iTokCount),"{2}",iTok)
BoxText(sMsgText)
EndIf
Break
Case UseVerbose
sMsgText = StrReplace(StrReplace(StrReplace(sMaskMsg6,"{3}",aTokName[iTokId]),"{1}",iTokCount),"{2}",iTok)
BoxText(sMsgText)
Break
EndSwitch
sTagItem = aTemp%iTokId%[iTag]
; Special handling for empty and blank strings. No need to be colorized.
If (StrTrim(sTagItem)=="")
FileWrite(hFW,sTagItem)
Continue
EndIf
Switch iTokId
Case 4 ; Operator.
sTagItem = StrReplace(sMaskFontOperator,"{1}",sTagItem)
camPut(aCAMColorUsed,"Operator","")
Break
Case 5 ; Bracket.
sTagItem = StrReplace(sMaskFontBracket,"{1}",sTagItem)
camPut(aCAMColorUsed,"Bracket","")
Break
Case 1 ; Quote.
sTagItem = StrReplace(sMaskFontQuote,"{1}",sTagItem)
camPut(aCAMColorUsed,"Quote","")
Break
Case 2 ; Comment.
sTagItem = StrReplace(sMaskFontComment,"{1}",sTagItem)
camPut(aCAMColorUsed,"Comment","")
Break
Case 6 ; Special.
sTagItem = StrReplace(sMaskFontSpecial,"{1}",sTagItem)
camPut(aCAMColorUsed,"Special","")
Break
Case 3 ; OpMod.
sTagItem = StrReplace(sMaskFontOperator,"{1}",sTagItem)
camPut(aCAMColorUsed,"Operator","")
Break
Case 8 ; Number.
sTagItem = StrReplace(sMaskFontNumber,"{1}",sTagItem)
camPut(aCAMColorUsed,"Number","")
Break
Case 7 ; Word.
; Find word in Keyword CAM Table, get colorname and standard writing.
sColorName = "default text"
sKeywordValue = camGet(aCAMKeyword,sTagItem)
If (sKeywordValue!="*EOF*CAM*")
sColorName = ItemExtract(1,sKeywordValue,@TAB)
Switch UseCase
Case 4
sTagItem = ItemExtract(2,sKeywordValue,@TAB)
Break
Case 3
sTagItem = StrUpper(sTagItem)
Break
Case 2
sTagItem = StrLower(sTagItem)
Break
Case 1
; sTagItem = sTagItem ; Freestyle, no change.
Break
EndSwitch
EndIf
If (sColorName=="") Then sColorName = "default text"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
sTagItem = StrReplace(StrReplace(sMaskFont,"{1}",sColorValue),"{2}",sTagItem)
camPut(aCAMColorUsed,sColorName,"")
If (UseVerbose>2)
sMsgText = StrReplace(StrReplace(sMaskMsg3,"{1}",sColorName),"{2}",sTagItem)
BoxText(sMsgText)
EndIf
Break
EndSwitch
FileWrite(hFW,sTagItem)
Next
Exclusive(iLastExclusive)
FileClose(hFW)
; CAM keyword array has done the job.
Drop(aCAMKeyword)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:AddLineNumber
;------------------------------------------------------------------------------------------------------------------------------------------
sColorName = "LineNumber"
If (sColorName=="") Then sColorName = "default text"
sColorValue = camGet(aCAMColor,sColorName)
If (sColorValue=="*EOF*CAM*") Then sColorValue = "#0"
;..........................................................................................................................................
iLineNoLen = UseLineNumberLen
If (UseLineNumberLen<0) Then iLineNoLen = StrLen(iInputLines)
;..........................................................................................................................................
Switch UseLineNumberLink
Case 2
sMaskAnchorNameId = '<a name="id.{1}.{2}" href="#id.{1}.{2}">{3}</a>'
sMaskAnchorNameId = StrReplace(sMaskAnchorNameId,"{1}",sFileInCrc)
Break
Case 1
sMaskAnchorNameId = '<a name="id.{1}.{2}">{3}</a>'
sMaskAnchorNameId = StrReplace(sMaskAnchorNameId,"{1}",sFileInCrc)
Break
Case 0
sMaskAnchorNameId = ''
Break
EndSwitch
;..........................................................................................................................................
iLastIC65 = IntControl(65,4096*Min(64,1+(FileSize(sFileIn)/4096)),0,0,0) ; Set size of internal FileRead buffer.
hFR = FileOpen(sFileOut2,"READ")
IntControl(53,1,0,0,0) ; Set line terminator for FileWrite. p1: 0=None, 1=@CRLF, 2=@LF, 3=@CR, 4=@TAB.
hFWOut = FileOpen(sFileOut1,"WRITE")
iCountLine = 0
iLastExclusive = Exclusive(@ON)
While @TRUE
sCurrentLine = FileRead(hFR)
If (sCurrentLine=="*EOF*") Then Break
iCountLine = iCountLine+1
sLineNo = StrFixLeft(iCountLine,UseLineNumberFiller,iLineNoLen)
sLineNo = StrReplace(StrReplace(sMaskFont,"{1}",sColorValue),"{2}",sLineNo)
Switch UseLineNumberLink
Case 2
Case 1
sAnchorNameId = StrReplace(sMaskAnchorNameId,"{2}",iCountLine)
sAnchorNameId = StrReplace(sAnchorNameId,"{3}",sLineNo)
sCurrentLine = StrCat(sAnchorNameId," ",sCurrentLine)
Break
Case 0
sCurrentLine = StrCat(sLineNo," ",sCurrentLine)
Break
EndSwitch
FileWrite(hFWOut,sCurrentLine)
EndWhile
Exclusive(iLastExclusive)
FileClose(hFWOut)
FileClose(hFR)
Drop(hFR,hFW,iLastExclusive,iLastIC65,iLineNoLen,sAnchorNameId,sColorName)
Drop(sColorValue,sCurrent,sLineNo,sMaskAnchorNameId)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:CreateTempFilenames
;------------------------------------------------------------------------------------------------------------------------------------------
; Create random filenames.
sFileTemp = FileCreateTemp("")
FileDelete(sFileTemp)
sMaskFN = StrCat(FilePath(sFileTemp),sProgProduct,".",FileRoot(sFileTemp),"{1}")
sFileCAMTagList = StrReplace(sMaskFN,"{1}",".cam.taglist.txt")
sFileOut1 = StrReplace(sMaskFN,"{1}",".1.txt")
sFileOut2 = StrReplace(sMaskFN,"{1}",".2.txt")
Drop(sFileTemp,sMaskFN)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:DeleteTempFilenames
;------------------------------------------------------------------------------------------------------------------------------------------
If IsDefined(sFileCAMTagList) Then If FileExist(sFileCAMTagList) Then FileDelete(sFileCAMTagList)
If IsDefined(sFileOut1) Then If FileExist(sFileOut1) Then FileDelete(sFileOut1)
If IsDefined(sFileOut2) Then If FileExist(sFileOut2) Then FileDelete(sFileOut2)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:CreateWriteTargetFile
;------------------------------------------------------------------------------------------------------------------------------------------
; Create the HTML output from previously defined template.
sMaskHtmPre = StrReplace(sMaskHtmPre,"{1}" ,TimeYmdHms())
sMaskHtmPre = StrReplace(sMaskHtmPre,"{2}" ,sProgProduct)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{3}" ,sProgVersion)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{4}" ,sProgCopyright)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{5}" ,sListHtmColor)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{6}" ,sStyleImageBg)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{7}" ,sStyleColorBg)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{8}" ,sStyleBorder)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{9}" ,sStylePadding)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{10}",sStyleWidth)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{11}",sStyleFontFamily)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{12}",sStyleFontSize)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{13}",sStyleFontWeight)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{14}",sStyleFontStyle)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{15}",sStyleColorFg)
sMaskHtmPre = StrReplace(sMaskHtmPre,"{16}",sFileInCrc)
If UseLineNumberLen Then
sMaskHtmPre = StrReplace(sMaskHtmPre,"{17}",FileGet(sFileOut1))
Else
sMaskHtmPre = StrReplace(sMaskHtmPre,"{17}",FileGet(sFileOut2))
EndIf
;..........................................................................................................................................
FilePut(sFileOut,sMaskHtmPre)
;..........................................................................................................................................
If (UseVerbose>1)
sMsgText = StrCat(sFileOut,@LF,"Closing targetfile ...")
BoxText(sMsgText)
EndIf
Drop(sMaskHtmPre,sMsgText)
Return
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================
:GetParams
;------------------------------------------------------------------------------------------------------------------------------------------
Drop(sFileIn,sFileOut)
iResult = 0
If !Param0 Then Return ; No parameters given, immediately return.
sMsgTitle = "Error"
sFileIn = udfGetLongPathNameA(Param1)
If !FileSizeEx(sFileIn)
sMsgText = StrCat(sFileIn,@LF,"Cannot handle input file.",@LF,"FileSize may be zero.")
Message(sMsgTitle,sMsgText)
Goto CANCEL
EndIf
If !ItemLocate(StrLower(FileExtension(sFileIn)),"wbt|web","|")
sMsgText = StrCat(sFileIn,@LF,"Cannot handle input file.",@LF,"Filename has wrong extension.",@LF,"Must be '.wbt' or '.web'.")
Message(sMsgTitle,sMsgText)
Goto CANCEL
EndIf
If IsDefined(Param2)
; Force extension.
sFileOut = StrCat(FilePath(Param2),FileRoot(Param2),".htm")
Else
; Simply add extension.
sFileOut = StrCat(sFileIn,".htm")
EndIf
If (FileExist(sFileOut)==2)
sMsgText = StrCat(sFileOut,@LF,"Cannot handle output file.",@LF,"File is currently open by another application.")
Message(sMsgTitle,sMsgText)
Goto CANCEL
EndIf
If FileSizeEx(sFileOut)
If !UseAllowOverwrite
sMsgText = StrCat(sFileOut,@LF,"Cannot handle output file.",@LF,"File may exist.",@LF,"Allow to overwrite?")
If (@YES!=AskYesNo(sMsgTitle,sMsgText)) Then Goto CANCEL
EndIf
FileAttrSet(sFileOut,"rash")
iResult = 1
Return
EndIf
If !FileExist(sFileOut)
FileClose(FileOpen(sFileOut,"WRITE"))
If !FileExist(sFileOut)
sMsgText = StrCat(sFileOut,@LF,"Cannot handle output file.",@LF,"File cannot be created.")
Message(sMsgTitle,sMsgText)
Goto CANCEL
EndIf
Else
FileDelete(sFileOut)
If FileExist(sFileOut)
sMsgText = StrCat(sFileOut,@LF,"Cannot handle output file.",@LF,"File cannot be deleted.")
Message(sMsgTitle,sMsgText)
Goto CANCEL
EndIf
EndIf
; If we arrive here, then input and output filenames seem to be useful.
iResult = 1
Return
;==========================================================================================================================================
;==========================================================================================================================================
:AskParams
;------------------------------------------------------------------------------------------------------------------------------------------
AFN_folder = UseAskFilename ; Define your standard folder here.
AFN_folder = IniReadPvt("User","UseAskFilename",AFN_folder,sFileMyIni)
AFN_title = "WBT2HTML: Select WBT or WEB File to convert to HTM"
AFN_filetypes = "WIL Files|*.wbt;*.web|HTML Files|*.htm;*.html|All Files|*.*|"
AFN_default = "*.wbt;*.web"
AFN_flag = 1 ; Open single file.
sFileIn = AskFilename(AFN_title,AFN_folder,AFN_filetypes,AFN_default,AFN_flag)
AFN_folder = FilePath(sFileIn)
IniWritePvt("User","UseAskFilename",AFN_folder,sFileMyIni)
IniWritePvt("","","",sFileMyIni)
DropWild("AFN_*")
If (sFileIn>"")
Param0 = 1
Param1 = sFileIn
Return
EndIf
:CANCEL
Exit
;==========================================================================================================================================
;==========================================================================================================================================
:WriteLog
;------------------------------------------------------------------------------------------------------------------------------------------
; Start performance test.
If !IsDefined(iPerfStart)
iPerfStart = GetTickCount()
Return
EndIf
;..........................................................................................................................................
; Stop performance test.
iPerfStop = GetTickCount()
iPerfLinesIn = ItemCount(FileGet(sFileIn),@LF)-(StrSub(FileGet(sFileIn),FileSize(sFileIn),1)==@LF)
iPerfLinesOut = iCountLine
iPerfSecs = (iPerfStop-iPerfStart)/1000.0
iPerfLinesOutPerSec = iPerfLinesOut/iPerfSecs
;..........................................................................................................................................
If !UseWriteLogfile Then Return
;..........................................................................................................................................
Decimals(2)
sPerfIni = StrCat(sFolderTemp,sProgProduct,".log.txt")
sPerfSection = StrCat(TimeYmdHms(),"|",StrFixLeft(GetTickCount()," ",10))
sPerfKey = "Version"
sPerfValue = sProgVersion
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "FileIn"
sPerfValue = sFileIn
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "FileOut"
sPerfValue = sFileOut
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "LinesIn"
sPerfValue = iPerfLinesIn
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "LinesOut"
sPerfValue = iPerfLinesOut
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "Secs"
sPerfValue = iPerfSecs
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
sPerfKey = "LinesOutPerSec"
sPerfValue = iPerfLinesOutPerSec
IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
; sPerfKey = "Quoted Literals"
; sPerfValue = aTagList[12]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Comments"
; sPerfValue = aTagList[13]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Operator mod"
; sPerfValue = aTagList[14]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Operators"
; sPerfValue = aTagList[15]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Brackets"
; sPerfValue = aTagList[16]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Special Chars"
; sPerfValue = aTagList[17]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Words"
; sPerfValue = aTagList[18]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
;
; sPerfKey = "Numbers"
; sPerfValue = aTagList[19]-iTagLow
; IniWritePvt(sPerfSection,sPerfKey,sPerfValue,sPerfIni)
Return
;==========================================================================================================================================
;==========================================================================================================================================
:WBERRORHANDLER
;------------------------------------------------------------------------------------------------------------------------------------------
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
; 1668 ; "Minor user-defined error"
; 2669 ; "Moderate user-defined error"
; 3670 ; "Severe user-defined error"
WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = StrCat(TimeYmdHms(),"|",StrFixLeft(GetTickCount()," ",10))
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
IniWritePvt(WbErrorDateTime,"ErrorValue" ,WbError ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ErrorString" ,WbErrorString ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptLine" ,WbErrorHandlerLine ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
IniWritePvt("","","",WbErrorFile)
WbErrorMsgText = StrCat(WbErrorDateTime,@LF,@LF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError value:",@LF,WbError,@LF,@LF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError string:",@LF,WbErrorString,@LF,@LF)
; Line in script that caused Error.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerLine:",@LF,WbErrorHandlerLine,@LF,@LF)
; Offset into script of error line, in bytes.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerOffset:",@LF,WbErrorHandlerOffset,@LF,@LF)
; Variable being assigned on error line, or "" if none.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerAssignment:",@LF,WbErrorHandlerAssignment,@LF,@LF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "eeek"
Message("wbErrorHandler",WbErrorMsgText)
Exit
;==========================================================================================================================================
*EOF*
;==========================================================================================================================================
; 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 script from WSPOPUP.MNU, for example:
;
; WBT2HTML via ClipBoard
; call("W:\WINBATCH\Scripts\WBStudioToWBT2HTML.wbt","")
;
;------------------------------------------------------------------------------------------------------------------------------------------
; Detlev Dalitz.20011113.20020807.20030718
;------------------------------------------------------------------------------------------------------------------------------------------
iInStudio = (RtStatus()==10)
If !iInStudio Then Exit
If iInStudio
If !wGetSelstate() Then wSelectAll()
wCopy()
EndIf
wClearSel()
hBBSize = BinaryClipGet(0,1)
If !hBBSize Then Return ; Nothing to do.
; If !hBBSize then Exit ; Nothing to do.
hBB = BinaryAlloc(hBBSize)
iSize = BinaryClipGet(hBB,1)
Display(2,"WBT2HTML","Selected Text copied to ClipBoard, %iSize% Byte to format ...")
sFNTemp = FileCreateTemp("TMP")
sFNTemp = FileLocate(sFNTemp)
sFNWBT = StrCat(sFNTemp,".wbt")
sFNHTM = StrCat(sFNTemp,".htm")
FileRename(sFNTemp,sFNWBT)
iSize = BinaryWrite(hBB,sFNWBT)
BinaryFree(hBB)
sFNMyIni = "W:\WINBATCH\PROD\WBT2HTML\WBT2HTML.INI" ; <== Change the path to your needs.
sFNMyWbt = '"W:\WINBATCH\PROD\WBT2HTML\WBT2HTML.WBT"' ; <== Change the path to your needs.
iLast_UseRunOutput = IniReadPvt("User","UseRunOutput",1,sFNMyIni) ; Save current value.
iLast_UseVerbose = IniReadPvt("User","UseVerbose" ,1,sFNMyIni) ; Save current value.
IniWritePvt("User","UseRunOutput",0,sFNMyIni) ; No browsing.
IniWritePvt("User","UseVerbose" ,0,sFNMyIni) ; No messages.
RunWait (StrCat(DirHome(),"WinBatch.exe"),StrCat(sFNMyWbt," ",sFNWBT," ",sFNHTM))
If FileExist(sFNHTM)
hBBSize = FileSize(sFNHTM)
hBB = BinaryAlloc(hBBSize)
iSize = BinaryRead(hBB,sFNHTM)
BinaryClipPut(hBB,1)
iSize = BinaryClipGet(0,1)
BinaryFree(hBB)
Display(2,"WBT2HTML","HTML copied to ClipBoard, %iSize% Byte to paste ...")
EndIf
:CANCEL
IniWritePvt("User","UseRunOutput",iLast_UseRunOutput,sFNMyIni) ; Restore old value.
IniWritePvt("User","UseVerbose" ,iLast_UseVerbose ,sFNMyIni) ; Restore old value.
iLastErrorMode = ErrorMode(@OFF)
If (FileExist(sFNHTM)==1) Then FileDelete(sFNHTM)
If (FileExist(sFNWBT)==1) Then FileDelete(sFNWBT)
ErrorMode(iLastErrorMode)
Drop(hBB,hBBSize,iInStudio,iLast_UseRunOutput,iLast_UseVerbose,iLastErrorMode,iSize,sFNHTM,sFNMyIni,sFNMyWbt,sFNTemp,sFNWBT)
Exit
;==========================================================================================================================================
*EOF*
|
|
|
DD383400.HTM DD-Software.WBT2HTML Add this page to your favorites Save this document |