אופיס 365 זיהוי כתובת IP

[ארי4791]

האם יש קוד באקסס למציאת כתובת הIP של המחשב?
והאם יש איזשהו קוד לכל מחשב גם כשלא מחובר לאינטרנט?
אני רוצה לעשות תוכנה שתזהה באיזה מחשב היא מופעלת.
תודה רבה

 

[דוד אי]

בvb.net:

System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName()).AddressList(0).ToString()

 

[ארי4791]

תודה, אבל אני מחפש בVBA
מצאתי קוד למציאת IP, אבל אני רוצה לשאול האם יש קוד אחר לכל מחשב גם בלי רשת?
תודה רבה

 

[moishy]

Option Explicit
'----------------------------------------------------------------------------
'This module contains 3 functions for determing the public IP, the local IP
'and the MAC address of the computer that runs those functions.
'Written By:    Christos Samaras
'Date:          22/11/2014
'E-mail:        <לא ניתן לפרסם מיילים באופן פומבי>
'Site:          http://www.myengineeringworld.net
'----------------------------------------------------------------------------
Function GetMyPublicIP() As String
Dim HttpRequest As Object
On Error Resume Next
'Create the XMLHttpRequest object.
Set HttpRequest = CreateObject("MSXML2.XMLHTTP")
'Check if the object was created.
If Err.Number <> 0 Then
'Return error message.
GetMyPublicIP = "Could not create the XMLHttpRequest object!"
'Release the object and exit.
Set HttpRequest = Nothing
Exit Function
End If
On Error GoTo 0
'Create the request - no special parameters required.
HttpRequest.Open "GET", "http://myip.dnsomatic.com", False
'Send the request to the site.
HttpRequest.Send
'Return the result of the request (the IP string).
GetMyPublicIP = HttpRequest.ResponseText
End Function
Function GetMyLocalIP() As String
'Declaring the necessary variables.
Dim strComputer     As String
Dim objWMIService   As Object
Dim colItems        As Object
Dim objItem         As Object
Dim myIPAddress     As String
'Set the computer.
strComputer = "."
'The root\cimv2 namespace is used to access the Win32_NetworkAdapterConfiguration class.
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'A select query is used to get a collection of IP addresses from the network adapters that have the property IPEnabled equal to true.
Set colItems = objWMIService.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
'Loop through all the objects of the collection and return the first non-empty IP.
For Each objItem In colItems
If Not IsNull(objItem.IPAddress) Then myIPAddress = Trim(objItem.IPAddress(0))
Exit For
Next
'Return the IP string.
GetMyLocalIP = myIPAddress
End Function
Function GetMyMACAddress() As String
'Declaring the necessary variables.
Dim strComputer     As String
Dim objWMIService   As Object
Dim colItems        As Object
Dim objItem         As Object
Dim myMACAddress    As String
'Set the computer.
strComputer = "."
'The root\cimv2 namespace is used to access the Win32_NetworkAdapterConfiguration class.
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'A select query is used to get a collection of network adapters that have the property IPEnabled equal to true.
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
'Loop through all the collection of adapters and return the MAC address of the first adapter that has a non-empty IP.
For Each objItem In colItems
If Not IsNull(objItem.IPAddress) Then myMACAddress = objItem.MACAddress
Exit For
Next
'Return the IP string.
GetMyMACAddress = myMACAddress
End Function

הפונקציה GetMyMACAddress זה מה שאתה מחפש.

מקור: https://myengineeringworld.net/2014/12/public-ip-mac-address-vba.html

 

[FullTime]

זה יתן לך את הסריאל של המחשב.

Function GetSerialNumber() As String

    Dim fsObj As Object
    Dim drv As Object
    Dim HDSerialNumber As String
    Dim strAllNumber As String

    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives(Left(CurrentProject.Path, 1))

    HDSerialNumber = Hex(drv.SerialNumber)

    GetSerialNumber = parseNum(HDSerialNumber)

End Function

Function parseNum(strSearch As String) As String

    Dim i As Integer
    Dim tempVal As String

    For i = 1 To Len(strSearch)
        If IsNumeric(Mid(strSearch, i, 1)) Then
            tempVal = tempVal + Mid(strSearch, i, 1)
        End If
    Next

    parseNum = tempVal

End Function

