7

私はExcel VBAアプリケーションに取り組んでいます。

私の会社はそれを製品にしたいと思っています。このアプリケーションは、1 つのシステムにのみインストールできる必要があります。誰かがこれを手伝ってくれませんか。

4

1 に答える 1

24

これは、製品が 1 つのシステムだけにインストールされるようにする方法の基本的な例にすぎません。

論理：

  1. ハードウェア ID を取得します (例: ハードディスク番号、CPU 番号など...)
  2. ユーザー名とメールアドレスを尋ねることもできます
  3. 上記の情報を暗号化して生成しますUnique Code(これはアプリ内で行われます)
  4. ユーザーはあなたに送信しますUnique Code（メール/オンラインアクティベーション/電話で）
  5. Activation Idに基づいてユーザーに送信しますUnique Code

ハードディスクのシリアル番号とCPU番号を取得するためのコード

このコードをクラス モジュールに貼り付けます (私のコードではありません。コードに著作権情報が記載されています) 。

Private Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1

Private Enum HDINFO
    HD_MODEL_NUMBER
    HD_SERIAL_NUMBER
    HD_FIRMWARE_REVISION
End Enum

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Type IDEREGS
    bFeaturesReg As Byte
    bSectorCountReg As Byte
    bSectorNumberReg As Byte
    bCylLowReg As Byte
    bCylHighReg As Byte
    bDriveHeadReg As Byte
    bCommandReg As Byte
    bReserved As Byte
End Type

Private Type SENDCMDINPARAMS
    cBufferSize As Long
    irDriveRegs As IDEREGS
    bDriveNumber As Byte
    bReserved(1 To 3) As Byte
    dwReserved(1 To 4) As Long
End Type

Private Type DRIVERSTATUS
    bDriveError As Byte
    bIDEStatus As Byte
    bReserved(1 To 2) As Byte
    dwReserved(1 To 2) As Long
End Type

Private Type SENDCMDOUTPARAMS
    cBufferSize As Long
    DStatus As DRIVERSTATUS
    bBuffer(1 To 512) As Byte
End Type

Private Declare Function GetVersionEx _
    Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long

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, _
    lpInBuffer As Any, _
    ByVal nInBufferSize As Long, _
    lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, _
    lpBytesReturned As Long, _
    ByVal lpOverlapped As Long) As Long

Private Declare Sub ZeroMemory _
    Lib "kernel32" Alias "RtlZeroMemory" _
    (dest As Any, _
    ByVal numBytes As Long)

Private Declare Sub CopyMemory _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Private Declare Function GetLastError _
    Lib "kernel32" () As Long

Private mvarCurrentDrive As Byte
Private mvarPlatform As String

Public Property Get Copyright() As String
    Copyright = "HDSN Vrs. 1.00, (C) Antonio Giuliana, 2001-2003"
End Property

Public Function GetModelNumber() As String
    GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER)
End Function

Public Function GetSerialNumber() As String
    GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER)
End Function

Public Function GetFirmwareRevision() As String
    GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION)
End Function

Public Property Let CurrentDrive(ByVal vData As Byte)
    If vData < 0 Or vData > 3 Then
        Err.Raise 10000, , "Illegal drive number"   ' IDE drive 0..3
    End If
    mvarCurrentDrive = vData
End Property

Public Property Get CurrentDrive() As Byte
    CurrentDrive = mvarCurrentDrive
End Property

Public Property Get Platform() As String
    Platform = mvarPlatform
End Property

Private Sub Class_Initialize()
    Dim OS As OSVERSIONINFO

    OS.dwOSVersionInfoSize = Len(OS)
    Call GetVersionEx(OS)
    mvarPlatform = "Unk"
    Select Case OS.dwPlatformId
        Case Is = VER_PLATFORM_WIN32S
            mvarPlatform = "32S"
        Case Is = VER_PLATFORM_WIN32_WINDOWS
            If OS.dwMinorVersion = 0 Then
                mvarPlatform = "W95"
            Else
                mvarPlatform = "W98"
            End If
        Case Is = VER_PLATFORM_WIN32_NT
            mvarPlatform = "WNT"
    End Select
