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

معرفة الاي بي الحقيقي في وجود شبكة داخليه وخط DSL

مغلق
بدأه شمس الزناتي في 1 فبراير 2007 · 3 رد · 5,206 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

اخواني هذا الكود

Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const ERROR_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = _
WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1

Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Function gethostname Lib "WSOCK32.DLL" _
(ByVal szHost As String, ByVal dwHostLen As Long) As Long

Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal szHost As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
	If Not SocketsInitialize() Then
		GetIPAddress = ""
		Exit Function
	End If
	If gethostname(sHostName, 256) = SOCKET_ERROR Then
		GetIPAddress = ""
		MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
		" has occurred. Unable to successfully get Host Name."
		SocketsCleanup
		Exit Function
	End If
	sHostName = Trim$(sHostName)
	lpHost = gethostbyname(sHostName)
	If lpHost = 0 Then
		GetIPAddress = ""
		MsgBox "Windows Sockets are not responding. " & _
		"Unable to successfully get Host Name."
		SocketsCleanup
		Exit Function
	End If
	CopyMemory HOST, lpHost, Len(HOST)
	CopyMemory dwIPAddr, HOST.hAddrList, 4
	ReDim tmpIPAddr(1 To HOST.hLen)
	CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
	For i = 1 To HOST.hLen
		sIPAddr = sIPAddr & tmpIPAddr(i) & "."
	Next
	GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
	SocketsCleanup
End Function

Private Function GetIPHostName() As String
Dim sHostName As String * 256
	If Not SocketsInitialize() Then
		GetIPHostName = ""
		Exit Function
	End If
	If gethostname(sHostName, 256) = SOCKET_ERROR Then
		GetIPHostName = ""
		MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
		" has occurred. Unable to successfully get Host Name."
		SocketsCleanup
		Exit Function
	End If
	GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
	SocketsCleanup
End Function


Private Function HiByte(ByVal wParam As Integer)
	HiByte = wParam \ &H100 And &HFF&
End Function

Private Function LoByte(ByVal wParam As Integer)
	LoByte = wParam And &HFF&
End Function

Private Sub SocketsCleanup()
	If WSACleanup() <> ERROR_SUCCESS Then
		MsgBox "Socket error occurred in Cleanup."
	End If
