日常メモ帳

現在PCはメインPCとサブPCの二台使い
そうなると、マウス・キーボードは共有したくなるけど、もう一つ
クリップボードも共有したくなる

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

まったく動かなかったり、一方通行でしか共有できなかったり、最初は動いていても
すぐに動かなくなったりで、まったくいうことを聞かない
まあ仕方ないかと諦めていたんだけど、そのくらいのツールならサクっとつくれそうだったんで
ちょっと作ってみた

#!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を使う癖が抜けないが、
まあ個人的にしかつかわないしよしとするｗ
こいつをメインPCとサブPCにいれて、コンソール画面はいらないので
wperlから呼び出すようにすると、無事にクリップボードが共有された
いまんとこ、動作も安定しててまあ問題はないかな？
本当はperlccでコンパイルできればよかったんだけど