#!/usr/bin/perl # ------------------------------------------------ # WRISTOMOシンクロ通信解析結果 # プロトコル説明用サンプルスクリプト # ------------------------------------------------ # # ●注意 # このPerlスクリプトは、NTT DoCoMoのWRISTOMO(リストモ)についている # 「シンクロ」機能と通信するプロトコルを再現するものです。 # これは通信内容を独自に解析した結果に基づいて作られたもので、正常に # 動作することを期待していますが、正常に動作することを保証するものでは # ありません。万が一スクリプトならびに解析結果を使用したことにより # データが消失するなどの損害が発生したとしても、解析者である私は # 何の責も負わないこととします。あくまでも自己責任のもとご利用ください。 # # # # よだん: # このスクリプトをそのまま使うと、データを入力するのがたいていWRISTOMOの # タイムアウトに間に合わなかったりしますがそれはご愛嬌ってことで。 # # # # ===== 現在、このスクリプトはネットワークシンクロに対応して動作する # ===== セッティングになっています。改造方法については各コメントを # ===== ごらんください。 # # (ソースリストはTabを4桁の設定にすると読みやすいです) # # # ==================================================== # メインループ # ==================================================== # メディアをオープンする $| = 1; &WRISTOMO_MEDIA_open(); # (プロセスを2つ使う) if (fork()==0) { # 受信 while(1) { &WRISTOMO_recieve(); } } else { # 送信メニュー $serial = 0; while(1) { print "\n\n"; print "----------------------------------------\n"; print " WRISTOMO 簡易シンクロサーバ MENU\n"; print "----------------------------------------\n"; print "1: コネクションオープン\n"; print "2: コネクションクローズ\n"; print "3: レコード数確認\n"; print "4: レコード更新時刻取得\n"; print "5: レコード取得\n"; print "6: レコード書き込み\n"; print "7: レコード削除\n"; print "8: レコード新規作成\n"; print "----------------------------------------\n"; print "Sending packet type > "; $d = ; $d =~ s/[^\d]//g; if ($d == 1) { &WRISTOMO_send_ConnectionOpen(); } elsif ($d == 2) { &WRISTOMO_send_ConnectionClose(); } elsif ($d == 3) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); &WRISTOMO_send_GetRecordNum($type); } elsif ($d == 4) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); &WRISTOMO_send_GetRecordTimestamp($type); } elsif ($d == 5) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); print "取得するレコード番号を数値で入力してください > "; my $num = eval(); &WRISTOMO_send_GetRecord($type,$num); } elsif ($d == 6) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); print "書き込むレコード番号を数値で入力してください > "; my $num = eval(); my ($dat,$size) = &WRISTOMO_InputRecord($type); my $str = &WRISTOMO_scramble($dat,$size); # 暗号化する &WRISTOMO_send_SetRecord($type,$num,$str,$size); } elsif ($d == 7) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); print "削除するレコード番号を数値で入力してください > "; my $num = eval(); &WRISTOMO_send_DeleteRecord($type,$num); } elsif ($d == 8) { print "種別を数値で入力してください(0:電話帳 1:スケジュール) > "; my $type = eval(); my ($dat,$size) = &WRISTOMO_InputRecord($type); my $str = &WRISTOMO_scramble($dat,$size); # 暗号化する &WRISTOMO_send_NewRecord($type,$str,$size); } } } &WRISTOMO_MEDIA_close(); exit; # ==================================================== # データを入力する # ==================================================== sub WRISTOMO_InputRecord { my $type = shift; my @DATS,$size,$dat; if ($type == 0) { @DATS = ( "0000:24:S:名前", "001A:24:S:読み", "0034:2:W:電話1アイコン番号", "0036:32:S:電話1", "0058:2:W:電話2アイコン番号", "005A:32:S:電話2", "007C:2:W:電話3アイコン番号", "007E:32:S:電話3", "00A0:2:W:メール1アイコン番号", "00A2:32:S:メール1", "00E4:2:W:メール2アイコン番号", "00E6:32:S:メール2", "0138:2:W:グループ番号", "013A:2:W:シークレット(00:OFF 01:ON)" ); $size = 0x13C; } else { @DATS = ( "0000:48:S:件名", "0032:48:S:場所", "0064:96:S:内容", "00C6:1:B:タイプ(00:時間帯指定 01:終日)", "00C7:1:B:開始年(西暦-2000)", "00C8:1:B:開始月", "00C9:1:B:開始日", "00CA:1:B:開始時間 (終日はFF)", "00CB:1:B:開始分 (終日はFF)", "00CC:1:B:終了年(西暦-2000)", "00CD:1:B:終了月", "00CE:1:B:終了日", "00CF:1:B:終了時間 (終日はFF)", "00D0:1:B:終了分 (終日はFF)", "00D1:1:B:アラーム設定(01:アラームON FF:アラームOFF)", "00D2:1:B:アラーム鳴動タイミング(nn分前,FF:アラームOFF)", "00D3:1:B:00 (FF:アラームOFF)", "00D4:1:B:アラーム年 (FF:アラームOFF)", "00D5:1:B:アラーム月 (FF:アラームOFF)", "00D6:1:B:アラーム日 (FF:アラームOFF)", "00D7:1:B:アラーム時 (FF:アラームOFF)", "00D8:1:B:アラーム分 (FF:アラームOFF)" ); $size = 0xDE; } $dat = ""; for(my $i=0; $i<$size; $i++) { $dat .= chr(0); } for(my $i=0; $i<=$#DATS; $i++) { my @D = split(":",$DATS[$i],4); print $D[3]." > "; my $str = ; if ($D[2] eq "S") { # ----- String $str = substr($str,0,$D[1]); substr($dat,hex($D[0]),length($str)) = $str; } elsif ($D[2] eq "B") { # ----- Byte $str = eval($str); substr($dat,hex($D[0]),1) = chr($str & 255); } elsif ($D[3] eq "W") { # ----- Word $str = eval($str); substr($dat,hex($D[0]),2) = chr($str & 255).chr(($str / 256) & 255); } } ($dat,$size); } # ==================================================== # 各種パケットを投げる # ==================================================== # --------------------------------------- コネクションオープン sub WRISTOMO_send_ConnectionOpen { my $key = 0; # 暗号キー(乱数種)。解析の都合上0x0000固定 my $send = chr(0x01).chr($key & 255).chr(($key / 256) & 255).chr(0x00); &WRISTOMO_sendpacket( $serial, $send, 4); $serial++; } # --------------------------------------- コネクションクローズ sub WRISTOMO_send_ConnectionClose { my $send = chr(0x02).chr(0x00); &WRISTOMO_sendpacket( $serial, $send, 2); $serial++; } # --------------------------------------- レコード数確認 sub WRISTOMO_send_GetRecordNum { my $type = shift; # 種別 my $send = chr(0x03).chr($type & 255); &WRISTOMO_sendpacket( $serial, $send, 2); $serial++; } # --------------------------------------- レコード更新時間確認 sub WRISTOMO_send_GetRecordTimestamp { my $type = shift; # 種別 my $send = chr(0x04).chr($type & 255); &WRISTOMO_sendpacket( $serial, $send, 2); $serial++; } # --------------------------------------- レコード取得 sub WRISTOMO_send_GetRecord { my $type = shift; # 種別 my $num = shift; # レコード番号 my $send = chr(0x05).chr($type & 255).chr($num & 255).chr(($num / 256) & 255); &WRISTOMO_sendpacket( $serial, $send, 4); $serial++; } # --------------------------------------- レコード書き込み sub WRISTOMO_send_SetRecord { my $type = shift; # 種別 my $num = shift; # レコード番号 my $dat = shift; # データ my $size = shift; # データサイズ my $send = chr(0x06).chr($type & 255).chr($num & 255).chr(($num / 256) & 255).$dat; &WRISTOMO_sendpacket( $serial, $send, 4+$size); $serial++; } # --------------------------------------- レコード削除 sub WRISTOMO_send_DeleteRecord { my $type = shift; # 種別 my $num = shift; # レコード番号 my $send = chr(0x07).chr($type & 255).chr($num & 255).chr(($num / 256) & 255); &WRISTOMO_sendpacket( $serial, $send, 4); $serial++; } # --------------------------------------- レコード新規作成 sub WRISTOMO_send_NewRecord { my $type = shift; # 種別 my $dat = shift; # データ my $size = shift; # データサイズ my $send = chr(0x06).chr($type & 255).$dat; &WRISTOMO_sendpacket( $serial, $send, 2+$size); $serial++; } # ==================================================== # パケット受信処理 # ==================================================== # パケット受信待機をし、送られてきたデータを表示します。 # 表示するのみで特に処理をしませんので、各自必要な処理を加えてください。 sub WRISTOMO_recieve { my $num,$data,$size,$cmd,$num,$i,$d,$str; ($num,$data,$size) = &WRISTOMO_recievepacket(); print "●パケットを受信しました------------\n"; print " サイズ: ".$size."\n"; print "PacketNo: ".sprintf("%02X",$num)."\n"; $cmd = ord(substr($data,0,1)); # ============================================== 0x41 : シンクロ開始要求 if ($cmd == 0x41) { print "cmd : 41 (シンクロ開始要求)\n"; print "\n"; # ============================================== 0x42 : シンクロ強制終了要求 } elsif ($cmd == 0x42) { print "cmd : 42 (シンクロ強制終了要求)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "\n"; # ============================================== 0x81 : コネクションオープン完了 } elsif ($cmd == 0x81) { print "cmd : 81 (コネクションオープン完了)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "? : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; print "製造年? : ".sprintf("%02X",ord(substr($data,3,1)))."\n"; print "製造月? : ".sprintf("%02X",ord(substr($data,4,1)))."\n"; $num = ord(substr($data,5,1))*0x100000; $num += ord(substr($data,6,1))* 0x1000; $num += ord(substr($data,7,1))* 0x10; $num += ((ord(substr($data,8,1)) >> 4) & 0xF); print "製造番号: ".$num."\n"; print "\n"; # ============================================== 0x82 : コネクションクローズ完了 } elsif ($cmd == 0x82) { print "cmd : 82 (コネクションクローズ完了)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "\n"; # ============================================== 0x83 : レコード数レスポンス } elsif ($cmd == 0x83) { print "cmd : 83 (レコード数レスポンス)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "種別 : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録数 : ".$num."\n"; print "? : ".sprintf("%02X",ord(substr($data,5,1)))."\n"; print "? : ".sprintf("%02X",ord(substr($data,6,1)))."\n"; print "\n"; # ============================================== 0x84 : レコード更新時刻レスポンス } elsif ($cmd == 0x84) { print "cmd : 84 (レコード更新時刻レスポンス)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "種別 : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録数 : ".$num."\n"; for($i=0;$i<$num;$i++) { $d = ord(substr($data,$i*12+5,1)); $d += ord(substr($data,$i*12+6,1))*0x100; print " No.".sprintf("%05d",$d); $d = ord(substr($data,$i*12+7,1)); $d += ord(substr($data,$i*12+8,1))*0x100; print "(".sprintf("%05d",$d).") : "; print sprintf("%02X",ord(substr($data,$i*12+ 9,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+10,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+11,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+12,1)))." / "; print sprintf("%02X",ord(substr($data,$i*12+13,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+14,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+15,1)))." "; print sprintf("%02X",ord(substr($data,$i*12+16,1)))."\n"; } print "\n"; # ============================================== 0x85 : レコード取得レスポンス } elsif ($cmd == 0x85) { print "cmd : 85 (レコード取得レスポンス)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; $d = ord(substr($data,2,1)); print "種別 : ".sprintf("%02X",$d)."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録番号: ".$num."\n"; print "Data : \n"; $str = &WRISTOMO_scramble(substr($data,5),$size-5); # 暗号化を解除する if ($d == 0) { # ============= 電話帳 print " 名前: ".substr($str,0x0000,24)."\n"; print " 読み: ".substr($str,0x001A,24)."\n"; print " 電話1アイコン: ".sprintf("%02X%02X",ord(substr($str,0x0035,1)),ord(substr($str,0x0034,1)))."\n"; print " 電話1: ".substr($str,0x0036,24)."\n"; print " 電話2アイコン: ".sprintf("%02X%02X",ord(substr($str,0x0059,1)),ord(substr($str,0x0058,1)))."\n"; print " 電話2: ".substr($str,0x005A,24)."\n"; print " 電話3アイコン: ".sprintf("%02X%02X",ord(substr($str,0x007D,1)),ord(substr($str,0x007C,1)))."\n"; print " 電話3: ".substr($str,0x007E,24)."\n"; print "メール1アイコン: ".sprintf("%02X%02X",ord(substr($str,0x00A1,1)),ord(substr($str,0x00A0,1)))."\n"; print " メール1: ".substr($str,0x00A2,64)."\n"; print "メール2アイコン: ".sprintf("%02X%02X",ord(substr($str,0x00E5,1)),ord(substr($str,0x00E4,1)))."\n"; print " メール2: ".substr($str,0x00E6,64)."\n"; print " グループ番号: ".sprintf("%02X%02X",ord(substr($str,0x0139,1)),ord(substr($str,0x0138,1)))."\n"; print " シークレット: ".sprintf("%02X%02X",ord(substr($str,0x013B,1)),ord(substr($str,0x013A,1)))."\n"; } elsif ($d =- 1) { # ============= スケジュール print " 件名: ".substr($str,0x0000,48)."\n"; print " 場所: ".substr($str,0x0032,48)."\n"; print " 内容: ".substr($str,0x0064,96)."\n"; print " タイプ: ".sprintf("%02X",ord(substr($str,0x00C6,1)))."\n"; print " 開始時間: "; print sprintf("%02d/%02d/%02d %02d:%02d", ord(substr($str,0x00C7,1)), ord(substr($str,0x00C8,1)), ord(substr($str,0x00C9,1)), ord(substr($str,0x00CA,1)), ord(substr($str,0x00CB,1)), )."\n"; print " 終了時間: "; print sprintf("%02d/%02d/%02d %02d:%02d", ord(substr($str,0x00CC,1)), ord(substr($str,0x00CD,1)), ord(substr($str,0x00CE,1)), ord(substr($str,0x00CF,1)), ord(substr($str,0x00D0,1)), )."\n"; print " アラーム設定: ".sprintf("%02X",ord(substr($str,0x00D1,1)))."\n"; print " 鳴動タイミング: ".sprintf("%02X",ord(substr($str,0x00D2,1)))."\n"; print " ??: ".sprintf("%02X",ord(substr($str,0x00D3,1)))."\n"; print " アラーム時間: "; print sprintf("%02d/%02d/%02d %02d:%02d", ord(substr($str,0x00D4,1)), ord(substr($str,0x00D5,1)), ord(substr($str,0x00D6,1)), ord(substr($str,0x00D7,1)), ord(substr($str,0x00D8,1)), )."\n"; print " ??: "; print sprintf("%02X %02X %02X %02X %02X", ord(substr($str,0x00D9,1)), ord(substr($str,0x00DA,1)), ord(substr($str,0x00DB,1)), ord(substr($str,0x00DC,1)), ord(substr($str,0x00DD,1)), )."\n"; } print "\n"; # ============================================== 0x86 : レコード書き込み完了 } elsif ($cmd == 0x86) { print "cmd : 86 (レコード書き込み完了)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "種別 : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録番号: ".$num."\n"; print "更新時刻: "; print sprintf("%02X",ord(substr($data,5,1)))." "; print sprintf("%02X",ord(substr($data,6,1)))." "; print sprintf("%02X",ord(substr($data,7,1)))." "; print sprintf("%02X",ord(substr($data,8,1)))."\n"; print "\n"; # ============================================== 0x87 : レコード削除完了 } elsif ($cmd == 0x87) { print "cmd : 87 (レコード削除完了)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "種別 : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録番号: ".$num."\n"; print "\n"; # ============================================== 0x88 : レコード新規作成完了 } elsif ($cmd == 0x88) { print "cmd : 88 (レコード新規作成完了)\n"; print "? : ".sprintf("%02X",ord(substr($data,1,1)))."\n"; print "種別 : ".sprintf("%02X",ord(substr($data,2,1)))."\n"; $num = ord(substr($data,3,1)); $num += ord(substr($data,4,1))*0x100; print "登録番号: ".$num."\n"; print "? : ".sprintf("%02X",ord(substr($data,5,1)))."\n"; print "? : ".sprintf("%02X",ord(substr($data,6,1)))."\n"; print "登録時刻: "; print sprintf("%02X",ord(substr($data,7,1)))." "; print sprintf("%02X",ord(substr($data,8,1)))." "; print sprintf("%02X",ord(substr($data,9,1)))." "; print sprintf("%02X",ord(substr($data,10,1)))."\n"; print "更新時刻: "; print sprintf("%02X",ord(substr($data,11,1)))." "; print sprintf("%02X",ord(substr($data,12,1)))." "; print sprintf("%02X",ord(substr($data,13,1)))." "; print sprintf("%02X",ord(substr($data,14,1)))."\n"; print "\n"; # ============================================== その他のパケット } else { print "Data : "; for($i=0;$i3) && ($pos<=($size-2))) { $data .= chr($C); $sum += $C; $pos++; } # 4〜 : データ本体 elsif ($pos == ($size-1)) { $sumd = $C; $pos++; } # last-1 : チェックサム(下位) elsif ($pos == $size ) { # last : チェックサム(上位) $sumd = $C * 256 + $sumd; $pos = 0; if ($sum == $sumd) { $flag = 1; # チェックサム整合 = パケット受信終了 } else { $flag = 0; # (※エラー) } } } $size = $size - 5; # 実際のデータ(ペイロード)はパケットサイズ-5 ($num,$data,$size); # パケット番号, データ本体, データサイズを返す } # ==================================================== # 送信用データをもとに、パケットを生成して送信する # ==================================================== # 引数:パケット番号(1byte,スカラー値) # データ (バイナリ文字列) # データ長 (データの長さ) sub WRISTOMO_sendpacket { my $num = shift; my $dat = shift; my $siz = shift; my $pkt = ""; # パケットバッファ my $sum = 0; # チェックサム my $psiz = $siz + 5; # データ長+パケット番号1byte+サイズ2bytes+チェックサム2bytes $pkt .= chr($psiz & 255).chr(($psiz / 256) & 255); # パケット長 $sum += ($psiz & 255) + (($psiz / 256) & 255); # (のチェックサム) $pkt .= chr($num & 255); # パケット番号 $sum += ($num & 255); # (のチェックサム) $pkt .= $dat; # データ for(my $i=0; $i<$siz; $i++) { # (のチェックサム) $sum += ord(substr($dat,$i,1)); } $pkt .= chr($sum & 255).chr(($sum / 256) & 255); # チェックサム &WRISTOMO_MEDIA_sendchar(0x7E); # パケット開始デリミタ &WRISTOMO_send($pkt,$psiz); # パケット本体 &WRISTOMO_MEDIA_sendchar(0x7E); # パケット終了デリミタ } # ======================================================= # 一連のデータを、0x7D,0x7Eをエスケープしつつ送信する # ======================================================= # 引数:データ (バイナリ文字列) # データ長(スカラー値) sub WRISTOMO_send { my $dat = shift; my $len = shift; for(my $i=0;$i<$len;$i++) { my $ch = ord(substr($dat,$i,1)); if ($ch == 0x7D) { &WRISTOMO_MEDIA_sendchar(0x7D); # 0x7Dは 0x7D 0x00 にエスケープする &WRISTOMO_MEDIA_sendchar(0x00); } elsif ($ch == 0x7E) { &WRISTOMO_MEDIA_sendchar(0x7D); # 0x7Eは 0x7D 0x03 にエスケープする &WRISTOMO_MEDIA_sendchar(0x03); } else { &WRISTOMO_MEDIA_sendchar($ch); # それ以外はそのまま送信する } } } # ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ # 以下のルーチンは、シンクロを行うメディアに応じて書き換えます。 # 現在ネットワークシンクロを待受けるようなコードになっていますが、これをたとえば # シリアルポートに対して送受信することでシンクロケーブル経由でのシンクロが可能です。 # ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ #$IGNORE = <<___END___; # ==================================== # シンクロ先メディアをオープンする # ==================================== sub WRISTOMO_MEDIA_open { use Socket; $port= 3850; $proto=getprotobyname('tcp'); socket(LISTEN,&PF_INET,&SOCK_STREAM,$proto) or die("ソケットがオープン出来ない:$!\n"); bind(LISTEN,sockaddr_in($port,INADDR_ANY)) or die("ソケットがbindできない:$!\n"); listen(LISTEN,SOMAXCON); accept(FH,LISTEN); binmode(FH); select(FH); $|=1; select(STDOUT); } # ==================================== # シンクロ先メディアをクローズする # ==================================== sub WRISTOMO_MEDIA_close { close(FH); close(LISTEN); } # ========================================== # 1バイトをシンクロ先メディアに送信する # ========================================== # 引数:データ(1byte,スカラー値) sub WRISTOMO_MEDIA_sendchar { my $dat = shift; print FH chr($dat); } # ============================================ # 1バイトをシンクロ先メディアから読み込む # ============================================ # 返値:データ(1byte,スカラー値) sub WRISTOMO_MEDIA_getchar { my $flg,$C,$r,$e; my $fhv = ""; vec($fhv,fileno(FH),1) = 1; $flg = 0; while($flg==0) { select($r=$fhv,undef,$e=$fhv,0); if (vec($r,fileno(FH),1)) { $C = getc(FH); if ($C eq "") { $flg = -1; } else { $C = ord($C); $flg = 1; } } if (vec($e,fileno(FH),1)) { $flg = -1; } # 接続が切れた if ($flg < 0) { print "********************** 接続が切れました\n"; while(1) { sleep(1); } } } $C; } #___END___ # ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ # 以下参考用の、ActivePerl + Win32::SerialPortを使った、シンクロケーブル向けルーチンです。 # Perlでシリアルポートを利用する方法は環境によって異なりますので、あくまでも参考として # お考えください。 # ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ # $IGNORE = <<___END___; # ==================================== # シンクロ先メディアをオープンする # ==================================== sub WRISTOMO_MEDIA_open { use Win32::SerialPort; $CnfName = "./protocol_test_setting.txt"; print "オープンするポートを入力してください (例:COM9) >"; $PortName = ; $PortName =~ s/[\x00-\x1f]//g; $PortObj = new Win32::SerialPort($PortName) || die; $PortObj->baudrate(115200); $PortObj->parity("none"); $PortObj->databits(8); $PortObj->stopbits(1); $PortObj->write_settings || undef $PortObj; $PortObj->save($CnfName); $PortObj->close(); undef $PortObj; $PortObj = tie (*FH, 'Win32::SerialPort', $CnfName) || undef $PortObj; } # ==================================== # シンクロ先メディアをクローズする # ==================================== sub WRISTOMO_MEDIA_close { close FH || warn "close failed"; ## CLOSE ## undef $PortObj; untie *FH; } # ========================================== # 1バイトをシンクロ先メディアに送信する # ========================================== # 引数:データ(1byte,スカラー値) sub WRISTOMO_MEDIA_sendchar { my $dat = shift; print FH chr($dat); print sprintf("%02X ",$dat); } # ============================================ # 1バイトをシンクロ先メディアから読み込む # ============================================ # 返値:データ(1byte,スカラー値) sub WRISTOMO_MEDIA_getchar { my $C=""; while($C eq "") { $C = getc(FH); } $C = ord($C); $C; } ___END___