با عرض سلام و خسته نباشید به مهندسین
من یه مشکلی دارم واسه پروژم
پروژه من قفل رمز دیجیتالی 8رقمی هست که قابلیت تغیر رمز نداره از دوستان میخوام که کمکم کنن تا امکان تغیر رمز هم داشته باشه
اینم دستورش
'******************************************** ***********************************
'* Digital 8 digit Code Lock (Compatible with AMC8) *
'* Compiler: BASCOM-AVR 2.0.4.0 *
'* Creation Date: 07.April.2011 *
'* Last - Change: 13.April.2011 *
'* ************ *
'* License: freeware *
'* ********* *
'* Ver: 2.0 *
'******************************************** ***********************************
$regfile = "m8def.dat"
$crystal = 1000000
$framesize = 128
$hwstack = 128
$swstack = 128
'$projecttime = 12
'LCD
Config Lcdpin = Pin , Db4 = Portc.2 , Db5 = Portc.3 , Db6 = Portc.4 , Db7 = _
Portc.5 , E = Portc.1 , Rs = Portc.0
Config Lcd = 16 * 2
'Keypad
Config Kbd = Portd
'Sub's
Declare Sub Init()
Declare Sub Main()
Declare Sub Error()
Declare Sub Ok()
'Function
Declare Function Getpass() As String
Declare Function Star(byval Passwd As String) As String
'Backlight
Config Pinb.2 = Output
Backlight Alias Portb.2
'Relay
Config Pinb.7 = Output
Relay Alias Portb.7
'Main Prog Start Here:
Call Init()
Do
Call Main()
Loop
End
'____________________________________________ ___________________________________
'Keypad Decode Data Table
Keypad:
Data "1" , "2" , "3" , "Esc"
Data "4" , "5" , "6" , "F2"
Data "7" , "8" , "9" , "F3"
Data "*" , "0" , "#" , "Enter" , "no"
'____________________________________________ ___________________________________
Sub Init()
Cls : Cursor Off Noblink
Set Backlight
Lcd " WELCOM To "
Lowerline
Lcd "Electronic Lock"
Wait 8
Cls : Cursor Off Noblink
Set Backlight
Lcd " Tech
r.Ehsani "
Lowerline
Lcd " St:M.Zarandi "
Wait 8
End Sub
'____________________________________________ ___________________________________
Sub Main()
Cls : Cursor Off Noblink
Lcd "Enter Password:"
Lowerline
Cursor Blink
If Getpass() = "11223344" Then
Call Ok()
Else
Call Error()
End If
End Sub
'____________________________________________ ___________________________________
Sub Ok()
Local _key As Byte
Local _num As String * 5
Cls : Cursor Noblink
Lcd "Door is open!"
Lowerline
Lcd " Esc=Exit"
Set Relay
' For A Home Open Door System Remove Above Line And Remark Below Lines:
Set Relay
Wait 4
Reset Relay
Do
_key = Getkbd()
_num = Lookupstr(_key , Keypad)
Loop Until _num = "Esc"
Reset Relay
End Sub
'____________________________________________ ___________________________________
Sub Error()
Cls : Cursor Noblink
Lcd "Code Error!"
Wait 2
End Sub
'____________________________________________ ___________________________________
Function Star(byval Passwd As String) As String
Local _result As String * 8
Local _count As Byte
Local _length As Byte
_result = ""
_length = Len(passwd)
For _count = 1 To _length
_result = _result + "*"
Next Count
Star = _result
End Function
'____________________________________________ ___________________________________
Function Getpass() As String
Local _key As Byte
Local _num As String * 5
Local _password As String * 8
_password = ""
Do
_key = Getkbd()
_num = Lookupstr(_key , Keypad)
If _num = "0" Or _num = "1" Or _num = "2" Or _num = "3" Or _num = "4" Or _
_num = "5" Or _num = "6" Or _num = "7" Or _num = "8" Or _num = "9" Then
If Len(_password) < 8 Then
_password = _password + _num
Lowerline
Lcd Star(_password)
Do
Loop Until Getkbd() = 16
End If
If Len(_password) = 8 Then Cursor Noblink
End If
If _num = "Esc" Then
_password = ""
Lowerline
Lcd Spc(16)
Lowerline
Cursor Blink
Do
Loop Until Getkbd() = 16
End If
Loop Until _num = "Enter"
Getpass = _password
End Function
'End Of File
دوستان ازتون خواهش میکنم که کمکم کنید باید تا هفته دیگه کامل بشه
من یه مشکلی دارم واسه پروژم
پروژه من قفل رمز دیجیتالی 8رقمی هست که قابلیت تغیر رمز نداره از دوستان میخوام که کمکم کنن تا امکان تغیر رمز هم داشته باشه
اینم دستورش
'******************************************** ***********************************
'* Digital 8 digit Code Lock (Compatible with AMC8) *
'* Compiler: BASCOM-AVR 2.0.4.0 *
'* Creation Date: 07.April.2011 *
'* Last - Change: 13.April.2011 *
'* ************ *
'* License: freeware *
'* ********* *
'* Ver: 2.0 *
'******************************************** ***********************************
$regfile = "m8def.dat"
$crystal = 1000000
$framesize = 128
$hwstack = 128
$swstack = 128
'$projecttime = 12
'LCD
Config Lcdpin = Pin , Db4 = Portc.2 , Db5 = Portc.3 , Db6 = Portc.4 , Db7 = _
Portc.5 , E = Portc.1 , Rs = Portc.0
Config Lcd = 16 * 2
'Keypad
Config Kbd = Portd
'Sub's
Declare Sub Init()
Declare Sub Main()
Declare Sub Error()
Declare Sub Ok()
'Function
Declare Function Getpass() As String
Declare Function Star(byval Passwd As String) As String
'Backlight
Config Pinb.2 = Output
Backlight Alias Portb.2
'Relay
Config Pinb.7 = Output
Relay Alias Portb.7
'Main Prog Start Here:
Call Init()
Do
Call Main()
Loop
End
'____________________________________________ ___________________________________
'Keypad Decode Data Table
Keypad:
Data "1" , "2" , "3" , "Esc"
Data "4" , "5" , "6" , "F2"
Data "7" , "8" , "9" , "F3"
Data "*" , "0" , "#" , "Enter" , "no"
'____________________________________________ ___________________________________
Sub Init()
Cls : Cursor Off Noblink
Set Backlight
Lcd " WELCOM To "
Lowerline
Lcd "Electronic Lock"
Wait 8
Cls : Cursor Off Noblink
Set Backlight
Lcd " Tech

