[عبد الهادي بهاب]

السلام عليكم

لاحظت كثيرا على الفايسبوك لعبة يعطي احدهم 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 
المحاولة ناقصة 
----- مجرد ترفيه برمجي --------------
المهم ...... بالتوفيق

[Anas Mahmoud]

هذه مسألة شهيرة جدا اسمها 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

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

[سعود]

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

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

[Mohamad Anan]

السلام عليكم

ذكرني موضوع أخي عبد الهادي بالبرامج التي تقوم بتجريب كلمات المرور لاختراق شبكة او برنامج 
و المعروفة ب 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

[عبد الهادي بهاب]

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