ایجاد یک لیست از کلمات کلیدی و تشخیص آن در متن

با سلام.

من یکسری کلمات کلیدی رو به آرایه دادم و روش من برای تشخیص وجود اون کلمه کلیدی در متن اصلی استفاده از حلقه بوده آیا روش ساده تری هم وجود داره البته من از طریق LINQ نتونستم با آرایه به نتیجه برسم.

    Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

        For Each Word As String In KeyWords

            If Value.ToUpper.CompareTo(Word) = 0 Then

                Value = Word

                Return True

            End If

        Next

        Return False

    End Function

روش دوم استفاده از فیلتر بود به اینصورت که اصولی نیست:

 Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

        Dim Expr() As String = Filter(KeyWords, Value.ToUpper, True, CompareMethod.Binary)

        If Expr.Length > 0 Then

            Value = Expr(0)

            Return True

        End If

        Return False

    End Function

سلام و روز خوش
اگر آرایه رو به لیست تبدیل کنین (با متد tolist) بعد میتونین با contains چک کنین.

Function ISKeyWord(ByRef Value As String) As Boolean

	Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

	Return KeyWords.ToList.Contains(Value)

End Function

یادم نبود؛
بجای این که کلمات رو در آرایه بریزین و بعد به لیست تبدیل کنین،مستقیما هم میتونین لیست رو initialize کنین:

Function ISKeyWord(ByRef Value As String) As Boolean

    Dim KeyWords As New List(Of String)({"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"})

    Return KeyWords.Contains(Value)

End Function

خوبه دستت درد نکنه.
ی موردی که هست من می خوام مقدار ورودی Value ارجاع داده بشه به متغیر و نیاز دارم که نحوه نوشتاری کلمه (بزرگی و کوچکی حروف) رو پس بگیرم تا اگه کاربر هر نوشتاری داشته برگرده به حالت نوشتاری لیست.
این که می شه از لیست استفاده کرد مناسبه و فکر کنم از متد ToList از آرایه برای استفاده از LINQ بشه نتیجه مطلوب رو گرفت که کلمه کلیدی اصلی هم ارجاع داده بشه.

ممنون.

بله، چون contains به کوچک/بزرگ بودن حساس هست (case sensitive) ، میشه تابع رو به شکل زیر اصلاح کنین:

Dim KeyWords As New List(Of String)({"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"})

Function ISKeyWord(ByRef Value As String, Optional CaseSensitive As Boolean = False) As Boolean

    If CaseSensitive Then

        Return KeyWords.Contains(Value)

    Else

        Return KeyWords.ConvertAll(Function(KW) KW.ToUpper).Contains(Value.ToUpper)

    End If

End Function

البته اگه همیشه مطمئن هستین که همه المانهای لیست uppercase هست دیگه نیازی به ConvertAll(Function(KW) KW.ToUpper) نیست.

ضمیمه 154069

برای اینکه موضوع روشن بشه بیشتر توضیح می دم:

1- با زدن کلید Space از صفحه کلید کلمه ای که کاربر نوشته قبل از درج فاصله در متن چک می شه که در اینجا از تابع LastWord استفاده شده یعنی آخرین کلمه از کل متن: و همچنین متغیر QueryText یک رشته است که کل متن رو در بر می گیره و LastWord d یک Extension Method برای String هست.

 

Select Case Key.Key

                                    Case ConsoleKey.Spacebar

                                        LastWord = QueryText.LastWord

                                        CurrentPos = Console.CursorLeft

                                        If ISKeyWord(LastWord) = True Then

                                            Console.CursorLeft = (CurrentPos - LastWord.Length)

                                            Console.ForegroundColor = ConsoleColor.Blue

                                            Console.Write("{0}", LastWord)

                                            Console.ResetColor()

                                        End If

                                End Select

2- این هم تابع LastWord که آخرین کلمه از متن رو برمی گردونه:

 

    <Extension()> Function LastWord(str As String) As String

        If str.EndsWith(Space(1)) = True Then Return ""

        Dim spl() As String = str.Split(Space(1))

        If spl.Length > 0 Then

            Return spl(spl.Length - 1)

        End If

        Return ""

    End Function

3- بعد از گرفتن آخرین کلمه از متن با تابع ISKeyWord چک می کنیم که این کلمه در کلمات کلیدی وجود داره یا نه اگر وجود داشته مقدار True رو بر می گردونه و چیزی که خواسته دیگه از این تابع هست برگردوندن مقدار اصلی کلمه کلیدی که در آرایه قرار داره برای همین هم متغیر LastWord که به ورودی تابع ISKeyWord داده شده از ونجایی که این ورودی ByRef تعریف شده مقدارش در خود تابع IsKeyWord تغییر می کنه چرا که باید جایگزین کلمه آخر از متن بشه و نحوه نوشتاری اون به شکل کلمه کلیدی اصلی زبان مورد نظر بشه و مطمئنا رنگ هم بگیره البته این در کنسول اپ هست (به فرض مثال SQL.)

 

  Select Case Key.Key

                                    Case ConsoleKey.Spacebar

                                        LastWord = QueryText.LastWord

                                        CurrentPos = Console.CursorLeft

                                        If ISKeyWord(LastWord) = True Then

                                            Console.CursorLeft = (CurrentPos - LastWord.Length)

                                            Console.ForegroundColor = ConsoleColor.Blue

                                            Console.Write("{0}", LastWord)

                                            Console.ResetColor()

                                        End If

                                End Select

 Console.Write(Key.KeyChar)

                                QueryText += Key.KeyChar

                                GoTo ReadKey

4- این هم تابع ISKeyWord که از دستور LINQ برای جستجوی کلمه در لیست استفاده می کنه که بنظرم همون حلقه fOR Each...Next ساده تر از این باشه:

 

    Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() As String = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}





        Dim MyWord As String = Value

        Dim Words = From Word In KeyWords Where String.Compare(Word, MyWord, True) = 0





        If Words.Count > 0 Then

            Value = Words.First

            Return True

        End If

        Return False

    End Function

مشکلی که کد من داشت و نمی تونستم از linq استفاده کنم این بود که حواسم به نسخه dotnet نبود و ریفرنس linq رو اضافه نکرده بودم.
و مهم برای من مقدار دادن به ورودی Value هم بود با وجود اینکه می خواستم کدش ساده تر باشه اما بنظر همون حلقه For Each...Next بهتر بود.

 

  Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

        For Each Word As String In KeyWords

            If Value.ToUpper.CompareTo(Word) = 0 Then

                Value = Word

                Return True

            End If

        Next

        Return False

    End Function

که مشکل دیگه ای که وجود داشت در استفاده از LINQ ورودی Value رو چون ByRef بود قبول نمی کرد. و بنظر همون دستور اول بهتر بود:

ضمیمه 154070

آخرین تغییرات در LastWord Extension Method:
با این تغیییرات اگر متن خط به خط نوشته شده باشه هم پشتیبانی می شه که توی پست قبل ناقص هست.

 

 <Extension()> Function LastWord(str As String) As String

        If str.EndsWith(Space(1)) = True Then Return ""

        Dim Lines() As String = str.Split(Chr(10), Chr(13))

        If Lines.Length = 0 Then Return ""

        Dim spl() As String = Lines(Lines.Length - 1).Split(Space(1))

        If spl.Length > 0 Then

            Return spl(spl.Length - 1)

        End If

        Return ""

    End Function

بسیار عالی!

در کد تابع lastword یک موردی هست:

<Extension()> Function LastWord(str As String) As String

    If str.EndsWith(Space(1)) = True Then Return ""

    Dim spl() As String = str.Split(Space(1))

    If spl.Length > 0 Then

        Return spl(spl.Length - 1)

    End If

    Return ""

End Function

اگر در str بجای یک space ، چند تا پشت سر هم باشه و یا بین wordها از tab یا crlf استفاده شده باشه،
دیگه نمیشه از str.split(space(1)) استفاده کرد چون درست تشخیص نمیده.

گذشته از این، اگر str خودش شامل یک یا چند string درون "" یا '' باشه که داخل اون space باشه باز هم مشکل داریم.

من یک نمونه درست کردم که مشکل رو نشون بده:

Dim spl() As String = TB1.Text.Split(Space(1))

ListBox1.Items.Clear()

For i As Integer = 0 To UBound(spl)

    ListBox1.Items.Add(spl(i))

Next

ListBox1.Items.Add("---END---")

ضمیمه 154082

سلام
با استفاده از ریجکس می توان تمام حروف و کلمات موجود در متن مورد نظر را تبدیل به یک لیست نمود.

Dim rgx As Regex = New Regex("\w+")

        Dim words = rgx.Matches(TextBox1.Text).

            Cast(Of Match)().

            Select(Function(a) a.Value.ToLowerInvariant()).

            GroupBy(Function(b) b).

            Select(Function(c) c.Key).ToList()

نقل قول:

