gold.frm

金卡（gold card),俗称84卡

Private Sub MIds_Click(Index As Integer)
    keyindex = Index
    
    keymap.Show 1
    
End Sub

Private Sub mLoad_Click()
    
    mIDst.Visible = True
    
    Fileloc.Show 1
        
    ' process channel IDS into menu heading
    
    memstart% = &H178
    offset% = 0
    
    For a% = 1 To 16
        tempid$ = ""
        tempid$ = tempid$ + Right$("00" + Trim$(Hex$(Asc(Mid$(Memmap, memstart% + offset%, 1)))), 2)
        tempid$ = tempid$ + Right$("00" + Trim$(Hex$(Asc(Mid$(Memmap, memstart% + offset% + 1, 1)))), 2)
        tempid$ = tempid$ + Right$("00" + Trim$(Hex$(Asc(Mid$(Memmap, memstart% + offset% + 2, 1)))), 2)
        MIds(a%).Caption = tempid$ + " : "
        offset% = offset% + 3
    Next a%
      



' process the File ID
    
    For a% = 0 To 0
        tempid$ = ""
        
        memstart% = &H712 + ((a% - 1) * 15)
        offset% = 0
        
        For b% = 0 To 11
                      
           l1 = Asc(Mid$(Memmap, memstart% + offset% + b%, 1))
           'da% = (((l1 << 4) Or (l1 >> 4)) Xor &H69) And &HFF
      
           Hi = (l1 And &HF0) / 16
           
           lo = (l1 And &HF) * 16
                 
           da% = ((Hi Or lo) Xor &H69) And 255
                 
           
           l1 = Asc(Mid$(Memmap, memstart% + offset% + b%, 1))
           'da% = (((l1 << 4) Or (l1 >> 4)) Xor &H69) And &HFF
      
           l1 = l1 Xor &H69
           
           Hi = (l1 And &HF0) / 16
           
           lo = (l1 And &HF) * 16
                 
           da% = ((Hi Or lo)) And 255
                 
                 
           tempid$ = tempid$ + Chr$(da%)
           
        Next b%
        
        

    Next a%
    


' process the channel name
    
    For a% = 1 To 16
        tempid$ = ""
        
        memstart% = &H712 + ((a% - 1) * 15)
        offset% = 0
        
        For b% = 0 To 11
                      
           l1 = Asc(Mid$(Memmap, memstart% + offset% + b%, 1))
           'da% = (((l1 << 4) Or (l1 >> 4)) Xor &H69) And &HFF
      
           Hi = (l1 And &HF0) / 16
           
           lo = (l1 And &HF) * 16
                 
           da% = ((Hi Or lo) Xor &H69) And 255
                 
           
           l1 = Asc(Mid$(Memmap, memstart% + offset% + b%, 1))
           'da% = (((l1 << 4) Or (l1 >> 4)) Xor &H69) And &HFF
      
           l1 = l1 Xor &H69
           
           Hi = (l1 And &HF0) / 16
           
           lo = (l1 And &HF) * 16
                 
           da% = ((Hi Or lo)) And 255
                 
                 
           tempid$ = tempid$ + Chr$(da%) 'Mid$(Memmap, memstart% + offset% + b%, 1)
           
        Next b%
        
        MIds(a%).Caption = MIds(a%).Caption + tempid$
        
        label1(a%).Caption = MIds(a%).Caption
        
        offset% = offset% + 7
    Next a%
    

    

End Sub

Private Sub OPENPORT()
   
   buffout = ""
   Buffin = LTrim$(RTrim$(""))
   Datln = 0
   Cmdln = 0
   Handle = 0
   Datlnout = 255
   
   cmdst = "System,OemRegister,2470-2925-1045-1712-0214-8175"
   response = ScardComand(Handle, cmdst, 0, Buffin, Datln, buffout, Datlnout)



  
End Sub

Private Sub mslot1_Click(Index As Integer)

End Sub

Private Sub MSlot2_Click()

End Sub


Private Sub mSave_Click()
     Filelocs.Show 1
End Sub

Private Sub Read_Click()

On Error GoTo readerror

