4428frm.frm

十分好的一个医院管理系统

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Siemens 4428 IC Card"
   ClientHeight    =   5184
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   8580
   LinkTopic       =   "Form1"
   ScaleHeight     =   5184
   ScaleWidth      =   8580
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Exit_Com 
      Caption         =   "Exit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2040
      TabIndex        =   6
      Top             =   4320
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Read"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   4320
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "4428"
      Height          =   1095
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3615
      Begin VB.Label Label2 
         Caption         =   "ATR:92 23 10 91 "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   720
         TabIndex        =   4
         Top             =   240
         Width           =   2655
      End
      Begin VB.Label Label1 
         Caption         =   "Size: 1024x8bit"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   720
         TabIndex        =   3
         Top             =   600
         Width           =   2655
      End
   End
   Begin VB.TextBox Text28 
      Height          =   375
      Left            =   5280
      TabIndex        =   1
      Text            =   "Text28"
      Top             =   480
      Width           =   1215
   End
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2496
      Left            =   120
      TabIndex        =   0
      Top             =   1440
      Width           =   7575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************
'*
'* Reader setup functions
'*
'*****************************************************

Private Declare Function OpenPort Lib "micro900.dll" (ByVal PortName As String, ByRef PortHandle As Long) As Long
        
Private Declare Function ClosePort Lib "micro900.dll" () As Long
        
Private Declare Function SelectPort Lib "micro900.dll" (ByVal PortHandle As Long) As Long
        
Private Declare Function PowerOn Lib "micro900.dll" () As Long
        
Private Declare Function PowerOff Lib "micro900.dll" () As Long
        
Private Declare Function CardChanged Lib "micro900.dll" () As Long
        
Private Declare Function GetCardType Lib "micro900.dll" (ByRef ATR As Byte) As Long
        
Private Declare Function GetCardName Lib "micro900.dll" (ByVal CardType As Long) As String
        
Private Declare Function CardPresent Lib "micro900.dll" () As Integer
        
        
'*****************************************************
'*
'* 4428 functions
'*
'*****************************************************
        
Private Declare Function Read_4428_With_PB _
            Lib "micro900.dll" (ByVal startPos As Long, ByVal NOB As Long, ByRef Bfr As Byte, ByRef PB_Bfr As Byte) As Long

Private Declare Function Read_4428_NO_PB _
            Lib "micro900.dll" (ByVal startPos As Long, ByVal NOB As Long, ByRef Bfr As Byte) As Long

Private Declare Function Write_4428 _
            Lib "micro900.dll" (ByVal startPos As Long, ByVal DestByte As Byte, ByVal PBSetFlag As Byte) As Long

Private Declare Function Verify_4428_PSC _
            Lib "micro900.dll" (ByVal PSC1 As Long, ByVal PSC2 As Long) As Long

Private Declare Function Read_4428_SM _
            Lib "micro900.dll" (ByRef SM_Bfr As Byte, ByRef SM_PB_Bfr As Byte) As Long

'*****************************************************
'*
'* DES functions
'*
'*****************************************************

Private Declare Function LoadKey Lib "micro900.dll" _
        (ByRef KeyBytes As Byte) As Long

Private Declare Function Encrypto Lib "micro900.dll" _
        (ByRef InputBytes As Byte, ByRef OutputBytes As Byte) As Long

Private Declare Function Decrypto Lib "micro900.dll" _
        (ByRef InputBytes As Byte, ByRef OutputBytes As Byte) As Long
        
     Dim CardData(1024) As Byte
     Dim p As String
     Dim p1 As String
     Dim ListStr As String
     Dim zzz As Long
     
     
Private Sub Command1_Click()
    Dim ATR(4) As Byte
    
    Dim DispBfr(100) As Byte
    Dim CardData(1024) As Byte
    Dim CardPb(1024) As Byte
    Dim p As String
    Dim p1 As String
        
    Dim ListStr As String
    
    Dim result As Long
    Dim i As Long
    Dim j As Long
    Dim a As Long
    Dim k As Long
        
   
    
     
     If CardPresent() <> 1 Then    '检查是否有卡
        MsgBox "Please insert IC Card", 32, "IC Card Detect"
     Else
       result = GetCardType(ATR(0))   '检查卡的类型
        
   
      If ATR(0) = &H92 And ATR(1) = &H23 And ATR(2) = &H10 And ATR(3) = &H91 Then
      
       List1.Clear
       '-------------
       result = Read_4428_With_PB(0, 1024, CardData(0), CardPb(0))

       For i = 0 To 63
          ListStr = ""
          For j = 0 To 15
             p = "000" + Hex(CardData(16 * i + j))
             p = Right(p, 2)
                   
          If CardPb(16 * i + j) = 0 Then
               ListStr = ListStr + "+" + p
          Else
               ListStr = ListStr + " " + p
          End If
          
          If j = 7 Then
             ListStr = ListStr + " - "
          End If
         Next
       
          p1 = Hex(i * 16) + "-" + Hex(i * 16 + 15)
       p1 = Right("       " + p1, 6)
          
       List1.AddItem "  " + p1 + ": " + ListStr
       Next
       '-------------
       Else
          MsgBox "Please insert 4428 IC Card", 32, "IC Card Detect"
       End If
       
     End If
        
     
End Sub




Private Sub Exit_Com_Click()
   Dim result As Long
    result = PowerOff()
    result = ClosePort()
    End

End Sub

Private Sub Form_Load()
Dim result As Long
Dim PortHandle As Long
    
    Port = 0

    result = OpenPort("COM2", PortHandle)
    If result <> 0 Then
      result = OpenPort("COM1", PortHandle)
      Text28.Text = "COM1"
    Else
      Text28.Text = "COM2"
    End If
      result = PowerOn()
      Port = 0
    

End Sub