#/////////////////////////////////////////////////////////////////// # GMS_Perl KENTWEB様モジュール Ver1.51 # Copyright(C) by でいゆ工房 # http://www.deiyu-studio.net/ #/////////////////////////////////////////////////////////////////// # このCGIスクリプトは KENT WEB様のスクリプトを使用しております # Copyright(C) Kent Web # webmaster@kent-web.com # http://www.kent-web.com/ #/////////////////////////////////////////////////////////////////// #------------------# # JPEGサイズ認識 # #------------------# sub JpegSize { local($jpeg) = @_; local($t, $m, $c, $l, $W, $H); open(JPEG, "$jpeg") || return (0,0); binmode(JPEG); read(JPEG, $t, 2); while (1) { read(JPEG, $t, 4); ($m, $c, $l) = unpack("a a n", $t); if ($m ne "\xFF") { $W = $H = 0; last; } elsif ((ord($c) >= 0xC0) && (ord($c) <= 0xC3)) { read(JPEG, $t, 5); ($H, $W) = unpack("xnn", $t); last; } else { read(JPEG, $t, ($l - 2)); } } close(JPEG); return ($W, $H); } #-----------------# # GIFサイズ認識 # #-----------------# sub GifSize { local($gif) = @_; local($data, $W, $H); open(GIF,"$gif") || return (0,0); binmode(GIF); sysread(GIF,$data,10); close(GIF); if ($data =~ /^GIF/) { $data = substr($data,-4); } $W = unpack("v",substr($data,0,2)); $H = unpack("v",substr($data,2,2)); return ($W, $H); } #-----------------# # PNGサイズ認識 # #-----------------# sub PngSize { local($png) = @_; local($W, $H); open(PNG, "$png") || return (0, 0); binmode(PNG); seek(PNG, 16, 0); read(PNG, $W, 4); read(PNG, $H, 4); close(PNG); $W = unpack("N", $W); $H = unpack("N", $H); return ($W, $H); } #----------------------# # パスワード暗号処理 # #----------------------# sub encrypt { local($inpw) = @_; local(@SALT, $salt, $encrypt); @SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/'); srand; $salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))]; $encrypt = crypt($inpw, $salt) || crypt ($inpw, '$1$' . $salt); return $encrypt; } #----------------------# # パスワード照合処理 # #----------------------# sub decrypt { local($inpw, $logpw) = @_; local($salt, $key, $check); $salt = $logpw =~ /^\$1\$(.*)\$/ && $1 || substr($logpw, 0, 2); $check = "no"; if (crypt($inpw, $salt) eq $logpw || crypt($inpw, '$1$' . $salt) eq $logpw) { $check = "yes"; } return $check; } #--------------# # ロック処理 # #--------------# sub lock { # 1分以上古いロックは削除する if (-e @_[1]) { local($mtime) = (stat(@_[1]))[9]; if ($mtime < time - 60) { &unlock(@_[0],"@_[1]"); } } local($retry) = 5; # symlink関数式ロック if (@_[0] == 1) { while (!symlink(".", @_[1])) { if (--$retry <= 0) { &Main::Error('Lock is busy'); } sleep(1); } # mkdir関数式ロック } elsif (@_[0] == 2) { while (!mkdir(@_[1], 0755)) { if (--$retry <= 0) { &Main::Error('Lock is busy'); } sleep(1); } } $lockflag=1; } #--------------# # ロック解除 # #--------------# sub unlock { if (@_[0] == 1) { unlink(@_[1]); } elsif (@_[0] == 2) { rmdir(@_[1]); } $lockflag=0; } 1;