modsys.bas

一个完整的非接触IC卡会员管理系统

Attribute VB_Name = "modSys"
Public maSys_db As ADODB.Connection '本地数据库
'Public maSys_db As ADODB.Connection    '中心数据库
Public strUserName As String
Public sJc As String
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function cTOasc(c As String) As String
    Dim a() As Byte
    a = StrConv(c, vbFromUnicode)
    cTOasc = ""
    For i = 0 To UBound(a)
        cTOasc = cTOasc + hex(a(i))
    Next
End Function

Public Function ascTOc(asc As String) As String
    Dim PutAsc As String
    For i = 1 To Len(asc)
        PutAsc = Mid(asc, i, 4)
        sMe = Chr("&H" + PutAsc)
        ascTOc = ascTOc + sMe
        i = i + 3
    Next
End Function

Public Function GetRecordset(mConn As ADODB.Connection, ByVal sQuery As String) As ADODB.Recordset
    Dim mRst As New ADODB.Recordset
    
    mRst.LockType = adLockReadOnly
    Set mRst.ActiveConnection = mConn
    mRst.Open sQuery
    Set GetRecordset = mRst
End Function

Sub Main()
'    Dim rKey(8) As Byte ' As String
'    Dim rKeyAB(8) As Byte
'    Dim rKeySa(8) As Byte
'    s = "1234567812345678"
'    rKey(0) = &H12
'    rKey(1) = &H34
'    rKey(2) = &H56
'    rKey(3) = &H78
'    rKey(4) = &H12
'    rKey(5) = &H34
'    rKey(6) = &H56
'    rKey(7) = &H78
'
'    rKeyAB(0) = &H66
'    rKeyAB(1) = &HC2
'    rKeyAB(2) = &H5E
'    rKeyAB(3) = &H57
'    rKeyAB(4) = &H66
'    rKeyAB(5) = &HC2
'    rKeyAB(6) = &H5E
'    rKeyAB(7) = &H57
'    st = ic_encrypt(rKey(0), rKeyAB(0), 8, rKeySa(0)) 's2KEYB
'    sTest = ""
'    For i = 0 To 5
'    sTest = sTest & Right("00" + hex(rKeySa(i)), 2)
'    Next i
    sSystem = "Test"
    If App.PrevInstance Then
        MsgBox "该程序已经运行，请退出！", vbInformation, "系统提示"
        Exit Sub
    Else
         Call SystemInit
'        Set SD = New CDatabaseConnector '初始化数据库（Sql server）连接，并打开
'
'        Set maSys_db = New ADODB.Connection
'        Set maSys_db = SD.DatabaseConnect
'
        Set AD = New db 'Caccess   '初始化数据库（Access）连接，并打开
        Set maSys_db = New ADODB.Connection
        Set maSys_db = AD.DatabaseConnect
        frm_login.Show 1
    End If
End Sub

Public Function WriteData(psStr() As Byte) As Boolean
    Dim MaxSize
    Dim Index As Long
    Dim pbIn(31) As Byte
    Dim i As Integer
    For i = 0 To 31
        pbIn(i) = psStr(i)
    Next i
    On Error GoTo E:
    Open App.Path & "\" + "data.full" For Binary As #3
    MaxSize = LOF(3)
    If MaxSize > 0 Then
        Seek #3, MaxSize + 1
    End If
    Put #3, , pbIn
    Close #3
    Exit Function
E:
    MsgBox "系统错误:Data.dat已被打开或没发现！", vbCritical, "系统提示"
End Function

Public Function GetPCName() As String
Dim i As Integer
Dim PCName As String * 20
i = GetComputerName(PCName, 20)
For i = 1 To 20
    If asc(Mid(PCName, i, 1)) = 0 Then
       gsPC_Name = Left(PCName, i - 1)
       Exit For
    End If
Next
GetPCName = gsPC_Name
End Function