タグ:オススメ ( 97 ) タグの人気記事
[VBScript] デバッグ上手はプログラム上手6 ~まとめ改~
こんにチワワ。どーもボキです。

以下と組み合わせれば、実行時にホストを変更でき、デバッグが楽になる。
引数を引き継いだ上で、指定したホストで実行する

前回はデバッグクラスを自分で生成するようにしていたが、
今回の記事では、最初にdprintf()を実行したタイミングで自動生成するよう改良した。

配布時は、SetScriptHostのみコメントアウトすればよい。
デフォルトであるWScriptホストでは、デバッグメッセージが表示されないようにしているので。

プログラムとその実装例
SetScriptHost("CScript")
dprintf("デバッグモード")

' ↑上記にスクリプト本体を記載する
' ===============================================================================
' デバッグ
Dim objDbg
' クラス
Class TDebug
Dim FCScript

' 初期化処理
Private Sub Class_Initialize()
FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0
End Sub

' 終了処理
Private Sub Class_Terminate()
If Not FCScript Then Exit Sub

WScript.StdOut.WriteLine NOW & " [END]"
WScript.StdIn.ReadLine
End Sub

' CScriptホストかどうか
Public Property Get CScript
CScript = FCScript
End Property

' デバッグメッセージ処理
Public Sub dprintf(v)
Dim i,s,ityp
If Not FCScript Then Exit Sub

s = v
ityp = VarType(v)
If ityp = vbBoolean Then
s = CStr(v)
ElseIf VarType(v) >= vbArray Then
s = ""
For i = 0 to UBound(v)
s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF
Next
End If
WScript.Echo s
End Sub
End Class
' 関数
Sub dprintf(v)
If VarType(objDbg) = vbEmpty Then
Set objDbg = New TDebug
objDbg.dprintf(NOW & " " & WScript.ScriptFullName)
End If
objDbg.dprintf(v)
End Sub
' -------------------------------------------------------------------------------
' 実行ホストを切り替える
Sub SetScriptHost(HostName)
If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub

s = HostName & " """ & WScript.ScriptFullName & """"
If WScript.Arguments.Count > 0 Then
For i = 0 To WScript.Arguments.Count -1
s = s &" """ & WScript.Arguments.Item(i) & """" ' 引数
Next
End If
objWS.Run s
WScript.Quit
End Sub
' -------------------------------------------------------------------------------
[VBScript] デバッグ上手はプログラム上手5 ~まとめ~

[PR]
by yozda | 2014-08-24 14:48 | プログラミング | Trackback | Comments(0)
[VBScript] 管理者昇格してスクリプトを実行する
こんばんワイン。どーもボキです。

Win7以降(Vista以降?)、管理者でのログインといえど、
プログラムが管理者権限で実行されるわけではない。これはスクリプトも同じ。

管理者権限で実行するならば、右クリック > 管理者として実行する。
これをしなければ、スクリプトでレジストリの書き換えすら出来ない。

PBPには、ボタン押す以外は困難を極めるため、こういった高度な操作は期待できない。

なので、スクリプト内でOSを判定させ、Win7以降の場合は、
勝手に管理者に昇格して、スクリプトを実行しなおす仕組みを用意した。

なお、Win7以前は管理者ログインで実行されたプロセスは管理者権限で動作するため、
OSバージョンがWin7以前の場合は、何もしないようにしている。

実行部
' 管理者権限でVBSを実行する
If ExecRunas Then WScript.Quit

' ~管理者権限で実行したいソース~


実装部
'--------------------------------------------------------------------------------------------------------
'OSのバージョンを取得する
Const osWinNT = 4.0
Const osWin2k = 5.0
Const osWinXP = 5.1
Const osWin7 = 6.1
Const osWin8 = 6.2
Function GetOSVersion
Dim objWMI, osInfo, os

Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set osInfo = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each os in osInfo
GetOSVersion = CDbl(Left(os.Version, 3))
Next
End Function
'--------------------------------------------------------------------------------------------------------
' 管理者に昇格して実行する
Function ExecRunas
Const cKey = "/ExecRunas"
Dim s

ExecRunas = False

' OS情報を取得'
If GetOSVersion < osWin7 Then Exit Function

' 引数の処理'
s = ""
If WScript.Arguments.Count > 0 Then
If WScript.Arguments.item(0) = cKey Then Exit Function ' 実行済み'

For i = 0 To WScript.Arguments.Count -1
s = s & " """ & WScript.Arguments.item(i) & """"
Next
End If

' Runas実行'
CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """" & " " &cKey& " " & s, "", "runas", 1

ExecRunas = True
End Function
'--------------------------------------------------------------------------------------------------------