End Sub

Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim sLoByte As String
Dim sHiByte As String
	If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
		MsgBox "The 32-bit Windows Socket is not responding."
		SocketsInitialize = False
		Exit Function
	End If
	If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
		MsgBox "This application requires a minimum of " & _
		CStr(MIN_SOCKETS_REQD) & " supported sockets."
		SocketsInitialize = False
		Exit Function
	End If
	If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
	(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
	HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
		sHiByte = CStr(HiByte(WSAD.wVersion))
		sLoByte = CStr(LoByte(WSAD.wVersion))
		MsgBox "Sockets version " & sLoByte & "." & sHiByte & _
		" is not supported by 32-bit Windows Sockets."
		SocketsInitialize = False
		Exit Function
	End If
	SocketsInitialize = True
End Function

'Insert this code to your form:

Private Sub Form_Load()
	MsgBox "IP Host Name: " & GetIPHostName()
	MsgBox "IP Address: " & GetIPAddress()
End Sub

يأتي بال ip من الجهاز اذا فاذا كنت عضو في شبكة lan او تستخدم adsl فلن تحصل على الاي بي الصحيح لك و لكي تحصل علية عليك دخول احد المواقع كهذة http://www.mediacollege.com/internet/utilities/show-ip.shtml لكي تعرف الاي بي الحقيقي الخاص بك

فما هو الكود الذي يمكني من عرض الاي بي الحقيقي من داخل برنامجي

تم تعديل هذه المشاركة بواسطة HnHn في 1 فبراير 2007 في 08:55

خطوات فيجوالية

--------------------------------------

التحزيم بواسطة Package & Deployment Wizard

أداة all date للتعامل مع الوقت

التعامل مع app.path دروس للمبتدئين

اصنع ocx من تصميمك لجميع احتيجاتك دروس للمبتدئين

شرح برنامج fack foder لحماية الفهارس

مواضيع اخرى

--------------------------------------

سجل بياناتك للاشتراك في رابطة المبرمجين المصريين, للاخوة المصريين او العرب المقيمين بمصر

عني = about me

--------------------------------------

مدونتي مصري للنهاية

--------------------------------------

على اسم مصر التاريخ يقدر يقول ما شاء ............... انا مصر عندي احب و اجمل الاشياء

#2

تستطيع ذلك عن طريق الخروج من نظاق الشبكة ، لانه لايمكن الوصول للراوتر مثلا من جهازك الفرعي علي ما اعتقد ، انا حليت هذه المشكلة بطريقة بسيطة وهي وضع صفحة علي اي موقع انترنت يدعن asp او اي لغة مثل php المهم في داخل هذه الصفة تقوم بارجاع الIP لانه عند تصفح المواقع يتم اخذ الـIP الحقيقي وتقوم بتنفيذ هذه الصفحة من برنامجك . وبهذه الطريق تحصل علي الـIPخاصتك .

وهذه مثال للصفحة علي موقعي

http://mistrosoft.com/ip.asp

وطريقة تنفيذ هذه الصفحة من برنامجك بالطريقة التالية .

Function GetRealIp() As String

Dim GotothisURL As String, ResponsePage As String
Dim CleanIP As String
Dim P1 As Long, P2 As Long

GotothisURL = "http://www.mistrosoft.com/ip.asp" 'Url

 Set GetConnection = CreateObject("Microsoft.XMLHTTP") 'Create XML HTTP Instance

 GetConnection.Open "get", GotothisURL, False 'Open Connection

 On Error Resume Next

 GetConnection.Send 'Send Request
 ResponsePage = GetConnection.responseText 'Html Response

'---------------------- Get IP / Just IP From Html Response


P1 = InStr(1, ResponsePage, "<body>")
P2 = InStr(P1 + 1, ResponsePage, "</body>")
If P1 > 0 And P2 > 0 Then

CleanIP = Mid(ResponsePage, P1 + 6, P2 - P1 - 6)
CleanIP = Trim(CleanIP)
CleanIP = Replace(CleanIP, Chr(13), "") 'Clear Caregreturn
CleanIP = Replace(CleanIP, Chr(10), "")

GetRealIp = CleanIP
Else

GetRealIp = "*"
End If

'----------------------


 Set GetConnection = Nothing


End Function

ومثال ايضا

RealIP.rar

الإنسان الذي يقول بأنه لا يمكن عمل شيء يجب ألا يعيق مطلقاً الإنسان الذي يقوم بعمل ذلك الشيء.

إن تخطئ فأنت إنسان ... أما أن تلوم جهازك الكمبيوتر على خطأك فهذا أكثر إنسانية.

#3

جاري التجربة

خطوات فيجوالية

--------------------------------------

التحزيم بواسطة Package & Deployment Wizard

أداة all date للتعامل مع الوقت

التعامل مع app.path دروس للمبتدئين

اصنع ocx من تصميمك لجميع احتيجاتك دروس للمبتدئين

شرح برنامج fack foder لحماية الفهارس

مواضيع اخرى

--------------------------------------

سجل بياناتك للاشتراك في رابطة المبرمجين المصريين, للاخوة المصريين او العرب المقيمين بمصر

عني = about me

--------------------------------------

مدونتي مصري للنهاية

--------------------------------------

على اسم مصر التاريخ يقدر يقول ما شاء ............... انا مصر عندي احب و اجمل الاشياء

#4

لكن هل يوجد طريقة لمعرفة الاي بي من الجهاز مباشرة دون اللجوء الى النت

يعني هل نستطيع استخدام الالية التي تستخدمها صفحة النت لاستخراج الاي بي

وشكرا

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

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

عدد الزوار حالياً

المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

جارٍ التحقق من المتواجدين…