וקוד כזה בעת פתיחה של הטופס הראשון, יגביל את פתיחת הקובץ [לאנשים פשוטים בלבד]...
כאן הסיסמה הנגדית מאוחסנת בטבלה בשם tblNumber תוכל גם לשים אותו בקובץ, אבל אחד שיודע לפענח את הקוד שבטבלה גם יידע לפענח את הקובץ.

    Dim strKode As String
    Dim strSerialKode As String
    Dim inputGetNumber As String

    strSerialKode = Round(GetSerialNumber * 10/10/2*50 , 0) ''חישוב שלך

    strKode = DLookup("number", "tblnumber")

    If strKode <> strSerialKode Then
   
        inputGetNumber = InputBox("התוכנה אינה רשומה!" & vbCrLf & "קוד נעילה: " & GetSerialNumber)

        If inputGetNumber = Round(GetSerialNumber * * 10/10/2*50, 0) Then ''חישוב שלך
            DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE tblNumber SET tblNumber.[Number] = " & inputGetNumber
            DoCmd.SetWarnings True
            MsgBox "נרשם בהצלחה!" & vbCrLf & "תודה שרכשת את אימון התוכנה.", vbMsgBoxRight + vbMsgBoxRtlReading
        Else
            MsgBox "שגיאת רישום, פנה ל ... לקבלת הקוד" & vbCrLf & "התוכנה נסגרת!!!", vbMsgBoxRight + vbMsgBoxRtlReading
            Cancel = True
        End If
    End If

 

[moishy]

זה יתן לך את הסריאל של המחשב.

Function GetSerialNumber() As String

    Dim fsObj As Object
    Dim drv As Object
    Dim HDSerialNumber As String
    Dim strAllNumber As String

    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives(Left(CurrentProject.Path, 1))

    HDSerialNumber = Hex(drv.SerialNumber)

    GetSerialNumber = parseNum(HDSerialNumber)

End Function

רק צריך לדעת שאחרי פירמוט הסריאל שהפונקציה הזו מחזירה היא שונה.

 

[ארי4791]

אני צריך משהו שלא משתנה אף פעם
תודה רבה

 

[FullTime]

רק צריך לדעת שאחרי פירמוט הסריאל שהפונקציה הזו מחזירה היא שונה.

ומתי הסריאל מתפרמט?

 

[moishy]

ומתי הסריאל מתפרמט?

הסריאל שהפונקציה מחזירה הוא סריאל לוגי. תבדוק על דיסק און קי, אחרי כל פירמוט הסריאל ישתנה.

 

[moishy]

אני צריך משהו שלא משתנה אף פעם
תודה רבה

כבר כתבתי לך פתרון, להשתמש עם הכתובת מאק.

 

[ארי4791]

כבר כתבתי לך פתרון, להשתמש עם הכתובת מאק.

הכתובת הזאת לא משתנה אף פעם?

 

[moishy]

היא משתנה אם מחליפים את הכרטיס רשת.

 

[ארי4791]

וה-IP משתנה מתישהו?

 

[ארי4791]

והאם יש דרך למצוא את השם משתמש?
תודה רבה מאוד

 

[ימהר]

והאם יש דרך למצוא את השם משתמש?

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
    Dim lngLen As Long, lngX As Long
    Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If lngX <> 0 Then
        fOSUserName = Left$(strUserName, lngLen - 1)
    Else
        fOSUserName = ""
    End If
End Function

הוא משתמש עם API וצריך להתאים אותו עם PtrSafe ל64 ביט

מקור

 

[יוגורט]

IP יכול להשתנות, mac לא משתנה
בנוסף לכל המחשבים ברשת המקומית יש IP אחד חיצוני

 

[moishy]

וה-IP משתנה מתישהו?

לרוב המשתמשים באינטרנט בישראל יש אייפי דינמי, כלומר אייפי שמשתנה מידי פעם. אצל מרבית הספקים ניתן לקבל אייפי קבוע בתוספת תשלום.

 

[ari rm]

בס"ד
אם מחליפים את הדיסק קשיח ממחשב למחשב (בנייד מצוי מאוד)
הMAC נשאר פתרון?

 

[moishy]

בס"ד
אם מחליפים את הדיסק קשיח ממחשב למחשב (בנייד מצוי מאוד)
הMAC נשאר פתרון?

המאק לא קשור לדיסק קשיח הוא קשור לכרטיס רשת.

 

[ari rm]

לכן אם אני מכניס את הדיסק קשיח למחשב אחר (כרטיס רשת שונה) אני לא יוכל לעבוד אם התוכנה אם היא תהיה מוגבלת לכרטיס רשת במחשב הראשון