タグ:VBScript ( 61 ) タグの人気記事 > Z_ ̄∂
[VBScript] 指定時間経過後にPCをスタンバイにする > Z_ ̄∂
こんばんワイン。どーもボキです。

PCをスタンバイにするで紹介したもの使った。
Excel未インストールの場合には、SendKeyを利用するようにしている。

何かしらの処理(○○な動画ダウンロード・変換など)で一定時間後にPCを切りたいときなどに利用できそう。
a0021757_23433621.gif
s = InputBox("hh:mm形式","指定時間後にスタンバイ","00:10")
If s = "" Then WScript.Quit

t = CDate(s) + Time
While CDate(t) > Time
WScript.Sleep(10000)
Wend

Set objWS = CreateObject("WScript.Shell")
r = objWS.PopUp("スタンバイにします。",3,"確認",vbOKCancel)
If r = vbCancel then WScript.Quit

On Error Resume Next ' Excel未インストール対応
Set objExcel = CreateObject("Excel.Application")
On Error GoTo 0
If Not (objExcel Is Nothing) Then
' Excelあり
cmd = "CALL(""powrprof.dll"",""SetSuspendState"",""JJJJ"",0,0,0)" '1,0,0とすると休止
objExcel.ExecuteExcel4Macro(cmd)
objExcel.Quit ' Quitしないとプロセスが残るため
Else
' Excelなし ⇒ タスクマネージャーを起動
objWS.SendKeys "^+{esc}" ' タスクマネージャー起動
Do While Not objWS.AppActivate("Windows タスク マネージャ")
WScript.Sleep 250 ' タスクマネージャー起動待ち
Loop
WScript.Sleep 1000

' ショートカットキーを送信
objWS.SendKeys "%ub%fx" ' スタンバイ
'objWS.SendKeys "%uh%fx" ' 休止状態
'objWS.SendKeys "%uu%fx" ' シャットダウン
'objWS.SendKeys "%ur%fx" ' 再始動
'objWS.SendKeys "%ul%fx" ' ログオフ
End If

[VBScript] Craving Explorerの動画変換の終了後、PCをスタンバイにする

[PR]
by yozda | 2014-11-22 23:46 | プログラミング | Trackback | Comments(0)
[VBScript] デバッグ上手はプログラム上手6 ~まとめ改~ > Z_ ̄∂
こんにチワワ。どーもボキです。

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

前回はデバッグクラスを自分で生成するようにしていたが、
今回の記事では、最初に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] 管理者昇格してスクリプトを実行する > Z_ ̄∂
こんばんワイン。どーもボキです。

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)
[VBScript] youkuの分割動画をリネームする > Z_ ̄∂
こんヴァンヘイレン。どーもボキです。

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)
[VBScript] 「アーティスト名 - 曲名」ファイルを「アーティスト名」フォルダ/「曲名」ファイルに分ける > Z_ ̄∂
こんばんワイン。どーもボキです。

こういう平置きされたファイルをフォルダに分けるスクリプト。
特に使い勝手がないだろうが、メモとして。
a0021757_1461320.gif
If WScript.Arguments.Count = 0 Then WScript.Quit    ' フォルダドロップでない

Set objFS = CreateObject("Scripting.FileSystemObject")
s = WScript.Arguments(0)
If Not objFS.FolderExists(s) Then WScript.Quit ' フォルダでない


' フォルダ内のファイルサーチ
Set Folder = objFS.GetFolder(s)
For Each File In Folder.Files: Do
s = File.Name
i = InStr(s, " - ")
If i <= 1 Then Exit Do ' アーティスト名が不明

dnam = LTrim(Left(s, i-1))
dpth = Folder.Path &"\"& dnam &"\"
fnam = Right(s, Len(s) -i-2)

On Error Resume Next ' CreateFolderのエラー回避
objFS.CreateFolder(dpth)
objFS.MoveFile File.Path, dpth & fnam
On Error GoTo 0
Loop Until 1: Next

MsgBox "
終了"



[PR]
by yozda | 2013-04-29 01:48 | プログラミング | Trackback | Comments(0)
[VBScript] メモ帳のフォントを「MS ゴシック」「9pt」「装飾なし」にする > Z_ ̄∂
今朝は、朝から頭痛が痛い。どーもボキです。

