util.bas

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

Attribute VB_Name = "Util"
Option Explicit
Global mMSISDN   As String
Declare Function GetTickCount Lib "kernel32" () As Long '得到系统的时间计数，单位毫秒
Declare Function ExitWindowsEx Lib "User32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public 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
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Global mIPAddr As String '服务器ip地址
Global mPortNum As String '网络端口号
Global mNetConnectFlag As Boolean '网络是否连接成功标志，true表示与服务器连接成功
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const Flag = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Global result As String
Global logFileName As String
Global startCardNo As String
Global endCardNo As String
Global logFolder As String
Global WATCHKEY As String
Global ManageKEY As String
Global PtFont As String
Global PtSize As String
Global PtBold As String
Global ComPt As String
Global ComCrw As String
Global ComCrwRate As Long
Global Reader As String
Global ReaderRate As Long
Global LptPt As String
Global fd As Long
Global Resp As String * 600
Global Lenr As Long
'Global Lens As Long
Global mStopped As Integer
Global rICCID As String
Global rIMSI As String
Global rCHV1 As String
Global rCHV2 As String
Global rPUK1 As String
Global rPUK2 As String
Global rKI As String
Global rSMSC As String
Global rADM As String
Global rOTAKey As String
Global ret As String
Global RECORDLENGTH As Integer
Global TOTALLINES As Double
Global Const MAXLINES = 500
Type COMMAND
    Counter As Integer
    Cmd(1 To MAXLINES) As String
End Type
Global INITCMD As COMMAND
Global PREPERSOCMD As COMMAND
Global Const CARDFILEDIR = "制卡文件目录"
Global Const RPTTEMPLATEDIR = "报告文件模板目录"
Global Const REPORTDIR = "报告文件目录"
Global Const TEMPLATENAME = "报告模板.RTT"
Global Const OTAREPROTDIR = "OTAKEY报告目录"
Global Const PATCHDIR = "补卡文件目录"
Global Const OTAKEYREPORTFILE = "OTAKey.rpt"


Public Sub WriteINI(AppName As String, KeyName As String, MyValue As String)
Dim lpAppName As String, lpFileName As String, lpKeyName As String, lpString As String
Dim U As Long
On Error Resume Next
DoEvents
    lpAppName = AppName
    lpKeyName = KeyName
    lpString = MyValue
    lpFileName = App.Path & "\NSD.INI"
    If lpString = "" Then lpString = "0"
    U = WritePrivateProfileString(lpAppName, lpKeyName, lpString, lpFileName)
    If U = 0 Then
       MsgBox ("写INI文件出错！")
    End If
End Sub

Public Sub ReadINI(AppName As String, KeyName As String)
Dim X As Long
Dim temp As String
temp = Space(100)
DoEvents
Dim lpAppName As String, lpKeyName As String, lpDefault As String, lpFileName As String
    lpAppName = AppName
    lpKeyName = KeyName
    lpDefault = App.Path & "\NSD.INI"
    lpFileName = App.Path & "\NSD.INI"
    If Dir$(App.Path & "\NSD.INI") = "" Then result = "0": Exit Sub
    X = GetPrivateProfileString(lpAppName, lpKeyName, lpDefault, temp, Len(temp), lpFileName)
    result = Trim0(temp)
End Sub
'********************************************************************
'* 过程名：Delay                                                    *
'* 参数：lngLength 时间长度单位毫秒                                  *
'* 功能：获得给定时间长度的延时                                       *
'********************************************************************
Public Sub Delay(ByVal lngLength As Long)
    Dim lngBeginTime As Long
    lngBeginTime = GetTickCount
    Do While GetTickCount - lngBeginTime < lngLength
        DoEvents
    Loop
End Sub

'取得当前生产批号的记录总数量
Public Function GetRecordCount(FileName As String) As Long
    Dim filenumber As Integer
    Dim Num As Long
    Dim InputData As String
    
    DoEvents
    Num = 0
    filenumber = FreeFile ' 取得未使用的文件号
    Open FileName For Input As #filenumber
         Line Input #filenumber, InputData
         RECORDLENGTH = 300 + 2 'RECORDLENGTH  is a magic number !!!!
         Num = (LOF(filenumber) + 2) / RECORDLENGTH
         TOTALLINES = Num
    Close #filenumber
    GetRecordCount = Num
End Function

