libtestusers.bas

来自「本系统是给大庆油田做的一个示例程序」· BAS 代码 · 共 82 行

Attribute VB_Name = "LibTestUsers"
Option Explicit
Rem 读系统序列号，需调用如下函数
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
       ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
       lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
       ByVal nFileSystemNameSize As Long) As Long

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Rem 读硬盘列号，需调用DiskID32.dll
Declare Function DiskID32 Lib "DiskID32.DLL" (ByRef DiskModel As Byte, ByRef DiskID As Byte) As Long
Rem 读系统序列号
Sub GetSerialNumber(SerialNum As Long)
    Dim Res As Long
    Dim temp1 As String, temp2 As String
    temp1 = String$(255, Chr$(0))
    temp2 = String$(255, Chr$(0))
    Res = GetVolumeInformation("c:\", temp1, Len(temp1), SerialNum, 0, 0, temp2, Len(temp2))
End Sub
Rem 读硬盘列号
Sub ReadDiskSeriesNum(Id As String)
    Dim i As Integer
    Dim Model As String
    Dim DiskModel(31) As Byte, DiskID(31) As Byte
    
    If DiskID32(DiskModel(0), DiskID(0)) <> 1 Then
        MsgBox "get diskid32 err"
        Exit Sub
    End If
    For i = 0 To 31
        If Chr(DiskModel(i)) <> Chr(0) Then
            Model = Model & Chr(DiskModel(i))
        End If
        If Chr(DiskID(i)) <> Chr(0) Then
            Id = Id & Chr(DiskID(i))
            Id = LTrim$(RTrim$(Id))
        End If
    Next
End Sub
Sub Test_Users()
    Dim ComputerSeriesNumbers_Allowed(200) As String
    Dim j As Integer
    Dim N As Integer, M As Integer
    
    Rem  读硬盘系列号
    Dim DiskModel(31) As Byte, DiskID(31) As Byte, i As Integer, Model As String, Id As String
    Call ReadDiskSeriesNum(Id)
    
    M = 80
    For j = 1 To M
        ComputerSeriesNumbers_Allowed(j) = ""
    Next j
    
    Rem 本机
    ComputerSeriesNumbers_Allowed(1) = "3DW522"
    
    Rem 大庆十一厂
    ComputerSeriesNumbers_Allowed(11) = "L3AXKJCG"
    ComputerSeriesNumbers_Allowed(12) = "L3AXK6XG"
    ComputerSeriesNumbers_Allowed(13) = "9LS6H1CL"
    
    N = 0
    For j = 1 To M
        If Id = ComputerSeriesNumbers_Allowed(j) Then
            N = 1
            Exit For
        End If
    Next j
    
    If N = 0 Then
        MsgBox "    未授权用户！"
        MsgBox "若希望应用该系统，请和燕山大学董世民教授联系！"
        MsgBox "  联系电话：[phone]！"
        End
    Else
    End If
End Sub