[PR]
by yozda | 2014-04-29 23:59 | プログラミング | Trackback(1) | Comments(0)
要らないLANケーブルからツイストぺアケーブルを採る
こんにチワワ。どーもボキです。

ツイストペアケーブルって作るのがメンドイ。うまくやんないとネジれるしね。
かといって、買うのはさらに面倒。(会社内の手続きとか)

そんなときは要らんLANケーブルを剥くとよい。数10mA程度しか流さないのであれば、このケーブルで十分。

a0021757_13261962.jpg
カッターで切れ目を入れる


a0021757_13262258.jpg
剥いた先端を持って引き裂く


a0021757_1326233.jpg
剥いたケーブルは片側端を固定し、一本ずつ引き抜く


a0021757_13262460.jpg
ツイストペアケーブルと抜け殻


a0021757_13262574.jpg
抜け殻でまとめておしまい


簡単だ。
[PR]
by yozda | 2014-04-19 13:25 | SE♂日誌 | Trackback | Comments(5)
腕時計を買った。CITIZEN ATTESA AT8040-57E
こんヴァンヘイレン。どーもボキです。

腕時計を買ったよ。CITIZEN ATTESA AT8040-57E

嫁はんからもらったアニエスを10年以上使っていたが、こないだ床に落としてガラスを欠けさせてしまった。
欠けはムーブメント側だったので利用には支障がなかったし、ガラス交換も可能らしかったが、
もういい年だし、それなりの時計にしようと、この盆連休に買い替えた。

機械式も魅力的だが、時間がズレない電波時計。国内メーカに決めてた。だって日本人ですから。
エコ・ドライブ電波時計なので、メンテナンスフリーですよ。

アニエスに比べるとずいぶん大きくなったが、チタン製&スリムボディで重さはまったく気にならない。
主張しすぎないクロノグラフで時刻も読みやすいし、高級感もあるし、長く使えそう。とても気に入ってる。
a0021757_12423100.jpg
a0021757_1815859.jpg
夜間の視認性も良い。


分針は10秒ごと進む。秒針が50秒で分針は次の分を指す。そのため0秒では1/6分だけ進んだ状態となる。(これは仕様?)



[PR]
by yozda | 2013-08-25 01:23 | 物・モノ・もの | Trackback(1) | Comments(0)
[VBScript] youkuの分割動画をリネームする
こんヴァンヘイレン。どーもボキです。

youkuから(一時的に)ダウンロードした動画ファイルは、訳の分からん長ったらしい名前がついている。
それを短くリネームするスクリプト。

動画ファイルを保存したフォルダをスクリプトファイルにドロップすれば、
以下のようにリネームしてくれる。
a0021757_2042648.gif
Const cPos = 9  ' 16^1の位の文字位置

If WScript.Arguments.Count = 0 Then WScript.Quit ' フォルダドロップでない

Set objFS = CreateObject("Scripting.FileSystemObject")

For idpth = 0 To WScript.Arguments.Count -1: Do
dpth = WScript.Arguments(idpth)
If Not objFS.FolderExists(dpth) Then Exit Do ' フォルダでない

dname = objFS.GetFileName(dpth) ' フォルダ名

' フォルダ内のファイル処理
Set Folder = objFS.GetFolder(dpth)
For Each File In Folder.Files: Do
fname = File.Name
If InStr(fname, dname) <> 0 Then Exit Do ' リネーム済み

If Len(fname) > cPos Then
' 16^1の位
i = CInt(Mid(fname,cPos,1))
' 16^0の位
s = Mid(fname,cPos+1,1)
If s < "A" Then
j = CInt(s)
Else
j = Asc(s) -Asc("A") +10
End If

' ファイル番号を生成
s = CStr(i*16 +j)
If Len(s) = 1 Then s = "0" & s

' ファイル名の変更
fname = dname &"_"& s & Right(fname,4)
ElseIf (Len(fname) = 6) And IsNumeric(Left(fname,2)) Then
fname = dname & "_" & fname
End If

File.Name = fname
Loop Until 1: Next
Loop Until 1: Next

[youku] オススメ動画サイトyouku(= 中国版Youtube)、そのダウンロード方法
[PR]
by yozda | 2013-06-29 20:38 | プログラミング | Trackback | Comments(0)
[iPhone] 無線写真転送 が使いやすい
連休2日目だっちゃ。どーもボキです。

iPhoneアプリの「無線写真転送」が使いやすい。
このアプリは、無線LANを利用し iPhone⇔iPhone/PC で写真や動画をやり取りするもの。

無線LAN環境が家庭にあれば、無線LANに対応していないデスクトップでも、
ケーブルを接続することなくiPhoneの写真を取り出せる。
Bluetoothを利用したアプリもあったが、無線LANをつかったこのアプリの方が格段に転送が速い。
a0021757_9402588.gif
無線写真転送を利用し、PC→iPhoneにアクセスしている図


