تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[كود] للترفيه ...كود ينتج كل الكلمات من احرف
#1
السلام عليكم

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

برمجيا 

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

 الكود

PHP كود :
Public Class Form1

    Private Sub Button1_Click
(ByVal sender As System.ObjectByVal e As System.EventArgsHandles 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 
المحاولة ناقصة 
----- مجرد ترفيه برمجي --------------
المهم ...... بالتوفيق
 لعل الكلمة التي تنفعني لم أكتبها بعد
عبد الله بن المبارك
الرد
#2
هذه مسألة شهيرة جدا اسمها 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

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


الرد
#4
السلام عليكم

ذكرني موضوع أخي عبد الهادي بالبرامج التي تقوم بتجريب كلمات المرور لاختراق شبكة او برنامج 
و المعروفة ب 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
الرد
تم الشكر بواسطة: عبد الهادي بهاب , ابراهيم ايبو
#5
شكرا لاخوة الخبراء على المرور الطيب و اثراءه بشكل احترافي
 لعل الكلمة التي تنفعني لم أكتبها بعد
عبد الله بن المبارك
الرد
تم الشكر بواسطة: Anas Mahmoud , Anas Mahmoud , Mohamad Anan , ابراهيم ايبو


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Exclamation [VB.NET] برنامج لمسح الكلمات المتكررة malek369 0 248 06-07-20, 08:53 AM
آخر رد: malek369
  [سؤال] توليد احرف لعدد خانات معين AbdoDabak 3 561 17-10-19, 11:54 PM
آخر رد: elgokr
Exclamation [VB.NET] منع ادخال اكثر من مسافه بين الكلمات في التكست بوكس سميـر 9 933 22-08-19, 01:57 AM
آخر رد: ابراهيم ايبو
  [VB.NET] مشكلة في إخراج المعطيات عند طباعة الكلمات باللغة العربية karimvb2008 2 1,004 07-11-18, 12:57 PM
آخر رد: elgokr
  مطلوب كود ةحذف بعض الكلمات من التكست ZaerAllail 2 689 07-08-18, 06:38 PM
آخر رد: ZaerAllail
  [VB.NET] تحديد عدد احرف التيكست بوكس محمد اسماعيل 3 720 21-07-18, 09:56 AM
آخر رد: YousefOkasha
  كيف اجعل الكلمات تحت بعضها فى الليست بوكس ابو روضة 5 1,064 16-07-18, 01:34 AM
آخر رد: elgokr
  [VB.NET] كيف اجعل listbox تستوعب اكبر عدد ممكن من الكلمات او الارقام e-coder 3 913 06-05-18, 12:53 PM
آخر رد: viv
  [VB.NET] عند استيراد قيم نصية من ملف نصي تظهر الكلمات العربية بالشكل ؟؟؟؟؟ يا ريت اجد يساعدني alaa.altunsi 3 890 06-04-18, 02:12 PM
آخر رد: alaa.altunsi
  كود يقوم باحتساب عدد الكلمات داخل textbox nabil.1710 2 1,283 02-03-18, 11:57 PM
آخر رد: nabil.1710

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم