۰۹-خرداد-۱۳۹۵, ۲۰:۳۰:۰۲
لطفا کمک کنید بتونم تعدادتک بیشتری بهش بشناسونم وتک هارو حذف کنم
کد:
$regfile = "m8def.dat"
$crystal = 8000000
$baud = 9600
'-------------------------------------------------------------------------------
Config Lcdpin = Pin , Rs = Portc.5 , E = Portc.4 , Db4 = Portb.4 , Db5 = Portb.3 , Db6 = Portb.2 , Db7 = Portb.1
Config Lcd = 16 * 2
'-------------------------------------------------------------------------------
Dim E As Byte , P As Byte
Dim C(12)as String * 1
Dim Code As String * 10
Dim B As String * 10
Dim N As Byte
Dim I_eerom As Eram Byte
'****************************** '
Cls
Cursor Off
'******************************
Door_open Alias Portd.2
'Config Portd.2 = Output
Config Pinc.2 = Input
Config Pinc.3 = Input
'******************************
Declare Sub F
Declare Sub S
'******************************
Do
Cls : Lcd "<<insert Card>>" : Wait 1
Step1:
Incr E
C(e) = Waitkey()
If E < 12 Then Goto Step1
For E = 3 To 12
Incr P
Mid(code , P , 1) = C(e)
Next
E = 0 : P = 0
'Cls : Lcd Code : Wait 4
'Goto F
Gosub F
'Return
Loop
'******************************************
Sub F
'Code = " "
'Do
Cls
Readeeprom B , 1
If Pinc.2 = 1 Then Gosub S
Locate 2 , 4
Lcd Code
'Wait 4
Waitms 500
Cls
If B = Code Then
Door_open = 1
Locate 1 , 1
Lcd "Welcome:"
Locate 2 , 4
Lcd "Opened"
Wait 2
Door_open = 0
Cls
End If
'Code = ""
'Loop
'End
End Sub
'*****************************
Sub S
N = 1
'Do
Cls
Locate 1 , 4
Lcd "Save user"
Locate 2 , 1
Lcd "(" ; N ; "):" ; Code
Waitms 600
If Pinc.2 = 1 Then
Writeeeprom Code , N
Cls
Code = "Successful"
End If
'******************************
'If Pinc.3 = 1 Then Goto F
'
Return
'******************************
'Loop
End Sub