الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

كود إرسال نص إلى غرف البالتوك

مغلق
بدأه الغانمي في 18 نوفمبر 2006 · 7 رد · 1,890 مشاهدة · في Microsoft Visual Basic.NET
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم ورحمة الله وبركاته

هذا كود لإرسال النصوص مباشرة إلى غرف البالتوك ، ولكن الكود بفيجوال بيسك 6 ويحتاج تحويلة إلى دوت نت

Option Strict Off
Option Explicit On
Module Module1
	Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Integer, ByVal lParam As Integer) As Integer
	Public Declare Function GetWindowText Lib "user32"  Alias "GetWindowTextA"(ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
	Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Integer) As Integer
	Public Declare Function GetParent Lib "user32" (ByVal hwnd As Integer) As Integer
	'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
	Public Declare Function SendMessage Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Any) As Integer
	Public Declare Function SendMessageLong Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
	Public Declare Function SendMessageByString Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
	Public Declare Function FindWindow Lib "user32"  Alias "FindWindowA"(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
	Public Declare Function FindWindowEx Lib "user32"  Alias "FindWindowExA"(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
	Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer


	Public Const GW_Child As Integer = 5
	Public Const WM_LBUTTONDOWN As Short = &H201s
	Public Const WM_LBUTTONUP As Short = &H202s
	Public Const WM_SETTEXT As Short = &HCs
	Private Const HTCAPTION As Short = 2

	Dim sPattern As String
	Dim hFind As Integer
	'Send Text To Paltalk
	Public Function Palsend(ByRef Sendit As String) As Object
		Dim X As Integer
		Dim xx As Integer
		Dim xxx As Integer
		Dim xxxx As Integer
		Dim xxxxx As Integer
		Dim xxxxxx As Integer
		Dim xxxxxxx As Integer
		Dim xxxxxxxx As Integer
		Dim xxxxxxxxx As Integer
		Dim xxxxxxxxxx As Integer

		X = FindWindowWild("*Voice Room", False) 'I use my FindWindowWild Function To search For - Voice room
		If X = 0 Then
			Exit Function
		End If
		xx = FindWindowEx(X, 0, "wtl_splitterwindow", vbNullString)
		xxx = FindWindowEx(xx, 0, "wtl_splitterwindow", vbNullString)
		xxxx = FindWindowEx(xxx, 0, "wtl_splitterwindow", vbNullString)
		xxxxx = GetWindow(xxxx, GW_Child) 'This will get the next control after wtl_splitterwindow, the next control is also knowen as Atl:####### what ever...
		xxxxxx = FindWindowEx(xxxxx, 0, "atlaxwin71", vbNullString)
		xxxxxxx = FindWindowEx(xxxxxx, 0, "#32770", vbNullString)
		xxxxxxxx = FindWindowEx(xxxxxxx, 0, "richedit20a", vbNullString)
		xxxxxxxx = FindWindowEx(xxxxxxx, xxxxxxxx, "richedit20a", vbNullString)
		Call SendMessageByString(xxxxxxxx, WM_SETTEXT, 0, Sendit)
		Do 
			System.Windows.Forms.Application.DoEvents()
			xxxxxxxxx = FindWindowEx(xxxxxxx, 0, "toolbarwindow32", vbNullString)
			xxxxxxxxxx = FindWindowEx(xxxxxxxxx, 0, "wtl_bitmapbutton", vbNullString)
			Call SendMessageLong(xxxxxxxxxx, WM_LBUTTONDOWN, 0, 0)
			Call SendMessageLong(xxxxxxxxxx, WM_LBUTTONUP, 0, 0)
		Loop Until xxxxxxxxxx <> 0
	End Function
	'Gets the window title
	Function EnumWinProc(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer
		Dim k As Integer
		Dim sName As String
		If IsWindowVisible(hwnd) And GetParent(hwnd) = 0 Then
			sName = Space(128)
			k = GetWindowText(hwnd, sName, 128)
			If k > 0 Then
				sName = Left(sName, k)
				If lParam = 0 Then sName = UCase(sName)
				If sName Like sPattern Then
					hFind = hwnd
					EnumWinProc = 0
					Exit Function
				End If
			End If
		End If
		EnumWinProc = 1
	End Function
	'FindWindowWild Function
	Public Function FindWindowWild(ByRef sWild As String, Optional ByRef bMatchCase As Boolean = True) As Integer
		sPattern = sWild
		If Not bMatchCase Then sPattern = UCase(sPattern)
		'UPGRADE_WARNING: Add a delegate for AddressOf EnumWinProc Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="E9E157F7-EF0C-4016-87B7-7D7FBBC6EE08"'
		EnumWindows(AddressOf EnumWinProc, bMatchCase)
		FindWindowWild = hFind
	End Function
End Module

تواجهني مشكلتين

الأولى : ما هو البديل لكلمة Any

	Public Declare Function SendMessage Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Any) As Integer

والثانية :وهنا مشكلة AddressOf

EnumWindows(AddressOf EnumWinProc, bMatchCase)
#2

مشكلة Any يجب أن تستخدم نوع البيانات الذي سيستخدم فعليا مثلا إن كنت ستمرر نص استخدم String بدلا من Any

ولكن في الكود المذكور هنا يمكنك حذف السطر

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Any) As Integer

الذي يسبب لك المشكلة لأنه غير مستخدم فعليا في الإجراءات

عن عائشة رضي الله عنها أن النبي صلى الله عليه وسلم قال: إن الله يحب إذا عمل أحدكم عملا أن يتقنه

نعيب زماننا والعيب فينا ... وما لزماننا عيب سوانا

ونهجو ذا الزمان بغير ذنب ... ولو نطق الزمان لنا هجانا

محمد سامر أبو سلو

#3

بالنسبة لموضوع EnumWindows(AddressOf EnumWinProc, bMatchCase) في الإجراء FindWindowWild يمكن حله بسهولة كالتالي

أولا غير السطر التالي

Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Integer, ByVal lParam As Integer) As Integer

