برنامج على الشبكة

[Faten Helles]

اذا كنت حاطط البرنامج على نت ورك، واريد ان احتفظ بمعلومات عن المستخدم اللي فتح البرنامج، مثل رقمه الوظيفي او اسم جهازه او ال IP address ماله، هل توجد طريقة لمعرفة هذه البيانات بالاكسس؟

[أمجد جمالي]

ممكن اخي الكريم

تفضل هذه هو الكود

  Public Const WS_VERSION_REQD = &H101
  Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
  Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
  Public Const MIN_SOCKETS_REQD = 1
  Public Const SOCKET_ERROR = -1
  Public Const WSADescription_Len = 256
  Public Const WSASYS_Status_Len = 128

Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long
Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Declare Function gethostname Lib "WSOCK32.DLL" (ByVal Hostname$, ByVal HostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal Hostname$) As Long
Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Public Type HOSTENT
      hName As Long
      hAliases As Long
      hAddrType As Integer
      hLength As Integer
      hAddrList As Long
End Type
  
Public Type WSADATA
      wversion As Integer
      wHighVersion As Integer
      szDescription(0 To WSADescription_Len) As Byte
      szSystemStatus(0 To WSASYS_Status_Len) As Byte
      iMaxSockets As Integer
      iMaxUdpDg As Integer
      lpszVendorInfo As Long
  End Type

Function Ap_GetHostNameAndIPAddress()

'##################################UserName And IP Address###########################
Dim StrHostName As String
Dim Hostname As String * 256
Dim Hostent_Addr As Long
Dim Host As HOSTENT
Dim HostIP_Addr As Long
Dim Temp_IP_Address() As Byte
Dim I As Integer
Dim StrIPAddress As String
        SocketsInitialize
                
      If gethostname(Hostname, 256) = SOCKET_ERROR Then
          MsgBox "Windows Sockets error " & Str(WSAGetLastError())
          Exit Function
      Else
          MsgBox Trim$(Hostname)
      End If
      Hostent_Addr = gethostbyname(Hostname)
      If Hostent_Addr = 0 Then
          MsgBox "Winsock.dll is not responding."
          Exit Function
      End If
      RtlMoveMemory Host, Hostent_Addr, LenB(Host)
      RtlMoveMemory HostIP_Addr, Host.hAddrList, 4
      StrHostName = Hostname
      'get all of the IP address if machine is  multi-homed
      Do
          ReDim Temp_IP_Address(1 To Host.hLength)
          RtlMoveMemory Temp_IP_Address(1), HostIP_Addr, Host.hLength
          For I = 1 To Host.hLength
              StrIPAddress = StrIPAddress & Temp_IP_Address(I) & "."
          Next
          StrIPAddress = Mid$(StrIPAddress, 1, Len(StrIPAddress) - 1)
          MsgBox StrIPAddress
          StrIPAddress = ""
          Host.hAddrList = Host.hAddrList + LenB(Host.hAddrList)
          RtlMoveMemory HostIP_Addr, Host.hAddrList, 4
       Loop While (HostIP_Addr <> 0)
       SocketsCleanup
'##################################UserName And IP Address###########################

End Function

Public Sub SocketsCleanup()

  Dim lReturn As Long

      lReturn = WSACleanup()

      If lReturn <> 0 Then
          MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
          End
      End If

  End Sub
  
Public Function hibyte(ByVal wParam As Integer)

      hibyte = wParam \ &H100 And &HFF&

End Function
  
Public Function lobyte(ByVal wParam As Integer)

      lobyte = wParam And &HFF&

End Function

Public Sub SocketsInitialize()
  
  Dim WSAD As WSADATA
  Dim iReturn As Integer
  Dim sLowByte As String, sHighByte As String, sMsg As String

      iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

      If iReturn <> 0 Then
          MsgBox "Winsock.dll is not responding."
          End
      End If

      If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
          WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then

          sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
          sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
          sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
          sMsg = sMsg & " is not supported by winsock.dll "
          MsgBox sMsg
          End
      End If

      'iMaxSockets is not used in winsock 2. So the following check is only
      'necessary for winsock 1. If winsock 2 is requested,
      'the following check can be skipped.

      If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
          sMsg = "This application requires a minimum of "
          sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
          MsgBox sMsg
          End
      End If

  End Sub

وطريقة استدعائه

Ap_GetHostNameAndIPAddress

تحياتي

تم تعديل أغسطس 23, 2005 بواسطه أمجد جمالي