ちなみに、iPhone ⇔ iPhone での転送はまだ試せてない。
ときどき無料化(元は、250円)されてるので、そんときにでも嫁のiPhoneに入れて試そう。


[PR]
by yozda | 2013-04-28 09:50 | パソコン全般 | Trackback | Comments(0)
B'z Live動画 高解像度なもの
おはこんにちは。どーもボキです。

下の動画はかなり画質がいい。
B'z LIVE-GYM 2007 SHOWCASE -19- at Zepp Tokyo
a0021757_12144725.jpg


B'z LIVE-GYM 2010 “Ain't No Magic” at TOKYO
a0021757_1210649.jpg



B z LIVE-GYM 2012 -Into Free- in LA 2012
[PR]
by yozda | 2013-03-31 12:10 | ギター | Trackback(1) | Comments(0)
B z LIVE-GYM 2012 -Into Free- in LA 2012
おはヨーグルト。どーもボキです。

某国は著作権に関してはブレがないね。
まったくケシカラン。また見つけたわ。見たかったやつ。

B’z LIVE-GYM 2012 -Into Free- in LA 2012 Part1
B’z LIVE-GYM 2012 -Into Free- in LA 2012 Part2
a0021757_126115.jpg


けどこの動画、某国大陸専用らしいわ。ケシカラン。
a0021757_126103.gif


でも大丈夫。FLVcdを使って【一時的に】PCに残せばいい。
a0021757_1261053.gif



FC2動画でWOWOWの特集ドキュメントも見つけた。まったく持ってケシカラン。
wowow20121209

これもFirefoxのDownload Helperを使えば、【一時的に】PCに残せるらしい。
いやーケシカランね。


[PR]
by yozda | 2013-01-27 12:08 | ギター | Trackback(1) | Comments(0)
[iPhone] To Do管理アプリ「Do! Spring」が便利
もうすぐ駅につくわ。どーもボキです。

標準のリマインドは、指定日時になると通知センターに表示されるが、
一度でも確認すると通知から消えてしまう。これじゃリマインドできんわ。

その点、Do! Springは便利だ。チェックするまで通知センターに表示され続けるから。
a0021757_23152986.jpg
時計のマークを押して、Alarm Onにするだけ。
つまり、アラート表示時間の設定が「今」になる = 設定したタイミングでアラート時間を過ぎる = 通知センターに表示される ってこと。
a0021757_23152810.jpg
ホーム画面でも(数字はTo Do件数)と通知されて分かりやすい。
a0021757_23171624.jpg


[PR]
by yozda | 2012-11-05 08:55 | パソコン全般 | Trackback | Comments(0)
[Excel] コピーした文字列を改行ごとにテキストボックス化して張り付ける
『やっぱ今年はやめとくか?』 と言われそう。どーもボキです。

コピーした文字列を、選択セル位置を基準に一行ごとにテキストボックス化して貼り付けるマクロ。

ひとつのテキストボックスや行ごとに 箇条書きで書き溜めたアイデアを、
グループ分けしたり、前後関係で並べてみたり、そんなのに使えそう。

というかそのために作ったんだが、そもそも考えがまとまらないこととは関係なかったわ。
a0021757_1315010.gif
以下Excelマクロのソース。
Sub ClipBoardToTextBox()
' クリップボードの文字列を取得
s = CreateObject("htmlfile").parentwindow.clipboarddata.GetData("text")
If s = "" Then Exit Sub

' 表示更新を停止
Application.ScreenUpdating = False

' アクティブセルの座標を取得
x = ActiveCell.Left
y = ActiveCell.Top

' 改行ごとに格納
slst = Split(s, vbCrLf)

For i = 0 To UBound(slst): Do
If slst(i) = "" Then Exit Do

' テキストボックスを該当行に作成
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, x, y, 0#, 0#).Select

' テキストボックスに文字を反映
Selection.Characters.Text = slst(i)

' テキストボックスの装飾
Selection.ShapeRange(1).TextFrame.AutoSize = msoTrue
Selection.ShapeRange.Line.Visible = msoTrue
' Selection.ShapeRange.Line.Style = msoLineThinThin ' 縁取り線「=」
' Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid

' テキストボックスの作成座標を更新
y = y + Selection.Height
Loop Until 1: Next

' 表示更新を再開
Application.ScreenUpdating = True
End Sub
ここの下のほうにあるDataObjectを使うやり方を試したんだが、
Microsoft Forms 2.0 Object Libraryを参照設定するために、ユーザフォームを追加したり面倒。
クリップボードから文字列の取得する方法もわからんかった(Formatなんとかってエラーが出る)のであきらめた。


[PR]
by yozda | 2012-11-04 13:19 | プログラミング | Trackback | Comments(0)