レジストリを書き換えて、メモ帳のフォントを「MS ゴシック」「9pt」「装飾なし」に書き換えるスクリプト。
プロポーショナルフォントを使うやつぁ、わしゃSEとして認めんけぇの。
key  = "HKCU\Software\Microsoft\Notepad\"
font = "MS ゴシック"
Set objWS = CreateObject("WScript.Shell")
r = objWS.RegWrite(key & "lfFaceName", font, "REG_SZ") ' フォント
r = objWS.RegWrite(key & "lfItalic", 0, "REG_DWORD") ' イタリック 0/1
r = objWS.RegWrite(key & "lfWeight", 400, "REG_DWORD") ' ボールド 400/700
r = objWS.RegWrite(key & "lfStrikeOut", 0, "REG_DWORD") ' 取り消し線 0/1
r = objWS.RegWrite(key & "lfUnderline", 0, "REG_DWORD") ' 下線 0/1
r = objWS.RegWrite(key & "iPointSize", 90, "REG_DWORD") ' 9pt×10



[PR]
by yozda | 2012-10-21 18:19 | プログラミング | Trackback | Comments(0)
[VBScript] メッセージダイアログを実現する > Z_ ̄∂
こんにチワワ。ドーモボキです。

[VBScript] ラジオボタンダイアログを実現する その3

ラジオボタンダイアログのソースを利用して、メッセージダイアログを作成した。

実行ソース
r = MessageDlg("タイトル","キャプション","アイテム0,アイテム1,アイテム2")
a0021757_21263884.gif

戻り値は、押されたボタンのインデックス (0~)。
[×]で終了した場合は、-1。

◆ソース◆
[PR]
by yozda | 2012-09-22 18:08 | プログラミング | Trackback | Comments(0)
[VBScript] ラジオボタンダイアログを実現する その3 > Z_ ̄∂
こんにチワワ。どーもボキです。

前回の記事 ⇒ [VBScript] ラジオボタンダイアログを実現する その2

ラジオボタンダイアログを改良した。タイトルバーに「http:/// -」を出なくした。

実行ソース
r = RadioGroupBox("タイトル","キャプション","アイテム0,アイテム1,アイテム2",1)
a0021757_21244099.gif
戻り値は、[OK]ボタンが押された場合は項目インデックス (0~)。
[キャンセル]ボタン や [×]で終了した場合は、-1。

RadioGroupBox_MaxCount = 3
とすることで、項目が指定数(この場合は3)以上になった場合、プルダウンメニュータイプに変更できる。
a0021757_21243675.gif





◆ソース◆
[PR]
by yozda | 2012-09-22 17:37 | プログラミング | Trackback(2) | Comments(10)
[VBScript] 右クリックメニューのカスタマイズ 他 > Z_ ̄∂
こんばんワイン。どーもボキです。

ファイルやフォルダを右クリックした際に表示されるメニューをカスタマイズするスクリプト。
出来ることは以下。
a0021757_2243191.gif
実行結果イメージ
ファイル 右クリックメニュー
 ・選択ファイルの親フォルダ基準ででエクスプローラを開く
 ・選択ファイルの親フォルダ基準でコマンドプロンプトを開く

フォルダ 右クリックメニュー
 ・選択ファイルの親フォルダ基準ででエクスプローラを開く
 ・選択ファイルの親フォルダ基準でコマンドプロンプトを開く

拡張子がないファイルのテキストファイル関連付け

(サクラエディタがインストール済みの場合、以下をサクラエディタに関連付け)
 ・全ファイルの右クリックメニューにサクラエディタで編集を追加
 ・IEのソースエディタ
 ・VBScriptの編集エディタ
Set objWS = WScript.CreateObject("WScript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")

