GoogleAdSenseのPINコード

今更書くほどのことでもないんですが、少し前に、GoogleAdSenseという、アフィリエイト広告を始めました。


GoogleAdSenseってなによ!?

簡単に言えば、自分のホームページやブログに他人様の広告を表示して、広告がクリックされたら、回数に応じて収益がもらえるというやつです。

あまり広告収入は期待していませんが、あるとホームページが賑やかになるカナ!?
くらいの感じです。(実際、収入はありません(+o+))


PINコードが届きました!

昨日、身元確認のためのPINコードなるものが、ようやく届きました。
PINの生成日が"2012/2/8"なので、2週間ほどかかりました。
(収入が一定額にならないと届かないのでは!?と思ってしまいました。)

届いた封書は、A5の紙を半分に折って、左右と下の3か所をシールで止めてあるだけの、
良く言えば、ひじょ~にシンプルなものです。
(紙を丸めると、中が丸見えですが、、、(-_-;))
2012_02_21_01.jpg

中を空けると、PIN:******(ぼかし)と書かれています。
2012_02_21_02.jpg

という訳で、早速登録してみます。
PINを入力してください」をクリックして、
2012_02_21_03.jpg

PINコードの入力」⇒「PINを送信
、、、で、あっさり登録が終わりました。
2012_02_21_04.jpg


これで広告をクリックされれば、収入がバンバン入る!?なんて甘いです。
今の所、1クリック/数百ページビュー 位です。
振込がされるのは、お支払い基準額(¥10,000)に達してからという事なので、いったいいつになる事やら、、、

ちなみに、自分でクリックしてはダメです!
もちろん家族や友人に頼むのもダメです!
Googleは、サイトの状況やOS、ブラウザ、解像度など様々な要素から、かなりの精度で、チェックしているらしいです。
ルータの電源入れ直しでIP変えて、とかマンガ喫茶から串を使って、バンバンクリック!
なんてやった日には、2~3日後に、アカウント停止のお達しが届くそうですので、くれぐれも気長に待ちましょう!(やったら犯罪ですから)

、、、ちなみに、自分は、、、クリックしちゃいました∑(*゚д゚*)!!
でもあくまで確認用に数クリックだけだったので、怒られることはありませんでした。