End Sub

Private Function CmnGetHDData(hdi As HDINFO) As String
    Dim bin As SENDCMDINPARAMS
    Dim bout As SENDCMDOUTPARAMS
    Dim hdh As Long
    Dim br As Long
    Dim ix As Long
    Dim hddfr As Long
    Dim hddln As Long
    Dim s As String

    Select Case hdi
        Case HD_MODEL_NUMBER
            hddfr = 55
            hddln = 40
        Case HD_SERIAL_NUMBER
            hddfr = 21
            hddln = 20
        Case HD_FIRMWARE_REVISION
            hddfr = 47
            hddln = 8
        Case Else
            Err.Raise 10001, "Illegal HD Data type"

    End Select

    Select Case mvarPlatform
        Case "WNT"
            hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _
                GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _
                0, OPEN_EXISTING, 0, 0)
        Case "W95", "W98"
            hdh = CreateFile("\\.\Smartvsd", _
                0, 0, 0, CREATE_NEW, 0, 0)
        Case Else
            Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)"
    End Select
    If hdh = 0 Then
        Err.Raise 10003, , "Error on CreateFile"
    End If

    ZeroMemory bin, Len(bin)
    ZeroMemory bout, Len(bout)

    With bin
        .bDriveNumber = mvarCurrentDrive
        .cBufferSize = 512
        With .irDriveRegs
            If (mvarCurrentDrive And 1) Then
                .bDriveHeadReg = &HB0
            Else
                .bDriveHeadReg = &HA0
            End If
            .bCommandReg = &HEC
            .bSectorCountReg = 1
            .bSectorNumberReg = 1
        End With
    End With

    DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _
                    bin, Len(bin), bout, Len(bout), br, 0

    s = ""
    For ix = hddfr To hddfr + hddln - 1 Step 2
        If bout.bBuffer(ix + 1) = 0 Then Exit For
        s = s & Chr(bout.bBuffer(ix + 1))
        If bout.bBuffer(ix) = 0 Then Exit For
        s = s & Chr(bout.bBuffer(ix))
    Next ix

    CloseHandle hdh

    CmnGetHDData = Trim(s)
End Function

その後、次を使用して呼び出すことができます

'~~> Get the CPU No
CPU = GetWmiDeviceSingleValue("Win32_Processor", "ProcessorID")

'~~> Get the Hard Disk No
Dim h As HDSN

Set h = New HDSN

With h
    .CurrentDrive = 0
    HDNo = .GetSerialNumber
End With

Set h = Nothing

この情報を入手したら、それを名、姓、および電子メール アドレスと結合して、文字列を作成できます。例えば

strg = Trim(FirstName) & Chr(1) & Trim(LastName) & Chr(1) & _
       Trim(EmailAddress) & Chr(1) & Trim(CPU) & Chr(1) & Trim(HDNo)

文字列を取得したら、それを暗号化できます。これは、暗号化の別の基本的な例です。任意のタイプの暗号化を選択できます

For i = 1 To Len(strg)
    RandomNo = (Rnd * 100)
    tmp = tmp & Hex((Asc(Mid(strg, i, 1)) Xor RandomNo))
Next

上記tmpは暗号化された文字列を保持します。

この文字列を受け取ったら、それをデコードし、それにActivation Id基づいて を作成する必要があります。アプリは を受け入れることができるはずですActivation Id。この情報をレジストリまたは Dat ファイルに保存するオプションもあります。

簡単な登録ウィンドウは次のようになります。

ここに画像の説明を入力

これで始められることを願っています！:)

IMP : VBA プロジェクトをロックすることはできますが、ハッキング防止とは言えません。VSTO を調べて、上記のことを行う DLL を作成することをお勧めします。

于 2012-12-21T06:10:38.643 に答える