---

نوشته شده توسط 336699

سلام
با استفاده از ریجکس می توان تمام حروف و کلمات موجود در متن مورد نظر را تبدیل به یک لیست نمود.

Dim rgx As Regex = New Regex("\w+")

        Dim words = rgx.Matches(TextBox1.Text).

            Cast(Of Match)().

            Select(Function(a) a.Value.ToLowerInvariant()).

            GroupBy(Function(b) b).

            Select(Function(c) c.Key).ToList()

---

سلام و روز خوش
این پترن برای اینکار خیلی ابتدایی هست و فقط wordهایی رو تشخیص میده که alphanumeric باشن.
در حالت کلی بطور عام و دست کم برای این مسئله بطور خاص جوابگو نیست.
پترن(های) بمراتب پیچیده تری نیاز هست برای تشخیص عبارت های درون ' یا " و همینجور () و [] و کارآکترهایی نظیر @!%$#* و شاید چند بار باید پروسس بشه.
چیزی که رستم خان نیاز داره در حد یک parser باید باشه.

نقل قول:

---

نوشته شده توسط mazoolagh

سلام و روز خوش
این پترن برای اینکار خیلی ابتدایی هست و فقط wordهایی رو تشخیص میده که alphanumeric باشن.
در حالت کلی بطور عام و دست کم برای این مسئله بطور خاص جوابگو نیست.
پترن(های) بمراتب پیچیده تری نیاز هست برای تشخیص عبارت های درون ' یا " و همینجور () و [] و کارآکترهایی نظیر @!%$#* و شاید چند بار باید پروسس بشه.
چیزی که رستم خان نیاز داره در حد یک parser باید باشه.

---

There is no silver bullet

هیچ محصول یا روش یا ترفندی وجود ندارد که بتواند نتایج موفقیت آمیز را تضمین کند.

خب میدونیم که برای این مسئله از قبل پاسخ داریم که در همین محیط QUERY EDITOR برنامه MSSQLMS (و مشابه اون) پیاده شده.
چیزی که هست اینه که پاسخ مد نظر آقای ROSTAM2 پیچیده تر از یک split یا regex ساده است.

ولی حتی با یک پترن دیگه میشه خیلی نتایج بهتری گرفت،
و این که باید هر چه که درون ' ' یا [ ] هست از پردازش کنار گذاشته بشه.

سر فرصت یک نمونه میگذارم و حیف است که این تاپیک همینجا رها بشه.

در ادامه بحث و این که چجوری باید از regex در این پرسش استفاده کرد؛

ابتدا باید بخشهایی رو که نباید پردازش بشن کنار بگذاریم:
1- کامنت ها

USE Nwind; -- SINGLE LINE COMMENT

/* MULILINE COMMENT LINE 1

MULTILINE COMMENT LINE 2 */

2- هر چه که درون ' ها (single quote) باشه یعنی stringها

N'John Smith'

'%s r%'

3- هر چه که درون " ها (double quote) باشه، البته اینها string نیستن ولی بعنوان جداکننده یا برای تعریف alias میتونن بکار برن

SELECT SUM(UnitsInStock) "Total Units In Stock" FROM Products

SELECT ProductID, "ProductName" AS "Product Name" FROM Products

4- هر چه که درون [] باشه

SELECT SUM(UnitsInStock) [Total Units In Stock] FROM Products

SELECT ProductID, [ProductName] AS [Product Name] FROM Products

برای شناسایی هر یک از اینها یک پترن جدا مینویسیم:

Const pt1 As String = "--.*[^\r\n]"                 ' -- (Singleline Comment)

Const pt2 As String = "/\*((?:.|\s)*?)\*/"          ' /**/ (Multiline Comment)

Const pt3 As String = "[N]?'((?:.|\s)*?)'"          ' Single Quotes

Const pt4 As String = "\u0022((?:.|\s)*?)\u0022"    ' Double Quotes

Const pt5 As String = "\[((?:.|\s)*?)\]"            ' []

در مرحله بعد هر چه whitespace یعنی (tab, cr, lf, space)در اینها باشه یا یک کارآکتر که مطمئنیم در هیچ کد SQL دیده نمیشود جایگزین میکنیم (در اینجا ChrW(&HFFFD))

Const Pattern_Ignore = pt1 + "|" + pt2 + "|" + pt3 + "|" + pt4 + "|" + pt5

Dim strSQL As String = TB_Source.Text

Dim strMOD As String = strSQL

For Each m As Match In Regex.Matches(strMOD, Pattern_Ignore, RegexOptions.Multiline)

    strMOD = strMOD.Remove(m.Index, m.Length)

    strMOD = strMOD.Insert(m.Index, FillWhiteSpaces(m.Value))

Next





Function FillWhiteSpaces(str As String) As String

    Return Regex.Replace(NZ(str), "\s", ChrW(&HFFFD))

End Function





Private Function NZ(str As String) As String

    If String.IsNullOrEmpty(str) Then

        Return String.Empty

    Else

        Return str

    End If

End Function

در گام بعدی در چپ و راست کارآکترهایی مثل () و اپراتورها (مثل = * / + و ...) یک space اضافه میکنیم تا مطمئن باشیم هیچ کلمه ای به اینها چسبیده نباشد

Dim x As List(Of Char) = "(),;!=<>+-*/%^|&~".ToList

For Each c In x

    strMOD = strMOD.Replace(c, Blank + c + Blank)

Next

بعد همه spaceهای اضافه رو پاک میکنیم

strMOD = Regex.Replace(strMOD, "\s", Blank)

strMOD = Regex.Replace(strMOD, "[  ]{2,}", Blank)

تازه الان هست که میتونیم کد رو split کنیم

Dim Words As List(Of String) = strMOD.Trim.Split(Blank).ToList

با این فرض که از پیش لیست کلمات کلیدی رو در SQL_KeyWords تعریف کردیم
و همچنین این موضوع که keywordهای SQL میتونن فقط شامل حرف یا _ یا @ باشن (تا اونجایی که من میدونم همینها هست، اگر چیز دیگه ای هم هست یادآوری کنین)

For Each word In Words

    If Regex.IsMatch(word, "^[a-zA-Z_@]+$") Then

        LB_Words.Items.Add(word)

        If SQL_KeyWords.Contains(word.ToUpper) Then

            LB_Keywords.Items.Add(word)

        End If

    End If

Next

Imports System.Text.RegularExpressions

Public Class UsingRegEx

    Const Blank As Char = ChrW(32)

    Const pt1 As String = "--.*[^\r\n]"                 ' -- (Singleline Comment)

    Const pt2 As String = "/\*((?:.|\s)*?)\*/"          ' /**/ (Multiline Comment)

    Const pt3 As String = "[N]?'((?:.|\s)*?)'"          ' Single Quotes

    Const pt4 As String = "\u0022((?:.|\s)*?)\u0022"    ' Double Quotes

    Const pt5 As String = "\[((?:.|\s)*?)\]"            ' []

    Const Pattern_Ignore = pt1 + "|" + pt2 + "|" + pt3 + "|" + pt4 + "|" + pt5





    Private Sub Btn_Process_Click(sender As Object, e As EventArgs) Handles Btn_Process.Click

        LB_Words.Items.Clear()

        LB_Keywords.Items.Clear()

        Dim strSQL As String = TB_Source.Text

        Dim strMOD As String = strSQL

        For Each m As Match In Regex.Matches(strMOD, Pattern_Ignore, RegexOptions.Multiline)

            strMOD = strMOD.Remove(m.Index, m.Length)

            strMOD = strMOD.Insert(m.Index, FillWhiteSpaces(m.Value))

        Next

        TB_Modified.Text = strMOD

        'strMOD = Regex.Replace(strSQL, pattern, String.Empty)

        Dim x As List(Of Char) = "(),;!=<>+-*/%^|&~".ToList

        For Each c In x

            strMOD = strMOD.Replace(c, Blank + c + Blank)

        Next

        strMOD = Regex.Replace(strMOD, "\s", Blank)

        strMOD = Regex.Replace(strMOD, "[  ]{2,}", Blank)

        Dim Words As List(Of String) = strMOD.Trim.Split(Blank).ToList

        For Each word In Words

            If Regex.IsMatch(word, "^[a-zA-Z_@]+$") Then

                LB_Words.Items.Add(word)

                If SQL_KeyWords.Contains(word.ToUpper) Then

                    LB_Keywords.Items.Add(word)

                End If

            End If

        Next

    End Sub



    Function FillWhiteSpaces(str As String) As String

        Return Regex.Replace(NZ(str), "\s", ChrW(&HFFFD))

    End Function



    Private Function NZ(str As String) As String

        If String.IsNullOrEmpty(str) Then

            Return String.Empty

        Else

            Return str

        End If

    End Function

End Class

نمونه
ضمیمه 154123