إلى

Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWinProcDelegate, ByVal lParam As Integer) As Integer

وقبل تعريف الإجراء

Public Function FindWindowWild ... rest of function

أضف السطر التالي

	Delegate Function EnumWinProcDelegate(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer

وضع ردا بالنتائج بعد تطبيق ما ذكرت

كما انصحك بقراءة المواضيع المتعلقة بـ AddressOf و delegates في مكتبة MSDN و في هذا المنتدى

وبالتالي يمكن أن يصبح كودك بعد بعض التعديلات البسيطة

Module Module1

	Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWinProcDelegate, ByVal lParam As Integer) As Integer
	Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
	Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Integer) As Integer
	Public Declare Function GetParent Lib "user32" (ByVal hwnd As Integer) As Integer
	Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
	Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
	Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
	Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
	Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer

	Public Const GW_Child As Integer = 5
	Public Const WM_LBUTTONDOWN As Short = &H201S
	Public Const WM_LBUTTONUP As Short = &H202S
	Public Const WM_SETTEXT As Short = &HCS
	Private Const HTCAPTION As Short = 2

	Dim sPattern As String
	Dim hFind As Integer
	'Send Text To Paltalk
	Public Sub Palsend(ByRef Sendit As String)
		Dim X As Integer
		Dim xx As Integer
		Dim xxx As Integer
		Dim xxxx As Integer
		Dim xxxxx As Integer
		Dim xxxxxx As Integer
		Dim xxxxxxx As Integer
		Dim xxxxxxxx As Integer
		Dim xxxxxxxxx As Integer
		Dim xxxxxxxxxx As Integer

		X = FindWindowWild("*Voice Room", False) 'I use my FindWindowWild Function To search For - Voice room
		If X = 0 Then
			Exit Sub
		End If
		xx = FindWindowEx(X, 0, "wtl_splitterwindow", vbNullString)
		xxx = FindWindowEx(xx, 0, "wtl_splitterwindow", vbNullString)
		xxxx = FindWindowEx(xxx, 0, "wtl_splitterwindow", vbNullString)
		xxxxx = GetWindow(xxxx, GW_Child) 'This will get the next control after wtl_splitterwindow, the next control is also knowen as Atl:####### what ever...
		xxxxxx = FindWindowEx(xxxxx, 0, "atlaxwin71", vbNullString)
		xxxxxxx = FindWindowEx(xxxxxx, 0, "#32770", vbNullString)
		xxxxxxxx = FindWindowEx(xxxxxxx, 0, "richedit20a", vbNullString)
		xxxxxxxx = FindWindowEx(xxxxxxx, xxxxxxxx, "richedit20a", vbNullString)
		Call SendMessageByString(xxxxxxxx, WM_SETTEXT, 0, Sendit)
		Do
			System.Windows.Forms.Application.DoEvents()
			xxxxxxxxx = FindWindowEx(xxxxxxx, 0, "toolbarwindow32", vbNullString)
			xxxxxxxxxx = FindWindowEx(xxxxxxxxx, 0, "wtl_bitmapbutton", vbNullString)
			Call SendMessageLong(xxxxxxxxxx, WM_LBUTTONDOWN, 0, 0)
			Call SendMessageLong(xxxxxxxxxx, WM_LBUTTONUP, 0, 0)
		Loop Until xxxxxxxxxx <> 0
	End Sub

	'Gets the window title
	Function EnumWinProc(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer
		Dim k As Integer
		Dim sName As String
		If IsWindowVisible(hwnd) And GetParent(hwnd) = 0 Then
			sName = Space(128)
			k = GetWindowText(hwnd, sName, 128)
			If k > 0 Then
				sName = Left(sName, k)
				If lParam = 0 Then sName = UCase(sName)
				If sName Like sPattern Then
					hFind = hwnd
					EnumWinProc = 0
					Exit Function
				End If
			End If
		End If
		EnumWinProc = 1
	End Function

	Delegate Function EnumWinProcDelegate(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer

	'FindWindowWild Function
	Public Function FindWindowWild(ByRef sWild As String, Optional ByRef bMatchCase As Boolean = True) As Integer
		sPattern = sWild
		If Not bMatchCase Then sPattern = UCase(sPattern)

		EnumWindows(AddressOf EnumWinProc, bMatchCase)
		FindWindowWild = hFind
	End Function

End Module

عن عائشة رضي الله عنها أن النبي صلى الله عليه وسلم قال: إن الله يحب إذا عمل أحدكم عملا أن يتقنه

نعيب زماننا والعيب فينا ... وما لزماننا عيب سوانا

ونهجو ذا الزمان بغير ذنب ... ولو نطق الزمان لنا هجانا

محمد سامر أبو سلو

#4

السلام عليكم ورحمة الله وبركاته

أخي العزيز samerselo نجحت الطريق ولله الحمد وشتغل البرنامج بشكل سليم مية في المية

ماني عارف كيف أشكرك الله يوفقك إن شاء الله

#5

أخي samerselo صحيح أن المشكلة انتهت ولكن أريد شرح للمشكلة وطريقة حلها

لأنه أنا عندي أكواد فيها نفس المشكلة وماني عارف كيف أحلها

ممكن رابط يشرح الحل وخاصتاً البديل لهذا الكود AddressOf

وشكراً

#6

طريقة العمل ببساطة

- معالج التحديث وضع لك رسالة

 'UPGRADE_WARNING: Add a delegate for AddressOf EnumWinProc Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="E9E157F7-EF0C-4016-87B7-7D7FBBC6EE08"'

قبل السطر

 EnumWindows(AddressOf EnumWinProc, bMatchCase)

وهذا ما سنقوم بفعله بالضبط

أولا - سنعرف إجراء مفوض Delegate للإجراء EnumWinProc و سيكون اسمه EnumWinProcDelegate و سيحتفظ بشكل الإجراء الأصلي ولكن بدون جسم الإجراء يمكنك بالطبع ملاحظة إضافة كلمة Delegate لاسم الإجراء هكذا كما ترغب بيئة التطوير- قاعدة ثابتة هنا - وبذلك يكون تعريف الإجراء المفوض

Delegate Function EnumWinProcDelegate(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer

بقي علينا خطوة واحدة وهي تعديل تعريف الإجراء EnumWindows الذي سنمرر له الإجراء المفوض حسب الوضعية الجديدة بحيث يتم تغيير فقط البارامتر الذي سنمرر له الإجراء المفوض

من

ByVal lpEnumFunc As Integer

إلى

ByVal lpEnumFunc As EnumWinProcDelegate

وبهذا أصبح تعريف الإجراء هو

Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWinProcDelegate, ByVal lParam As Integer) As Integer

وبهذا سيعمل الكود بشكل جيد - و بنفس الطريقة يمكنك تجاوز أي مشكلة من هذا النوع

كما يمكنك متابعة تفاصيل أكثر للعملية في مكتبة MSDN في الرابط الذي تشير إليه رسالة الخطأ في التعليق الذي وضعه لك معالج التحديث

عن عائشة رضي الله عنها أن النبي صلى الله عليه وسلم قال: إن الله يحب إذا عمل أحدكم عملا أن يتقنه

نعيب زماننا والعيب فينا ... وما لزماننا عيب سوانا

ونهجو ذا الزمان بغير ذنب ... ولو نطق الزمان لنا هجانا

محمد سامر أبو سلو

#7

السلام عليكم ورحمة الله وبركاته

بصراحة أنا حاولت أتجاوز المشاكل في الكود ولكن بدون فايدة نفس المشكلة تواجهني في الاكواد

أخي samerselo يا ليت تساعدني في هذا الكود وتعلمني كيف أحل المشكلة

الكود في المرفقات وجزاك الله خير

Project1.NET.rar

#8

أخ الغانمي يمكنك إصلاح الكود بنفسك طريقة العمل أوضحتها لك حاول مرة أخرى ثم سنحاول حل المشاكل معا إن لم تستطع فقط اعمل بهدوء وتروي وقم بحل كل مشكلة على حدة

عن عائشة رضي الله عنها أن النبي صلى الله عليه وسلم قال: إن الله يحب إذا عمل أحدكم عملا أن يتقنه

نعيب زماننا والعيب فينا ... وما لزماننا عيب سوانا

ونهجو ذا الزمان بغير ذنب ... ولو نطق الزمان لنا هجانا

محمد سامر أبو سلو

هذا الموضوع مغلق.

مواضيع مشابهة