ようこそゲストさん

日常メモ帳

メッセージ欄

2010年10月の日記

一覧で表示する

2010/10/31(日) クリップボード共有

2010/10/31 14:00 プログラム
現在PCはメインPCとサブPCの二台使い
そうなると、マウス・キーボードは共有したくなるけど、もう一つ
クリップボードも共有したくなる

で、ソフトウェア的にマウス・キーボード共有はツールも一杯あるし、それで
問題なく動くけど、前から困っていたのがクリップボードの共有
これも、専用のツールなり、マウス共有の1機能なりですでに出回ってるんだけど、
なぜか上手く動かない

まったく動かなかったり、一方通行でしか共有できなかったり、最初は動いていても
すぐに動かなくなったりで、まったくいうことを聞かない
まあ仕方ないかと諦めていたんだけど、そのくらいのツールならサクっとつくれそうだったんで
ちょっと作ってみた
#!perl
use Win32::Clipboard;
use IO::Socket;
my $clip = Win32::Clipboard();
my $sport =24252;
#送信先アドレスを読み込み
open (IN,"iplist.txt")  or die $!;
$iplist = <IN>;
close(IN);
print "send to $iplist\n";

# サーバ側
if (my $pid = fork()) {
	local $buf,$txt,$ca,$port,$ipaddr;
	#ソケット作成
	local $serv = IO::Socket::INET->new(
		LocalPort	=> $sport,
		ReuseAddr	=> 1,
		Proto	=> "udp"
	) or die $!;

	#待ち受け
	while(1){
		$txt='';#初期化
		while(1){
			$ca = $serv->recv($buf, 1001);#受信
			($port,$ipaddr)=sockaddr_in($ca);
			$ipaddr=inet_ntoa($ipaddr);
			#ローカル以外からの通信なら無視
			if (substr($ipaddr,0,10) ne "192.168.1.") {print "err!! (illegal addr $ipaddr)\n";last;};
			#末尾のコードが0なら、続きがある
			if (substr($buf,-1) eq chr(0)){
				chop($buf);
				$txt.=$buf;
			#そうじゃなかったらこれで終わり
			}else{
				$txt.=$buf;
				last
			}
		}
		#結合した文字をクリップボードにセット
		$clip->Set($txt);
		#終了コードなら抜ける
		if ($txt eq "SYS:EXIT") {last};
	}
	#ソケットを閉じる
	$serv->close;
	exit(0);
#クライアント側
} else {
	local $old_text,$text,$cnt,$sptxt;
	#ソケット作成
	local $cli = IO::Socket::INET->new(
		PeerAddr	=> $iplist,
		PeerPort	=> $sport,
		Proto	=> "udp"
	) or die $!;
	#何故かWin起動直後に限りWaitForChange前に少し時間をおかないと
	#バグってクリップボードの変更を感知しなくなる
	sleep(50);
	while(1){
		#無限ループ防止に変更前のクリップボードの中身を記憶
		$old_text = $clip->GetText();
		#クリップボードの中身が変わるまで待つ
		$clip -> WaitForChange();
		unless ($clip->IsText()) {print "notxt\n";next};#テキスト以外なら無視
		$text = $clip->GetText();

		if  ($old_text eq $text) {print "eq\n";next};#中身が変わってなければ無視(無限ループ防止)
		$cnt=0;#文字位置記録用
		while(1)
		{
			#1000バイト分取得(パケットサイズを越えない程度に)
			$sptxt = substr($text, $cnt, 1000);
			$cnt+=1000;
			#続きがあれば目印にキャラコード0をくっつける
			if ($cnt < length($text)){
				$cli->send($sptxt.chr(0))
			}else{
				$cli->send($sptxt);
				last;#全部送ったのでループを抜ける
			}
		}
		#終了コードなら抜ける
		if ($text eq "SYS:EXIT") {last};
	}
	#ソケットを閉じる
	$cli->close;
	exit(0);
}
未だにこの手の簡単なツールを作る時perlを使う癖が抜けないが、
まあ個人的にしかつかわないしよしとするw
こいつをメインPCとサブPCにいれて、コンソール画面はいらないので
wperlから呼び出すようにすると、無事にクリップボードが共有された
いまんとこ、動作も安定しててまあ問題はないかな?
本当はperlccでコンパイルできればよかったんだけど

名前:  非公開コメント   

2010/10/29(金) STAXのヘッドフォン

2010/10/29 23:34 趣味
先週のことだけど、メールアラートで登録してたSTAXのヘッドフォンセットがいつもの底値より
2万以上もぽんと安くなってた
メールをみた瞬間飛びついて注文したんだけど、品切れということでキャンセルされてしまった……
ぬか喜びかよー、と思ったけど。どうも後継のSRS-4170ってのが発売されるっぽい

横浜買収でコジマのパクリかよwといわれてるノジマで視聴してこようかなー
(いつ視聴できるようになるかわからんがw)

名前:  非公開コメント   

2010/10/23(土) LED育成装置三号改・改

2010/10/23 22:47 園芸
どうも、階段の所に設置したLED育成装置三号改の調子が思わしくないので
前から気になっていた

 「 市販のLED電球でうまく植物が育つか? 」

という疑問を解決する意味も込めて、「LED育成装置三号改・改」にしました
そろそろ「LED育成装置三二式」とか呼んだ方がいいんだろうかw
で、できあがりはこんな感じ

DCF00541.JPG

ちょっと廃熱問題が不安ですが、まあ何とかして貰おう
白色のLEDって実は「疑似白色」といってもいい内容で
普通の白は「赤+緑+青」で作ってるんですが、これは「青+黄」で作っている
つまり、植物が一番光合成で必要としている「赤」の成分がない状態になっている
(いちおう、「赤+緑+青」で白を作っているLEDもあるが高価)
なので、まったく育たなくても不思議はないのだが、二週間ほどプレテストをしてみたら
なんと、普通に成長を始めたので、今回本格的に組んでみた

さて、上手く育つかどうか

名前:  非公開コメント   

2010/10/03(日) スパムメール

2010/10/03 23:55 その他
スパムメール多いんですよね、実はそれも引っ越しを決意した理由の一つだったりするんですが
少ない日でも100通は来るんです。
まあ、ほとんどホワイトリスト方式で弾いてるんで、うざいメールを見ることは
ほとんど無いんですが、たまたまのタイミングで受信しちゃったスパムの送り主

From: レアアース

おまえ、最近話題になってる単語を使いたかっただけじゃないのかw
中国へお帰りください。

名前:  非公開コメント