ソースコード

「ソースコード」の編集履歴(バックアップ)一覧に戻る

ソースコード - (2012/03/03 (土) 20:38:20) のソース

ココは@パーティー改造者がボランティアでソースを公開してくださる場所です。
ソースを快く公開してくださる人がいてくださると嬉しいです。

*トップページのソースコード byホイホイ

今回必要なファイル:index.cgi
まずindex.cgiを開き
><p style="width:300px;height:100px;background-color:#000;overflow:scroll;">
>職業公開<br>トップページ公開</p>
こんな感じのを
>$contents .= <<"EOM";
の下に追加
更新内容とか追加したい場合は、
>職業公開<br>トップページ公開</p>
       ↓
>時間会得を追加<br>職業公開<br>トップページ公開</p>
こんな感じで増やしてく。用は<br>を増やせばいいってこと

*宝クジ屋の画面ヘッダー byホイホイ

今回必要なファイル:kuzi.cgi
これは宝クジ屋を追加していない人は全く関係ないです。
宝クジ屋を追加したいと思った人は[[INDEX.html>http://www4.atwiki.jp/patd/pages/27.html]]から追加してみてください
そこで追加したら、上のステータス表示がおかしいと思いませんか?そういうあなたに必要なソースです。
まず、kuzi.cgiの画面ヘッダーを見ます。そこを全て、消して
	 sub header_html {
	 my $nokori = $m{kuzitime} - $m{ltime};
	 $nokori = 0 if $nokori < 0;
	 print qq|<div class="mes">【$this_title】$e2j{money}:<b>$m{money}</b>G $e2j{hp}:<b>$m{hp} 	  </b>/<b>$m{mhp}</b>  $e2j{mp}:<b>$m{mp}</b>/<b>$m{mmp}</b></div>|;
	      	print qq|<b>宝券番号 $m{kuzi} のこり時間$nokori秒 </b>| if $m{kuzi};
	 }
に書き換え、すると出来ます
*宝くじ景品増やすには by暗黒剣
	my $okane1 = int(rand(99)+1);
を
	unless ($m{kuzi}) {
		$mes = "くじをかっていないじゃないか";
			return;
			}
の下に追加
そして		$npc_com = に$okane1が金貨賞、を追加
  

そんでif($m{kuzi} eq $okane1){
		$npc_com .= "<br />おめでとう!金貨賞だ!1000000Gを君に振り込んでおいた";
		$m{money} += 1000000;
	&write_news(qq|<span class="tenshon">$mさんが金貨賞に当たりました!おめでとうございます!</span>|);
}
をついかすればOK?
このようにいろいろふやしていけばいい^^

*@ギルド勢力内でのギルドの表示を上のほうへ by聖龍
 		my $gid = unpack 'H*', $gname;
 		$gname = qq|<img src="$guilddir/$gid/mark.gif" alt="ギルドマーク" /> $gname| if -f "$guilddir/$gid/mark.gif";
のしたの
 		$contents .= qq|<table class="table1" width="100%"><tr><td style="white-space: normal;">$count位 <span style="color: $gcolor;">$gname</span>  <b>$gcount</b>人  <b>$gpoint</b>Point  $gmes</td></tr>\n|;
の width="100% を width="77%にする

*ソースコードじゃない 単純な話だ by聖龍
view_monster.cgiについて
# 出現モンスターを確認するためのもの(管理用)
# http://自分のURL/party2/_view_monster.cgi?pass=管理者パスワード
# ※「自分のURL」とはこのCGIを設置した場所までのアドレス
つかねーよと思うかもしれませんが単純に
# http://自分のURL/party2/_view_monster.cgi?pass=管理者パスワード
じゃなくて
# http://自分のURL/party2/view_monster.cgi?pass=管理者パスワード
が正しいだけなんです以上w

*復活の草を強化? by遅いです
battle.cgiの
	# 復活の状態
	if ($ms{$y}{tmp} eq '復活') {
		$ms{$y}{tmp} = '';
		$ms{$y}{hp}  = int($ms{$y}{mhp} * (rand(0.1)+0.1));
		$com.=qq|<span class="revive">$yは瀕死でよみがえった!</span>|;
		&reset_status($y);
		return;
	}
の下に
	elsif ($ites[$m{ite}][1] eq '復活の草') {
		$m{ite} = '';
		$ms{$y}{hp}  = int($ms{$y}{mhp} * (rand(0.1)+0.1));
		$com.=qq|<span class="revive">$yは瀕死でよみがえった!</span>|;
		&reset_status($y);
		return;
	}
を追加。
こうすると、復活の草を装備している時に死ぬと自動で復活するようになります。
復活時の体力を変更したい場合は、
		$ms{$y}{hp}  = int($ms{$y}{mhp} * (rand(0.1)+0.1));
ここを変更してください。
このままだと@どうぐ で一時的状態を復活にも出来ますが、自分はなんとなく出来なくしています←

*ドロップを2つ設定する byシャナ (既にドロップを設定している方の@パ以外では動作を保証しません)
流れは殆どドロップシステムの追加と同じ。最初にconfig.cgiの変数の所を
@battle_datas = (qw/name addr color time ten job sp old_job old_sp mhp hp mmp mp mat at mdf df mag ag hit state tmp get_exp get_money icon wea arm drop drop2/); 
に変更。(最後にdrop2を追加するだけ。)
次に、battle.cgiの#NPCがプレイヤーを倒した時。または自爆の所を下のように変更
# NPCがプレイヤーを倒した時。または自爆 
return if $ms{$m}{color} eq $npc_color || $m eq $y; 



$com .= qq|<br /><span class="get">$mたちはそれぞれ $ms{$y}{get_exp} の$e2j{exp}と $ms{$y}{get_money} Gを手に入れた!</span>|; 




if ($ms{$y}{drop}) { 



if (int(rand(1)) > 4) { 


my $item_name = $ites[$ms{$y}{drop}][1]; 



if (!$m{ite}) { 
$npc_com .= "$item_nameを手に入れました!"; 
$m{ite} = $ms{$y}{drop}; 
require "./lib/_add_collection.cgi"; 
&add_collection; 
} 
elsif ($m{is_full}) { 
$npc_com .= "$item_name を拾った!!しかし、$mの預かり所はいっぱいだった…。$mはあきらめた"; 
} 
else { 
$npc_com .= "$item_name を拾った!$item_name は預かり所に送られました"; 
&send_item($m,3,$ms{$y}{drop}); 
}


}}



if ($ms{$y}{drop2}) { 



if (int(rand(1)) > 4) { 


my $item_name = $ites[$ms{$y}{drop2}][1]; 



if (!$m{ite}) { 
$npc_com .= "$item_nameを手に入れました!"; 
$m{ite} = $ms{$y}{drop2}; 
require "./lib/_add_collection.cgi"; 
&add_collection; 
} 
elsif ($m{is_full}) { 
$npc_com .= "$item_name を拾った!!しかし、$mの預かり所はいっぱいだった…。$mはあきらめた"; 
} 
else { 
$npc_com .= "$item_name を拾った!$item_name は預かり所に送られました"; 
&send_item($m,3,$ms{$y}{drop2}); 
} 



}}


for my $name (@partys) { 
next if $ms{$name}{hp} <= 0; 
if ($name eq $m) { # 倒した人 
$m{exp} += $ms{$y}{get_exp}; 
$m{money} += $ms{$y}{get_money}; 


my $par = 3; # 仲間になる確率(自分より弱い) 
if ( &is_strong) { # 自分より強い判定 
$win ? $m{kill_p}++ : $m{kill_m}++; 
$par = 1 unless $ms{$m}{job} eq '12'; # 仲間になる確率(自分より強い) 
}}}
そして、stage○.cgiの1つ1つのモンスターデータの所に
drop2 => アイテム番号を入力,
を追加。drop2を設定しない場合はそのままでOK。
これで完成です!ドロップするアイテムを武器に変更する場合はbattle.cgiを下に変更
# NPCがプレイヤーを倒した時。または自爆
return if $ms{$m}{color} eq $npc_color || $m eq $y;


$com .= qq|<br /><span class="get">$mたちはそれぞれ $ms{$y}{get_exp} の$e2j{exp}と $ms{$y}{get_money} Gを手に入れた!</span>|;



if ($ms{$y}{drop}) { 


if (int(rand(1)) > 4) {

my $item_name = $ites[$ms{$y}{drop}][1]; 


if (!$m{ite}) {
$npc_com .= "$item_nameを手に入れました!";
$m{ite} = $ms{$y}{drop};
require "./lib/_add_collection.cgi";
&add_collection;
}
elsif ($m{is_full}) {
$npc_com .= "$item_name を拾った!!しかし、$mの預かり所はいっぱいだった…。$mはあきらめた";
}
else {
$npc_com .= "$item_name を拾った!$item_name は預かり所に送られました";
&send_item($m,3,$ms{$y}{drop});
}

}}


if ($ms{$y}{drop2}) { 


if (int(rand(1)) > 4) {

my $item_name = $weas[$ms{$y}{drop2}][1]; 


if (!$m{wea}) {
$npc_com .= "$item_nameを手に入れました!";
$m{wea} = $ms{$y}{drop2};
require "./lib/_add_collection.cgi";
&add_collection;
}
elsif ($m{is_full}) {
$npc_com .= "$item_name を拾った!!しかし、$mの預かり所はいっぱいだった…。$mはあきらめた";
}
else {
$npc_com .= "$item_name を拾った!$item_name は預かり所に送られました";
&send_item($m,1,$ms{$y}{drop2});
}


}}

for my $name (@partys) {
next if $ms{$name}{hp} <= 0;
if ($name eq $m) { # 倒した人
$m{exp} += $ms{$y}{get_exp};
$m{money} += $ms{$y}{get_money};

my $par = 3; # 仲間になる確率(自分より弱い)
if ( &is_strong(%{ $ms{$y} }) ) { # 自分より強い判定
$win ? $m{kill_p}++ : $m{kill_m}++;
$par = 1 unless $ms{$m}{job} eq '12'; # 仲間になる確率(自分より強い)
}}}
*Lvが20以下の人は経験値2倍 byシャナ
battle.cgiの経験値・ゴールド習得等の所を以下に変更。
$com .= qq|<br /><span class="get">$mたちはそれぞれ $ms{$y}{get_exp}×$bonus の$e2j{exp}と $ms{$y}{get_money}×$bonus Gを手に入れた!</span>|;

for my $name (@partys) {
	next if $ms{$name}{hp} <= 0;
	if ($name eq $m) { # 倒した人
	if ( $m{lv} eq 20 ) {
		$bonus = 2;
	}
	else {
		$bonus = 1;
	}

	$m{exp}   += $ms{$y}{get_exp}*$bonus;
	$m{money} += $ms{$y}{get_money}*$bonus;

*wikiのバク。謝罪 byホイホイ
wikiにバクが発見されましてソースコードの一部が表示されないというのを聞きました。
これはwikiの性質上どうしようもないことです。今まで気がつかずまことに申し訳ありませんでした
これからは上のほうの『編集』をクリックし、ここを編集するところからソースコードをお持ちください

*@パーティーDXのペット選択機能 byシャナ
system.cgiとconfig.cgiの変数 p_name p2_name p3_name を削除して pet1 pet2 pet3を追加。(他のものはそのままでOK)
次に、_data.cgiを開いて下記のものを追加。

#=================================================
# ペット1(削除/並び変え自由)
#=================================================
@pet1s = (
#0No	1名前,		※2HP,3MP,4力,5守,6素,
[0, '----', 0, 0, 0, 0, 0,],
[1, 'スライム', 3, 2, 4, 2, 3,],
);
#=================================================
# ペット2(削除/並び変え自由)
#=================================================
@pet2s = (
#0No	1名前,		※2HP,3MP,4力,5守,6素,		7転職条件
[0, '----', 0, 0, 0, 0, 0,],
[1, 'ドラキー', 2, 4, 3, 3, 3,],
);
#=================================================
# ペット3(削除/並び変え自由)
#=================================================
@pet3s = (
#0No	1名前,		※2HP,3MP,4力,5守,6素,		7転職条件
[0, '----', 0, 0, 0, 0, 0,],
[1, 'フレイム', 5, 1, 4, 4, 1,],
);

次に、new_entry.cgiを開き、全て下にかきかえてください。

#!/usr/bin/perl
require 'config.cgi';
require '_side_menu.cgi';
require './lib/_data.cgi';
#================================================
# 新規登録 Created by Merino
#================================================
# 初期で選べる職業(No)
my @default_jobs = (1..12);
my @default_pet1s = (1);
my @default_pet2s = (1);
my @default_pet3s = (1);

#================================================
&decode;
&access_check;
&header;
&error("現在メンテナンス中です。しばらくお待ちください(約 $mente_min 分間)") if $mente_min;
$in{mode} eq 'new_entry' ? &new_entry : &new_form;
&footer;
exit;

#================================================
# 新規登録フォーム
#================================================
sub new_form {
	my $job_html = qq|<select class="select1" name="job">|;
	for my $i (@default_jobs) {
		$job_html .= qq|<option value="$i">$jobs[$i][1]</option>|;
	}
	$job_html .= qq|</select>|;
	my $pet1_html = qq|<select class="select1" name="pet1">|;
	for my $i (@default_pet1s) {
		$pet1_html .= qq|<option value="$i">$pet1s[$i][1]</option>|;
	}
	$pet1_html .= qq|</select>|;
	my $pet2_html = qq|<select class="select1" name="pet2">|;
	for my $i (@default_pet2s) {
		$pet2_html .= qq|<option value="$i">$pet2s[$i][1]</option>|;
	}
	$pet2_html .= qq|</select>|;
	my $pet3_html = qq|<select class="select1" name="pet3">|;
	for my $i (@default_pet3s) {
		$pet3_html .= qq|<option value="$i">$pet3s[$i][1]</option>|;
	}
	$pet3_html .= qq|</select>|;
	
	my $yid = $ENV{'QUERY_STRING'};
	my $contents = <<"EOM";
<h2>新規登録</h2>

<form method="$method" action="new_entry.cgi">
	<input type="hidden" name="mode" value="new_entry" />
	<input type="hidden" name="yid" value="$yid" />
	<ul>
		<li>記号(,;"'&<>\\/@)や空白は使えません。</li>
		<li>ネットマナーを守って楽しく遊びましょう。</li>
		<li><b>他人が不愉快になるような書き込みや多重登録は禁止です。見つけ次第削除します。</b></li>
	</ul>
	<table class="table1">
		<tr><td>プレイヤー名:</td><td><input type="text" name="name" class="text_box1" /></td></th></tr>
		<tr><td> </td><td>全角4(半角8)文字まで</td></tr>
		<tr><td>パスワード:</td><td><input type="text" name="pass" class="text_box1" /></td></th></tr>
		<tr><td> </td><td>半角英数字4~12文字まで</td></tr>
		<tr><td>職業:</td><td>$job_html</td></th></tr>
		<tr><td> </td><td>職業は重要です。説明書の特徴をよく読み、自分に合った職業を選びましょう</td></tr>
		<tr><td>ペット1:</td><td>$pet1_html</td></th></tr>
		<tr><td> </td><td>ペット1は戦闘でとても重要です。説明書の特徴をよく読み、自分に合ったペット1を選びましょう。</td></tr>
		<tr><td>ペット2:</td><td>$pet2_html</td></th></tr>
		<tr><td> </td><td>ペット2は戦闘でとても重要です。説明書の特徴をよく読み、自分に合ったペット2を選びましょう</td></tr>
		<tr><td>ペット3:</td><td>$pet3_html</td></th></tr>
		<tr><td> </td><td>ペット3は戦闘でとても重要です。説明書の特徴をよく読み、自分に合ったペット3を選びましょう</td></tr>
		<tr><td>$e2j{sex}:</td><td><input type="radio" name="sex" value="m" checked="checked" />男 <input type="radio" name="sex" value="f" />女</td></tr>
		<tr><td> </td><td>性別によって転職できる職業やアイコンが違います</td></tr>
	</table>
	<p><input type="submit" value="@登録" /></p>
</form>
<br />
EOM

	&side_menu($contents);
}
#================================================
# 新規登録チェック&完了処理
#================================================
sub new_entry {
	&check_black_list;
	&check_entry;
	&check_registered;
	&create_user;

	$contents = <<"EOM";
<p>以下の内容で登録しました</p>

<p class="strong">※プレイヤー名とパスワードはログインするときに必要なので、忘れないように!<p>
<table class="table1">
	<tr><th>プレイヤー</th><td>$m{name}</td>
	<tr><th>パスワード</th><td>$m{pass}</td>
	<tr><th>$e2j{sex}</th><td>$e2j{$m{sex}}</td>
	<tr><th>職業</th><td>$jobs[$m{job}][1]</td>
	<tr><th>$e2j{hp}</th><td align="right">$m{hp}</td>
	<tr><th>$e2j{mp}</th><td align="right">$m{mp}</td>
	<tr><th>$e2j{at}</th><td align="right">$m{at}</td>
	<tr><th>$e2j{df}</th><td align="right">$m{df}</td>
	<tr><th>$e2j{ag}</th><td align="right">$m{ag}</td>
	<tr><th>ペット1</th><td>$pet1s[$m{pet1}][1]</td>
	<tr><th>$e2j{hp}</th><td align="right">$pet1s[$m{pet1}][2]</td>
	<tr><th>$e2j{mp}</th><td align="right">$pet1s[$m{pet1}][3]</td>
	<tr><th>$e2j{at}</th><td align="right">$pet1s[$m{pet1}][4]</td>
	<tr><th>$e2j{df}</th><td align="right">$pet1s[$m{pet1}][5]</td>
	<tr><th>$e2j{ag}</th><td align="right">$pet1s[$m{pet1}][6]</td>
	<tr><th>ペット2</th><td>$pet2s[$m{pet2}][1]</td>
	<tr><th>$e2j{hp}</th><td align="right">$pet2s[$m{pet2}][2]</td>
	<tr><th>$e2j{mp}</th><td align="right">$pet2s[$m{pet2}][3]</td>
	<tr><th>$e2j{at}</th><td align="right">$pet2s[$m{pet2}][4]</td>
	<tr><th>$e2j{df}</th><td align="right">$pet2s[$m{pet2}][5]</td>
	<tr><th>$e2j{ag}</th><td align="right">$pet2s[$m{pet2}][6]</td>
	<tr><th>ペット3</th><td>$pet3s[$m{pet3}][1]</td>
	<tr><th>$e2j{hp}</th><td align="right">$pet3s[$m{pet3}][2]</td>
	<tr><th>$e2j{mp}</th><td align="right">$pet3s[$m{pet3}][3]</td>
	<tr><th>$e2j{at}</th><td align="right">$pet3s[$m{pet3}][4]</td>
	<tr><th>$e2j{df}</th><td align="right">$pet3s[$m{pet3}][5]</td>
	<tr><th>$e2j{ag}</th><td align="right">$pet3s[$m{pet3}][6]</td>
</table>
<div>
説明書は読みましたか?<br />
わからないことがある場合は、まず説明書を読みましょう。
</div>
<form method="$method" action="login.cgi">
	<input type="hidden" name="is_cookie" value="1" />
	<input type="hidden" name="login_name" value="$in{name}" />
	<input type="hidden" name="pass" value="$in{pass}" />
	<input type="submit" value="@プレイ" />
</form>
EOM
&side_menu($contents);
}

#================================================
# 登録チェック
#================================================
sub check_entry {
	&error("不正な登録処理です")				if $ENV{QUERY_STRING};
	&error("プレイヤー名が入力されていません")	unless $in{name};
	&error("パスワードが入力されていません")	if $in{pass} eq '';
	&error("$e2j{sex}が入力されていません")		if $in{sex} eq '';

	&error("プレイヤー名に不正な文字( ,;\"\'&<>\@ )が含まれています")	if $in{name} =~ /[,;\"\'&<>\@]/;
	&error("プレイヤー名に不正な文字( @ )が含まれています")			if $in{name} =~ /@/;
	&error("プレイヤー名に不正な空白が含まれています")					if $in{name} =~ / |\s/;
	&error("プレイヤー名は全角4(半角8)文字以内です")					if length($in{name}) > 8;
	&error("パスワードは半角英数字で入力して下さい")					if $in{pass} =~ m/[^0-9a-zA-Z]/;
	&error("パスワードは半角英数字4~12文字です")						if length $in{pass} < 4 || length $in{pass} > 12;
	&error("プレイヤー名とパスワードが同一文字列です")					if $in{name} eq $in{pass};
	&error("$e2j{sex}が異常です")										unless $in{sex} eq 'm' || $in{sex} eq 'f';

	my $is_ng_job = 1;
	for my $i (@default_jobs) {
		if ($i eq $in{job}) {
			$is_ng_job = 0;
			last;
		}
	}
	&error("職業が異常です") if $is_ng_job;
	
	$id = unpack 'H*', $in{name};
	&error("その名前はすでに登録されています") if -d "$userdir/$id";
	
	open my $fh, "< $logdir/entry.cgi" or &error("$logdir/entry.cgiファイルが読み込めません");
	my $line = <$fh>;
	close $fh;
	my($entry_count, $last_addr) = split /<>/, $line;
	&error("現在定員のため、新規登録は受け付けておりません") if $entry_count >= $max_entry;
	&error("多重登録は禁止しています") if $addr eq $last_addr;
}
#================================================
# 登録処理
#================================================
sub create_user {
	$id = unpack 'H*', $in{name};
	
	# フォルダ・ファイル作成
	mkdir "$userdir/$id", $mkdir or &error("その名前はすでに登録されています");
	for my $file_name (qw/collection depot depot_s hanasu home home_member item_send_mes job_master letter letter_log memory money monster monster_book profile recipe reload screen_shot send_item_mes stock user/) {
		my $output_file = "$userdir/$id/$file_name.cgi";
		open my $fh, "> $output_file" or &error("$output_file ファイルが作れませんでした");
		close $fh;
		chmod $chmod, $output_file;
	}
	open my $fh2, ">> $userdir/$id/collection.cgi" or &error("$userdir/$id/collection.cgiファイルが作れませんでした");
	print $fh2 ",\n,\n,\n";
	close $fh2;
	
	%m = ();
	$m = $m{name} = $in{name};
	$m{pass} = $in{pass};
	$m{job}  = $in{job};
	$m{sex}  = $in{sex};
	$m{money} = 200;
	$m{mhp}  = int(rand(3)) + 30;
	$m{mmp}  = int(rand(3)) + 6;
	$m{at}   = int(rand(3)) + 6;
	$m{df}   = int(rand(3)) + 6;
	$m{ag}   = int(rand(3)) + 6;
	$m{hp}   = $m{mhp};
	$m{mp}   = $m{mmp};
	$m{lv}   = 1;
	$m{icon} = "job/$m{job}_$m{sex}.gif";
	$m{color} = $default_color;
	$m{home} = $m;

	for my $k (qw/sleep job_lv exp medal coin coupon rare tired sp old_job old_sp wea wea_hp tate atama ude zyou ka asi ite is_full is_get is_eat kill_p kill_m cas_c hero_c mao_c pet1 pet2 pet3/) {
		$m{$k} = 0;
	}
	
	&write_user;
	&write_memory("冒険者 <b>$m</b> 誕生!");
	&write_news("<b>$m</b> という冒険者が参加しました");

	require './lib/_add_monster_book.cgi';
	&write_monster_book;

	&plus_entry_count;
	&copy("$htmldir/space.gif", "$userdir/$id/bgimg.gif");
	
	# 紹介ID付なら紹介者に小さなメダル送信
	if ($in{yid}) {
		my $send_name = pack 'H*', $in{yid};
		&send_item($send_name, 3, 23, "$m{name}(紹介加入)");
	}
}


#================================================
# 登録者数プラス
#================================================
sub plus_entry_count {
	open my $fh, "+< $logdir/entry.cgi" or &error("$logdir/entry.cgiファイルが開けません");
	eval { flock $fh, 2; };
	my $line = <$fh>;
	my($entry_count, $last_addr) = split /<>/, $line;
	++$entry_count;
	seek  $fh, 0, 0;
	truncate $fh, 0;
	print $fh "$entry_count<>$addr<>";
	close $fh;
}

#================================================
# ブラックリストのIPと同じかチェック
#================================================
sub check_black_list {
	open my $fh, "< $logdir/black_list.cgi" or &error("$logdir/black_list.cgiファイルが読み込めません");
	my $line = <$fh>;
	close $fh;
	&error("あなたのホストからは登録することが禁止されています") if $line =~ /,$host,/;
}

#================================================
# 多重登録禁止:全ユーザーのIPアドレスを調べる
#================================================
sub check_registered {
	opendir my $dh, "$userdir" or &error("ユーザーディレクトリが開けません");
	while (my $dir_name = readdir $dh) {
		next if $dir_name =~ /\./;
		
		my %datas = &get_you_datas($dir_name, 1);
		if ($addr eq $datas{addr}) {
#			&add_black_list($addr);
			&error("多重登録は禁止しています");
		}
	}
	closedir $dh;
}

これだけで作動すると思います。他の基本システムと合わない所があるので、そこは改造していって下さい。