FreeBasic code в HTML
Программа преобразует код Freebasic в HTML страницу. Может пригодится при
размещении исходника на сайтах. Добавлена возможность выбирать файлы из диалога.
Если убрать в коде строчки, связанные с библиотекой Window9, то можно
откомпилировать под Linux.
Платформа: Windows, создано: в 2008
году.
Автор: Martin Wiemann
'############################################################################################################## ' F B 2 H T M L '############################################################################################################## 'Autor: Martin Wiemann 'Create: 22.01.2008 '############################################################################################################## #INCLUDE "window9.bi" #IF DEFINED(__FB_LINUX__) Const G_Seperator = "/" #ELSEIF DEFINED(__FB_WIN32__) Const G_Seperator = "\" #ELSE #ERROR "Unsupported platform" #ENDIF '############################################################################################################## Declare Sub Main () Declare Function InStrRev_ (Byval V_Data As String, V_Search As String) As Long Declare Function MakeWord_ (V_Data As String) As String Declare Function F_CheckHex (V_Data As String) As Ubyte '############################################################################################################## Main() End 0 '############################################################################################################## Sub Main() Dim T As String Dim T1 As String Dim X As Ulong Dim Y As Ulong Dim XPos As Ulong Dim DD() As String Dim DC As Ulong Dim XABSC As Ulong Dim XPathFileIn As String Dim XPathFileOut As String Dim XLineNum As Ubyte = 1 Dim XColorBack As String = "FFFFFF" Dim XColorFore As String = "000000" Dim XColorComment As String = "008800" Dim XColorString As String = "FF0000" Dim XColorCommand As String = "0000FF" Dim XColorStatement As String = "6666FF" Dim XColorDatatype As String = "AA5500" Dim XColorPreProcStatement As String = "00AAAA" Dim XColorPreProcVar As String = "AA00AA" T = Command If T="" Then T =OpenFileRequester("","C:\","FB files (*.bas, *.bi)"_ +Chr(0)+"*.bas;*.bi"+Chr(0)) Endif For X = 1 To Len(T) XPos = Instr(1, T, " ") If XPos > 0 Then T1 = Mid(T, 1, XPos - 1): T = Mid(T, XPos + 1) Else: T1 = T: T = "" End If If T1 <> "" Then DC += 1: Redim Preserve DD(DC) As String DD(DC) = T1 End If If T = "" Then Exit For Next Select Case DC Case 0: Print "Missing commands! Use --help to show commands!": End -1 Case 1 Select Case Lcase(DD(1)) Case "--help", "-help" Print "" Print " #####################################################" Print " ### freeBASIC sourcecode to HTML-script converter ###" Print " #####################################################" Print "" Print "" Print "Syntax: fb2html <command / path> [<option>]" Print "" Print "" Print "example: fb2html incode.bas" Print " Will read file 'incode.bas' and create html in new incode.html" Print "" Print "example: fb2html -i incode.bas -o outcode.html -cb FF00FF -cf 00FF00" Print " Will read file 'incode.bas' and create html in new outcode.html" Print " New HTML code will colorized whis FF00FF as Backcolor and 00FF00 als Forecolor" Print "" Print "" Print "" Print "-!- .bas files was convert to to .html" Print "-!- .bi files was convert to to .htm" Print "-!- other files will only be convert whis -i and -o option!" Print "" Print "" Print " --help / -help = Show help text. (This text)" Print "" Print " -i <path/file> = Input path / file" Print " -o <path/file> = Output path / file" Print "" Print " -noline = will toggel the visibility of the line numbers" Print "" Print " -cb <hex-color> = Color value for background like 000000 to FFFFFF" Print " -cf <hex-color> = Foreground color (regulare text)" Print " -cs <hex-color> = String color (text in " & Chr(34,34) & " tags)" Print " -cc <hex-color> = Comments color (text after ' tag)" Print " -co <hex-color> = Basecommand color (text like 'Print')" Print " -cm <hex-color> = Statement color (text like 'byval')" Print " -cd <hex-color> = Datatype color (text like 'Long')" Print " -cps <hex-color> = Preporcessor Statement color (text like '#IFDEF')" Print " -cpv <hex-color> = Preporcessor Variable color (text like '__fb_linux__')" Print "" End 0 Case Else: XPathFileIn = DD(1) End Select Case Else For X = 1 To DC Select Case Lcase(DD(X)) Case "-i" If DC <= X Then Print "Missing path / file!": End -1 X += 1: XPathFileIn = DD(X) Case "-o" If DC <= X Then Print "Missing path / file!": End -1 X += 1: XPathFileOut = DD(X) Case "-noline": XLineNum = 0 Case Else If DC <= X Then Print "Missing hex value!": End -1 If F_CheckHex(DD(X + 1)) = 0 Then Print "'" & DD(X + 1) & "' is not a hex value": End -1 X += 1 Select Case Lcase(DD(X - 1)) Case "-cb": XColorBack = Lcase(DD(X)) Case "-cf": XColorFore = Lcase(DD(X)) Case "-cs": XColorString = Lcase(DD(X)) Case "-cc": XColorCommand = Lcase(DD(X)) Case "-cm": XColorStatement = Lcase(DD(X)) Case "-cd": XColorDatatype = Lcase(DD(X)) Case "-cps": XColorPreProcStatement = Lcase(DD(X)) Case "-cpv": XColorPreProcVar = Lcase(DD(X)) Case Else: Print "Unknow commands! Use --help to show commands! [" & Lcase(DD(X - 1)) & "]": End -1 End Select End Select Next End Select If XPathFileIn = "" Then Print "Inputfile was not found!": End -1 If Dir(XPathFileIn) = "" Then Print "Inputfile was not found!": End -1 Dim XInPath As String Dim XInName As String Dim XInType As String Dim XOutPath As String Dim XOutName As String Dim XOutType As String XPos = Instrrev(XPathFileIn, G_Seperator) If XPos > 0 Then XInName = Mid(XPathFileIn, XPos + 1) XInPath = Mid(XPathFileIn, 1, XPos) Else: XInName = XPathFileIn End If If XPathFileOut <> "" Then XPos = Instrrev(XPathFileOut, G_Seperator) If XPos > 0 Then XOutName = Mid(XPathFileOut, XPos + 1) XOutPath = Mid(XPathFileOut, 1, XPos) Else: XOutName = XPathFileOut End If End If If XOutPath <> "" Then If Right(XOutPath, 1) <> G_Seperator Then Print "Outputpath corrupt!": End -1 XPos = Instrrev(XInName, ".") If XPos = 0 Then Print "can't find input filetype! (.bas / .bi / .*)": End -1 XInType = Mid(XInName, XPos + 1) XInName = Mid(XInName, 1, XPos - 1) If XOutName <> "" Then XPos = Instrrev(XOutName, ".") If XPos = 0 Then Print "can't find output filetype! (.html / .htm)": End -1 XOutType = Mid(XOutName, XPos + 1) XOutName = Mid(XOutName, 1, XPos - 1) Select Case Lcase(XOutType) Case "html", "htm" Case Else: Print "Output filetype was not supported by converter.": End -1 End Select Else XOutName = XInName Select Case Lcase(XInType) Case "bas": XOutType = "html" Case "bi": XOutType = "htm" Case Else: Print "-o command need for .* filetype": End -1 End Select End If Dim G_FNIn As Integer Dim G_FNOut As Integer Dim TOutD() As String Dim TOutC As Ulong = 1 Redim TOutD(TOutC) As String Dim FBCRLF As String = Chr(13,10) If Dir(XOutPath & XOutName & "." & XOutType) <> "" Then Kill XOutPath & XOutName & "." & XOutType G_FNOut = Freefile Open XOutPath & XOutName & "." & XOutType For Binary As #G_FNOut Print #G_FNOut, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">" Print #G_FNOut, "<html>" Print #G_FNOut, " <head>" Print #G_FNOut, " <title>Freebasic-Sourcecode of: '" & XInName & "." & XInType & "'</title>" Print #G_FNOut, " <style type=""text/css"">" Print #G_FNOut, " body{font-family:lucida console,fixedsys,monospace;font-size:11px;line-height:12px;}" Print #G_FNOut, " .ca{color:#" & XColorCommand & ";font-weight:bold;}" Print #G_FNOut, " .cb{color:#" & XColorStatement & ";font-weight:bold;}" Print #G_FNOut, " .cc{color:#" & XColorDatatype & ";}" Print #G_FNOut, " .cd{color:#" & XColorPreProcStatement & ";}" Print #G_FNOut, " .ce{color:#" & XColorPreProcVar & ";}" Print #G_FNOut, " .cf{color:#" & XColorComment & ";font-style:italic;}" Print #G_FNOut, " .cg{color:#" & XColorString & ";}" Print #G_FNOut, " .cz{color:#" & XColorFore & ";font-family:lucida console,fixedsys,monospace;font-size:12px;line-height:12px;float:left;text-align:right;padding-left:10px;padding-right:10px;}" Print #G_FNOut, " .cy{color:#" & XColorFore & ";font-family:lucida console,fixedsys,monospace;font-size:12px;line-height:12px;float:left;text-align:left;padding-left:10px;padding-right:10px;}" Print #G_FNOut, " </style>" Print #G_FNOut, " </head>" Print #G_FNOut, " <body bgcolor=""#" & XColorBack & """ text=""#" & XColorFore & """ link=""#" & XColorFore & """ vlink=""#" & XColorFore & """ alink=""#" & XColorFore & """>" G_FNIn = Freefile Open XPathFileIn For Binary As #G_FNIn Dim XLen As Ulong = Lof(G_FNIn) Dim XALock As Ubyte Dim XLLock As Ubyte Dim XWCaS As String Dim XTS As Ulong For Y = 1 To XLen Step 1024 T = Space(1024) If Y + 1024 > XLen Then T = Space(XLen - Y + 1) Get #G_FNIn, Y, T For X = 1 To Len(T) Select Case Mid(T, X, 1) Case """" If XLLock = 0 Then XABSC += Len(XWCaS) + 1 If XALock = 0 Then TOutD(TOutC) += MakeWord_(XWCaS): XWCaS = "" XALock = 1: TOutD(TOutC) += "<span class=""cg"">"" Else TOutD(TOutC) += XWCaS: XWCaS = "" XALock = 0: TOutD(TOutC) += "</span>" End If Else: TOutD(TOutC) += """: XABSC += 1 End If Case ":" XABSC += Len(XWCaS) + 1 If (XALock = 0) And (XLLock = 0) Then TOutD(TOutC) += MakeWord_(XWCaS): XWCaS = "" Else: TOutD(TOutC) += XWCaS: XWCaS = "" End If TOutD(TOutC) += ":" Case Chr(9) XABSC += Len(XWCaS) XTS = 4 - (XABSC Mod 4) If (XALock = 0) And (XLLock = 0) Then TOutD(TOutC) += MakeWord_(XWCaS) & String(XTS, " "): XWCaS = "" Else: TOutD(TOutC) += XWCaS & String(XTS, " "): XWCaS = "" End If XABSC += XTS Case Chr(13) Case Chr(10) If (XALock = 0) And (XLLock = 0) Then TOutD(TOutC) += MakeWord_(XWCaS): XWCaS = "" Else: TOutD(TOutC) += XWCaS: XWCaS = "" End If If XLLock = 1 Then TOutD(TOutC) += "</span>" If XALock = 1 Then TOutD(TOutC) += "</span>" TOutD(TOutC) += Chr(13,10) TOutC += 1 Redim Preserve TOutD(TOutC) As String XLLock = 0 XALock = 0 XABSC = 0 Case " ", "<", ">", "&", "(", ")", "," XABSC += Len(XWCaS) + 1 Select Case Mid(T, X, 1) Case " ": T1 = " " Case "<": T1 = "<" Case ">": T1 = ">" Case "&": T1 = "&" Case Else: T1 = Mid(T, X, 1) End Select If (XALock = 0) And (XLLock = 0) Then TOutD(TOutC) += MakeWord_(XWCaS) & T1: XWCaS = "" Else: TOutD(TOutC) += XWCaS & T1: XWCaS = "" End If Case "'" XABSC += Len(XWCaS) + 1 If XALock = 0 Then TOutD(TOutC) += MakeWord_(XWCaS): XWCaS = "" If XLLock = 0 Then TOutD(TOutC) += "<span class=""cf"">" XLLock = 1 Else: TOutD(TOutC) += XWCaS: XWCaS = "" End If TOutD(TOutC) += Mid(T, X, 1) Case Else: XWCaS += Mid(T, X, 1) End Select Next Next Close #G_FNIn TOutD(TOutC) += MakeWord_(XWCaS) Print #G_FNOut, " <table border=""0"" cellpadding=""1"" cellspacing=""2"">" Print #G_FNOut, " <tr>" If XLineNum = 1 Then Print #G_FNOut, " <td class=""cz"" align=""right"" valign=""top"">" For X = 1 To TOutC Print #G_FNOut, Str(x) & ":<br>"; Next Print #G_FNOut, " </td>" End If Print #G_FNOut, " <td class=""cy"" align=""left"" valign=""top"">" Print #G_FNOut, " <pre>"; For X = 1 To TOutC Print #G_FNOut, TOutD(X); Next Print #G_FNOut, " </pre>" Print #G_FNOut, " </td>" Print #G_FNOut, " </tr>" Print #G_FNOut, " </table>" Print #G_FNOut, " </body>" Print #G_FNOut, "</html>" Close #G_FNOut Print "convert successful!" End Sub '############################################################################################################## Function InStrRev_(Byval V_Data As String, V_Search As String) As Long Dim X As Long Dim SL As Long SL = Len(V_Search) For X = Len(V_Data) - SL + 1 To 1 Step - 1 If Mid(V_Data, X, SL) = V_Search Then Return X Next End Function '############################################################################################################## Function MakeWord_(V_Data As String) As String Dim XT As Ubyte Select Case Lcase(Left(V_Data, 1)) Case "_" Select Case Lcase(V_Data) Case "__date__": XT = 4 Case "__fb_argc": XT = 4 Case "__fb_argv__": XT = 4 Case "__fb_bigendian__": XT = 4 Case "__fb_debug__": XT = 4 Case "__fb_dos__": XT = 4 Case "__fb_err__": XT = 4 Case "__fb_lang__": XT = 4 Case "__fb_linux__": XT = 4 Case "__fb_main__": XT = 4 Case "__fb_min_version__": XT = 4 Case "__fb_mt__": XT = 4 Case "__fb_option_byval__": XT = 4 Case "__fb_option_dynamic__": XT = 4 Case "__fb_option_escape__": XT = 4 Case "__fb_option_explicit__": XT = 4 Case "__fb_option_private__": XT = 4 Case "__fb_out_dll__": XT = 4 Case "__fb_out_exe__": XT = 4 Case "__fb_out_lib__": XT = 4 Case "__fb_out_obj__": XT = 4 Case "__fb_signature__": XT = 4 Case "__fb_ver_major__": XT = 4 Case "__fb_ver_minor__": XT = 4 Case "__fb_ver_patch__": XT = 4 Case "__fb_version__": XT = 4 Case "__fb_win32__": XT = 4 Case "__file__": XT = 4 Case "__file_nq__": XT = 4 Case "__function__": XT = 4 Case "__line__": XT = 4 Case "__path__": XT = 4 Case "__time__": XT = 4 End Select Case "#" Select Case Lcase(V_Data) Case "#if": XT = 5 Case "#ifdef": XT = 5 Case "#elseif": XT = 5 Case "#else": XT = 5 Case "#endif": XT = 5 Case "#ifndef": XT = 5 Case "#error": XT = 5 End Select Case "a" Select Case Lcase(V_Data) Case "abs": XT = 1 Case "access": XT = 2 Case "acos": XT = 1 Case "add": XT = 2 Case "alias": XT = 2 Case "allocate": XT = 1 Case "alpha": XT = 1 Case "and": XT = 2 Case "any": XT = 3 Case "append": XT = 2 Case "as": XT = 2 Case "asc": XT = 1 Case "asin": XT = 1 Case "asim": XT = 1 Case "asm": XT = 2 Case "assert": XT = 2 Case "assertwarn": XT = 2 Case "atan2": XT = 1 Case "atn": XT = 1 End Select Case "b" Select Case Lcase(V_Data) Case "base": XT = 2 Case "beep": XT = 2 Case "bin": XT = 1 Case "binary": XT = 2 Case "bit": XT = 1 Case "bitreset": XT = 1 Case "bitset": XT = 1 Case "bload": XT = 1 Case "bsave": XT = 1 Case "byte": XT = 3 Case "byref": XT = 2 Case "byval": XT = 2 End Select Case "c" Select Case Lcase(V_Data) Case "call": XT = 2 Case "callocate": XT = 1 Case "calls": XT = 2 Case "case": XT = 1 Case "cast": XT = 1 Case "cbyte": XT = 1 Case "cdbl": XT = 1 Case "cdecl": XT = 2 Case "chain": XT = 1 Case "chdir": XT = 1 Case "chr": XT = 1 Case "cint": XT = 1 Case "circel": XT = 2 Case "clear": XT = 2 Case "clng": XT = 1 Case "clngint": XT = 1 Case "close": XT = 2 Case "cls": XT = 2 Case "color": XT = 2 Case "com": XT = 2 Case "command": XT = 1 Case "common": XT = 2 Case "condbroadcast": XT = 1 Case "condcreate": XT = 1 Case "conddestroy": XT = 1 Case "condsignal": XT = 1 Case "condwait": XT = 1 Case "cons": XT = 2 Case "const": XT = 2 Case "constructor": XT = 2 Case "continue": XT = 2 Case "cos": XT = 1 Case "cptr": XT = 1 Case "cshort": XT = 1 Case "csign": XT = 1 Case "csng": XT = 1 Case "csrlin": XT = 1 Case "cubyte": XT = 1 Case "cuint": XT = 1 Case "culngint": XT = 1 Case "cunsg": XT = 1 Case "curdir": XT = 1 Case "cushort": XT = 1 Case "custom": XT = 2 Case "cvd": XT = 1 Case "cvi": XT = 1 Case "cvl": XT = 1 Case "cvlongint": XT = 1 Case "cvs": XT = 1 Case "cvshort": XT = 1 End Select Case "d" Select Case Lcase(V_Data) Case "data": XT = 2 Case "date": XT = 1 Case "dateadd": XT = 1 Case "datediff": XT = 1 Case "datepart": XT = 1 Case "dateserial": XT = 1 Case "datevalue": XT = 1 Case "day": XT = 1 Case "deallocate": XT = 1 Case "declare": XT = 1 Case "defbyte": XT = 2 Case "defdbl": XT = 2 Case "define": XT = 2 Case "defined": XT = 1 Case "defint": XT = 2 Case "deflng": XT = 2 Case "deflongint": XT = 2 Case "defshort": XT = 2 Case "defsng": XT = 2 Case "defstr": XT = 2 Case "defubyte": XT = 2 Case "defuint": XT = 2 Case "defulongint": XT = 2 Case "defushort": XT = 2 Case "delete": XT = 2 Case "destructor": XT = 2 Case "dim": XT = 1 Case "dir": XT = 1 Case "do": XT = 1 Case "double": XT = 3 Case "draw": XT = 1 Case "dylibfree": XT = 1 Case "dylibload": XT = 1 Case "dylibsymbol": XT = 1 Case "dynamic": XT = 2 End Select Case "e" Select Case Lcase(V_Data) Case "else": XT = 1 Case "elseif": XT = 1 Case "encoding": XT = 1 Case "end": XT = 1 Case "endif": XT = 1 Case "endmacro": XT = 2 Case "enum": XT = 1 Case "environ": XT = 2 Case "eof": XT = 1 Case "eqv": XT = 1 Case "erase": XT = 2 Case "erfn": XT = 1 Case "ermn": XT = 1 Case "err": XT = 2 Case "error": XT = 2 Case "escape": XT = 2 Case "exec": XT = 1 Case "exepath": XT = 1 Case "exit": XT = 1 Case "exp": XT = 1 Case "explicite": XT = 2 Case "export": XT = 2 Case "extern": XT = 2 End Select Case "f" Select Case Lcase(V_Data) Case "field": XT = 1 Case "fileattr": XT = 1 Case "filecopy": XT = 1 Case "filedatetime": XT = 1 Case "fileexist": XT = 1 Case "filelen": XT = 1 Case "fix": XT = 1 Case "flip": XT = 1 Case "for": XT = 1 Case "format": XT = 1 Case "frac": XT = 1 Case "fre": XT = 1 Case "freefile": XT = 1 Case "function": XT = 1 End Select Case "g" Select Case Lcase(V_Data) Case "get": XT = 1 Case "getjoystick": XT = 1 Case "getkey": XT = 1 Case "getmouse": XT = 1 Case "gosub": XT = 2 Case "goto": XT = 2 End Select Case "h" Select Case Lcase(V_Data) Case "hex": XT = 1 Case "hibyte": XT = 1 Case "hiword": XT = 1 Case "hour": XT = 1 End Select Case "i" Select Case Lcase(V_Data) Case "if": XT = 1 Case "ifdef": XT = 2 Case "ifndef": XT = 2 Case "iif": XT = 1 Case "imageconvertrow": XT = 1 Case "imagecreate": XT = 1 Case "imagedestroy": XT = 1 Case "imp": XT = 2 Case "import": XT = 1 Case "inclib": XT = 1 Case "include": XT = 1 Case "inkey": XT = 1 Case "inp": XT = 2 Case "input": XT = 2 Case "instr": XT = 1 Case "instrrev": XT = 1 Case "int": XT = 1 Case "integer": XT = 3 Case "is": XT = 1 Case "isdate": XT = 1 End Select Case "k" Select Case Lcase(V_Data) Case "kill": XT = 1 End Select Case "l" Select Case Lcase(V_Data) Case "lbound": XT = 1 Case "lcase": XT = 1 Case "left": XT = 1 Case "len": XT = 1 Case "let": XT = 1 Case "lib": XT = 2 Case "libpath": XT = 2 Case "line": XT = 2 Case "lobyte": XT = 1 Case "loc": XT = 1 Case "local": XT = 1 Case "locate": XT = 1 Case "lock": XT = 1 Case "lof": XT = 1 Case "loop": XT = 1 Case "log": XT = 1 Case "long": XT = 3 Case "longint": XT = 3 Case "loword": XT = 1 Case "lpos": XT = 1 Case "lprint": XT = 1 Case "lset": XT = 1 Case "ltrim": XT = 1 Case "lpt": XT = 1 End Select Case "m" Select Case Lcase(V_Data) Case "macro": XT = 2 Case "mid": XT = 1 Case "minute": XT = 1 Case "mkd": XT = 1 Case "mkdir": XT = 1 Case "mki": XT = 1 Case "mkl": XT = 1 Case "mklongint": XT = 1 Case "mks": XT = 1 Case "mkshort": XT = 1 Case "mod": XT = 2 Case "month": XT = 1 Case "monthname": XT = 1 Case "multikey": XT = 1 Case "mutexcreate": XT = 1 Case "mutexdestroy": XT = 1 Case "mutexlock": XT = 1 Case "mutexunlock": XT = 1 End Select Case "n" Select Case Lcase(V_Data) Case "name": XT = 2 Case "namespace": XT = 2 Case "next": XT = 1 Case "new": XT = 2 Case "not": XT = 2 Case "now": XT = 1 End Select Case "o" Select Case Lcase(V_Data) Case "option": XT = 2 Case "oct": XT = 1 Case "offsetop": XT = 2 Case "on": XT = 2 Case "once": XT = 2 Case "open": XT = 1 Case "operator": XT = 2 Case "or": XT = 2 Case "out": XT = 2 Case "output": XT = 1 Case "overload": XT = 2 End Select Case "p" Select Case Lcase(V_Data) Case "paint": XT = 1 Case "palette": XT = 1 Case "pascal": XT = 1 Case "pcopy": XT = 1 Case "peek": XT = 2 Case "pipe": XT = 2 Case "pmap": XT = 1 Case "point": XT = 1 Case "pointer": XT = 1 Case "poke": XT = 2 Case "pos": XT = 1 Case "pragma": XT = 2 Case "preserve": XT = 2 Case "preset": XT = 2 Case "print": XT = 1 Case "private": XT = 2 Case "procptr": XT = 1 Case "property": XT = 2 Case "pset": XT = 1 Case "ptr": XT = 2 Case "public": XT = 2 Case "put": XT = 1 End Select Case "r" Select Case Lcase(V_Data) Case "random": XT = 2 Case "randomize": XT = 1 Case "read": XT = 1 Case "reallocate": XT = 1 Case "redim": XT = 2 Case "rem": XT = 2 Case "reset": XT = 1 Case "restore": XT = 2 Case "resume": XT = 1 Case "return": XT = 1 Case "rgb": XT = 1 Case "rgba": XT = 1 Case "right": XT = 1 Case "rmdir": XT = 1 Case "rnd": XT = 1 Case "rset": XT = 1 Case "rtrim": XT = 1 Case "run": XT = 1 End Select Case "s" Select Case Lcase(V_Data) Case "sadd": XT = 1 Case "scope": XT = 2 Case "screen": XT = 1 Case "screencontrol": XT = 1 Case "screencopy": XT = 1 Case "screenevent": XT = 1 Case "screeninfo": XT = 1 Case "screenlist": XT = 1 Case "screenlock": XT = 1 Case "screenptr": XT = 1 Case "screenres": XT = 1 Case "screenset": XT = 1 Case "screensync": XT = 1 Case "screenunlock": XT = 1 Case "scrn": XT = 1 Case "second": XT = 1 Case "seek": XT = 1 Case "select": XT = 1 Case "setdate": XT = 1 Case "setenviron": XT = 1 Case "setmouse": XT = 1 Case "settime": XT = 1 Case "sgn": XT = 1 Case "shared": XT = 2 Case "shell": XT = 1 Case "shl": XT = 1 Case "short": XT = 3 Case "shr": XT = 1 Case "sin": XT = 1 Case "single": XT = 3 Case "sizeof": XT = 1 Case "sleep": XT = 1 Case "space": XT = 1 Case "spc": XT = 1 Case "sqr": XT = 1 Case "static": XT = 2 Case "stdcall": XT = 1 Case "step": XT = 2 Case "stop": XT = 1 Case "str": XT = 1 Case "string": XT = 3 Case "strptr": XT = 1 Case "sub": XT = 1 Case "system": XT = 1 End Select Case "t" Select Case Lcase(V_Data) Case "tab": XT = 1 Case "tan": XT = 1 Case "then": XT = 1 Case "this": XT = 2 Case "threadcreate": XT = 1 Case "threadwait": XT = 1 Case "time": XT = 1 Case "timer": XT = 1 Case "timeserial": XT = 1 Case "timevalue": XT = 1 Case "to": XT = 2 Case "trans": XT = 1 Case "trim": XT = 1 Case "type": XT = 1 End Select Case "u" Select Case Lcase(V_Data) Case "ubound": XT = 1 Case "ubyte": XT = 3 Case "ucase": XT = 1 Case "uinteger": XT = 3 Case "ulong": XT = 3 Case "ulongint": XT = 3 Case "undef": XT = 2 Case "union": XT = 2 Case "unlock": XT = 2 Case "unsigned": XT = 2 Case "using": XT = 2 Case "until": XT = 1 Case "ushort": XT = 3 End Select Case "v" Select Case Lcase(V_Data) Case "va_arg": XT = 1 Case "va_first": XT = 1 Case "va_next": XT = 1 Case "val": XT = 1 Case "val64": XT = 1 Case "valint": XT = 1 Case "vallng": XT = 1 Case "valuint": XT = 1 Case "valulng": XT = 1 Case "var": XT = 1 Case "varptr": XT = 1 Case "view": XT = 1 End Select Case "w" Select Case Lcase(V_Data) Case "wait": XT = 1 Case "wbin": XT = 1 Case "wchr": XT = 1 Case "weekday": XT = 1 Case "weekdayname": XT = 1 Case "whex": XT = 1 Case "while": XT = 1 Case "wend": XT = 1 Case "width": XT = 1 Case "window": XT = 1 Case "windowtitle": XT = 1 Case "winput": XT = 1 Case "with": XT = 1 Case "woct": XT = 1 Case "write": XT = 1 Case "wspace": XT = 1 Case "wstr": XT = 1 Case "wstring": XT = 3 End Select Case "x" Select Case Lcase(V_Data) Case "xor": XT = 1 End Select Case "y" Select Case Lcase(V_Data) Case "yeah": XT = 1 End Select Case "z" Select Case Lcase(V_Data) Case "zstring": XT = 1 End Select End Select Select Case XT Case 1: Return "<span class=""ca"">" & Ucase(Left(V_Data, 1)) & Lcase(Mid(V_Data, 2)) & "</span>" Case 2: Return "<span class=""cb"">" & Ucase(Left(V_Data, 1)) & Lcase(Mid(V_Data, 2)) & "</span>" Case 3: Return "<span class=""cc"">" & Ucase(Left(V_Data, 1)) & Lcase(Mid(V_Data, 2)) & "</span>" Case 4: Return "<span class=""cd"">" & Ucase(V_Data) & "</span>" Case 5: Return "<span class=""ce"">" & Ucase(V_Data) & "</span>" Case Else: Return V_Data End Select End Function '############################################################################################################## Function F_CheckHex(V_Data As String) As Ubyte If Len(V_Data) <> 6 Then Return 0 For X As Ubyte = 1 To 6 Select Case Asc(Lcase(Mid(V_Data, X, 1))) Case Asc("0") To Asc("9"), Asc("a") To Asc("f") Case Else: Return 0 End Select Next Return 1 End Function
