+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم اسئلة VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=183)
+--- الموضوع : [كود] للترفيه ...كود ينتج كل الكلمات من احرف (/showthread.php?tid=36472)
للترفيه ...كود ينتج كل الكلمات من احرف - عبد الهادي بهاب - 21-09-20
السلام عليكم
لاحظت كثيرا على الفايسبوك لعبة يعطي احدهم 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
المحاولة ناقصة
----- مجرد ترفيه برمجي --------------
المهم ...... بالتوفيق
RE: للترفيه ...كود ينتج كل الكلمات من احرف - Anas Mahmoud - 21-09-20
هذه مسألة شهيرة جدا اسمها 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تصلح لاي طول نص طبعا ولكن عند الكلمات الكبيرة تصبح الاحتمالات اكثر وبالتالي تأخذ وقت اطول
RE: للترفيه ...كود ينتج كل الكلمات من احرف - سعود - 21-09-20
مشاركة لكم جميعا اضع محاولتي
RE: للترفيه ...كود ينتج كل الكلمات من احرف - Mohamad Anan - 22-09-20
السلام عليكم
ذكرني موضوع أخي عبد الهادي بالبرامج التي تقوم بتجريب كلمات المرور لاختراق شبكة او برنامج
و المعروفة ب 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 SubRE: للترفيه ...كود ينتج كل الكلمات من احرف - عبد الهادي بهاب - 22-09-20
شكرا لاخوة الخبراء على المرور الطيب و اثراءه بشكل احترافي