くれぐれもお気を付け下さい(-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : 雑記
ジャンル : コンピュータ

第3回:FANの異音と処理速度低下PC復旧

さて、本日ご紹介する内容は、とある個人様から、、

【ご依頼内容】
 パソコンを起動すると、時々、異音「カタカタ」がし、日々音が大きくなってきている。
 また、処理速度がとても遅く、インターネットで動画がプツンプツンと切れる。

【お仕事内容】
 パソコンは、Fujitsu FMV BIBLO NF55Y/D WindowsVistaSP1
 2012_02_20_01.jpg

 まずは、不測の事態に備えて、旧HDDのクローンを、新HDDに作ります。
 2012_02_20_02.jpg

 中を見ると、ディスプレイが、何か幕を張ったような感じになっています、、、
 2012_02_20_03.jpg

 キーボードも、なかなかすごい汚れです(ダジャレじゃありません)
 2012_02_20_04.jpg

 まずは、分解します。パネルを外すと、意外にもホコリは少なかったです。
 2012_02_20_05.jpg

 このタイプは、とても分解しやすいです。自社サポート用によく考えてあるんでしょうね。
 (ここまで開けるのに、10分と掛かりません。)
 問題のFanが見えました!(書いていませんでしたが、異音の原因がFanというのは確認済です)
 2012_02_20_06.jpg

 このFanは、エアースプレーで回すと、カラカラと元気な音を立てています。
 まずは、だいぶ汚れていたので、ホコリをきれいにお掃除します。
 (頑固な汚れは、魔法のお薬できれいにしてあげます。)
 そのあと、軸部分にグリースを注入します。すると、、、
 「サァー」と、いい響きに生まれ変わりました♪
 
 表側はこんな感じです。(写真はホコリを取った後です。)
 2012_02_20_08.jpg

 裏側はこんな感じです。(写真はホコリを取った後です。)
 2012_02_20_07.jpg

 中はこんな感じです。(写真はホコリを取った後です。)
 2012_02_20_09.jpg

 あとは、処理速度の低下です。ディスク使用量を見ると、残り2GB!!
 随分使いっぱなしだったんでしょうね。
 お客様から「リカバリして!」とのことなので、リカバリします。
 この辺は省略しますが、やったことは大体こんな感じです。
 ・パーティションサイズの変更(Cドライブ拡大)
 ・OSのリカバリ
 ・ServicePack1とServicePack2の適用
 ・WindowsUpdateの適用

 、、、と本当はここまでなのですが、おまけで下記の設定も、お客様宅にて行わせて頂きました。
 ・インターネット接続設定
 ・メールの設定&データ復旧
 ・プリンタドライバのインストール&設定

 さらに格安サービス(ほとんどおまけです、、、)
 ・ソフトのインストール3本

 ちなみに、パソコンは、ご返却前にピカピカにしておきました。
 FANのメンテより、こちらの方が時間が掛かりました(-_-;) 
 2012_02_20_10.jpg

【作業期間:1日、お会計:¥8,480】
 ・初期診断:無料
 ・パソコンサポート基本料金:¥980
 ・FAN修理:¥2,000
 ・OSリカバリ:¥3,000
 ・パーティション変更:¥1,000
 ・その他もろもろ:¥1,500
 となります。

ご利用ありがとうございました!

最後に
 「パソコンのメンテナンスはどうしたらいいのと?」とよく聞かれます。
 パソコンを長く使うためには、普段の手入れが一番ですが、その中でもホコリは一番の大敵です。
 エラースプレーなどでこまめに掃除してあげましょう!
 でもくれぐれも、中に向かって吹かないようにしてください。逆にホコリを吸い込んじゃいますから。
 不安な方は、いつでもご連絡下さい。

 ちなみに弊社では、お預かりしたパソコンをきれいにしてご返却しています。
 (もちらん無料サービスです。頼まれなくてもやっちゃいます。)
 これは、お客様に、「おっ、自分のパソコンはまだまだ使えるじゃん♪」と思ってほしいからです。
 パソコンは上手に使えば、パソコンは3年~5年位は使えますから(-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン修理・サポート
ジャンル : コンピュータ

第2回 Windows7/64bit+仮想マシン(VirtualPC)+Ubuntu11.10

前回の続きです。


起動時オプションの変更が必要!

起動時に、「F6」を連打し、メニューが出たら[ESC」を押します。
すると、下の方に起動時オプションが表示されるので、末尾を次のように書き換えます。

2012_02_17_15.jpg
変更前:"quiet splash --"

2012_02_17_16.jpg
変更後:"vga=791 noreplace-paravirt"

017-2
すると、起動します!
これは、解像度の問題らしいです。でもこれで終わりではありません!
このあと、インストールし、設定を保存しないと、また元の木阿弥、、、


いよいよ、お待ちかね、Ubuntu11.10のインストール!

017-2
まずは、デスクトップ「Ubuntu 11.10のインストール」をクリック!

2012_02_17_20.jpg
言語は、「日本語」のまま ⇒ 続ける

2012_02_17_21.jpg
インターネット接続環境なら、次のオプションもチェック(どちらでも構いません)します ⇒ 続ける
インストール中にアップデートをインストールする
サードパーティーのソフトウェアをインストールする

2012_02_17_22.jpg
仮想マシンにインストールするので、「ディスクを削除してUbuntuをインストール」をのまま ⇒ 続ける
※.すでにインストール済のディスクを使用した場合、ここで、「Windows〇〇がインストールされていますが」的な警告メッセージも出ます。

2012_02_17_23.jpg
ここまで来たら「インストール」 ⇒ 続ける

2012_02_17_24.jpg
もう1回「インストール」 ⇒ 続ける

2012_02_17_25.jpg
地域を選びます ⇒ 続ける

2012_02_17_26.jpg
キーボードレイアウトは、自分に合った環境で ⇒ 続ける

2012_02_17_27.jpg
次の項目を入力する ⇒ 続ける
・「あなたの名前
・「コンピュータの名前
・「ユーザ名」⇒ ログインするときの名前
・「パスワード」 ⇒ ログインするときのパスワード(忘れないで!)

2012_02_17_28.jpg
ここから、インストールが始まります。この設定で、大体30~40分位でした。

再起動しないで!!

2012_02_17_29.jpg
ようやくインストールが完了です!
でもここは、再起動せず、「使用を続ける」で続けます。
先に話した設定を保存するためです。



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

続きを読む

テーマ : パソコン
ジャンル : コンピュータ

第1回 Windows7/64bit+仮想マシン(VirtualPC)+Ubuntu11.10

今回は、タイトル通り、「Windows7/64bit + 仮想マシン(VirtualPC) + Ubuntu11.10」です。

2012_02_17_14.jpg

こんなのです↑


Ubuntu11.10のCDを作って、USB起動も作ったら、なぜかUSBは失敗、、、
また母艦をUbuntuで占領されるのは嫌なので、VirtualPCに作ってしまえば!
というわけで、やってみたものの、なぜか失敗、、、
ようやく解決したので、備忘録として残しておきます。

ちなみに仮想マシンについては、こちらを見て下さい。
Ubuntuについては、こちらを見て下さい。
要は、フリーOS「Ubuntu」をCDやUSBメモリに入れておいて、いざという時に備えよう!
という試みです。


1.Ubuntu11.10のCDを作る!

Ubuntu11.10のisoイメージを、こちらからダウンロードして、CDに適当に焼いて下さい。


2.VirtualPCをインストールする!

~割愛~
はい!出来ました!

3.VirtualPC環境を作る!

ここも、ちょー簡単です。
最初に、ベースとなる仮想PCを作ります。

001.jpg
仮想マシンの作成」をクリックする。

002.jpg
仮想マシンを作成する「名前」と「場所」を指定します。⇒次へ
(何でも構いません。)

003.jpg
当然「はい」です。

004.jpg
メモリ」を指定します。⇒次へ
(物理メモリを食いますので、無理のない範囲で指定しましょう!)

005.jpg
容量可変の拡張ハードディスク」の名前と場所を指定します。⇒作成
(既にある方は、既存の仮想ハードディスクでも構いません。)

006.jpg
出来ました!⇒右クリックで設定を開く

007.jpg
先に準備したUbuntuのisoイメージ、あるいはCDの場所を指定しておきます。
(これが無いと始まらない、、、)

008-2.jpg
ネットワークアダプターは、「共有ネットワーク(NAT)」と物理ネットワークの2つを指定すれば十分かと思います。私の場合、無線なので、「Broadcom…」を選びました。
これで、準備は完了です!


4.いよいよUbuntu11.10のインストール開始!

009.jpg
まずは普通に、仮想マシンをダブルクリックして起動します。

010.jpg
メニューが表示されたら、「インストールせずにUbuntuを試してみる」のままで「Enter」

011.jpg
すると、起動が始まります、、、が!

012.jpg
緑色の画面になって、落ちます。
何べんやっても落ちます。
最初の一回だけデスクトップが表示されたのは、幻だったかと思えるくらいに失敗します。

012-2.jpg
とりあえず、タスクマネージャ~、プロセス「VPC.exe」を終了します。

長くなったので、続きは次回へ、、、
(-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン
ジャンル : コンピュータ

パスワードの付け方について

今回は、パスワードの付け方についてです。

パスワードの付け方の基本

一般的に言われている条件は、

・半角英数字と記号を混ぜて、16文字以上
 ⇒ 8文字以下だと、簡単に解析できますので。

・他人が推測しにくいこと
 ⇒ 名前や生年月日、ユーザ名と同じものは使わない。

・定期的に変える事
 ⇒ 情報漏えいや業務担当者の変更など、万が一に備えて。


でもこれで本当に大丈夫!?

大丈夫ではありません。どんなに複雑なパスワードを設定しようとも、
パスワードを見破る方法は、ツールによる解析以外にもあります。
それは、、、ズバリ目視です。(イヤン♪)

意外かもしれませんが、毎日同じ席で、隣の席の同僚が、同じ様に打ち込んでいたら、
嫌でもわかりますよね。
現実に、オフィスの向かいのビルから、盗み見るハッカーも実在するそうです。
ですので、大事なのは、判り難いパスワードを設定するとともに、
パスワードを打ち込んでいるところを、見られないように工夫することも大切です。

また、いくら複雑なパスワードでも、自分がチンタラ打ち込まなければいけないようなパスワードも論外です。それじゃぁ、見て覚えてくれと言っているようなものです。


じゃぁ、どんなパスワードがいいか?

半角英数字を混ぜつつ、2~3秒で打ち込め、なおかつ複雑で、自分には覚えやすいパスワードが良いと思います。

・推測されにくい
・他人には覚えにくい
・自分では覚えやすい&変えやすい


でも考えるのがめんどくさい!?

例えば文章がいいと思います。

「好きなお店は100均です!」⇒「sukinaomiseha100kindesu!

如何でしょうか?


最後に

パスワードに対して、無頓着な人が多い気がします。
自分が入力するときもそうですが、他人が入力しているときは、
顔をそらすなどの配慮があると、お互い気持ちよく仕事ができると思います。
これも、ネチケットになるカナ!?
(-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン
ジャンル : コンピュータ

画面ロックの方法と重要性

今回は、画面ロックについてです。

画面ロックって何?

一言で言えば、自分が席を離れているとき、他人にパソコンを操作されない様に、
パスワードロックを掛けることです。
2012_02_11_02.png



どんなメリットがあるの?

ズバリ!セキュリティ対策です。
自分のパソコンの中の情報流出を防ぐのはもちろん、データの改ざんを防いだり、
悪意のあるソフトウェアを仕組まれないためにも、非常に有効な手段のひとつです。
(あと、こっそり見ていた〇〇なファイルを、うっかりした隙に、大切な人に見られない様、エチケットを守るためにも役立ちます(-_-;))


難しくない?

とても簡単です。やり方は2つあります。
一つ目は、席を離れるとき、"Windows + L" キーを押す。
二つ目は、スクリーンセーバを有効にする。


具体的にどうやるの?

一つ目は、、、いいですよね(~_~;)
二つ目は、
 1.画面のプロパティを出します。
   出し方はOSのバージョンで若干異なりますが、Windows7の場合、
   コントロールパネルの個人設定の中にあるスクリーンセーバーをクリックします。
 2.下図のように、設定します。
   「待ち時間」:5分(スクリーンセーバーになるまでの時間です。)
   「再開時にログオン画面に戻る」:チェックを入れる。
   2012_02_11_01.jpg

以上で設定は終わりです。

あとは、何もせず5分待つか、"Windows + L" キーを押してみましょう!
下図のようなログオン画面が出れば成功です!
2012_02_11_02.png
<ようこそ画面を使っている場合>

2012_02_11_03.jpg
<ようこそ画面を使っていない場合>

これでもう、デスクトップを再開するには、パスワードを入れるしかありません。
(えっ!?パスワードすら設定していない!?、、、して下さいね)


最後に

なぜ今更こんなことを書いたかというと、知っていても意外と使っている人が少ないからです。
セキュリティ対策をきちんとしている会社であれば、Active Directory のポリシーなどで設定していますが、個人任せの会社が多いのも事実です。
ご家庭では、やっていない人が大多数です。(あくまで自分の経験です。)

なぜか!?

必要性を感じないからだと思います。(知らないだけかもしれませんが、、、)
「俺のパソコン、大したデータ入っていないから大丈夫~♪」
いえいえ、本人が考えている重要な情報と、悪意のある人が考えている重要な情報は、
必ずしも一致しません。

大切なのは、「見せない、出さない、触らせない」という考え方だと思います。

注意一秒、けが一生、、ぜひ一度だけでいいので、設定して下さいね♪
(-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン
ジャンル : コンピュータ

第2回:再起動を繰り返すPC復旧

さて、本日ご紹介する内容は、とある企業様から、、

【ご依頼内容】
 パソコンは起動するが、拡張オプションメニュー画面が開き、
 セーフモード等のどれを選択しても、Windowsロゴ表示後に勝手に再起動してしまう。
 データだけでも救出して欲しい。

【お仕事内容】
 まずは、不測の事態に備えて、旧HDDのクローンを、新HDDに作ります

 次に、再起動を繰り返すということで、早速確認、、、
2012_02_08_01.jpg
2012_02_08_02.jpg

 一瞬、ブルースクリーンになるが、すぐに再起動。
 ならばと、動画でキャプチャを撮ったところ、"UNMOUNTABLE_BOOT_VOLUME"の文字が、、、
 2012_02_08_03.jpg

 明らかにHDDの故障です。
 続いて、エラーチェックを行なうと、やっぱり出ました。
 2012_02_08_05.jpg

 エラー内容は、"S・M・A・R・Tエラー"です。
 2012_02_08_06.jpg

 別のツールでも確認&修復(できれば)
 ちなみに、HDDのエラーは、6割近くが磁性エラーらしい。
 なので、Windows標準機能では回復できないこのツールで、
 エラーも回復してくれることをお祈りしつつ、
 待つこと約3時間、、、(*´ρ`*) (ウソです。ちゃんと別の仕事をしています) 
 、、、結果、不良セクタの回復ならずです。
 念のため、起動テストしますが、状況は変わりません。(あたりまえですが)
 2012_02_08_08.jpg

 ちなみに、念のため、メモリーもテストしておきます。
 待つこと約2.5時間、、、(*´ρ`*) (ウソです。ちゃんと別の仕事をしています)
 こちらは、特に問題ありません
 2012_02_08_07.jpg

 というわけで、次に、旧HDDを魔法のツールに掛けます。(こちらは企業秘密♪)
 待つこと約?時間、、、(*´ρ`*) (本当です。もう夜中なので寝てました)
 見事、起動できるようになりました!
 (出来なければ、OSリカバリになりますが、今回はリカバリメディアもリカバリ領域も
  なかったので、良かったです)
 2012_02_08_02.jpg
 
 ここまで来れば、ゴールは目前、、、
 再度、旧HDDのクローンを、新HDDに作り、PCにセットします。
 当然、起動しますが、作業はまだ終わりません。
 念のため、12時間連続稼働テストを行ない、問題が無いことを確認します。
 最後に、旧HDDのデータをすべて、新HDDの空領域にコピーして完了です。

【作業期間:1日、お会計:¥16,440】
 ・初期診断:無料
 ・旧HDDより復旧:¥3,980
 ・HDD交換:¥1,980
 ・データ復旧:¥1,980
 ・部品代:HDD:¥8,500
 となります。

ご利用ありがとうございました!

最後に
 Windowsが起動しない、すぐにシャットダウンしてしまうなど、HDDエラーが疑われる場合、
 無理に何度も電源を入れると、データ復旧が困難になります。
 そんな時は、すぐにご連絡下さい。
 早ければ早いほど、データ復旧率が上がりますので (-。-)y-゜゜゜



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン修理・サポート
ジャンル : コンピュータ

旧ホームページ(tyuta's room)合併完了

ようやく旧ホームページ(tyuta's room)の主だったコンテンツのお引越し完了!ヾ(@⌒▽⌒@)ノ
(あまり多くは無かったのですが、、、)

それでも、あちらを整理したときは、長年使っていた場所なので、
ちょっぴりさみしい気もします。でも、

心機一転、頑張っていきます

ので、今後もどうぞよろしくお願いいたします。


なお、旧ホームページでのみ公開していたソフトやサンプルソースなどは、
移行できませんでした。
もし必要という方は、こちら(info@system-aoi.com)までご連絡下さい。



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : ホームページ・ブログ制作
ジャンル : コンピュータ

メール送信(Windows標準のCDOオブジェクトを利用)について

メール送信(Windows標準のCDOオブジェクトを利用)

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが,より使い易くなりますが,あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも,Excel(VBA)やWSH(VBScript)でも使用できます。

下記の説明でうまくいかない場合は、サンプルをお試しください。
⇒ って、これもブログにサンプルを移植できませんでした。m(__)m

#Region "■■■ 定数宣言 ■■■"

  '--------------------------------------------------
  ' CDO関連の定数
  '--------------------------------------------------

  Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
  Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
  Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
  Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
  Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
  Private Const cdoSendUsingPort = 2
  Private Const cdoAnonymous = 0
  Private Const cdoBasic = 1
  Private Const cdoNTLM = 2
  Private Const cdoShift_JIS = "shift-jis"
  Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
  Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"

#End Region


#Region "■■■ 変数宣言 ■■■"

  '--------------------------------------------------
  ' Mail関連
  '--------------------------------------------------

  Public Structure objMail
    Public objFrom As String       '差出人
    Public objSMTPServer As String    'SMTPサーバ
    Public objSMTP_FLG As Boolean    'SMTPサーバ認証
    Public objUserName As String     'SMTPサーバ認証:ユーザ名
    Public objPassWord As String     'SMTPサーバ認証:パスワード
    Public objTo As String        '宛先(複数指定はセミコロン(;)区切りで指定可)
    Public objCC As String        'CC(複数指定はセミコロン(;)区切りで指定可)
    Public objBCC As String       'BCC(複数指定はセミコロン(;)区切りで指定可)
    Public objSubject As String     '件名
    Public objBody As String       '本文
    Public objAttachment() As String   '添付ファイル
  End Structure

#End Region


#Region "■■■ 関数 ■■■"
  '==============================================================================
  '
  ' メール送信
  '
  ' ------------------------------------------------------------------------
  ' 説明 : メールオブジェクトの内容にしたがってメールを送信する
  '
  ' ------------------------------------------------------------------------
  ' 引数 : objMailSet     メールオブジェクトセット
  '    strErrMsg      エラーメッセージ
  ' 戻値 : True:成功、False:失敗
  '
  '==============================================================================

  Public Function fncMailSend(ByVal objMailSet As objMail, _
                Optional ByRef strErrMsg As String = "") As Boolean

    Dim oMsg As Object
    Dim intCnt As Integer

    Try

      '--------------------------------------------------
      ' メール送信
      '--------------------------------------------------

      'CDOオブジェクト作成
      oMsg = CreateObject("CDO.Message")

      'CDOオブジェクト設定&送信
      With oMsg
        '差出人
        .From = objMailSet.objFrom

        '宛先,件名,本文設定
        .To = objMailSet.objTo
        .CC = objMailSet.objCC
        .BCC = objMailSet.objBCC
        .Subject = objMailSet.objSubject
        .TextBody = objMailSet.objBody

        '添付ファイル設定
        For intCnt = 0 To objMailSet.objAttachment.GetUpperBound(0)
          If objMailSet.objAttachment(intCnt).ToString <> "" Then
            .AddAttachment(objMailSet.objAttachment(intCnt).ToString)
          End If
        Next

        'SMTPサーバ設定
        If objMailSet.objSMTPServer <> "" Then
          With .Configuration.Fields

            'SMTPサーバ
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = objMailSet.objSMTPServer
            .Item(cdoSMTPServerPort) = 25

            'SMTP認証
            If objMailSet.objSMTP_FLG Then
              .Item(cdoSMTPAuthenticate) = cdoAnonymous
              .Item(cdoSendUserName) = objMailSet.objUserName
              .Item(cdoSendPassword) = objMailSet.objPassWord
            End If

            '設定更新
            .Update()
          End With
        End If

        'メール送信
        .Send()

      End With

      'CDOオブジェクト解放
      oMsg = Nothing


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return True

    Catch ex As Exception

      '--------------------------------------------------
      ' エラーメッセージ設定
      '--------------------------------------------------

      strErrMsg = "メール送信中にエラーが発生しました。" & vbCrLf & _
            "ネットワーク管理者(プロバイダ)にお問い合わせください。" & vbCrLf & _
            "詳細は以下のとおり" & vbCrLf & _
            ex.Message


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return False

    End Try

  End Function
#End Region



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

ファイル圧縮(コマンドプロンプト実行)について

ファイル圧縮(コマンドプロンプト実行)

指定したファイルを圧縮(Windows標準のCAB形式)します。
実際には、fncProcRunという関数がプロセスを実行しています。
(この関数については、プロセス実行(アプリケーションの実行)を参照して下さい。)

Windows標準のCab形式で圧縮するため、特にアーカイバなど外部DLLなどは不要でできるので、フリーソフトを利用できない環境(サーバとか)でもファイル圧縮が可能です。ただ、あまり高級な設定はできませんが、、、
またこのやり方は、コマンドプロンプトを実行しているので、コマンド作成部分を引数にすれば、圧縮("MakeCab"コマンド)に限らず、様々なコマンドを実行したい場合に利用できます。

'==============================================================================
'
' ファイル圧縮
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを圧縮(CAB形式)する
'
' ------------------------------------------------------------------------
' 引数 : strSourceFile   圧縮元ファイル名(フルパス)
'    strCabFile    圧縮先ファイル名(フルパス)
'    blnCreateNoWindow ウィンドウ表示
'    strErrMsg     エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncCabMake(ByVal strSourceFile As String, ByVal strSourceFile As String, _
                ByVal blnCreateNoWindow As Boolean, ByRef strErrMsg As String) As Boolean
  Dim strMakeCabCmd As String
  Dim intRet As Integer
  Dim strRet As String = ""
  Dim strOldCabPath As String = ""
  Dim strNewCabPath As String = ""

  Try

    '--------------------------------------------------
    ' コマンド作成
    '--------------------------------------------------

    strMakeCabCmd = "makecab """ & strSourceFile & """ """ & strCabFile & """"


    '--------------------------------------------------
    ' コマンド実行
    '--------------------------------------------------

    'コマンド実行
    intRet = fncProcRun(System.Environment.GetEnvironmentVariable("ComSpec"), _
         "/c " & strMakeCabCmd, blnCreateNoWindow, _
         True, "", "", "", strErrMsg)


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    If intRet = 0 Then
      '正常終了
      Return True

    Else
      'エラーメッセージ設定
      strErrMsg = "ファイルの圧縮処理に失敗しました。" & vbCrLf & _
            "ファイル:" & strSourceFile & _
            "詳細は以下のとおり" & vbCrLf & _
            "--------------------------------------------------" & vbCrLf & _
            strErrMsg

       '異常終了
       Return False
    End If

  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ設定
    '--------------------------------------------------

    strErrMsg = "ファイルの圧縮中にエラーが発生しました。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "--------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

プロセス削除について

プロセス削除

指定したプロセスを削除します。
このやり方は、プロセス名をキーに、該当するプロセスを削除します。
同じプロセス名が複数存在する場合、すべて削除します。

なお、プロセス名やその他詳細は、"System.Diagnostics.Process.GetProcesses()"で取得できます。やり方は、Sampleを見てくださいね。
⇒って、サンプルはブログに移植できませんでした。m(__)m

'==============================================================================
'
' プロセス削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したプロセスを削除する
'
' ------------------------------------------------------------------------
' 引数 : strProcessName   プロセス名
'    strErrMsg      エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncProcRun(ByVal strProcessName As String, _
                Optional ByRef strErrMsg As String = "") As Boolean
  Dim proKillProcess As System.Diagnostics.Process = Nothing
  Dim proSerchProcess() As Process = Nothing
  Dim proFindProcess As Process = Nothing


  Try

    '--------------------------------------------------
    ' 対象プロセスをセット
    '--------------------------------------------------

    proSerchProcess = System.Diagnostics.Process.GetProcessesByName(strProcessName)


    '--------------------------------------------------
    ' 対象プロセスを削除
    '--------------------------------------------------

    '対象プロセスのプロセスを検索
    For Each proFindProcess In proSerchProcess
      '対象プロセスのプロセスIDを取得
      proKillProcess = System.Diagnostics.Process.GetProcessById(proFindProcess.Id)

      '対象プロセスを強制終了
      proKillProcess.Kill()
      proKillProcess.Dispose()
    Next


    '--------------------------------------------------
    ' プロセス解放
    '--------------------------------------------------

    proSerchProcess = Nothing
    proFindProcess = Nothing


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True

  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ設定
    '--------------------------------------------------

    strErrMsg = "プロセス削除中にエラーが発生しました。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "--------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

プロセス実行(アプリケーションの実行)について

プロセス実行(アプリケーションの実行)

指定したプログラムを実行します。
プログラムの引数やウィンドウ表示(コマンドプロンプトは効きますが、アプリケーションがサポートしていなければ効きません。まぁ、オマケです。)、キャンセルの受付なども指定できます。
このやり方は、いろいろありこれが正しいとは思いませんが、引数の組み合わせでなかなかうまくいかず、私の要望に合うやり方が以下のやり方でした。まだまだ、改良の余地があるような、、、いや、絶対ある!

ちなみに、変数宣言とプロパティは、キャンセル処理受付用です。キャンセル処理を行なわないのであれば、不要です。また、サンプルでは、処理経過時間の取得や、プロセスの出力取得(コメントしてありますが)も追加してあります。

#Region "■■■ 変数宣言 ■■■"

  '--------------------------------------------------
  ' プロセス関連
  '--------------------------------------------------

  Private mblnProcCancel As Boolean = False

#End Region


#Region "■■■ プロパティ ■■■"

  '==============================================================================
  '
  ' プロセスキャンセル
  '
  '==============================================================================

  Public Property ProcCancel() As Boolean
    Get
      Return mblnProcCancel
    End Get
    Set(ByVal value As Boolean)
      mblnProcCancel = value
    End Set
  End Property

#End Region


#Region "■■■ 関数 ■■■"
  '==============================================================================
  '
  ' プロセス実行
  '
  ' ------------------------------------------------------------------------
  ' 説明 : プロセスを実行する
  '
  ' ------------------------------------------------------------------------
  ' 引数 : strCMD       実行プログラム
  '    strPara       引数
  '    blnCreateNoWindow  ウィンドウ表示
  '    blnCancel      キャンセル処理受付
  '    strErrMsg      エラーメッセージ
  ' 戻値 : プロセス終了コード
  '
  '==============================================================================

  Public Function fncProcRun(ByVal strCMD As String, ByVal strPara As String, _
                ByVal blnCreateNoWindow As Boolean, ByVal blnCancel As Boolean, _
                Optional ByRef strErrMsg As String = "") As Integer

    Dim proMainProcess As System.Diagnostics.Process = Nothing
    Dim proMainProcessInfo As New System.Diagnostics.ProcessStartInfo
    Dim intExitCode As Integer
    Dim proKillProcess As System.Diagnostics.Process = Nothing

    Try

      '--------------------------------------------------
      ' プロセス準備
      '--------------------------------------------------

       With proMainProcessInfo
         .FileName = strCMD
         .Arguments = strPara
         .UseShellExecute = False
         .CreateNoWindow = Not blnCreateNoWindow 'ウィンドウ表示
      End With


      '--------------------------------------------------
      ' プロセス監視
      '--------------------------------------------------

      If Not blnCancel Then
        'プロセス終了まで待機
        proMainProcess.WaitForExit()
      Else
        'プロセスキャンセルフラグ:Trueまで処理する。
        Do Until Me.ProcCancel

          'DoEvent(キャンセル処理を受け付ける)
          Application.DoEvents()

          'プロセスが終了したら、プロセスフラグ:True
          If proMainProcess.HasExited Then
            Exit Do
          End If
        Loop

        'プロセスが終了しているかチェック(キャンセルした場合、終了していないので強制終了する)
        If Not proMainProcess.HasExited Then
          '強制終了
          proMainProcess.Kill()
          proMainProcess.Dispose()
        End If
      End If

      'プロセス終了取得
      intExitCode = proMainProcess.ExitCode

      'プロセス解放
      proMainProcess.Close()
      proMainProcess.Dispose()

      '終了
      Return intExitCode

    Catch ex As Exception

      '--------------------------------------------------
      ' エラーメッセージ設定
      '--------------------------------------------------

      strErrMsg = "プログラムの実行に失敗しました。" & vbCrLf & _
            "詳細は以下のとおり" & vbCrLf & _
            "--------------------------------------------------" & vbCrLf & _
            "実行プログラム:" & strCMD & vbCrLf & _
            "引数:" & strPara & vbCrLf & _
            ex.Message


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return 9

    End Try

  End Function
#End Region



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

数値型チェックについて

数値型チェック

指定した値が、範囲内の数値かチェックします。
ついでに半角チェックもします。このとき、sjisエンコードしてバイトチェックします。
このあたり、VBより楽になった気がします。
ただ、最小・大値のチェックについては、改良の余地があるような、、、

'==============================================================================
'
' 数値型チェック
'
' ------------------------------------------------------------------------
' 説明 : 指定した値が、範囲内の数値かチェックする
'
' ------------------------------------------------------------------------
' 引数 : strNum     チェックする値
'     dblMinValue   最小値
'     dblMaxValue   最大値
'     strErrMsg    エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncNumChk(ByVal strNum As String, ByVal dblMinValue As Double, _
ByVal dblMaxValue As Double, Optional ByRef strErrMsg As String = "") As Boolean
  Dim sjisEnc As System.Text.Encoding = System.Text.Encoding.GetEncoding("Shift_JIS") 'Shift_JISエンコード用

  Try

    '--------------------------------------------------
    ' 数値型チェック
    '--------------------------------------------------

    '入力済チェック
    If strNum = "" Then
      strErrMsg = "数値が入力されていません。"
      Return False
    End If

    '全角・半角チェック
    If sjisEnc.GetByteCount(strNum) <> strNum.Length Then
      strErrMsg = "半角文字ではありません。"
      Return False
    End If

    '数値型チェック
    If Not IsNumeric(strNum) Then
      strErrMsg = "数値型ではありません。"
      Return False
    End If

    '範囲チェック
    If CDbl(strNum) < dblMinValue Or dblMaxValue < CDbl(strNum) Then
      strErrMsg = "範囲内ではありません。"
      Return False
    End If


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "数値型チェック中にエラーが発生しました。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

サブフォルダをすべて削除について

サブフォルダをすべて削除

指定したフォルダ内のサブフォルダをすべて削除します。
削除する検索パターン(*:任意の文字列、?:任意の一文字)も指定できます。

'==============================================================================
'
' サブフォルダをすべて削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダ内のサブフォルダをすべて削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
'     strPattern   検索パターン
'     strErrMsg   エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFoldersDelete(ByVal strFolderPath As String, Optional ByVal strPattern As String = "*", Optional ByRef strErrMsg As String = "") As Boolean
  Dim strFolders As String() = System.IO.Directory.GetDirectories(strFolderPath, strPattern, System.IO.SearchOption.AllDirectories)
  Dim intCnt As Integer

  Try

    '------------------------------------------
    ' サブフォルダをすべて削除
    '------------------------------------------

    For intCnt = 0 To strFolders.GetUpperBound(0)
      If System.IO.Directory.Exists(strFolders(intCnt)) Then
        System.IO.Directory.Delete(strFolders(intCnt))
      End If
    Next


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "フォルダを削除できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

フォルダ内のファイルをすべて削除について

フォルダ内のファイルをすべて削除

指定したフォルダ内のファイルをすべて削除します。
削除する拡張子も指定できます。

'==============================================================================
'
' フォルダ内のファイルをすべて削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダ内のファイルをすべて削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
'     strDelimiter 拡張子
'     strErrMsg  エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFilesDelete(ByVal strFolderPath As String, Optional ByVal strDelimiter As String = "*", Optional ByRef strErrMsg As String = "") As Boolean
  Dim strFiles As String() = System.IO.Directory.GetFiles(strFolderPath, strDelimiter,     System.IO.SearchOption.AllDirectories)
  Dim intCnt As Integer

  Try

    '------------------------------------------
    ' 指定したファイルをすべて削除
    '------------------------------------------

    For intCnt = 0 To strFiles.GetUpperBound(0)
      If System.IO.File.Exists(strFiles(intCnt)) Then
        System.IO.File.Delete(strFiles(intCnt))
      End If
    Next


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "ファイルを削除できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

フォルダ削除について

フォルダ削除

指定したフォルダを削除します。
ただし、削除するフォルダが空で無い場合、エラーになります。

'==============================================================================
'
' フォルダ削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダを削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
'     strErrMsg  エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFolderDelete(ByVal strFolderPath As String, Optional ByRef strErrMsg As String = "") As Boolean

  Try

    '------------------------------------------
    ' フォルダ削除
    '------------------------------------------

    If System.IO.Directory.Exists(strFolderPath) Then
      System.IO.Directory.Delete(strFolderPath)
    End If


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "フォルダを削除できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

第1回:プリンタ設定&パソコン教室(ワンポイント講座)

ブログに書きたいことは、毎日山のようにありますが、
なかなか更新できないです(-_-;)
まぁ、ブログ名の通りなので、更新は気ままにいきますが。

さて今日から、弊社のお仕事内容を少しずつご紹介していきたいと思います。
これを読んでいただいて、少しでも弊社の仕事の様子をわかってもらえたらと思います。

第1回目は、、、

【ご依頼内容】
 ノートPC(Toshiba)と、モバイルルータ(Docomoの「Xi(クロッシィ)」)を繋げたい。

【お仕事内容】
 今までも別の無線に繋いでいたという事だったので、設定すればサクッと終わると思いきや
 ネットワーク接続を見ても、どこにも「ワイヤレス ネットワーク接続」がありません!
 よくよく聞いてみると、今までは、別のモバイル用アダプタを使って接続していたようです。
 デバイスマネージャで確認してみると、確かにワイヤレスネットワークがありません!

 (下図は自分のPCの場合です。赤枠が無線LANが搭載されている場合です。)
 2012_02_04_1.jpg

 しかし、HPでハードウェア仕様を見ると、確かに無線LAN「IEEE802.11a/b/g/n準拠」が搭載と
 記載されています。そこで東芝サポートに電話したところ、「オプションです」と、、、
 つまり、無線LANが搭載されていない機種でした。

 では、無線子機を買足して繋げるか?どうかお聞きしたところ、あまり使わないPCなので不要と、、、
 (ちなみに、無線子機は、これがあれば、無線LANに接続できるようになります。
  価格は、安いもので \1,000~あります。)

 替わりにメインPCがプリンタを使えるようになればよいという事だったので、
 ご依頼内容をプリンタ設定に変更、こちらはサクッと無事に終わりました。

 もうひとつ、こちらはパソコン教室ワンポイント講座です。
 今回は、アメーバブログのことでした。
 最近始められたとのことで、リンクの貼り方や、ペタの付け方など、いろいろでした。

【という訳で】
 今回は、ご依頼内容が随分変更になりましたが、こういう時でも成功報酬なので、
 ・プリンタ設定:\1,980
 ・ワンポイント講座:\1,980
 となります。

ご利用ありがとうございました!


ところで!!
 お仕事内容とは関係ありませんが、今回のお客様は、なんと「占い師」の方でした!
 占い師名を、愛月日奈子さんと言います。
 何年も修行して、占い師になり、今では月の館」という著名な占い・鑑定・セラピーのプロ集団で
 ご活躍されている方で、得意は、四柱推命、タロット鑑定だそうです。

 私は、元来占いをあまり気にしない方ですが、この方なら悩んだ時に占ってもらおうと思える、
 しっかりした包容力のある方でした。
 皆さんも、人生に悩んだときは、占ってもらうのも、如何でしょうか!

 ※.予め、お客様に許可を頂いて掲載しています。


最後に

この仕事をしていると、色々な職業の方に出会います。
出張訪問の隠れた楽しみでもあるので、ついつい話が脱線することがよくあります。
気を付けねば、、、ゞ( ̄∇ ̄;)




【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコン修理・サポート
ジャンル : コンピュータ

ファイル削除について

ファイル削除

指定したファイルを削除します。


'==============================================================================
'
' ファイル削除
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを削除する。
'
' ------------------------------------------------------------------------
' 引数 : strFilePath ファイルのフルパス
'     strErrMsg  エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFileDelete(ByVal strFilePath As String, Optional ByRef strErrMsg As String = "") As Boolean

  Try

    '------------------------------------------
    ' ファイル削除
    '------------------------------------------

    If System.IO.File.Exists(strFilePath) Then
      System.IO.File.Delete(strFilePath)
    End If


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "ファイルを削除できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

フォルダ作成について

フォルダ作成

指定したパスに、新たにフォルダを作成します。


'==============================================================================
'
' フォルダ作成
'
' ------------------------------------------------------------------------
' 説明 : 指定したフォルダを作成する。
'
' ------------------------------------------------------------------------
' 引数 : strFolderPath フォルダのフルパス
'     strErrMsg  エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFolderCreate(ByVal strFolderPath As String, Optional ByRef strErrMsg As String = "") As Boolean

  Try

    '------------------------------------------
    ' フォルダ作成
    '------------------------------------------

    If Not System.IO.Directory.Exists(strFolderPath) Then
      System.IO.Directory.CreateDirectory(strFolderPath)
    End If


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "フォルダを作成できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

ファイル作成について

ファイル作成

指定した内容をファイルに出力します。
出力内容が比較的少ないログ出力などは、この関数一回で処理が済みます。
逆に、順次出力や追記、出力内容が大きい場合には向きません。あしからず。。。


Imports System.IO
Imports System.Text


'==============================================================================
'
' ファイル作成
'
' ------------------------------------------------------------------------
' 説明 : 指定したファイルを、指定した内容で作成する。
'
' ------------------------------------------------------------------------
' 引数 : strFilePath ファイルのフルパス
'     strText   ファイルの内容
'     strErrMsg  エラーメッセージ
' 戻値 : True:成功、False:失敗
'
'==============================================================================

Public Function fncFileCreate(ByVal strFilePath As String, ByVal strText As String, Optional ByRef strErrMsg As String = "") As Boolean

  Dim objStreamWriter As StreamWriter

  Try

    '------------------------------------------
    ' StreamWriter作成
    '------------------------------------------

    objStreamWriter = New StreamWriter(strFilePath, True, System.Text.Encoding.Default)


    '------------------------------------------
    ' 内容出力
    '------------------------------------------

    objStreamWriter.WriteLine(strText)


    '------------------------------------------
    ' StreamWriter終了
    '------------------------------------------

    objStreamWriter.Close()


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return True


  Catch ex As Exception

    '--------------------------------------------------
    ' エラーメッセージ作成
    '--------------------------------------------------

    strErrMsg = "ファイルを作成できませんでした。" & vbCrLf & _
          "詳細は以下のとおり" & vbCrLf & _
          "----------------------------------------------------------------------" & vbCrLf & _
          ex.Message


    '--------------------------------------------------
    ' 戻り値設定
    '--------------------------------------------------

    Return False

  End Try

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

ワード文書(*.doc)が開いているかチェックについて

ワード文書(*.doc)が開いているかチェック

ワード文書(*.doc)が開いているかのチェック方法についてです。

ワード文書(*.doc)などを扱う場合、プログラム終了時に他の文書が開いているか確認し、開いている文書が
無ければ、ワード自体を終了させる必要があります。これをしないと、ワード文書を閉じた後も、
ワード(winword.exe)というアプリケーションだけが起動したままになってしまいます。
このあたり、Excelなどでも一緒です。(ExcelとWord位しかやったことが無いのでわかりませんが。。。)

以下のサンプルコードは、同じインスタンス内でのみ開いている文書が無いか確認しています。
ただし、同じインスタンス内でのみ確認すれば問題ないと思います。
・Excelを起動して、同じ画面から他の文書を開いた場合、同じインスタンス内で複数の文書が開いている
 ことになります。
・Excelを起動している状態で、スタートメニューやプログラムから新たにワードを立ち上げ文書を開いた場合、
 別インスタンスで立ち上がります。
 (タスクマネージャで確認すると、winword.exeが複数起動していることが確認できます。)


'==============================================================================
'
'ワード文書が開いているかチェック関連
''
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書が開いているかチェック
'
'==============================================================================

  Dim wWD     As Word.Application
  Dim wDoc    As Word.Document
  Dim wWkDoc  As Word.Document
  Dim bOpenFlg As Boolean
  Dim iRet     As Integer
  Dim sFileName As String


  '---ワードオブジェクト作成
    Set wWD = CreateObject("Word.Application")
     wWD.Visible = True '←ワードが表示されない場合


  '---オープン
    Set wDoc = wWD.Documents.Open(App.Path & "\" & "サンプル.doc")


  '---他のワード文書の開いているかチェック
    bOpenFlg = False
    For Each wDoc In wWD.Documents
      sFileName = sFileName & wDoc.Name & vbCrLf
      bOpenFlg = True
    Next


  '---ワード終了(他のワード文書が開いていない場合)
     If Not bOpenFlg Then
      MsgBox "開いているワード文書が無いので、ワードを終了します。"
      wWD.Quit
    Else
      MsgBox "開いているワード文書があるので、ワードを終了しません。" & vbCrLf & _
            "------------------------------" & vbCrLf & _
            "ワード文書名:" & sFileName
    End If


  '---ワードオブジェクト開放
    Set wDoc = Nothing
    Set wDoc = Nothing
    Set wWD = Nothing



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

ワード文書(*.doc)の情報取得について

ワード文書(*.doc)の情報取得

ワード文書(*.doc)の中身を取得するには、単純にテキストを取得する以外にも、オブジェクト(シェイプとか)の
テキストや、表から取得する場合もあります。特に表から取得する場合、
特定の位置の情報(行・列番号を指定して)を取得したい場合もあります。
以下のサンプルコードは、テキストから取得、オブジェクトから取得、表から取得(行・列番号も併せて)の
3種類を載せています。また、VisualBasicでできるので、ExcelなどのVBAでも利用できます。
応用すれば、ワード文書(*.doc)の作成・保存なども可能です。


'==============================================================================
'
'ワード文書の情報取得関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書の作成
'
'==============================================================================

  Const msoTextBox = 1
  Dim wWD     As Word.Application
  Dim wDoc    As Word.Document
  Dim wTable   As Word.Table
  Dim wCell    As Word.Cell
  Dim wRange   As Word.Range
  Dim wShape   As Word.Shape
  Dim wPara    As Word.Paragraph
  Dim iNumCells  As Integer
  Dim iTabCount  As Integer
  Dim iTabAllCount As Integer
  Dim sOutput1   As String
  Dim sOutput2   As String
  Dim sOutput3   As String
  Dim bOpenFlg  As Boolean


  '---ワードオブジェクト作成
    Set wWD = CreateObject("Word.Application")


  '---ワード文書作成
    Set wDoc = wWD.Documents.Open("c:\ワード文書サンプル.doc")


  '---ワード文書の中身を取得
    'ワード情報取得
    For Each wPara In wDoc.Range.Paragraphs
      sOutput1 = sOutput1 & wPara.Range.Text & vbCrLf
    Next


  '---ワード文書の表の中身を取得
    '表数の取得
    iTabAllCount = wDoc.Tables.Count


  '---ワード情報取得
    sOutput2 = ""
    sOutput2 = sOutput2 & "テーブル番号" & vbTab & _
                  "行番号" & vbTab & _
                  "列番号" & vbTab & _
                  "内容" & vbCrLf & _
                  "--------------------------------------------------" & vbCrLf

    If iTabAllCount >= 1 Then
      For iTabCount = 1 To iTabAllCount
        '表を取得
        Set wTable = wDoc.Tables(iTabCount)

        'セル総数取得
        iNumCells = wTable.Range.Cells.Count

        For Each wCell In wTable.Range.Cells
          'セル取得
          Set wRange = wCell.Range

          'セル最後尾にカーソル移動
          wRange.MoveEnd Unit:=wdCharacter, Count:=-1

          'セル情報取得
          sOutput2 = sOutput2 & iTabCount & vbTab & vbTab & _
          wRange.Information(wdStartOfRangeRowNumber) & vbTab & _
          wRange.Information(wdStartOfRangeColumnNumber) & vbTab & _
          wRange.Text & vbCrLf
        Next

        sOutput = sOutput & "--------------------------------------------------" & vbCrLf
      Next
    End If


  '---ワード文書のオブジェクトの中身を取得
    sOutput3 = ""
    sOutput3 = sOutput3 & "オブジェクト名" & vbTab & _
                  "内容" & vbCrLf
    With wDoc
      'オブジェクトを一つずつ取得
      For Each wShape In .Shapes
        If wShape.Type = msoTextBox Then
          With wShape.TextFrame.TextRange
            For Each wPara In .Paragraphs
              sOutput3 = sOutput3 & wShape.Name & vbTab & _
              wPara.Range.Text & vbCrLf
            Next
          End With
        End If
      Next
    End With


   '---ワード情報出力
     MsgBox("ワード文書の中身" & vbCRLF & sOutput1)
     MsgBox("ワード文書の表の中身" & vbCRLF & sOutput2)
     MsgBox("ワード文書のオブジェクトの中身" & vbCRLF & sOutput3)


  '---終了
    '他のワード文書の開いているかチェック
    bOpenFlg = False
    For Each wDoc In wWD.Documents
      bOpenFlg = True
    Next

    'ワード終了(他のワード文書が開いていない場合)
    '非表示
    wWD.Visible = True
    If Not bOpenFlg Then
      wWD.Quit
    End If


  '---メッセージ
    MsgBox "終了"


  '---ワードオブジェクト開放
    Set wDoc = Nothing
    Set wWD = Nothing



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

ワード文書(*.doc)の作成について

ワード文書(*.doc)の作成

ワード文書(*.doc)を作成する方法は、ワードオブジェクトの作成 ⇒ 保存、これが基本です。
このあたり、Excelなどでも一緒です。(ExcelとWord位しかやったことが無いのでわかりませんが。。。)
あとは、いかにして思うような文章などを挿入し、成型するかだけだと思います。
以下のサンプルコードは、ページ設定や文章の挿入、表の作成を載せています。
応用すれば、思い描いたとおりのワード文書(*.doc)が作成できます。(多分。。。)


'==============================================================================
'
'ワード文書の作成関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

'------------------------------------------------------------
' 事前に参照設定を行なってください。
' 【参照設定方法】
' [プロジェクト]-[参照設定]-[MicroSoft Word 11.0 Object Library]にチェックを入れる。
' (11.0はバージョンにより異なります。ex)11.0 ⇒ Word2003, 9.0 ⇒ Word2000))
'------------------------------------------------------------

''==============================================================================
'
' ワード文書の作成
'
'==============================================================================
  Dim wWD     As Word.Application
  Dim wDoc    As Word.Document
  Dim wTable   As Word.Table
  Dim wCell    As Word.Cell
  Dim wRange   As Word.Range
  Dim wShape   As Word.Shape
  Dim wPara    As Word.Paragraph
  Dim sInpuPath  As String
  Dim iCntI     As Integer
  Dim iCntJ    As Integer
  Dim bOpenFlg  As Boolean

   '---保存ファイル名取得
    sInpuPath = "c:\ワード文書サンプル.doc"


  '---ワードオブジェクト作成
    Set wWD = CreateObject("Word.Application")
    wWD.Visible = False


  '---ワード文書作成
    'オープン
    Set wDoc = wWD.Documents.Add

    With wDoc
      '---ページ設定(書式)
        With .PageSetup
          .LineNumbering.Active = False
          .Orientation = wdOrientPortrait
          .TopMargin = MillimetersToPoints(35)
          .BottomMargin = MillimetersToPoints(26)
          .LeftMargin = MillimetersToPoints(25)
          .RightMargin = MillimetersToPoints(15)
          .Gutter = MillimetersToPoints(0)
          .HeaderDistance = MillimetersToPoints(15)
          .FooterDistance = MillimetersToPoints(17.5)
          .PageWidth = MillimetersToPoints(210)
          .PageHeight = MillimetersToPoints(297)
          .FirstPageTray = wdPrinterDefaultBin
          .OtherPagesTray = wdPrinterDefaultBin
          .SectionStart = wdSectionNewPage
          .OddAndEvenPagesHeaderFooter = False
          .DifferentFirstPageHeaderFooter = False
          .VerticalAlignment = wdAlignVerticalTop
          .SuppressEndnotes = False
          .MirrorMargins = False
          .TwoPagesOnOne = False
          .GutterPos = wdGutterPosLeft
          .CharsLine = 40
          .LinesPage = 40
          .LayoutMode = wdLayoutModeGrid
        End With


      '---ページ設定(フォント)
        With wWD.Selection
          .Font.Name = "MS 明朝"
          .Font.Size = 11
        End With


      '---文書作成
        With wWD.Selection
          For iCntI = 1 To 10
            '文書挿入
            .TypeText Text:="テスト文書" & iCntI & vbCrLf

            '次行にカーソルを移動
            .MoveDown wdLine, Count:=1, Extend:=wdMove
          Next
        End With


        '次行にカーソルを移動
        wWD.Selection.MoveDown wdLine, Count:=1, Extend:=wdMove


      '---表作成
        Set wTable = .Tables.Add(Range:=wWD.Selection.Range, NumRows:=1, NumColumns:=4)

        '表の設定
        With wTable
          '表位置
          .Rows.LeftIndent = MillimetersToPoints(14.5)
          '列幅
          .Columns(1).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
          .Columns(2).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
          .Columns(3).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
          .Columns(4).SetWidth ColumnWidth:=MillimetersToPoints(35), RulerStyle:=wdAdjustNone
        End With

        '表への値挿入
        With wWD.Selection
          For iCntI = 1 To 10
            '行挿入
            If iCntI > 1 Then
              .InsertRowsBelow 1
            End If

           For iCntJ = 1 To 4
              '文書挿入
              .TypeText Text:="表文書(" & iCntI & ", " & iCntJ & ")"

              '右隣にカーソルを移動
              If iCntJ <> 4 Then
                .MoveRight wdCell, Count:=1, Extend:=wdMove
              End If
            Next

            '左端にカーソルを移動
            .MoveLeft wdCell, Count:=3, Extend:=wdMove
          Next
        End With

        '保存
        .SaveAs sInpuPath

        'クローズ
        .Close
    End With


  '---終了
    '他のワード文書の開いているかチェック
    bOpenFlg = False
    For Each wDoc In wWD.Documents
      bOpenFlg = True
    Next

    'ワード終了(他のワード文書が開いていない場合)
    '非表示
    wWD.Visible = True
    If Not bOpenFlg Then
      wWD.Quit
    End If


  '---メッセージ
    MsgBox "終了"


  '---ワードオブジェクト開放
    Set wDoc = Nothing
    Set wWD = Nothing



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

四捨五入・切上げ・切捨てについて

四捨五入・切上げ・切捨て

四捨五入については,よくさまざまな議論がされていますが,単純に
「4より小さければ切り捨て」,「5より大きければ切り上げ」したい場合,
標準のRound関数では実現できません。(銀行型四捨五入と言われている「最近接偶数丸め」だからかな?)
なので,自分で関数を作成する必要があります。
以下はその例です。ついでに切上げ・切り捨ても付けてみました。


'==============================================================================
'
' 四捨五入・切上げ・切捨て関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

''==============================================================================
'
' 四捨五入(切上げ, 切捨て)
'
'
' ------------------------------------------------------------------------
' 説明 : 四捨五入(切上げ, 切捨て)をする
'
' ------------------------------------------------------------------------
' 引数 : sValue 四捨五入(切上げ, 切捨て)をする値
'    : iMode 0:四捨五入, 1:切上げ, 2:切捨て
'    : iKeta 四捨五入(切上げ, 切捨て)をする位(第n位)
' 戻値 : Double 計算結果
'
'==============================================================================

Public Function fnc_Round_Value(sValue As Variant, iMode As Integer, iKeta As Integer) As Double
Dim dWkValue As Double

  '---戻り値初期化
    fnc_Round_Value = 0


  '---値チェック
    If Not IsNumeric(sValue) Then
      Exit Function
    End If


  '---計算
    Select Case iMode
      Case 0
        '四捨五入
        dWkValue = Int((sValue * (10 ^ (iKeta - 1)) + 0.5)) / (10 ^ (iKeta - 1))

      Case 1
        '切上げ
        dWkValue = Int((sValue * (10 ^ (iKeta - 1)) + 0.9)) / (10 ^ (iKeta - 1))

      Case 2
        '切捨て
        dWkValue = Int((sValue * (10 ^ (iKeta - 1)))) / (10 ^ (iKeta - 1))

    End Select


  '---戻り値設定
    fnc_Round_Value = dWkValue

End Function



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

マウスの座標について

マウスの座標

マウスの座標を取得する方法についてです。
マウスがフォームの外側,或いは透明フォーム等,MouseMoveイベントを利用出来ない場合に便利です。


'=======================================================================
'
' カーソル関連
'
'=======================================================================

'--------------------
' API宣言
'--------------------
  '---カーソルの現在のスクリーン座標の取得
    Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
  '---キーボードのキーが押されているかどうか調べる
    Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer

  '---定数宣言
    Public Type POINTAPI
      x As Long
      y As Long
    End Type




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<< カーソル位置取得 >>
    Dim pPoint      As POINTAPI

    '---カーソル位置取得
      Call GetCursorPos(pPoint)


    '---カーソル位置表示
      MsgBox "X座標:" & pPoint.x
      MsgBox "Y座標:" & pPoint.y


    '---マウス状態
      If GetAsyncKeyState(vbKeyRButton) < 0 Then
        MsgBox "マウスの右ボタンがクリックされてます。"
      End If
      If GetAsyncKeyState(vbKeyLButton) < 0 Then
        MsgBox "マウスの左ボタンがクリックされてます。"
      End If



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

スクリーンセーバーの実行について

スクリーンセーバーの実行

スクリーンセーバーを実行する方法についてです。


'=======================================================================
'
' スクリーンセーバー関連
'
'=======================================================================

'--------------------
' API宣言
'--------------------
  '---指定のウィンドウのメッセージキューにメッセージを送る
    Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, _
                    ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long


  '---定数宣言
    Public Const WM_SYSCOMMAND = &H112  'ポストするメッセージID(システムコマンドを指定)
    Public Const SC_SCREENSAVE = &HF140& 'スクリーンセーバー実行




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<<スクリーンセーバー実行 >>
     Dim lRet As Long

    '---スクリーンセーバーを実行するメッセージをポスト
      lRet = PostMessage(Me.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, ByVal CLng(0))



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

スクリーンセーバーについて

スクリーンセーバー

スクリーンセーバーの作成方法についてです。
スクリーンセーバーの作成方法は,単純です。
まず,作成した実行ファイル(*.exe)の拡張子を"scr"に変更します。
以上で終わりです。
利用方法は,このスクリーンセーバーのファイル(*.scr)をWindowsHome(※)の直下に配置します。
次に,画面のプロパティからスクリーンセーバータブで,先ほど配置したスクリーンセーバを選択します。
これで,作成したスクリーンセーバーが動きます。あら簡単!
作成する際のPointとして,マウス移動時に終了するなど,終了のトリガーを入れる事を忘れないように
して下さい。以下は,簡単な作成例です。
※.Windows2000の場合,C:\WinNT,WindowsXPの場合,C:\Windows


'==============================================================================
'
' スクリーンセーバー関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法
' FormにLabelとTimerコントロールを貼り付け,
' 以下のソースをコピペして下さい。
'---------------------------------------------------

  '---<< スクリーンセーバー >>
    Dim mbFastFlg As Boolean
    Dim msBeforeX As Single
    Dim msBeforeY As Single



      Private Sub Form_Load()

        '---初回フラグ:ON
          mbFastFlg = True

        '---Window最大化
          Form1.WindowState = 2

        '---タイマー開始
          Timer1.Interval = 1

      End Sub

      Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

        '---マウス移動判定
          If Not mbFastFlg Then
            If X <> msBeforeX Or Y <> msBeforeY Then
              Unload Me
            End If
          End If

        '---初回フラグ:OFF
          mbFastFlg = False

        '---マウス位置退避
          msBeforeX = X
          msBeforeY = Y

      End Sub

      Private Sub Timer1_Timer()

        '---タイマー
          If Label1.Caption <> Time Then
            Label1.Caption = Time
          End If

      End Sub



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

画像の縮小(サムネイル)について

画像の縮小(サムネイル)

画像のサムネイル作成方法についてです。
サムネイルの作成方法は,多数ありますが表示速度やメモリ使用量,解像度など考えなければいけない
要素があります。ここで紹介している方法では,元画像をいったんロードしている為,表示速度は
速くありませんが元画像をサムネイル作成後に破棄している分,サムネイルを同時に複数作成しても
メモリ使用量を抑えられます。
(サンプルでは,サムネイルは1つしか作成していません。)


'==============================================================================
'
' サムネイル関連
'
'==============================================================================




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<< サムネイル作成 >>
    Dim sFile As String
    Dim dHeight As Double
    Dim dWidth As Double
    Dim dNewHeight As Single
    Dim dNewWidth As Single

    Const iPicHeight = 3000
    Const iPicWidth = 3000

    On Error GoTo Err

    '---ファイル取得
      sFile = "c:\aaa\bbb\ccc\ddd.bmp"


    '---画像クリア
      Picture1.Cls


    '---幅と高さを調べるために、一旦 Picture オブジェクトに格納
      Picture2.Picture = LoadPicture(sFile)


    '---元画像の幅・高さ取得
      dHeight = Picture2.Picture.Height
      dWidth = Picture2.Picture.Width


    '---元画像の幅・高さがサムネイルの範囲を超える場合のみ縮小するサイズを取得
      If dHeight > 0 Or dWidth > 0 Then

        '元画像の幅・高さどちらかでもサムネイルの範囲を超えるかチェック
        If dHeight > iPicHeight Or dWidth > iPicWidth Then

          '元画像の幅・高さどちらかがサムネイルの範囲を超える場合
          If dHeight > dWidth Then

            '高さが幅より範囲を大きく超えている場合,高さの縮小率に併せて幅を縮小
            dNewHeight = iPicHeight
            dNewWidth = dWidth / dHeight * iPicHeight
          Else

            '幅が高さより範囲を大きく超えている場合,幅の縮小率に併せて高さを縮小
            dNewWidth = iPicWidth
            dNewHeight = dHeight / dWidth * iPicWidth
          End If

        Else

          '元画像の幅・高さどちらかがサムネイルの範囲を超えない場合
          dNewHeight = dHeight
          dNewWidth = dWidth
        End If
      End If


    '---サムネイルの大きさ変更
      Picture1.Height = dNewHeight
      Picture1.Width = dNewWidth
      DoEvents


    '---サムネイル作成
      Picture1.PaintPicture Picture2.Picture, 0, 0, dNewWidth / 0.567, dNewHeight / 0.567, _
                               0, 0, Picture2.Picture.Width, Picture2.Picture.Height


    '---元画像破棄
      Set Picture2 = Nothing


    '---終了
      Exit Sub

  Err:
    '---エラー処理
      sErrMsg = "エラーが発生しました。" & vbCrLf & _
             Err.Number & " " & Err.Description
      MsgBox sErrMsg, vbCritical, "サムネイルサンプル"
      Exit Sub



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

メールの送信(CDO)について

メールの送信(CDO)

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが,より使い易くなりますが,あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも,Excel(VBA)やWSH(VBScript)でも使用できます。

'==============================================================================
'
' メール送信関連
'
'==============================================================================
  '---定数宣言
'---CDO関連の定数
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Private Const cdoSendUsingPort = 2
Private Const cdoAnonymous = 0
Private Const cdoShift_JIS = "shift-jis"
Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<< フォーム透明化 >>
    Dim oMsg As Object
    Dim sSMTPServer As String
    Dim bSMTP_Flg As Boolean
    Dim sUserName As String
    Dim sPassWord As String
    Dim sFrom As String
    Dim sTO As String
    Dim sCC As String
    Dim sBCC As String
    Dim sSubject As String
    Dim sTextBody As String
    Dim vFile As Variant
    Dim sFile As String
    Dim iLoopCnt As Integer
    Dim sErrMsg As String

    On Error GoTo Err

    '---確認
      If MsgBox("メールを送信します。よろしいですか?", vbQuestion + vbYesNo, _
                                   "メール送信(CDO)サンプル") = vbNo Then
        Exit Sub
      End If


    '---メール送信情報取得
      sSMTPServer = "SMTP-Server@aaa.bbb.co.jp(or 999.999.999.999)" 'SMTPサーバ
      bSMTP_Flg = False      'SMTPサーバ:認証有無
      sUserName = "UserName" 'SMTPサーバ:認証用ユーザ名
      sPassWord = "PassWord"  'SMTPサーバ:認証用パスワード


    '---メール送信内容取得
      sFrom = "FromUser@aaa.bbb.co.jp"   '差出人
      sTO = "ToUser@aaa.bbb.co.jp"      '宛先
      sCC = "CCUser@aaa.bbb.co.jp"      'CC
      sBCC = "BCCUser@aaa.bbb.co.jp"    'BCC
      sSubject = "件名を入力して下さい。"  '件名
      sTextBody = "本文を入力して下さい。" '本文


    '---CDOオブジェクト作成
      Set oMsg = CreateObject("CDO.Message")


    '---CDOオブジェクト設定&送信
      With oMsg
        'メール送信情報設定
        If sSMTPServer <> "" Then
          With .Configuration.Fields
            'SMTPサーバ
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = sSMTPServer 'SMTPサーバ
            .Item(cdoSMTPServerPort) = 25

            ''SMTPサーバ:認証有無判定
            If bSMTP_Flg = True Then
              .Item(cdoSMTPAuthenticate) = cdoAnonymous
              .Item(cdoSendUserName) = sUserName 'SMTPサーバ:認証用ユーザ名
              .Item(cdoSendPassword) = sPassWord  'SMTPサーバ:認証用パスワード
            End If

            '設定更新
            .Update
          End With
        End If

        'メール送信内容設定
        .From = sFrom       '差出人
        .To = sTO          '宛先
        .cc = sCC          'CC
        .bcc = sBCC        'BCC
        .Subject = sSubject    '件名
        .TextBody = sTextBody '本文

        '添付ファイル
        .AddAttachment "C:\aaa\bbb\ccc\001.txt"
        .AddAttachment "C:\aaa\bbb\ccc\002.txt"
        .AddAttachment "C:\aaa\bbb\ccc\003.txt"

        'メール送信
        .Send

      End With


    '---CDOオブジェクト解放
      Set oMsg = Nothing

      MsgBox "メールを送信しました。", vbInformation, "メール送信(CDO)サンプル"

      Exit Sub

  Err:
    '---エラー処理
      sErrMsg = "エラーが発生しました。" & vbCrLf & _
      Err.Number & " " & Err.Description
      MsgBox sErrMsg, vbCritical, "メール送信(CDO)サンプル"
      Exit Sub



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

Windowの整列について

Windowの整列

MDIフォームのWindowの整列方法についてです。
簡単で載せるほどたいしたことはありませんが,便利なので載せました。


'=======================================================================
'
' Window関連
'
'=======================================================================

'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

   '---<< Window整列 >>
     'Index値
     '0:整列-重ねて表示
     '1:上下に並べて表示
     '2:左右に並べて表示
     MDIForm1.Arrange (Index)



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

最新コメント
プロフィール

ITLife

Author:ITLife
システム葵新井聡太です。
東京都東村山市に生まれ、ここで育ち、ここで結婚し、システムエンジニア一筋で十数年やってきました。
ここでは主に、パソコンを中心にITに関わることを備忘録として残していきたいと思います。
少しでも来ていただいた方のお役に立てたら幸いです。
m(_ _)m

p.s
ここで紹介している内容は一例です。すべては、自己責任でお願いします。

カレンダー
01 | 2012/02 | 03
- - - 1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 - - -
訪問数
月別アーカイブ
リンク