util.bas

这是一个读取银行卡上的磁条信息的例程

    For i = 2 To Lens Step 2
        Swap = Swap + Mid(strin, i, 1)
        Swap = Swap + Mid(strin, i - 1, 1)
    Next i
End Function


'*********************************************
'*                                           *
'*        过程 IMSI 码 生成、倒置函数        *
'*                                           *
'*********************************************

Function Make_IMSI_Ascend(IMSI As String, ByVal i As Long) As String
   Dim StrD As String
   StrD = Mid(IMSI, 1, 9) & Format(CLng(Mid(IMSI, 10, 6)) + (i - 1), "###000000")
   Make_IMSI_Ascend = StrD
End Function
Function Make_IMSI_Descend(IMSI As String, ByVal i As Long) As String
   Dim StrD As String
   StrD = Mid(IMSI, 1, 9) & Format(CLng(Mid(IMSI, 10, 6)) - (i - 1), "###000000")
   Make_IMSI_Descend = StrD
End Function
'***********************************
'*                                 *
'*         IMSI 码 倒置函数        *
'*                                 *
'***********************************

Function Inversion_IMSI(IMSI As String, IMSI_CRC As String) As String
Dim StrD As String
Dim Str As String
Dim i As Integer
On Error Resume Next
   Str = Mid(IMSI, 2, 14)
   StrD = ""
   For i = 1 To 7
       StrD = StrD & Mid(Str, 2 * i, 1) & Mid(Str, 2 * i - 1, 1)
   Next i
   StrD = "08" & Mid(IMSI, 1, 1) & IMSI_CRC & StrD
   Inversion_IMSI = StrD
End Function

'**********************************************
'*                                            *
'*       ICCID 最后一位校验码的算法实现       *
'*                                            *
'**********************************************

Function LUHN_FORMULR(Str As String) As String
Dim i As Integer
Dim Num As Long
Dim StrD As String
On Error Resume Next
    If (Len(Str) Mod 2) <> 0 Then
        StrD = "0" & Str
        Else
        StrD = "0" & Str
    End If
    Num = 0
    For i = 1 To Len(StrD)
        If (i Mod 2) <> 0 Then
           Num = Num + CInt(Mid(StrD, i, 1))
        Else
           Num = Num + (2 * CInt(Mid(StrD, i, 1))) \ 10 + (2 * CInt(Mid(StrD, i, 1))) Mod 10
        End If
    Next i
    Num = (10 - (Num Mod 10)) Mod 10
    StrD = Str & CStr(Num)
    LUHN_FORMULR = StrD
End Function

'************************************
'*                                  *
'*      过程 ICCID 码 生成函数      *
'*                                  *
'************************************

Function Make_ICCID_Ascend(ByVal ICCID As String, ByVal i As Long) As String
    Dim StrD As String
    If Len(ICCID) = 19 Then ICCID = LUHN_FORMULR(ICCID)
    StrD = Mid(ICCID, 1, 14) & Format(CLng(Mid(ICCID, 15, 6)) + (i - 1), "###000000")
    Make_ICCID_Ascend = StrD
End Function
Function Make_ICCID_Descend(ByVal ICCID As String, ByVal i As Long) As String
    Dim StrD As String
    If Len(ICCID) = 19 Then ICCID = LUHN_FORMULR(ICCID)
    StrD = Mid(ICCID, 1, 14) & Format(CLng(Mid(ICCID, 15, 6)) - (i - 1), "###000000")
    Make_ICCID_Descend = StrD
End Function

'************************************
'*                                  *
'*         ICCID 码 倒置函数        *
'*                                  *
'************************************

Function Inversion_ICCID(ICCID As String) As String
Dim StrD As String
Dim i As Integer
On Error Resume Next
   StrD = ""
   For i = 1 To 10
       StrD = StrD & Mid(ICCID, 2 * i, 1) & Mid(ICCID, 2 * i - 1, 1)
   Next i
   Inversion_ICCID = StrD
End Function
'生成16进制随机数
Function Random_HEX(StrLen As Integer) As String
    Dim NumD As Integer
    Dim i As Integer
    Random_HEX = ""
    Randomize
    For i = 1 To StrLen * 2
        NumD = Int(16 * Rnd)
        Random_HEX = Random_HEX + Hex(NumD)
    Next i
End Function
'生成10进制随机数
Function Random_DEC(StrLen As Integer) As String
    Dim NumD As Integer
    Dim i As Integer
    Random_DEC = ""
    Randomize
    For i = 1 To StrLen * 2
        NumD = Int(10 * Rnd)
        Random_DEC = Random_DEC + CStr(NumD)
    Next i
