Vise se i ne sjecam odakle sam skinuo ovaj gotov kod za zastitu baze ali vjerno me sluzio do danas.
Naime, danas sam svoj "uradak" baze postavio na server (mislim na back end) i pokusao sa implementacijom front end tzv.baze na ostalim racunarima.
Prvi problem na koji sam naisao, bio je nemogucnost ocitavanja serijskog broja diska pomocu ovog koda.
ovaj modul se zove modCopyProtection i vjerujem da je mnogima dobro poznat
Code:
Option Explicit
Option Compare Database
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1&
Public Const DFP_GET_VERSION = &H74080
Public Const DFP_SEND_DRIVE_COMMAND = &H7C084
Public Const DFP_RECEIVE_DRIVE_DATA = &H7C088
Public Const IDE_ATAPI_IDENTIFY = &HA1
Public Const IDE_ATA_IDENTIFY = &HEC
Public Const IDENTIFY_BUFFER_SIZE = 512
Public Type GETVERSIONOUTPARAMS
bVersion As Byte ' Binary driver version.
bRevision As Byte ' Binary driver revision.
bReserved As Byte ' Not used.
bIDEDeviceMap As Byte ' Bit map of IDE devices.
fCapabilities As Long ' Bit mask of driver capabilities.
dwReserved1 As Long ' For future use.
dwReserved2 As Long ' For future use.
dwReserved3 As Long ' For future use.
dwReserved4 As Long ' For future use.
End Type
Public Type IDEREGS
bFeaturesReg As Byte ' Used for specifying SMART "commands".
bSectorCountReg As Byte ' IDE sector count register
bSectorNumberReg As Byte ' IDE sector number register
bCylLowReg As Byte ' IDE low order cylinder value
bCylHighReg As Byte ' IDE high order cylinder value
bDriveHeadReg As Byte ' IDE drive/head register
bCommandReg As Byte ' Actual IDE command.
bReserved As Byte ' reserved for future use. Must be zero.
End Type
Public Type SENDCMDINPARAMS
cBufferSize As Long ' Buffer size in bytes
irDriveRegs As IDEREGS ' Structure with drive register values.
bDriveNumber As Byte ' Physical drive number to send command to (0,1,2,3).
bReserved1 As Byte ' Reserved for future expansion.
bReserved2 As Byte ' Reserved for future expansion.
bReserved3 As Byte ' Reserved for future expansion.
dwReserved1 As Long ' For future use.
dwReserved2 As Long ' For future use.
dwReserved3 As Long ' For future use.
dwReserved4 As Long ' For future use.
bBuffer() As Byte ' Input buffer.
End Type
Public Type DRIVERSTATUS
bDriverError As Byte ' Error code from driver, or 0 if no error.
bIDEStatus As Byte ' Contents of IDE Error register, only valid when bDriverError is SMART_IDE_ERROR.
bReserved1 As Byte ' Reserved for future expansion.
bReserved2 As Byte ' Reserved for future expansion.
dwReserved1 As Long ' Reserved for future expansion.
dwReserved2 As Long ' Reserved for future expansion.
End Type
Public Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
inDriveStatus As DRIVERSTATUS ' Driver status structure.
bBuffer() As Byte ' Buffer of arbitrary length in which to store the data read from the // drive.
End Type
Public Enum vbDiskDataType
vbDriveModelNumber = 0
vbDriveSerialNumber = 1
vbDriveControllerRevisionNumber = 2
vbControllerBufferSize = 3
vbDriveType = 4
End Enum
Function ConvertToString(DiskData() As Byte, firstIndex As Long, lastIndex As Long) As String
Dim Index As Integer
Dim S As String
Index = firstIndex
While Index <= lastIndex
S = S + Chr(DiskData(Index + 1)) + Chr(DiskData(Index))
Index = Index + 2
Wend
ConvertToString = Trim(S)
End Function
Function GetDiskData(DataType As vbDiskDataType) As String
GetDiskData = ""
Dim hPhysicalDriveIOCTL As Long
hPhysicalDriveIOCTL = CreateFile("\\.\PhysicalDrive0", _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, _
OPEN_EXISTING, 0, 0)
If hPhysicalDriveIOCTL <> INVALID_HANDLE_VALUE Then
Dim VersionParams As GETVERSIONOUTPARAMS
Dim cbBytesReturned As Long
If DeviceIoControl(hPhysicalDriveIOCTL, DFP_GET_VERSION, _
Null, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0) <> 0 Then
If VersionParams.bIDEDeviceMap > 0 Then
Dim cmd_in As SENDCMDINPARAMS
Dim cmd_out As SENDCMDOUTPARAMS
Dim buf(Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1) As Byte
Dim bIDCmd As Byte
If (VersionParams.bIDEDeviceMap And &H10) = &H10 Then
bIDCmd = IDE_ATAPI_IDENTIFY
Else
bIDCmd = IDE_ATA_IDENTIFY
End If
cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
cmd_in.irDriveRegs.bFeaturesReg = 0
cmd_in.irDriveRegs.bSectorCountReg = 1
cmd_in.irDriveRegs.bSectorNumberReg = 1
cmd_in.irDriveRegs.bCylLowReg = 0
cmd_in.irDriveRegs.bCylHighReg = 0
cmd_in.irDriveRegs.bDriveHeadReg = &HA0 ' 0xA0 | ((bDriveNum & 1) << 4);
cmd_in.irDriveRegs.bCommandReg = bIDCmd
cmd_in.bDriveNumber = 0 ' bDriveNum
cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
cbBytesReturned = 0
If DeviceIoControl(hPhysicalDriveIOCTL, DFP_RECEIVE_DRIVE_DATA, _
cmd_in, Len(cmd_in) - 1, buf(0), _
Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1, _
cbBytesReturned, 0) <> 0 Then
If DataType = vbDriveModelNumber Then GetDiskData = ConvertToString(buf, 70, 108)
If DataType = vbDriveSerialNumber Then GetDiskData = ConvertToString(buf, 36, 54)
If DataType = vbDriveControllerRevisionNumber Then GetDiskData = ConvertToString(buf, 62, 68)
If DataType = vbControllerBufferSize Then GetDiskData = Str((CLng(buf(58)) + CLng(buf(59)) * 256) * 512)
If DataType = vbDriveType Then
If (buf(16) And &H80) = &H80 Then
GetDiskData = "Removable"
ElseIf (buf(16) And &H40 = &H40) Then
GetDiskData = "Fixed"
Else
GetDiskData = "Unknown"
End If
End If
End If
End If
End If
CloseHandle hPhysicalDriveIOCTL
End If
End Function
Function IsRegistered() As Boolean
IsRegistered = (GetPropertyValue("registration", "") = GetDiskData(vbDriveSerialNumber))
End Function
Sub RegisterProgram()
SetPropertyValue "registration", dbText, GetDiskData(vbDriveSerialNumber)
End Sub
Sub UnRegisterProgram()
RemoveProperty "registration"
End Sub
koji je takodje na neki nacin vezan sa ovim kodom (modul se zove modMDBProperties)
Code:
Option Compare Database
Option Explicit
Function PropertyExists(PropertyName As String) As Boolean
On Error GoTo PropertyExists_Error
PropertyExists = False
If CurrentDb.Properties(PropertyName).Name <> PropertyName Then GoTo PropertyExists_Error
PropertyExists = True
PropertyExists_Error:
End Function
Function GetPropertyValue(PropertyName As String, Default As Variant) As Variant
On Error GoTo GetPropertyValue_Error
GetPropertyValue = Default
If PropertyExists(PropertyName) Then GetPropertyValue = CurrentDb.Properties(PropertyName).Value
GetPropertyValue_Error:
End Function
Function SetPropertyValue(PropertyName As String, ValueType As Integer, Value As Variant) As Boolean
'On Error GoTo SetPropertyValue_Error
SetPropertyValue = False
If PropertyExists(PropertyName) Then
CurrentDb.Properties(PropertyName).Value = Value
SetPropertyValue = True
Else
Dim NewProperty As Property
Set NewProperty = CurrentDb.CreateProperty(PropertyName, ValueType, Value)
CurrentDb.Properties.Append NewProperty
SetPropertyValue = True
End If
SetPropertyValue_Error:
End Function
Function RemoveProperty(PropertyName As String) As Boolean
On Error GoTo RemoveProperty_Error
RemoveProperty = False
If PropertyExists(PropertyName) Then CurrentDb.Properties.Delete PropertyName
RemoveProperty = True
RemoveProperty_Error:
End Function
a sve ovo je "zacinjeno" sljedecim kodom na formi registracija
Option Compare Database
Private Sub ButtonProvjeraSifra_Click()
If EditSifra.Value = "ovdje je neka moja sifra" Then
Call RegisterProgram
DoCmd.Close
DoCmd.OpenForm "frmStartUp"
Else
MsgBox "Žao mi je ali Vaš aktivacijski kôd nije ispravan!", vbCritical, "Registracija nije uspjela!"
End If
End Sub
Ovo sve funkcionise super na racunarima sa administratorskim pravima, medjutim kada se ovo pokusa pokrenuti na accauntima koji nemaju ta prava onda u polju (gdje se inace pojavi broj diska) nema nista. i nakon unosa one moje sifre za registraciju opet se nista ne desava.
Pokusao sam i sa logovanjemi na administratorski acc. tamo odradi sve OK ali kad se ponovo vratim na korisnicki opet nista.
Sljedeci pokusaj je bio "rucno" pokretanje registracije u VB ali opet nista jer zaglavi u pola procedure.
Ako moze neko da mi "protumaci" ove moje nocne more i pokusa pomoci shvatiti gdje se ustvari smjestaju ti podaci o registraciji kako bih je mogao zaobici, bio bih veoma zahvalan jer nisam programer pa ruku na srce i ne razumijem dosta ovog koda.
Iskreno ne znam kakve ovo ima veze sa HDD jer je ista sifra bez obzira koji broj ucitao ali napominjem da je to sve radilo i ta
Citat:
If EditSifra.Value = "ovdje je neka moja sifra" Then
je nekim dijelom zasticena sifrom na VB projektu.
Hvala na svakoj pomoci