البته این روش هم که در بالا آمد گرچه خطای خیلی کمی داره اما باز هم راه درستی نیست و بنوعی اختراع دوباره چرخ هست.
راه درست و قطعی رو هم خواهم گذاشت (در پست 11 اشاره کردم)

نقل قول:

---

نوشته شده توسط mazoolagh

Imports System.Text.RegularExpressions

Public Class UsingRegEx

    Const Blank As Char = ChrW(32)

    Const pt1 As String = "--.*[^\r\n]"                 ' -- (Singleline Comment)

    Const pt2 As String = "/\*((?:.|\s)*?)\*/"          ' /**/ (Multiline Comment)

    Const pt3 As String = "[N]?'((?:.|\s)*?)'"          ' Single Quotes

    Const pt4 As String = "\u0022((?:.|\s)*?)\u0022"    ' Double Quotes

    Const pt5 As String = "\[((?:.|\s)*?)\]"            ' []

    Const Pattern_Ignore = pt1 + "|" + pt2 + "|" + pt3 + "|" + pt4 + "|" + pt5





    Private Sub Btn_Process_Click(sender As Object, e As EventArgs) Handles Btn_Process.Click

        LB_Words.Items.Clear()

        LB_Keywords.Items.Clear()

        Dim strSQL As String = TB_Source.Text

        Dim strMOD As String = strSQL

        For Each m As Match In Regex.Matches(strMOD, Pattern_Ignore, RegexOptions.Multiline)

            strMOD = strMOD.Remove(m.Index, m.Length)

            strMOD = strMOD.Insert(m.Index, FillWhiteSpaces(m.Value))

        Next

        TB_Modified.Text = strMOD

        'strMOD = Regex.Replace(strSQL, pattern, String.Empty)

        Dim x As List(Of Char) = "(),;!=<>+-*/%^|&~".ToList

        For Each c In x

            strMOD = strMOD.Replace(c, Blank + c + Blank)

        Next

        strMOD = Regex.Replace(strMOD, "\s", Blank)

        strMOD = Regex.Replace(strMOD, "[  ]{2,}", Blank)

        Dim Words As List(Of String) = strMOD.Trim.Split(Blank).ToList

        For Each word In Words

            If Regex.IsMatch(word, "^[a-zA-Z_@]+$") Then

                LB_Words.Items.Add(word)

                If SQL_KeyWords.Contains(word.ToUpper) Then

                    LB_Keywords.Items.Add(word)

                End If

            End If

        Next

    End Sub



    Function FillWhiteSpaces(str As String) As String

        Return Regex.Replace(NZ(str), "\s", ChrW(&HFFFD))

    End Function



    Private Function NZ(str As String) As String

        If String.IsNullOrEmpty(str) Then

            Return String.Empty

        Else

            Return str

        End If

    End Function

End Class

---

سلام مجدد.
برای شناسایی Attribute ها برای سورس کد #C مخصوصا اونایی که مقدار رشته ای دارن و بینشون ممکنه فاصله باشه یا بدون فاصله باشه Pattern همین درسته؟

 Const pt5 As String = "\[((?:.|\s)*?)\]"            ' []

نقل قول:

---

نوشته شده توسط ROSTAM2

سلام مجدد.
برای شناسایی Attribute ها برای سورس کد #C مخصوصا اونایی که مقدار رشته ای دارن و بینشون ممکنه فاصله باشه یا بدون فاصله باشه Pattern همین درسته؟

 Const pt5 As String = "\[((?:.|\s)*?)\]"            ' []

---

سلام دوباره و روز خوش
من این پترن رو برای همین مسئله نوشتم و اگر عبارت بین [] ساده باشه باید جواب بده،
ولی بهتره همه حالتها رو تست کنین (چون خودم ممکنه مواردی در مورد اینها باشه که ندونم)،
و اگر مشکلی بود همینجا مطرح کنین تا پترن مناسب رو بنویسم.

نقل قول:

---

نوشته شده توسط mazoolagh

البته این روش هم که در بالا آمد گرچه خطای خیلی کمی داره اما باز هم راه درستی نیست و بنوعی اختراع دوباره چرخ هست.
راه درست و قطعی رو هم خواهم گذاشت (در پست 11 اشاره کردم)

---

خوب شد تاپیک بالا اومد.
من این رو همون وقت آماده کرده بودم ولی یادم رفت!
چند شات باید آماده کنم بعد همینجا میذارم.

نقل قول:

---

نوشته شده توسط mazoolagh

سلام دوباره و روز خوش
من این پترن رو برای همین مسئله نوشتم و اگر عبارت بین [] ساده باشه باید جواب بده،
ولی بهتره همه حالتها رو تست کنین (چون خودم ممکنه مواردی در مورد اینها باشه که ندونم)،
و اگر مشکلی بود همینجا مطرح کنین تا پترن مناسب رو بنویسم.

---

فکر کنم درست باشه این لیست یافته ها از این کد هست:

ضمیمه 154397
ضمیمه 154396

نقل قول:

---

نوشته شده توسط mazoolagh

خوب شد تاپیک بالا اومد.
من این رو همون وقت آماده کرده بودم ولی یادم رفت!
چند شات باید آماده کنم بعد همینجا میذارم.

---

آموزش: تفسیر و آنالیز سورس SQL با استفاده از Microsoft.SqlServer.TransactSql.ScriptDom (barnamenevis.org)

نقل قول:

---

نوشته شده توسط ROSTAM2

با سلام.

من یکسری کلمات کلیدی رو به آرایه دادم و روش من برای تشخیص وجود اون کلمه کلیدی در متن اصلی استفاده از حلقه بوده آیا روش ساده تری هم وجود داره البته من از طریق LINQ نتونستم با آرایه به نتیجه برسم.

    Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

        For Each Word As String In KeyWords

            If Value.ToUpper.CompareTo(Word) = 0 Then

                Value = Word

                Return True

            End If

        Next

        Return False

    End Function

روش دوم استفاده از فیلتر بود به اینصورت که اصولی نیست:

 Function ISKeyWord(ByRef Value As String) As Boolean

        Dim KeyWords() = {"FROM", "AS", "WHERE", "IS", "SELECT", "ALL"}

        Dim Expr() As String = Filter(KeyWords, Value.ToUpper, True, CompareMethod.Binary)

        If Expr.Length > 0 Then

            Value = Expr(0)

            Return True

        End If

        Return False

    End Function

---

بزار خیالت رو راحت کنم
اگر می خوای کلمات کلیدی رو با رنگ متمایز نشون بدی، از کامپوننت fastcoloredtextbox استفاده کن، راحته و سریع و زیبا و البته متن باز
البته من قبلا از همین روش استفاده می کردم و با عبارت با قاعده، کلمات کلیدی و ... رو رنگی می کردم ولی سرعت رو می آورد پایین.

سلام مجدد