' サクラエディタのインストールパス
cmd = "サクラエディタで開く"
fpth = ""
On Error Resume Next ' 未インストールへの対応 (RegReadでエラーになる)
s = Replace(objWS.RegRead("HKEY_CLASSES_ROOT\Applications\sakura.exe\shell\open\command\"),"""","",1,-1,1)
fpth = Left(s,InStr(s,"
%1")-1)
On Error GoTo 0

' エディタのパスを設定
If Not objFS.FileExists(fpth) Then
cmd = "
メモ帳で開く"
fpth = "
notepad"
End If
'--------------------------------------------------------------------------------------------------------
' ファイル 右クリメニュー
root = "
HKEY_CLASSES_ROOT\*\shell\"

key = root & cmd & "
\"
val = cmd & "
(&E)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
""" & fpth &""" ""%1"""
r = objWS.RegWrite(key, val, "
REG_SZ")

cmd = "
エクスプローラ"
key = root & cmd & "
\"
val = cmd & "
(&X)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
explorer /e , ""%1\.."""
r = objWS.RegWrite(key, val, "
REG_SZ")

cmd = "
エクスプローラ (このフォルダ基準)"
key = root & cmd & "
\"
val = cmd & "
(&X)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
explorer /e ,/root, ""%1\.."""
r = objWS.RegWrite(key, val, "
REG_SZ")

cmd = "
コマンドプロンプトを開く"
key = root & cmd & "
\"
val = cmd & "
(&W)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
cmd.exe /k ""cd %1\.."""
r = objWS.RegWrite(key, val, "
REG_SZ")

'--------------------------------------------------------------------------------------------------------
' フォルダ 右クリメニュー
root = "
HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Directory\shell\"

cmd = "
エクスプローラ (このフォルダ基準)"
key = root & cmd & "
\"
val = cmd & "
(&X)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
explorer /e ,/root, ""%1"""
r = objWS.RegWrite(key, val, "
REG_SZ")

cmd = "
コマンドプロンプトを開く"
key = root & cmd & "
\"
val = cmd & "
(&W)"
r = objWS.RegWrite(key, val, "
REG_SZ")
key = key & "
command\"
val = "
cmd.exe /k ""cd %1"""
r = objWS.RegWrite(key, val, "
REG_SZ")

'--------------------------------------------------------------------------------------------------------
' 拡張子のないファイルを関連付け
fpth_bat = objFS.GetSpecialFolder(2) &"
\tmp.bat"
Set txt = objFS.OpenTextFile(fpth_bat,2,True)
txt.WriteLine "
assoc .=txtfile"
txt.Close
r = objWS.Run(fpth_bat,0,True)
objFS.DeleteFile(fpth_bat)

If fpth = "
notepad" Then WScript.Quit

' IEソース表示エディタの変更
key = "
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\View Source Editor\Editor Name\"
val = fpth
r = objWS.RegWrite(key, val, "
REG_SZ")

' テキストの編集用エディタを変更
key = "
HKEY_CLASSES_ROOT\txtfile\Shell\Edit\command\"
val = fpth & "
%1"
r = objWS.RegWrite(key, val, "
REG_SZ")

' VBScriptの編集用エディタを変更
key = "
HKEY_CLASSES_ROOT\VBSFile\Shell\Edit\command\"
val = fpth & "
%1"
r = objWS.RegWrite(key, val, "
REG_SZ")



[PR]
by yozda | 2012-06-25 22:08 | プログラミング | Trackback | Comments(0)
拡張子のないファイルをテキストファイルとして認識させる > Z_ ̄∂
こんにチワワ。どーもボキです。

WinXPならば、フォルダ メニュー > ツール > フォルダオプション > ファイルの種類
「.」のみの拡張子を新規登録し、それのエディタに関連付ければいい。

しかし、Win7では使えない。(拡張子の関連付けメニューがない)

WinXPにおいても、操作で設定が必要だったので、
レジストリやスクリプトでどうにかできないものか以前から調べていた。やっと見つけた。カンタンだわ。

コマンドプロンプトで以下を実行するだけ。
Win7では、管理者として実行しないとダメかもしれんね。
assoc .=txtfile
ここの方法を使えば、VBSciptでも出来なくはない。
しかし、assoc実行時のコマンドプロンプトをユーザが閉じるまでスクリプトが終わらない。

素直にコマンドプロンプトやbatファイルで処理させたほうがいい。


[PR]
by yozda | 2012-06-23 15:56 | パソコン全般 | Trackback | Comments(0)