MartyConnelly
martyconnelly at shaw.ca
Sat Jan 22 13:12:40 CST 2005
This method might be of interest to those in recent Polyps thread too.
Copy protection or how to safely distribute a demo Microsoft Access
Application from Tony Toews
http://www.granite.ab.ca/access/demo.htm
This will only stop the shadetree hacker.
Oops your Irish, a shadetree mechanic is one who fixes cars in his backyard.
Nowadays you need $5000 worth of software a year to do auto diagnosis.
There are some other hints on his site
Mac Addresses can be easily spoofed and also a machine may have multiple
NIC's hence multiple MAC's
NIC's also tend to be replaced easily and especially by network guys if
tracking Network problems.
Anyway here is some code from Stuart to get a MAC address
You can also do this via WMI with less code on newer OS W2000 +
The "Physical Address" returns the MAC Address
Option Compare Database
Option Explicit
Public Const MAX_HOSTNAME_LEN = 132
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Public Const ERROR_BUFFER_OVERFLOW = 111
Public Const MIB_IF_TYPE_ETHERNET = 1
Public Const MIB_IF_TYPE_TOKENRING = 2
Public Const MIB_IF_TYPE_FDDI = 3
Public Const MIB_IF_TYPE_PPP = 4
Public Const MIB_IF_TYPE_LOOPBACK = 5
Public Const MIB_IF_TYPE_SLIP = 6
Type IP_ADDR_STRING
Next As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End Type
Type IP_ADAPTER_INFO
Next As Long
ComboIndex As Long
AdapterName As String * MAX_ADAPTER_NAME_LENGTH
Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
AddressLength As Long
Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
Index As Long
Type As Long
DhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
HaveWins As Boolean
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type
Type FIXED_INFO
HostName As String * MAX_HOSTNAME_LEN
DomainName As String * MAX_DOMAIN_NAME_LEN
CurrentDnsServer As Long
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId As String * MAX_SCOPE_ID_LEN
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Public Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As
Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As
Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Function NWInfo() As Long
'This example was created by George Bernier (bernig at dinomail.qc.ca)
Dim error As Long
Dim FixedInfoSize As Long
Dim AdapterInfoSize As Long
Dim i As Integer
Dim PhysicalAddress As String
Dim NewTime As Date
Dim AdapterInfo As IP_ADAPTER_INFO
Dim Adapt As IP_ADAPTER_INFO
Dim AddrStr As IP_ADDR_STRING
Dim FixedInfo As FIXED_INFO
Dim Buffer As IP_ADDR_STRING
Dim pAddrStr As Long
Dim pAdapt As Long
Dim Buffer2 As IP_ADAPTER_INFO
Dim FixedInfoBuffer() As Byte
Dim AdapterInfoBuffer() As Byte
'Get the main IP configuration information for this machine using a
FIXED_INFO structure
FixedInfoSize = 0
error = GetNetworkParams(ByVal 0&, FixedInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetNetworkParams sizing failed with error " & error
Exit Function
End If
End If
ReDim FixedInfoBuffer(FixedInfoSize - 1)
error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
If error = 0 Then
CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
MsgBox "Host Name: " & FixedInfo.HostName 'host name
MsgBox "DNS Servers: " & FixedInfo.DnsServerList.IpAddress
'dns server IP
pAddrStr = FixedInfo.DnsServerList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
MsgBox "DNS Servers: " & Buffer.IpAddress 'dns server IP
pAddrStr = Buffer.Next
Loop
Select Case FixedInfo.NodeType 'node type
Case 1
MsgBox "Node type: Broadcast"
Case 2
MsgBox "Node type: Peer to peer"
Case 4
MsgBox "Node type: Mixed"
Case 8
MsgBox "Node type: Hybrid"
Case Else
MsgBox "Unknown node type"
End Select
MsgBox "NetBIOS Scope ID: " & FixedInfo.ScopeId 'scope ID
'routing
If FixedInfo.EnableRouting Then
MsgBox "IP Routing Enabled "
Else
MsgBox "IP Routing not enabled"
End If
' proxy
If FixedInfo.EnableProxy Then
MsgBox "WINS Proxy Enabled "
Else
MsgBox "WINS Proxy not Enabled "
End If
' netbios
If FixedInfo.EnableDns Then
MsgBox "NetBIOS Resolution Uses DNS "
Else
MsgBox "NetBIOS Resolution Does not use DNS "
End If
Else
MsgBox "GetNetworkParams failed with error " & error
Exit Function
End If
'Enumerate all of the adapter specific information using the
IP_ADAPTER_INFO structure.
'Note: IP_ADAPTER_INFO contains a linked list of adapter entries.
AdapterInfoSize = 0
error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetAdaptersInfo sizing failed with error " & error
Exit Function
End If
End If
ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
' Get actual adapter information
error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
If error <> 0 Then
MsgBox "GetAdaptersInfo failed with error " & error
Exit Function
End If
CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
pAdapt = AdapterInfo.Next
Do While pAdapt <> 0
CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
Select Case Buffer2.Type
Case MIB_IF_TYPE_ETHERNET
MsgBox "Ethernet adapter "
Case MIB_IF_TYPE_TOKENRING
MsgBox "Token Ring adapter "
Case MIB_IF_TYPE_FDDI
MsgBox "FDDI adapter "
Case MIB_IF_TYPE_PPP
MsgBox "PPP adapter"
Case MIB_IF_TYPE_LOOPBACK
MsgBox "Loopback adapter "
Case MIB_IF_TYPE_SLIP
MsgBox "Slip adapter "
Case Else
MsgBox "Other adapter "
End Select
MsgBox " AdapterName: " & Buffer2.AdapterName
MsgBox "AdapterDescription: " & Buffer2.Description 'adatpter name
For i = 0 To Buffer2.AddressLength - 1
PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
If i < Buffer2.AddressLength - 1 Then
PhysicalAddress = PhysicalAddress & "-"
End If
Next
MsgBox "Physical Address: " & PhysicalAddress 'mac address
If Buffer2.DhcpEnabled Then
MsgBox "DHCP Enabled "
Else
MsgBox "DHCP disabled"
End If
pAddrStr = Buffer2.IpAddressList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
MsgBox "IP Address: " & Buffer.IpAddress
MsgBox "Subnet Mask: " & Buffer.IpMask
pAddrStr = Buffer.Next
If pAddrStr <> 0 Then
CopyMemory Buffer2.IpAddressList, ByVal pAddrStr,
Len(Buffer2.IpAddressList)
End If
Loop
MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
pAddrStr = Buffer2.GatewayList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer)
MsgBox "IP Address: " & Buffer.IpAddress
pAddrStr = Buffer.Next
If pAddrStr <> 0 Then
CopyMemory Buffer2.GatewayList, ByVal pAddrStr,
Len(Buffer2.GatewayList)
End If
Loop
MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress
MsgBox "Primary WINS Server: " & Buffer2.PrimaryWinsServer.IpAddress
MsgBox "Secondary WINS Server: " & Buffer2.SecondaryWinsServer.IpAddress
' Display time
NewTime = CDate(Adapt.LeaseObtained)
MsgBox "Lease Obtained: " & CStr(NewTime)
NewTime = CDate(Adapt.LeaseExpires)
MsgBox "Lease Expires : " & CStr(NewTime)
pAdapt = Buffer2.Next
If pAdapt <> 0 Then
CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
End If
Loop
End Function
-- Stuart
--
Tom Hayes wrote:
>To introduce- My name is Tom Hayes - I run a small IT business in the west of Ireland - Galway to be precise. Land of milk and guinness!
>
>I build solutions using MS Access - I have been training and working with the app. for six years. I want to prevent some of my generic solutions being copied and used without my knowledge.
>
>
>The ideal solution for me is a way to identify the unique computer number (i think this is reffered to as the host id) and set this as a constant in a module in each individual database (mde). Each time the database is opened the computers unique id will be referenced by the database and either open or lock depending on comparison.
>
>Background: due to the nauture of the solution - I will configure each database to each cpu and that is then delivered to site. If there is a problem a complete new system ie hardware/ software is removed and returned. There will be no ligitimate reason why the software should be used on a different terminal.
>
>I have used code in the past to retrieve Usernames into an access solution;
>Option Compare Database
>Option Explicit
>
>Declare Function GetUserName Lib "advapi32.dll" Alias _
>"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
>As Long
>
>Public Function fntUsername() As String
>Dim s As String
>Dim cnt As Long
>Dim dl As Long
>Dim CurUser As String
>
>cnt = 199
>s = String$(200, 0)
>dl = GetUserName(s, cnt)
>If dl <> 0 Then CurUser = Left$(s, cnt) Else CurUser = ""
>fntUsername = CurUser
>
>
>
>End Function
>
>
>
>Can you help or offer an alternative?
>
>reagrds
>
>Tom
>
>Business Development Manager
>HayesMinton Ltd
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada