/[RFID]/3m-810.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /3m-810.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Sep 28 12:57:32 2008 UTC (15 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 5846 byte(s)
first dump of serial port communication with 3M 810 RFID reader
1 dpavlin 1 #!/usr/bin/perl
2    
3     use Device::SerialPort qw (:STAT);
4     use strict;
5     use warnings;
6    
7     use Data::Dump qw/dump/;
8    
9     my $response = {
10     'd500090400110a0500027250' => 'version?',
11     'd60007fe00000500c97b' => 'no tag in range',
12    
13     'd6000ffe00000501e00401003123aa26941a' => 'tag #1',
14     'd6000ffe00000501e0040100017c0c388e2b' => 'rfid card',
15     'd6000ffe00000501e00401003123aa2875d4' => 'tag red-stripe',
16    
17     'd60017fe00000502e00401003123aa26e0040100017c0c38cadb' => 'tag #1 + card',
18     'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',
19     };
20    
21     =head1 NAME
22    
23     3m-810 - support for 3M 810 RFID reader
24    
25     =head1 SYNOPSIS
26    
27     3m-810.pl [DEVICE [BAUD [DATA [PARITY [STOP [FLOW]]]]]]
28    
29     =head1 DESCRIPTION
30    
31     Communicate with 3M 810 RFID reader and document it's protocol
32    
33     =head1 SEE ALSO
34    
35     L<Device::SerialPort(3)>
36    
37     L<perl(1)>
38    
39     =head1 AUTHOR
40    
41     Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>
42    
43     =head1 COPYRIGHT AND LICENSE
44    
45     This program is free software; you may redistribute it and/or modify
46     it under the same terms ans Perl itself.
47    
48     =cut
49    
50     # your serial port.
51     my ($device,$baudrate,$databits,$parity,$stopbits,$handshake)=@ARGV;
52     $device ||= "/dev/ttyUSB0";
53     $baudrate ||= "19200";
54     $databits ||= "8";
55     $parity ||= "none";
56     $stopbits ||= "1";
57     $handshake ||= "none";
58    
59     my $port=new Device::SerialPort($device) || die "new($device): $!\n";
60     $handshake=$port->handshake($handshake);
61     $baudrate=$port->baudrate($baudrate);
62     $databits=$port->databits($databits);
63     $parity=$port->parity($parity);
64     $stopbits=$port->stopbits($stopbits);
65    
66     print "## using $device $baudrate $databits $parity $stopbits\n";
67    
68     # Just in case: reset our timing and buffers
69     $port->lookclear();
70     $port->read_const_time(100);
71     $port->read_char_time(5);
72    
73     # Turn on parity checking:
74     #$port->stty_inpck(1);
75     #$port->stty_istrip(1);
76    
77     sub cmd {
78     my ( $cmd, $desc, $expect ) = @_;
79     $cmd =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/; # fix checksum
80     $cmd =~ s/\s+/\\x/g;
81     $cmd = '"\x' . $cmd . '"';
82     my $bytes = eval $cmd;
83     die $@ if $@;
84     warn ">> ", as_hex( $bytes ), "\t$desc\n";
85     writechunk( $bytes );
86     warn "?? $expect\n" if $expect;
87     readchunk();
88     }
89    
90     cmd( 'D5 00 05 04 00 11 8C66', 'hw version?',
91     'D5 00 09 04 00 11 0A 05 00 02 7250 -- hw 10.5.0.2' );
92    
93     cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','stats?' );
94     # D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778
95    
96     cmd( 'D6 00 05 FE 00 05 FA40', "XXX scan $_",
97     'D6 00 07 FE 00 00 05 00 C97B -- no tag' ) foreach ( 1 .. 10 );
98    
99     # D6 00 0F FE 00 00 05 01 E00401003123AA26 941A # seen
100    
101     cmd( 'D6 00 0D 02 E00401003123AA26 00 03 1CC4', 'read offset: 0 blocks: 3' );
102    
103     # D6 00 1F 02 00 E00401003123AA26 03 00 00 04 11 00 01 01 00 30 30 30 30 02 00 30 30 30 30 E5F4
104     warn "D6 00 1F 02 00 E00401003123AA26 03 00 00 04 11 00 01 01 00 31 32 33 34 02 00 35 36 37 38 531F\n";
105    
106     cmd( 'D6 00 0D 02 E00401003123AA26 03 04 3970', 'read offset: 3 blocks: 4' );
107    
108     # D6 00 25 02 00 E00401003123AA26 04 03 00 30 30 00 00 04 00 00 00 00 00
109     # 05 00 00 00 00 00 06 00 00 00 00 00 B9BA
110     warn "D6 00 25 02 00 E00401003123AA26 04 03 00 39 30 31 32 04 00 33 34 35 36
111     05 00 00 00 00 00 06 00 00 00 00 00 524B\n";
112     warn "D6 00 0F FE 00 00 05 01 E00401003123AA26 941A ##### ready?\n";
113    
114     for ( 1 .. 3 ) {
115    
116     # ++-->type 00-0a
117     # D6 00 2A 04 E00401003123AA26 00 07 00 04 11 00 01 31 31 31 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 1C D4
118     # D6 00 2A 04 E0 04 01 00 31 23 AA 26 00 07 00 04 11 00 06 32 32 32 32 32 32 32 32 32 32 32 00 00 00 00 00 00 00 00 00 00 00 00 00 32B7
119     # D6 00 2A 04 E0 04 01 00 31 23 AA 26 00 07 00 04 11 00 02 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 00 00 00 00 00 00 00 00 42 1F
120    
121     cmd(' D6 00 2A 04 E00401003123AA26 00 07 00 04 11 00 01 30 30 30 30 30 30 30 30 30 30 00 00 00 00 00 00 00 00 00 00 00 00 00 00 8843', "write offset 0, block: 7 -- 0000000000 $_" );
122     warn "D6 00 0D 04 00 E00401003123AA26 07 CFF1 -- ack 7 block?\n";
123    
124     }
125     warn " D6 00 0F FE 00 00 05 01 E00401003123AA26 941A\n";
126    
127     cmd( 'D6 00 05 FE 00 05 FA 40', "port-write scan $_" ) foreach ( 1 .. 2 );
128    
129     cmd('D6 00 0C 09 E00401003123AA26 D7 3AF0', 'checkin?',
130     'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
131     cmd('D6 00 0C 09 E00401003123AA26 DA EB5D', 'checkout?',
132     'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
133    
134     cmd('D6 00 26 04 E00401003123AA26 00 06 00 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 A98B', 'blank offset: 0 blocks: 6',
135     'D6 00 0D 04 00 E00401003123AA26 06 DFD0 -- ack 6 blocks' ) foreach ( 1 .. 3 );
136    
137     undef $port;
138     print "Port closed\n";
139    
140     sub writechunk
141     {
142     my $str=shift;
143    
144     my $count = $port->write($str);
145     print ">> ", as_hex( $str ), "\t[$count]\n";
146     }
147    
148     sub as_hex {
149     my @out;
150     foreach my $str ( @_ ) {
151     my $hex = unpack( 'H*', $str );
152     $hex =~ s/(..)/$1 /g;
153     push @out, $hex;
154     }
155     return join(' ', @out);
156     }
157    
158     sub read_bytes {
159     my ( $len, $desc ) = @_;
160     my $data = '';
161     while ( length( $data ) < $len ) {
162     my ( $c, $b ) = $port->read(1);
163     #warn "## got $c bytes: ", as_hex($b), "\n";
164     $data .= $b;
165     }
166     $desc ||= '?';
167     warn "#< ", as_hex($data), "\t$desc\n";
168     return $data;
169     }
170    
171     sub readchunk {
172    
173     # read header of packet
174     my $header = read_bytes( 2, 'header' );
175     my $len = ord( read_bytes( 1, 'length' ) );
176     my $data = read_bytes( $len, 'data' );
177    
178     warn "<< ",as_hex( $header, ), " [$len] ", as_hex( $data ), "\n";
179    
180     sleep 1;
181     }
182    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26