'取得第n条记录
Public Function GetRecordValue(n As Long, FileName As String) As String
    Dim fn As Integer
    Dim InputData As String * 260  '!!!!!!!!!!!magic number
    
    If n > TOTALLINES Then
        GetRecordValue = ""
        Exit Function
    End If
    fn = FreeFile
    
    Open FileName For Random As #fn Len = RECORDLENGTH
'    Open FileName For Input As #fn

    Get #fn, n, InputData
    Close #fn
    GetRecordValue = Trim(InputData)

End Function
'检查操作员卡的合法性
Public Function CheckOperateCard(fd As Long, Pin As String, result As String) As Boolean
     Dim ret As Long
     '卡复位
      ret = ResetCard(ComCrw, fd, Lenr, Resp)
      If ret <> 36864 Then
         CheckOperateCard = False
         result = "操作员卡复位失败!错误返回:" + UCase(Hex(ret))
         Exit Function
      End If
      '选择应用目录DF01
      ret = SendCmd(ComCrw, fd, 7, "00A4000002DF01", Lenr, Resp)
      If ret <> 36864 Then
        CheckOperateCard = False
        result = "选择应用目录失败!错误返回:" + UCase(Hex(ret))
        Exit Function
      End If
      '验证口令
      ret = SendCmd(ComCrw, fd, 5 + Len(Trim(Pin)) / 2, "002000010" + CStr(Len(Trim(Pin)) / 2) + Trim(Pin), Lenr, Resp)
      If ret <> 36864 Then
        CheckOperateCard = False
        result = "验证口令失败!错误返回:" + UCase(Hex(ret))
        Exit Function
      End If
      '取8字节随机数
      Dim rand As String * 20
      ret = SendCmd(ComCrw, fd, 5, "0084000008", Lenr, rand)
      If ret <> 36864 Then
        CheckOperateCard = False
        result = "取随机数失败!错误返回:" + UCase(Hex(ret))
        Exit Function
      End If
      Dim DestData As String * 20
      TripleDESVB 1, "5741544348435553544F4D45524A4851", 16, rand, DestData

      '外部认证
      ret = SendCmd(ComCrw, fd, 13, "0082000008" + DestData, Lenr, Resp)
      If ret <> 36864 Then
        CheckOperateCard = False
        result = "非本系统卡,请换卡!错误返回:" + UCase(Hex(ret))
        Exit Function
      End If
      
    CheckOperateCard = True
    result = "OK"
End Function
Function Str2ASC(ByVal strin As String) As String
    Dim i As Integer
    Str2ASC = ""
    For i = 1 To Len(strin)
        Str2ASC = Str2ASC + Hex(asc(Mid(strin, i, 1)))
    Next i
End Function
Function PAD1(ByVal data As String, ByVal padChar As String, toLens As Integer) As String
    Dim tmp As String
    Dim i As Integer
    tmp = ""
    PAD1 = ""
    For i = Len(data) To toLens - 1
        tmp = tmp + padChar
    Next i
    PAD1 = data + tmp
End Function
Function PAD2(ByVal data As String, ByVal padChar As String, toLens As Integer) As String
    Dim tmp As String
    Dim i As Integer
    tmp = ""
    For i = Len(data) To toLens - 1
        tmp = tmp + padChar
    Next i
    PAD2 = tmp + data
End Function
Function PAD3(ByVal data As String, ByVal padChar As String, toLens As Integer) As String
    Dim tmp As String
    Dim i As Integer
    tmp = "80"
    PAD3 = ""
    For i = Len(data) + 2 To toLens - 1
        tmp = tmp + padChar
    Next i
    PAD3 = data + tmp
End Function
Public Function SwapTelNumber(ByVal strin As String) As String
    Dim i As Integer
    SwapTelNumber = ""
    If Len(strin) Mod 2 <> 0 Then
        strin = strin + "F"
    End If
     For i = 1 To Len(strin) / 2
        SwapTelNumber = SwapTelNumber & Mid(strin, 2 * i, 1) & Mid(strin, 2 * i - 1, 1)
    Next i
    If Right(SwapTelNumber, 1) = "F" Then
        SwapTelNumber = Left(SwapTelNumber, Len(SwapTelNumber) - 1)
    End If
End Function
Public Function Swap(ByVal strin As String) As String
    Dim i As Integer
    Dim Lens As Integer
    Lens = Len(strin)
    Swap = ""