' card memread
   
   lo = 0
   Hi = 0

   For a% = 0 To Memsize Step 8
       
       GoSub readmem
       Mid$(Memmap, a% + 1, 8) = Left$(buffout, 8)
       lo = lo + 8
       
       If lo > 255 Then
          Hi = Hi + 1
          lo = 0
       End If

   Next a%

   For a% = 1 To Memsize Step 8
       
       MSG = MSG + Right$("000000" + Hex$(a%), 4) + " : "
       
       For b% = 0 To 8

         tmpmsg = Mid$(Memmap, a% + b%, 1)
        
          If Asc(tmpmsg) < 32 Then
             tmpmsg = "."
          Else
          
          End If

          MSG = MSG + tmpmsg
          
       Next b%
        
       text1.Refresh
       
       MSG = MSG + Chr$(&HD) + Chr$(&HA)
   
   Next a%

   text1 = MSG

   MSG = ""

   For a% = 1 To Memsize Step 8
       
       MSG = MSG + Right$("000000" + Hex$(a%), 4) + " : "
       
       For b% = 0 To 7

          MSG = MSG + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + b%, 1))), 2) + " "
       
       Next b%
       
       MSG = MSG + Chr$(&HD) + Chr$(&HA)

   Next a%

   text2 = MSG
      

   On Error GoTo 0
Exit Sub


' This is the main code for reading the data from the card.

readmem:
   
   ' set up the call for the read, the starting position and the length need to be
   ' sent to the routine in ascii format

   text3 = "reading address " + Str$((Hi * 256) + lo)

   cmdst = "Card,T0RX,"
   buffout = ""
   Buffin = LTrim$(Chr$(&HCA) + Chr$(&H20) + Chr$(Hi) + Chr$(lo) + Chr$(&H8))

   Cmdln = 0
   Datln = 5
   Datlnout = 10
   
   text2.Text = ScardComand(Handle, cmdst, Cmdln, Buffin, Datln, buffout, Datlnout)
   
   Buffin = Right$(buffout, 8)
   
Return


readerror:
   Resume ReadErrmess

ReadErrmess:
    MsgBox "There was an error reading"

End Sub

Private Sub Reset_Click()
   If Val(lotnr) <> 1100 Then
      MsgBox "Invalid Reader"
      End
   End If

' card type
   status = ""

   cmdst = "card,info,"
   
   buffout = ""                             ' Cleared for this call
   Buffin = ""                              ' Cleared for this call
   Datln = 0                                ' zeroed for this call
   Cmdln = 0                                ' zeroed for this call
   Handle = 0                               ' zeroed for this call
   DatoutLN = 255                           ' Length of data to get from call

   response.Text = ScardComand(Handle, cmdst, 0, Buffin, Datln, buffout, DatoutLN)
  
   'buffout now contain the details and settting of the card.
   status = RTrim$(buffout)

   MsgBox status
   
' card type
   
   Memsize = 2040


End Sub

Private Sub write_Click(Index As Integer)
   
   If Val(lotnr) <> 1100 Then
      MsgBox "Invalid Reader"
      End
   End If
   
   
   ' card memread

   On Error GoTo writeerror

   lo = 0
   Hi = 0

   For a% = 0 To 2040 Step 8

      temp = "writing address " + Right$("0000" + Hex$((Hi * 256) + lo), 4) + "    "
      
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 1, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 2, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 3, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 4, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 5, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 6, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 7, 1))), 2)
      temp = temp + Right$("00" + Hex$(Asc(Mid$(Memmap, a% + 8, 1))), 2)

      text3.Caption = temp
      cmdst = "Card,T0TX,"
   
      Buffin = LTrim$(Chr$(&HCA) + Chr$(&H20) + Chr$(Hi) + Chr$(lo) + Chr$(&H8)) + Mid$(Memmap, a% + 1, 8)
   
      Cmdln = 0
      Datln = 5 + 8
      Datlnout = 2
   
      response = ScardComand(Handle, cmdst, Cmdln, Buffin, Datln, buffout, Datlnout)
   
      Buffin = Right$(buffout, Len(buffout) - 2)
   
      If response <> 0 Then
          MsgBox "There was an updating address " + Right$("0000" + Trim$(Hex$(a%)), 4)
          Exit Sub
      End If
      
'      MsgBox Str$(response) + "|" + Hex$(Asc(Mid$(buffout, 1, 1))) + Hex$(Asc(Mid$(buffout, 2, 1)))
      
      Call getcardstatus

      lo = lo + 8
      If lo > 255 Then
         lo = 0
         Hi = Hi + 1

      End If
    Next a%
    
    MsgBox "write compelete"

Exit Sub

writeerror:
   Resume WriteErrmess

WriteErrmess:
    MsgBox "There was an updating address " + Right$("0000" + Trim$(Hex$(a%)), 4)

  
End Sub