End Function
'读StrIn第n个字段的值
Function ReadBlock(ByVal strin As String, ByVal FieldNum As Integer, ByVal Sep As String) As String
    Dim tmp As String
    Dim i As Integer
    Dim pos As Integer
    tmp = strin
    For i = 1 To FieldNum
        If tmp = "" Then
            ReadBlock = ""
            Exit Function
        End If
        pos = InStr(tmp, Sep)
        '字串尾
        If pos = 0 And tmp <> "" Then
            ReadBlock = tmp
        Else
            ReadBlock = Mid(tmp, 1, pos - 1)
        End If
        tmp = Right(tmp, Len(tmp) - pos)
        
    Next i
End Function
Public Sub GetINITCmd(FileName As String)
    Dim FileNum As Integer
    Dim i As Integer
    Dim temp As String
    Dim pos As Integer
    FileNum = FreeFile
    i = 0
    Open FileName For Input As #FileNum
cycle:
    Do While Not EOF(FileNum)
        Line Input #FileNum, temp
        If (Trim(temp) = "") Or (Left(Trim(temp), 2) = "//") Then
          GoTo cycle
        End If
        pos = InStr(1, temp, "SW", 1)
        If pos = 0 Then
            MsgBox "初始化文件中没有状态字！请设置。", 64, "提示"
            Close #FileNum
            Exit Sub
        End If
        i = i + 1
        INITCMD.Cmd(i) = Trim(temp)
    Loop
    INITCMD.Counter = i
    Close #FileNum
End Sub
Public Sub GetPrePersoCmd(FileName As String)
    Dim FileNum As Integer
    Dim i As Integer
    Dim temp As String
    Dim pos As Integer
    FileNum = FreeFile
    i = 0
    Open FileName For Input As #FileNum
cycle:
    Do While Not EOF(FileNum)
        Line Input #FileNum, temp
        If (Trim(temp) = "") Or (Left(Trim(temp), 2) = "//") Then
          GoTo cycle
        End If
        pos = InStr(1, temp, "SW", 1)
        If pos = 0 Then
            MsgBox "预个人化文件中没有状态字！请设置。", 64, "提示"
            Close #FileNum
            Exit Sub
        End If
        i = i + 1
        PREPERSOCMD.Cmd(i) = Trim(temp)
    Loop
    PREPERSOCMD.Counter = i
    Close #FileNum
End Sub
Public Function GetFileName(ByVal strin As String) As String
    Dim temp As String
    Dim pos As Integer
    temp = strin
    Do
       pos = InStr(1, temp, "\", 1)
       temp = Right(temp, Len(temp) - pos)
    Loop While pos <> 0
    GetFileName = temp
End Function
Public Function Trim0(sName As String) As String
' Keep left portion of string sName up to first 0. Useful with Win API null terminated strings.
    Dim X As Integer
    X = InStr(sName, Chr$(0))
    If X > 0 Then Trim0 = Left$(sName, X - 1) Else Trim0 = sName

End Function
Public Function SwapIMSI(ByVal Str As String) As String
    Dim i As Integer
    SwapIMSI = ""
    For i = 2 To 9
        SwapIMSI = SwapIMSI & Mid(Str, 2 * i, 1) & Mid(Str, 2 * i - 1, 1)
    Next i
    SwapIMSI = Mid(SwapIMSI, 2, 15)
End Function
Public Function SwapICCID(Str As String) As String
    Dim i As Integer
    SwapICCID = ""
    For i = 1 To 10
        SwapICCID = SwapICCID & Mid(Str, 2 * i, 1) & Mid(Str, 2 * i - 1, 1)
    Next i
End Function
Public Sub ErrorLog(ByVal Comm As String, ByVal ret As String, ByVal Lines As Integer)
      Dim fn As Integer
      Dim strLog As String
      strLog = ""
      fn = FreeFile
      Open App.Path & "\" & "Error.log" For Append As #fn
      If Lines = -1 Then
            strLog = vbCrLf & "系统在SIM卡个人化时出现错误！错误返回如下："
            strLog = strLog & vbCrLf & Comm & ":[" & UCase(Hex(ret)) & "]"
      ElseIf Lines = -2 Then
            strLog = vbCrLf & "系统在打印时出现错误！错误返回如下："
            strLog = strLog & vbCrLf & "[" & CStr(Format(Lines, "###000")) & "]" & Comm & ":[" & ret & "]"
      Else
            strLog = vbCrLf & "系统在SIM卡预个人化时出现错误！错误返回如下："
            strLog = strLog & vbCrLf & "[" & CStr(Format(Lines, "###000")) & "]" & Comm & ":[" & UCase(Hex(ret)) & "]"
      End If
      Print #fn, strLog
      Close #fn
End Sub