modgeneral.bas

Mifare SDK - VB Sample Program

Attribute VB_Name = "modGeneral"
Option Explicit

Public gstrServerName$
Public gstrDatabaseName$
Public gstrDatabaseUser$
Public gstrPasswordUser$
Public gblDataFolder$

Public gconnSQL As ADODB.Connection
Public grsCompany As ADODB.Recordset
Public grsSafetyBadge As ADODB.Recordset

Public Declare Function GetTickCount Lib "kernel32" () As Long

'Data type range for :
'   - Integer           : -32,768 to 32,767
'   - Unsigned Integer  : 0 to 65,565
'   - Long              : -2,147,483,648 to 2,147,483,647
'   - Unsigned Long     : 0 to 4,294,967,295

Private Const OFFSET_ULONG = 4294967296#
Private Const OFFSET_UINT = 65536
Private Const MAX_LONG = 2147483647
Private Const MAX_INT = 32767

Public Function ULong2Long(Value As Double) As Long
    If Value < 0 Or Value >= OFFSET_ULONG Then Error 6 ' Overflow
    If Value <= MAX_LONG Then
        ULong2Long = Value
    Else
        ULong2Long = Value - OFFSET_ULONG
    End If
End Function

Public Function Long2Unsigned(Value As Long) As Double
    If Value < 0 Then
        Long2Unsigned = Value + OFFSET_ULONG
    Else
        Long2Unsigned = Value
    End If
End Function

Public Function Unsigned2Integer(Value As Long) As Integer
    If Value < 0 Or Value >= OFFSET_UINT Then Error 6 ' Overflow
    If Value <= MAX_INT Then
        Unsigned2Integer = Value
    Else
        Unsigned2Integer = Value - OFFSET_UINT
    End If
End Function

Public Function Integer2Unsigned(Value As Integer) As Long
    If Value < 0 Then
        Integer2Unsigned = Value + OFFSET_UINT
    Else
        Integer2Unsigned = Value
    End If
End Function
      
Public Sub DelayMSec(nLong As Long)
    Dim xCurrent As Long
    
    xCurrent = GetTickCount()
    
    While (GetTickCount() - xCurrent) < nLong
    Wend
End Sub

Public Sub CenterMe(frmForm As Object)
    frmForm.Top = (Screen.Height - frmForm.Height) \ 2
    frmForm.Left = (Screen.Width - frmForm.Width) \ 2
End Sub

Public Function Hex2Dec(strStr As String) As Double
    Dim i As Integer
    Dim j As Integer
    Dim nValue As Integer
    Dim strTmp As String
    
    strTmp = Trim$(strStr)
    Hex2Dec = 0
    j = 1
    For i = Len(strTmp) To 1 Step -1
        If UCase(Mid(strTmp, j, 1)) = "A" Then
            nValue = 10
        ElseIf UCase(Mid(strTmp, j, 1)) = "B" Then
            nValue = 11
        ElseIf UCase(Mid(strTmp, j, 1)) = "C" Then
            nValue = 12
        ElseIf UCase(Mid(strTmp, j, 1)) = "D" Then
            nValue = 13
        ElseIf UCase(Mid(strTmp, j, 1)) = "E" Then
            nValue = 14
        ElseIf UCase(Mid(strTmp, j, 1)) = "F" Then
            nValue = 15
        Else
            nValue = Val(Mid(strTmp, j, 1))
        End If
        
        Hex2Dec = Hex2Dec + ((16 ^ (i - 1)) * nValue)
        
        j = j + 1
    Next
    
End Function

Public Function Dec2Bin(intValue As Integer) As String
    Dim i As Integer
    Dim nExponent As Integer
    Dim nReminder As Integer
    Dim sBinary$
    
    nReminder = intValue
    sBinary$ = ""
    
    If nReminder > 255 Then
        nExponent = 15
    Else
        nExponent = 7
    End If
    
    For i = nExponent To 1 Step -1
        If nReminder >= (2 ^ i) Then
            nReminder = nReminder - (2 ^ i)
            sBinary$ = sBinary$ & "1"
        Else
            sBinary$ = sBinary$ & "0"
        End If
    Next
    
    sBinary$ = sBinary$ & Trim$(str$(nReminder))
    
    Dec2Bin = sBinary$
End Function

Public Function Bin2Dec(str As String) As Integer
    Dim i As Integer
    Dim iLen As Integer
    Dim Result As Integer
    
    Result = 0
    
    iLen = Len(str)
    
    For i = iLen To 1 Step -1
        Result = Result + (Val(Mid$(str, i, 1)) * (2 ^ (i - 1)))
    Next
    
    Bin2Dec = Result
End Function