منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - للترفيه ...كود ينتج كل الكلمات من احرف

السلام عليكم

لاحظت كثيرا على الفايسبوك لعبة يعطي احدهم 3 احرف ويطلب انتاج كلمات منها

برمجيا

ضع مربع نص 1 textbox1
زر
مربع نص متعدد الاسطر textbox2

الكود

PHP كود :

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Retxt = ""
        Dim NewTxt = ""
        TextBox2.Text = ""
        Dim txt = TextBox1.Text
        For i = 0 To txt.Length - 1
            Retxt = Retxt & txt
        Next

        Dim ali = ""

        Dim strt = 0
        Dim Lmax = txt.Length - 1
        Do Until strt = Lmax + 1
            NewTxt = ""
            For p = strt To strt + Lmax
                NewTxt = NewTxt & Retxt(p)
            Next
            ali = ali & NewTxt & vbNewLine

            NewTxt = ""
            For p = strt + Lmax To strt Step -1
                NewTxt = NewTxt & Retxt(p)
            Next
            ali = ali & NewTxt & vbNewLine
            strt += 1
        Loop

        TextBox2.Text = ali

    End Sub
End Class 

حاولت من اجل كلمات من اكثر من 4
المحاولة ناقصة
----- مجرد ترفيه برمجي --------------
المهم ...... بالتوفيق

هذه مسألة شهيرة جدا اسمها Permutations

حلي يستخدم recursive function تنادي نفسها ، نقوم بحذف حرف حرف من الكلمة ونحسب احتمالات الباقي ونضيف النتائج الى بعضها :

كود :

   Function Permutations(word As String) As List(Of String)

        If word.Length = 1 Then

            Return New List(Of String)({word})

        Else

            Dim ReturnedList As New List(Of String)

            For i As Integer = 0 To word.Length - 1

                Dim FirstLetter As Char = word(i)

                Dim NewString As String = word.Remove(i, 1)

                Dim NewPermutation = Permutations(NewString)

                For Each S In NewPermutation

                    ReturnedList.Add(S & FirstLetter)

                Next

            Next

            Return ReturnedList

        End If

    End Function

استخدامها

كود :

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

        Dim Word As String = TextBox1.Text

        ListBox1.DataSource = Permutations(Word)

    End Sub

تصلح لاي طول نص طبعا ولكن عند الكلمات الكبيرة تصبح الاحتمالات اكثر وبالتالي تأخذ وقت اطول

مشاركة لكم جميعا اضع محاولتي

[ليس جديد] الحصول على كلمة من تقليب عشوائي للحروف

السلام عليكم

ذكرني موضوع أخي عبد الهادي بالبرامج التي تقوم بتجريب كلمات المرور لاختراق شبكة او برنامج
و المعروفة ب Brute-Force Attack حيث تقوم باستخدام قاموس يتم توليده من سلسلة من الاحرف و الرموز
بطول محدد لا علاقة له بعدد الحروف بمعنى يمكن تركيب كافة الاحتمالات لكلمة من 4 احرف باستخدام حرفين او اكثر
و للمشاركة مع اخواني اردت نشر الكود قد يفيد من يبحث عنه

كود :

   Public Sub Engine(ByVal Characters As String, ByVal Length As Byte)

        Dim Flag As Boolean

        Dim Ary(Length) As Integer

        Dim Depth As Integer

        Dim Result As String

        Depth = 1

        While Not (Flag)

            My.Application.DoEvents()

            Ary(Depth) = Ary(Depth) + 1

            If Depth = Length Then

                Result = Result.Substring(0, Length - 1) + Mid(Characters, Ary(Depth), 1)

            Else

                Result = Result + Mid(Characters, Ary(Depth), 1)

            End If

            If Ary(Depth) <> Len(Characters) + 1 Then

                If Depth <> Length Then

                    Depth = Depth + 1

                Else

                    ListBox1.Items.Add(Result)

                End If

            Else

                If Depth = 1 Then

                    Flag = True

                Else

                    Ary(Depth) = 0

                    Depth = Depth - 1

                    Result = Result.Substring(0, Depth - 1)

                End If

            End If

        End While

    End Sub

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

        Engine("ABC", 4)

    End Sub

شكرا لاخوة الخبراء على المرور الطيب و اثراءه بشكل احترافي

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

عبد الهادي بهاب

Anas Mahmoud

سعود

Mohamad Anan

عبد الهادي بهاب