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