PageLastUpdate:2009-06-09/today: - /yesterday: -
2009/06/09
MDBファイルを運用していると肥大化対策とバックアップが必要なので、VBSで対応。
MDBCompactAndBackup "ソースのMDBファイルのパス" "バックアップフォルダのパス"
という感じで呼び出すと、バックアップフォルダに[ファイルの更新日時(yyyyymmddhhnnss)+ファイル名.zip]でバックアップファイルを作ります。
バックアップフォルダを省略した場合はMDBと同じフォルダに生成するので、MDBをスクリプトにドラッグ&ドロップしてもok。
元のファイルは最適化されます。
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count = 0 Then
WScript.Quit
End If
Dim SourceDBName
SourceDBName = WScript.Arguments(0)
Dim BackupFolderName
If WScript.Arguments.Count = 2 Then
BackupFolderName = WScript.Arguments(1)
Else
BackupFolderName = fso.GetParentFolderName(SourceDBName)
End If
'バックアップフォルダーがなければ処理中止
If fso.FolderExists(BackupFolderName) = False Then
WScript.Quit
End If
Dim SourceLFName
SourceLFName = fso.BuildPath(fso.GetParentFolderName(SourceDBName),fso.GetBaseName(SourceDBName) & ".ldb")
'ロックファイルがあったら処理中止
If fso.FileExists(SourceLFName) Then
WScript.Quit
End If
Dim TempDBName
TempDBName = fso.BuildPath(fso.GetParentFolderName(SourceDBName),fso.GetBaseName(SourceDBName) & ".compact.tmp")
'一時ファイルがあったら削除
If fso.FileExists(TempDBName) Then
fso.DeleteFile TempDBName
End If
'最適化
Dim Jet
Set Jet = WScript.CreateObject("JRO.JetEngine")
Jet.CompactDatabase ";Data Source=" & SourceDBName, ";Data Source=" & TempDBName
'圧縮
Dim f
Set f = fso.GetFile(SourceDBName)
Dim FileName
FileName=f.Name
Dim ZipFileName
ZipFileName = fso.BuildPath(BackupFolderName,GetYYYYMMDDHHNNSS(f.DateLastModified) & FileName & ".zip")
If fso.FileExists(ZipFileName) = False Then
Dim Shell
Set Shell=CreateObject("Shell.Application")
Set SourceFolder = Shell.NameSpace(fso.GetParentFolderName(SourceDBName))
Set SourceFolderItem = SourceFolder.ParseName(FileName)
fso.CreateTextFile(ZipFileName,False).Write "PK" & Chr(5) & Chr(6) & String(18,0)
Dim ZipFolder
Set ZipFolder = Shell.NameSpace(ZipFileName)
ZipFolder.CopyHere SourceFolderItem
While ZipFolder.Items().Count = 0
WScript.Sleep 100
Wend
End If
'リネーム
f.delete
Set f = Nothing
fso.MoveFile TempDBName,SourceDBName
Function GetYYYYMMDDHHNNSS(dt)
GetYYYYMMDDHHNNSS = RIGHT("0000" & Year(dt),4) & RIGHT("00" & Month(dt),2) & RIGHT("00" & Day(dt),2) & RIGHT("00" & Hour(dt),2) & RIGHT("00" & Minute(dt),2) & RIGHT("00" & Second(dt),2)
End Function
SourceFileName = "圧縮したいファイルのパス"
ZipFileName = "作成したい圧縮ファイルのパス"
Set fso=CreateObject("Scripting.FileSystemObject")
Set Shell=CreateObject("Shell.Application")
FileName=fso.GetFileName(SourceFileName)
Set SourceFolder = Shell.NameSpace(fso.GetParentFolderName(SourceFileName))
Set SourceFolderItem = SourceFolder.ParseName(FileName)
fso.CreateTextFile(ZipFileName,False).Write "PK" & Chr(5) & Chr(6) & String(18,0)
Set ZipFolder =Shell.NameSpace(ZipFileName)
ZipFolder.CopyHere SourceFolderItem
'コピーが非同期のようでこのループを入れたほうがよいようです。
While ZipFolder.Items().Count = 0
WScript.Sleep 100
Wend
MsgBox "OK!"
2009/05/085
下記のLogRecorderクラスを引数ひとつにできないかなと調べたけどvbsではできないっぽい。
JScriptならできるらしい。
2009/05/07
WSHで複雑な処理を実行する必要が出てきたので、恒常的にログを記録できるようにクラス化。
includeして使う感じ。
インスタンス起こした後「myLog.Write 整数値,メッセージ」と書くだけで下記のレイアウトのログを積み上げていってくれる。
クラスの生成時刻 |
処理毎の一意キー |
処理毎のカウンタ |
ステップ実行時刻 |
実行PC名 |
実行ユーザー名 |
整数値 |
メッセージ |
Err.NumberとErr.Descriptionをそのまま記録できるように整数値とメッセージの指定にした。
既存のログを指定すれば追記します。
途中で記録ファイルを再指定できるので、特定の処理だけ別ログに切り出すようなことも可能。
呼び出しはこんな感じ。
Option Explicit
'インクルード
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Execute fso.OpenTextFile("Hoge\Moge\LogRecorder.vbs", 1, False).ReadAll()
'インスタンスの生成
Dim myLog
Set myLog = New LogRecorder
myLog.SetLogFile("ログファイルのパス")
myLog.Write 1000000000000,"TE" & """" & "ST"""
myLog.Write 1.1,"TE STTAB"
myLog.Write "xdar","TES" & vbCrLf & "Tvbcrlf"
クラス定義はこんな感じ。
Class LogRecorder
'定型書式でログを記録するクラスです。異なる処理や異なるPCで行ったログファイルを最終的に集積できるように
'GUIDで一意キーを生成しています。前3列でソートすれば、完全に実行順に処理が並びます。
'ログファイルのパスをセットしないときはスクリプトの実行フォルダにLogRecorder.txtを生成します。
'
'ログファイルはTab区切りで、記録項目は下記の通りです。
'クラスの生成時刻/処理毎の一意キー/処理毎のカウンタ/ステップ実行時刻/実行PC名/実行ユーザー名/Number/Description
'
Private GUID
Private fso
Private net
Private logfile
Private counter
Private startdt
Private openstate '0-開いていない/1-開けた/2-開けなかった
'コンストラクタ
Private Sub Class_Initialize()
Set fso = CreateObject("Scripting.FileSystemObject")
Set net = WScript.CreateObject("WScript.Network")
GUID = MID(CreateObject("Scriptlet.Typelib").GUID,2,36)
counter = 0
startdt = Now()
openstate = 0
End Sub
Sub SetLogFile(Value)
'ログファイルが開いていたらクローズ
If TypeName(logfile) = "TextStream" Then
logfile.Close
End If
On Error Resume Next
Set logfile = fso.OpenTextFile(Value,8,True)
If Err.Number = 0 Then
openstate = 1
Else
MsgBox Err.Number & vbCrLf & Err.Description
openstate = 2
End If
On Error Goto 0
End Sub
Sub Write(number,description)
If openstate = 0 Then
SetLogFile(fso.GetParentFolderName(WScript.ScriptFullName) & "\LogRecorder.txt")
End If
If openstate = 1 Then
If IsNumeric(number) Then
number = Int(number)
Else
number = 0
End If
description = Replace(description,vbCrLf,vbLf)
description = """" & Replace(description,"""","""""") & """"
logfile.WriteLine startdt _
& vbTab & GUID _
& vbTab & counter _
& vbTab & Now() _
& vbTab & net.ComputerName _
& vbTab & net.UserName _
& vbTab & number _
& vbTab & description
counter = counter + 1
End If
End Sub
' デストラクタ
Private Sub Class_Terminate()
'ログファイルが開いていたらクローズ
If TypeName(logfile) = "TextStream" Then
logfile.Close
End If
End Sub
End Class
2009/05/07
'こんな感じで定義して
Class myClass
'コンストラクタ
Private Sub Class_Initialize()
End Sub
' デストラクタ
Private Sub Class_Terminate()
End Sub
End Class
'こんな感じで呼び出し
Set myInstance = New myClass
2009/05/07
Set fso = CreateObject("Scripting.FileSystemObject")
Execute fso.OpenTextFile("includeしたいスクリプトのパス", 1, False).ReadAll()
2009/05/07
WSHでデータベースを使わずにいろいろなスクリプトから吐き出したログを統括する為に一意キーが欲しい。
どうするか考えた末にGUIDを使うことにした。
GUID = CreateObject("Scriptlet.Typelib").GUID
GUID = MID(GUID,2,36)
なぜかGUIDの結果は40文字帰ってきて、末尾二文字にはNullと5が入ってくるので{}括弧ともども除外する為にMIDで取り出している。
2007/07/31
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.OpenTextFile(".\ApplicationList.txt", 8, True)
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each strSubKey in arrSubkeys
strValueName = "DisplayName"
strSubPath = strKeyPath & "\" & strSubKey
objRegistry.GetStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
If Not IsNull(strValue) Then
objOutput.WriteLine strValue
End If
Next
objOutput.Close
comment
このページの記述で聞きたいこととか間違ってることとかありましたらコメントを。
最終更新:2009年06月09日 17:03