من نیاز دارم که کاراکتر ` توی متن تشخیص بدم در اصل 3 تا کنارهم در ایتدا و 3 تا هم در انتهای بخشی از متن:

مثلا:

```
Hello World
```

lمن این کد رو دارم ولی شناسایی نمی کنه :

 Dim CodeMatch As New Regex("[\`]{3}\w+[\`]{3}")

redoCode: With CodeMatch.Matches(OutPut, 0)

            For I = 0 To .Count - 1

                With .Item(I)

                    If .Success = False Then Continue For

                 

                    Dim Expr As String = String.Format("<pre><code class='{1}'>{0}{2}{0}</code></pre>",

                                                       vbLf, "language-" + Language,

                                                       .Value.Substring(3, .Length - 6))





                    OutPut = OutPut.Remove(.Index, .Length)

                    OutPut = OutPut.Insert(.Index, Expr)

                    GoTo redoCode

                                  End With

            Next

        End With

این pattern برای زمانیه که اون 3 کاراکتر بعد از اولی و قبل از آخری newline دارند:

Dim CodeMatch As New Regex("[\`]{3}\n+(.*?)\n+[\`]{3}")

اما اگر newline ز هرکجایی حذف بشه جواب نمی ده

ضمیمه 156086

سلام دوباره
من یک آرایه دارم حاوی کلمات کلیدی ویژوال بیسیک:

Protected Friend Shared Keywords As String() = {"addhandler", "addressof", "alias", "and",

                                                    "andalso", "as", "boolean", "byref", "byte", "byval" _

, "call", "case", "catch", "cbool", "cbyte", "cchar", "cdate", "cdec", "cdbl", "char", "cint", "class" _

, "clng", "cobj", "const", "continue", "csbyte", "cshort", "csng", "cstr", "ctype", "cuint", "culng" _

, "cushort", "date", "decimal", "declare", "default", "delegate", "dim", "directcast", "do", "double" _

, "each", "else", "elseif", "end", "endif", "enum", "erase", "error", "event", "exit", "false", "finally" _

, "for", "friend", "function", "get", "gettype", "getxmlnamespace", "global", "gosub", "goto", "handles", "if" _

, "implements", "imports", "in", "inherits", "integer", "interface", "is", "isnot", "let", "lib", "like" _

, "long", "loop", "me", "mod", "module", "mustinherit", "mustoverride", "mybase", "myclass", "namespace" _

, "narrowing", "new", "next", "not", "nothing", "notinheritable", "notoverridable", "object", "of" _

, "on", "operator", "option", "optional", "or", "orelse", "overloads", "overridable", "overrides" _

, "paramarray", "partial", "private", "property", "protected", "public", "raiseevent", "readonly" _

, "redim", "removehandler", "resume", "return", "sbyte", "select", "set", "shadows", "shared" _

, "short", "single", "static", "step", "stop", "string", "structure", "sub", "synclock", "then", "throw" _

, "to", "true", "try", "trycast", "typeof", "variant", "wend", "uinteger", "ulong", "ushort", "using" _

, "when", "while", "widening", "with", "withevents", "writeonly", "xor", "#const", "#else", "#elseif" _

, "#end", "#if", "aggregate", "ansi", "assembly", "auto", "binary", "compare", "custom", "distinct" _

, "equals", "explicit", "from", "group", "by", "join", "into", "isfalse", "istrue", "key" _

, "mid", "off", "order", "preserve", "skip", "strict", "take", "text", "unicode" _

, "until", "where", "#externalsource", "#region", "region", "ushort", "uint16", "uint64", "uint32", "int16" _

, "int64", "int32", "datetime", "infer", "type", "my"}

حالا با این کدی همه کلمات طبق فاصله گذاری چک می شه امل کلماتی که قبلشون یا بعدشون پرانتز داره رو تشخیص نمی ده:

  Private Shared KeywordMatch As New Regex("\b(\S+)\s?") '\b(\S+)\s?

    Shared Sub Highlight(ByRef Expression As String)

        Dim Expr As String = Expression

        Dim X, Start As Integer

        Start = 0

Restart: With KeywordMatch.Matches(Expr, Start)

            For X = 0 To .Count - 1

                With .Item(X)

                    If Keywords.Contains(.Value.Trim.ToLower) Then

                        Dim Value As String = String.Format("<kw>{0}</kw>", StrConv(.Value, VbStrConv.ProperCase))

                        Expr = Expr.Remove(.Index, .Length)

                        Expr = Expr.Insert(.Index, Value)

                        Start = .Index + Value.Length

                        GoTo Restart

                    End If

                End With

            Next

        End With

        Expression = Expr

    End Sub

با رنگ زرد مشخص شده تو تصویرو....

ضمیمه 156090

توی کدی که من در نرم افزار دارم کاراکترهای <> برای تگ ها بعنوان تگ شناخته شده که فکر کنم باید از این روش استفاده کنم که درست نمایش داده بشن:

css - How can I put "< >" as a text in HTML? - Stack Overflow

حالا درست شد:

ضمیمه 156091

مشکل کلمات پرانتزدار هم رفع شد مطمئن نیستم پترن درستی باشه و لی درست عمل می کنه

Shared Sub Highlight(ByRef Expression As String)        Dim Expr As String = Expression

        Dim X, Start As Integer, newValue As String

        Start = 0

Restart: With KeywordMatch.Matches(Expr, Start)

            For X = 0 To .Count - 1

                With .Item(X)

                    newValue = If(.Value.EndsWith(")"), .Value.Remove(.Value.Length - 1, 1), .Value)

                    newValue = If(newValue.StartsWith("("), newValue.Remove(0, 1), newValue)





                    If Keywords.Contains(newValue.Trim.ToLower) Then





                        Dim Value As String = String.Format("<kw>{0}</kw>{1}",

                                                            StrConv(newValue, VbStrConv.ProperCase),

                                                            If(.Value.EndsWith(")"), ")", ""))

                        If .Value.StartsWith("(") Then Value = Value.Insert(0, "(")

                        Expr = Expr.Remove(.Index, .Length)

                        Expr = Expr.Insert(.Index, Value)

                        Start = .Index + Value.Length

                        GoTo Restart

                    End If

                End With

            Next

        End With

        Expression = Expr

    End Sub

ضمیمه 156092

کد شناسایی توضیحات در زبان ویژوال بیسیک برای Htghlight

  Protected Friend Shared CommentMatch As New Regex("[\']((?:.|\s)*?)(\u0022|\n+)")

    Protected Friend Shared RemMatch As New Regex("(Rem|rem|REM)\s+((?:.|\s)*?)(\u0022|\n+)")





    Protected Friend Shared Sub HighlightComments(ByRef Expression As String)

        Dim Expr As String = Expression





        Dim Start As Integer = 0, newValue As String

Restart: With CommentMatch.Matches(Expr, Start)

            For i = 0 To .Count - 1

                With .Item(i)

                    newValue = If(.Value.StartsWith(")"), .Value.Remove(0, 1), .Value)

                    newValue = newValue.Replace("<kw>", "").Replace("</kw>", "")

                    newValue = newValue.Replace("<str>", "").Replace("</str>", "")

                    Dim Value As String = String.Format("{1}<cm>{0}</cm>",

                        newValue,

                        If(.Value.StartsWith(")"), ")", ""))





                    Expr = Expr.Remove(.Index, .Length)

                    Expr = Expr.Insert(.Index, Value)

                    Start = .Index + Value.Length

                    GoTo Restart

                End With

            Next

        End With

        Start = 0

Restart2: With RemMatch.Matches(Expr, Start)

            For i = 0 To .Count - 1

                With .Item(i)

                    newValue = If(.Value.StartsWith(")"), .Value.Remove(0, 1), .Value)

                    newValue = newValue.Replace("<kw>", "").Replace("</kw>", "")

                    newValue = newValue.Replace("<cm>", "").Replace("</cm>", "")

                    newValue = newValue.Replace("<str>", "").Replace("</str>", "")

                    Dim Value As String = String.Format("{1}<cm>{0}</cm>",

                        newValue,

                        If(.Value.StartsWith(")"), ")", ""))





                    Expr = Expr.Remove(.Index, .Length)

                    Expr = Expr.Insert(.Index, Value)

                    Start = .Index + Value.Length

                   

                    GoTo Restart2

                End With

            Next

        End With

        Expression = Expr

    End Sub

کد شناسایی و Highlight زبان ویژوال بیسیک:

  Protected Friend Shared Keywords As String() = {"addhandler", "addressof", "alias", "and",

                                                    "andalso", "as", "boolean", "byref", "byte", "byval" _

, "call", "case", "catch", "cbool", "cbyte", "cchar", "cdate", "cdec", "cdbl", "char", "cint", "class" _

, "clng", "cobj", "const", "continue", "csbyte", "cshort", "csng", "cstr", "ctype", "cuint", "culng" _

, "cushort", "date", "decimal", "declare", "default", "delegate", "dim", "directcast", "do", "double" _

, "each", "else", "elseif", "end", "endif", "enum", "erase", "error", "event", "exit", "false", "finally" _

, "for", "friend", "function", "get", "gettype", "getxmlnamespace", "global", "gosub", "goto", "handles", "if" _

, "implements", "imports", "in", "inherits", "integer", "interface", "is", "isnot", "let", "lib", "like" _

, "long", "loop", "me", "mod", "module", "mustinherit", "mustoverride", "mybase", "myclass", "namespace" _

, "narrowing", "new", "next", "not", "nothing", "notinheritable", "notoverridable", "object", "of" _

, "on", "operator", "option", "optional", "or", "orelse", "overloads", "overridable", "overrides" _

, "paramarray", "partial", "private", "property", "protected", "public", "raiseevent", "readonly" _

, "redim", "removehandler", "resume", "return", "sbyte", "select", "set", "shadows", "shared" _

, "short", "single", "static", "step", "stop", "string", "structure", "sub", "synclock", "then", "throw" _

, "to", "true", "try", "trycast", "typeof", "variant", "wend", "uinteger", "ulong", "ushort", "using" _

, "when", "while", "widening", "with", "withevents", "writeonly", "xor", "#const", "#else", "#elseif" _

, "#end", "#if", "aggregate", "ansi", "assembly", "auto", "binary", "compare", "custom", "distinct" _

, "equals", "explicit", "from", "group", "by", "join", "into", "isfalse", "istrue", "key" _

, "mid", "off", "order", "preserve", "skip", "strict", "take", "text", "unicode" _

, "until", "where", "#externalsource", "#region", "region", "ushort", "uint16", "uint64", "uint32", "int16" _

, "int64", "int32", "datetime", "infer", "type", "my"}

   Private Shared KeywordMatch As New Regex("\b([\w\d]+|[\w\d]+\s)") '/[\w\d]+/ '\b(\S+)\s? ' \G\(\d\) '\b(\w+\(*?)|(\S+)(\)?|\s?)

    Shared Sub Highlight(ByRef Expression As String)

        Dim Expr As String = Expression

        Dim X, Start As Integer, newValue As String

        Start = 0

Restart: With KeywordMatch.Matches(Expr, Start)

            For X = 0 To .Count - 1

                With .Item(X)

                    If .Success = False Then Continue For

                    ' newValue = If(.Value.EndsWith(")"), .Value.Remove(.Value.Length - 1, 1), .Value)

                    ' newValue = If(newValue.StartsWith("("), newValue.Remove(0, 1), newValue)

                    newValue = .Value

                    If Keywords.Contains(newValue.Trim.ToLower) Then





                        Dim Value As String = String.Format("<kw>{0}</kw>",

                                                            StrConv(newValue, VbStrConv.ProperCase),

                                                            If(.Value.EndsWith(")"), ")", ""))

                        'If .Value.StartsWith("(") Then Value = Value.Insert(0, "(")

                        Expr = Expr.Remove(.Index, .Length)

                        Expr = Expr.Insert(.Index, Value)

                        Start = .Index + Value.Length

                        GoTo Restart

                    End If

                End With

            Next

        End With

        Expression = Expr

    End Sub

    Protected Friend Shared CommentMatch As New Regex("\'[^\n\r]+(?:[\n\r]|\*\))") '("[\']((?:.|\s)*?)(\u0022|\n+)")

    Protected Friend Shared RemMatch As New Regex("(Rem|rem|REM)\s+((?:.|\s)*?)(\u0022|\n+)")





    Protected Friend Shared Sub HighlightComments(ByRef Expression As String)

        Dim Expr As String = Expression

        'CommentMatch = New Regex(MainForm.ToolStripTextBox1.Text)

        Dim Start As Integer = 0, newValue As String

Restart: With CommentMatch.Matches(Expr, Start)

            For i = 0 To .Count - 1

                With .Item(i)

                    If .Success = False Then Continue For

                    If .Value.Contains("<str>") = False AndAlso .Value.Contains("</str>") = True Then

                        Dim index As Integer = InStrRev(Expr, vbNewLine, .Index)

                        If index > 0 Then

                            Dim v As String = Expr.Substring(index, .Index - index)

                            If v.Contains("<str>") Then Continue For

                        End If

                    End If

                    newValue = .Value.Replace("<kw>", "").Replace("</kw>", "")

                    newValue = newValue.Replace("<str>", "").Replace("</str>", "")

                    Dim Value As String = String.Format("<cm>{0}</cm>",

                        newValue)





                    Expr = Expr.Remove(.Index, .Length)

                    Expr = Expr.Insert(.Index, Value)

                    Start = .Index + Value.Length

                    GoTo Restart

                End With

            Next

        End With

        Start = 0

Restart2: With RemMatch.Matches(Expr, Start)

            For i = 0 To .Count - 1

                With .Item(i)

                    If .Success = False Then Continue For

                    If .Value.Contains("<str>") = False AndAlso .Value.Contains("</str>") = True Then

                        Dim index As Integer = InStrRev(Expr, vbNewLine, .Index)

                        If index > 0 Then

                            Dim v As String = Expr.Substring(index, .Index - index)

                            If v.Contains("<str>") Then Continue For

                        End If

                    End If

                    newValue = .Value.Replace("<kw>", "").Replace("</kw>", "")

                    newValue = newValue.Replace("<cm>", "").Replace("</cm>", "")

                    newValue = newValue.Replace("<str>", "").Replace("</str>", "")

                    Dim Value As String = String.Format("<cm>{0}</cm>",

                        newValue)





                    Expr = Expr.Remove(.Index, .Length)

                    Expr = Expr.Insert(.Index, Value)

                    Start = .Index + Value.Length





                    GoTo Restart2

                End With

            Next

        End With

        Expression = Expr

    End Sub

کد شناسایی رشته (متن) برای highlight

  Protected Friend Shared StringsMatch As New Regex("\u0022((?:.|\s)*?)\u0022") '(")([\s\S]+)(")

    Protected Friend Shared Sub HighLightStrings(ByRef Expression As String) 

        Dim Expr As String = Expression

        Dim Start As Integer = 0, newValue As String

Restart: With StringsMatch.Matches(Expr, Start)

            For i = 0 To .Count - 1

                With .Item(i)

                    newValue = If(.Value.EndsWith(")"), .Value.Remove(.Value.Length - 1, 1), .Value)

                    newValue = If(newValue.StartsWith("("), newValue.Remove(0, 1), newValue)

                    newValue = newValue.Replace("<kw>", "").Replace("</kw>", "")

                    newValue = newValue.Replace("<cm>", "").Replace("</cm>", "")

                    newValue = newValue.Replace("<str>", "").Replace("</str>", "")

                    Dim Value As String = String.Format("<str>{0}</str>{1}",

                        newValue,

                        If(.Value.EndsWith(")"), ")", ""))

                    If .Value.StartsWith("(") Then Value = Value.Insert(0, "(")

                    Expr = Expr.Remove(.Index, .Length)

                    Expr = Expr.Insert(.Index, Value)

                    Start = .Index + Value.Length

                    GoTo Restart

                End With

            Next

        End With

        Expression = Expr

    End Sub

کد تبدیل markdown به HTML که فعلا فقط برای قسمت کد از زبان ویژوال بیسیک نوشتمش:

Protected Friend Shared ContentList As New List(Of String)



    Private Shared CodeMatch As New Regex("[\`]{3}\w+\n+([\s\S]+)\n+[\`]{3}")

    Protected Friend Shared Function Markdown2HTML(ByVal Expression As String) As String

        Dim Output As String = Expression.Replace("<", "&lt;").Replace(">", "&gt;")

        Dim Start As Integer = 0, Value, Language, Code As String

        ContentList.Clear()

redoCode: With CodeMatch.Matches(Output, Start)

            For I = 0 To .Count - 1

                With .Item(I)

                    If .Success = False Then Continue For

                    If I = 0 Then

                        Value = Output.Substring(Start, .Index)

                        If .Index > 0 And Value.Length > 0 Then

                            ' As MarkdownText....

                            ContentList.Add(Value.Replace(Space(1), "&nbsp;").

                                            Replace(vbLf, "<br>"))

                        End If

                    End If

                    ' As Code....

                    Dim Index As Integer = InStr(3, .Value, vbLf, CompareMethod.Binary)

                    If Index > 0 Then

                        Language = .Value.Substring(3, (Index - 3) - 1)

                        Code = .Value.Substring((3 + Language.Length) + 1, .Length - (6 + Language.Length + 1))

                        Select Case Language.ToLower

                            Case "vb", "vbnet", "vb.net", "visualbasic"

                                VisualBasic.Highlight(Code)

                            Case Else





                        End Select





                        Dim Expr As String = String.Format("<pre><code>{1}</code></pre>",

                                                           vbLf,

                                                           Code)

                        VisualBasic.HighlightComments(Expr)

                        SharedHighlight.HighLightStrings(Expr)

                        Expr = Expr.Replace(Space(1), "&nbsp;").Replace(vbLf, "<br>")

                        Start = .Index + .Length





                        ContentList.Add(Expr)

                    Else

                        Start = .Index + .Length

                    End If

                    GoTo redoCode

                End With

            Next

        End With

        If Start < Output.Length - 1 Then

            ContentList.Add(Output.Substring(Start).

                            Replace(Space(1), "&nbsp;").

                            Replace(vbCrLf, "<br>"))

        End If

        Return Join(ContentList.ToArray, "")

    End Function

نمونه:
ضمیمه 156104

سلام مجدد

من برای پترن کدها مشکل پیدا کردم

[\`]{3}([\w+\n|\n]+)([\s\S]+)\n+[\`]{3}\n+

همه رو با هم در یک آیتم پیدا می کنه
ضمیمه 156151

پسداش کردم و فکر کنم درست باشه:

```(?:(\w+|\s))([\s\S]*?)```

ضمیمه 156152

این یک نمونه مقاله نوشته شده در نرم افزار من: (Code Library)

متنش:

##VB .Net: Get Processor ID

Hi there....

For make software Activation-code we need A unique ID Like CPU(Processor)-ID

**Reference:**
```vb
System.Management
```
**Namespaces:**
```vb
Imports System.Management
Imports Microsoft.Win32
```
**GetProcessInfo() Method:**
```vb
Private Sub GetProcInfo()
Dim wmi As ManagementClass
Dim Mobjs As ManagementObjectCollection
Dim CPUID As String
Dim CPUType As String
wmi = New ManagementClass("Win32_Processor")
Mobjs = wmi.GetInstances()
For Each Mobj As ManagementObject In Mobjs
CPUType = Mobj("Name")
Debug.WriteLine(CPUType.ToString)
CPUID = Mobj("ProcessorID")
Debug.WriteLine(CPUID.ToString)
Next
Mobjs.Dispose()
wmi.Dispose()
End Sub
```

[http://vbcity.com/forums/t/83343.asp.../t/83343.aspx)

تصویرش:
ضمیمه 156157
ضمیمه 156153
ضمیمه 156154

سلام مجدد

دستور تبدیل کلمات کلیدی یک زبان کدنویسی (کپی شده از صفحه وب) به عناصر آرایه :

نمونه کلمات کلیدی: Reserved Keywords (Transact-SQL) - SQL Server | Microsoft Learn

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        Dim List As New List(Of String)

        Dim spl As String() = Me.InputTextBox.Text.Split(" "c, vbNewLine)

        For Each word As String In spl

            If word.Trim.Length = 0 Then Continue For





            List.Add(String.Format("{0}{1}{0}", Chr(34), word.Trim))

        Next

        Me.RichTextBox2.Text =

       String.Format("Public {0}() As String = {{{1}}}", ArrayNameTextBox.Text, Join(List.ToArray, ", "))

    End Sub

ضمیمه 156381

دانلود سورس پروژه....

متود SetText برای ایجاد HylightSyntax بر اساس خط های RichtextBox.Lines:

Sub SetText(Value As String())

        Dim Expr As String = My.Resources.Blank_html

        With Me.WebBrowser1

            .DocumentText = My.Resources.Blank_html

            Do Until .ReadyState = WebBrowserReadyState.Complete

                Application.DoEvents()

            Loop

        End With

        For i = 0 To Value.Length - 1

            Dim V As String = Value(i).Trim

            HTMLReplacement(V)

            If LineIndent > 0 Then

                Select Case SelectedTabItem.Language

                    Case "C#‎‎‎‎‎‎‎‎", "C++‎‎‎‎‎‎‎‎", "C", "PHP", "TSQL", "SQL (MDX)"

                        If V.StartsWith("}") Then

                            LineIndent -= 1

                        End If

                    Case "VB"

                        For Each Item As String In EndKeyWordList

                            If V.ContainsKeywords(Item) Then

                                Debug.Print("Item: {0}", Item)

                                LineIndent -= 1

                                If Item = "End Select" Then LineIndent -= 1

                            End If

                        Next

                End Select

            End If

            If i = Value.Length - 1 Then LineIndent = 0



            Dim Value_ As String =

                    String.Format("{0}{1}",

                          StrDup((LineIndent), " "), V)

            If LineIndent >= 0 Then

                Select Case SelectedTabItem.Language

                    Case "C#‎‎‎‎‎‎‎‎", "C++‎‎‎‎‎‎‎‎", "C", "PHP", "TSQL", "SQL (MDX)"

                        If V.EndsWith("{") Then

                            LineIndent += 1

                        End If

                    Case "VB"

                        For Each Item As String In BeginKeyWordList

                            If V.ContainsKeywordsBut(ExcludeWord:="End", Item) Then

                                LineIndent += 1

                            End If

                        Next

                        For Each W As String In StartWithsKeywords

                            Select Case W

                                Case "If"

                                    If (V.StartsWith("If ",

                                           StringComparison.OrdinalIgnoreCase) = False Or

                                           V.StartsWith("If ",

                                           StringComparison.OrdinalIgnoreCase)) AndAlso

                                           V.EndsWith(" Then", StringComparison.OrdinalIgnoreCase) Then

                                        LineIndent += 1

                                    End If

                                    Continue For

                            End Select

                            If V.StartsWith(W) Then

                                LineIndent += 1

                            End If

                        Next



End Select

            End If



            Select Case SelectedTabItem.Language

                Case "VB"

                    VisualBasic.HighlightComments(Value_)

                    VisualBasic.Highlight(Value_)

                    SharedHighlight.HighLightStrings(Value_)

                Case "C#‎‎‎‎‎‎‎‎"

                    CSharp.Highlight(Value_)

                Case "C++‎‎‎‎‎‎‎‎"

                    CPP.Highlight(Value_)

                Case "C"

                    C.Highlight(Value_)

                Case "PHP"

                    PHP.Highlight(Value_)

                Case "HTML"

                Case "JavaScript"

                Case "TSQL"

                    TSQL.Highlight(Value_)

                Case "SQL (MDX)"

                    SQL.Highlight(Value_)

            End Select

            NewLine(i + 1, Value_)

        Next

    End Sub

متود ایجاد خط جدید Highlight شده در HTML:

Function NewLine(LineNumber As Integer, Text As String) As HtmlElement

        With Me.WebBrowser1.Document

            Dim LinesTable As HtmlElement = .GetElementById("Lines")

            Dim Row As HtmlElement = .CreateElement("tr")

            Dim TR As mshtml.HTMLTableRow = .CreateElement("tr").DomElement

            Dim TD As mshtml.HTMLTableCell = .CreateElement("td").DomElement

            TD.innerHTML = LineNumber.ToString

            TD.className = "Column1"

            TR.appendChild(TD)

            TD = .CreateElement("td").DomElement

            TD.innerHTML = Text

            TD.className = "Column2"

            TR.appendChild(TD)

            Row.InnerHtml = TR.innerHTML

            LinesTable.AppendChild(Row)

            Return Row

        End With

    End Function

کد سند HTML برای Htghlight Syntax در این نمونه:

<!DOCTYPE html>

<html>

<head>

<meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1" />

    <meta charset="utf-8" />

<style type="text/css">

body {margin:0;

    background-color: Black;

    opacity:;

      font-family: 'Source Code Pro';

    padding:0 0 5PX 0;

    margin: 0;

    

      }

          pre {

        color: snow;

        text-align: left;

        margin: 5px 0 0;

        padding: 10px ;

font-family: 'Source Code Pro';

        background-color: black !important;

    font-size: 14pt !important;

        white-space: normal;

        border-radius: 5px;

    } 

    code{

        font-family: 'Source Code Pro';

        padding: 0px;

        padding-left: 0px;

        margin: 0;

color: Honydew ;

    }

    kw{

        color: skyblue !important;

        font-weight: bold;

    }

    str{

    color: gold;    

    }

    /* comment */

    cm{

        color: greenyellow;

    }

    /* operator */

    op{

        color: lightpink;

            

    }

    prm {

        color: violet;

    }

    .Column1 {

        text-align: right;

        vertical-align: text-top;

                padding-right: 5px;

     border-right-width: thick;

     border-right-style: solid;

     border-right-color: chartreuse;

    }

    .Column2 {

        text-align: left;

        padding-left: 10px;

       }

    </style>





</head>

<body>

<pre>

<code>

 <table  width="100%" align="center" cellpadding="0" cellspacing="1" border="0" >

     <Col class="Column1" width="auto">

    <Col class="Column2" width="100%">

    <tbody id="Lines">



    </tbody>

 </table>

 </code>

 </pre>

      </body>

</html>

سورس کلاس Highlight Syntax برای T-SQL در HTML بصورت خط به خط:

ضمیمه 156383

Public Class TSQL

    Protected Friend Shared Sub Highlight(ByRef Line As String)

        Dim CompleteLine As Boolean = False

        If Line.EndsWith(";") Then

            CompleteLine = True

            Line = Line.Remove(Line.Length - 1, 1)

        End If

        Dim Words As String() = Line.Split(" ")

        Dim List As New List(Of String)

        Dim BeginString, BeginComment, BeginCommentLine As Boolean

        For Each Word As String In Words

            If (Word.StartsWith(Chr(34)) Or Word.StartsWith(Chr(39))) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginString = True

                If (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) Then

                    BeginString = False

                    List.Add(String.Format("<str>{0}</str>", Word))

                Else

                    List.Add(String.Format("<str>{0}", Word))

                End If

            ElseIf (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) And BeginString = True Then

                BeginString = False

                List.Add(String.Format("{0}</str>", Word))

            ElseIf Word.StartsWith("/*") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginComment = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("*/") AndAlso BeginComment = True Then

                BeginComment = False

                List.Add(String.Format("{0}</cm>", Word))

            ElseIf Word.StartsWith("//") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginCommentLine = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("(") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If TSQLKeywords.Contains(Word.Trim.Replace("(", "")) Then

                    List.Add(String.Format("<kw>{0}</kw>(", Word.Replace("(", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.StartsWith("(") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If TSQLKeywords.Contains(Word.Trim.Replace("(", "")) Then

                    List.Add(String.Format("(<kw>{0}</kw>", Word.Replace("(", "")))

                ElseIf Word.Substring(1, 1) = "@" Then

                    List.Add(String.Format("(<prm>{0}</prm>", Word.Replace("(", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.EndsWith(")") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If TSQLKeywords.Contains(Word.Trim.Replace(")", "")) Then

                    List.Add(String.Format("<kw>{0}</kw>)", Word.Replace(")", "")))

                ElseIf Word.StartsWith("@") Then

                    List.Add(String.Format("<prm>{0}</prm>)", Word.Replace(")", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf TSQLKeywords.Contains(Word.Trim) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<kw>{0}</kw>", Word))

            ElseIf Word.StartsWith("@") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<prm>{0}</prm>", Word))

            Else

                List.Add(Word)

            End If

        Next

        If BeginCommentLine = True Then List.Add("</cm>")

        Dim Expr As String = Join(List.ToArray, " ")

        List.Clear()

        Line = Expr + If(CompleteLine, ";", "")

    End Sub

End Class

Public TSQLKeywords() As String = {"ADD", "EXTERNAL",

        "PROCEDURE", "ALL", "FETCH", "PUBLIC", "ALTER", "FILE",

        "RAISERROR", "AND", "FILLFACTOR", "READ", "ANY", "FOR",

        "READTEXT", "AS", "FOREIGN", "RECONFIGURE", "ASC",

        "FREETEXT", "REFERENCES", "AUTHORIZATION",

        "FREETEXTTABLE", "REPLICATION", "BACKUP", "FROM",

        "RESTORE", "BEGIN", "FULL", "RESTRICT", "BETWEEN",

        "FUNCTION", "RETURN", "BREAK", "GOTO", "REVERT",

        "BROWSE", "GRANT", "REVOKE", "BULK", "GROUP", "RIGHT",

        "BY", "HAVING", "ROLLBACK", "CASCADE", "HOLDLOCK",

        "ROWCOUNT", "CASE", "IDENTITY", "ROWGUIDCOL", "CHECK",

        "IDENTITY_INSERT", "RULE", "CHECKPOINT", "IDENTITYCOL",

        "SAVE", "CLOSE", "IF", "SCHEMA", "CLUSTERED", "IN",

        "SECURITYAUDIT", "COALESCE", "INDEX", "SELECT",

        "COLLATE", "INNER", "SEMANTICKEYPHRASETABLE", "COLUMN",

        "INSERT", "SEMANTICSIMILARITYDETAILSTABLE", "COMMIT",

        "INTERSECT", "SEMANTICSIMILARITYTABLE", "COMPUTE",

        "INTO", "SESSION_USER", "CONSTRAINT", "IS", "SET",

        "CONTAINS", "JOIN", "SETUSER", "CONTAINSTABLE", "KEY",

        "SHUTDOWN", "CONTINUE", "KILL", "SOME", "CONVERT",

        "LEFT", "STATISTICS", "CREATE", "LIKE", "SYSTEM_USER",

        "CROSS", "LINENO", "TABLE", "CURRENT", "LOAD",

        "TABLESAMPLE", "CURRENT_DATE", "MERGE", "TEXTSIZE",

        "CURRENT_TIME", "NATIONAL", "THEN", "CURRENT_TIMESTAMP",

        "NOCHECK", "TO", "CURRENT_USER", "NONCLUSTERED", "TOP",

        "CURSOR", "NOT", "TRAN", "DATABASE", "NULL",

        "TRANSACTION", "DBCC", "NULLIF", "TRIGGER", "DEALLOCATE",

        "OF", "TRUNCATE", "DECLARE", "OFF", "TRY_CONVERT",

        "DEFAULT", "OFFSETS", "TSEQUAL", "DELETE", "ON", "UNION",

        "DENY", "OPEN", "UNIQUE", "DESC", "OPENDATASOURCE",

        "UNPIVOT", "DISK", "OPENQUERY", "UPDATE", "DISTINCT",

        "OPENROWSET", "UPDATETEXT", "DISTRIBUTED", "OPENXML",

        "USE", "DOUBLE", "OPTION", "USER", "DROP", "OR",

        "VALUES", "DUMP", "ORDER", "VARYING", "ELSE", "OUTER",

        "VIEW", "END", "OVER", "WAITFOR", "ERRLVL", "PERCENT",

        "WHEN", "ESCAPE", "PIVOT", "WHERE", "EXCEPT", "PLAN",

        "WHILE", "EXEC", "PRECISION", "WITH", "EXECUTE",

        "PRIMARY", "WITHIN", "GROUP", "EXISTS", "PRINT",

        "WRITETEXT", "EXIT", "PROC"}

کد Highlight Syntax برای #C در این نمونه:

ضمیمه 156384

Public Class CSharp

    Protected Friend Shared Sub Highlight(ByRef Line As String)

        Dim CompleteLine As Boolean = False

        If Line.EndsWith(";") Then

            CompleteLine = True

            Line = Line.Remove(Line.Length - 1, 1)

        End If

        Dim Words As String() = Line.Split(" ")

        Dim List As New List(Of String)

        Dim BeginString, BeginComment, BeginCommentLine As Boolean

        For Each Word As String In Words

            If (Word.StartsWith(Chr(34)) Or Word.StartsWith(Chr(39))) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginString = True

                If (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) Then

                    BeginString = False

                    List.Add(String.Format("<str>{0}</str>", Word))

                Else

                    List.Add(String.Format("<str>{0}", Word))

                End If

            ElseIf (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) And BeginString = True Then

                BeginString = False

                List.Add(String.Format("{0}</str>", Word))

            ElseIf Word.StartsWith("/*") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginComment = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("*/") AndAlso BeginComment = True Then

                BeginComment = False

                List.Add(String.Format("{0}</cm>", Word))

            ElseIf Word.StartsWith("//") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginCommentLine = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("(") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If VCSKeyWords.Contains(Word.Trim.Replace("(", "")) Then

                    List.Add(String.Format("<kw>{0}</kw>(", Word.Replace("(", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.StartsWith("(") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If VCSKeyWords.Contains(Word.Trim.Replace("(", "")) Then

                    List.Add(String.Format("(<kw>{0}</kw>", Word.Replace("(", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.EndsWith(")") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If VCSKeyWords.Contains(Word.Trim.Replace(")", "")) Then

                    List.Add(String.Format("<kw>{0}</kw>)", Word.Replace(")", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.StartsWith(")") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                If VCSKeyWords.Contains(Word.Trim.Replace(")", "")) Then

                    List.Add(String.Format(")<kw>{0}</kw>", Word.Replace(")", "")))

                Else

                    List.Add(Word)

                End If

            ElseIf Word.Contains("(") And (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                Dim LeftPart, RightPart As String

                Dim spl As String() = Word.Split("(")

                LeftPart = spl(0) : RightPart = spl(1)

                If VCSKeyWords.Contains(RightPart.Trim) Then

                    List.Add(String.Format("{0}(<kw>{1}</kw>", LeftPart, RightPart))

                Else

                    List.Add(Word)

                End If

            ElseIf VCSKeyWords.Contains(Word.Trim) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<kw>{0}</kw>", Word))

            Else

                List.Add(Word)

            End If

        Next

        If BeginCommentLine = True Then List.Add("</cm>")

        Dim Expr As String = Join(List.ToArray, " ")

        List.Clear()

        Line = Expr + If(CompleteLine, ";", "")

    End Sub





End Class

 ''' <summary>

    ''' Visual C#‎‎‎‎‎‎‎ Language Keywords

    ''' </summary>

    Public VCSKeyWords() As String = {"abstract", "event", "new", "struct", "as", "explicit", "null", _

        "switch", "base", "extern", "object", "this", "bool", "false", "operator", "throw", "break", _

        "finally", "out", "true", "byte", "fixed", "override", "try", "case", "float", "params", _

        "typeof", "catch", "for", "private", "uint", "char", "foreach", "protected", "ulong", _

        "checked", "goto", "public", "unchecked", "class", "if", "readonly", "unsafe", "const", _

        "implicit", "ref", "ushort", "continue", "in", "return", "using", "decimal", "int", _

        "sbyte", "virtual", "default", "interface", "sealed", "volatile", "delegate", "internal", _

        "short", "void", "var", "do", "is", "sizeof", "while", "double", "lock", "stackalloc", _

        "else", "long", "static", "enum", "namespace", "string", "from", "get", "group", "into", _

        "join", "let", "orderby", "partial", "select", "set", "value", "where", "yield", "#if", _

        "#else", "#elif", "#endif", "#define", "#undef", "#warning", "#error", "#line", "#region", _

        "#endregion", "#pragma", "#pragma warning", "#pragma checksum", "#include"}

کد Hylight Syntax برای PHP در این نمونه:

ضمیمه 156385

Public Class PHP

    Private Shared PHPKeywords() As String = {"abstract", "and", "as",

     "break", "callable", "case", "catch", "class", "clone",

     "const", "continue", "declare", "default", "do", "echo",

     "else", "elseif", "empty", "enddeclare", "endfor",

     "endforeach", "endif", "endswitch", "endwhile", "extends",

     "final", "finally", "fn", "for", "foreach", "function",

     "global", "goto", "if", "implements", "include",

    "include_oncet", "instanceof", "insteadof", "interface", "isset",

    "list", "namespace", "new", "or", "print", "private", "protected",

    "public", "require", "require_oncet", "return", "static", "switch",

    "throw", "trait", "try", "unset", "use", "var", "while", "xor",

    "yield", "yield", "from"}

    Protected Friend Shared Sub Highlight(ByRef Line As String)

        Dim CompleteLine As Boolean = False

        If Line.EndsWith(";") AndAlso

            (Line.EndsWith(">") = False And Line.EndsWith("<") = False) Then

            CompleteLine = True

            Line = Line.Remove(Line.Length - 1, 1)

        End If

        Dim Words As String() = Line.Split(" ")

        Dim List As New List(Of String)

        Dim BeginString, BeginComment, BeginCommentLine As Boolean

        For Each Word As String In Words

            If (Word.StartsWith(Chr(34)) Or Word.StartsWith(Chr(39))) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginString = True

                If (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) Then

                    BeginString = False

                    List.Add(String.Format("<str>{0}</str>", Word))

                Else

                    List.Add(String.Format("<str>{0}", Word))

                End If

            ElseIf (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) And BeginString = True Then

                BeginString = False

                List.Add(String.Format("{0}</str>", Word))

            ElseIf Word.StartsWith("/*") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginComment = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("*/") AndAlso BeginComment = True Then

                BeginComment = False

                List.Add(String.Format("{0}</cm>", Word))

            ElseIf Word.StartsWith("//") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginCommentLine = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.Trim.StartsWith("&lt;?") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<php>{0}</php>", Word))

            ElseIf Word.Trim.EndsWith("?&gt;") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<php>{0}</php>", Word))

            ElseIf Word.Trim.StartsWith("$") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<prm>{0}</prm>", Word))

            ElseIf PHPKeywords.Contains(Word.Trim) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<kw>{0}</kw>", Word))

            Else

                List.Add(Word)

            End If

        Next

        If BeginCommentLine = True Then List.Add("</cm>")

        Dim Expr As String = Join(List.ToArray, " ")

        List.Clear()

        Line = Expr + If(CompleteLine, ";", "")

    End Sub





End Class

کد Highlight Syntax برای JavaScript در این نمونه:

ضمیمه 156386

Public Class JavaScript

    Protected Friend Shared Sub Highlight(ByRef Line As String)

        Dim CompleteLine As Boolean = False

        If Line.EndsWith(";") Then

            CompleteLine = True

            Line = Line.Remove(Line.Length - 1, 1)

        End If

        Dim Words As String() = Line.Split(" ")

        Dim List As New List(Of String)

        Dim BeginString, BeginComment, BeginCommentLine As Boolean

        For Each Word As String In Words

            If (Word.StartsWith(Chr(34)) Or Word.StartsWith(Chr(39))) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginString = True

                If (Word.Trim.Length > 1) AndAlso (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) Then

                    BeginString = False

                    List.Add(String.Format("<str>{0}</str>", Word))

                Else

                    List.Add(String.Format("<str>{0}", Word))

                End If

            ElseIf (Word.Trim.EndsWith(Chr(34)) Or Word.Trim.EndsWith(Chr(39))) And BeginString = True Then

                BeginString = False

                List.Add(String.Format("{0}</str>", Word))

            ElseIf Word.StartsWith("/*") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginComment = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf Word.EndsWith("*/") AndAlso BeginComment = True Then

                BeginComment = False

                List.Add(String.Format("{0}</cm>", Word))

            ElseIf Word.StartsWith("//") AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                BeginCommentLine = True

                List.Add(String.Format("<cm>{0}", Word))

            ElseIf JavaScriptKeyWords.Contains(Word.Trim) AndAlso (BeginString = False And BeginComment = False And BeginCommentLine = False) Then

                List.Add(String.Format("<kw>{0}</kw>", Word))

            Else

                List.Add(Word)

            End If

        Next

        If BeginCommentLine = True Then List.Add("</cm>")

        Dim Expr As String = Join(List.ToArray, " ")

        List.Clear()

        Line = Expr + If(CompleteLine, ";", "")

        Debug.Print(" => {0}", Line)

    End Sub

End Class

Public JavaScriptKeyWords() As String = {"abstract",

        "arguments", "await", "boolean", "break", "byte", "case",

        "catch", "char", "class", "const", "continue", "debugger",

        "default", "delete", "do", "double", "else", "enum",

        "eval", "export", "extends", "false", "final", "finally",

        "float", "for", "function", "goto", "if", "implements",

        "import", "in", "instanceof", "int", "interface", "let",

        "long", "native", "new", "null", "package", "private",

        "protected", "public", "return", "short", "static",

        "super", "switch", "synchronized", "this", "throw",

        "throws", "transient", "true", "try", "typeof", "var",

        "void", "volatile", "while", "with", "yield"}

کد Hylight Syntax برای XML در این نمونه:

​ضمیمه 156388

Public Class XML

Const LT As String = "<"

    Const GT As String = ">"

    Shared Sub Highlight(ByRef Line As String)

        Dim StartTag As Boolean

        Dim List As New List(Of String)

        Dim RevNum% = 0

        Dim BeginString, BeginContent As Boolean

        Line = Line.Replace(GT, String.Format(" {0}", GT)).

            Replace(LT + "/", String.Format(" {0}/", LT)).

            Replace(LT, String.Format(" {0}", LT))

        Dim spl = Line.Split(Space(1))

        For Each Word As String In spl

            If (Word.Trim.StartsWith(LT) AndAlso Word.Trim.StartsWith(LT + "/") = False) And (Word.Trim.EndsWith(GT) Or Word.Trim.EndsWith(GT) = False) AndAlso BeginString = False And BeginContent = False Then

                StartTag = True

                If Word.Trim.EndsWith(GT) AndAlso Word.Trim.EndsWith("/" + GT) = False Then

                    List.Add(String.Format("{0}<tag>{2}</tag>{1}",

                                           LT, GT, Word.Substring(LT.Length, Word.Length - (LT.Length + GT.Length))))

                ElseIf Word.Trim.EndsWith("/" + GT) = True Then

                    List.Add(String.Format("{0}<tag>{2}</tag>/{1}",

                                           LT, GT, Word.Substring(LT.Length, Word.Length - (LT.Length + GT.Length + 1))))

                    StartTag = False

                Else

                    List.Add(String.Format("{0}<tag>{2}</tag>",

                                           LT, GT, Word.Substring(LT.Length, Word.Length - LT.Length)))

                End If

            ElseIf Word.Trim.StartsWith(LT + "/") And (Word.Trim.EndsWith(GT) Or Word.Trim.EndsWith(GT) = False) AndAlso BeginString = False And BeginContent = False Then

                If Word.Trim.EndsWith(GT) Then

                    List.Add(String.Format("{0}/<tag>{2}</tag>{1}",

                                           LT, GT, Word.Substring(LT.Length + 1, Word.Length - (LT.Length + GT.Length + 1))))

                Else

                    List.Add(String.Format("{0}/<tag>{2}</tag>",

                           LT, GT, Word.Substring(LT.Length + 1, Word.Length - (LT.Length + 1))))

                End If

            ElseIf (Word.Trim = GT Or Word.Trim = "/" + GT) AndAlso BeginString = False And BeginContent = False Then

                If Word.Trim = GT Then

                    If StartTag = True Then BeginContent = True

                    List.Add(String.Format("{0}", GT))

                Else

                    List.Add(String.Format("/{0}", GT))

                End If

            ElseIf (Word.StartsWith(Chr(34)) Or Word.StartsWith(Chr(39))) AndAlso

            BeginString = False Then

                BeginString = True

                If (Word.Trim.Length > 1) AndAlso

                    (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) Then

                    BeginString = False

                    List.Add(String.Format("<str>{0}</str>", Word))

                Else

                    List.Add(String.Format("<str>{0}", Word))

                End If

            ElseIf (Word.EndsWith(Chr(34)) Or Word.EndsWith(Chr(39))) And

                BeginString = True Then

                BeginString = False

                List.Add(String.Format("{0}</str>", Word))

            ElseIf (Word.Trim.StartsWith(LT + "/") And Word.Trim.EndsWith(GT)) AndAlso

            BeginContent = True And BeginString = False Then

                BeginContent = False

                List.Add(String.Format("{0}/{2}{1}",

                                       LT, GT, Word.Substring(LT.Length + 2, Word.Length - (LT.Length + GT.Length + 1))))

            ElseIf BeginContent = True Then

                List.Add(Word)

            Else

                List.Add(Word)

            End If

        Next

        Line = String.Format("{0}",

               Join(List.ToArray, " "))

        Line = Line.Replace(String.Format(" {0}", GT), String.Format("<sign>{0}</sign>", GT)).

            Replace(String.Format("  {0}/", LT), String.Format("<sign>{0}/</sign>", LT)).

        Replace(String.Format(" {0}", LT), String.Format("<sign>{0}</sign>", LT))

    End Sub

End Class