2013年8月17日土曜日

ServersMan SIM LTE 100

「[DTI] ServersMan SIM LTE 100 ご利用機器発送手配完了のお知らせ」というメールが届き、数日後にSIMが入った封筒が届きました。
今回も配達証明が無い形での郵送。
定額で音声なしという事での割り切った対応でしょうが、OCNのように、受け取ってからアクティベートする方法でも良いのでは?

SIM交換自体は、交換後、APNとユーザー名を ynmbl.net から dream.jp に書き換えて終了。
3G携帯でスマートループを利用しているだけなので、何の恩恵もありません。
LTE対応にして、チャージでの利用を期待しているのか、LTEに切り替える理由がキャリア側にあるのかな。

2013年8月12日月曜日

ファイル削除

zip圧縮に続いて、今度はフォルダを削除するスクリプト。
関数の為、以下の様に呼び出して使います。
Call OldFileDelete("C:¥Temp", 7)



 ■指定フォルダの指定日数分を残してファイルを削除する
Sub OldFileDelete(strFolder, numDays) 
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim MyFolder
Set MyFolder = objFSO.GetFolder(strFolder)

Dim MyFileName
For Each MyFileName In MyFolder.Files
If DateDiff("d", MyFileName.DateLastModified, date) >= numDays Then
On Error Resume Next
objFSO.DeleteFile MyFileName
On Error Goto 0
End If
Next

Set MyFileName = Nothing
Set MyFolder = Nothing
Set objFSO = Nothing
End Sub


■指定フォルダの指定個数分最新のものを残してファイルを削除する関数
Sub OldFileDelete2(strFolder, numDays)
Dim rs
Set rs = CreateObject("ADODB.Recordset")
Call rs.Fields.Append("LastModified", 4)
Call rs.Fields.Append("FileName", 130, 1000)
Call rs.Open()

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim MyFolder
Set MyFolder = objFSO.GetFolder(strFolder)

Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")

Dim objShortcut

Dim MyFileName
For Each MyFileName In MyFolder.Files

On Error Resume Next
Set objShortcut = WshShell.CreateShortcut(strFolder &"\"& MyFileName.Name)
' LNKファイル以外はエラーとなる(index.dat を除外)
If Err.Number = 0  Then
On Error Goto 0

If objFSO.FolderExists(objShortcut.TargetPath) Then
On Error Resume Next
' リンク先がフォルダであればリンクファイルを削除
objFSO.DeleteFile strFolder &"\"& MyFileName.Name
On Error Goto 0
ElseIf objFSO.FileExists(objShortcut.TargetPath) Then
Call rs.AddNew()
rs.Fields("FileName").Value = MyFileName.Name
rs.Fields("LastModified").Value = MyFileName.DateLastModified
Call rs.Update()
Else
' リンク先がリンク切れフォルダまたはリンク切れファイルであればリンクファイルを削除
On Error Resume Next
objFSO.DeleteFile strFolder &"\"& MyFileName.Name
On Error Goto 0
End If

Else
On Error Goto 0
' WScript.Echo strFolder &"\"& MyFileName.Name
End If

Next

rs.Sort = "LastModified DESC"

If rs.RecordCount > numDays Then
Call rs.Move(numDays)
Do Until rs.EOF
On Error Resume Next
objFSO.DeleteFile strFolder &"\"& rs.Fields("FileName").Value
On Error Goto 0
rs.MoveNext
Loop
End If

Call rs.Close()

Set MyFileName = Nothing
Set MyFolder = Nothing
Set objFSO = Nothing
Set rs = Nothing
End Sub

2013年8月9日金曜日

zip圧縮

Windows標準の zip圧縮機能だと、複数選択して「圧縮(zip 形式)フォルダー」を作成すると、1つの zipファイルになる。
例えば、100個のファイルがあり、それを個別に zipファイルにしたい場合は、連続圧縮やLHAUtirityなどの圧縮ツールか、個別に1つ1つ地道に作業するしかない。

そんな訳で、圧縮ツールを使えない環境でも手軽に個別圧縮ができるようにスクリプトを組んでみました。


Option Explicit

Dim i
Dim fso
Dim Shell
Dim file
Dim dFolder
Dim Folder
Dim FolderItem
Dim ZIPfile:ZIPfile="新規圧縮 (zip 形式) フォルダ.zip"
Dim ZIPdata:ZIPdata="PK" & Chr(5) & Chr(6) & String(18,0)

If WScript.Arguments.Count<1 div="" then="">
    WScript.Echo "Usage: CScript.exe MakeZIP.VBS fileName ...."
    WScript.Quit
End If

Set fso=CreateObject("Scripting.FileSystemObject")
Set Shell=CreateObject("Shell.Application")

For i=0 to WScript.Arguments.Count-1
    Call MakeZIP()
Next

WScript.Quit

Sub MakeZIP()
    ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(i)&".zip")
    If Not fso.FileExists(ZIPfile) Then
         fso.CreateTextFile(ZIPfile,False).Write ZIPdata
    End If

    If i=0 Then 
         WScript.Sleep 1000
    Else
         WScript.Sleep 100
    End If

    file=fso.GetAbsolutePathName(WScript.Arguments(i))
    Set Folder=Shell.NameSpace(fso.GetParentFolderName(file))
    Set FolderItem=Folder.ParseName(fso.GetFileName(file))
    Set dFolder=Shell.NameSpace(ZIPfile)
    dFolder.CopyHere FolderItem

    WScript.Sleep 10

End Sub