Lowerline
Lcd " St:M.Zarandi "
Wait 8
End Sub
'____________________________________________ ___________________________________
Sub Main()
Cls : Cursor Off Noblink
Lcd "Enter Password:"
Lowerline
Cursor Blink
If Getpass() = "11223344" Then
Call Ok()
Else
Call Error()
End If
End Sub
'____________________________________________ ___________________________________
Sub Ok()
Local _key As Byte
Local _num As String * 5
Cls : Cursor Noblink
Lcd "Door is open!"
Lowerline
Lcd " Esc=Exit"
Set Relay
' For A Home Open Door System Remove Above Line And Remark Below Lines:
Set Relay
Wait 4
Reset Relay
Do
_key = Getkbd()
_num = Lookupstr(_key , Keypad)
Loop Until _num = "Esc"
Reset Relay
End Sub
'____________________________________________ ___________________________________
Sub Error()
Cls : Cursor Noblink
Lcd "Code Error!"
Wait 2
End Sub
'____________________________________________ ___________________________________
Function Star(byval Passwd As String) As String
Local _result As String * 8
Local _count As Byte
Local _length As Byte
_result = ""
_length = Len(passwd)
For _count = 1 To _length
_result = _result + "*"
Next Count
Star = _result
End Function
'____________________________________________ ___________________________________
Function Getpass() As String
Local _key As Byte
Local _num As String * 5
Local _password As String * 8
_password = ""
Do
_key = Getkbd()
_num = Lookupstr(_key , Keypad)
If _num = "0" Or _num = "1" Or _num = "2" Or _num = "3" Or _num = "4" Or _
_num = "5" Or _num = "6" Or _num = "7" Or _num = "8" Or _num = "9" Then
If Len(_password) < 8 Then
_password = _password + _num
Lowerline
Lcd Star(_password)
Do
Loop Until Getkbd() = 16
End If
If Len(_password) = 8 Then Cursor Noblink
End If
If _num = "Esc" Then
_password = ""
Lowerline
Lcd Spc(16)
Lowerline
Cursor Blink
Do
Loop Until Getkbd() = 16
End If
Loop Until _num = "Enter"
Getpass = _password
End Function
'End Of File
دوستان ازتون خواهش میکنم که کمکم کنید باید تا هفته دیگه کامل بشه
دیدگاه